diff options
| author | Kenichi Handa <handa@m17n.org> | 2011-07-07 08:28:00 +0900 |
|---|---|---|
| committer | Kenichi Handa <handa@m17n.org> | 2011-07-07 08:28:00 +0900 |
| commit | d2a0a50628933d3cdb09818eee2e17f55e22531f (patch) | |
| tree | d19c8e71eb63eb6ccd204c2f36f406e4cf853154 | |
| parent | c805dec0b5fa81b5c9f2b724e2ec12a17d723aca (diff) | |
| parent | 354cf0ba0b20108c9776be1d868458893bc2cd54 (diff) | |
| download | emacs-d2a0a50628933d3cdb09818eee2e17f55e22531f.tar.gz | |
merge trunk
282 files changed, 14792 insertions, 7667 deletions
diff --git a/ChangeLog b/ChangeLog index 9b8e5f762f3..19dcf6818e3 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,39 @@ +2011-07-05 Jan Djärv <jan.h.d@swipnet.se> + + * configure.in (HAVE_GCONF): Allow both HAVE_GCONF and HAVE_GSETTINGS. + +2011-07-01 Glenn Morris <rgm@gnu.org> + + * configure.in (SETTINGS_CFLAGS, SETTINGS_LIBS) [HAVE_GCONF]: Fix typo. + +2011-06-30 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * configure.in (HAVE_GSETTINGS): Fix syntax for GSETTINGS tests, + which made ./configure infloop. + +2011-06-30 Jan Djärv <jan.h.d@swipnet.se> + + * configure.in (gsettings): New option and check for GSettings. + +2011-06-29 Glenn Morris <rgm@gnu.org> + + * configure.in: Try to test for the required crt*.o files. + +2011-06-27 Bill Wohler <wohler@newt.com> + + * .bzrignore: Add lisp/mh-e/mh-autoloads.el and lisp/mh-e/mh-cus-load.el. + +2011-06-25 Paul Eggert <eggert@cs.ucla.edu> + + Use gnulib's dup2 module instead of rolling our own. + * Makefile.in (GNULIB_MODULES): Add dup2. + * configure.in: Do not check for dup2; gnulib does that now. + * lib/dup2.c, m4/dup2.m4: New files, from gnulib. + +2011-06-23 Paul Eggert <eggert@cs.ucla.edu> + + * lib/getopt.c, lib/stat.c, m4/gl-comp.m4: Merge from gnulib. + 2011-06-22 Paul Eggert <eggert@cs.ucla.edu> Use gnulib's alloca-opt module. diff --git a/INSTALL.BZR b/INSTALL.BZR index 93229ec7a79..664aab1c765 100644 --- a/INSTALL.BZR +++ b/INSTALL.BZR @@ -68,10 +68,12 @@ etc.) before "make bootstrap" or "make"; the rest of the procedure is applicable to those systems as well. Because the Bazaar version of Emacs is a work in progress, it will -sometimes fail to build. Please wait a day or so (and check the bug -and development mailing list archives) before reporting such problems. -In most cases, the problem is known about and is just waiting for -someone to fix it. +sometimes fail to build. Please wait a day or so (and check the +archives of the emacs-buildstatus, emacs-devel, and bug-gnu-emacs +mailing lists) before reporting such problems. In most cases, the +problem is known about and is just waiting for someone to fix it. +This is especially true for Lisp compilation errors, which are almost +never platform-specific. diff --git a/Makefile.in b/Makefile.in index 40d76104397..457b5d6472e 100644 --- a/Makefile.in +++ b/Makefile.in @@ -334,6 +334,7 @@ DOS_gnulib_comp.m4 = gl-comp.m4 GNULIB_MODULES = \ alloca-opt \ careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr \ + dup2 \ filemode getloadavg getopt-gnu ignore-value intprops lstat mktime readlink \ socklen stdarg stdio strftime strtoumax symlink sys_stat GNULIB_TOOL_FLAGS = \ diff --git a/autogen/Makefile.in b/autogen/Makefile.in index 18127366751..fd93b0146a6 100644 --- a/autogen/Makefile.in +++ b/autogen/Makefile.in @@ -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 dup2 filemode getloadavg getopt-gnu ignore-value intprops lstat mktime readlink socklen stdarg stdio strftime strtoumax symlink sys_stat VPATH = @srcdir@ pkgdatadir = $(datadir)/@PACKAGE@ @@ -51,7 +51,8 @@ DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in \ 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/alloca.m4 $(top_srcdir)/m4/c-strtod.m4 \ + $(top_srcdir)/m4/dup2.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 \ @@ -104,6 +105,7 @@ CTAGS = ctags 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@ @@ -304,6 +306,8 @@ GNULIB_WRITE = @GNULIB_WRITE@ GNULIB__EXIT = @GNULIB__EXIT@ GNU_OBJC_CFLAGS = @GNU_OBJC_CFLAGS@ GREP = @GREP@ +GSETTINGS_CFLAGS = @GSETTINGS_CFLAGS@ +GSETTINGS_LIBS = @GSETTINGS_LIBS@ GTK_CFLAGS = @GTK_CFLAGS@ GTK_LIBS = @GTK_LIBS@ GTK_OBJ = @GTK_OBJ@ @@ -617,6 +621,8 @@ REPLACE_WCTOMB = @REPLACE_WCTOMB@ REPLACE_WRITE = @REPLACE_WRITE@ RSVG_CFLAGS = @RSVG_CFLAGS@ RSVG_LIBS = @RSVG_LIBS@ +SETTINGS_CFLAGS = @SETTINGS_CFLAGS@ +SETTINGS_LIBS = @SETTINGS_LIBS@ SET_MAKE = @SET_MAKE@ SHELL = @SHELL@ SIG_ATOMIC_T_SUFFIX = @SIG_ATOMIC_T_SUFFIX@ @@ -732,35 +738,36 @@ x_default_search_path = @x_default_search_path@ # 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 \ - 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 + sha512.h dosname.h ftoastr.c ftoastr.h dup2.c 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 \ - 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 \ 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 \ - lstat.c mktime.c readlink.c stat.c strtol.c strtoul.c \ - strtoull.c strtoimax.c strtoumax.c symlink.c time_r.c +EXTRA_libgnu_a_SOURCES = ftoastr.c dup2.c getloadavg.c getopt.c \ + getopt1.c lstat.c mktime.c readlink.c stat.c strtol.c \ + strtoul.c strtoull.c strtoimax.c strtoumax.c symlink.c \ + time_r.c ARG_NONNULL_H = arg-nonnull.h CXXDEFS_H = c++defs.h WARN_ON_USE_H = warn-on-use.h @@ -816,6 +823,7 @@ distclean-compile: @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/allocator.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/careadlinkat.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dtoastr.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dup2.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/filemode.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ftoastr.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getloadavg.Po@am__quote@ @@ -1052,6 +1060,17 @@ uninstall-am: mostlyclean-generic mostlyclean-local pdf pdf-am ps ps-am tags \ uninstall uninstall-am + +# We need the following in order to create <alloca.h> 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 diff --git a/autogen/aclocal.m4 b/autogen/aclocal.m4 index eaa2330e9ed..8c0a25eba14 100644 --- a/autogen/aclocal.m4 +++ b/autogen/aclocal.m4 @@ -985,7 +985,9 @@ AC_SUBST([am__untar]) ]) # _AM_PROG_TAR m4_include([m4/00gnulib.m4]) +m4_include([m4/alloca.m4]) m4_include([m4/c-strtod.m4]) +m4_include([m4/dup2.m4]) m4_include([m4/extensions.m4]) m4_include([m4/filemode.m4]) m4_include([m4/getloadavg.m4]) diff --git a/autogen/config.in b/autogen/config.in index b3e14609845..8fa108844b8 100644 --- a/autogen/config.in +++ b/autogen/config.in @@ -104,7 +104,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* 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 <alloca.h>, a header that + may be supplied by this distribution. */ #undef HAVE_ALLOCA /* Define to 1 if you have <alloca.h> and it should be used (not on Ultrix). @@ -303,6 +304,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define to 1 if you have the `grantpt' function. */ #undef HAVE_GRANTPT +/* Define to 1 if using GSettings. */ +#undef HAVE_GSETTINGS + /* Define to 1 if using GTK 3 or later. */ #undef HAVE_GTK3 @@ -1290,6 +1294,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #undef volatile +/* On AIX 3 this must be included before any other include file. */ +#include <alloca.h> +#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 +1376,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <string.h> #include <stdlib.h> -#ifdef HAVE_ALLOCA_H -# include <alloca.h> -#elif defined __GNUC__ -# define alloca __builtin_alloca -#elif defined _AIX -# define alloca __alloca -#else -# include <stddef.h> -# ifdef __cplusplus -extern "C" -# endif -void *alloca (size_t); -#endif - #ifndef HAVE_STRCHR #define strchr(a, b) index (a, b) #endif diff --git a/autogen/configure b/autogen/configure index d3cf11111a7..9b9e915f759 100755 --- a/autogen/configure +++ b/autogen/configure @@ -894,6 +894,72 @@ PRAGMA_COLUMNS PRAGMA_SYSTEM_HEADER INCLUDE_NEXT_AS_FIRST_DIRECTIVE INCLUDE_NEXT +GETLOADAVG_LIBS +REPLACE_WCTOMB +REPLACE_UNSETENV +REPLACE_STRTOD +REPLACE_SETENV +REPLACE_REALPATH +REPLACE_REALLOC +REPLACE_PUTENV +REPLACE_MKSTEMP +REPLACE_MBTOWC +REPLACE_MALLOC +REPLACE_CANONICALIZE_FILE_NAME +REPLACE_CALLOC +HAVE_DECL_UNSETENV +HAVE_UNLOCKPT +HAVE_SYS_LOADAVG_H +HAVE_STRUCT_RANDOM_DATA +HAVE_STRTOULL +HAVE_STRTOLL +HAVE_STRTOD +HAVE_DECL_SETENV +HAVE_SETENV +HAVE_RPMATCH +HAVE_REALPATH +HAVE_RANDOM_R +HAVE_RANDOM_H +HAVE_PTSNAME +HAVE_MKSTEMPS +HAVE_MKSTEMP +HAVE_MKOSTEMPS +HAVE_MKOSTEMP +HAVE_MKDTEMP +HAVE_GRANTPT +HAVE_GETSUBOPT +HAVE_DECL_GETLOADAVG +HAVE_CANONICALIZE_FILE_NAME +HAVE_ATOLL +HAVE__EXIT +GNULIB_WCTOMB +GNULIB_UNSETENV +GNULIB_UNLOCKPT +GNULIB_SYSTEM_POSIX +GNULIB_STRTOULL +GNULIB_STRTOLL +GNULIB_STRTOD +GNULIB_SETENV +GNULIB_RPMATCH +GNULIB_REALPATH +GNULIB_REALLOC_POSIX +GNULIB_RANDOM_R +GNULIB_PUTENV +GNULIB_PTSNAME +GNULIB_MKSTEMPS +GNULIB_MKSTEMP +GNULIB_MKOSTEMPS +GNULIB_MKOSTEMP +GNULIB_MKDTEMP +GNULIB_MBTOWC +GNULIB_MALLOC_POSIX +GNULIB_GRANTPT +GNULIB_GETSUBOPT +GNULIB_GETLOADAVG +GNULIB_CANONICALIZE_FILE_NAME +GNULIB_CALLOC_POSIX +GNULIB_ATOLL +GNULIB__EXIT UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS UNISTD_H_HAVE_WINSOCK2_H REPLACE_WRITE @@ -1004,78 +1070,15 @@ GNULIB_DUP3 GNULIB_DUP2 GNULIB_CLOSE GNULIB_CHOWN -GETLOADAVG_LIBS -REPLACE_WCTOMB -REPLACE_UNSETENV -REPLACE_STRTOD -REPLACE_SETENV -REPLACE_REALPATH -REPLACE_REALLOC -REPLACE_PUTENV -REPLACE_MKSTEMP -REPLACE_MBTOWC -REPLACE_MALLOC -REPLACE_CANONICALIZE_FILE_NAME -REPLACE_CALLOC -HAVE_DECL_UNSETENV -HAVE_UNLOCKPT -HAVE_SYS_LOADAVG_H -HAVE_STRUCT_RANDOM_DATA -HAVE_STRTOULL -HAVE_STRTOLL -HAVE_STRTOD -HAVE_DECL_SETENV -HAVE_SETENV -HAVE_RPMATCH -HAVE_REALPATH -HAVE_RANDOM_R -HAVE_RANDOM_H -HAVE_PTSNAME -HAVE_MKSTEMPS -HAVE_MKSTEMP -HAVE_MKOSTEMPS -HAVE_MKOSTEMP -HAVE_MKDTEMP -HAVE_GRANTPT -HAVE_GETSUBOPT -HAVE_DECL_GETLOADAVG -HAVE_CANONICALIZE_FILE_NAME -HAVE_ATOLL -HAVE__EXIT -GNULIB_WCTOMB -GNULIB_UNSETENV -GNULIB_UNLOCKPT -GNULIB_SYSTEM_POSIX -GNULIB_STRTOULL -GNULIB_STRTOLL -GNULIB_STRTOD -GNULIB_SETENV -GNULIB_RPMATCH -GNULIB_REALPATH -GNULIB_REALLOC_POSIX -GNULIB_RANDOM_R -GNULIB_PUTENV -GNULIB_PTSNAME -GNULIB_MKSTEMPS -GNULIB_MKSTEMP -GNULIB_MKOSTEMPS -GNULIB_MKOSTEMP -GNULIB_MKDTEMP -GNULIB_MBTOWC -GNULIB_MALLOC_POSIX -GNULIB_GRANTPT -GNULIB_GETSUBOPT -GNULIB_GETLOADAVG -GNULIB_CANONICALIZE_FILE_NAME -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 @@ -1100,8 +1103,12 @@ LIBXTR6 LIBGNUTLS_LIBS LIBGNUTLS_CFLAGS LIBSELINUX_LIBS +SETTINGS_LIBS +SETTINGS_CFLAGS GCONF_LIBS GCONF_CFLAGS +GSETTINGS_LIBS +GSETTINGS_CFLAGS DBUS_OBJ DBUS_LIBS DBUS_CFLAGS @@ -1129,9 +1136,9 @@ ALSA_LIBS ALSA_CFLAGS PKG_CONFIG LIBSOUND +CRT_DIR START_FILES LIB_MATH -CRT_DIR LIBS_SYSTEM C_SWITCH_SYSTEM UNEXEC_OBJ @@ -1268,6 +1275,7 @@ with_ns with_gpm with_dbus with_gconf +with_gsettings with_selinux with_gnutls with_makeinfo @@ -1984,6 +1992,7 @@ Optional Packages: console --without-dbus don't compile with D-Bus support --without-gconf don't compile with GConf support + --without-gsettings don't compile with GSettings support --without-selinux don't compile with SELinux support --without-gnutls don't use -lgnutls for SSL/TLS support --without-makeinfo don't require makeinfo for building manuals @@ -3080,6 +3089,7 @@ as_fn_append ac_header_list " stdlib.h" as_fn_append ac_header_list " unistd.h" as_fn_append ac_header_list " sys/param.h" as_fn_append ac_func_list " readlinkat" +as_fn_append ac_func_list " dup2" gl_getopt_required=GNU as_fn_append ac_header_list " getopt.h" as_fn_append ac_header_list " wchar.h" @@ -3986,6 +3996,14 @@ else fi +# Check whether --with-gsettings was given. +if test "${with_gsettings+set}" = set; then : + withval=$with_gsettings; +else + with_gsettings=yes +fi + + # Check whether --with-selinux was given. if test "${with_selinux+set}" = set; then : withval=$with_selinux; @@ -6535,6 +6553,7 @@ esac + # Code from module alloca-opt: # Code from module allocator: # Code from module arg-nonnull: # Code from module c++defs: @@ -6545,6 +6564,7 @@ esac # Code from module crypto/sha512: # Code from module dosname: # Code from module dtoastr: + # Code from module dup2: # Code from module extensions: # Code from module filemode: @@ -7636,76 +7656,6 @@ fi -## 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 - ## can be in a variety of places. We only try /usr/lib64 and /usr/lib. - ## For anything else (eg /usr/lib32), it is up the user to specify - ## the location (bug#5655). - ## Test for crtn.o, not just the directory, because sometimes the - ## directory exists but does not have the relevant files (bug#1287). - ## FIXME better to test for binary compatibility somehow. - test -e /usr/lib64/crtn.o && CRT_DIR=/usr/lib64 - ;; - - powerpc64-*-linux-gnu* | sparc64-*-linux-gnu*) CRT_DIR=/usr/lib64 ;; - esac - - case "$opsys" in - hpux10-20) CRT_DIR=/lib ;; - esac - - ## Default is /usr/lib. - test "X$CRT_DIR" = "X" && CRT_DIR=/usr/lib - - ## If we're using gcc, try to determine it automatically by asking - ## gcc. [If this doesn't work, CRT_DIR will remain at the - ## system-dependent default from above.] - if test "x${GCC}" = xyes; then - crt_file=`$CC --print-file-name=crt1.o 2>/dev/null` - case "$crt_file" in - */*) - CRT_DIR=`$as_dirname -- "$crt_file" || -$as_expr X"$crt_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$crt_file" : 'X\(//\)[^/]' \| \ - X"$crt_file" : 'X\(//\)$' \| \ - X"$crt_file" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$crt_file" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - ;; - esac - fi - -else - - ## Some platforms don't use any of these files, so it is not - ## appropriate to put this test outside the if block. - test -e $CRT_DIR/crtn.o || test -e $CRT_DIR/crt0.o || \ - as_fn_error "crt*.o not found in specified location." "$LINENO" 5 - -fi - - - LIB_MATH=-lm LIB_STANDARD= START_FILES= @@ -7746,6 +7696,99 @@ esac +crt_files= + +for file in x $LIB_STANDARD $START_FILES; do + case "$file" in + *CRT_DIR*) crt_files="$crt_files `echo $file | sed -e 's|.*/||'`" ;; + esac +done + +if test "x$crt_files" != x; then + + ## If user specified a crt-dir, use that unconditionally. + crt_gcc=no + + if test "X$CRT_DIR" = "X"; then + + CRT_DIR=/usr/lib # default + + case "$canonical" in + x86_64-*-linux-gnu* | s390x-*-linux-gnu*) + ## On x86-64 and s390x GNU/Linux distributions, the standard library + ## can be in a variety of places. We only try /usr/lib64 and /usr/lib. + ## For anything else (eg /usr/lib32), it is up the user to specify + ## the location (bug#5655). + ## Test for crtn.o, not just the directory, because sometimes the + ## directory exists but does not have the relevant files (bug#1287). + ## FIXME better to test for binary compatibility somehow. + test -e /usr/lib64/crtn.o && CRT_DIR=/usr/lib64 + ;; + + powerpc64-*-linux-gnu* | sparc64-*-linux-gnu*) CRT_DIR=/usr/lib64 ;; + esac + + case "$opsys" in + hpux10-20) CRT_DIR=/lib ;; + esac + + test "x${GCC}" = xyes && crt_gcc=yes + + fi # CRT_DIR = "" + + crt_missing= + + for file in $crt_files; do + + ## If we're using gcc, try to determine it automatically by asking + ## gcc. [If this doesn't work, CRT_DIR will remain at the + ## system-dependent default from above.] + if test $crt_gcc = yes && test ! -e $CRT_DIR/$file; then + + crt_file=`$CC --print-file-name=$file 2>/dev/null` + case "$crt_file" in + */*) + CRT_DIR=`$as_dirname -- "$crt_file" || +$as_expr X"$crt_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$crt_file" : 'X\(//\)[^/]' \| \ + X"$crt_file" : 'X\(//\)$' \| \ + X"$crt_file" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$crt_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + ;; + esac + fi + + crt_gcc=no + + test -e $CRT_DIR/$file || crt_missing="$crt_missing $file" + done # $crt_files + + test "x$crt_missing" = x || \ + as_fn_error "Required file(s) not found:$crt_missing +Try using the --with-crt-dir option." "$LINENO" 5 + +fi # crt_files != "" + + + + @@ -11017,6 +11060,111 @@ done fi +HAVE_GSETTINGS=no +if test "${HAVE_X11}" = "yes" && test "${with_gsettings}" = "yes"; then + + succeeded=no + + # Extract the first word of "pkg-config", so it can be a program name with args. +set dummy pkg-config; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + case $PKG_CONFIG in + [\\/]* | ?:[\\/]*) + ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no" + ;; +esac +fi +PKG_CONFIG=$ac_cv_path_PKG_CONFIG +if test -n "$PKG_CONFIG"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 +$as_echo "$PKG_CONFIG" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + + if test "$PKG_CONFIG" = "no" ; then + HAVE_GSETTINGS=no + else + PKG_CONFIG_MIN_VERSION=0.9.0 + if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for glib-2.0 >= 2.26" >&5 +$as_echo_n "checking for glib-2.0 >= 2.26... " >&6; } + + if $PKG_CONFIG --exists "glib-2.0 >= 2.26" 2>&5; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + succeeded=yes + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking GSETTINGS_CFLAGS" >&5 +$as_echo_n "checking GSETTINGS_CFLAGS... " >&6; } + GSETTINGS_CFLAGS=`$PKG_CONFIG --cflags "glib-2.0 >= 2.26"|sed -e 's,///*,/,g'` + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GSETTINGS_CFLAGS" >&5 +$as_echo "$GSETTINGS_CFLAGS" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking GSETTINGS_LIBS" >&5 +$as_echo_n "checking GSETTINGS_LIBS... " >&6; } + GSETTINGS_LIBS=`$PKG_CONFIG --libs "glib-2.0 >= 2.26"|sed -e 's,///*,/,g'` + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GSETTINGS_LIBS" >&5 +$as_echo "$GSETTINGS_LIBS" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + GSETTINGS_CFLAGS="" + GSETTINGS_LIBS="" + ## If we have a custom action on failure, don't print errors, but + ## do set a variable so people can do so. + GSETTINGS_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "glib-2.0 >= 2.26"` + + fi + + + + else + echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer." + echo "*** See http://www.freedesktop.org/software/pkgconfig" + fi + fi + + if test $succeeded = yes; then + HAVE_GSETTINGS=yes + else + HAVE_GSETTINGS=no + fi + + if test "$HAVE_GSETTINGS" = "yes"; then + +$as_echo "#define HAVE_GSETTINGS 1" >>confdefs.h + + SETTINGS_CFLAGS="$GSETTINGS_CFLAGS" + SETTINGS_LIBS="$GSETTINGS_LIBS" + fi +fi + HAVE_GCONF=no if test "${HAVE_X11}" = "yes" && test "${with_gconf}" = "yes"; then @@ -11117,7 +11265,17 @@ $as_echo "no" >&6; } $as_echo "#define HAVE_GCONF 1" >>confdefs.h - for ac_func in g_type_init + SETTINGS_CFLAGS="$SETTINGS_CFLAGS $GCONF_CFLAGS" + SETTINGS_LIBS="$SETTINGS_LIBS $GCONF_LIBS" + fi +fi + +if test "$HAVE_GSETTINGS" = "yes" || test "$HAVE_GCONF" = "yes"; then + SAVE_CFLAGS="$CFLAGS" + SAVE_LDFLAGS="$LDFLAGS" + CFLAGS="$SETTINGS_CFLAGS $CFLAGS" + LDFLAGS="$SETTINGS_LIBS $LDFLAGS" + for ac_func in g_type_init do : ac_fn_c_check_func "$LINENO" "g_type_init" "ac_cv_func_g_type_init" if test "x$ac_cv_func_g_type_init" = x""yes; then : @@ -11128,9 +11286,13 @@ _ACEOF fi done - fi + CFLAGS="$SAVE_CFLAGS" + LDFLAGS="$SAVE_LDFLAGS" fi + + + HAVE_LIBSELINUX=no LIBSELINUX_LIBS= if test "${with_selinux}" = "yes"; then @@ -13313,201 +13475,6 @@ $as_echo "#define HAVE_H_ERRNO 1" >>confdefs.h 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 <alloca.h> -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 <malloc.h> -# define alloca _alloca -# else -# ifdef HAVE_ALLOCA_H -# include <alloca.h> -# 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 @@ -13777,7 +13744,7 @@ esac -for ac_func in gethostname getdomainname dup2 \ +for ac_func in gethostname getdomainname \ rename closedir mkdir rmdir sysinfo getrusage get_current_dir_name \ random lrand48 logb frexp fmod rint cbrt ftime setsid \ strerror fpathconf select euidaccess getpagesize tzset setlocale \ @@ -13962,6 +13929,197 @@ fi 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 <alloca.h> +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 <malloc.h> +# define alloca _alloca +# else +# ifdef HAVE_ALLOCA_H +# include <alloca.h> +# 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 + @@ -14292,119 +14450,6 @@ $as_echo "#define HAVE_C99_STRTOLD 1" >>confdefs.h fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for st_dm_mode in struct stat" >&5 -$as_echo_n "checking for st_dm_mode in struct stat... " >&6; } -if test "${ac_cv_struct_st_dm_mode+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#include <sys/types.h> -#include <sys/stat.h> -int -main () -{ -struct stat s; s.st_dm_mode; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_struct_st_dm_mode=yes -else - ac_cv_struct_st_dm_mode=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_struct_st_dm_mode" >&5 -$as_echo "$ac_cv_struct_st_dm_mode" >&6; } - - if test $ac_cv_struct_st_dm_mode = yes; then - -$as_echo "#define HAVE_ST_DM_MODE 1" >>confdefs.h - - fi - - -ac_fn_c_check_decl "$LINENO" "strmode" "ac_cv_have_decl_strmode" "$ac_includes_default" -if test "x$ac_cv_have_decl_strmode" = x""yes; then : - ac_have_decl=1 -else - ac_have_decl=0 -fi - -cat >>confdefs.h <<_ACEOF -#define HAVE_DECL_STRMODE $ac_have_decl -_ACEOF - - - GNULIB__EXIT=0; - GNULIB_ATOLL=0; - GNULIB_CALLOC_POSIX=0; - GNULIB_CANONICALIZE_FILE_NAME=0; - GNULIB_GETLOADAVG=0; - GNULIB_GETSUBOPT=0; - GNULIB_GRANTPT=0; - GNULIB_MALLOC_POSIX=0; - GNULIB_MBTOWC=0; - GNULIB_MKDTEMP=0; - GNULIB_MKOSTEMP=0; - GNULIB_MKOSTEMPS=0; - GNULIB_MKSTEMP=0; - GNULIB_MKSTEMPS=0; - GNULIB_PTSNAME=0; - GNULIB_PUTENV=0; - GNULIB_RANDOM_R=0; - GNULIB_REALLOC_POSIX=0; - GNULIB_REALPATH=0; - GNULIB_RPMATCH=0; - GNULIB_SETENV=0; - GNULIB_STRTOD=0; - GNULIB_STRTOLL=0; - GNULIB_STRTOULL=0; - GNULIB_SYSTEM_POSIX=0; - GNULIB_UNLOCKPT=0; - GNULIB_UNSETENV=0; - GNULIB_WCTOMB=0; - HAVE__EXIT=1; - HAVE_ATOLL=1; - HAVE_CANONICALIZE_FILE_NAME=1; - HAVE_DECL_GETLOADAVG=1; - HAVE_GETSUBOPT=1; - HAVE_GRANTPT=1; - HAVE_MKDTEMP=1; - HAVE_MKOSTEMP=1; - HAVE_MKOSTEMPS=1; - HAVE_MKSTEMP=1; - HAVE_MKSTEMPS=1; - HAVE_PTSNAME=1; - HAVE_RANDOM_H=1; - HAVE_RANDOM_R=1; - HAVE_REALPATH=1; - HAVE_RPMATCH=1; - HAVE_SETENV=1; - HAVE_DECL_SETENV=1; - HAVE_STRTOD=1; - HAVE_STRTOLL=1; - HAVE_STRTOULL=1; - HAVE_STRUCT_RANDOM_DATA=1; - HAVE_SYS_LOADAVG_H=0; - HAVE_UNLOCKPT=1; - HAVE_DECL_UNSETENV=1; - REPLACE_CALLOC=0; - REPLACE_CANONICALIZE_FILE_NAME=0; - REPLACE_MALLOC=0; - REPLACE_MBTOWC=0; - REPLACE_MKSTEMP=0; - REPLACE_PUTENV=0; - REPLACE_REALLOC=0; - REPLACE_REALPATH=0; - REPLACE_SETENV=0; - REPLACE_STRTOD=0; - REPLACE_UNSETENV=0; - REPLACE_WCTOMB=0; - GNULIB_CHOWN=0; GNULIB_CLOSE=0; @@ -14520,6 +14565,121 @@ _ACEOF +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for st_dm_mode in struct stat" >&5 +$as_echo_n "checking for st_dm_mode in struct stat... " >&6; } +if test "${ac_cv_struct_st_dm_mode+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <sys/types.h> +#include <sys/stat.h> +int +main () +{ +struct stat s; s.st_dm_mode; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_struct_st_dm_mode=yes +else + ac_cv_struct_st_dm_mode=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_struct_st_dm_mode" >&5 +$as_echo "$ac_cv_struct_st_dm_mode" >&6; } + + if test $ac_cv_struct_st_dm_mode = yes; then + +$as_echo "#define HAVE_ST_DM_MODE 1" >>confdefs.h + + fi + + +ac_fn_c_check_decl "$LINENO" "strmode" "ac_cv_have_decl_strmode" "$ac_includes_default" +if test "x$ac_cv_have_decl_strmode" = x""yes; then : + ac_have_decl=1 +else + ac_have_decl=0 +fi + +cat >>confdefs.h <<_ACEOF +#define HAVE_DECL_STRMODE $ac_have_decl +_ACEOF + + + GNULIB__EXIT=0; + GNULIB_ATOLL=0; + GNULIB_CALLOC_POSIX=0; + GNULIB_CANONICALIZE_FILE_NAME=0; + GNULIB_GETLOADAVG=0; + GNULIB_GETSUBOPT=0; + GNULIB_GRANTPT=0; + GNULIB_MALLOC_POSIX=0; + GNULIB_MBTOWC=0; + GNULIB_MKDTEMP=0; + GNULIB_MKOSTEMP=0; + GNULIB_MKOSTEMPS=0; + GNULIB_MKSTEMP=0; + GNULIB_MKSTEMPS=0; + GNULIB_PTSNAME=0; + GNULIB_PUTENV=0; + GNULIB_RANDOM_R=0; + GNULIB_REALLOC_POSIX=0; + GNULIB_REALPATH=0; + GNULIB_RPMATCH=0; + GNULIB_SETENV=0; + GNULIB_STRTOD=0; + GNULIB_STRTOLL=0; + GNULIB_STRTOULL=0; + GNULIB_SYSTEM_POSIX=0; + GNULIB_UNLOCKPT=0; + GNULIB_UNSETENV=0; + GNULIB_WCTOMB=0; + HAVE__EXIT=1; + HAVE_ATOLL=1; + HAVE_CANONICALIZE_FILE_NAME=1; + HAVE_DECL_GETLOADAVG=1; + HAVE_GETSUBOPT=1; + HAVE_GRANTPT=1; + HAVE_MKDTEMP=1; + HAVE_MKOSTEMP=1; + HAVE_MKOSTEMPS=1; + HAVE_MKSTEMP=1; + HAVE_MKSTEMPS=1; + HAVE_PTSNAME=1; + HAVE_RANDOM_H=1; + HAVE_RANDOM_R=1; + HAVE_REALPATH=1; + HAVE_RPMATCH=1; + HAVE_SETENV=1; + HAVE_DECL_SETENV=1; + HAVE_STRTOD=1; + HAVE_STRTOLL=1; + HAVE_STRTOULL=1; + HAVE_STRUCT_RANDOM_DATA=1; + HAVE_SYS_LOADAVG_H=0; + HAVE_UNLOCKPT=1; + HAVE_DECL_UNSETENV=1; + REPLACE_CALLOC=0; + REPLACE_CANONICALIZE_FILE_NAME=0; + REPLACE_MALLOC=0; + REPLACE_MBTOWC=0; + REPLACE_MKSTEMP=0; + REPLACE_PUTENV=0; + REPLACE_REALLOC=0; + REPLACE_REALPATH=0; + REPLACE_SETENV=0; + REPLACE_STRTOD=0; + REPLACE_UNSETENV=0; + REPLACE_WCTOMB=0; + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the preprocessor supports include_next" >&5 $as_echo_n "checking whether the preprocessor supports include_next... " >&6; } if test "${gl_cv_have_include_next+set}" = set; then : @@ -16682,6 +16842,61 @@ fi 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 + + + + : @@ -16705,6 +16920,114 @@ fi +$as_echo "#define HAVE_DUP2 1" >>confdefs.h + + + if test $HAVE_DUP2 = 1; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether dup2 works" >&5 +$as_echo_n "checking whether dup2 works... " >&6; } +if test "${gl_cv_func_dup2_works+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + case "$host_os" in + mingw*) # on this platform, dup2 always returns 0 for success + gl_cv_func_dup2_works=no;; + cygwin*) # on cygwin 1.5.x, dup2(1,1) returns 0 + gl_cv_func_dup2_works=no;; + linux*) # On linux between 2008-07-27 and 2009-05-11, dup2 of a + # closed fd may yield -EBADF instead of -1 / errno=EBADF. + gl_cv_func_dup2_works=no;; + freebsd*) # on FreeBSD 6.1, dup2(1,1000000) gives EMFILE, not EBADF. + gl_cv_func_dup2_works=no;; + haiku*) # on Haiku alpha 2, dup2(1, 1) resets FD_CLOEXEC. + gl_cv_func_dup2_works=no;; + *) gl_cv_func_dup2_works=yes;; + esac +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include <unistd.h> +#include <fcntl.h> +#include <errno.h> +int +main () +{ +int result = 0; +#ifdef FD_CLOEXEC + if (fcntl (1, F_SETFD, FD_CLOEXEC) == -1) + result |= 1; +#endif + if (dup2 (1, 1) == 0) + result |= 2; +#ifdef FD_CLOEXEC + if (fcntl (1, F_GETFD) != FD_CLOEXEC) + result |= 4; +#endif + close (0); + if (dup2 (0, 0) != -1) + result |= 8; + /* Many gnulib modules require POSIX conformance of EBADF. */ + if (dup2 (2, 1000000) == -1 && errno != EBADF) + result |= 16; + return result; + + ; + return 0; +} + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + gl_cv_func_dup2_works=yes +else + gl_cv_func_dup2_works=no +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: $gl_cv_func_dup2_works" >&5 +$as_echo "$gl_cv_func_dup2_works" >&6; } + if test "$gl_cv_func_dup2_works" = no; then + + + + if test $ac_cv_func_dup2 = yes; then + REPLACE_DUP2=1 + fi + + + + + + + + + gl_LIBOBJS="$gl_LIBOBJS dup2.$ac_objext" + + + fi + fi + + + + + + + GNULIB_DUP2=1 + + + + + + + + + + # Persuade glibc <stdlib.h> to declare getloadavg(). @@ -18798,6 +19121,9 @@ fi if $condition; then func_gl_gnulib_m4code_dosname fi + if $condition; then + func_gl_gnulib_m4code_verify + fi fi } func_gl_gnulib_m4code_strtoull () @@ -20913,6 +21239,7 @@ echo " Does Emacs use imagemagick? ${HAVE_IMAGEMAGI echo " Does Emacs use -lgpm? ${HAVE_GPM}" echo " Does Emacs use -ldbus? ${HAVE_DBUS}" echo " Does Emacs use -lgconf? ${HAVE_GCONF}" +echo " Does Emacs use GSettings? ${HAVE_GSETTINGS}" echo " Does Emacs use -lselinux? ${HAVE_LIBSELINUX}" echo " Does Emacs use -lgnutls (2.6.x or higher)? ${HAVE_GNUTLS}" echo " Does Emacs use -lxml2? ${HAVE_LIBXML2}" @@ -21098,6 +21425,10 @@ if test -z "${GL_COND_LIBTOOL_TRUE}" && test -z "${GL_COND_LIBTOOL_FALSE}"; then 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. diff --git a/configure.in b/configure.in index fdeae8e6152..2c258174d46 100644 --- a/configure.in +++ b/configure.in @@ -172,6 +172,7 @@ OPTION_DEFAULT_OFF([ns],[use NeXTstep (Cocoa or GNUstep) windowing system]) OPTION_DEFAULT_ON([gpm],[don't use -lgpm for mouse support on a GNU/Linux console]) OPTION_DEFAULT_ON([dbus],[don't compile with D-Bus support]) OPTION_DEFAULT_ON([gconf],[don't compile with GConf support]) +OPTION_DEFAULT_ON([gsettings],[don't compile with GSettings support]) OPTION_DEFAULT_ON([selinux],[don't compile with SELinux support]) OPTION_DEFAULT_ON([gnutls],[don't use -lgnutls for SSL/TLS support]) @@ -988,54 +989,6 @@ dnl Do this early because it can frob feature test macros for Unix-98 &c. AC_SYS_LARGEFILE -## 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 - ## can be in a variety of places. We only try /usr/lib64 and /usr/lib. - ## For anything else (eg /usr/lib32), it is up the user to specify - ## the location (bug#5655). - ## Test for crtn.o, not just the directory, because sometimes the - ## directory exists but does not have the relevant files (bug#1287). - ## FIXME better to test for binary compatibility somehow. - test -e /usr/lib64/crtn.o && CRT_DIR=/usr/lib64 - ;; - - powerpc64-*-linux-gnu* | sparc64-*-linux-gnu*) CRT_DIR=/usr/lib64 ;; - esac - - case "$opsys" in - hpux10-20) CRT_DIR=/lib ;; - esac - - ## Default is /usr/lib. - test "X$CRT_DIR" = "X" && CRT_DIR=/usr/lib - - ## If we're using gcc, try to determine it automatically by asking - ## gcc. [If this doesn't work, CRT_DIR will remain at the - ## system-dependent default from above.] - if test "x${GCC}" = xyes; then - crt_file=`$CC --print-file-name=crt1.o 2>/dev/null` - case "$crt_file" in - */*) - CRT_DIR=`AS_DIRNAME(["$crt_file"])` - ;; - esac - fi - -else - - ## Some platforms don't use any of these files, so it is not - ## appropriate to put this test outside the if block. - test -e $CRT_DIR/crtn.o || test -e $CRT_DIR/crt0.o || \ - AC_MSG_ERROR([crt*.o not found in specified location.]) - -fi - -AC_SUBST(CRT_DIR) - LIB_MATH=-lm LIB_STANDARD= START_FILES= @@ -1076,6 +1029,80 @@ esac AC_SUBST(LIB_MATH) AC_SUBST(START_FILES) +dnl Not all platforms use crtn.o files. Check if the current one does. +crt_files= + +for file in x $LIB_STANDARD $START_FILES; do + case "$file" in + *CRT_DIR*) crt_files="$crt_files `echo $file | sed -e 's|.*/||'`" ;; + esac +done + +if test "x$crt_files" != x; then + + ## If user specified a crt-dir, use that unconditionally. + crt_gcc=no + + if test "X$CRT_DIR" = "X"; then + + CRT_DIR=/usr/lib # default + + case "$canonical" in + x86_64-*-linux-gnu* | s390x-*-linux-gnu*) + ## On x86-64 and s390x GNU/Linux distributions, the standard library + ## can be in a variety of places. We only try /usr/lib64 and /usr/lib. + ## For anything else (eg /usr/lib32), it is up the user to specify + ## the location (bug#5655). + ## Test for crtn.o, not just the directory, because sometimes the + ## directory exists but does not have the relevant files (bug#1287). + ## FIXME better to test for binary compatibility somehow. + test -e /usr/lib64/crtn.o && CRT_DIR=/usr/lib64 + ;; + + powerpc64-*-linux-gnu* | sparc64-*-linux-gnu*) CRT_DIR=/usr/lib64 ;; + esac + + case "$opsys" in + hpux10-20) CRT_DIR=/lib ;; + esac + + test "x${GCC}" = xyes && crt_gcc=yes + + fi # CRT_DIR = "" + + crt_missing= + + for file in $crt_files; do + + ## If we're using gcc, try to determine it automatically by asking + ## gcc. [If this doesn't work, CRT_DIR will remain at the + ## system-dependent default from above.] + if test $crt_gcc = yes && test ! -e $CRT_DIR/$file; then + + crt_file=`$CC --print-file-name=$file 2>/dev/null` + case "$crt_file" in + */*) + CRT_DIR=`AS_DIRNAME(["$crt_file"])` + ;; + esac + fi + + dnl We expect all the files to be in a single directory, so after the + dnl first there is no point asking gcc. + crt_gcc=no + + test -e $CRT_DIR/$file || crt_missing="$crt_missing $file" + done # $crt_files + + test "x$crt_missing" = x || \ + AC_MSG_ERROR([Required file(s) not found:$crt_missing +Try using the --with-crt-dir option.]) + +fi # crt_files != "" + +AC_SUBST(CRT_DIR) + + dnl This function definition taken from Gnome 2.0 dnl PKG_CHECK_MODULES(GSTUFF, gtk+-2.0 >= 1.3 glib = 1.3.4, action-if, action-not) dnl defines GSTUFF_LIBS, GSTUFF_CFLAGS, see pkg-config man page @@ -1955,6 +1982,17 @@ if test "${with_dbus}" = "yes"; then fi AC_SUBST(DBUS_OBJ) +dnl GSettings has been tested under GNU/Linux only. +HAVE_GSETTINGS=no +if test "${HAVE_X11}" = "yes" && test "${with_gsettings}" = "yes"; then + PKG_CHECK_MODULES(GSETTINGS, glib-2.0 >= 2.26, HAVE_GSETTINGS=yes, HAVE_GSETTINGS=no) + if test "$HAVE_GSETTINGS" = "yes"; then + AC_DEFINE(HAVE_GSETTINGS, 1, [Define to 1 if using GSettings.]) + SETTINGS_CFLAGS="$GSETTINGS_CFLAGS" + SETTINGS_LIBS="$GSETTINGS_LIBS" + fi +fi + dnl GConf has been tested under GNU/Linux only. dnl The version is really arbitrary, it is about the same age as Gtk+ 2.6. HAVE_GCONF=no @@ -1963,10 +2001,24 @@ if test "${HAVE_X11}" = "yes" && test "${with_gconf}" = "yes"; then if test "$HAVE_GCONF" = yes; then AC_DEFINE(HAVE_GCONF, 1, [Define to 1 if using GConf.]) dnl Newer GConf doesn't link with g_objects, so this is not defined. - AC_CHECK_FUNCS([g_type_init]) + SETTINGS_CFLAGS="$SETTINGS_CFLAGS $GCONF_CFLAGS" + SETTINGS_LIBS="$SETTINGS_LIBS $GCONF_LIBS" fi fi +if test "$HAVE_GSETTINGS" = "yes" || test "$HAVE_GCONF" = "yes"; then + SAVE_CFLAGS="$CFLAGS" + SAVE_LDFLAGS="$LDFLAGS" + CFLAGS="$SETTINGS_CFLAGS $CFLAGS" + LDFLAGS="$SETTINGS_LIBS $LDFLAGS" + AC_CHECK_FUNCS([g_type_init]) + CFLAGS="$SAVE_CFLAGS" + LDFLAGS="$SAVE_LDFLAGS" +fi +AC_SUBST(SETTINGS_CFLAGS) +AC_SUBST(SETTINGS_LIBS) + + dnl SELinux is available for GNU/Linux only. HAVE_LIBSELINUX=no LIBSELINUX_LIBS= @@ -2645,7 +2697,7 @@ esac AC_SUBST(BLESSMAIL_TARGET) -AC_CHECK_FUNCS(gethostname getdomainname dup2 \ +AC_CHECK_FUNCS(gethostname getdomainname \ rename closedir mkdir rmdir sysinfo getrusage get_current_dir_name \ random lrand48 logb frexp fmod rint cbrt ftime setsid \ strerror fpathconf select euidaccess getpagesize tzset setlocale \ @@ -3648,6 +3700,7 @@ echo " Does Emacs use imagemagick? ${HAVE_IMAGEMAGI echo " Does Emacs use -lgpm? ${HAVE_GPM}" echo " Does Emacs use -ldbus? ${HAVE_DBUS}" echo " Does Emacs use -lgconf? ${HAVE_GCONF}" +echo " Does Emacs use GSettings? ${HAVE_GSETTINGS}" echo " Does Emacs use -lselinux? ${HAVE_LIBSELINUX}" echo " Does Emacs use -lgnutls (2.6.x or higher)? ${HAVE_GNUTLS}" echo " Does Emacs use -lxml2? ${HAVE_LIBXML2}" diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index 8853eb099d6..aca1ccc663e 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,3 +1,39 @@ +2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * display.texi (Scrolling): `C-v' (etc) are now bound to + `scroll-*-command' (bug#8349). + +2011-07-02 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * dired.texi (Subdirectories in Dired): Clarify that `C-u k' + doesn't actually delete any files (bug#7125). + + * picture-xtra.texi (Rectangles in Picture): Clarify the prefix + argument for `C-c C-k' (bug#7391). + + * frames.texi (Fonts): Mention "C-u C-x =" to find out what font + you're currently using (bug#8489). + +2011-07-01 Eli Zaretskii <eliz@gnu.org> + + * mule.texi (Coding Systems): Move index entries from the previous + change into their proper places. + +2011-07-01 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * help.texi (Help Files): Document view-external-packages (bug#8902). + + * mule.texi (Coding Systems): Put a few more of the coding systems + into the index (bug#8900). + +2011-06-26 Glenn Morris <rgm@gnu.org> + + * fortran-xtra.texi (Fortran): F90 mode is also for F2008. + +2011-06-25 Andreas Rottmann <a.rottmann@gmx.at> + + * misc.texi (emacsclient Options): Mention --frame-parameters. + 2011-06-09 Glenn Morris <rgm@gnu.org> * custom.texi (Specifying File Variables): diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 2f274d7a324..fb3521e4316 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -984,8 +984,9 @@ to the parent directory in the same Dired buffer. Use the @kbd{l} command (@code{dired-do-redisplay}) to update the subdirectory's contents. Use @kbd{C-u k} on the subdirectory header -line to delete the subdirectory (@pxref{Dired Updating}). You can also -hide and show inserted subdirectories (@pxref{Hiding Subdirectories}). +line to remove the subdirectory listing (@pxref{Dired Updating}). You +can also hide and show inserted subdirectories (@pxref{Hiding +Subdirectories}). @ifnottex @include dired-xtra.texi @@ -1145,9 +1146,9 @@ current file as a last resort. If you use @kbd{k} with a numeric prefix argument to kill the line for a file that is a directory, which you have inserted in the Dired -buffer as a subdirectory, it deletes that subdirectory from the buffer -as well. Typing @kbd{C-u k} on the header line for a subdirectory -also deletes the subdirectory from the Dired buffer. +buffer as a subdirectory, it removed that subdirectory line from the +buffer as well. Typing @kbd{C-u k} on the header line for a +subdirectory also removes the subdirectory line from the Dired buffer. The @kbd{g} command brings back any individual lines that you have killed in this way, but not subdirectories---you must use @kbd{i} to diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 3cec3e8fb8b..210b1b636a1 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -61,11 +61,11 @@ order; also, maybe redisplay the screen (@code{recenter-top-bottom}). @item C-v @itemx @key{next} @itemx @key{PageDown} -Scroll forward by nearly a full window (@code{scroll-up}). +Scroll forward by nearly a full window (@code{scroll-up-command}). @item M-v @itemx @key{prior} @itemx @key{PageUp} -Scroll backward (@code{scroll-down}). +Scroll backward (@code{scroll-down-command}). @item C-M-l Scroll heuristically to bring useful information onto the screen (@code{reposition-window}). diff --git a/doc/emacs/fortran-xtra.texi b/doc/emacs/fortran-xtra.texi index 8f92df3f3ae..b7a4ef973ea 100644 --- a/doc/emacs/fortran-xtra.texi +++ b/doc/emacs/fortran-xtra.texi @@ -10,12 +10,12 @@ @cindex mode, Fortran @cindex Fortran fixed form and free form -@cindex Fortran 77 and Fortran 90, 95, 2003 +@cindex Fortran 77 and Fortran 90, 95, 2003, 2008 @findex f90-mode @findex fortran-mode Fortran mode is meant for editing ``fixed form'' (and also ``tab format'') source code (normally Fortran 77). For editing more modern -``free form'' source code (Fortran 90, 95, 2003), use F90 mode +``free form'' source code (Fortran 90, 95, 2003, 2008), use F90 mode (@code{f90-mode}). Emacs normally uses Fortran mode for files with extension @samp{.f}, @samp{.F} or @samp{.for}, and F90 mode for the extensions @samp{.f90} and @samp{.f95}. Customize diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index 298a7d4598b..633b65251e4 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -689,6 +689,11 @@ Use the command line option @samp{-fn} (or @samp{--font}). @xref{Font X}. @end itemize +To check what font you're currently using, the @kbd{C-u C-x =} +command can be helpful. It'll describe the character under point, and +also say what font it's rendered in, if the window system you're +running under supports that. + @cindex fontconfig On X, there are four different ways to express a ``font name''. The first is to use a @dfn{Fontconfig pattern}. Fontconfig patterns have diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 2c3630adba4..e00f8b9115a 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -630,6 +630,9 @@ Display the Emacs copying conditions (@code{describe-copying}). These are the rules under which you can copy and redistribute Emacs. @item C-h C-d Display help for debugging Emacs (@code{view-emacs-debugging}). +@item C-h C-e +Display external packages and information about Emacs +(@code{view-external-packages}). @item C-h C-f Display the Emacs frequently-answered-questions list (@code{view-emacs-FAQ}). @item C-h g diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 290e5dc53bf..f83ac38469a 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -1623,6 +1623,11 @@ text-only terminal frame (@pxref{Frames}). If you omit a filename argument while supplying the @samp{-c} option, the new frame displays the @samp{*scratch*} buffer (@pxref{Buffers}). +@item -F +@itemx --frame-parameters=@var{alist} +Set the parameters for a newly-created graphical frame +(@pxref{Frame Parameters}). + @item -d @var{display} @itemx --display=@var{display} Tell Emacs to open the given files on the X display @var{display} diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi index a721e0c204b..3f3da503769 100644 --- a/doc/emacs/mule.texi +++ b/doc/emacs/mule.texi @@ -761,6 +761,7 @@ aliases for @code{undecided-unix}, @code{undecided-dos}, and the end-of-line conversion, and leave the character code conversion to be deduced from the text itself. +@cindex @code{raw-text}, coding system The coding system @code{raw-text} is good for a file which is mainly @acronym{ASCII} text, but may contain byte values above 127 which are not meant to encode non-@acronym{ASCII} characters. With @@ -771,6 +772,7 @@ end-of-line conversion in the usual way, based on the data encountered, and has the usual three variants to specify the kind of end-of-line conversion to use. +@cindex @code{no-conversion}, coding system In contrast, the coding system @code{no-conversion} specifies no character code conversion at all---none for non-@acronym{ASCII} byte values and none for end of line. This is useful for reading or writing binary @@ -782,6 +784,7 @@ the @kbd{M-x find-file-literally} command. This uses @code{no-conversion}, and also suppresses other Emacs features that might convert the file contents before you see them. @xref{Visiting}. +@cindex @code{emacs-internal}, coding system The coding system @code{emacs-internal} (or @code{utf-8-emacs}, which is equivalent) means that the file contains non-@acronym{ASCII} characters stored with the internal Emacs encoding. This coding diff --git a/doc/emacs/picture-xtra.texi b/doc/emacs/picture-xtra.texi index 7e72fb0acb6..0dcfc7a9627 100644 --- a/doc/emacs/picture-xtra.texi +++ b/doc/emacs/picture-xtra.texi @@ -245,7 +245,8 @@ rectangle commands may also be useful. @table @kbd @item C-c C-k Clear out the region-rectangle with spaces -(@code{picture-clear-rectangle}). With argument, delete the text. +(@code{picture-clear-rectangle}). With a prefix argument, delete the +text. @item C-c C-w @var{r} Similar, but save rectangle contents in register @var{r} first (@code{picture-clear-rectangle-to-register}). diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index b6b02686caf..23ddf0c5ad1 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,64 @@ +2011-07-06 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * functions.texi (Calling Functions): Link to the "Interactive + Call" node (bug#1001). + +2011-07-06 Chong Yidong <cyd@stupidchicken.com> + + * customize.texi (Composite Types): Move alist and plist to here + from Simple Types (Bug#7545). + + * elisp.texi (Top): Update menu description. + + * display.texi (Face Attributes): Document negative line widths + (Bug#6113). + +2011-07-03 Tobias C. Rittweiler <tcr@freebits.de> (tiny change) + + * searching.texi (Match Data): Note that match data can be + overwritten by most functions (bug#2499). + +2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * strings.texi (Formatting Strings): Clarify what the "-" and "0" + flags mean (bug#6659). + + * functions.texi (What Is a Function): Document the autoload + object (bug#6496). + +2011-07-02 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * customize.texi (Variable Definitions): Clarify that SETFUNCTION + is only used in the Customize user interface (bug#6089). + + * display.texi (Showing Images): Mention the point of sliced + images (bug#7836). + +2011-07-02 Eli Zaretskii <eliz@gnu.org> + + * variables.texi (Defining Variables, Void Variables) + (Constant Variables): Fix incorrect usage of @kindex. + +2011-07-02 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * variables.texi (Defining Variables): Add an index entry for + `set-variable' (bug#7262). + (Defining Variables): Use @findex for functions. + + * frames.texi (Basic Parameters): Document the `explicit-name' + parameter (bug#6951). + + * customize.texi (Type Keywords): Clarify that :value provides a + default value for all types (bug#7386). + + * streams.texi (Output Functions): Document `pp'. + +2011-06-25 Chong Yidong <cyd@stupidchicken.com> + + * keymaps.texi (Searching Keymaps): + * display.texi (Overlay Properties): Fix errors in 2011-05-29 + change. Suggested by Johan BockgĂĄrd. + 2011-06-15 Chong Yidong <cyd@stupidchicken.com> * text.texi (Special Properties): Clarify role of font-lock-face. diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi index e58c8c298c9..868edaa5bd4 100644 --- a/doc/lispref/customize.texi +++ b/doc/lispref/customize.texi @@ -326,11 +326,12 @@ individual types for a description of how to use @code{:options}. @item :set @var{setfunction} @kindex set@r{, @code{defcustom} keyword} Specify @var{setfunction} as the way to change the value of this -option. The function @var{setfunction} should take two arguments, a -symbol (the option name) and the new value, and should do whatever is -necessary to update the value properly for this option (which may not -mean simply setting the option as a Lisp variable). The default for -@var{setfunction} is @code{set-default}. +option when using the Customize user interface. The function +@var{setfunction} should take two arguments, a symbol (the option +name) and the new value, and should do whatever is necessary to update +the value properly for this option (which may not mean simply setting +the option as a Lisp variable). The default for @var{setfunction} is +@code{set-default}. @item :get @var{getfunction} @kindex get@r{, @code{defcustom} keyword} @@ -512,8 +513,7 @@ equivalent to @code{(string)}. Introduction, widget, The Emacs Widget Library}, for details. @menu -* Simple Types:: Simple customization types: sexp, integer, number, - string, file, directory, alist. +* Simple Types:: Simple customization types: sexp, integer, etc. * Composite Types:: Build new types from other types or data. * Splicing into Lists:: Splice elements into list with @code{:inline}. * Type Keywords:: Keyword-argument pairs in a customization type. @@ -576,22 +576,103 @@ You can use the @code{:options} keyword in a hook variable's @code{defcustom} to specify a list of functions recommended for use in the hook; see @ref{Variable Definitions}. -@item alist -The value must be a list of cons-cells, the @sc{car} of each cell -representing a key, and the @sc{cdr} of the same cell representing an -associated value. The user can add and delete key/value pairs, and -edit both the key and the value of each pair. +@item symbol +The value must be a symbol. It appears in the customization buffer as +the name of the symbol. -You can specify the key and value types like this: +@item function +The value must be either a lambda expression or a function name. When +it is a function name, you can do completion with @kbd{M-@key{TAB}}. -@smallexample -(alist :key-type @var{key-type} :value-type @var{value-type}) -@end smallexample +@item variable +The value must be a variable name, and you can do completion with +@kbd{M-@key{TAB}}. + +@item face +The value must be a symbol which is a face name, and you can do +completion with @kbd{M-@key{TAB}}. + +@item boolean +The value is boolean---either @code{nil} or @code{t}. Note that by +using @code{choice} and @code{const} together (see the next section), +you can specify that the value must be @code{nil} or @code{t}, but also +specify the text to describe each value in a way that fits the specific +meaning of the alternative. + +@item coding-system +The value must be a coding-system name, and you can do completion with +@kbd{M-@key{TAB}}. + +@item color +The value must be a valid color name, and you can do completion with +@kbd{M-@key{TAB}}. A sample is provided. +@end table + +@node Composite Types +@subsection Composite Types +@cindex composite types (customization) + + When none of the simple types is appropriate, you can use composite +types, which build new types from other types or from specified data. +The specified types or data are called the @dfn{arguments} of the +composite type. The composite type normally looks like this: + +@example +(@var{constructor} @var{arguments}@dots{}) +@end example @noindent -where @var{key-type} and @var{value-type} are customization type -specifications. The default key type is @code{sexp}, and the default -value type is @code{sexp}. +but you can also add keyword-value pairs before the arguments, like +this: + +@example +(@var{constructor} @r{@{}@var{keyword} @var{value}@r{@}}@dots{} @var{arguments}@dots{}) +@end example + + Here is a table of constructors and how to use them to write +composite types: + +@table @code +@item (cons @var{car-type} @var{cdr-type}) +The value must be a cons cell, its @sc{car} must fit @var{car-type}, and +its @sc{cdr} must fit @var{cdr-type}. For example, @code{(cons string +symbol)} is a customization type which matches values such as +@code{("foo" . foo)}. + +In the customization buffer, the @sc{car} and the @sc{cdr} are +displayed and edited separately, each according to the type +that you specify for it. + +@item (list @var{element-types}@dots{}) +The value must be a list with exactly as many elements as the +@var{element-types} given; and each element must fit the +corresponding @var{element-type}. + +For example, @code{(list integer string function)} describes a list of +three elements; the first element must be an integer, the second a +string, and the third a function. + +In the customization buffer, each element is displayed and edited +separately, according to the type specified for it. + +@item (group @var{element-types}@dots{}) +This works like @code{list} except for the formatting +of text in the Custom buffer. @code{list} labels each +element value with its tag; @code{group} does not. + +@item (vector @var{element-types}@dots{}) +Like @code{list} except that the value must be a vector instead of a +list. The elements work the same as in @code{list}. + +@item (alist :key-type @var{key-type} :value-type @var{value-type}) +The value must be a list of cons-cells, the @sc{car} of each cell +representing a key of customization type @var{key-type}, and the +@sc{cdr} of the same cell representing a value of customization type +@var{value-type}. The user can add and delete key/value pairs, and +edit both the key and the value of each pair. + +If omitted, @var{key-type} and @var{value-type} default to +@code{sexp}. The user can add any key matching the specified key type, but you can give some keys a preferential treatment by specifying them with the @@ -686,105 +767,11 @@ and the VALUE is a list of that person's pets." :type '(alist :value-type (repeat string))) @end smallexample -@item plist -The @code{plist} custom type is similar to the @code{alist} (see above), -except that the information is stored as a property list, i.e. a list of -this form: - -@smallexample -(@var{key} @var{value} @var{key} @var{value} @var{key} @var{value} @dots{}) -@end smallexample - -The default @code{:key-type} for @code{plist} is @code{symbol}, -rather than @code{sexp}. - -@item symbol -The value must be a symbol. It appears in the customization buffer as -the name of the symbol. - -@item function -The value must be either a lambda expression or a function name. When -it is a function name, you can do completion with @kbd{M-@key{TAB}}. - -@item variable -The value must be a variable name, and you can do completion with -@kbd{M-@key{TAB}}. - -@item face -The value must be a symbol which is a face name, and you can do -completion with @kbd{M-@key{TAB}}. - -@item boolean -The value is boolean---either @code{nil} or @code{t}. Note that by -using @code{choice} and @code{const} together (see the next section), -you can specify that the value must be @code{nil} or @code{t}, but also -specify the text to describe each value in a way that fits the specific -meaning of the alternative. - -@item coding-system -The value must be a coding-system name, and you can do completion with -@kbd{M-@key{TAB}}. - -@item color -The value must be a valid color name, and you can do completion with -@kbd{M-@key{TAB}}. A sample is provided. -@end table - -@node Composite Types -@subsection Composite Types -@cindex composite types (customization) - - When none of the simple types is appropriate, you can use composite -types, which build new types from other types or from specified data. -The specified types or data are called the @dfn{arguments} of the -composite type. The composite type normally looks like this: - -@example -(@var{constructor} @var{arguments}@dots{}) -@end example - -@noindent -but you can also add keyword-value pairs before the arguments, like -this: - -@example -(@var{constructor} @r{@{}@var{keyword} @var{value}@r{@}}@dots{} @var{arguments}@dots{}) -@end example - - Here is a table of constructors and how to use them to write -composite types: - -@table @code -@item (cons @var{car-type} @var{cdr-type}) -The value must be a cons cell, its @sc{car} must fit @var{car-type}, and -its @sc{cdr} must fit @var{cdr-type}. For example, @code{(cons string -symbol)} is a customization type which matches values such as -@code{("foo" . foo)}. - -In the customization buffer, the @sc{car} and the @sc{cdr} are -displayed and edited separately, each according to the type -that you specify for it. - -@item (list @var{element-types}@dots{}) -The value must be a list with exactly as many elements as the -@var{element-types} given; and each element must fit the -corresponding @var{element-type}. - -For example, @code{(list integer string function)} describes a list of -three elements; the first element must be an integer, the second a -string, and the third a function. - -In the customization buffer, each element is displayed and edited -separately, according to the type specified for it. - -@item (group @var{element-types}@dots{}) -This works like @code{list} except for the formatting -of text in the Custom buffer. @code{list} labels each -element value with its tag; @code{group} does not. - -@item (vector @var{element-types}@dots{}) -Like @code{list} except that the value must be a vector instead of a -list. The elements work the same as in @code{list}. +@item (plist :key-type @var{key-type} :value-type @var{value-type}) +This customization type is similar to @code{alist} (see above), except +that (i) the information is stored as a property list, +(@pxref{Property Lists}), and (ii) @var{key-type}, if omitted, +defaults to @code{symbol} rather than @code{sexp}. @item (choice @var{alternative-types}@dots{}) The value must fit at least one of @var{alternative-types}. @@ -1035,7 +1022,12 @@ meanings: @table @code @item :value @var{default} -This is used for a type that appears as an alternative inside of +Provide a default value. + +If @code{nil} is not a valid value for the alternative, then it is +essential to specify a valid default with @code{:value}. + +If you use this for a type that appears as an alternative inside of @code{choice}; it specifies the default value to use, at first, if and when the user selects this alternative with the menu in the customization buffer. @@ -1043,9 +1035,6 @@ customization buffer. Of course, if the actual value of the option fits this alternative, it will appear showing the actual value, not @var{default}. -If @code{nil} is not a valid value for the alternative, then it is -essential to specify a valid default with @code{:value}. - @item :format @var{format-string} @kindex format@r{, customization keyword} This string will be inserted in the buffer to represent the value diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 199a20cc2cd..bc81c59f05f 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -1441,9 +1441,9 @@ specify a particular attribute for certain text. @xref{Face Attributes}. @item -A cons cell, either of the form @code{(fg-color . @var{color-name})} -or @code{(bg-color . @var{color-name})}. These elements specify just -the foreground color or just the background color. +A cons cell, of the form @code{(foreground-color . @var{color-name})} +or @code{(background-color . @var{color-name})}. These elements +specify just the foreground color or just the background color. @code{(foreground-color . @var{color-name})} has the same effect as @code{(:foreground @var{color-name})}; likewise for the background. @@ -2092,7 +2092,10 @@ Draw a box with lines of width 1, in color @var{color}. @item @code{(:line-width @var{width} :color @var{color} :style @var{style})} This way you can explicitly specify all aspects of the box. The value -@var{width} specifies the width of the lines to draw; it defaults to 1. +@var{width} specifies the width of the lines to draw; it defaults to +1. A negative width @var{-n} means to draw a line of width @var{n} +that occupies the space of the underlying text, thus avoiding any +increase in the character height or width. The value @var{color} specifies the color to draw with. The default is the foreground color of the face for simple boxes, and the background @@ -4700,10 +4703,17 @@ it a @code{display} property which specifies @var{image}. @xref{Display Property}. @end defun +@cindex slice, image +@cindex image slice @defun insert-sliced-image image &optional string area rows cols This function inserts @var{image} in the current buffer at point, like @code{insert-image}, but splits the image into @var{rows}x@var{cols} equally sized slices. + +If an image is inserted ``sliced'', then the Emacs display engine will +treat each slice as a separate image, and allow more intuitive +scrolling up/down, instead of jumping up/down the entire image when +paging through a buffer that displays (large) images. @end defun @defun put-image image pos &optional string area diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 264d63511bc..29b3e398f4b 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -508,8 +508,7 @@ Writing Customization Definitions Customization Types -* Simple Types:: Simple customization types: sexp, integer, number, - string, file, directory, alist. +* Simple Types:: Simple customization types: sexp, integer, etc. * Composite Types:: Build new types from other types or data. * Splicing into Lists:: Splice elements into list with @code{:inline}. * Type Keywords:: Keyword-argument pairs in a customization type. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index c5136456177..ee765a7e1d0 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -520,6 +520,11 @@ you don't specify a name, Emacs sets the frame name automatically If you specify the frame name explicitly when you create the frame, the name is also used (instead of the name of the Emacs executable) when looking up X resources for the frame. + +@item explicit-name +If the frame name was specified explicitly when the frame was created, +this parameter will be that name. If the frame wasn't explicitly +named, this parameter will be @code{nil}. @end table @node Position Parameters diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 974487382c8..f3b2375b61d 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -112,6 +112,13 @@ editors; for Lisp programs, the distinction is normally unimportant. @item byte-code function A @dfn{byte-code function} is a function that has been compiled by the byte compiler. @xref{Byte-Code Type}. + +@item autoload object +@cindex autoload object +An @dfn{autoload object} is a place-holder for a real function. If +the autoload object is called, it will make Emacs load the file +containing the definition of the real function, and then call the real +function instead. @end table @defun functionp object @@ -783,6 +790,12 @@ This function returns @var{arg} and has no side effects. This function ignores any arguments and returns @code{nil}. @end defun + Emacs Lisp functions can also be user-visible @dfn{commands}. A +command is a function that has an @dfn{interactive} specification. +You may want to call these functions as if they were called +interactively. See @ref{Interactive Call} for details on how to do +that. + @node Mapping Functions @section Mapping Functions @cindex mapping functions diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index d55cb299771..cf1db5b7fce 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -723,13 +723,13 @@ them: (@var{find-in} overriding-terminal-local-map)) (overriding-local-map (@var{find-in} overriding-local-map)) - (or (@var{find-in} (get-char-property (point) 'keymap)) - (@var{find-in-any} emulation-mode-map-alists) - (@var{find-in-any} minor-mode-overriding-map-alist) - (@var{find-in-any} minor-mode-map-alist) - (if (get-text-property (point) 'local-map) - (@var{find-in} (get-char-property (point) 'local-map)) - (@var{find-in} (current-local-map))))) + ((or (@var{find-in} (get-char-property (point) 'keymap)) + (@var{find-in-any} emulation-mode-map-alists) + (@var{find-in-any} minor-mode-overriding-map-alist) + (@var{find-in-any} minor-mode-map-alist) + (if (get-text-property (point) 'local-map) + (@var{find-in} (get-char-property (point) 'local-map)) + (@var{find-in} (current-local-map)))))) (@var{find-in} (current-global-map))) @end lisp diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi index 27b089f75b6..6272301dbb4 100644 --- a/doc/lispref/searching.texi +++ b/doc/lispref/searching.texi @@ -1207,6 +1207,12 @@ search you wish to refer back to and the use of the match data. If you can't avoid another intervening search, you must save and restore the match data around it, to prevent it from being overwritten. + Notice that all functions are allowed to overwrite the match data +unless they're explicitly documented not to do so. A consequence is +that functions that are run implictly in the background +(@pxref{Timers}, and @ref{Idle Timers}) should likely save and restore +the match data explicitly. + @menu * Replacing Match:: Replacing a substring that was matched. * Simple Match Data:: Accessing single items of match data, diff --git a/doc/lispref/streams.texi b/doc/lispref/streams.texi index 9802c7485dd..4d3a66d8852 100644 --- a/doc/lispref/streams.texi +++ b/doc/lispref/streams.texi @@ -684,6 +684,12 @@ For example, if the current buffer name is @samp{foo}, returns @code{"The buffer is foo"}. @end defmac +@defun pp object &optional stream +This function outputs @var{object} to @var{stream}, just like +@code{prin1}, but does it in a more ``pretty'' way. That is, it'll +indent and fill the object to make it more readable for humans. +@end defun + @node Output Variables @section Variables Affecting Output @cindex output-controlling variables diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 05ac40e90c1..2b8911277cd 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -856,14 +856,16 @@ with @samp{0x} or @samp{0X}. For @samp{%e}, @samp{%f}, and @samp{%g}, the @samp{#} flag means include a decimal point even if the precision is zero. + The flag @samp{0} ensures that the padding consists of @samp{0} +characters instead of spaces. This flag is ignored for non-numerical +specification characters like @samp{%s}, @samp{%S} and @samp{%c}. +These specification characters accept the @samp{0} flag, but still pad +with @emph{spaces}. + The flag @samp{-} causes the padding inserted by the width specifier, if any, to be inserted on the right rather than the left. -The flag @samp{0} ensures that the padding consists of @samp{0} -characters instead of spaces, inserted on the left. These flags are -ignored for specification characters for which they do not make sense: -@samp{%s}, @samp{%S} and @samp{%c} accept the @samp{0} flag, but still -pad with @emph{spaces} on the left. If both @samp{-} and @samp{0} are -present and valid, @samp{-} takes precedence. +If both @samp{-} and @samp{0} are present, the @samp{0} flag is +ignored. @example @group diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 08712466b5c..4ec1779b732 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -99,7 +99,7 @@ x @node Constant Variables @section Variables that Never Change -@kindex setting-constant +@cindex @code{setting-constant} error @cindex keyword symbol @cindex variable with constant value @cindex constant variables @@ -288,7 +288,7 @@ has room to execute. @node Void Variables @section When a Variable is ``Void'' -@kindex void-variable +@cindex @code{void-variable} error @cindex void variable If you have never given a symbol any value as a global variable, we @@ -583,7 +583,8 @@ and is a string, and its first character is @samp{*}, then the variable is a user option. Aliases of user options are also user options. @end defun -@kindex variable-interactive +@cindex @code{variable-interactive} property +@findex set-variable If a user option variable has a @code{variable-interactive} property, the @code{set-variable} command uses that value to control reading the new value for the variable. The property's value is used as if it were diff --git a/doc/man/ChangeLog b/doc/man/ChangeLog index 06ff5782003..88f70e410c8 100644 --- a/doc/man/ChangeLog +++ b/doc/man/ChangeLog @@ -1,3 +1,7 @@ +2011-06-25 Andreas Rottmann <a.rottmann@gmx.at> + + * emacsclient.1: Mention --frame-parameters. + 2011-03-07 Chong Yidong <cyd@stupidchicken.com> * Version 23.3 released. diff --git a/doc/man/emacsclient.1 b/doc/man/emacsclient.1 index cae4d76634b..4843053666a 100644 --- a/doc/man/emacsclient.1 +++ b/doc/man/emacsclient.1 @@ -58,6 +58,9 @@ daemon mode and emacsclient will try to connect to it. .B -c, \-\-create-frame create a new frame instead of trying to use the current Emacs frame .TP +.B \-F, \-\-frame-parameters=ALIST +set the parameters of a newly-created frame. +.TP .B \-d, \-\-display=DISPLAY tell the server to display the files on the given display. .TP diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 9181bb81e7a..ff5831caa12 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,50 @@ +2011-07-05 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Expiring Mail): Document gnus-auto-expirable-marks. + (Filtering New Groups): Clarify how simple the "options -n" format is. + (Agent Expiry): Remove mention of `gnus-request-expire-articles', which + is internal. + +2011-07-04 Michael Albinus <michael.albinus@gmx.de> + + * tramp.texi (Cleanup remote connections): Add + `tramp-cleanup-this-connection'. + +2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Subscription Methods): Link to "Group Levels" to explain + zombies. + (Checking New Groups): Ditto (bug#8974). + (Checking New Groups): Moved the reference to the right place. + +2011-07-03 Dave Abrahams <dave@boostpro.com> (tiny change) + + * gnus.texi (Startup Files): Clarify that we're talking about numbered + backups, and not actual vc (bug#8975). + +2011-07-03 Kevin Ryde <user42@zip.com.au> + + * cl.texi (For Clauses): @items for hash-values and key-bindings + to make them more visible when skimming. Add examples of `using' + clause to them, examples being clearer than a description in + words (bug#6599). + +2011-07-01 Alan Mackenzie <acm@muc.de> + + * cc-mode.texi (Guessing the Style): New page. + (Styles): Add a short introduction to above. + +2011-06-28 Deniz Dogan <deniz@dogan.se> + + * rcirc.texi (Configuration): Bug-fix: + `rcirc-default-user-full-name' is now `rcirc-default-full-name'. + Reported by Elias Pipping <pipping@exherbo.org>. + +2011-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Summary Mail Commands): Document + `gnus-summary-reply-to-list-with-original'. + 2011-06-20 Stefan Monnier <monnier@iro.umontreal.ca> * eshell.texi (Known problems): Fix typo. diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index 9ae9abd5e1a..a9339162666 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -287,10 +287,11 @@ Configuration Basics Styles -* Built-in Styles:: -* Choosing a Style:: -* Adding Styles:: -* File Styles:: +* Built-in Styles:: +* Choosing a Style:: +* Adding Styles:: +* Guessing the Style:: +* File Styles:: Customizing Auto-newlines @@ -2511,14 +2512,18 @@ groupings of customizations called @dfn{styles}, associate a single name for any particular style, and pretty easily start editing new or existing code using these styles. +As an alternative to writing a style definition yourself, you can have +@ccmode{} @dfn{guess} (at least part of) your style by looking at an +already formatted piece of your code, @ref{Guessing the Style}. + @menu -* Built-in Styles:: -* Choosing a Style:: -* Adding Styles:: -* File Styles:: +* Built-in Styles:: +* Choosing a Style:: +* Adding Styles:: +* Guessing the Style:: +* File Styles:: @end menu - @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @node Built-in Styles, Choosing a Style, Styles, Styles @comment node-name, next, previous, up @@ -2653,9 +2658,8 @@ This variable always contains the buffer's current style name, as a string. @end defvar - @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -@node Adding Styles, File Styles, Choosing a Style, Styles +@node Adding Styles, Guessing the Style, Choosing a Style, Styles @comment node-name, next, previous, up @subsection Adding and Amending Styles @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -2742,9 +2746,131 @@ This is the variable that holds the definitions for the styles. It should not be changed directly; use @code{c-add-style} instead. @end defvar +@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +@node Guessing the Style, File Styles, Adding Styles, Styles +@comment node-name, next, previous, up +@subsection Guessing the Style +@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +Instead of specifying a style, you can get @ccmode{} to @dfn{guess} +your style by examining an already formatted code buffer. @ccmode{} +then determines the ''most frequent'' offset (@pxref{c-offsets-alist}) +for each of the syntactic symbols (@pxref{Indentation Engine Basics}) +encountered in the buffer, and the ''most frequent'' value of +c-basic-offset (@pxref{Customizing Indentation}), then merges the +current style with these ''guesses'' to form a new style. This +combined style is known as the @dfn{guessed style}. + +To do this, call @code{c-guess} (or one of the other 5 guessing +commands) on your sample buffer. The analysis of your code may take +some time. + +You can then set the guessed style in any @ccmode{} buffer with +@code{c-guess-install}. You can display the style with +@code{c-guess-view}, and preserve it by copying it into your +@file{.emacs} for future use, preferably after editing it. + +@table @asis +@item @kbd{M-x c-guess-no-install} +@itemx @kbd{M-x c-guess-buffer-no-install} +@itemx @kbd{M-x c-guess-region-no-install} +@findex c-guess-no-install +@findex c-guess-buffer-no-install +@findex c-guess-region-no-install +@findex guess-no-install (c-) +@findex guess-buffer-no-install (c-) +@findex guess-region-no-install (c-) +These commands analyze a part of the current buffer and guess the +style from it. + +The part of the buffer examined is either the region +(@code{c-guess-region-no-install}), the entire buffer +(@code{c-guess-buffer-no-install}), or the first +@code{c-guess-region-max} bytes (@code{c-guess-no-install}). + +Each of these commands can be given an optional prefix argument. This +instructs @ccmode{} to combine the new guesses with the current +guesses before forming the guessed style. +@end table + +@table @asis +@item @kbd{M-x c-guess} +@itemx @kbd{M-x c-guess-buffer} +@itemx @kbd{M-x c-guess-region} +@findex c-guess +@findex c-guess-buffer +@findex c-guess-region +@findex guess (c-) +@findex guess-buffer (c-) +@findex guess-region (c-) +These commands analyze a part of the current buffer, guess the style +from it, then install the guessed style on the buffer. The guessed +style is given a name based on the buffer's absolute file name, and +you can then set this style on any @ccmode{} buffer with @kbd{C-c .}. + +The part of the buffer examined is either the region +(@code{c-guess-region}), the entire buffer (@code{c-guess-buffer}), or +the first @code{c-guess-region-max} bytes (@code{c-guess}). + +Each of these commands can be given an optional prefix argument. This +instructs @ccmode{} to combine the new guesses with the current +guesses before forming the guessed style. +@end table + +@defopt c-guess-region-max +@vindex guess-region-max (c-) +This variable, default 50000, is the size in bytes of the buffer +portion examined by c-guess and c-guess-no-install. If set to +@code{nil}, the entire buffer is examined. +@end defopt + +@defopt c-guess-offset-threshold +@vindex guess-offset-threshold (c-) +This variable, default 10, is the maximum offset, either outwards or +inwards, which will be taken into account by the analysis process. +Any offset bigger than this will be ignored. For no limit, set this +variable to a large number. +@end defopt + +@table @asis +@item @kbd{M-x c-guess-install} +@findex c-guess-install +@findex guess-install (c-) + +Set the current buffer's style to the guessed style. This prompts you +to enter an optional new style name to give to the guessed style. By +default, this name is based on the buffer's absolute file name. You +can then use this style like any other. + +@item @kbd{M-x c-guess-view} +@findex c-guess-view +@findex guess-view (c-) +Display the most recently guessed style in a temporary buffer. This +display is in the form of a @code{c-add-style} form (@pxref{Adding +Styles}) which can be easily copied to your @file{.emacs}. You will +probably want to edit it first. + +The display of the guessed style contains these elements: + +@table @asis +@item Placeholder Name +You should replace this with a style name of your own. +@item Parent Style +The style current when the guessing began, from which the guessed +style inherits (@pxref{Config Basics}) the settings which weren't +guessed. +@item Guessed Offsets +These are the core result of the guessing process. Each of them is +marked by a comment. +@item Inherited Offsets +These are syntactic offsets which have been taken over from the parent +style. To avoid possible future conflicts, you should remove either +these offsets or the parent style name. +@end table +@end table @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -@node File Styles, , Adding Styles, Styles +@node File Styles, , Guessing the Style, Styles @comment node-name, next, previous, up @subsection File Styles @cindex styles, file local diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index afe7c94f447..ab54b99138a 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -2449,22 +2449,33 @@ one of these types of clauses with other clauses like @code{for ... to} or @code{while}. @item for @var{var} being the hash-keys of @var{hash-table} -This clause iterates over the entries in @var{hash-table}. For each -hash table entry, @var{var} is bound to the entry's key. If you write -@samp{the hash-values} instead, @var{var} is bound to the values -of the entries. The clause may be followed by the additional -term @samp{using (hash-values @var{var2})} (where @code{hash-values} -is the opposite word of the word following @code{the}) to cause -@var{var} and @var{var2} to be bound to the two parts of each -hash table entry. +@itemx for @var{var} being the hash-values of @var{hash-table} +This clause iterates over the entries in @var{hash-table} with +@var{var} bound to each key, or value. A @samp{using} clause can bind +a second variable to the opposite part. + +@example +(loop for k being the hash-keys of h + using (hash-values v) + do + (message "key %S -> value %S" k v)) +@end example @item for @var{var} being the key-codes of @var{keymap} +@itemx for @var{var} being the key-bindings of @var{keymap} This clause iterates over the entries in @var{keymap}. The iteration does not enter nested keymaps but does enter inherited (parent) keymaps. -You can use @samp{the key-bindings} to access the commands bound to -the keys rather than the key codes, and you can add a @code{using} -clause to access both the codes and the bindings together. +A @code{using} clause can access both the codes and the bindings +together. + +@example +(loop for c being the key-codes of (current-local-map) + using (key-bindings b) + do + (message "key %S -> binding %S" c b)) +@end example + @item for @var{var} being the key-seqs of @var{keymap} This clause iterates over all key sequences defined by @var{keymap} diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 82200780e19..439ff7fbc55 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -1167,16 +1167,17 @@ when you do the @kbd{g} command (@pxref{Scanning New Messages}). @node Checking New Groups @subsection Checking New Groups -Gnus normally determines whether a group is new or not by comparing the -list of groups from the active file(s) with the lists of subscribed and -dead groups. This isn't a particularly fast method. If -@code{gnus-check-new-newsgroups} is @code{ask-server}, Gnus will ask the -server for new groups since the last time. This is both faster and -cheaper. This also means that you can get rid of the list of killed -groups altogether, so you may set @code{gnus-save-killed-list} to -@code{nil}, which will save time both at startup, at exit, and all over. -Saves disk space, too. Why isn't this the default, then? -Unfortunately, not all servers support this command. +Gnus normally determines whether a group is new or not by comparing +the list of groups from the active file(s) with the lists of +subscribed and dead groups. This isn't a particularly fast method. +If @code{gnus-check-new-newsgroups} is @code{ask-server}, Gnus will +ask the server for new groups since the last time. This is both +faster and cheaper. This also means that you can get rid of the list +of killed groups (@pxref{Group Levels}) altogether, so you may set +@code{gnus-save-killed-list} to @code{nil}, which will save time both +at startup, at exit, and all over. Saves disk space, too. Why isn't +this the default, then? Unfortunately, not all servers support this +command. I bet I know what you're thinking now: How do I find out whether my server supports @code{ask-server}? No? Good, because I don't have a @@ -1214,9 +1215,10 @@ Some handy pre-fab functions are: @item gnus-subscribe-zombies @vindex gnus-subscribe-zombies -Make all new groups zombies. This is the default. You can browse the -zombies later (with @kbd{A z}) and either kill them all off properly -(with @kbd{S z}), or subscribe to them (with @kbd{u}). +Make all new groups zombies (@pxref{Group Levels}). This is the +default. You can browse the zombies later (with @kbd{A z}) and either +kill them all off properly (with @kbd{S z}), or subscribe to them +(with @kbd{u}). @item gnus-subscribe-randomly @vindex gnus-subscribe-randomly @@ -1300,6 +1302,10 @@ subscribing these groups. @code{gnus-subscribe-options-newsgroup-method} is used instead. This variable defaults to @code{gnus-subscribe-alphabetically}. +The ``options -n'' format is very simplistic. The syntax above is all +that is supports -- you can force-subscribe hierarchies, or you can +deny hierarchies, and that's it. + @vindex gnus-options-not-subscribe @vindex gnus-options-subscribe If you don't want to mess with your @file{.newsrc} file, you can just @@ -1430,7 +1436,7 @@ several servers where not all servers support @code{ask-server}. The @code{gnus-startup-file} variable says where the startup files are. The default value is @file{~/.newsrc}, with the Gnus (El Dingo) startup file being whatever that one is, with a @samp{.eld} appended. -If you want version control for this file, set +If you want to keep multiple numbered backups of this file, set @code{gnus-backup-startup-file}. It respects the same values as the @code{version-control} variable. @@ -2360,6 +2366,7 @@ empty subscribed groups and unsubscribed groups, too. Type @kbd{l} to go back to showing nonempty subscribed groups again. Thus, unsubscribed groups are hidden, in a way. +@cindex zombie groups Zombie and killed groups are similar to unsubscribed groups in that they are hidden by default. But they are different from subscribed and unsubscribed groups in that Gnus doesn't ask the news server for @@ -5568,6 +5575,13 @@ message (@code{gnus-summary-wide-reply-with-original}). This command uses the process/prefix convention, but only uses the headers from the first article to determine the recipients. +@item S L +@kindex S L (Summary) +@findex gnus-summary-reply-to-list-with-original +When replying to a message from a mailing list, send a reply to that +message to the mailing list, and include the original message +(@code{gnus-summary-reply-to-list-with-original}). + @item S v @kindex S v (Summary) @findex gnus-summary-very-wide-reply @@ -15638,14 +15652,16 @@ will remain on your system until hell freezes over. This bears repeating one more time, with some spurious capitalizations: IF you do NOT mark articles as EXPIRABLE, Gnus will NEVER delete those ARTICLES. +@vindex gnus-auto-expirable-marks You do not have to mark articles as expirable by hand. Gnus provides two features, called ``auto-expire'' and ``total-expire'', that can help you with this. In a nutshell, ``auto-expire'' means that Gnus hits @kbd{E} for you when you select an article. And ``total-expire'' means that Gnus considers all articles as expirable that are read. So, in addition to the articles marked @samp{E}, also the articles marked @samp{r}, -@samp{R}, @samp{O}, @samp{K}, @samp{Y} and so on are considered -expirable. +@samp{R}, @samp{O}, @samp{K}, @samp{Y} (and so on) are considered +expirable. @code{gnus-auto-expirable-marks} has the full list of +these marks. When should either auto-expire or total-expire be used? Most people who are subscribed to mailing lists split each list into its own group @@ -18994,9 +19010,8 @@ that you're running out of space. Neither are particularly fast or efficient, and it's not a particularly good idea to interrupt them (with @kbd{C-g} or anything else) once you've started one of them. -Note that other functions, e.g. @code{gnus-request-expire-articles}, -might run @code{gnus-agent-expire} for you to keep the agent -synchronized with the group. +Note that other functions might run @code{gnus-agent-expire} for you +to keep the agent synchronized with the group. The agent parameter @code{agent-enable-expiration} may be used to prevent expiration in selected groups. diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi index c2b6867c419..3e9ee928822 100644 --- a/doc/misc/rcirc.texi +++ b/doc/misc/rcirc.texi @@ -509,8 +509,8 @@ This variable contains the default user name to report to the server. It defaults to the login name returned by @code{user-login-name}, just like @code{rcirc-default-nick}. -@item rcirc-default-user-full-name -@vindex rcirc-default-user-full-name +@item rcirc-default-full-name +@vindex rcirc-default-full-name @cindex full name @cindex real name @cindex surname @@ -519,7 +519,7 @@ to the name returned by @code{user-full-name}. If you want to hide your full name, you might want to set it to some pseudonym. @example -(setq rcirc-default-user-full-name "Curious Minds Want To Know") +(setq rcirc-default-full-name "Curious Minds Want To Know") @end example @item rcirc-authinfo @@ -926,7 +926,7 @@ The real answer, therefore, is a @code{/reconnect} command: (delete-process process) (rcirc-connect server port nick rcirc-default-user-name - rcirc-default-user-full-name + rcirc-default-full-name channels)))) @end smallexample diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 50f1e90618f..a4e06ab22f1 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -2680,6 +2680,12 @@ handling}), file cache, connection cache (@pxref{Connection caching}), connection buffers. @end deffn +@deffn Command tramp-cleanup-this-connection +This command flushes all objects of the current buffer's remote +connection. The same objects are removed as in +@code{tramp-cleanup-connection}. +@end deffn + @deffn Command tramp-cleanup-all-connections This command flushes objects for all active remote connections. The same objects are removed as in @code{tramp-cleanup-connection}. diff --git a/etc/ChangeLog b/etc/ChangeLog index 062edbe42a4..5e80b5029ff 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,28 @@ +2011-07-06 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * NEWS: Clarify that `smtpmail-starttls-credentials' doesn't exist. + +2011-07-05 Juanma Barranquero <lekktu@gmail.com> + + * NEWS: Document new emacs-lock.el and renaming of old one. + +2011-07-05 Manoj Srivastava <srivasta@ieee.org> + + * themes/manoj-dark-theme.el (manoj-dark): New file. + +2011-03-29 Kevin Ryde <user42@zip.com.au> + + * compilation.txt (perl-Test2): New samples. + +2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * tutorials/TUTORIAL.zh: Remove spurious ")" character on the + first line. + +2011-07-01 Alan Mackenzie <acm@muc.de> + + * NEWS: CC Mode: New "guessing" of style. + 2011-06-21 Leo Liu <sdl.web@gmail.com> * NEWS: Mention the new primtive secure-hash. @@ -84,6 +84,10 @@ client frame in parent X window ID, via XEmbed. This works like the +++ *** New emacsclient argument -q/--quiet suppresses some status messages. ++++ +*** New emacsclient argument --frame-parameters can be used to set the +frame parameters of a newly-created graphical frame. + *** If emacsclient shuts down as a result of Emacs signalling an error, its exit status is 1. @@ -107,6 +111,10 @@ and pops down the *Completions* buffer accordingly. *** `completing-read' can be customized using the new variable `completing-read-function'. +*** minibuffer-local-filename-must-match-map is not used any more. +Instead, the bindings in minibuffer-local-filename-completion-map are combined +with minibuffer-local-must-match-map. + ** auto-mode-case-fold is now enabled by default. ** smtpmail changes @@ -122,8 +130,8 @@ 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 +** Similarly, `smtpmail-starttls-credentials' no longer exists. If +you had thet set, then then you need to put machine smtp.whatever.foo port 25 key "~/.my_smtp_tls.key" cert "~/.my_smtp_tls.cert" @@ -467,6 +475,11 @@ Just set shell-dir-cookie-re to an appropriate regexp. ** BibTeX mode +*** BibTeX mode now supports biblatex. +Use the variable bibtex-dialect to select support for different BibTeX dialects. +bibtex-entry-field-alist is now an obsolete alias for +bibtex-BibTeX-entry-alist. + *** New command `bibtex-search-entries' bound to C-c C-a. *** New `bibtex-entry-format' option `sort-fields', disabled by default. @@ -477,7 +490,7 @@ Just set shell-dir-cookie-re to an appropriate regexp. ** FIXME: xdg-open for browse-url and reportbug, 2010/08. -** Archive Mode has basic support to browse 7z archives. +** Archive Mode has basic support to browse and update 7z archives. ** browse-url has gotten a new variable that is used for mailto: URLs, `browse-url-mailto-function', which defaults to `browse-url-mail'. @@ -783,6 +796,9 @@ the user for specifics, e.g. a merge source. **** Currently supported for Bzr, Git, and Mercurial. +*** New option `vc-revert-show-diff' controls whether `vc-revert' +shows a diff while querying the user. It defaults to t. + *** Log entries in some Log View buffers can be toggled to display a longer description by typing RET (log-view-toggle-entry-display). In the Log View buffers made by `C-x v L' (vc-print-root-log), you can @@ -796,8 +812,15 @@ binding `log-view-expanded-log-entry-function' to a suitable function. *** New command `vc-ediff' allows visual comparison of two revisions of a file similar to `vc-diff', but using ediff backend. +** CC Mode (C, C++, etc.) + +*** New feature to "guess" the style in an existing buffer. + ** Miscellaneous ++++ +*** f90.el has some support for Fortran 2008 syntax. + --- *** `copyright-fix-years' can optionally convert consecutive years to ranges. @@ -839,6 +862,13 @@ soap-inspect.el is an interactive inspector for SOAP WSDL structures. ** xmodmap-generic-mode for xmodmap files. +** New emacs-lock.el package. +(The pre-existing one has been renamed to old-emacs-lock.el and moved +to obsolete/.) Now, Emacs Lock is a proper minor mode +`emacs-lock-mode'. Protection against exiting Emacs and killing the +buffer can be set separately. The mechanism for auto turning off +protection for buffers with inferior processes has been generalized. + * Incompatible Lisp Changes in Emacs 24.1 @@ -1080,6 +1110,7 @@ as well as those in the -*- line. --- ** rx.el has a new `group-n' construct for explicitly numbered groups. +** keymaps can inherit from multiple parents. * Changes in Emacs 24.1 on non-free operating systems @@ -13,15 +13,10 @@ to the FSF. * Tentative plan for Emacs-24 -** Bidi -** lexbind: I haven't checked the status of the code recently, so - I don't know how realistic it is to include it. But it's been around - for a long time, and I trust Miles, so I have hope. ** concurrency: including it as an "experimental" compile-time option sounds good. Of course there might still be big questions around "which form of concurrency" we'll want. ** Overhaul of customize: sounds wonderful. -** some kind of color-theme: agreed. ** better support for dynamic embedded graphics: I like this idea (my mpc.el code could use it for the volume widget), tho I wonder if the resulting efficiency will be sufficient. @@ -30,7 +25,6 @@ to the FSF. and expand.el (any other?) and then advertise/use/improve it. ** Improve VC: yes, there's a lot of work to be done there :-( And most of it could/should make it into Emacs-23.3. -** package manager. ** Random things that cross my mind right now that I'd like to see (some of them from my local hacks), but it's not obvious at all whether they'll diff --git a/etc/compilation.txt b/etc/compilation.txt index 8e19222143a..0eb3fe1bda2 100644 --- a/etc/compilation.txt +++ b/etc/compilation.txt @@ -496,6 +496,16 @@ symbol: perl--Test # Failed test 1 in foo.t at line 6 +* Perl Test.pm module error messages comparing two values + +symbol: perl--Test2 + +# Test 3 got: "99" (d-compilation-perl.t at line 29) +# Expected: "88" (my test name) +# d-compilation-perl.t line 29 is: ok(99,88,'my test name'); + +# Test 6 got: "xx" (foo.t at line 33 fail #2) +# Expected: "yy" * Perl Test::Harness output diff --git a/etc/themes/manoj-dark-theme.el b/etc/themes/manoj-dark-theme.el new file mode 100644 index 00000000000..bd6bbaa88a2 --- /dev/null +++ b/etc/themes/manoj-dark-theme.el @@ -0,0 +1,700 @@ +;;; manoj-dark.el --- A dark theme from Manoj + +;; Copyright (C) 2011 Free Software Foundation, Inc. + +;; Author: Manoj Srivastava <srivasta@ieee.org> +;; Keywords: lisp, faces + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; I spend a lot of time workin in front of a screen (many hours in a +;; dimly lit room) and eye fatigue is an issue. This is a dark color +;; theme for emacs, which is easier on the eyes than light themes. + +;; It does not help that I am blue-green color blind, so subtle +;; variations are often lost on me. I do want to use color contrast to +;; increase productivity, but I also want to avoid the jarring angry +;; fruit salad look, and so I am in the process of crafting a logical +;; color scheme that is high contrast enough for me, without being too +;; unpleasing. + +;; In circumstances where there a lot of related faces that can be +;; viewed, for example, the Gnus group buffer, consistent and logical +;; color choices are the only sane option. Gnus groups can be newa +;; (blueish) or mail (greenish), have states (large number of under +;; messages, normal, and empty). The large number unread groups have +;; highest luminance (appear brighter), and the empty one have lower +;; luminance (appear greyer), but have the same chroma and saturation. +;; Sub states and group priorities are rendered using a color series +;; which has constant luminance and saturation, and vary in hue by a +;; constant separation -- so all the related groups have the same +;; brightness ({mail,news}/{unread,normal,empty}), and a graded +;; selection of foreground colors. It sounds more complicated that it +;; looks. The eye is drawn naturally to the unread groups, and first +;; to the mail, then USENET groups (which is my preference). + +;; Similar color variations occur for individual messages in a group; +;; high scoring messages bubble to the top, and have a higher +;; luminance. This color schema has made me slightly faster at +;; reading mail/USENET. + +;; In the message itself, quoted mail messages from different people +;; are color coordinated, with high contrast beteen citations that are +;; close to each other in the heirarchy, so it is less likely that one +;; misunderstands who said what in a long conversation. + +;; The following scheme covers programming languages, Gnus, Erc, mail, +;; org-mode, CUA-mode, apt-utils, bbdb, compilation buffers, changelog +;; mode, diff and ediff, eshell, and more. You need emacs-goodies +;; package on Debian to use this. See the wiki page at +;; http://www.emacswiki.org/cgi-bin/wiki?ColorTheme for details. The +;; project home page is at https://gna.org/projects/color-theme. + +;;; Code: + +(deftheme manoj-dark + "Very high contrast faces with a black background. +This theme avoids subtle color variations, while avoiding the +jarring angry fruit salad look to reduce eye fatigue.") + +(custom-theme-set-faces + 'manoj-dark + '(default ((t (:background "black" :foreground "WhiteSmoke")))) + ;; Font lock faces + '(font-lock-builtin-face ((t (:foreground "LightSteelBlue")))) + '(font-lock-constant-face ((t (:foreground "LightSlateBlue" :bold t)))) + '(font-lock-preprocessor-face ((t (:foreground "CornFlowerBlue" :italic t)))) + '(font-lock-keyword-face ((t (:foreground "cyan1")))) + '(font-lock-type-face ((t (:foreground "SteelBlue1")))) + '(font-lock-regexp-grouping-backslash ((t (:bold t :weight bold)))) + '(font-lock-regexp-grouping-construct ((t (:bold t :weight bold)))) + '(font-lock-variable-name-face ((t (:foreground "Aquamarine")))) + '(font-lock-function-name-face ((t (:foreground "mediumspringgreen" + :weight bold :height 1.1)))) + '(font-lock-string-face ((t (:foreground "RosyBrown1")))) + '(font-lock-comment-face ((t (:italic t :slant oblique :foreground "chocolate1")))) + '(font-lock-comment-delimiter-face ((t (:foreground "Salmon")))) + '(font-lock-doc-face ((t (:italic t :slant oblique :foreground "LightCoral")))) + '(font-lock-doc-string-face ((t (:foreground "Plum")))) + '(font-lock-warning-face ((t (:bold t :foreground "Pink" :weight bold)))) + + '(cperl-array-face ((t (:foreground "LawnGreen" :background "B;ack" :bold t)))) + '(cperl-hash-face ((t (:foreground "SpringGreen" :background "B;ack" :bold t :italic t)))) + '(cperl-nonoverridable-face ((t (:foreground "chartreuse3")))) + + '(gnus-button ((t (:bold t :weight bold :background "#191932" :box (:line-width 2 :style released-button))))) + '(gnus-cite-attribution-face ((t (:italic t)))) + '(gnus-cite-face-1 ((t (:foreground "CornflowerBlue")))) + '(gnus-cite-face-2 ((t (:foreground "PaleGreen")))) + '(gnus-cite-face-3 ((t (:foreground "LightGoldenrod")))) + '(gnus-cite-face-4 ((t (:foreground "LightPink")))) + '(gnus-cite-face-5 ((t (:foreground "turquoise")))) + '(gnus-cite-face-6 ((t (:foreground "khaki")))) + '(gnus-cite-face-7 ((t (:foreground "plum")))) + '(gnus-cite-face-8 ((t (:foreground "DeepSkyBlue1")))) + '(gnus-cite-face-9 ((t (:foreground "chartreuse1")))) + '(gnus-cite-face-10 ((t (:foreground "thistle1")))) + '(gnus-cite-face-11 ((t (:foreground "LightYellow1")))) + '(gnus-emphasis-bold ((t (:bold t :weight bold)))) + '(gnus-emphasis-bold-italic ((t (:italic t :bold t :slant italic :weight bold)))) + '(gnus-emphasis-highlight-words ((t (:background "black" :foreground "yellow")))) + '(gnus-emphasis-italic ((t (:italic t :slant italic)))) + '(gnus-emphasis-strikethru ((t (:strike-through t)))) + '(gnus-emphasis-underline ((t (:underline t)))) + '(gnus-emphasis-underline-bold ((t (:bold t :underline t :weight bold)))) + '(gnus-emphasis-underline-bold-italic ((t (:italic t :bold t :underline t :slant italic :weight bold)))) + '(gnus-emphasis-underline-italic ((t (:italic t :underline t :slant italic)))) + + '(gnus-header-content ((t (:italic t :foreground "DarkKhaki" :slant italic)))) + '(gnus-header-content-face ((t (:italic t :foreground "DarkKhaki" :slant italic)))) + '(gnus-header-from ((t (:foreground "PaleGreen1")))) + '(gnus-header-from-face ((t (:foreground "PaleGreen1")))) + '(gnus-header-name ((t (:bold t :foreground "BlanchedAlmond" :weight bold)))) + '(gnus-header-name-face ((t (:bold t :foreground "BlanchedAlmond" :weight bold)))) + '(gnus-header-newsgroups ((t (:italic t :foreground "yellow" :slant italic)))) + '(gnus-header-newsgroups-face ((t (:italic t :foreground "yellow" :slant italic)))) + '(gnus-header-subject ((t (:foreground "coral1")))) + '(gnus-header-subject-face ((t (:foreground "coral1")))) + '(gnus-signature ((t (:italic t :slant italic)))) + '(gnus-signature-face ((t (:italic t :slant italic)))) + '(gnus-splash ((t (:foreground "#cccccc")))) + '(gnus-summary-cancelled ((t (:background "black" :foreground "yellow")))) + '(gnus-summary-cancelled-face ((t (:background "black" :foreground "yellow")))) + '(gnus-summary-high-ancient ((t (:bold t :foreground "CornflowerBlue" :weight bold)))) + '(gnus-summary-high-ancient-face ((t (:bold t :foreground "CornflowerBlue" :weight bold)))) + '(gnus-summary-normal-ancient ((t (:foreground "SkyBlue")))) + '(gnus-summary-normal-ancient-face ((t (:foreground "SkyBlue")))) + '(gnus-summary-low-ancient ((t (:italic t :foreground "LightSteelBlue" :slant italic)))) + '(gnus-summary-low-ancien-facet ((t (:italic t :foreground "LightSteelBlue" :slant italic)))) + + '(gnus-summary-high-read ((t (:bold t :foreground "grey60" :weight bold)))) + '(gnus-summary-high-read-face ((t (:bold t :foreground "grey60" :weight bold)))) + '(gnus-summary-normal-read ((t (:foreground "grey50")))) + '(gnus-summary-normal-read-face ((t (:foreground "grey50")))) + '(gnus-summary-low-read ((t (:italic t :foreground "LightSlateGray" :slant italic)))) + '(gnus-summary-low-read-face ((t (:italic t :foreground "LightSlateGray" :slant italic)))) + + '(gnus-summary-high-ticked ((t (:bold t :foreground "RosyBrown" :weight bold)))) + '(gnus-summary-high-ticked-face ((t (:bold t :foreground "RosyBrown" :weight bold)))) + '(gnus-summary-normal-ticked ((t (:foreground "LightSalmon")))) + '(gnus-summary-normal-ticked-face ((t (:foreground "LightSalmon")))) + '(gnus-summary-low-ticked ((t (:italic t :foreground "pink" :slant italic)))) + '(gnus-summary-low-ticked-face ((t (:italic t :foreground "pink" :slant italic)))) + + '(gnus-summary-high-undownloaded ((t (:bold t :foreground "ivory3" :weight bold)))) + '(gnus-summary-normal-undownloaded ((t (:foreground "LightGray" :weight normal)))) + '(gnus-summary-low-undownloaded ((t (:italic t :foreground "grey75" :slant italic :weight normal)))) + + '(gnus-summary-high-unread ((t (:bold t :foreground "PaleGreen" :weight bold)))) + '(gnus-summary-high-unread-face ((t (:bold t :foreground "PaleGreen" :weight bold)))) + '(gnus-summary-normal-unread ((t (:foreground "YellowGreen")))) + '(gnus-summary-normal-unread-face ((t (:foreground "YellowGreen")))) + '(gnus-summary-low-unread ((t (:italic t :foreground "MediumSeaGreen" :slant italic)))) + '(gnus-summary-low-unread-face ((t (:italic t :foreground "MediumSeaGreen" :slant italic)))) + '(gnus-summary-root-face ((t (:bold t :foreground "Red" :weight bold)))) + '(gnus-summary-selected ((t (:underline t :foreground "LemonChiffon")))) + '(gnus-summary-selected-face ((t (:underline t :foreground "LemonChiffon")))) + '(gnus-user-agent-bad-face ((t (:bold t :background "black" :foreground "red" :weight bold)))) + '(gnus-user-agent-good-face ((t (:background "black" :foreground "green")))) + '(gnus-user-agent-unknown-face ((t (:bold t :background "black" :foreground "orange" :weight bold)))) + '(gnus-x-face ((t (:background "white" :foreground "black")))) + + '(gnus-group-mail-1 ((t (:bold t :foreground "#3BFF00" :weight normal)))) + '(gnus-group-mail-1-face ((t (:bold t :foreground "#3BFF00" :weight normal)))) + '(gnus-group-mail-2 ((t (:bold t :foreground "#5EFF00" :weight normal)))) + '(gnus-group-mail-2-face ((t (:bold t :foreground "#5EFF00" :weight normal)))) + '(gnus-group-mail-3 ((t (:bold t :foreground "#80FF00" :weight normal)))) + '(gnus-group-mail-3-face ((t (:bold t :foreground "#A1FF00" :weight normal)))) + + + '(gnus-group-mail-1-empty ((t (:foreground "#249900")))) + '(gnus-group-mail-1-empty-face ((t (:foreground "#249900")))) + '(gnus-group-mail-2-empty ((t (:foreground "#389900")))) + '(gnus-group-mail-2-empty-face ((t (:foreground "#389900")))) + '(gnus-group-mail-3-empty ((t (:foreground "#4D9900")))) + '(gnus-group-mail-3-empty-face ((t (:foreground "#4D9900")))) + + '(gnus-group-mail-low ((t (:bold t :foreground "aquamarine2" :weight bold)))) + '(gnus-group-mail-low-face ((t (:bold t :foreground "aquamarine2" :weight bold)))) + '(gnus-group-mail-low-empty ((t (:foreground "aquamarine2")))) + '(gnus-group-mail-low-empty-face ((t (:foreground "aquamarine2")))) + + '(gnus-group-news-1 ((t (:bold t :foreground "#8480FF" :weight bold)))) + '(gnus-group-news-1-face ((t (:bold t :foreground "#8480FF" :weight bold)))) + '(gnus-group-news-2 ((t (:bold t :foreground "#8088FF" :weight bold)))) + '(gnus-group-news-2-face ((t (:bold t :foreground "#8088FF" :weight bold)))) + '(gnus-group-news-3 ((t (:bold t :foreground "#8095FF" :weight bold)))) + '(gnus-group-news-3-face ((t (:bold t :foreground "#8095FF" :weight bold)))) + '(gnus-group-news-4 ((t (:bold t :foreground "#80A1FF" :weight bold)))) + '(gnus-group-news-4-face ((t (:bold t :foreground "#80A1FF" :weight bold)))) + '(gnus-group-news-5 ((t (:bold t :foreground "#80AEFF" :weight bold)))) + '(gnus-group-news-5-face ((t (:bold t :foreground "#80AEFF" :weight bold)))) + '(gnus-group-news-6 ((t (:bold t :foreground "#80BBFF" :weight bold)))) + '(gnus-group-news-6-face ((t (:bold t :foreground "#80BBFF" :weight bold)))) + + '(gnus-group-news-1-empty ((t (:foreground "#524DFF")))) + '(gnus-group-news-1-empty-face ((t (:foreground "#524DFF")))) + '(gnus-group-news-2-empty ((t (:foreground "#4D58FF")))) + '(gnus-group-news-2-empty-face ((t (:foreground "#4D58FF")))) + '(gnus-group-news-3-empty ((t (:foreground "#4D6AFF")))) + '(gnus-group-news-3-empty-face ((t (:foreground "#4D6AFF")))) + '(gnus-group-news-4-empty ((t (:foreground "#4D7CFF")))) + '(gnus-group-news-4-empty-face ((t (:foreground "#4D7CFF")))) + '(gnus-group-news-5-empty ((t (:foreground "#4D8EFF")))) + '(gnus-group-news-5-empty-face ((t (:foreground "#4D8EFF")))) + '(gnus-group-news-6-empty ((t (:foreground "#4DA0FF")))) + '(gnus-group-news-6-empty-face ((t (:foreground "#4DA0FF")))) + + '(gnus-group-news-low ((t (:bold t :foreground "DarkTurquoise" :weight bold)))) + '(gnus-group-news-low-face ((t (:bold t :foreground "DarkTurquoise" :weight bold)))) + '(gnus-group-news-low-empty ((t (:foreground "DarkTurquoise")))) + '(gnus-group-news-low-empty-face ((t (:foreground "DarkTurquoise")))) + + ;;message faces + '(message-cited-text ((t (:foreground "red3")))) + '(message-header-cc ((t (:bold t :foreground "chartreuse1" :weight bold)))) + '(message-header-cc-face ((t (:bold t :foreground "chartreuse1" :weight bold)))) + '(message-header-name ((t (:foreground "green")))) + '(message-header-name-face ((t (:foreground "green")))) + '(message-header-newsgroups ((t (:italic t :bold t :foreground "papaya whip" :slant italic :weight bold)))) + '(message-header-newsgroups-face ((t (:italic t :bold t :foreground "papaya whip" :slant italic :weight bold)))) + '(message-header-other ((t (:foreground "ivory")))) + '(message-header-other-face ((t (:foreground "ivory")))) + '(message-header-subject ((t (:foreground "OliveDrab1")))) + '(message-header-subject-face ((t (:foreground "OliveDrab1")))) + '(message-header-to ((t (:bold t :foreground "floral white" :weight bold)))) + '(message-header-to-face ((t (:bold t :foreground "floral white" :weight bold)))) + '(message-header-xheader ((t (:foreground "DeepSkyBlue1")))) + '(message-header-xheader-face ((t (:foreground "DeepSkyBlue1")))) + '(message-mml ((t (:foreground "MediumSpringGreen")))) + '(message-mml-face ((t (:foreground "MediumSpringGreen")))) + '(message-separator ((t (:foreground "LightSkyBlue1")))) + '(message-separator-face ((t (:foreground "LightSkyBlue1")))) + '(message-url ((t (:bold t :foreground "blue" :weight bold)))) + + '(bg:erc-color-face0 ((t (:background "saddle brown")))) + '(bg:erc-color-face1 ((t (:background "black")))) + '(bg:erc-color-face10 ((t (:background "DodgerBlue4")))) + '(bg:erc-color-face11 ((t (:background "cyan4")))) + '(bg:erc-color-face12 ((t (:background "blue")))) + '(bg:erc-color-face13 ((t (:background "deeppink")))) + '(bg:erc-color-face14 ((t (:background "gray50")))) + '(bg:erc-color-face15 ((t (:background "grey15")))) + '(bg:erc-color-face2 ((t (:background "blue4")))) + '(bg:erc-color-face3 ((t (:background "green4")))) + '(bg:erc-color-face4 ((t (:background "red")))) + '(bg:erc-color-face5 ((t (:background "brown")))) + '(bg:erc-color-face6 ((t (:background "purple")))) + '(bg:erc-color-face7 ((t (:background "orange")))) + '(bg:erc-color-face8 ((t (:background "yellow4")))) + '(bg:erc-color-face9 ((t (:background "green")))) + '(erc-action-face ((t (:bold t :weight bold :foreground "turquoise1")))) + '(erc-bold-face ((t (:bold t :weight bold)))) + '(erc-button ((t (:bold t :weight bold :foreground "RoyalBlue1" :box (:line-width 2 :style released-button))))) + '(erc-button-face ((t (:bold t :weight bold :foreground "RoyalBlue1" :box (:line-width 2 :style released-button))))) + '(erc-command-indicator-face ((t (:bold t :weight bold)))) + '(erc-current-nick-face ((t (:bold t :foreground "DarkTurquoise" :weight bold)))) + '(erc-dangerous-host-face ((t (:foreground "red")))) + '(erc-direct-msg-face ((t (:foreground "sandybrown")))) + '(erc-error-face ((t (:foreground "red")))) + '(erc-fool-face ((t (:foreground "dim gray")))) + '(erc-header-line ((t (:background "grey95" :foreground "ConFlowerBlue")))) + '(erc-input-face ((t (:foreground "brown")))) + '(erc-inverse-face ((t (:background "Black" :foreground "White")))) + '(erc-keyword-face ((t (:bold t :foreground "pale green" :weight bold)))) + '(erc-my-nick-face ((t (:bold t :foreground "brown" :weight bold)))) + '(erc-nick-default-face ((t (:bold t :weight bold :foreground "DodgerBlue1")))) + '(erc-button-nickname-face ((t (:bold t :weight bold :background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button) )))) + '(erc-nick-msg-face ((t (:bold t :foreground "IndianRed" :weight bold)))) + '(erc-notice-face ((t (:bold t :foreground "SlateBlue" :weight bold)))) + '(erc-pal-face ((t (:bold t :foreground "Magenta" :weight bold)))) + '(erc-prompt-face ((t (:bold t :background "Navy" :foreground "lightBlue2" :weight bold)))) + '(erc-timestamp-face ((t (:bold t :foreground "SeaGreen1" :weight bold)))) + '(erc-underline-face ((t (:underline t)))) + '(fg:erc-color-face0 ((t (:foreground "BlanchedAlmond")))) + '(fg:erc-color-face1 ((t (:foreground "beige")))) + '(fg:erc-color-face10 ((t (:foreground "pale goldenrod")))) + '(fg:erc-color-face11 ((t (:foreground "cyan")))) + '(fg:erc-color-face12 ((t (:foreground "lightblue1")))) + '(fg:erc-color-face13 ((t (:foreground "deeppink")))) + '(fg:erc-color-face14 ((t (:foreground "gray50")))) + '(fg:erc-color-face15 ((t (:foreground "gray90")))) + '(fg:erc-color-face2 ((t (:foreground "blue4")))) + '(fg:erc-color-face3 ((t (:foreground "green4")))) + '(fg:erc-color-face4 ((t (:foreground "red")))) + '(fg:erc-color-face5 ((t (:foreground "brown")))) + '(fg:erc-color-face6 ((t (:foreground "purple")))) + '(fg:erc-color-face7 ((t (:foreground "orange")))) + '(fg:erc-color-face8 ((t (:foreground "yellow")))) + '(fg:erc-color-face9 ((t (:foreground "green")))) + + '(org-agenda-date ((t (:foreground "LightSkyBlue")))) + '(org-agenda-date-weekend ((t (:bold t :foreground "LightSkyBlue" :weight bold)))) + '(org-agenda-restriction-lock ((t (:background "skyblue4")))) + '(org-agenda-structure ((t (:foreground "LightSkyBlue")))) + '(org-archived ((t (:foreground "grey70")))) + '(org-code ((t (:foreground "grey70")))) + '(org-column ((t (:background "grey30" :slant normal :weight normal :height 81 :family "unknown-DejaVu Sans Mono")))) + '(org-column-title ((t (:bold t :background "grey30" :underline t :weight bold)))) + '(org-date ((t (:foreground "Cyan" :underline t)))) + '(org-done ((t (:bold t :foreground "PaleGreen" :weight bold)))) + '(org-drawer ((t (:foreground "LightSkyBlue")))) + '(org-ellipsis ((t (:foreground "LightGoldenrod" :underline t)))) + '(org-formula ((t (:foreground "chocolate1")))) + '(org-headline-done ((t (:foreground "LightSalmon")))) + '(org-hide ((t (:foreground "black")))) + '(org-latex-and-export-specials ((t (:foreground "burlywood")))) + '(org-level-1 ((t (:foreground "LightSkyBlue")))) + '(org-level-2 ((t (:foreground "LightGoldenrod")))) + '(org-level-3 ((t (:foreground "Cyan1")))) + '(org-level-4 ((t (:foreground "chocolate1")))) + '(org-level-5 ((t (:foreground "PaleGreen")))) + '(org-level-6 ((t (:foreground "Aquamarine")))) + '(org-level-7 ((t (:foreground "LightSteelBlue")))) + '(org-level-8 ((t (:foreground "LightSalmon")))) + '(org-link ((t (:foreground "Cyan" :underline t)))) + '(org-mode-line-clock ((t (:foreground "DarkGreen" :underline t)))) + '(org-scheduled-previously ((t (:foreground "chocolate1")))) + '(org-scheduled-today ((t (:foreground "PaleGreen")))) + '(org-sexp-date ((t (:foreground "Cyan")))) + '(org-special-keyword ((t (:foreground "LightSalmon")))) + '(org-table ((t (:foreground "LightSkyBlue")))) + '(org-tag ((t (:bold t :weight bold)))) + '(org-target ((t (:underline t)))) + '(org-time-grid ((t (:foreground "LightGoldenrod")))) + '(org-todo ((t (:bold t :foreground "Pink" :weight bold)))) + '(org-upcoming-deadline ((t (:foreground "chocolate1")))) + '(org-verbatim ((t (:foreground "grey70" :underline t)))) + '(org-warning ((t (:bold t :weight bold :foreground "Pink")))) + '(outline-1 ((t (:foreground "LightSkyBlue")))) + '(outline-2 ((t (:foreground "LightGoldenrod")))) + '(outline-3 ((t (:foreground "Cyan1")))) + '(outline-4 ((t (:foreground "chocolate1")))) + '(outline-5 ((t (:foreground "PaleGreen")))) + '(outline-6 ((t (:foreground "Aquamarine")))) + '(outline-7 ((t (:foreground "LightSteelBlue")))) + '(outline-8 ((t (:foreground "LightSalmon")))) + + + '(CUA-global-mark-face ((t (:background "cyan" :foreground "black")))) + '(CUA-rectangle-face ((t (:background "maroon" :foreground "white")))) + '(CUA-rectangle-noselect-face ((t (:background "dimgray" :foreground "white")))) + '(Info-title-1-face ((t (:bold t :weight bold :family "helv" :height 1.728)))) + '(Info-title-2-face ((t (:bold t :family "helv" :weight bold :height 1.44)))) + '(Info-title-3-face ((t (:bold t :weight bold :family "helv" :height 1.2)))) + '(Info-title-4-face ((t (:bold t :family "helv" :weight bold)))) + '(align-highlight-nochange-face ((t (:background "SkyBlue4")))) + + '(antlr-font-lock-keyword-face ((t (:foreground "SteelBlue")))) ;% + '(antlr-font-lock-literal-face ((t (:foreground "PaleVioletRed")))) + '(antlr-font-lock-ruledef-face ((t (:foreground "DarkGreen")))) + '(antlr-font-lock-ruleref-face ((t (:foreground "SteelBlue")))) + '(antlr-font-lock-tokendef-face ((t (:foreground "khaki")))) + '(antlr-font-lock-tokenref-face ((t (:foreground "LightSteelBlue4")))) + + '(bbdb-company ((t (:italic t :slant italic :foreground "indian red")))) + '(bbdb-field-name ((t (:bold t :weight bold :foreground "steel blue")))) + '(bbdb-field-value ((t (:foreground "AntiqueWhite2")))) + '(bbdb-name ((t (:underline t :foreground "cadet blue")))) + + '(bold ((t (:bold t :weight bold)))) + '(bold-italic ((t (:bold t :italic t :slant italic :weight bold)))) + '(border ((t (:background "gold" :foreground "black" )))) + '(buffer-menu-buffer ((t (:bold t :weight bold)))) + '(button ((t (:underline t :box (:line-width 2 :color "grey" + :style released-button) + :foreground "black" :background "grey" + :weight bold )))) + '(calendar-today-face ((t (:underline t :bold t :foreground "cornsilk")))) + '(change-log-acknowledgement-face ((t (:italic t :slant oblique :foreground "AntiqueWhite3")))) + '(change-log-conditionals-face ((t (:foreground "Aquamarine")))) + '(change-log-date-face ((t (:italic t :slant oblique :foreground "BurlyWood")))) + '(change-log-email-face ((t (:foreground "Aquamarine")))) + '(change-log-file-face ((t (:bold t :family "Verdana" :weight bold :foreground "LightSkyBlue" :height 0.9)))) + '(change-log-function-face ((t (:foreground "Aquamarine")))) + '(change-log-list-face ((t (:foreground "LightSkyBlue")))) + '(change-log-name-face ((t (:bold t :weight bold :foreground "Gold")))) + + '(comint-highlight-input ((t (:bold t :weight bold)))) + '(comint-highlight-prompt ((t (:foreground "cyan1")))) + '(compilation-column-number ((t (:foreground "PaleGreen")))) + '(compilation-error ((t (:bold t :weight bold :foreground "Brown1")))) + '(compilation-info ((t (:bold t :foreground "LightPink1" :weight bold)))) + '(compilation-line-number ((t (:foreground "LightGoldenrod")))) + '(compilation-message-face ((t (:underline t)))) + '(compilation-warning ((t (:bold t :foreground "Orange" :weight bold)))) + '(compilation-warning-face ((t (:bold t :foreground "Orange" :weight bold)))) + '(completions-common-part ((t (:family "unknown-DejaVu Sans Mono" + :width normal :weight normal + :slant normal :foreground "WhiteSmoke" + :background "black" :height 81)))) + '(completions-first-difference ((t (:bold t :weight bold)))) + + '(css-selector ((t (:foreground "LightSteelBlue")))) + '(css-property ((t (:foreground "light sea green")))) + + '(cursor ((t (:background "orchid")))) + '(custom-button-face ((t (:background "lightgrey" :foreground "black" + :box '(:line-width 2 :style released-button))))) + '(custom-button-pressed-face ((t (:background "lightgrey" + :foreground "black" + :box '(:line-width 2 :style pressed-button))))) + '(custom-changed-face ((t (:foreground "wheat" :background "blue")))) + '(custom-comment-face ((t (:background "dim gray")))) + '(custom-comment-tag-face ((t (:foreground "gray80")))) + '(custom-face-tag-face ((t (:bold t :family "helv" :weight bold :height 1.1)))) + '(custom-group-tag-face ((t (:bold t :family "helv" :foreground "light blue" :weight bold :height 1.1)))) + '(custom-group-tag-face-1 ((t (:bold t :family "helv" :foreground "pink" :weight bold :height 1.1)))) + '(custom-invalid-face ((t (:background "red" :foreground "yellow")))) + '(custom-modified-face ((t (:background "blue" :foreground "white")))) + '(custom-rogue-face ((t (:background "black" :foreground "pink")))) + '(custom-saved-face ((t (:underline t)))) + '(custom-set-face ((t (:background "white" :foreground "blue")))) + '(custom-state-face ((t (:foreground "lime green")))) + '(custom-variable-button-face ((t (:bold t :underline t :weight bold + :background "lightgrey" + :foreground "black" + :box '(:line-width 2 :style released-button))))) + '(custom-variable-tag-face ((t (:bold t :family "helv" + :foreground "light blue" + :weight bold :height 1.2)))) + + '(diary ((t (:foreground "IndianRed")))) + '(diary-anniversary ((t (:foreground "Cyan1")))) + '(diary-button ((t (:background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button))))) + '(diary-face ((t (:foreground "IndianRed")))) + '(diary-time ((t (:foreground "LightGoldenrod")))) + '(diff-added ((t (:foreground "Green")))) + '(diff-added-face ((t (:foreground "Green")))) + '(diff-changed-face ((t (:foreground "Khaki")))) + '(diff-context-face ((t (:foreground "grey70")))) + '(diff-file-header ((t (:bold t :background "grey20" :foreground "ivory1" :weight bold)))) + '(diff-file-header-face ((t (:bold t :background "grey20" :foreground "ivory1" :weight bold)))) + '(diff-function-face ((t (:foreground "SpringGreen1")))) + '(diff-header-face ((t (:background "SlateBlue4")))) + '(diff-hunk-header ((t (:slant italic :background "DodgerBlue4")))) + '(diff-hunk-header-face ((t (:slant italic :background "DodgerBlue4")))) + '(diff-index-face ((t (:bold t :weight bold :background "SteelBlue4" :foreground "linen" )))) + '(diff-nonexistent ((t (:bold t :weight bold :background "Black" :foreground "Wheat1")))) + '(diff-nonexistent-face ((t (:bold t :weight bold :background "Black" :foreground "Wheat1")))) + '(diff-removed ((t (:foreground "salmon1")))) + '(diff-removed-face ((t (:foreground "salmon1")))) + '(diff-refine-change-face ((t (:background "MidnightBlue")))) + '(diff-refine-change ((t (:background "MidnightBlue")))) + + '(ediff-current-diff-face-A ((t (:foreground "firebrick" :background "pale green")))) + '(ediff-current-diff-face-Ancestor ((t (:foreground "Black" :background "VioletRed")))) + '(ediff-current-diff-face-B ((t (:foreground "DarkOrchid" :background "Yellow")))) + '(ediff-current-diff-face-C ((t (:foreground "Navy" :background "Pink")))) + '(ediff-even-diff-face-A ((t (:foreground "Black" :background "light grey")))) + '(ediff-even-diff-face-Ancestor ((t (:foreground "White" :background "Grey")))) + '(ediff-even-diff-face-B ((t (:foreground "White" :background "Grey")))) + '(ediff-even-diff-face-C ((t (:foreground "Black" :background "light grey")))) + '(ediff-fine-diff-face-A ((t (:foreground "Navy" :background "sky blue")))) + '(ediff-fine-diff-face-Ancestor ((t (:foreground "Black" :background "Green")))) + '(ediff-fine-diff-face-B ((t (:foreground "Black" :background "cyan")))) + '(ediff-fine-diff-face-C ((t (:foreground "Black" :background "Turquoise")))) + '(ediff-odd-diff-face-A ((t (:foreground "White" :background "Grey")))) + '(ediff-odd-diff-face-Ancestor ((t (:foreground "Black" :background "light grey")))) + '(ediff-odd-diff-face-B ((t (:foreground "Black" :background "light grey")))) + '(ediff-odd-diff-face-C ((t (:foreground "White" :background "Grey")))) + + '(eieio-custom-slot-tag-face ((t (:foreground "light blue")))) + '(eldoc-highlight-function-argument ((t (:bold t :weight bold)))) + '(epa-field-body ((t (:italic t :foreground "turquoise" :slant italic)))) + '(epa-field-name ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) + '(epa-mark ((t (:bold t :foreground "orange" :weight bold)))) + '(epa-string ((t (:foreground "lightyellow")))) + '(epa-validity-disabled ((t (:italic t :slant italic)))) + '(epa-validity-high ((t (:bold t :foreground "PaleTurquoise" :weight bold)))) + '(epa-validity-low ((t (:italic t :slant italic)))) + '(epa-validity-medium ((t (:italic t :foreground "PaleTurquoise" :slant italic)))) + + '(escape-glyph ((t (:foreground "cyan")))) + + '(eshell-ls-archive-face ((t (:bold t :foreground "IndianRed")))) + '(eshell-ls-backup-face ((t (:foreground "Grey")))) + '(eshell-ls-clutter-face ((t (:foreground "DimGray")))) + '(eshell-ls-directory-face ((t (:bold t :foreground "MediumSlateBlue")))) + '(eshell-ls-executable-face ((t (:foreground "Coral")))) + '(eshell-ls-missing-face ((t (:foreground "black")))) + '(eshell-ls-picture-face ((t (:foreground "Violet")))) + '(eshell-ls-product-face ((t (:foreground "sandybrown")))) + '(eshell-ls-readonly-face ((t (:foreground "Aquamarine")))) + '(eshell-ls-special-face ((t (:foreground "Gold")))) + '(eshell-ls-symlink-face ((t (:foreground "DarkCyan" :bold t)))) + '(eshell-ls-symlink-face ((t (:foreground "White")))) + '(eshell-ls-unreadable-face ((t (:foreground "DimGray")))) + '(eshell-prompt-face ((t (:foreground "MediumAquamarine")))) + '(eshell-test-failed-face ((t (:foreground "OrangeRed" :bold t)))) + '(eshell-test-ok-face ((t (:foreground "Green" :bold t)))) + + '(excerpt ((t (:italic t)))) + '(file-name-shadow ((t (:foreground "grey70")))) + '(fixed ((t (:bold t)))) + '(fixed-pitch ((t (:family "courier")))) + '(flyspell-duplicate-face ((t (:foreground "IndianRed" :bold t :underline t)))) + '(flyspell-incorrect-face ((t (:foreground "Pink" :bold t :underline t)))) + + '(fringe ((t (:background "grey30" :foreground "Wheat")))) + '(header-line ((t (:box (:line-width -1 :color "grey20" :style released-button) :background "grey20" :foreground "grey90" :height 0.9)))) + '(help-argument-name ((t (:italic t :slant italic)))) + '(highlight ((t (:background "gray10" :foreground "Old Lace")))) + '(hl-line ((t (:background "grey10" :foreground "Old Lace")))) + '(gnus-mouse-face ((t (:background "darkseagreen2" :foreground "blue")))) + '(erc-button-mouse-face ((t (:background "darkseagreen2" :foreground "blue")))) + '(align-highlight-change-face ((t (:background "darkseagreen2" :foreground "blue")))) + '(goto-address-url-mouse-face ((t (:background "darkseagreen2" :foreground "blue")))) + '(goto-address-url-mouse-face ((t (:background "darkseagreen2" :foreground "blue")))) + '(ispell-highlight-face ((t (:background "darkseagreen2" :foreground "blue")))) + '(ispell-highlight-face ((t (:background "darkseagreen2" :foreground "blue")))) + '(widget-mouse-face ((t (:background "darkseagreen2" :foreground "blue")))) + + '(highlight-beyond-fill-column-face ((t (:underline t)))) + '(highlight-changes ((t (:foreground nil :background "#382f2f")))) + '(highlight-changes-delete ((t (:foreground nil :background "#916868")))) + + '(holiday ((t (:background "chocolate4")))) + '(holiday-face ((t (:background "chocolate4")))) + + '(ibuffer-dired-buffer-face ((t (:foreground "mediumspringgreen" :weight bold :height 1.1)))) + '(ibuffer-help-buffer-face ((t (:italic t :slant oblique :foreground "chocolate1")))) + '(ibuffer-hidden-buffer-face ((t (:bold t :foreground "Pink" :weight bold)))) + '(ibuffer-occur-match-face ((t (:bold t :foreground "Pink" :weight bold)))) + '(ibuffer-read-only-buffer-face ((t (:foreground "SteelBlue1")))) + '(ibuffer-special-buffer-face ((t (:foreground "SteelBlue1")))) + + '(ido-first-match ((t (:bold t :weight bold)))) + '(ido-incomplete-regexp ((t (:bold t :weight bold :foreground "Pink")))) + '(ido-indicator ((t (:background "red1" :foreground "yellow1" :width condensed)))) + '(ido-only-match ((t (:foreground "ForestGreen")))) + '(ido-subdir ((t (:foreground "red1")))) + '(info-menu-5 ((t (:underline t)))) + '(info-menu-header ((t (:bold t :family "helv" :weight bold)))) + '(info-node ((t (:bold t :italic t :foreground "yellow")))) + '(info-node ((t (:italic t :bold t :foreground "white" :slant italic :weight bold)))) + '(info-xref ((t (:bold t :foreground "DodgerBlue1")))) + '(info-xref ((t (:bold t :foreground "cyan" :weight bold)))) + '(isearch ((t (:background "palevioletred2" :foreground "brown4")))) + '(isearch-fail ((t (:background "red4")))) + '(isearch-lazy-highlight-face ((t (:background "paleturquoise4")))) + '(isearch-secondary ((t (:foreground "red3")))) + '(italic ((t (:italic t)))) + + '(js2-builtin-face ((t (:foreground "sandy brown")))) + '(js2-comment-face ((t (:foreground "dark orchid")))) + '(js2-constant-face ((t (:foreground "pale violet red")))) + '(js2-error-face ((t (:background "indian red" :foreground "green" :bold t)))) + '(js2-function-name-face ((t (:foreground "cadet blue")))) + '(js2-function-param-face ((t (:foreground "IndianRed1")))) + '(js2-instance-member-face ((t (:foreground "IndianRed1")))) + '(js2-jsdoc-tag-face ((t (:foreground "medium orchid")))) + '(js2-jsdoc-type-face ((t (:foreground "medium orchid")))) + '(js2-jsdoc-value-face ((t (:foreground "medium orchid")))) + '(js2-keyword-face ((t (:foreground "steel blue")))) + '(js2-private-function-call-face ((t (:foreground "cadet blue")))) + '(js2-private-member-face ((t (:foreground "IndianRed1")))) + '(js2-regexp-face ((t (:foreground "khaki")))) + '(js2-string-face ((t (:foreground "lemon chiffon")))) + '(js2-type-face ((t (:foreground "medium sea green")))) + '(js2-variable-name-face ((t (:foreground "IndianRed1")))) + '(js2-warning-face ((t (:background "indian red" :foreground "green")))) + + '(lazy-highlight ((t (:background "paleturquoise4")))) + '(link ((t (:foreground "cyan1" :underline t)))) + '(link-visited ((t (:underline t :foreground "violet")))) + + '(makefile-space ((t (:background "hotpink")))) + '(man-bold ((t (:bold t)))) + '(man-heading ((t (:bold t)))) + '(man-italic ((t (:foreground "yellow")))) + '(man-xref ((t (:underline t)))) + '(match ((t (:background "RoyalBlue3")))) + '(minibuffer-prompt ((t (:foreground "cyan")))) + '(mode-line ((t (:background "grey75" :foreground "Blue" + :box '(:line-width -1 :style released-button) + :height 0.9)))) + '(mode-line-buffer-id ((t (:background "grey65" :foreground "red" + :bold t :weight bold :height 0.9)))) + '(mode-line-emphasis ((t (:bold t :weight bold)))) + '(mode-line-highlight ((t (:box (:line-width 2 :color "grey40" + :style released-button :height 0.9))))) + '(mode-line-inactive ((t (:background "grey30" :foreground "grey80" + :box '(:line-width -1 :color "grey40") + :weight light :height 0.9)))) + '(mouse ((t (:background "OrangeRed")))) + + '(next-error ((t (:background "blue3")))) + '(nobreak-space ((t (:foreground "cyan" :underline t)))) + '(paren-blink-off ((t (:foreground "black")))) + '(paren-mismatch-face ((t (:bold t :background "white" :foreground "red")))) + '(paren-no-match-face ((t (:bold t :background "white" :foreground "red")))) + '(query-replace ((t (:foreground "brown4" :background "palevioletred2")))) + '(region ((t (:background "blue3")))) + '(scroll-bar ((t (:background "grey75" :foreground "WhiteSmoke")))) + '(secondary-selection ((t (:background "SkyBlue4")))) + '(semantic-dirty-token-face ((t (:background "lightyellow")))) + '(semantic-highlight-edits-face ((t (:background "gray20")))) + '(semantic-unmatched-syntax-face ((t (:underline "red")))) + '(senator-intangible-face ((t (:foreground "gray75")))) + '(senator-momentary-highlight-face ((t (:background "gray30")))) + '(senator-read-only-face ((t (:background "#664444")))) + '(sgml-doctype-face ((t (:foreground "orange")))) + '(sgml-end-tag-face ((t (:foreground "greenyellow")))) + '(sgml-entity-face ((t (:foreground "gold")))) + '(sgml-ignored-face ((t (:foreground "gray20" :background "gray60")))) + '(sgml-sgml-face ((t (:foreground "yellow")))) + '(sgml-start-tag-face ((t (:foreground "mediumspringgreen")))) + '(shadow ((t (:foreground "grey70")))) + + '(show-paren-match ((t (:background "steelblue3")))) + '(show-paren-match-face ((t (:background "steelblue3")))) + '(show-paren-mismatch ((t (:background "purple" :foreground "white")))) + '(smerge-base ((t (:foreground "orange")))) + '(smerge-markers ((t (:background "grey30")))) + '(smerge-mine ((t (:foreground "cyan")))) + '(smerge-other ((t (:foreground "lightgreen")))) + '(smerge-refined-change ((t (:background "blue4")))) + '(speedbar-button-face ((t (:foreground "green3")))) + '(speedbar-directory-face ((t (:foreground "light blue")))) + '(speedbar-file-face ((t (:foreground "cyan")))) + '(speedbar-highlight-face ((t (:background "sea green")))) + '(speedbar-selected-face ((t (:foreground "red" :underline t)))) + '(speedbar-separator-face ((t (:background "blue" :foreground "white" :overline "gray")))) + '(speedbar-tag-face ((t (:foreground "yellow")))) + '(table-cell ((t (:background "blue1" :foreground "gray90")))) + + '(tool-bar ((t (:background "grey75" :foreground "black" :box (:line-width 1 :style released-button))))) + '(tooltip ((t (:family "helv" :background "lightyellow" :foreground "black")))) + '(trailing-whitespace ((t (:background "red1")))) + '(underline ((t (:underline t)))) + '(variable-pitch ((t (:family "helv")))) + '(vcursor ((t (:foreground "blue" :background "cyan" :underline t)))) + '(vertical-border ((t (:background "dim gray")))) + '(vhdl-font-lock-attribute-face ((t (:foreground "Orchid")))) + '(vhdl-font-lock-directive-face ((t (:foreground "CadetBlue")))) + '(vhdl-font-lock-enumvalue-face ((t (:foreground "Gold4")))) + '(vhdl-font-lock-function-face ((t (:foreground "Orchid4")))) + '(vhdl-font-lock-prompt-face ((t (:foreground "Red" :bold t)))) + '(vhdl-font-lock-reserved-words-face ((t (:foreground "Orange" :bold t)))) + '(vhdl-font-lock-translate-off-face ((t (:background "LightGray")))) + '(vhdl-speedbar-architecture-face ((t (:foreground "Blue")))) + '(vhdl-speedbar-architecture-selected-face ((t (:foreground "Blue" :underline t)))) + '(vhdl-speedbar-configuration-face ((t (:foreground "DarkGoldenrod")))) + '(vhdl-speedbar-configuration-selected-face ((t (:foreground "DarkGoldenrod" :underline t)))) + '(vhdl-speedbar-entity-face ((t (:foreground "ForestGreen")))) + '(vhdl-speedbar-entity-selected-face ((t (:foreground "ForestGreen" :underline t)))) + '(vhdl-speedbar-instantiation-face ((t (:foreground "Brown")))) + '(vhdl-speedbar-instantiation-selected-face ((t (:foreground "Brown" :underline t)))) + '(vhdl-speedbar-package-face ((t (:foreground "Grey50")))) + '(vhdl-speedbar-package-selected-face ((t (:foreground "Grey50" :underline t)))) + + '(viper-minibuffer-emacs-face ((t (:foreground "Black" :background "darkseagreen2")))) + '(viper-minibuffer-insert-face ((t (:foreground "Black" :background "pink")))) + '(viper-minibuffer-vi-face ((t (:foreground "DarkGreen" :background "grey")))) + '(viper-replace-overlay-face ((t (:foreground "Black" :background "darkseagreen2")))) + '(viper-search-face ((t (:foreground "Black" :background "khaki")))) + '(vm-highlight-url-face ((t (:bold t :italic t :slant italic :weight bold)))) + '(vm-highlighted-header-face ((t (:bold t :weight bold)))) + '(vm-mime-button-face ((t (:background "grey75" :foreground "black" :box (:line-width 2 :style released-button))))) + '(vm-summary-highlight-face ((t (:bold t :weight bold)))) + '(vm-xface ((t (:background "white" :foreground "black")))) + + '(which-func ((t (:foreground "Blue1")))) + '(widget ((t (:height 1.2 :background "Gray80" :foreground "black")))) + '(widget-button ((t (:bold t :weight bold :box (:line-width 2 :style released-button))))) + '(widget-button-face ((t (:bold t :weight bold :box (:line-width 2 :style released-button))))) + '(widget-button-pressed ((t (:foreground "red1" :background "lightgrey" :box (:line-width 2 :style pressed-button))))) + '(widget-button-pressed-face ((t (:foreground "red1" :background "lightgrey" :box (:line-width 2 :style pressed-button))))) + '(widget-documentation ((t (:foreground "lime green")))) + '(widget-documentation-face ((t (:foreground "lime green")))) + '(widget-field ((t (:background "dim gray")))) + '(widget-field-face ((t (:background "dim gray")))) + '(widget-inactive ((t (:foreground "grey70")))) + '(widget-inactive-face ((t (:foreground "grey70")))) + '(widget-single-line-field ((t (:background "dim gray")))) + '(widget-single-line-field-face ((t (:background "dim gray")))) + '(woman-bold-face ((t (:bold t)))) + '(woman-italic-face ((t (:foreground "beige")))) + '(woman-unknown-face ((t (:foreground "LightSalmon"))))) + +(provide-theme 'manoj-dark) + +;; Local Variables: +;; no-byte-compile: t +;; End: + +;;; manoj-dark.el ends here diff --git a/etc/tutorials/TUTORIAL.zh b/etc/tutorials/TUTORIAL.zh index a7dc9e63a4a..da628a3af68 100644 --- a/etc/tutorials/TUTORIAL.zh +++ b/etc/tutorials/TUTORIAL.zh @@ -1,4 +1,4 @@ -Emacs §Öłt«ü«nˇ]. +Emacs §Öłt«ü«n. Emacs «üĄOłq±`Ą]§t¦ł CONTROL Áäˇ]¦ł®ÉÔĄH CTRL ©Î CTL ¨ÓĽĐĄÜˇ^©Î¬O META Áäˇ]¦ł®ÉÔĄH EDIT ©Î ALT ¨ÓĽĐĄÜˇ^ˇC¬°¤FÁקK¨C¤@¦¸łŁnĽgĄX¨äĄţ¦WˇA diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index ec123e85036..098ee06c762 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,17 @@ +2011-07-02 Jason Rumney <jasonr@gnu.org> + + * emacsclient.c (decode_options) [WINDOWSNT]: Avoid tty mode on + Windows (Bug#5486). + +2011-06-25 Glenn Morris <rgm@gnu.org> + + * emacsclient.c (decode_options) <opt>: Add `F:'. + (print_help_and_exit): Mention --frame-parameters. + +2011-06-25 Andreas Rottmann <a.rottmann@gmx.at> + + * emacsclient.c (longopts, decode_options, main): Add frame-parameters. + 2011-06-10 Paul Eggert <eggert@cs.ucla.edu> * movemail.c: Fix race condition and related bugs (Bug#8836). diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index c334fb6a196..2af139aee6d 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -160,6 +160,10 @@ const char *server_file = NULL; /* PID of the Emacs server process. */ int emacs_pid = 0; +/* If non-NULL, a string that should form a frame parameter alist to + be used for the new frame */ +const char *frame_parameters = NULL; + static void print_help_and_exit (void) NO_RETURN; static void fail (void) NO_RETURN; @@ -175,6 +179,7 @@ struct option longopts[] = { "nw", no_argument, NULL, 't' }, { "create-frame", no_argument, NULL, 'c' }, { "alternate-editor", required_argument, NULL, 'a' }, + { "frame-parameters", required_argument, NULL, 'F' }, #ifndef NO_SOCKETS_IN_FILE_SYSTEM { "socket-name", required_argument, NULL, 's' }, #endif @@ -526,9 +531,9 @@ decode_options (int argc, char **argv) { int opt = getopt_long_only (argc, argv, #ifndef NO_SOCKETS_IN_FILE_SYSTEM - "VHneqa:s:f:d:tc", + "VHneqa:s:f:d:F:tc", #else - "VHneqa:f:d:tc", + "VHneqa:f:d:F:tc", #endif longopts, 0); @@ -599,6 +604,10 @@ decode_options (int argc, char **argv) print_help_and_exit (); break; + case 'F': + frame_parameters = optarg; + break; + default: message (TRUE, "Try `%s --help' for more information\n", progname); exit (EXIT_FAILURE); @@ -643,6 +652,14 @@ decode_options (int argc, char **argv) an empty string"); exit (EXIT_FAILURE); } + + /* TTY frames not supported on Windows. Continue using GUI rather than + forcing the user to change their command-line. This is required since + tty is set above if certain options are given and $DISPLAY is not set, + which is not obvious to users. */ + if (tty) + tty = 0; + #endif /* WINDOWSNT */ } @@ -665,6 +682,8 @@ The following OPTIONS are accepted:\n\ -nw, -t, --tty Open a new Emacs frame on the current terminal\n\ -c, --create-frame Create a new frame instead of trying to\n\ use the current Emacs frame\n\ +-F ALIST, --frame-parameters=ALIST\n\ + Set the parameters of a new frame\n\ -e, --eval Evaluate the FILE arguments as ELisp expressions\n\ -n, --no-wait Don't wait for the server to return\n\ -q, --quiet Don't display messages on success\n\ @@ -1630,6 +1649,13 @@ main (int argc, char **argv) send_to_emacs (emacs_socket, " "); } + if (frame_parameters && !current_frame) + { + send_to_emacs (emacs_socket, "-frame-parameters "); + quote_argument (emacs_socket, frame_parameters); + send_to_emacs (emacs_socket, " "); + } + /* If using the current frame, send tty information to Emacs anyway. In daemon mode, Emacs may need to occupy this tty if no other frame is available. */ diff --git a/lib/dup2.c b/lib/dup2.c new file mode 100644 index 00000000000..e00dc7b2e3c --- /dev/null +++ b/lib/dup2.c @@ -0,0 +1,132 @@ +/* Duplicate an open file descriptor to a specified file descriptor. + + Copyright (C) 1999, 2004-2007, 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 <http://www.gnu.org/licenses/>. */ + +/* written by Paul Eggert */ + +#include <config.h> + +/* Specification. */ +#include <unistd.h> + +#include <errno.h> +#include <fcntl.h> + +#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__ +/* Get declarations of the Win32 API functions. */ +# define WIN32_LEAN_AND_MEAN +# include <windows.h> +#endif + +#if HAVE_DUP2 + +# undef dup2 + +int +rpl_dup2 (int fd, int desired_fd) +{ + int result; +# if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__ + /* If fd is closed, mingw hangs on dup2 (fd, fd). If fd is open, + dup2 (fd, fd) returns 0, but all further attempts to use fd in + future dup2 calls will hang. */ + if (fd == desired_fd) + { + if ((HANDLE) _get_osfhandle (fd) == INVALID_HANDLE_VALUE) + { + errno = EBADF; + return -1; + } + return fd; + } + /* Wine 1.0.1 return 0 when desired_fd is negative but not -1: + http://bugs.winehq.org/show_bug.cgi?id=21289 */ + if (desired_fd < 0) + { + errno = EBADF; + return -1; + } +# elif !defined __linux__ + /* On Haiku, dup2 (fd, fd) mistakenly clears FD_CLOEXEC. */ + if (fd == desired_fd) + return fcntl (fd, F_GETFL) == -1 ? -1 : fd; +# endif + result = dup2 (fd, desired_fd); +# ifdef __linux__ + /* Correct a Linux return value. + <http://git.kernel.org/?p=linux/kernel/git/stable/linux-2.6.30.y.git;a=commitdiff;h=2b79bc4f7ebbd5af3c8b867968f9f15602d5f802> + */ + if (fd == desired_fd && result == (unsigned int) -EBADF) + { + errno = EBADF; + result = -1; + } +# endif + if (result == 0) + result = desired_fd; + /* Correct a cygwin 1.5.x errno value. */ + else if (result == -1 && errno == EMFILE) + errno = EBADF; +# if REPLACE_FCHDIR + if (fd != desired_fd && result != -1) + result = _gl_register_dup (fd, result); +# endif + return result; +} + +#else /* !HAVE_DUP2 */ + +/* On older platforms, dup2 did not exist. */ + +# ifndef F_DUPFD +static int +dupfd (int fd, int desired_fd) +{ + int duplicated_fd = dup (fd); + if (duplicated_fd < 0 || duplicated_fd == desired_fd) + return duplicated_fd; + else + { + int r = dupfd (fd, desired_fd); + int e = errno; + close (duplicated_fd); + errno = e; + return r; + } +} +# endif + +int +dup2 (int fd, int desired_fd) +{ + int result = fcntl (fd, F_GETFL) < 0 ? -1 : fd; + if (result == -1 || fd == desired_fd) + return result; + close (desired_fd); +# ifdef F_DUPFD + result = fcntl (fd, F_DUPFD, desired_fd); +# if REPLACE_FCHDIR + if (0 <= result) + result = _gl_register_dup (fd, result); +# endif +# else + result = dupfd (fd, desired_fd); +# endif + if (result == -1 && (errno == EMFILE || errno == EINVAL)) + errno = EBADF; + return result; +} +#endif /* !HAVE_DUP2 */ diff --git a/lib/getopt.c b/lib/getopt.c index 23510d8afec..2af8352ee9c 100644 --- a/lib/getopt.c +++ b/lib/getopt.c @@ -829,7 +829,7 @@ _getopt_internal_r (int argc, char **argv, const char *optstring, 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; diff --git a/lib/gnulib.mk b/lib/gnulib.mk index 0fd7f520acb..18abe4536fa 100644 --- a/lib/gnulib.mk +++ b/lib/gnulib.mk @@ -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 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 +# 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 dup2 filemode getloadavg getopt-gnu ignore-value intprops lstat mktime readlink socklen stdarg stdio strftime strtoumax symlink sys_stat MOSTLYCLEANFILES += core *.stackdump @@ -159,6 +159,15 @@ EXTRA_libgnu_a_SOURCES += ftoastr.c ## end gnulib module dtoastr +## begin gnulib module dup2 + + +EXTRA_DIST += dup2.c + +EXTRA_libgnu_a_SOURCES += dup2.c + +## end gnulib module dup2 + ## begin gnulib module filemode libgnu_a_SOURCES += filemode.c diff --git a/lib/stat.c b/lib/stat.c index cbc9100fd4d..f07370dd06b 100644 --- a/lib/stat.c +++ b/lib/stat.c @@ -38,6 +38,7 @@ orig_stat (const char *filename, struct stat *buf) #include <stdbool.h> #include <string.h> #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 @@ rpl_stat (char const *name, struct stat *st) } #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 @@ rpl_stat (char const *name, struct stat *st) 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) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b85a1680286..5dd52709746 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -34,6 +34,1118 @@ * loadup.el: Load international/charprop.el before international/characters. +2011-07-06 Richard Stallman <rms@gnu.org> + + * mail/rmailmm.el (rmail-mime-process): Use markers for buf positions. + (rmail-mime-insert-bulk, rmail-mime-insert-text): + Treat markers like ints. + (rmail-mime-entity): Doc fix. + +2011-07-06 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * mail/smtpmail.el (smtpmail-default-smtp-server): Made into a + defcustom again for backwards compatibility. + + * simple.el (shell-command-on-region): Fill. + + * dired-aux.el (dired-kill-line): Add a doc string. + + * dabbrev.el (dabbrev-abbrev-char-regexp): Note that nil defaults + to "\\sw\\|\\s_" (bug#358). + + * dired.el (dired-mode): Clarify "unmark or unflag" (bug#8770). + (dired-unmark-backward): Ditto. + (dired-flag-backup-files): Ditto. + + * dired-x.el (dired-mark-sexp): Ditto. + +2011-07-06 Richard Stallman <rms@gnu.org> + + * mail/rmailmm.el: Give entity a new slot, TRUNCATED. + (rmail-mime-entity): New arg TRUNCATED. + (rmail-mime-entity-truncated, rmail-mime-entity-set-truncated): + New functions. + (rmail-mime-save): Warn if entity is truncated. + (rmail-mime-toggle-hidden): Likewise, for showing. + (rmail-mime-process-multipart): Record when an entity is truncated. + + * mail/rmailmm.el (rmail-search-mime-message): Don't get confused + if ENTITY is a string. + +2011-07-06 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * emacs-lisp/lisp-mode.el (eval-defun-1): Update the documentation + of faces when `M-C-x'-ing their definitions (bug#8378). Also + clean up the code slightly. + + * progmodes/grep.el (rgrep): Don't bind `process-connection-type', + because that makes the colours go away. + + * mail/sendmail.el (send-mail-function): Change the default to + `sendmail-query-once'. + (sendmail-query-once): Add an autoload cookie. + + * net/network-stream.el (network-stream-open-starttls): Try using + a plain connection even if the server offered STARTTLS, and we + kinda wanted to use it, if Emacs doesn't have any STARTTLS + capability. This should make smtpmail.el work in slightly more + configurations. + +2011-07-06 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-compat.el (tramp-compat-pop-to-buffer-same-window): + New defun. + * net/tramp-cmds.el (tramp-append-tramp-buffers): Use it. + +2011-07-06 Michael R. Mauger <mmaug@yahoo.com> + + * progmodes/sql.el: Version 3.0 + (sql-product-alist): Added product :completion-object, + :completion-column, and :statement attributes. + (sql-mode-menu, sql-interactive-mode-map): Fixed List entries. + (sql-mode-syntax-table): Mark all punctuation. + (sql-font-lock-keywords-builder): Temporarily removed fallback on + ansi keywords. + (sql-regexp-abbrev, sql-regexp-abbrev-list): New functions. + (sql-mode-oracle-font-lock-keywords): Improved. + (sql-oracle-show-reserved-words): New function for development. + (sql-product-font-lock): Simplify for source code buffers. + (sql-product-syntax-table, sql-product-font-lock-syntax-alist): + New functions. + (sql-highlight-product): Set product specific syntax table. + (sql-mode-map): Added statement movement functions. + (sql-ansi-statement-starters, sql-oracle-statement-starters): New + variable. + (sql-statement-regexp, sql-beginning-of-statement) + (sql-end-of-statement, sql-signum): New functions. + (sql-buffer-live-p, sql=find-sqli-buffer): Added CONNECTION + parameter. + (sql-show-sqli-buffer): Bug fix. + (sql-interactive-mode): Store connection data as buffer local. + (sql-connect): Added NEW-NAME parameter. Redesigned interaction + with sql-interactive-mode. + (sql-save-connection): Save buffer local settings. + (sql-connection-menu-filter): Changed menu entry name. + (sql-product-interactive): Bug fix. + (sql-preoutput-hold): New variable. + (sql-interactive-remove-continuation-prompt): Bug fixes. + (sql-debug-redirect): New variable. + (sql-str-literal): New function. + (sql-redirect, sql-redirect-one, sql-redirect-value, sql-execute): + Redesigned. + (sql-oracle-save-settings, sql-oracle-restore-settings) + (sql-oracle-list-all, sql-oracle-list-table): New functions. + (sql-completion-object, sql-completion-column) + (sql-completion-sqlbuf): New variables. + (sql-build-completions-1, sql-build-completions) + (sql-try-completion): New functions. + (sql-read-table-name): Use them. + (sql-contains-names): New buffer local variable. + (sql-list-all, sql-list-table): Use it. + (sql-oracle-completion-types): New variable. + (sql-oracle-completion-object, sql-sqlite-completion-object) + (sql-postgres-completion-object): New functions. + +2011-07-06 Glenn Morris <rgm@gnu.org> + + * window.el (pop-to-buffer): Doc fix. + +2011-07-06 Markus Heiser <markus.heiser@darmarit.de> (tiny change) + + * progmodes/gud.el (gud-pdb-marker-regexp): Accept \r char (Bug#5653). + +2011-07-06 Chong Yidong <cyd@stupidchicken.com> + + * window.el (special-display-popup-frame): Doc fix (Bug#8853). + + * info.el (Info-directory-toc-nodes): Minor doc fix (Bug#8833). + +2011-07-05 Chong Yidong <cyd@stupidchicken.com> + + * button.el (button): Inherit from link face. Suggested by Dan + Nicolaescu. + +2011-07-05 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/gdb-mi.el: Fit in 80 columns. + (gdb-setup-windows, gdb-restore-windows): Avoid other-window and + switch-to-buffer. + + * progmodes/which-func.el (which-func-ff-hook): Don't output a message + if imenu is simply not configured (bug#8941). + +2011-07-05 Ken Manheimer <ken.manheimer@gmail.com> + + * allout.el (allout-post-undo-hook): New allout outline-change + event hook to signal undo activity. + (allout-post-command-business): Run allout-post-undo-hook if an + undo just occurred. + (allout-after-copy-or-kill-hook, allout-mode): Minor docstring changes. + * allout-widgets.el (allout-widgets-after-undo-function): + Ensure the integrity of the current item's decoration after it has been + in the vicinity of an undo. + (allout-widgets-mode): Include allout-widgets-after-undo-function + on the new allout-post-undo-hook. + +2011-07-05 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/lisp-mode.el (lisp-interaction-mode-abbrev-table): + Let define-derived-mode define it. + * emacs-lisp/derived.el (define-derived-mode): Try to avoid creating + cycles of abbrev-table inheritance (bug#8998). + +2011-07-05 Roland Winkler <winkler@gnu.org> + + * textmodes/bibtex.el: Add support for biblatex. + (bibtex-BibTeX-entry-alist, bibtex-biblatex-entry-alist) + (bibtex-BibTeX-field-alist, bibtex-biblatex-field-alist) + (bibtex-dialect-list, bibtex-dialect, bibtex-no-opt-remove-re) + (bibtex-entry-alist, bibtex-field-alist): New variables. + (bibtex-entry-field-alist): Obsolete alias for + bibtex-BibTeX-entry-alist. + (bibtex-entry-alist, bibtex-field-alist): New widgets. + (bibtex-set-dialect): New command. + (bibtex-entry-type, bibtex-entry-head) + (bibtex-entry-maybe-empty-head, bibtex-any-valid-entry-type): + Bind via bibtex-set-dialect. + (bibtex-Article, bibtex-Book, bibtex-Booklet, bibtex-InBook) + (bibtex-InCollection, bibtex-InProceedings, bibtex-Manual) + (bibtex-MastersThesis, bibtex-Misc, bibtex-PhdThesis) + (bibtex-Proceedings, bibtex-TechReport, bibtex-Unpublished): + Define via bibtex-set-dialect. + (bibtex-name-in-field, bibtex-remove-OPT-or-ALT): + Obey bibtex-no-opt-remove-re. + (bibtex-vec-push, bibtex-vec-incr): New functions. + (bibtex-format-entry, bibtex-field-list) + (bibtex-print-help-message, bibtex-validate) + (bibtex-search-entries): Use new format of bibtex-entry-alist. + +2011-07-05 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/compile.el (compilation-goto-locus): + * net/tramp-cmds.el (tramp-append-tramp-buffers): + * bs.el (bs-cycle-next, bs-cycle-previous): + * bookmark.el (bookmark-bmenu-list, bookmark-bmenu-2-window): + * bindings.el (mode-line-other-buffer): + * autoinsert.el (auto-insert): + * arc-mode.el (archive-extract): + * abbrev.el (edit-abbrevs): Fix some uses of switch-to-buffer. + +2011-07-05 Juanma Barranquero <lekktu@gmail.com> + + * emacs-lock.el (emacs-lock-mode): Fix typo in variable name. + Fix check of `emacs-lock-unlockable-modes'. + Coerce true values of `emacs-lock--try-unlocking' to t. + +2011-07-05 Juanma Barranquero <lekktu@gmail.com> + + * obsolete/old-emacs-lock.el: Rename from emacs-lock.el. + * emacs-lock.el: New file. + +2011-07-05 Julien Danjou <julien@danjou.info> + + * textmodes/rst.el (rst-define-level-faces): Use `facep' rather + than `boundp' to check if face is set. + +2011-07-05 Juanma Barranquero <lekktu@gmail.com> + + * register.el (registerv-make): + * window.el (window-min-height): Fix typos in docstrings. + +2011-07-05 Jan Djärv <jan.h.d@swipnet.se> + + * dynamic-setting.el (dynamic-setting-handle-config-changed-event): + Update doc string. + +2011-07-04 Juanma Barranquero <lekktu@gmail.com> + + * server.el (server-execute): Catch quit and call + `server-return-error' to pass the error back to emacsclient and + close the connection (bug#8942). + +2011-07-04 Ken Manheimer <ken.manheimer@gmail.com> + + * allout.el (allout-encrypt-unencrypted-on-saves): Do not provide + insecure exception for current topic. Also note that auto-saves + are handled differently. + + (allout-auto-save-temporarily-disabled), (allout-just-did-undo): + State variables for tracking auto-save inhibition situation. + + (allout-write-contents-hook-handler): Rename from + 'allout-write-file-hook-handler', and describe how it depends on + write-contents-functions sensitivity to non-nil value to prevent + file write. + + (allout-auto-save-hook-handler): Remove. auto-save does not check + this in individual buffers, only in the starting buffer, so this + is not the right way for us to inhibit auto-save in a buffer + according to its condition. + + (allout-mode): Use new allout-write-contents-hook-handler, and + only with write-contents-functions. Remove auto-save provisions - + they're implemented elsewhere. + + (allout-before-change-handler): If undo is in progress, note that + for attention of allout-post-command-business. + + (allout-post-command-business): If the command we're following was + an undo, check for change in the status of encrypted items and + adjust auto-save inhibitions accordingly. + + (allout-toggle-subtree-encryption): Adjust auto-save inhibition + according to whether there are or aren't any plain-text topics + pending encryption. + + (allout-inhibit-auto-save-info-for-decryption): + Adjust buffer-saved-size and some allout state to inhibit auto-saves if + there are plain-text topics pending encryption. + + (allout-maybe-resume-auto-save-info-after-encryption): Adjust + buffer-saved-size and some allout state to not inhibit auto-saves + if there are no longer any plain-text topics pending encryption. + + (allout-next-topic-pending-encryption), + (allout-encrypt-decrypted): No longer provide for exemption of the + current topic. + +2011-07-04 Juri Linkov <juri@jurta.org> + + Add 7z operations to delete and save changed members (bug#8968). + * arc-mode.el (archive-7z-expunge, archive-7z-update): + New defcustoms. + (archive-7z-write-file-member): New function. + (archive-7z-summarize): Fix the number of dashes in the + listing output. + +2011-07-04 Stefan Monnier <monnier@iro.umontreal.ca> + + * pcmpl-linux.el (pcomplete-pare-list): Re-add, from pcomplete.el + (bug#8958). + +2011-07-04 Chong Yidong <cyd@stupidchicken.com> + + * bindings.el: Ignore next-buffer and previous-buffer in + minibuffer-local-map. + + * font-lock.el (font-lock-builtin-face): Change light background + color to dark slate blue (Bug#6693). + +2011-07-04 Wang Diancheng <dcwang@kingbase.com.cn> (tiny change) + + * progmodes/gdb-mi.el (gdb): Use completion-at-point. + +2011-07-04 Stefan Monnier <monnier@iro.umontreal.ca> + + * files.el (find-file): Use pop-to-buffer-same-window (bug#8911). + * emacs-lisp/bytecomp.el (byte-compile-interactive-only-functions): + Add switch-to-buffer. + +2011-07-04 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * isearch.el (isearch-search-fun-function): Clarify further the + meaning of the function returned. + +2011-07-04 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-cmds.el (tramp-cleanup-this-connection): New command. + + * net/tramp-sh.el (tramp-color-escape-sequence-regexp): New defconst. + (tramp-sh-handle-insert-directory, tramp-convert-file-attributes): + Use it. + (tramp-remote-path): Add "/bin" and "/usr/bin". On busyboxes, + `tramp-default-remote-path' does not exist. + (tramp-send-command-and-read): New optional argument NOERROR. + (tramp-open-connection-setup-interactive-shell) + (tramp-get-remote-path, tramp-get-remote-stat): Use it. + (tramp-get-remote-readlink): Do not mask with `ignore-errors'. + (tramp-process-sentinel): Flush also process' connection property. + (tramp-sh-handle-start-file-process): Do not set process + sentinel. It is done now ... + (tramp-maybe-open-connection): ... here. (Bug#8929) + +2011-07-04 MON KEY <monkey@sandpframing.com> + + * play/animate.el (animate-string): Doc fixes and allow changing + the buffer name (bug#5417). + +2011-07-04 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * play/animate.el (animation-buffer-name): Rename from *animate*. + +2011-07-04 Paul Eggert <eggert@cs.ucla.edu> + + * emacs-lisp/timer.el: Use time-date fns rather than rolling our own. + This is simpler and helps future-proof the code. + (timer-until): Use time-subtract and float-time. + (timer--time-less-p): Use time-less-p. + +2011-07-04 Juanma Barranquero <lekktu@gmail.com> + + * type-break.el (timep): Use the value of `float-time' to avoid a + byte-compiler warning. + + * server.el (server-eval-and-print): Return any result, even nil. + +2011-07-03 Paul Eggert <eggert@cs.ucla.edu> + + * type-break.el: Accept time formats that the builtins accept. + (timep, type-break-time-difference): Accept any format that + float-time accepts, rather than insisting on (HIGH LOW USECS) format. + This is simpler and helps future-proof the code. + (type-break-time-difference): Round rather than ignoring + subseconds components. + +2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * info.el (Info-apropos-matches): Make non-interactive, since it + doesn't seem to do anything useful as a command (bug#8829). + +2011-07-03 Chong Yidong <cyd@stupidchicken.com> + + * frame.el (frame-background-mode, frame-set-background-mode): + Move from faces.el. + (frame-default-terminal-background): New function. + + * custom.el (custom-push-theme): Don't record faces in `changed' + theme; this doesn't work correctly for per-frame face settings. + (disable-theme): Use face-set-after-frame-default to reset faces. + (custom--frame-color-default): New function. + +2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * dired.el (dired-flagging-regexp): Remove unused variable + (bug#8769). + +2011-03-29 Kevin Ryde <user42@zip.com.au> + + * progmodes/compile.el (compilation-error-regexp-alist-alist): + `perl-Test2' extend to match possible "fail #N" rep count + (bug#8377). + +2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * mail/feedmail.el (feedmail-buffer-to-smtpmail): + `smtpmail-via-smtp' now returns the error instead of nil. + + * isearch.el (isearch-search-fun-function): Clarify the doc string + (bug#8101). + +2011-07-03 Richard Kim <emacs18@gmail.com> (tiny change) + + * textmodes/texnfo-upd.el (texinfo-insert-menu): Don't insert + unnecessary spaces (bug#8987). + +2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/network-stream.el (open-network-stream): Use the + :end-of-capability command thoughout. + +2011-07-03 Wolfgang Jenkner <wjenkner@inode.at> (tiny change) + + * net/network-stream.el (open-network-stream): Add the + :end-of-capability command parameter, used by pop3.el. + +2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * dired.el (dired-map-over-marks): Refill the doc string (bug#6814). + + * fringe.el (fringe-query-style): Remove redundant text " (type ? + for list)" (bug#6475). + + * files.el (file-expand-wildcards): Ignore non-readable + sub-directories while trying to find matches instead of signalling + an error (bug#6297). + + * man.el (Man-reference-regexp): Allow matching possible + word-wrapped references (bug#6289). + + * vc/vc.el (vc-modify-change-comment): Change *VC-log* to *vc-log* + for consistency with the other vc buffers (bug#6197). + (vc-checkin): Ditto. + + * vc/vc-arch.el: Fix comments to match the *VC-log* name change. + + * longlines.el (longlines-mode): Document what ARG does (bug#6150). + +2011-07-02 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * custom.el (defcustom): Clarify that :set is only used in the + Customize user interface (bug#6089). + + * progmodes/flymake.el (flymake-mode): If the buffer isn't + associated with a file, refuse to run instead of erroring out + (bug#6084). + + * textmodes/fill.el (fill-region): Remove the "Ordinarily" from + the doc string, since it appears that using `fill-column' always + controls the width (bug#7845). + + * simple.el (shell-command-on-region): Say where the error output + went if `shell-command-default-error-buffer' is set (bug#6857). + +2011-07-02 Ken Manheimer <ken.manheimer@gmail.com> + + * allout.el (allout-yank-processing): Adjust cursor position for + backwards-deleted space. + + (allout-rebullet-heading): Register changes with + allout-exposure-changed-hook, so the modified topic is properly + decorated. + +2011-07-02 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * minibuffer.el (completion-in-region): Document PREDICATE + (bug#7136). + + * info-look.el (info-lookup-add-help): Clarify that ARGS is a list + of keyword/argument pairs (bug#6904). + + * replace.el (multi-occur): + Mention `multi-occur-in-matching-buffers' in the doc string (bug#7566). + +2011-07-02 Drew Adams <drew.adams@oracle.com> + + * dired.el (dired-mark-if): Make the message about whether it's + marking or unmarking clearer (bug#8523). + +2011-07-02 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * disp-table.el (display-table-print-array): New function. + (describe-display-table): Use it to print the vectors more pretty + (Bug#8859). + +2011-07-02 Martin Rudalics <rudalics@gmx.at> + + * window.el (window-state-get-1): Don't assign clone numbers. + Add clone-of item to list of window parameters. + (window-state-put-2): Don't process clone numbers. + (display-buffer-alist): Fix doc-string. + +2011-07-02 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (remq): Don't allocate if it's not needed. + (keymap--menu-item-binding, keymap--menu-item-with-binding) + (keymap--merge-bindings): New functions. + (keymap-canonicalize): Use them to refine the canonicalization. + * minibuffer.el (minibuffer-local-completion-map) + (minibuffer-local-must-match-map): Move initialization from C. + (minibuffer-local-filename-completion-map): Move initialization from C; + don't inherit from anything here. + (minibuffer-local-filename-must-match-map): Make obsolete. + (completing-read-default): Use make-composed-keymap to combine + minibuffer-local-filename-completion-map with either + minibuffer-local-must-match-map or + minibuffer-local-filename-completion-map. + +2011-07-01 Glenn Morris <rgm@gnu.org> + + * type-break.el (type-break-time-sum): Use dolist. + + * textmodes/flyspell.el (flyspell-word-search-backward): + Replace CL function. + +2011-07-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * mouse.el (mouse--strip-first-event): New function. + (function-key-map): Use it to map fringe clicks to normal clicks + by default. + + * vc/vc-bzr.el (vc-bzr-revision-keywords): Update. + (vc-bzr-revision-completion-table): Add support for annotate and date. + + * emacs-lisp/derived.el (define-derived-mode): Make abbrev-table + inherit from parent. + +2011-07-01 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * dired-aux.el (dired-diff): Doc fixup (bug#8816). + (dired-show-file-type): Doc fixup (bug#8818). + + * dired.el (dired-mode): Fix up the doc string as suggested by + Drew Adams (bug#8817). + + * progmodes/flymake.el (flymake-find-file-hook): Add an `autoload' + cookie, since the manual says that it should be possible to add + this function to `find-file-hook' (bug#8709). + +2011-07-01 Teodor Zlatanov <tzz@lifelogs.com> + + * progmodes/cfengine.el: Moved all cfengine3.el functionality + here. Noted Ted Zlatanov as the maintainer. + (cfengine-common-settings, cfengine-common-syntax): New functions + to set up common things between `cfengine-mode' and + `cfengine3-mode'. + (cfengine3-mode): New mode. + (cfengine3-defuns cfengine3-defuns-regex + (cfengine3-class-selector-regex cfengine3-category-regex) + (cfengine3-vartypes cfengine3-font-lock-keywords) + (cfengine3-beginning-of-defun, cfengine3-end-of-defun) + (cfengine3-indent-line): Add from cfengine3.el. + +2011-07-01 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-encoding-command-interactive): New defcustom. + + * net/tramp-sh.el (tramp-maybe-open-connection): Use it. + +2011-07-01 Martin Rudalics <rudalics@gmx.at> + + * window.el (same-window-buffer-names, same-window-regexps) + (same-window-p, special-display-frame-alist) + (special-display-popup-frame, special-display-function) + (special-display-buffer-names, special-display-regexps) + (special-display-p, pop-up-frame-alist, pop-up-frame-function) + (pop-up-frames, display-buffer-reuse-frames, pop-up-windows) + (split-window-preferred-function, split-height-threshold) + (split-width-threshold, even-window-heights) + (display-buffer-mark-dedicated, window-splittable-p) + (split-window-sensibly, window-safely-shrinkable-p): + Un-obsolete. + (display-buffer): Don't spread args with function specifier + because special-display-popup-frame won't like it. + +2011-07-01 Paul Eggert <eggert@cs.ucla.edu> + + Time-stamp simplifications and fixes. + These improve accuracy slightly, and future-proof the code + against some potential changes to current-time format. + + * woman.el (woman-decode-buffer, WoMan-log-end): Log fractional secs + by using time-since and float-time. + + * vc/ediff-util.el (ediff-calc-command-time): Use time-since + and float-time. Say "NNN.NNN seconds" rather than "NNN seconds + + NNN microseconds". + + * type-break.el (type-break-time-sum): Rewrite using time-add. + + * play/hanoi.el (hanoi-current-time-float): Remove. + All uses replaced by float-time. + + * nxml/rng-maint.el (rng-time-function): Rewrite using time-subtract. + This yields a more-accurate answer. + (rng-time-to-float): Remove; no longer needed. + + * emacs-lisp/timer.el (timer-relative-time): Use time-add. + + * calendar/timeclock.el (timeclock-seconds-to-time): + Defalias to seconds-to-time, since they're the same thing. + + * emacs-lisp/elp.el (elp-elapsed-time): + * emacs-lisp/benchmark.el (benchmark-elapse): + * allout-widgets.el (allout-elapsed-time-seconds): Use float-time. + +2011-07-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * window.el (bury-buffer): Don't iconify the only frame. + (switch-to-buffer): Revert to Emacs<23 behavior, i.e. do not fallback + to pop-to-buffer. Use pop-to-buffer-same-frame if you don't like that. + +2011-07-01 Chong Yidong <cyd@stupidchicken.com> + + * eshell/em-smart.el (eshell-smart-display-navigate-list): + Add mouse-yank-primary. + +2011-07-01 Teodor Zlatanov <tzz@lifelogs.com> + + * progmodes/cfengine3.el: New file to support CFEngine 3.x. + +2011-07-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/find-func.el (find-library--load-name): New fun. + (find-library-name): Use it to find relative load names when provided + absolute file name (bug#8803). + +2011-06-30 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * textmodes/flyspell.el (flyspell-word): Consider words that + differ only in case as potential doublons (bug#5687). + + * net/soap-client.el (soap-invoke, soap-wsdl-resolve-references): + Remove two rather uninteresting debugging-like messages to make + debbugs.el more silent. + + * comint.el (comint-password-prompt-regexp): Accept "Response" as + a password-like phrase. + +2011-06-30 Mastake YAMATO <yamato@redhat.com> + + * progmodes/cc-guess.el: New file. + + * progmodes/cc-langs.el (c-mode-menu): Add "Style..." submenu. + + * progmodes/cc-styles.el (cc-choose-style-for-mode): New function + derived from `c-basic-common-init'. + + * progmodes/cc-mode.el (top-level): Require cc-guess. + (c-basic-common-init): Use `cc-choose-style-for-mode'. + +2011-06-30 Lawrence Mitchell <wence@gmx.li> + + * progmodes/js.el (js-mode): Don't stomp on global settings (bug#8933). + +2011-06-30 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-engine.el (c-guess-continued-construct): + Correct the handling of template-args-cont, particularly for when font + lock is disabled. Name this case as "CASE G". + +2011-06-30 Ken Manheimer <ken.manheimer@gmail.com> + + * allout.el (allout-yank-processing): Fix injection of extra space + between bullet and non-whitespace character in first topic when + pasting, ensuring that the actual spacing in the pasted topic + following the bullet char is preserved. This extra space was + causing pasted encrypted topics to get a decrypted status even + when the content was actually still encrypted. Now the decryption + status from before the paste is preserved. + + (allout-flag-region): Set all allout overlays so they evaporate + when reduced to zero length (evanescent), to prevent overlay + leakage. + +2011-06-30 Glenn Morris <rgm@gnu.org> + + * w32-fns.el (w32-charset-info-alist): Declare. + + * find-dired.el (find-grep-options): Simplify. + + * term/ns-win.el (ns-set-resource): Declare. + + * ses.el (row, col): Declare dynamic variables honestly. + + * textmodes/reftex-parse.el (index-tags): Declare. + +2011-06-30 Chong Yidong <cyd@stupidchicken.com> + + * cus-edit.el (customize-push-and-save): New function. + + * files.el (hack-local-variables-confirm): Use it. + + * custom.el (load-theme): New arg NO-CONFIRM. + Use customize-push-and-save (Bug#8720). + (custom-enabled-themes): Doc fix. + + * cus-theme.el (customize-create-theme) + (custom-theme-merge-theme): Callers to load-theme changed. + +2011-06-30 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * thingatpt.el (thing-at-point-short-url-regexp): Require that + short URLs have at least one dot in them (bug #7614). + + * progmodes/grep.el (rgrep): Bind `process-connection-type' to + nil, because using a pty is apparently too slow (bug #895). + +2011-06-29 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * mail/sendmail.el (sendmail-query-once): New function. + (sendmail-query-once-function): New variable. + +2011-06-29 Glenn Morris <rgm@gnu.org> + + * files.el (auto-mode-alist): Add .f03, .f08 for f90-mode. + + * ses.el (top-level): Require cl when compiling. + (ses-set-localvars): Fix error statement. + Call it at compile time to silence a storm of warnings. + +2011-06-29 Martin Rudalics <rudalics@gmx.at> + + * window.el (normalize-live-buffer): Rename to + window-normalize-buffer. + (normalize-live-frame): Rename to window-normalize-frame. + (normalize-any-window): Rename to window-normalize-any-window. + (normalize-live-window): Rename to window-normalize-live-window. + (make-window-atom): Rename to window-make-atom. + (window-resize-reset): Rename to window--resize-reset. + (window-resize-reset-1): Rename to window--resize-reset-1. + (resize-mini-window): Rename to window--resize-mini-window. + (resize-subwindows-skip-p): Rename to + window--resize-subwindows-skip-p. + (resize-subwindows-normal): Rename to + window--resize-subwindows-normal. + (resize-subwindows): Rename to window--resize-subwindows. + (resize-other-windows): Rename to window--resize-siblings. + (resize-this-window): Rename to window--resize-this-window. + (resize-root-window): Rename to window--resize-root-window. + (resize-root-window-vertically): Rename to + window--resize-root-window-vertically. + (normalize-buffer-to-display): Rename to + window-normalize-buffer-to-display. + (normalize-buffer-to-switch-to): Rename to + window-normalize-buffer-to-switch-to. + Correspondingly update all callers of the functions listed + above. + (display-buffer-alist, display-buffer-normalize-arguments) + (display-buffer-normalize-options, display-buffer) + (display-buffer-alist-set): Use "function" instead of + "fun-with-args". + +2011-06-28 Chong Yidong <cyd@stupidchicken.com> + + * mail/emacsbug.el (report-emacs-bug): Handle non-gnu bug + addresses more clearly. Add hyperlinks for bug-gnu-emacs and + debbugs.gnu.org. Mention acknowledgment email. + +2011-06-28 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * mail/smtpmail.el (smtpmail-send-it): Leave off changing the + buffer multibyteness, since it shouldn't matter. + +2011-06-28 Martin Rudalics <rudalics@gmx.at> + + * window.el (display-buffer-in-side-window): Handle dedicated + windows as in display-buffer-reuse-window. + (display-buffer-normalize-alist): Use value of override + specifier. + (display-buffer-normalize-specifiers): Use value of + other-window-means-other-frame specifier. + (display-buffer-alist): Rewrite some texts in widgets. + (display-buffer): Spread arguments when calling function + specified by fun-with-args. + +2011-06-28 Deniz Dogan <deniz@dogan.se> + + * emacs-lisp/lisp-mode.el (emacs-lisp-mode-syntax-table): + Unnest `let'. + + * textmodes/css-mode.el (css-font-lock-keywords): Fix grouped + selectors (Bug#5732). + (css-proprietary-nmstart-re): Use `regexp-opt'. + +2011-06-27 Jari Aalto <jari.aalto@cante.net> + + * eshell/em-ls.el: Display `ls -l' dates in ISO format (Bug#8440). + (eshell-ls-date-format): New defcustom. + (eshell-ls-file): Use it. + +2011-06-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * help-fns.el (describe-variable): Fix message for terminal-local vars. + +2011-06-27 Katsumi Yamaoka <yamaoka@jpl.org> + + * net/ange-ftp.el: Allow loading .gz files (Bug#6923). + (ange-ftp-make-tmp-name): New arg. + (ange-ftp-file-local-copy): Use it. + +2011-06-27 Jambunathan K <kjambunathan@gmail.com> + + * tar-mode.el (tar-untar-buffer): Set coding-system-for-write to + no-conversion (Bug#8870). + +2011-06-27 Martin Rudalics <rudalics@gmx.at> + + * window.el (window-right, window-left, window-child) + (window-child-count, window-last-child) + (window-iso-combination-p, walk-window-tree-1) + (window-atom-check-1, window-tree-1, delete-window) + (window-state-get-1, display-buffer-even-window-sizes): Adapt to + new naming conventions - window-vchild, window-hchild, + window-next and window-prev are now called window-top-child, + window-left-child, window-next-sibling and window-prev-sibling + respectively. + (resize-window-reset): Rename to window-resize-reset. + (resize-window-reset-1): Rename to window-resize-reset-1. + (resize-window): Rename to window-resize. + (window-min-height, window-min-width) + (resize-mini-window, resize-this-window, resize-root-window) + (resize-root-window-vertically, adjust-window-trailing-edge) + (enlarge-window, shrink-window, maximize-window) + (minimize-window, delete-window, quit-restore-window) + (split-window, balance-windows, balance-windows-area-adjust) + (balance-windows-area, window-state-put-2) + (display-buffer-even-window-sizes, display-buffer-set-height) + (display-buffer-set-width, set-window-text-height) + (fit-window-to-buffer): Rename all "resize-window" prefixed + calls to use the "window-resize" prefix convention. + (display-buffer-alist): Fix symbol for label specifier. + (display-buffer-reuse-window): Set reuse-dedicated to cdr of + corresponding specifier. + Reported by Juanma Barranquero <lekktu@gmail.com>. + +2011-06-27 Vincent BelaĂŻche <vincentb1@users.sourceforge.net> + + * ses.el (ses-destroy-cell-variable-range): Fix heading comment + convention. + (ses-call-printer): Does not pass an empty string to formatter when the + cell is empty to keep from barking printer Calc math-format-value. + +2011-06-27 Richard Stallman <rms@gnu.org> + + * battery.el (battery-mode-line-limit): New variable. + (battery-update): Handle it. + + * mail/rmailmm.el (rmail-mime-process-multipart): + Handle truncated messages. + +2011-06-27 Glenn Morris <rgm@gnu.org> + + * progmodes/flymake.el (flymake-err-line-patterns): + Allow for column numbers in the ant/javac pattern. (Bug#8866) + +2011-06-27 Vincent BelaĂŻche <vincentb1@users.sourceforge.net> + + * ses.el (ses-relocate-range): Keep rest of arguments for ses-range. + (ses--clean-!, ses--clean-_): New functions. + (ses-range): Add configurability of readout order, and conversion + to Calc vector. + + * ses.el (ses-repair-cell-reference-all): New function. + (ses-cell-symbol): Set macro as safe, so that it can be used in + formulas. + + * ses.el: Update cycle detection algorithm. + (ses-localvars): Add ses--Dijkstra-attempt-nb and + ses--Dijkstra-weight-bound, and initial values thereof when applicable. + (ses-set-localvars): New function. + (ses-make-cell): Add property-list as a cell element. + (ses-cell-property-get-fun, ses-cell-property-get) + (ses-cell-property-delq-fun, ses-cell-property-set-fun) + (ses-cell-property-pop-fun, ses-cell-property-get-handle-fun): + New functions. + (ses-cell-property-set, ses-cell-property-pop) + (ses-cell-property-get-handle): New macro. + (ses-cell-property-handle-car, ses-cell-property-handle-setcar): + New aliases, used for code readability. + (ses-calculate-cell, ses-update-cells): Use Dijkstra algorithm for + cycle detection. + (ses-self-reference-early-detection): New defcustom. + (ses-formula-references): Robustify against self-refering cells. + (ses-mode): Use ses-set-localvars. + (ses-command-hook): Add call to ses-initialize-Dijkstra-attempt + before lauching the update processing. + (ses-initialize-Dijkstra-attempt): New function. + (ses-recalculate-cell): Update for cycle detection based on + Dijkstra algorithm. + + * ses.el: Fix commenting and indenting convention. + +2011-06-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * bs.el (bs-cycle-next): Complete last change. + +2011-06-27 Drew Adams <drew.adams@oracle.com> + + * faces.el (list-faces-display): Add help-mode-map to output (bug#8939). + +2011-06-27 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/network-stream.el (network-stream-open-starttls): + Don't re-get capabilities unless we've reestablished connection. + (network-stream-open-starttls): Fix stupid typo with gnutls-clii. + + * mail/smtpmail.el (smtpmail-via-smtp): Bind coding-system-for-* + to binary to possibly avoid line encoding issues on Windows (among + other things). + +2011-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/network-stream.el (open-network-stream): Return an :error + saying what the problem was, if possible. + + * mail/smtpmail.el (smtpmail-via-smtp): Report the error from the + server. + + * net/network-stream.el (network-stream-open-starttls): If we + wanted to use STARTTLS, and the server offered it, but we weren't + able to because we had no STARTTLS support, then close the connection. + (open-network-stream): Return an :error element, if present. + +2011-06-26 Chong Yidong <cyd@stupidchicken.com> + + * hl-line.el (hl-line-sticky-flag): Doc fix. + (global-hl-line-sticky-flag): New option (Bug#8323). + (global-hl-line-highlight): Obey it. + + * vc/vc.el (vc-revert-show-diff): Default to t. + +2011-06-26 Ken Manheimer <ken.manheimer@gmail.com> + + * allout-widgets.el (allout-widgets-post-command-business): + Stop decorating intermediate isearch matches. They're not being + undecorated when an isearch is continued past, and isearch + automatically collapses them. This leads to "widget leaks", where + decorated items accumulate in collapsed areas. Lines with lots of + hidden widgets can slow down cursor travel, substantially. + Too much complicated machinery would be needed to ensure undecoration, + so we're doing without this nicety. + + (allout-widgets-tally-string): Don't try to do a hash-table-count + of allout-widgets-tally when it's nil. This eliminates spurious "Error + during redisplay: (wrong-type-argument hash-table-p nil)" warnings in + *Messages* when allout-widgets-maintain-tally is t. + +2011-06-26 Martin Rudalics <rudalics@gmx.at> + + * window.el (display-buffer-normalize-argument): Rename to + display-buffer-normalize-arguments. Handle special meaning of + LABEL argument. Respect special-display-function when popping up + a new frame. Fix code searching for a window showing the buffer + on another frame. + (display-buffer-normalize-specifiers): + Call display-buffer-normalize-arguments. + (display-buffer-in-window): Don't undedicate the window if its + buffer remains the same. + Reported by Drew Adams <drew.adams@oracle.com>. + (display-buffer-alist): Add choice for same-window macro + specfier. + (display-buffer): Mention special meaning of LABEL argument in + doc-string. Fix quoting. Don't pop up a new frame even as + fallback. + +2011-06-26 Juanma Barranquero <lekktu@gmail.com> + + * bs.el (bs-cycle-next): Pass current buffer to `bury-buffer' to + avoid deleting the current window in some cases (bug#8911). + +2011-06-26 Andreas Schwab <schwab@linux-m68k.org> + + * emacs-lisp/smie.el (smie-bnf->prec2): Fix last change. + (Bug#8934) + +2011-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/network-stream.el (network-stream-open-starttls): + Use built-in TLS support if `gnutls-available-p' is true. + (network-stream-open-tls): Ditto. + +2011-06-26 Leo Liu <sdl.web@gmail.com> + + * register.el (registerv): New struct. + (registerv-make): New function. + (jump-to-register, describe-register-1, insert-register): + Support the jump-func, print-func and insert-func slot of a registerv + struct. (Bug#8415) + +2011-06-26 Chong Yidong <cyd@stupidchicken.com> + + * vc/vc.el (vc-revert-show-diff): New defcustom. + (vc-diff-internal): New arg specifying diff buffer. + (vc-revert): Obey vc-revert-show-diff. If we show a diff, don't + reuse an existing *vc-diff* buffer (Bug#8927). + + * progmodes/cperl-mode.el (cperl-mode): Derive from prog-mode. + +2011-06-26 Glenn Morris <rgm@gnu.org> + + * progmodes/f90.el (f90-critical-indent): New option. + (f90-font-lock-keywords-2, f90-blocks-re, f90-end-block-re) + (f90-start-block-re, f90-mode-abbrev-table): Add block, critical. + (f90-mode): Doc fix. + (f90-looking-at-critical, f90-looking-at-end-critical): New funcs. + (f90-no-block-limit, f90-calculate-indent, f90-end-of-block) + (f90-beginning-of-block, f90-next-block, f90-indent-region) + (f90-match-end): Handle block, critical. + +2011-06-25 Glenn Morris <rgm@gnu.org> + + * calendar/diary-lib.el (diary-included-files): Doc fix. + (diary-include-files): New function, extracted from + diary-include-other-diary-files and diary-mark-included-diary-files. + (diary-include-other-diary-files, diary-mark-included-diary-files): + Just call diary-include-files. + (diary-mark-entries): Reset diary-included-files on first call. + + * calendar/diary-lib.el (diary-mark-entries) + (diary-mark-included-diary-files): + Visit included diary-files in temp buffers. + + * progmodes/f90.el (f90-keywords-re, f90-font-lock-keywords-1) + (f90-blocks-re, f90-program-block-re, f90-end-block-re) + (f90-start-block-re, f90-imenu-generic-expression) + (f90-looking-at-program-block-start, f90-no-block-limit): + Add support for submodules. + + * progmodes/f90.el (f90-keywords-re, f90-keywords-level-3-re) + (f90-procedures-re, f90-constants-re): Add some F2008 stuff. + +2011-06-25 Eli Zaretskii <eliz@gnu.org> + + * net/ange-ftp.el (ange-ftp-insert-file-contents): Let-bind + buffer-file-type before setting its value, to avoid disastrous + global effects on decoding files for DOS/Windows systems. (Bug#8780) + +2011-06-25 Juanma Barranquero <lekktu@gmail.com> + + * allout.el (allout-unload-function): Pass -1 to `allout-mode'. + + * ses.el (ses-unload-function): + * emacs-lisp/re-builder.el (re-builder-unload-function): Simplify. + + * proced.el (proced-unload-function): + * progmodes/cperl-mode.el (cperl-mode-unload-function): Remove. + +2011-06-25 Andreas Rottmann <a.rottmann@gmx.at> + + * server.el (server-create-window-system-frame): Add parameters arg. + (server-process-filter): Doc fix. Handle frame-parameters. + +2011-06-25 Juanma Barranquero <lekktu@gmail.com> + + Fix bug#8730, bug#8781. + + * loadhist.el (unload--set-major-mode): New function. + (unload-feature): Use it. + + * progmodes/python.el (python-after-info-look): Add autoload cookie. + (python-unload-function): New function. + +2011-06-25 Stefan Monnier <monnier@iro.umontreal.ca> + + * mail/rmail.el (rmail-show-message-1): Use restore-buffer-modified-p. + +2011-06-25 Giuseppe Scrivano <gscrivano@gnu.org> + + * net/browse-url.el (browse-url-firefox-program): Add icecat to + the candidates list. + +2011-06-24 Juanma Barranquero <lekktu@gmail.com> + + * progmodes/verilog-mode.el (verilog-mode): Fix test for bound variable. + +2011-06-23 Richard Stallman <rms@gnu.org> + + * mail/rmail.el: Going to grep hit in Rmail buffer finds the message. + (rmail-variables): Set next-error-move-function. + (rmail-what-message): Take argument POS. + (rmail-next-error-move): New function. + +2011-06-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/smie.el (smie-bnf->prec2): Give more understandable error + messages for adjacent non-terminals. + +2011-06-23 Richard Stallman <rms@gnu.org> + + * mail/rmail.el (rmail-retry-ignored-headers): Add message-id. + (rmail-show-message-1): Preserve buffer modified flag. + (rmail-start-mail): Don't specify use of rmail-mail-return; + that's done by mail-bury now. + (rmail-mail-return): Handle arg NEWBUF. + +2011-06-23 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-sh.el (tramp-method-out-of-band-p): Check, whether + SIZE is a number. + +2011-06-23 Martin Rudalics <rudalics@gmx.at> + + * 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 <thierry.volpiatto@gmail.com>. + +2011-06-22 Leo Liu <sdl.web@gmail.com> + + * minibuffer.el (completing-read-function) + (completing-read-default): Move from minibuf.c + 2011-06-22 Richard Stallman <rms@gnu.org> * mail/sendmail.el (mail-bury): If Rmail is in use, return nicely @@ -83,8 +1195,8 @@ 2011-06-21 Lars Magne Ingebrigtsen <larsi@gnus.org> - * mail/smtpmail.el (smtpmail-via-smtp): Set - :use-starttls-if-possible so that we always use STARTTLS if the + * 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. @@ -96,13 +1208,13 @@ 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. + (smtpmail-auth-credentials): Remove. + (smtpmail-starttls-credentials): Remove. (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 + * 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. @@ -116,8 +1228,8 @@ 2011-06-21 Tim Harper <timcharper@gmail.com> - * term/ns-win.el (ns-initialize-window-system): set - application-specific `ApplePressAndHoldEnabled' system + * 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 <lekktu@gmail.com> @@ -142,8 +1254,8 @@ 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-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. @@ -160,7 +1272,7 @@ * 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 <drew.adams@oracle.com> +2011-06-21 Drew Adams <drew.adams@oracle.com> * menu-bar.el: Use function variable instead of switch-to-buffer. (menu-bar-select-buffer-function): New variable. @@ -686,7 +1798,7 @@ (window-in-direction-2, window-in-direction, get-mru-window): New functions. -2011-06-08 Reuben Thomas <rrt@sc3d.org> +2011-06-08 Reuben Thomas <rrt@sc3d.org> * progmodes/flymake.el (flymake-compilation-prevents-syntax-check): Doc fix (Bug#8713). @@ -1073,7 +2185,6 @@ 2011-05-28 Chong Yidong <cyd@stupidchicken.com> - * emacs-lisp/re-builder.el (re-builder): Improve doc (Bug#8286). 2011-05-28 Dima Kogan <dkogan@cds.caltech.edu> (tiny change) @@ -1204,7 +2315,7 @@ * vc/vc-bzr.el (vc-bzr-sha1-program): Rename from sha1-program. (vc-bzr-sha1): Adapt. - * sha1.el: Remove. Function `sha1' is now builtin. + * sha1.el: Remove. Function `sha1' is now builtin. * bindings.el: Provide sha1 feature. @@ -1292,7 +2403,7 @@ 2011-05-23 Vincent BelaĂŻche <vincentb1@users.sourceforge.net> * play/5x5.el: I/ Add an arithmetic solver to suggest positions to - click on. II/ Make 5x5 multisession. III/ Ensure that random grids + click on. II/ Make 5x5 multisession. III/ Ensure that random grids always have a solution in grid size = 5 cases. (5x5-mode-map): Add keybinding to function `5x5-solve-suggest'. (5x5-solver-output, 5x5-log-buffer): New vars. @@ -2513,7 +3624,7 @@ 2011-04-20 felix <EmacsWiki> (tiny change) - * whitespace.el (global-whitespace-mode): keep highlight when + * whitespace.el (global-whitespace-mode): Keep highlight when switching between major modes on a file. 2011-04-19 Stefan Monnier <monnier@iro.umontreal.ca> diff --git a/lisp/ChangeLog.14 b/lisp/ChangeLog.14 index c1313cfd16f..eeed5d7797c 100644 --- a/lisp/ChangeLog.14 +++ b/lisp/ChangeLog.14 @@ -4421,7 +4421,7 @@ 2008-12-06 Chong Yidong <cyd@stupidchicken.com> * term/xterm.el (terminal-init-xterm): Discard pending input - before reading a reply to the terminal attributes query. + before reading a reply to the terminal attributes query. (Bug#1495) 2008-12-05 Andreas Schwab <schwab@suse.de> diff --git a/lisp/ChangeLog.15 b/lisp/ChangeLog.15 index 3cb6c00b6ee..190be56dd09 100644 --- a/lisp/ChangeLog.15 +++ b/lisp/ChangeLog.15 @@ -8424,7 +8424,7 @@ * dabbrev.el (dabbrev-completion): Fix typo in docstring. -2010-08-08 MON KEY <monkey@sandpframing.com> (tiny change) +2010-08-08 MON KEY <monkey@sandpframing.com> * emacs-lisp/syntax.el (syntax-ppss-toplevel-pos): Fix typo in docstring (bug#6747). diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 9445cf9675c..2122f43bbad 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -159,7 +159,7 @@ where NAME and EXPANSION are strings with quotes, USECOUNT is an integer, and HOOK is any valid function or may be omitted (it is usually omitted)." (interactive) - (switch-to-buffer (prepare-abbrev-list-buffer))) + (pop-to-buffer-same-window (prepare-abbrev-list-buffer))) (defun edit-abbrevs-redefine () "Redefine abbrevs according to current buffer contents." diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el index 647b609288d..ef75e7157e6 100644 --- a/lisp/allout-widgets.el +++ b/lisp/allout-widgets.el @@ -258,7 +258,9 @@ widgets are locally inhibited. The number varies according to the evanescence of objects on a hash table with weak keys, so tracking of widget erasures is often delayed." - (when (and allout-widgets-maintain-tally (not allout-widgets-mode-inhibit)) + (when (and allout-widgets-maintain-tally + (not allout-widgets-mode-inhibit) + allout-widgets-tally) (format ":%s" (hash-table-count allout-widgets-tally)))) ;;;_ = allout-widgets-track-decoration nil (defcustom allout-widgets-track-decoration nil @@ -559,6 +561,8 @@ outline hot-spot navigation \(see `allout-mode')." 'allout-widgets-shifts-recorder nil 'local) (add-hook 'allout-after-copy-or-kill-hook 'allout-widgets-after-copy-or-kill-function nil 'local) + (add-hook 'allout-post-undo-hook + 'allout-widgets-after-undo-function nil 'local) (add-hook 'before-change-functions 'allout-widgets-before-change-handler nil 'local) @@ -748,20 +752,23 @@ Optional RECURSING is for internal use, to limit recursion." (message replaced-message) (message ""))))) - ;; Detect undecorated items, eg during isearch into previously - ;; unexposed topics, and decorate "economically". Some - ;; undecorated stuff is often exposed, to reduce lag, but the - ;; item containing the cursor is decorated. We constrain - ;; recursion to avoid being trapped by unexpectedly undecoratable - ;; items. - (when (and (not recursing) - (not (allout-current-decorated-p)) - (or (not (equal (allout-depth) 0)) - (not allout-container-item-widget))) - (let ((buffer-undo-list t)) - (allout-widgets-exposure-change-recorder - allout-recent-prefix-beginning allout-recent-prefix-end nil) - (allout-widgets-post-command-business 'recursing))) + ;; alas, decorated intermediate matches are not easily undecorated + ;; when they're automatically rehidden by isearch, so we're + ;; dropping this nicety. + ;; ;; Detect undecorated items, eg during isearch into previously + ;; ;; unexposed topics, and decorate "economically". Some + ;; ;; undecorated stuff is often exposed, to reduce lag, but the + ;; ;; item containing the cursor is decorated. We constrain + ;; ;; recursion to avoid being trapped by unexpectedly undecoratable + ;; ;; items. + ;; (when (and (not recursing) + ;; (not (allout-current-decorated-p)) + ;; (or (not (equal (allout-depth) 0)) + ;; (not allout-container-item-widget))) + ;; (let ((buffer-undo-list t)) + ;; (allout-widgets-exposure-change-recorder + ;; allout-recent-prefix-beginning allout-recent-prefix-end nil) + ;; (allout-widgets-post-command-business 'recursing))) ;; Detect and rectify fouled outline structure - decorated item ;; not at beginning of line. @@ -1125,6 +1132,14 @@ Dispatched by `allout-widgets-post-command-business' in response to Intended for use on allout-after-copy-or-kill-hook." (if (car kill-ring) (setcar kill-ring (allout-widgets-undecorate-text (car kill-ring))))) +;;;_ > allout-widgets-after-undo-function () +(defun allout-widgets-after-undo-function () + "Do allout-widgets processing of text after an undo. + +Intended for use on allout-post-undo-hook." + (save-excursion + (if (allout-goto-prefix) + (allout-redecorate-item (allout-get-or-create-item-widget))))) ;;;_ > allout-widgets-exposure-undo-recorder (widget from-state) (defun allout-widgets-exposure-undo-recorder (widget) @@ -2319,9 +2334,7 @@ We use a caching strategy, so the caller doesn't need to do so." (defun allout-elapsed-time-seconds (end start) "Return seconds between `current-time' style time START/END triples." (let ((elapsed (time-subtract end start))) - (+ (* (car elapsed) (expt 2.0 16)) - (cadr elapsed) - (/ (caddr elapsed) (expt 10.0 6))))) + (float-time elapsed))) ;;;_ > allout-frame-property (frame property) (defalias 'allout-frame-property (cond ((fboundp 'frame-parameter) diff --git a/lisp/allout.el b/lisp/allout.el index 8cdf24176b0..592a64c647a 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -823,37 +823,32 @@ formatted copy." :group 'allout-encryption) ;;;_ = allout-encrypt-unencrypted-on-saves (defcustom allout-encrypt-unencrypted-on-saves t - "When saving, should topics pending encryption be encrypted? - -The idea is to prevent file-system exposure of any un-encrypted stuff, and -mostly covers both deliberate file writes and auto-saves. - - - Yes: encrypt all topics pending encryption, even if it's the one - currently being edited. (In that case, the currently edited topic - will be automatically decrypted before any user interaction, so they - can continue editing but the copy on the file system will be - encrypted.) - Auto-saves will use the \"All except current topic\" mode if this - one is selected, to avoid practical difficulties -- see below. - - All except current topic: skip the topic currently being edited, even if - it's pending encryption. This may expose the current topic on the - file sytem, but avoids the nuisance of prompts for the encryption - passphrase in the middle of editing for, eg, autosaves. - This mode is used for auto-saves for both this option and \"Yes\". - - No: leave it to the user to encrypt any unencrypted topics. - -For practical reasons, auto-saves always use the 'except-current policy -when auto-encryption is enabled. (Otherwise, spurious passphrase prompts -and unavoidable timing collisions are too disruptive.) If security for a -file requires that even the current topic is never auto-saved in the clear, -disable auto-saves for that file." - - :type '(choice (const :tag "Yes" t) - (const :tag "All except current topic" except-current) - (const :tag "No" nil)) - :version "22.1" + "If non-nil, topics pending encryption are encrypted during buffer saves. + +This provents file-system exposure of un-encrypted contents of +items marked for encryption. + +When non-nil, if the topic currently being edited is decrypted, +it will be encrypted for saving but automatically decrypted +before any subsequent user interaction, so it is once again clear +text for editing though the file system copy is encrypted. + +\(Auto-saves are handled differently. Buffers with plain-text +exposed encrypted topics are exempted from auto saves until all +such topics are encrypted.)" + + :type 'boolean + :version "23.1" :group 'allout-encryption) (make-variable-buffer-local 'allout-encrypt-unencrypted-on-saves) +(defvar allout-auto-save-temporarily-disabled nil + "True while topic encryption is pending and auto-saving was active. + +The value of buffer-saved-size at the time of decryption is used, +for restoring when all encryptions are established.") +(defvar allout-just-did-undo nil + "True just after undo commands, until allout-post-command-business.") +(make-variable-buffer-local 'allout-just-did-undo) ;;;_ + Developer ;;;_ = allout-developer group @@ -1466,7 +1461,15 @@ This hook might be invoked multiple times by a single command.") (defvar allout-after-copy-or-kill-hook nil "*Hook that's run after copying outline text. -Functions on the hook should not take any arguments.") +Functions on the hook should not require any arguments.") +;;;_ = allout-post-undo-hook +(defvar allout-post-undo-hook nil + "*Hook that's run after undo activity. + +The item that's current when the hook is run *may* be the one +that was affected by the undo. + +Functions on the hook should not require any arguments.") ;;;_ = allout-outside-normal-auto-fill-function (defvar allout-outside-normal-auto-fill-function nil "Value of normal-auto-fill-function outside of allout mode. @@ -1564,39 +1567,43 @@ See `allout-encryption-ciphertext-rejection-regexps' for rejection reasons.") (defmacro allout-mode-p () "Return t if `allout-mode' is active in current buffer." 'allout-mode) -;;;_ > allout-write-file-hook-handler () -(defun allout-write-file-hook-handler () - "Implement `allout-encrypt-unencrypted-on-saves' policy for file writes." +;;;_ > allout-write-contents-hook-handler () +(defun allout-write-contents-hook-handler () + "Implement `allout-encrypt-unencrypted-on-saves' for file writes + +Return nil if all goes smoothly, or else return an informative +message if an error is encountered. The message will serve as a +non-nil return on `write-contents-functions' to prevent saving of +the buffer while it has decrypted content. + +This behavior depends on emacs versions that implement the +`write-contents-functions' hook." (if (or (not (allout-mode-p)) (not (boundp 'allout-encrypt-unencrypted-on-saves)) (not allout-encrypt-unencrypted-on-saves)) nil - (let ((except-mark (and (equal allout-encrypt-unencrypted-on-saves - 'except-current) - (point-marker)))) - (if (save-excursion (goto-char (point-min)) - (allout-next-topic-pending-encryption except-mark)) - (progn - (message "auto-encrypting pending topics") - (sit-for 0) - (condition-case failure + (if (save-excursion (goto-char (point-min)) + (allout-next-topic-pending-encryption)) + (progn + (message "auto-encrypting pending topics") + (sit-for 0) + (condition-case failure + (progn (setq allout-after-save-decrypt - (allout-encrypt-decrypted except-mark)) - (error (message - "allout-write-file-hook-handler suppressing error %s" - failure) - (sit-for 2))))) - )) - nil) -;;;_ > allout-auto-save-hook-handler () -(defun allout-auto-save-hook-handler () - "Implement `allout-encrypt-unencrypted-on-saves' policy for auto save." - - (if (and (allout-mode-p) allout-encrypt-unencrypted-on-saves) - ;; Always implement 'except-current policy when enabled. - (let ((allout-encrypt-unencrypted-on-saves 'except-current)) - (allout-write-file-hook-handler)))) + (allout-encrypt-decrypted)) + ;; aok - return nil: + nil) + (error + ;; whoops - probably some still-decrypted items, return non-nil: + (let ((text (format (concat "%s contents write inhibited due to" + " encrypted topic encryption error:" + " %s") + (buffer-name (current-buffer)) + failure))) + (message text)(sit-for 2) + text))))) + )) ;;;_ > allout-after-saves-handler () (defun allout-after-saves-handler () "Decrypt topic encrypted for save, if it's currently being edited. @@ -1875,6 +1882,7 @@ without changes to the allout core. Here are key ones: `allout-structure-deleted-hook' `allout-structure-shifted-hook' `allout-after-copy-or-kill-hook' +`allout-post-undo-hook' Terminology @@ -1960,12 +1968,7 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be." :lighter " Allout" :keymap 'allout-mode-map - (let ((write-file-hook-var-name (cond ((boundp 'write-file-functions) - 'write-file-functions) - ((boundp 'write-file-hooks) - 'write-file-hooks) - (t 'local-write-file-hooks))) - (use-layout (if (listp allout-layout) + (let ((use-layout (if (listp allout-layout) allout-layout allout-default-layout))) @@ -1984,9 +1987,8 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be." (remove-hook 'post-command-hook 'allout-post-command-business t) (remove-hook 'before-change-functions 'allout-before-change-handler t) (remove-hook 'isearch-mode-end-hook 'allout-isearch-end-handler t) - (remove-hook write-file-hook-var-name - 'allout-write-file-hook-handler t) - (remove-hook 'auto-save-hook 'allout-auto-save-hook-handler t) + (remove-hook 'write-contents-functions + 'allout-write-contents-hook-handler t) (remove-overlays (point-min) (point-max) 'category 'allout-exposure-category)) @@ -2019,9 +2021,8 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be." (add-hook 'post-command-hook 'allout-post-command-business nil t) (add-hook 'before-change-functions 'allout-before-change-handler nil t) (add-hook 'isearch-mode-end-hook 'allout-isearch-end-handler nil t) - (add-hook write-file-hook-var-name 'allout-write-file-hook-handler + (add-hook 'write-contents-functions 'allout-write-contents-hook-handler nil t) - (add-hook 'auto-save-hook 'allout-auto-save-hook-handler nil t) ;; Stash auto-fill settings and adjust so custom allout auto-fill ;; func will be used if auto-fill is active or activated. (The @@ -2085,7 +2086,7 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be." (save-current-buffer (dolist (buffer (buffer-list)) (set-buffer buffer) - (when (allout-mode-p) (allout-mode)))) + (when (allout-mode-p) (allout-mode -1)))) ;; continue standard unloading nil) @@ -2154,8 +2155,10 @@ internal functions use this feature cohesively bunch changes." See `allout-overlay-interior-modification-handler' for details." - (when (and (allout-mode-p) undo-in-progress (allout-hidden-p)) - (allout-show-children)) + (when (and (allout-mode-p) undo-in-progress) + (setq allout-just-did-undo t) + (if (allout-hidden-p) + (allout-show-children))) ;; allout-overlay-interior-modification-handler on an overlay handles ;; this in other emacs, via `allout-exposure-category's 'modification-hooks. @@ -3308,12 +3311,30 @@ coordinating with allout activity.") - Implement (and clear) `allout-post-goto-bullet', for hot-spot outline commands. +- If the command we're following was an undo, check for change in + the status of encrypted items and adjust auto-save inhibitions + accordingly. + - Decrypt topic currently being edited if it was encrypted for a save." - ; Apply any external change func: (if (not (allout-mode-p)) ; In allout-mode. nil + (when allout-just-did-undo + (setq allout-just-did-undo nil) + (run-hooks 'allout-post-undo-hook) + (cond ((and (= buffer-saved-size -1) + allout-auto-save-temporarily-disabled) + ;; user possibly undid a decryption, deinhibit auto-save: + (allout-maybe-resume-auto-save-info-after-encryption)) + ((save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (not (allout-next-topic-pending-encryption)))) + ;; plain-text encrypted items are present, inhibit auto-save: + (allout-inhibit-auto-save-info-for-decryption (buffer-size))))) + (if (and (boundp 'allout-after-save-decrypt) allout-after-save-decrypt) (allout-after-saves-handler)) @@ -4036,6 +4057,8 @@ this function." (not (allout-encrypted-topic-p))) (allout-reindent-body current-depth new-depth)) + (run-hook-with-args 'allout-exposure-change-hook mb me nil) + ;; Recursively rectify successive siblings of orig topic if ;; caller elected for it: (if do-successors @@ -4605,8 +4628,9 @@ however, are left exactly like normal, non-allout-specific yanks." ; and delete residual subj ; prefix digits and space: (while (looking-at "[0-9]") (delete-char 1)) - (if (looking-at " ") - (delete-char 1)))) + (delete-char -1) + (if (not (eolp)) + (forward-char)))) ;; Assert new topic's bullet - minimal effort if unchanged: (allout-rebullet-heading (string-to-char prefix-bullet))) (exchange-point-and-mark)))) @@ -4736,6 +4760,7 @@ arguments as this function, after the exposure changes are made." (when flag (let ((o (make-overlay from to nil 'front-advance))) (overlay-put o 'category 'allout-exposure-category) + (overlay-put o 'evaporate t) (when (featurep 'xemacs) (let ((props (symbol-plist 'allout-exposure-category))) (while props @@ -5895,6 +5920,8 @@ See `allout-toggle-current-subtree-encryption' for more details." " shift it in to make it encryptable"))) (let* ((allout-buffer (current-buffer)) + ;; for use with allout-auto-save-temporarily-disabled, if necessary: + (was-buffer-saved-size buffer-saved-size) ;; Assess location: (bullet-pos allout-recent-prefix-beginning) (after-bullet-pos (point)) @@ -5974,6 +6001,12 @@ See `allout-toggle-current-subtree-encryption' for more details." ;; Add the is-encrypted bullet qualifier: (goto-char after-bullet-pos) (insert "*")))) + + ;; adjust buffer's auto-save eligibility: + (if was-encrypted + (allout-inhibit-auto-save-info-for-decryption was-buffer-saved-size) + (allout-maybe-resume-auto-save-info-after-encryption)) + (run-hook-with-args 'allout-structure-added-hook bullet-pos subtree-end)))) ;;;_ > allout-encrypt-string (text decrypt allout-buffer keymode-cue @@ -6025,6 +6058,7 @@ signal." (epg-context-set-passphrase-callback context #'epa-passphrase-callback-function) context)) + (encoding (with-current-buffer allout-buffer buffer-file-coding-system)) (multibyte (with-current-buffer allout-buffer @@ -6146,8 +6180,29 @@ signal." result-text)) (error (concat "Encryption produced non-armored text, which" "conflicts with allout mode -- reconfigure!"))) - (t result-text)))) +;;;_ > allout-inhibit-auto-save-info-for-decryption +(defun allout-inhibit-auto-save-info-for-decryption (was-buffer-saved-size) + "Temporarily prevent auto-saves in this buffer when an item is decrypted. + +WAS-BUFFER-SAVED-SIZE is the value of buffer-saved-size *before* +the decryption." + (when (not (or (= buffer-saved-size -1) (= was-buffer-saved-size -1))) + (setq allout-auto-save-temporarily-disabled was-buffer-saved-size + buffer-saved-size -1))) +;;;_ > allout-maybe-resume-auto-save-info-after-encryption () +(defun allout-maybe-resume-auto-save-info-after-encryption () + "Restore auto-save info, *if* there are no topics pending encryption." + (when (and allout-auto-save-temporarily-disabled + (= buffer-saved-size -1) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (not (allout-next-topic-pending-encryption))))) + (setq buffer-saved-size allout-auto-save-temporarily-disabled + allout-auto-save-temporarily-disabled nil))) + ;;;_ > allout-encrypted-topic-p () (defun allout-encrypted-topic-p () "True if the current topic is encryptable and encrypted." @@ -6158,14 +6213,10 @@ signal." (save-match-data (looking-at "\\*"))) ) ) -;;;_ > allout-next-topic-pending-encryption (&optional except-mark) -(defun allout-next-topic-pending-encryption (&optional except-mark) +;;;_ > allout-next-topic-pending-encryption () +(defun allout-next-topic-pending-encryption () "Return the point of the next topic pending encryption, or nil if none. -EXCEPT-MARK identifies a point whose containing topics should be excluded -from encryption. This supports 'except-current mode of -`allout-encrypt-unencrypted-on-saves'. - Such a topic has the `allout-topic-encryption-bullet' without an immediately following '*' that would mark the topic as being encrypted. It must also have content." @@ -6200,10 +6251,7 @@ must also have content." (setq content-beg (point)) (backward-char 1) (allout-end-of-subtree) - (if (or (<= (point) content-beg) - (and except-mark - (<= content-beg except-mark) - (>= (point) except-mark))) + (if (<= (point) content-beg) ;; Continue looking (setq got nil) ;; Got it! @@ -6215,14 +6263,10 @@ must also have content." ) ) ) -;;;_ > allout-encrypt-decrypted (&optional except-mark) -(defun allout-encrypt-decrypted (&optional except-mark) +;;;_ > allout-encrypt-decrypted () +(defun allout-encrypt-decrypted () "Encrypt topics pending encryption except those containing exemption point. -EXCEPT-MARK identifies a point whose containing topics should be excluded -from encryption. This supports the `except-current' mode of -`allout-encrypt-unencrypted-on-saves'. - If a topic that is currently being edited was encrypted, we return a list containing the location of the topic and the location of the cursor just before the topic was encrypted. This can be used, eg, to decrypt the topic @@ -6238,7 +6282,7 @@ save. See `allout-encrypt-unencrypted-on-saves' for more info." bo-subtree editing-topic editing-point) (goto-char (point-min)) - (while (allout-next-topic-pending-encryption except-mark) + (while (allout-next-topic-pending-encryption) (setq was-modified (buffer-modified-p)) (when (save-excursion (and (boundp 'allout-encrypt-unencrypted-on-saves) diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 0d129856f1d..70f43aebaff 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -55,9 +55,9 @@ ;; -------------------------------------------- ;; View listing Intern Intern Intern Intern Y Y ;; Extract member Y Y Y Y Y Y -;; Save changed member Y Y Y Y N N +;; Save changed member Y Y Y Y N Y ;; Add new member N N N N N N -;; Delete member Y Y Y Y N N +;; Delete member Y Y Y Y N Y ;; Rename member Y Y N N N N ;; Chmod - Y Y - N N ;; Chown - Y - - N N @@ -323,9 +323,30 @@ Archive and member name will be added." Extraction should happen to standard output. Archive and member name will be added." :type '(list (string :tag "Program") - (repeat :tag "Options" - :inline t - (string :format "%v"))) + (repeat :tag "Options" + :inline t + (string :format "%v"))) + :group 'archive-7z) + +(defcustom archive-7z-expunge + '("7z" "d") + "Program and its options to run in order to delete 7z file members. +Archive and member names will be added." + :type '(list (string :tag "Program") + (repeat :tag "Options" + :inline t + (string :format "%v"))) + :group 'archive-7z) + +(defcustom archive-7z-update + '("7z" "u") + "Program and its options to run in order to update a 7z file member. +Options should ensure that specified directory will be put into the 7z +file. Archive and member name will be added." + :type '(list (string :tag "Program") + (repeat :tag "Options" + :inline t + (string :format "%v"))) :group 'archive-7z) ;; ------------------------------------------------------------------------- @@ -1062,7 +1083,7 @@ using `make-temp-file', and the generated name is returned." (view-buffer buffer (and just-created 'kill-buffer-if-not-modified))) ((eq other-window-p 'display) (display-buffer buffer)) (other-window-p (switch-to-buffer-other-window buffer)) - (t (switch-to-buffer buffer)))))) + (t (pop-to-buffer-same-window buffer)))))) (defun archive-*-extract (archive name command) (let* ((default-directory (file-name-as-directory archive-tmpdir)) @@ -2037,7 +2058,9 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (with-temp-buffer (call-process "7z" nil t nil "l" "-slt" file) (goto-char (point-min)) - (re-search-forward "^-+\n") + ;; Four dashes start the meta info section that should be skipped. + ;; Archive members start with more than four dashes. + (re-search-forward "^-----+\n") (while (re-search-forward "^Path = \\(.*\\)\n" nil t) (goto-char (match-end 0)) (let ((name (match-string 1)) @@ -2084,6 +2107,12 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (message "%s" (buffer-string))) (delete-file tmpfile))))) +(defun archive-7z-write-file-member (archive descr) + (archive-*-write-file-member + archive + descr + archive-7z-update)) + ;; ------------------------------------------------------------------------- ;;; Section `ar' archives. diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el index 5793c3180be..3b849cece22 100644 --- a/lisp/autoinsert.el +++ b/lisp/autoinsert.el @@ -360,7 +360,7 @@ Matches the visited file name against the elements of `auto-insert-alist'." (save-window-excursion ;; make buffer visible before skeleton or function ;; which might ask the user for something - (switch-to-buffer (current-buffer)) + (pop-to-buffer-same-window (current-buffer)) (if (and (consp action) (not (eq (car action) 'lambda))) (skeleton-insert action) diff --git a/lisp/battery.el b/lisp/battery.el index 9afe9de7b98..d7d3045fa58 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -102,6 +102,11 @@ string are substituted as defined by the current value of the variable "String to display in the mode line.") ;;;###autoload (put 'battery-mode-line-string 'risky-local-variable t) +(defcustom battery-mode-line-limit 100 + "Percentage of full battery load below which display battery status" + :type 'integer + :group 'battery) + (defcustom battery-mode-line-format (cond ((eq battery-status-function 'battery-linux-proc-acpi) "[%b%p%%,%d°C]") @@ -182,16 +187,21 @@ seconds." (defun battery-update () "Update battery status information in the mode line." - (setq battery-mode-line-string - (propertize (if (and battery-mode-line-format - battery-status-function) - (battery-format - battery-mode-line-format - (funcall battery-status-function)) - "") - 'help-echo "Battery status information")) + (let ((data (and battery-status-function (funcall battery-status-function)))) + (setq battery-mode-line-string + (propertize (if (and battery-mode-line-format + (<= (car (read-from-string (cdr (assq ?p data)))) + battery-mode-line-limit)) + (battery-format + battery-mode-line-format + data) + "") + 'face + (and (<= (car (read-from-string (cdr (assq ?p data)))) + battery-load-critical) + 'font-lock-warning-face) + 'help-echo "Battery status information"))) (force-mode-line-update)) - ;;; `/proc/apm' interface for Linux. diff --git a/lisp/bindings.el b/lisp/bindings.el index a7b729a1ba3..2f035608528 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -471,7 +471,8 @@ Like `bury-buffer', but temporarily select EVENT's window." (defun mode-line-other-buffer () "\ Switch to the most recently selected buffer other than the current one." (interactive) - (switch-to-buffer (other-buffer))) + (with-no-warnings ; We really do want to call `switch-to-buffer' here. + (switch-to-buffer (other-buffer)))) (defun mode-line-next-buffer (event) "Like `next-buffer', but temporarily select EVENT's window." @@ -806,6 +807,8 @@ if `inhibit-field-text-motion' is non-nil." (define-key map [up] 'previous-history-element) (define-key map "\es" 'next-matching-history-element) (define-key map "\er" 'previous-matching-history-element) + (define-key map [remap next-buffer] 'ignore) + (define-key map [remap previous-buffer] 'ignore) ;; Override the global binding (which calls indent-relative via ;; indent-for-tab-command). The alignment that indent-relative tries to ;; do doesn't make much sense here since the prompt messes it up. diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 184cecb9e9c..9f90ecedc4d 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1539,9 +1539,7 @@ deletion, or > if it is flagged for displaying." (bookmark-maybe-load-default-file) (let ((buf (get-buffer-create "*Bookmark List*"))) (if (called-interactively-p 'interactive) - (if (or (window-dedicated-p) (window-minibuffer-p)) - (pop-to-buffer buf) - (switch-to-buffer buf)) + (pop-to-buffer-same-window buf) (set-buffer buf))) (let ((inhibit-read-only t)) (erase-buffer) @@ -1843,7 +1841,8 @@ With a prefix arg, prompts for a file to save them in." (menu (current-buffer)) (pop-up-windows t)) (delete-other-windows) - (switch-to-buffer (other-buffer)) + (with-no-warnings ; We really do want to call `switch-to-buffer' here. + (switch-to-buffer (other-buffer))) (bookmark--jump-via bmrk 'pop-to-buffer) (bury-buffer menu))) diff --git a/lisp/bs.el b/lisp/bs.el index 95dc371e57b..c7326eedd26 100644 --- a/lisp/bs.el +++ b/lisp/bs.el @@ -1212,11 +1212,11 @@ by buffer configuration `bs-cycle-configuration-name'." bs--cycle-list))) (next (car tupel)) (cycle-list (cdr tupel))) - (unless (window-dedicated-p (selected-window)) - ;; We don't want the frame iconified if the only window in the frame - ;; happens to be dedicated; let's get the error from switch-to-buffer - (bury-buffer)) - (switch-to-buffer next) + ;; We don't want the frame iconified if the only window in the frame + ;; happens to be dedicated. + (bury-buffer (current-buffer)) + (with-no-warnings ; We really do want to call `switch-to-buffer' here. + (switch-to-buffer next)) (setq bs--cycle-list (append (cdr cycle-list) (list (car cycle-list)))) (bs-message-without-log "Next buffers: %s" @@ -1245,7 +1245,8 @@ by buffer configuration `bs-cycle-configuration-name'." bs--cycle-list))) (prev-buffer (car tupel)) (cycle-list (cdr tupel))) - (switch-to-buffer prev-buffer) + (with-no-warnings ; We really do want to call `switch-to-buffer' here. + (switch-to-buffer prev-buffer)) (setq bs--cycle-list (append (last cycle-list) (reverse (cdr (reverse cycle-list))))) (bs-message-without-log "Previous buffers: %s" diff --git a/lisp/button.el b/lisp/button.el index 2e485547745..6ef79532ae7 100644 --- a/lisp/button.el +++ b/lisp/button.el @@ -54,10 +54,7 @@ ;; Use color for the MS-DOS port because it doesn't support underline. ;; FIXME if MS-DOS correctly answers the (supports) question, it need ;; no longer be a special case. -(defface button '((((type pc) (class color)) - (:foreground "lightblue")) - (((supports :underline t)) :underline t) - (t (:foreground "lightblue"))) +(defface button '((t :inherit link)) "Default face used for buttons." :group 'basic-faces) diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index f21247e9c93..1b980b3b1fa 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -776,7 +776,8 @@ of the appropriate type." (goto-char (point-min))) (defvar diary-included-files nil - "List of any diary files included in the last call to `diary-list-entries'.") + "List of any diary files included in the last call to `diary-list-entries'. +Or to `diary-mark-entries'.") (defun diary-list-entries (date number &optional list-only) "Create and display a buffer containing the relevant lines in `diary-file'. @@ -832,7 +833,7 @@ LIST-ONLY is non-nil, in which case it just returns the list." (let* ((original-date date) ; save for possible use in the hooks (date-string (calendar-date-string date)) (diary-buffer (find-buffer-visiting diary-file)) - ;; Dynamically bound in diary-include-other-diary-files. + ;; Dynamically bound in diary-include-files. (d-incp (and (boundp 'diary-including) diary-including)) diary-entries-list file-glob-attrs temp-buff) (unless d-incp @@ -921,19 +922,20 @@ LIST-ONLY is non-nil, in which case it just returns the list." (defvar original-date) ; bound in diary-list-entries ;(defvar number) ; already declared above -(defun diary-include-other-diary-files () - "Add diary entries from included diary files to `diary-entries-list'. +(defun diary-include-files (&optional mark) + "Process diary entries from included diary files. +By default, lists included entries, but if optional argument MARK is non-nil +marks entries instead. For example, this enables you to share common diary files. -To use, add this function to `diary-list-entries-hook'. Specify include files using lines matching `diary-include-string', e.g. #include \"filename\" -This is recursive; that is, included files may include other files. -See also `diary-mark-included-diary-files'." +This is recursive; that is, included files may include other files." (goto-char (point-min)) (while (re-search-forward (format "^%s \"\\([^\"]*\\)\"" (regexp-quote diary-include-string)) nil t) (let ((diary-file (match-string-no-properties 1)) + (diary-mark-entries-hook 'diary-mark-included-diary-files) (diary-list-entries-hook 'diary-include-other-diary-files) (diary-including t) diary-hook diary-list-include-blanks efile) @@ -943,10 +945,12 @@ See also `diary-mark-included-diary-files'." diary-included-files) (error "Recursive diary include for %s" diary-file) (setq diary-included-files - (append diary-included-files (list efile)) - diary-entries-list - (append diary-entries-list - (diary-list-entries original-date number t)))) + (append diary-included-files (list efile))) + (if mark + (diary-mark-entries) + (setq diary-entries-list + (append diary-entries-list + (diary-list-entries original-date number t))))) (beep) (message "Can't read included diary file %s" diary-file) (sleep-for 2)) @@ -955,6 +959,13 @@ See also `diary-mark-included-diary-files'." (sleep-for 2)))) (goto-char (point-min))) +(defun diary-include-other-diary-files () + "Add diary entries from included diary files to `diary-entries-list'. +To use, add this function to `diary-list-entries-hook'. +For details, see `diary-include-files'. +See also `diary-mark-included-diary-files'." + (diary-include-files)) + (define-obsolete-function-alias 'include-other-diary-files 'diary-include-other-diary-files "23.1") @@ -1405,22 +1416,37 @@ marks. This is intended to deal with deleted diary entries." (setq calendar-mark-diary-entries-flag nil) (calendar-redraw)) (let ((diary-marking-entries-flag t) - file-glob-attrs) - (with-current-buffer (find-file-noselect (diary-check-diary-file) t) - (save-excursion - (when (eq major-mode (default-value 'major-mode)) (diary-mode)) - (setq calendar-mark-diary-entries-flag t) - (message "Marking diary entries...") - (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) - (with-syntax-table diary-syntax-table - (diary-mark-entries-1 'calendar-mark-date-pattern) - (diary-mark-sexp-entries) - ;; Although it looks like mark-entries-hook runs every time, - ;; diary-mark-included-diary-files binds it to nil - ;; (essentially) when it runs in included files. - (run-hooks 'diary-nongregorian-marking-hook - 'diary-mark-entries-hook)) - (message "Marking diary entries...done"))))) + (diary-buffer (find-buffer-visiting diary-file)) + ;; Dynamically bound in diary-include-files. + (d-incp (and (boundp 'diary-including) diary-including)) + file-glob-attrs temp-buff) + (unless d-incp + (setq diary-included-files nil) + (message "Marking diary entries...")) + (unwind-protect + (with-current-buffer (or diary-buffer + (if d-incp + (setq temp-buff (generate-new-buffer + " *diary-temp*")) + (find-file-noselect + (diary-check-diary-file) t))) + (if temp-buff + ;; If including, caller has already verified it is readable. + (insert-file-contents diary-file) + (if (eq major-mode (default-value 'major-mode)) (diary-mode))) + (setq calendar-mark-diary-entries-flag t) + (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))) + (with-syntax-table diary-syntax-table + (save-excursion + (diary-mark-entries-1 'calendar-mark-date-pattern) + (diary-mark-sexp-entries) + ;; Although it looks like mark-entries-hook runs every time, + ;; diary-mark-included-diary-files binds it to nil + ;; (essentially) when it runs in included files. + (run-hooks 'diary-nongregorian-marking-hook + 'diary-mark-entries-hook)))) + (and temp-buff (buffer-name temp-buff) (kill-buffer temp-buff))) + (or d-incp (message "Marking diary entries...done")))) ;;;###cal-autoload (define-obsolete-function-alias 'mark-diary-entries 'diary-mark-entries "23.1") @@ -1504,32 +1530,10 @@ is marked. See the documentation for the function `diary-list-sexp-entries'." (defun diary-mark-included-diary-files () "Mark diary entries from included diary files. -For example, this enables you to share common diary files. To use, add this function to `diary-mark-entries-hook'. -Specify include files using lines matching `diary-include-string', e.g. - #include \"filename\" -This is recursive; that is, included files may include other files. +For details, see `diary-include-files'. See also `diary-include-other-diary-files'." - (goto-char (point-min)) - (while (re-search-forward - (format "^%s \"\\([^\"]*\\)\"" (regexp-quote diary-include-string)) - nil t) - (let* ((diary-file (match-string-no-properties 1)) - (diary-mark-entries-hook 'diary-mark-included-diary-files) - (dbuff (find-buffer-visiting diary-file))) - (if (file-exists-p diary-file) - (if (file-readable-p diary-file) - (progn - (diary-mark-entries) - (unless dbuff - (kill-buffer (find-buffer-visiting diary-file)))) - (beep) - (message "Can't read included diary file %s" diary-file) - (sleep-for 2)) - (beep) - (message "Can't find included diary file %s" diary-file) - (sleep-for 2)))) - (goto-char (point-min))) + (diary-include-files t)) (define-obsolete-function-alias 'mark-included-diary-files 'diary-mark-included-diary-files "23.1") diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el index 8fc3f762f29..1ec474e828e 100644 --- a/lisp/calendar/timeclock.el +++ b/lisp/calendar/timeclock.el @@ -545,11 +545,7 @@ non-nil, the amount returned will be relative to past time worked." (defalias 'timeclock-time-to-seconds (if (fboundp 'float-time) 'float-time 'time-to-seconds)) -(defsubst timeclock-seconds-to-time (seconds) - "Convert SECONDS (a floating point number) to an Emacs time structure." - (list (floor seconds 65536) - (floor (mod seconds 65536)) - (floor (* (- seconds (ffloor seconds)) 1000000)))) +(defalias 'timeclock-seconds-to-time 'seconds-to-time) ;; Should today-only be removed in favour of timeclock-relative? - gm (defsubst timeclock-when-to-leave (&optional today-only) diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index 8c12806df1e..60d7690a3c8 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog @@ -1,3 +1,13 @@ +2011-07-04 Darren Hoo <darren.hoo@gmail.com> (tiny change) + + * semantic/db.el (semanticdb-file-table-object): Don't bug out on + unconfigured projects if `global-ede-mode' is on (bug#8092). + +2011-07-01 Paul Eggert <eggert@cs.ucla.edu> + + * semantic.el (semantic-elapsed-time): Rewrite using + time-subtract and float-time. + 2011-05-11 Glenn Morris <rgm@gnu.org> * semantic/wisent/javascript.el (semantic-get-local-variables): diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index c899988dc36..ce9af0e12b5 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -379,9 +379,7 @@ Do not set this yourself. Call `semantic-debug'.") (defun semantic-elapsed-time (start end) "Copied from elp.el. Was `elp-elapsed-time'. Argument START and END bound the time being calculated." - (+ (* (- (car end) (car start)) 65536.0) - (- (car (cdr end)) (car (cdr start))) - (/ (- (car (cdr (cdr end))) (car (cdr (cdr start)))) 1000000.0))) + (float-time (time-subtract end start))) (defun bovinate (&optional clear) "Parse the current buffer. Show output in a temp buffer. diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el index fa8de392b62..dca1b3bafea 100644 --- a/lisp/cedet/semantic/db.el +++ b/lisp/cedet/semantic/db.el @@ -880,7 +880,7 @@ If file does not have tags available, and DONTLOAD is nil, then load the tags for FILE, and create a new table object for it. DONTLOAD does not affect the creation of new database objects." ;; (message "Object Translate: %s" file) - (when (file-exists-p file) + (when (and file (file-exists-p file)) (let* ((default-directory (file-name-directory file)) (tab (semanticdb-file-table-object-from-hash file)) (fullfile nil)) diff --git a/lisp/comint.el b/lisp/comint.el index 5548d19ad30..2349fc0edd9 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -347,7 +347,7 @@ This variable is buffer-local." " +\\)" (regexp-opt '("password" "Password" "passphrase" "Passphrase" - "pass phrase" "Pass phrase")) + "pass phrase" "Pass phrase" "Response")) "\\(?:\\(?:, try\\)? *again\\| (empty for no passphrase)\\| (again)\\)?\ \\(?: for [^:]+\\)?:\\s *\\'") "Regexp matching prompts for passwords in the inferior process. diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 7c96b526f41..693b36040ea 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1036,6 +1036,29 @@ If given a prefix (or a COMMENT argument), also prompt for a comment." (custom-save-all) value) +;; Some parts of Emacs might prompt the user to save customizations, +;; during startup before customizations are loaded. This function +;; handles this corner case by avoiding calling `custom-save-variable' +;; too early, which could wipe out existing customizations. + +;;;###autoload +(defun customize-push-and-save (list-var elts) + "Add ELTS to LIST-VAR and save for future sessions, safely. +ELTS should be a list. This function adds each entry to the +value of LIST-VAR using `add-to-list'. + +If Emacs is initialized, call `customize-save-variable' to save +the resulting list value now. Otherwise, add an entry to +`after-init-hook' to save it after initialization." + (dolist (entry elts) + (add-to-list list-var entry)) + (if after-init-time + (let ((coding-system-for-read nil)) + (customize-save-variable list-var (eval list-var))) + (add-hook 'after-init-hook + `(lambda () + (customize-push-and-save ',list-var ',elts))))) + ;;;###autoload (defun customize () "Select a customization buffer which you can use to set user options. diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index 7f926c85e56..04a9e728b22 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -157,7 +157,7 @@ remove them from your saved Custom file.\n\n")) ;; Load the theme settings. (when theme (unless (eq theme 'user) - (load-theme theme t)) + (load-theme theme nil t)) (dolist (setting (get theme 'theme-settings)) (if (eq (car setting) 'theme-value) (progn (push (nth 1 setting) vars) @@ -326,7 +326,7 @@ SPEC, if non-nil, should be a face spec to which to set the widget." (unless (eq theme 'user) (unless (custom-theme-name-valid-p theme) (error "Invalid theme name `%s'" theme)) - (load-theme theme t)) + (load-theme theme nil t)) (let ((settings (reverse (get theme 'theme-settings)))) (dolist (setting settings) (funcall (if (eq (car setting) 'theme-value) diff --git a/lisp/custom.el b/lisp/custom.el index 8295777f1f1..a5c0065036a 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -215,7 +215,8 @@ The following keywords are meaningful: variable. It takes two arguments, the symbol and value given in the `defcustom' call. The default is `custom-initialize-reset'. -:set VALUE should be a function to set the value of the symbol. +:set VALUE should be a function to set the value of the symbol + when using the Customize user interface. It takes two arguments, the symbol to set and the value to give it. The default choice of function is `set-default'. :get VALUE should be a function to extract the value of symbol. @@ -854,25 +855,18 @@ See `custom-known-themes' for a list of known themes." ;; Add a new setting: (t (unless old - ;; If the user changed the value outside of Customize, we - ;; first save the current value to a fake theme, `changed'. - ;; This ensures that the user-set value comes back if the - ;; theme is later disabled. - (cond ((and (eq prop 'theme-value) - (boundp symbol)) - (let ((sv (get symbol 'standard-value)) - (val (symbol-value symbol))) - (unless (and sv (equal (eval (car sv)) val)) - (setq old `((changed ,(custom-quote val))))))) - ((and (facep symbol) - (not (face-attr-match-p - symbol - (custom-fix-face-spec - (face-spec-choose - (get symbol 'face-defface-spec)))))) - (setq old `((changed - (,(append '(t) (custom-face-attributes-get - symbol nil))))))))) + ;; If the user changed a variable outside of Customize, save + ;; the value to a fake theme, `changed'. If the theme is + ;; later disabled, we use this to bring back the old value. + ;; + ;; For faces, we just use `face-new-frame-defaults' to + ;; recompute when the theme is disabled. + (when (and (eq prop 'theme-value) + (boundp symbol)) + (let ((sv (get symbol 'standard-value)) + (val (symbol-value symbol))) + (unless (and sv (equal (eval (car sv)) val)) + (setq old `((changed ,(custom-quote val)))))))) (put symbol prop (cons (list theme value) old)) (put theme 'theme-settings (cons (list prop symbol theme value) theme-settings)))))) @@ -1119,20 +1113,29 @@ Emacs theme directory (a directory named \"themes\" in :risky t :version "24.1") -(defun load-theme (theme &optional no-enable) +(defun load-theme (theme &optional no-confirm no-enable) "Load Custom theme named THEME from its file. -Normally, this also enables THEME. If optional arg NO-ENABLE is -non-nil, load THEME but don't enable it. - The theme file is named THEME-theme.el, in one of the directories specified by `custom-theme-load-path'. +If THEME is not in `custom-safe-themes', prompt the user for +confirmation, unless optional arg NO-CONFIRM is non-nil. + +Normally, this function also enables THEME; if optional arg +NO-ENABLE is non-nil, load the theme but don't enable it. + +This function is normally called through Customize when setting +`custom-enabled-themes'. If used directly in your init file, it +should be called with a non-nil NO-CONFIRM argument, or after +`custom-safe-themes' has been loaded. + Return t if THEME was successfully loaded, nil otherwise." (interactive (list (intern (completing-read "Load custom theme: " (mapcar 'symbol-name - (custom-available-themes)))))) + (custom-available-themes)))) + nil nil)) (unless (custom-theme-name-valid-p theme) (error "Invalid theme name `%s'" theme)) ;; If reloading, clear out the old theme settings. @@ -1152,7 +1155,8 @@ Return t if THEME was successfully loaded, nil otherwise." (setq hash (sha1 (current-buffer))) ;; Check file safety with `custom-safe-themes', prompting the ;; user if necessary. - (when (or (and (memq 'default custom-safe-themes) + (when (or no-confirm + (and (memq 'default custom-safe-themes) (equal (file-name-directory fn) (expand-file-name "themes/" data-directory))) (member hash custom-safe-themes) @@ -1211,10 +1215,7 @@ query also about adding HASH to `custom-safe-themes'." ;; Offer to save to `custom-safe-themes'. (and (or custom-file user-init-file) (y-or-n-p "Treat this theme as safe in future sessions? ") - (let ((coding-system-for-read nil)) - (push hash custom-safe-themes) - (customize-save-variable 'custom-safe-themes - custom-safe-themes))) + (customize-push-and-save 'custom-safe-themes (list hash))) t))))) (defun custom-theme-name-valid-p (name) @@ -1291,7 +1292,10 @@ This list does not include the `user' theme, which is set by Customize and always takes precedence over other Custom Themes. This variable cannot be defined inside a Custom theme; there, it -is simply ignored." +is simply ignored. + +Setting this variable through Customize calls `enable-theme' or +`load-theme' for each theme in the list." :group 'customize :type '(repeat symbol) :set-after '(custom-theme-directory custom-theme-load-path @@ -1345,11 +1349,33 @@ See `custom-enabled-themes' for a list of enabled themes." ;; If the face spec specified by this theme is in the ;; saved-face property, reset that property. (when (equal (nth 3 s) (get symbol 'saved-face)) - (put symbol 'saved-face (and val (cadr (car val))))) - (custom-theme-recalc-face symbol))))) + (put symbol 'saved-face (and val (cadr (car val))))))))) + ;; Recompute faces on all frames. + (dolist (frame (frame-list)) + ;; We must reset the fg and bg color frame parameters, or + ;; `face-set-after-frame-default' will use the existing + ;; parameters, which could be from the disabled theme. + (set-frame-parameter frame 'background-color + (custom--frame-color-default + frame :background "background" "Background" + "unspecified-bg" "white")) + (set-frame-parameter frame 'foreground-color + (custom--frame-color-default + frame :foreground "foreground" "Foreground" + "unspecified-fg" "black")) + (face-set-after-frame-default frame)) (setq custom-enabled-themes (delq theme custom-enabled-themes))))) +(defun custom--frame-color-default (frame attribute resource-attr resource-class + tty-default x-default) + (let ((col (face-attribute 'default attribute t))) + (cond + ((and col (not (eq col 'unspecified))) col) + ((null (window-system frame)) tty-default) + ((setq col (x-get-resource resource-attr resource-class)) col) + (t x-default)))) + (defun custom-variable-theme-value (variable) "Return (list VALUE) indicating the custom theme value of VARIABLE. That is to say, it specifies what the value should be according to @@ -1381,7 +1407,7 @@ This function returns nil if no custom theme specifies a value for VARIABLE." (face-spec-recalc face frame))) -;;; XEmacs compability functions +;;; XEmacs compatibility functions ;; In XEmacs, when you reset a Custom Theme, you have to specify the ;; theme to reset it to. We just apply the next available theme, so diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index 00e2ec802e2..540b93faad8 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -206,7 +206,8 @@ starting with or containing `no-'. If you set this variable to expanding `yes-or-no-' signals an error because `-' is not part of a word; but expanding `yes-or-no' looks for a word starting with `no'. -The recommended value is \"\\\\sw\\\\|\\\\s_\"." +The recommended value is nil, which will make dabbrev default to +using \"\\\\sw\\\\|\\\\s_\"." :type '(choice (const nil) regexp) :group 'dabbrev) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 8e4b3b5c6a6..5ab4146383b 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -56,9 +56,9 @@ into this list; they also should call `dired-log' to log the errors.") "Compare file at point with file FILE using `diff'. FILE defaults to the file at the mark. (That's the mark set by \\[set-mark-command], not by Dired's \\[dired-mark] command.) -The prompted-for file is the first file given to `diff'. +The prompted-for FILE is the first file given to `diff'. With prefix arg, prompt for second argument SWITCHES, -which is options for `diff'." +which is the string of command switches for `diff'." (interactive (let* ((current (dired-get-filename t)) ;; Get the file at the mark. @@ -699,6 +699,9 @@ can be produced by `dired-get-marked-files', for example." ;; Commands that delete or redisplay part of the dired buffer. (defun dired-kill-line (&optional arg) + "Kill the current line (not the files). +With a prefix argument, kill that many lines starting with the current line. +\(A negative argument kills backward.)" (interactive "P") (setq arg (prefix-numeric-value arg)) (let (buffer-read-only file) @@ -1008,7 +1011,7 @@ See Info node `(emacs)Subdir switches' for more details." (dired-uncache (if (consp dired-directory) (car dired-directory) dired-directory)) (dired-map-over-marks (let ((fname (dired-get-filename)) - ;; Postphone readin hook till we map + ;; Postpone readin hook till we map ;; over all marked files (Bug#6810). (dired-after-readin-hook nil)) (message "Redisplaying... %s" fname) @@ -2493,8 +2496,9 @@ with the command \\[tags-loop-continue]." ;;;###autoload (defun dired-show-file-type (file &optional deref-symlinks) "Print the type of FILE, according to the `file' command. -If FILE is a symbolic link and the optional argument DEREF-SYMLINKS is -true then the type of the file linked to by FILE is printed instead." +If you give a prefix to this command, and FILE is a symbolic +link, then the type of the file linked to by FILE is printed +instead." (interactive (list (dired-get-filename t) current-prefix-arg)) (let (process-file-side-effects) (with-temp-buffer diff --git a/lisp/dired-x.el b/lisp/dired-x.el index ca89d07ea7f..8395a8b905f 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -1406,7 +1406,7 @@ Considers buffers closer to the car of `buffer-list' to be more recent." (defun dired-mark-sexp (predicate &optional unflag-p) "Mark files for which PREDICATE returns non-nil. -With a prefix arg, unflag those files instead. +With a prefix arg, unmark or unflag those files instead. PREDICATE is a lisp expression that can refer to the following symbols: diff --git a/lisp/dired.el b/lisp/dired.el index 43b2170d13a..62bab489fbc 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -238,8 +238,6 @@ This is what the do-commands look for, and what the mark-commands store.") ;; (> baud-rate search-slow-speed) "Non-nil means Dired shrinks the display buffer to fit the marked files.") -(defvar dired-flagging-regexp nil);; Last regexp used to flag files. - (defvar dired-file-version-alist) ;;;###autoload @@ -485,7 +483,16 @@ Return value is the number of files marked, or nil if none were marked." `(let ((inhibit-read-only t) count) (save-excursion (setq count 0) - (if ,msg (message "Marking %ss..." ,msg)) + (when ,msg + (message "%s %ss%s..." + (cond ((eq dired-marker-char ?\040) "Unmarking") + ((eq dired-del-marker dired-marker-char) + "Flagging") + (t "Marking")) + ,msg + (if (eq dired-del-marker dired-marker-char) + " for deletion" + ""))) (goto-char (point-min)) (while (not (eobp)) (if ,predicate @@ -506,24 +513,31 @@ Return value is the number of files marked, or nil if none were marked." (defmacro dired-map-over-marks (body arg &optional show-progress distinguish-one-marked) "Eval BODY with point on each marked line. Return a list of BODY's results. -If no marked file could be found, execute BODY on the current line. -ARG, if non-nil, specifies the files to use instead of the marked files. - If ARG is an integer, use the next ARG (or previous -ARG, if - ARG<0) files. In that case, point is dragged along. This is - so that commands on the next ARG (instead of the marked) files - can be chained easily. - For any other non-nil value of ARG, use the current file. +If no marked file could be found, execute BODY on the current +line. ARG, if non-nil, specifies the files to use instead of the +marked files. + +If ARG is an integer, use the next ARG (or previous -ARG, if +ARG<0) files. In that case, point is dragged along. This is so +that commands on the next ARG (instead of the marked) files can +be chained easily. +For any other non-nil value of ARG, use the current file. + If optional third arg SHOW-PROGRESS evaluates to non-nil, - redisplay the dired buffer after each file is processed. -No guarantee is made about the position on the marked line. - BODY must ensure this itself if it depends on this. -Search starts at the beginning of the buffer, thus the car of the list - corresponds to the line nearest to the buffer's bottom. This - is also true for (positive and negative) integer values of ARG. +redisplay the dired buffer after each file is processed. + +No guarantee is made about the position on the marked line. BODY +must ensure this itself if it depends on this. + +Search starts at the beginning of the buffer, thus the car of the +list corresponds to the line nearest to the buffer's bottom. +This is also true for (positive and negative) integer values of +ARG. + BODY should not be too long as it is expanded four times. -If DISTINGUISH-ONE-MARKED is non-nil, then if we find just one marked file, -return (t FILENAME) instead of (FILENAME)." +If DISTINGUISH-ONE-MARKED is non-nil, then if we find just one +marked file, return (t FILENAME) instead of (FILENAME)." ;; ;;Warning: BODY must not add new lines before point - this may cause an ;;endless loop. @@ -696,7 +710,6 @@ shell wildcards appended to select certain files). If DIRNAME is a cons, its first element is taken as the directory name and the rest as an explicit list of files to make directory entries for. \\<dired-mode-map>\ -You can move around in it with the usual commands. You can flag files for deletion with \\[dired-flag-file-deletion] and then delete them by typing \\[dired-do-flagged-delete]. Type \\[describe-mode] after entering Dired for more info. @@ -1789,8 +1802,8 @@ In Dired, you are \"editing\" a list of the files in a directory and files for later commands or \"flag\" them for deletion, either file by file or all files matching certain criteria. You can move using the usual cursor motion commands.\\<dired-mode-map> -Letters no longer insert themselves. Digits are prefix arguments. -Instead, type \\[dired-flag-file-deletion] to flag a file for Deletion. +The buffer is read-only. Digits are prefix arguments. +Type \\[dired-flag-file-deletion] to flag a file `D' for deletion. Type \\[dired-mark] to Mark a file or subdirectory for later commands. Most commands operate on the marked files and use the current file if no files are marked. Use a numeric prefix argument to operate on @@ -1798,9 +1811,9 @@ Type \\[dired-mark] to Mark a file or subdirectory for later commands. to operate on the current file only. Prefix arguments override marks. Mark-using commands display a list of failures afterwards. Type \\[dired-summary] to see why something went wrong. -Type \\[dired-unmark] to Unmark a file or all files of a subdirectory. -Type \\[dired-unmark-backward] to back up one line and unflag. -Type \\[dired-do-flagged-delete] to eXecute the deletions requested. +Type \\[dired-unmark] to Unmark a file or all files of an inserted subdirectory. +Type \\[dired-unmark-backward] to back up one line and unmark or unflag. +Type \\[dired-do-flagged-delete] to delete (eXecute) the files flagged `D'. Type \\[dired-find-file] to Find the current line's file (or dired it in another buffer, if it is a directory). Type \\[dired-find-file-other-window] to find file or dired directory in Other window. @@ -1810,12 +1823,12 @@ Type \\[dired-do-copy] to Copy files. Type \\[dired-sort-toggle-or-edit] to toggle Sorting by name/date or change the `ls' switches. Type \\[revert-buffer] to read all currently expanded directories aGain. This retains all marks and hides subdirs again that were hidden before. -SPC and DEL can be used to move down and up by lines. +Use `SPC' and `DEL' to move down and up by lines. If Dired ever gets confused, you can either type \\[revert-buffer] \ to read the directories again, type \\[dired-do-redisplay] \ -to relist a single or the marked files or a +to relist the file at point or the marked files or a subdirectory, or type \\[dired-build-subdir-alist] to parse the buffer again for the directory tree. @@ -3015,8 +3028,9 @@ If on a subdir headerline, mark all its files except `.' and `..'." (dired-mark arg))) (defun dired-unmark-backward (arg) - "In Dired, move up lines and remove deletion flag there. -Optional prefix ARG says how many lines to unflag; default is one line." + "In Dired, move up lines and remove marks or deletion flags there. +Optional prefix ARG says how many lines to unmark/unflag; default +is one line." (interactive "p") (dired-unmark (- arg))) @@ -3110,14 +3124,14 @@ The match is against the non-directory part of the filename. Use `^' (defun dired-mark-symlinks (unflag-p) "Mark all symbolic links. -With prefix argument, unflag all those files." +With prefix argument, unmark or unflag all those files." (interactive "P") (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char))) (dired-mark-if (looking-at dired-re-sym) "symbolic link"))) (defun dired-mark-directories (unflag-p) "Mark all directory file lines except `.' and `..'. -With prefix argument, unflag all those files." +With prefix argument, unmark or unflag all those files." (interactive "P") (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char))) (dired-mark-if (and (looking-at dired-re-dir) @@ -3126,7 +3140,7 @@ With prefix argument, unflag all those files." (defun dired-mark-executables (unflag-p) "Mark all executable files. -With prefix argument, unflag all those files." +With prefix argument, unmark or unflag all those files." (interactive "P") (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char))) (dired-mark-if (looking-at dired-re-exe) "executable file"))) @@ -3136,7 +3150,7 @@ With prefix argument, unflag all those files." (defun dired-flag-auto-save-files (&optional unflag-p) "Flag for deletion files whose names suggest they are auto save files. -A prefix argument says to unflag those files instead." +A prefix argument says to unmark or unflag those files instead." (interactive "P") (let ((dired-marker-char (if unflag-p ?\040 dired-del-marker))) (dired-mark-if @@ -3176,7 +3190,7 @@ A prefix argument says to unflag those files instead." (defun dired-flag-backup-files (&optional unflag-p) "Flag all backup files (names ending with `~') for deletion. -With prefix argument, unflag these files." +With prefix argument, unmark or unflag these files." (interactive "P") (let ((dired-marker-char (if unflag-p ?\s dired-del-marker))) (dired-mark-if @@ -3629,16 +3643,16 @@ Ask means pop up a menu for the user to select one of copy, move or link." ;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command ;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown ;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff -;;;;;; dired-diff) "dired-aux" "dired-aux.el" "7efcfe4f9e0913ae4a87be014010c27f") +;;;;;; dired-diff) "dired-aux" "dired-aux.el" "d7b197829c8d456cc5bc6c5fdab7c4b0") ;;; Generated autoloads from dired-aux.el (autoload 'dired-diff "dired-aux" "\ Compare file at point with file FILE using `diff'. FILE defaults to the file at the mark. (That's the mark set by \\[set-mark-command], not by Dired's \\[dired-mark] command.) -The prompted-for file is the first file given to `diff'. +The prompted-for FILE is the first file given to `diff'. With prefix arg, prompt for second argument SWITCHES, -which is options for `diff'. +which is the string of command switches for `diff'. \(fn FILE &optional SWITCHES)" t nil) @@ -4081,8 +4095,9 @@ with the command \\[tags-loop-continue]. (autoload 'dired-show-file-type "dired-aux" "\ Print the type of FILE, according to the `file' command. -If FILE is a symbolic link and the optional argument DEREF-SYMLINKS is -true then the type of the file linked to by FILE is printed instead. +If you give a prefix to this command, and FILE is a symbolic +link, then the type of the file linked to by FILE is printed +instead. \(fn FILE &optional DEREF-SYMLINKS)" t nil) diff --git a/lisp/disp-table.el b/lisp/disp-table.el index 7a9043a6a0a..3befedac256 100644 --- a/lisp/disp-table.el +++ b/lisp/disp-table.el @@ -94,9 +94,27 @@ Valid symbols are `truncation', `wrap', `escape', `control', (while (< i 256) (aset vector i (aref dt i)) (setq i (1+ i))) - (describe-vector vector)) + (describe-vector + vector 'display-table-print-array)) (help-mode)))) +(defun display-table-print-array (desc) + (insert "[") + (let ((column (current-column)) + (width (window-width)) + string) + (dotimes (i (length desc)) + (setq string (format "%s" (aref desc i))) + (cond + ((>= (+ (current-column) (length string) 1) + width) + (insert "\n") + (insert (make-string column ? ))) + ((> i 0) + (insert " "))) + (insert string))) + (insert "]\n")) + ;;;###autoload (defun describe-current-display-table () "Describe the display table in use in the selected window and buffer." diff --git a/lisp/dynamic-setting.el b/lisp/dynamic-setting.el index 81531c4a21f..167da69d1ca 100644 --- a/lisp/dynamic-setting.el +++ b/lisp/dynamic-setting.el @@ -86,7 +86,9 @@ current form for the frame (i.e. hinting or somesuch changed)." Changes can be The monospace font. If `font-use-system-font' is nil, the font is not changed. + The normal font. Xft parameters, like DPI and hinting. + The Gtk+ theme name. The tool bar style." (interactive "e") (let ((type (nth 1 event)) diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el index 86063c512c6..aa84a075b76 100644 --- a/lisp/emacs-lisp/benchmark.el +++ b/lisp/emacs-lisp/benchmark.el @@ -39,9 +39,8 @@ (setq ,t1 (current-time)) ,@forms (setq ,t2 (current-time)) - (+ (* (- (car ,t2) (car ,t1)) 65536.0) - (- (nth 1 ,t2) (nth 1 ,t1)) - (* (- (nth 2 ,t2) (nth 2 ,t1)) 1.0e-6))))) + (float-time (time-subtract ,t2 ,t1))))) + (put 'benchmark-elapse 'edebug-form-spec t) (put 'benchmark-elapse 'lisp-indent-function 0) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 127f93c6858..223e9667ac3 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -355,7 +355,7 @@ else the global value will be modified." (defvar byte-compile-interactive-only-functions '(beginning-of-buffer end-of-buffer replace-string replace-regexp insert-file insert-buffer insert-file-literally previous-line next-line - goto-line comint-run delete-backward-char) + goto-line comint-run delete-backward-char switch-to-buffer) "List of commands that are not meant to be called from Lisp.") (defvar byte-compile-not-obsolete-vars nil diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index 1db98ac39c8..4fda2bf1d52 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -253,8 +253,14 @@ No problems result if this variable is not bound. `(let ((parent (char-table-parent ,syntax))) (unless (and parent (not (eq parent (standard-syntax-table)))) - (set-char-table-parent ,syntax (syntax-table))))))) - + (set-char-table-parent ,syntax (syntax-table))))) + ,(when declare-abbrev + `(unless (or (abbrev-table-get ,abbrev :parents) + ;; This can happen if the major mode defines + ;; the abbrev-table to be its parent's. + (eq ,abbrev local-abbrev-table)) + (abbrev-table-put ,abbrev :parents + (list local-abbrev-table)))))) (use-local-map ,map) ,(when syntax `(set-syntax-table ,syntax)) ,(when abbrev `(setq local-abbrev-table ,abbrev)) diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index 73af3a5708f..b89b6decfc9 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -282,7 +282,7 @@ FUNSYM must be a symbol of a defined function." ;; the function so that non-local exists are still recorded. TBD: ;; I haven't tested non-local exits at all, so no guarantees. ;; - ;; The 1st element is the total amount of time in usecs that have + ;; The 1st element is the total amount of time in seconds that has ;; been spent inside this function. This number is added to on ;; function exit. ;; @@ -424,9 +424,7 @@ Use optional LIST if provided instead." (defsubst elp-elapsed-time (start end) - (+ (* (- (car end) (car start)) 65536.0) - (- (car (cdr end)) (car (cdr start))) - (/ (- (car (cdr (cdr end))) (car (cdr (cdr start)))) 1000000.0))) + (float-time (time-subtract end start))) (defun elp-wrapper (funsym interactive-p args) "This function has been instrumented for profiling by the ELP. diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 9c4a3e9832c..0194af2e3a8 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -141,6 +141,15 @@ See the functions `find-function' and `find-variable'." (dolist (suffix (get-load-suffixes) (nreverse suffixes)) (unless (string-match "elc" suffix) (push suffix suffixes))))) +(defun find-library--load-name (library) + (let ((name library)) + (dolist (dir load-path) + (let ((rel (file-relative-name library dir))) + (if (and (not (string-match "\\`\\.\\./" rel)) + (< (length rel) (length name))) + (setq name rel)))) + (unless (equal name library) name))) + (defun find-library-name (library) "Return the absolute file name of the Emacs Lisp source of LIBRARY. LIBRARY should be a string (the name of the library)." @@ -148,13 +157,23 @@ LIBRARY should be a string (the name of the library)." ;; the same name. (if (string-match "\\.el\\(c\\(\\..*\\)?\\)\\'" library) (setq library (replace-match "" t t library))) - (or + (or (locate-file library (or find-function-source-path load-path) (find-library-suffixes)) (locate-file library (or find-function-source-path load-path) load-file-rep-suffixes) + (when (file-name-absolute-p library) + (let ((rel (find-library--load-name library))) + (when rel + (or + (locate-file rel + (or find-function-source-path load-path) + (find-library-suffixes)) + (locate-file rel + (or find-function-source-path load-path) + load-file-rep-suffixes))))) (error "Can't find library %s" library))) (defvar find-function-C-source-directory diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 04299aec099..c8620aaa439 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -38,46 +38,46 @@ (define-abbrev-table 'lisp-mode-abbrev-table ()) (defvar emacs-lisp-mode-syntax-table - (let ((table (make-syntax-table))) - (let ((i 0)) - (while (< i ?0) - (modify-syntax-entry i "_ " table) - (setq i (1+ i))) - (setq i (1+ ?9)) - (while (< i ?A) - (modify-syntax-entry i "_ " table) - (setq i (1+ i))) - (setq i (1+ ?Z)) - (while (< i ?a) - (modify-syntax-entry i "_ " table) - (setq i (1+ i))) - (setq i (1+ ?z)) - (while (< i 128) - (modify-syntax-entry i "_ " table) - (setq i (1+ i))) - (modify-syntax-entry ?\s " " table) - ;; Non-break space acts as whitespace. - (modify-syntax-entry ?\x8a0 " " table) - (modify-syntax-entry ?\t " " table) - (modify-syntax-entry ?\f " " table) - (modify-syntax-entry ?\n "> " table) - ;; This is probably obsolete since nowadays such features use overlays. - ;; ;; Give CR the same syntax as newline, for selective-display. - ;; (modify-syntax-entry ?\^m "> " table) - (modify-syntax-entry ?\; "< " table) - (modify-syntax-entry ?` "' " table) - (modify-syntax-entry ?' "' " table) - (modify-syntax-entry ?, "' " table) - (modify-syntax-entry ?@ "' " table) - ;; Used to be singlequote; changed for flonums. - (modify-syntax-entry ?. "_ " table) - (modify-syntax-entry ?# "' " table) - (modify-syntax-entry ?\" "\" " table) - (modify-syntax-entry ?\\ "\\ " table) - (modify-syntax-entry ?\( "() " table) - (modify-syntax-entry ?\) ")( " table) - (modify-syntax-entry ?\[ "(] " table) - (modify-syntax-entry ?\] ")[ " table)) + (let ((table (make-syntax-table)) + (i 0)) + (while (< i ?0) + (modify-syntax-entry i "_ " table) + (setq i (1+ i))) + (setq i (1+ ?9)) + (while (< i ?A) + (modify-syntax-entry i "_ " table) + (setq i (1+ i))) + (setq i (1+ ?Z)) + (while (< i ?a) + (modify-syntax-entry i "_ " table) + (setq i (1+ i))) + (setq i (1+ ?z)) + (while (< i 128) + (modify-syntax-entry i "_ " table) + (setq i (1+ i))) + (modify-syntax-entry ?\s " " table) + ;; Non-break space acts as whitespace. + (modify-syntax-entry ?\x8a0 " " table) + (modify-syntax-entry ?\t " " table) + (modify-syntax-entry ?\f " " table) + (modify-syntax-entry ?\n "> " table) + ;; This is probably obsolete since nowadays such features use overlays. + ;; ;; Give CR the same syntax as newline, for selective-display. + ;; (modify-syntax-entry ?\^m "> " table) + (modify-syntax-entry ?\; "< " table) + (modify-syntax-entry ?` "' " table) + (modify-syntax-entry ?' "' " table) + (modify-syntax-entry ?, "' " table) + (modify-syntax-entry ?@ "' " table) + ;; Used to be singlequote; changed for flonums. + (modify-syntax-entry ?. "_ " table) + (modify-syntax-entry ?# "' " table) + (modify-syntax-entry ?\" "\" " table) + (modify-syntax-entry ?\\ "\\ " table) + (modify-syntax-entry ?\( "() " table) + (modify-syntax-entry ?\) ")( " table) + (modify-syntax-entry ?\[ "(] " table) + (modify-syntax-entry ?\] ")[ " table) table) "Syntax table used in `emacs-lisp-mode'.") @@ -525,7 +525,6 @@ if that value is non-nil." "Keymap for Lisp Interaction mode. All commands in `lisp-mode-shared-map' are inherited by this map.") -(defvar lisp-interaction-mode-abbrev-table lisp-mode-abbrev-table) (define-derived-mode lisp-interaction-mode emacs-lisp-mode "Lisp Interaction" "Major mode for typing and evaluating Lisp forms. Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression @@ -790,25 +789,25 @@ Reinitialize the face according to the `defface' specification." ;; `defface' is macroexpanded to `custom-declare-face'. ((eq (car form) 'custom-declare-face) ;; Reset the face. - (setq face-new-frame-defaults - (assq-delete-all (eval (nth 1 form) lexical-binding) - face-new-frame-defaults)) - (put (eval (nth 1 form) lexical-binding) 'face-defface-spec nil) - ;; Setting `customized-face' to the new spec after calling - ;; the form, but preserving the old saved spec in `saved-face', - ;; imitates the situation when the new face spec is set - ;; temporarily for the current session in the customize - ;; buffer, thus allowing `face-user-default-spec' to use the - ;; new customized spec instead of the saved spec. - ;; Resetting `saved-face' temporarily to nil is needed to let - ;; `defface' change the spec, regardless of a saved spec. - (prog1 `(prog1 ,form - (put ,(nth 1 form) 'saved-face - ',(get (eval (nth 1 form) lexical-binding) - 'saved-face)) - (put ,(nth 1 form) 'customized-face - ,(nth 2 form))) - (put (eval (nth 1 form) lexical-binding) 'saved-face nil))) + (let ((face-symbol (eval (nth 1 form) lexical-binding))) + (setq face-new-frame-defaults + (assq-delete-all face-symbol face-new-frame-defaults)) + (put face-symbol 'face-defface-spec nil) + (put face-symbol 'face-documentation (nth 3 form)) + ;; Setting `customized-face' to the new spec after calling + ;; the form, but preserving the old saved spec in `saved-face', + ;; imitates the situation when the new face spec is set + ;; temporarily for the current session in the customize + ;; buffer, thus allowing `face-user-default-spec' to use the + ;; new customized spec instead of the saved spec. + ;; Resetting `saved-face' temporarily to nil is needed to let + ;; `defface' change the spec, regardless of a saved spec. + (prog1 `(prog1 ,form + (put ,(nth 1 form) 'saved-face + ',(get face-symbol 'saved-face)) + (put ,(nth 1 form) 'customized-face + ,(nth 2 form))) + (put face-symbol 'saved-face nil)))) ((eq (car form) 'progn) (cons 'progn (mapcar 'eval-defun-1 (cdr form)))) (t form))) diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index 5ce18d020c9..ebbd6ff1fdf 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -714,8 +714,7 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions." (remove-hook 'after-change-functions 'reb-auto-update t) (remove-hook 'kill-buffer-hook 'reb-kill-buffer t) (when (reb-mode-buffer-p) - (reb-delete-overlays) - (funcall (or (default-value 'major-mode) 'fundamental-mode))))) + (reb-delete-overlays)))) ;; continue standard unloading nil) diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 17cc5668b5f..cad7c8419b2 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -229,14 +229,18 @@ one of those elements share the same precedence level and associativity." ;; the trouble, and it lets the writer of the BNF ;; be a bit more sloppy by skipping uninteresting base ;; cases which are terminals but not OPs. - (assert (not (member (cadr rhs) nts))) + (when (member (cadr rhs) nts) + (error "Adjacent non-terminals: %s %s" + (car rhs) (cadr rhs))) (pushnew (cadr rhs) first-ops))) (let ((shr (reverse rhs))) (if (not (member (car shr) nts)) (pushnew (car shr) last-ops) (pushnew (car shr) last-nts) (when (consp (cdr shr)) - (assert (not (member (cadr shr) nts))) + (when (member (cadr shr) nts) + (error "Adjacent non-terminals: %s %s" + (cadr shr) (car shr))) (pushnew (cadr shr) last-ops))))) (push (cons nt first-ops) first-ops-table) (push (cons nt last-ops) last-ops-table) diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index 0a035175041..0e007ff7176 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -110,38 +110,16 @@ of SECS seconds since the epoch. SECS may be a fraction." (defun timer-relative-time (time secs &optional usecs) "Advance TIME by SECS seconds and optionally USECS microseconds. SECS may be either an integer or a floating point number." - ;; FIXME: we should just use (time-add time (list 0 secs usecs)) - (let ((high (car time)) - (low (if (consp (cdr time)) (nth 1 time) (cdr time))) - (micro (if (numberp (car-safe (cdr-safe (cdr time)))) - (nth 2 time) - 0))) - ;; Add - (if usecs (setq micro (+ micro usecs))) - (if (floatp secs) - (setq micro (+ micro (floor (* 1000000 (- secs (floor secs))))))) - (setq low (+ low (floor secs))) - - ;; Normalize - ;; `/' rounds towards zero while `mod' returns a positive number, - ;; so we can't rely on (= a (+ (* 100 (/ a 100)) (mod a 100))). - (setq low (+ low (/ micro 1000000) (if (< micro 0) -1 0))) - (setq micro (mod micro 1000000)) - (setq high (+ high (/ low 65536) (if (< low 0) -1 0))) - (setq low (logand low 65535)) - - (list high low (and (/= micro 0) micro)))) + (let ((delta (if (floatp secs) + (seconds-to-time secs) + (list (floor secs 65536) (mod secs 65536))))) + (if usecs + (setq delta (time-add delta (list 0 0 usecs)))) + (time-add time delta))) (defun timer--time-less-p (t1 t2) "Say whether time value T1 is less than time value T2." - ;; FIXME just use time-less-p. - (destructuring-bind (high1 low1 micro1) (timer--time t1) - (destructuring-bind (high2 low2 micro2) (timer--time t2) - (or (< high1 high2) - (and (= high1 high2) - (or (< low1 low2) - (and (= low1 low2) - (< micro1 micro2)))))))) + (time-less-p (timer--time t1) (timer--time t2))) (defun timer-inc-time (timer secs &optional usecs) "Increment the time set in TIMER by SECS seconds and USECS microseconds. @@ -273,10 +251,7 @@ how many will really happen.") "Calculate number of seconds from when TIMER will run, until TIME. TIMER is a timer, and stands for the time when its next repeat is scheduled. TIME is a time-list." - ;; FIXME: (float-time (time-subtract (timer--time timer) time)) - (let ((high (- (car time) (timer--high-seconds timer))) - (low (- (nth 1 time) (timer--low-seconds timer)))) - (+ low (* high 65536)))) + (float-time (time-subtract time (timer--time timer)))) (defun timer-event-handler (timer) "Call the handler for the timer TIMER. diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el index 1553aeae0d5..18411f7d2ef 100644 --- a/lisp/emacs-lock.el +++ b/lisp/emacs-lock.el @@ -1,9 +1,10 @@ -;;; emacs-lock.el --- prevents you from exiting Emacs if a buffer is locked +;;; emacs-lock.el --- protect buffers against killing or exiting -*- lexical-binding: t -*- -;; Copyright (C) 1994, 1997, 2001-2011 Free Software Foundation, Inc +;; Copyright (C) 2011 Free Software Foundation, Inc -;; Author: Tom Wurgler <twurgler@goodyear.com> -;; Created: 12/8/94 +;; Author: Juanma Barranquero <lekktu@gmail.com> +;; Inspired by emacs-lock.el by Tom Wurgler <twurgler@goodyear.com> +;; Maintainer: FSF ;; Keywords: extensions, processes ;; This file is part of GNU Emacs. @@ -23,78 +24,220 @@ ;;; Commentary: -;; This code sets a buffer-local variable to t if toggle-emacs-lock is run, -;; then if the user attempts to exit Emacs, the locked buffer name will be -;; displayed and the exit aborted. This is just a way of protecting -;; yourself from yourself. For example, if you have a shell running a big -;; program and exiting Emacs would abort that program, you may want to lock -;; that buffer, then if you forget about it after a while, you won't -;; accidentally exit Emacs. To unlock the buffer, just goto the buffer and -;; run toggle-emacs-lock again. +;; This package defines a minor mode Emacs Lock to mark a buffer as +;; protected against accidental killing, or exiting Emacs, or both. +;; Buffers associated with inferior modes, like shell or telnet, can +;; be treated specially, by auto-unlocking them if their interior +;; processes are dead. ;;; Code: -(defvar emacs-lock-from-exiting nil - "Whether Emacs is locked to prevent exiting. See `check-emacs-lock'.") -(make-variable-buffer-local 'emacs-lock-from-exiting) - -(defvar emacs-lock-buffer-locked nil - "Whether a shell or telnet buffer was locked when its process was killed.") -(make-variable-buffer-local 'emacs-lock-buffer-locked) -(put 'emacs-lock-buffer-locked 'permanent-local t) +(defgroup emacs-lock nil + "Emacs-Lock mode." + :version "24.1" + :group 'convenience) + +(defcustom emacs-lock-default-locking-mode 'all + "Default locking mode of Emacs-Locked buffers. + +Its value is used as the default for `emacs-lock-mode' (which +see) the first time that Emacs Lock mode is turned on in a buffer +without passing an explicit locking mode. + +Possible values are: + exit -- Emacs cannot exit while the buffer is locked + kill -- the buffer cannot be killed, but Emacs can exit as usual + all -- the buffer is locked against both actions + nil -- the buffer is not locked" + :type '(choice + (const :tag "Do not allow Emacs to exit" exit) + (const :tag "Do not allow killing the buffer" kill) + (const :tag "Do not allow killing the buffer or exiting Emacs" all) + (const :tag "Do not lock the buffer" nil)) + :group 'emacs-lock + :version "24.1") + +;; Note: as auto-unlocking can lead to data loss, it would be better +;; to default to nil; but the value below is for compatibility with +;; the old emacs-lock.el. +(defcustom emacs-lock-unlockable-modes '((shell-mode . all) + (telnet-mode . all)) + "Alist of auto-unlockable modes. +Each element is a pair (MAJOR-MODE . ACTION), where ACTION is +one of `kill', `exit' or `all'. Buffers with matching major +modes are auto-unlocked for the specific action if their +inferior processes are not alive. If this variable is t, all +buffers associated to inferior processes are auto-unlockable +for both actions (NOT RECOMMENDED)." + :type '(choice + (const :tag "All buffers with inferior processes" t) + (repeat :tag "Selected modes" + (cons :tag "Set auto-unlock for" + (symbol :tag "Major mode") + (radio + (const :tag "Allow exiting" exit) + (const :tag "Allow killing" kill) + (const :tag "Allow both" all))))) + :group 'emacs-lock + :version "24.1") + +(defvar emacs-lock-mode nil + "If non-nil, the current buffer is locked. +It can be one of the following values: + exit -- Emacs cannot exit while the buffer is locked + kill -- the buffer cannot be killed, but Emacs can exit as usual + all -- the buffer is locked against both actions + nil -- the buffer is not locked") +(make-variable-buffer-local 'emacs-lock-mode) +(put 'emacs-lock-mode 'permanent-local t) + +(defvar emacs-lock--old-mode nil + "Most recent locking mode set on the buffer. +Internal use only.") +(make-variable-buffer-local 'emacs-lock--old-mode) +(put 'emacs-lock--old-mode 'permanent-local t) + +(defvar emacs-lock--try-unlocking nil + "Non-nil if current buffer should be checked for auto-unlocking. +Internal use only.") +(make-variable-buffer-local 'emacs-lock--try-unlocking) +(put 'emacs-lock--try-unlocking 'permanent-local t) + +(defun emacs-lock-live-process-p (buffer-or-name) + "Return t if BUFFER-OR-NAME is associated with a live process." + (let ((proc (get-buffer-process buffer-or-name))) + (and proc (process-live-p proc)))) + +(defun emacs-lock--can-auto-unlock (action) + "Return t if the current buffer can auto-unlock for ACTION. +ACTION must be one of `kill' or `exit'. +See `emacs-lock-unlockable-modes'." + (and emacs-lock--try-unlocking + (not (emacs-lock-live-process-p (current-buffer))) + (or (eq emacs-lock-unlockable-modes t) + (let ((unlock (cdr (assq major-mode emacs-lock-unlockable-modes)))) + (or (eq unlock 'all) (eq unlock action)))))) + +(defun emacs-lock--exit-locked-buffer () + "Return the name of the first exit-locked buffer found." + (save-current-buffer + (catch :found + (dolist (buffer (buffer-list)) + (set-buffer buffer) + (unless (or (emacs-lock--can-auto-unlock 'exit) + (memq emacs-lock-mode '(nil kill))) + (throw :found (buffer-name)))) + nil))) + +(defun emacs-lock--kill-emacs-hook () + "Signal an error if any buffer is exit-locked. +Used from `kill-emacs-hook' (which see)." + (let ((buffer-name (emacs-lock--exit-locked-buffer))) + (when buffer-name + (error "Emacs cannot exit because buffer %S is locked" buffer-name)))) + +(defun emacs-lock--kill-emacs-query-functions () + "Display a message if any buffer is exit-locked. +Return a value appropriate for `kill-emacs-query-functions' (which see)." + (let ((locked (emacs-lock--exit-locked-buffer))) + (or (not locked) + (progn + (message "Emacs cannot exit because buffer %S is locked" locked) + nil)))) + +(defun emacs-lock--kill-buffer-query-functions () + "Display a message if the current buffer is kill-locked. +Return a value appropriate for `kill-buffer-query-functions' (which see)." + (or (emacs-lock--can-auto-unlock 'kill) + (memq emacs-lock-mode '(nil exit)) + (progn + (message "Buffer %S is locked and cannot be killed" (buffer-name)) + nil))) + +(defun emacs-lock--set-mode (mode arg) + "Setter function for `emacs-lock-mode'." + (setq emacs-lock-mode + (cond ((memq arg '(all exit kill)) + ;; explicit locking mode arg, use it + arg) + ((and (eq arg current-prefix-arg) (consp current-prefix-arg)) + ;; called with C-u M-x emacs-lock-mode, so ask the user + (intern (completing-read "Locking mode: " + '("all" "exit" "kill") + nil t nil nil + (symbol-name + emacs-lock-default-locking-mode)))) + ((eq mode t) + ;; turn on, so use previous setting, or customized default + (or emacs-lock--old-mode emacs-lock-default-locking-mode)) + (t + ;; anything else (turn off) + mode)))) + +;;;###autoload +(define-minor-mode emacs-lock-mode + "Toggle Emacs Lock mode in the current buffer. + +With \\[universal-argument], ask for the locking mode to be used. +With other prefix ARG, turn mode on if ARG is positive, off otherwise. + +Initially, if the user does not pass an explicit locking mode, it defaults +to `emacs-lock-default-locking-mode' (which see); afterwards, the locking +mode most recently set on the buffer is used instead. + +When called from Elisp code, ARG can be any locking mode: + + exit -- Emacs cannot exit while the buffer is locked + kill -- the buffer cannot be killed, but Emacs can exit as usual + all -- the buffer is locked against both actions + +Other values are interpreted as usual." + :init-value nil + :lighter ("" + (emacs-lock--try-unlocking " locked:" " Locked:") + (:eval (symbol-name emacs-lock-mode))) + :group 'emacs-lock + :variable (emacs-lock-mode . + (lambda (mode) + (emacs-lock--set-mode mode arg))) + (when emacs-lock-mode + (setq emacs-lock--old-mode emacs-lock-mode) + (setq emacs-lock--try-unlocking + (and (if (eq emacs-lock-unlockable-modes t) + (emacs-lock-live-process-p (current-buffer)) + (assq major-mode emacs-lock-unlockable-modes)) + t)))) -(defun check-emacs-lock () - "Check if variable `emacs-lock-from-exiting' is t for any buffer. -If any locked buffer is found, signal error and display the buffer's name." - (save-excursion +(unless noninteractive + (add-hook 'kill-buffer-query-functions 'emacs-lock--kill-buffer-query-functions) + ;; We set a hook in both kill-emacs-hook and kill-emacs-query-functions because + ;; we really want to use k-e-q-f to stop as soon as possible, but don't want to + ;; be caught by surprise if someone calls `kill-emacs' instead. + (add-hook 'kill-emacs-hook 'emacs-lock--kill-emacs-hook) + (add-hook 'kill-emacs-query-functions 'emacs-lock--kill-emacs-query-functions)) + +(defun emacs-lock-unload-function () + "Unload the Emacs Lock library." + (catch :continue (dolist (buffer (buffer-list)) (set-buffer buffer) - (when emacs-lock-from-exiting - (error "Emacs is locked from exit due to buffer: %s" (buffer-name)))))) + (when emacs-lock-mode + (if (y-or-n-p (format "Buffer %S is locked, unlock it? " (buffer-name))) + (emacs-lock-mode -1) + (message "Unloading of feature `emacs-lock' aborted.") + (throw :continue t)))) + ;; continue standard unloading + nil)) -(defun toggle-emacs-lock () - "Toggle `emacs-lock-from-exiting' for the current buffer. -See `check-emacs-lock'." - (interactive) - (setq emacs-lock-from-exiting (not emacs-lock-from-exiting)) - (if emacs-lock-from-exiting - (message "Buffer is now locked") - (message "Buffer is now unlocked"))) - -(defun emacs-lock-check-buffer-lock () - "Check if variable `emacs-lock-from-exiting' is t for a buffer. -If the buffer is locked, signal error and display its name." - (when emacs-lock-from-exiting - (error "Buffer `%s' is locked, can't delete it" (buffer-name)))) - -; These next defuns make it so if you exit a shell that is locked, the lock -; is shut off for that shell so you can exit Emacs. Same for telnet. -; Also, if a shell or a telnet buffer was locked and the process killed, -; turn the lock back on again if the process is restarted. - -(defun emacs-lock-shell-sentinel () - (set-process-sentinel - (get-buffer-process (buffer-name)) (function emacs-lock-clear-sentinel))) - -(defun emacs-lock-clear-sentinel (_proc _str) - (if emacs-lock-from-exiting - (progn - (setq emacs-lock-from-exiting nil) - (setq emacs-lock-buffer-locked t) - (message "Buffer is now unlocked")) - (setq emacs-lock-buffer-locked nil))) +;;; Compatibility -(defun emacs-lock-was-buffer-locked () - (if emacs-lock-buffer-locked - (setq emacs-lock-from-exiting t))) +(define-obsolete-variable-alias 'emacs-lock-from-exiting 'emacs-lock-mode "24.1") -(unless noninteractive - (add-hook 'kill-emacs-hook 'check-emacs-lock)) -(add-hook 'kill-buffer-hook 'emacs-lock-check-buffer-lock) -(add-hook 'shell-mode-hook 'emacs-lock-was-buffer-locked) -(add-hook 'shell-mode-hook 'emacs-lock-shell-sentinel) -(add-hook 'telnet-mode-hook 'emacs-lock-was-buffer-locked) -(add-hook 'telnet-mode-hook 'emacs-lock-shell-sentinel) +(defun toggle-emacs-lock () + "Toggle `emacs-lock-from-exiting' for the current buffer." + (interactive) + (call-interactively 'emacs-lock-mode)) +(make-obsolete 'toggle-emacs-lock 'emacs-lock-mode "24.1") (provide 'emacs-lock) diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index 3d9b0c8646f..1560f2a9049 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,3 +1,8 @@ +2011-07-04 Vivek Dasmohapatra <vivek@etla.org> + + * erc.el (erc-generate-new-buffer-name): Reuse old buffer names + when reconnecting (bug#5563). + 2011-06-23 Lars Magne Ingebrigtsen <larsi@gnus.org> * erc.el (erc-ssl): Made into a synonym for erc-tls, which diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 36097cf0c12..a4040b239c1 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1555,26 +1555,33 @@ symbol, it may have these values: (defun erc-generate-new-buffer-name (server port target &optional proc) "Create a new buffer name based on the arguments." (when (numberp port) (setq port (number-to-string port))) - (let* ((buf-name (or target - (or (let ((name (concat server ":" port))) - (when (> (length name) 1) - name)) - ; This fallback should in fact never happen - "*erc-server-buffer*")))) + (let ((buf-name (or target + (or (let ((name (concat server ":" port))) + (when (> (length name) 1) + name)) + ;; This fallback should in fact never happen + "*erc-server-buffer*"))) + buffer-name) ;; Reuse existing buffers, but not if the buffer is a connected server ;; buffer and not if its associated with a different server than the ;; current ERC buffer. - (if (and erc-reuse-buffers - (get-buffer buf-name) - (or target - (with-current-buffer (get-buffer buf-name) - (and (erc-server-buffer-p) - (not (erc-server-process-alive))))) - (with-current-buffer (get-buffer buf-name) - (and (string= erc-session-server server) - (erc-port-equal erc-session-port port)))) - buf-name - (generate-new-buffer-name buf-name)))) + ;; if buf-name is taken by a different connection (or by something !erc) + ;; then see if "buf-name/server" meets the same criteria + (dolist (candidate (list buf-name (concat buf-name "/" server))) + (if (and (not buffer-name) + erc-reuse-buffers + (get-buffer candidate) + (or target + (with-current-buffer (get-buffer candidate) + (and (erc-server-buffer-p) + (not (erc-server-process-alive))))) + (with-current-buffer (get-buffer candidate) + (and (string= erc-session-server server) + (erc-port-equal erc-session-port port)))) + (setq buffer-name candidate))) + ;; if buffer-name is unset, neither candidate worked out for us, + ;; fallback to the old <N> uniquification method: + (or buffer-name (generate-new-buffer-name buf-name)) )) (defun erc-get-buffer-create (server port target &optional proc) "Create a new buffer based on the arguments." @@ -2362,7 +2369,7 @@ If STRING is nil, the function does nothing." (cond ((integerp elt) ; POSITION (incf (car list) shift)) ((or (atom elt) ; nil, EXTENT - ;; (eq t (car elt)) ; (t HIGH . LOW) + ;; (eq t (car elt)) ; (t . TIME) (markerp (car elt))) ; (MARKER . DISTANCE) nil) ((integerp (car elt)) ; (BEGIN . END) @@ -6493,4 +6500,3 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL." ;; indent-tabs-mode: t ;; tab-width: 8 ;; End: - diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index 4ef259dee4b..17dbe3fbaf2 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -57,6 +57,13 @@ properties to colorize its output based on the setting of :type 'hook :group 'eshell-ls) +(defcustom eshell-ls-date-format "%Y-%m-%d" + "How to display time information in `eshell-ls-file'. +This is passed to `format-time-string' as a format string. +To display the date using the current locale, use \"%b \%e\"." + :type 'string + :group 'eshell-ls) + (defcustom eshell-ls-initial-args nil "If non-nil, this list of args is included before any call to `ls'. This is useful for enabling human-readable format (-h), for example." @@ -508,7 +515,7 @@ whose cdr is the list of file attributes." str)) " " (format-time-string (concat - "%b %e " + eshell-ls-date-format " " (if (= (nth 5 (decode-time (current-time))) (nth 5 (decode-time (nth (cond diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el index f08fec8f8fa..259072d9750 100644 --- a/lisp/eshell/em-smart.el +++ b/lisp/eshell/em-smart.el @@ -120,6 +120,7 @@ only if that output can be presented in its entirely in the Eshell window." (defcustom eshell-smart-display-navigate-list '(insert-parentheses mouse-yank-at-click + mouse-yank-primary mouse-yank-secondary yank-pop yank-rectangle diff --git a/lisp/faces.el b/lisp/faces.el index 3fb8bc80931..34e154314b5 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1255,7 +1255,7 @@ arg, prompt for a regular expression." (insert (substitute-command-keys (concat - "Use " + "\\<help-mode-map>>Use " (if (display-mouse-p) "\\[help-follow-mouse] or ") "\\[help-follow] on a face name to customize it\n" "or on its sample text for a description of the face.\n\n"))) @@ -1821,109 +1821,6 @@ Return nil if it has no specified face." (cond ((memq 'background-color face) (cdr (memq 'background-color face))) ((memq ':background face) (cadr (memq ':background face))))) (t nil)))) ; Invalid face value. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Background mode. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defcustom frame-background-mode nil - "The brightness of the background. -Set this to the symbol `dark' if your background color is dark, -`light' if your background is light, or nil (automatic by default) -if you want Emacs to examine the brightness for you. Don't set this -variable with `setq'; this won't have the expected effect." - :group 'faces - :set #'(lambda (var value) - (set-default var value) - (mapc 'frame-set-background-mode (frame-list))) - :initialize 'custom-initialize-changed - :type '(choice (const dark) - (const light) - (const :tag "automatic" nil))) - - -(declare-function x-get-resource "frame.c" - (attribute class &optional component subclass)) - -(defvar inhibit-frame-set-background-mode nil) - -(defun frame-set-background-mode (frame &optional keep-face-specs) - "Set up display-dependent faces on FRAME. -Display-dependent faces are those which have different definitions -according to the `background-mode' and `display-type' frame parameters. - -If optional arg KEEP-FACE-SPECS is non-nil, don't recalculate -face specs for the new background mode." - (unless inhibit-frame-set-background-mode - (let* ((bg-resource - (and (window-system frame) - (x-get-resource "backgroundMode" "BackgroundMode"))) - (bg-color (frame-parameter frame 'background-color)) - (terminal-bg-mode (terminal-parameter frame 'background-mode)) - (tty-type (tty-type frame)) - (default-bg-mode - (if (or (window-system frame) - (and tty-type - (string-match "^\\(xterm\\|\\rxvt\\|dtterm\\|eterm\\)" - tty-type))) - 'light - 'dark)) - (non-default-bg-mode (if (eq default-bg-mode 'light) 'dark 'light)) - (bg-mode - (cond (frame-background-mode) - (bg-resource (intern (downcase bg-resource))) - (terminal-bg-mode) - ((equal bg-color "unspecified-fg") ; inverted colors - non-default-bg-mode) - ((not (color-values bg-color frame)) - default-bg-mode) - ((>= (apply '+ (color-values bg-color frame)) - ;; Just looking at the screen, colors whose - ;; values add up to .6 of the white total - ;; still look dark to me. - (* (apply '+ (color-values "white" frame)) .6)) - 'light) - (t 'dark))) - (display-type - (cond ((null (window-system frame)) - (if (tty-display-color-p frame) 'color 'mono)) - ((display-color-p frame) - 'color) - ((x-display-grayscale-p frame) - 'grayscale) - (t 'mono))) - (old-bg-mode - (frame-parameter frame 'background-mode)) - (old-display-type - (frame-parameter frame 'display-type))) - - (unless (and (eq bg-mode old-bg-mode) (eq display-type old-display-type)) - (let ((locally-modified-faces nil) - ;; Prevent face-spec-recalc from calling this function - ;; again, resulting in a loop (bug#911). - (inhibit-frame-set-background-mode t) - (params (list (cons 'background-mode bg-mode) - (cons 'display-type display-type)))) - (if keep-face-specs - (modify-frame-parameters frame params) - ;; If we are recomputing face specs, first collect a list - ;; of faces that don't match their face-specs. These are - ;; the faces modified on FRAME, and we avoid changing them - ;; below. Use a negative list to avoid consing (we assume - ;; most faces are unmodified). - (dolist (face (face-list)) - (and (not (get face 'face-override-spec)) - (not (face-spec-match-p face - (face-user-default-spec face) - (selected-frame))) - (push face locally-modified-faces))) - ;; Now change to the new frame parameters - (modify-frame-parameters frame params) - ;; For all unmodified named faces, choose face specs - ;; matching the new frame parameters. - (dolist (face (face-list)) - (unless (memq face locally-modified-faces) - (face-spec-recalc face frame))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -2020,7 +1917,8 @@ settings, X resources, and `face-new-frame-defaults'. Finally, apply any relevant face attributes found amongst the frame parameters in PARAMETERS." (let ((window-system-p (memq (window-system frame) '(x w32)))) - (dolist (face (nreverse (face-list))) ;Why reverse? --Stef + ;; The `reverse' is so that `default' goes first. + (dolist (face (nreverse (face-list))) (condition-case () (progn ;; Initialize faces from face spec and custom theme. diff --git a/lisp/files.el b/lisp/files.el index 7b97b730111..c9f85ff6a1a 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1341,8 +1341,8 @@ automatically choosing a major mode, use \\[find-file-literally]." (confirm-nonexistent-file-or-buffer))) (let ((value (find-file-noselect filename nil nil wildcards))) (if (listp value) - (mapcar 'switch-to-buffer (nreverse value)) - (switch-to-buffer value)))) + (mapcar #'pop-to-buffer-same-window (nreverse value)) + (pop-to-buffer-same-window value)))) (defun find-file-other-window (filename &optional wildcards) "Edit file FILENAME, in another window. @@ -2268,7 +2268,12 @@ since only a single case-insensitive search through the alist is made." ("\\.icn\\'" . icon-mode) ("\\.sim\\'" . simula-mode) ("\\.mss\\'" . scribe-mode) + ;; The Fortran standard does not say anything about file extensions. + ;; .f90 was widely used for F90, now we seem to be trapped into + ;; using a different extension for each language revision. + ;; Anyway, the following extensions are supported by gfortran. ("\\.f9[05]\\'" . f90-mode) + ("\\.f0[38]\\'" . f90-mode) ("\\.indent\\.pro\\'" . fundamental-mode) ; to avoid idlwave-mode ("\\.\\(pro\\|PRO\\)\\'" . idlwave-mode) ("\\.srt\\'" . srecode-template-mode) @@ -2938,16 +2943,7 @@ n -- to ignore the local variables list.") (setq char nil))) (kill-buffer buf) (when (and offer-save (= char ?!) unsafe-vars) - (dolist (elt unsafe-vars) - (add-to-list 'safe-local-variable-values elt)) - ;; When this is called from desktop-restore-file-buffer, - ;; coding-system-for-read may be non-nil. Reset it before - ;; writing to .emacs. - (if (or custom-file user-init-file) - (let ((coding-system-for-read nil)) - (customize-save-variable - 'safe-local-variable-values - safe-local-variable-values)))) + (customize-push-and-save 'safe-local-variable-values unsafe-vars)) (memq char '(?! ?\s ?y)))))) (defun hack-local-variables-prop-line (&optional mode-only) @@ -5564,7 +5560,8 @@ default directory. However, if FULL is non-nil, they are absolute." contents) (while dirs (when (or (null (car dirs)) ; Possible if DIRPART is not wild. - (file-directory-p (directory-file-name (car dirs)))) + (and (file-directory-p (directory-file-name (car dirs))) + (file-readable-p (car dirs)))) (let ((this-dir-contents ;; Filter out "." and ".." (delq nil diff --git a/lisp/find-dired.el b/lisp/find-dired.el index a2b196dc029..491110bc898 100644 --- a/lisp/find-dired.el +++ b/lisp/find-dired.el @@ -86,8 +86,7 @@ them for `find-ls-option'." (defcustom find-grep-options (if (or (eq system-type 'berkeley-unix) - (string-match "solaris2" system-configuration) - (string-match "irix" system-configuration)) + (string-match "solaris2\\|irix" system-configuration)) "-s" "-q") "Option to grep to be as silent as possible. On Berkeley systems, this is `-s'; on Posix, and with GNU grep, `-q' does it. diff --git a/lisp/font-lock.el b/lisp/font-lock.el index e4dc6f11479..3743dd54b7a 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -1904,7 +1904,7 @@ Sets various variables using `font-lock-defaults' and (defface font-lock-builtin-face '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold)) (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold)) - (((class color) (min-colors 88) (background light)) (:foreground "MediumOrchid4")) + (((class color) (min-colors 88) (background light)) (:foreground "dark slate blue")) (((class color) (min-colors 88) (background dark)) (:foreground "LightSteelBlue")) (((class color) (min-colors 16) (background light)) (:foreground "Orchid")) (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue")) diff --git a/lisp/frame.el b/lisp/frame.el index 3ceec2657e7..d6f82750347 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -847,6 +847,116 @@ If there is no frame by that name, signal an error." (if frame (select-frame-set-input-focus frame) (error "There is no frame named `%s'" name)))) + + +;;;; Background mode. + +(defcustom frame-background-mode nil + "The brightness of the background. +Set this to the symbol `dark' if your background color is dark, +`light' if your background is light, or nil (automatic by default) +if you want Emacs to examine the brightness for you. Don't set this +variable with `setq'; this won't have the expected effect." + :group 'faces + :set #'(lambda (var value) + (set-default var value) + (mapc 'frame-set-background-mode (frame-list))) + :initialize 'custom-initialize-changed + :type '(choice (const dark) + (const light) + (const :tag "automatic" nil))) + +(declare-function x-get-resource "frame.c" + (attribute class &optional component subclass)) + +(defvar inhibit-frame-set-background-mode nil) + +(defun frame-set-background-mode (frame &optional keep-face-specs) + "Set up display-dependent faces on FRAME. +Display-dependent faces are those which have different definitions +according to the `background-mode' and `display-type' frame parameters. + +If optional arg KEEP-FACE-SPECS is non-nil, don't recalculate +face specs for the new background mode." + (unless inhibit-frame-set-background-mode + (let* ((frame-default-bg-mode (frame-terminal-default-bg-mode frame)) + (bg-color (frame-parameter frame 'background-color)) + (tty-type (tty-type frame)) + (default-bg-mode + (if (or (window-system frame) + (and tty-type + (string-match "^\\(xterm\\|\\rxvt\\|dtterm\\|eterm\\)" + tty-type))) + 'light + 'dark)) + (non-default-bg-mode (if (eq default-bg-mode 'light) 'dark 'light)) + (bg-mode + (cond (frame-default-bg-mode) + ((equal bg-color "unspecified-fg") ; inverted colors + non-default-bg-mode) + ((not (color-values bg-color frame)) + default-bg-mode) + ((>= (apply '+ (color-values bg-color frame)) + ;; Just looking at the screen, colors whose + ;; values add up to .6 of the white total + ;; still look dark to me. + (* (apply '+ (color-values "white" frame)) .6)) + 'light) + (t 'dark))) + (display-type + (cond ((null (window-system frame)) + (if (tty-display-color-p frame) 'color 'mono)) + ((display-color-p frame) + 'color) + ((x-display-grayscale-p frame) + 'grayscale) + (t 'mono))) + (old-bg-mode + (frame-parameter frame 'background-mode)) + (old-display-type + (frame-parameter frame 'display-type))) + + (unless (and (eq bg-mode old-bg-mode) (eq display-type old-display-type)) + (let ((locally-modified-faces nil) + ;; Prevent face-spec-recalc from calling this function + ;; again, resulting in a loop (bug#911). + (inhibit-frame-set-background-mode t) + (params (list (cons 'background-mode bg-mode) + (cons 'display-type display-type)))) + (if keep-face-specs + (modify-frame-parameters frame params) + ;; If we are recomputing face specs, first collect a list + ;; of faces that don't match their face-specs. These are + ;; the faces modified on FRAME, and we avoid changing them + ;; below. Use a negative list to avoid consing (we assume + ;; most faces are unmodified). + (dolist (face (face-list)) + (and (not (get face 'face-override-spec)) + (not (face-spec-match-p face + (face-user-default-spec face) + (selected-frame))) + (push face locally-modified-faces))) + ;; Now change to the new frame parameters + (modify-frame-parameters frame params) + ;; For all unmodified named faces, choose face specs + ;; matching the new frame parameters. + (dolist (face (face-list)) + (unless (memq face locally-modified-faces) + (face-spec-recalc face frame))))))))) + +(defun frame-terminal-default-bg-mode (frame) + "Return the default background mode of FRAME. +This checks the `frame-background-mode' variable, the X resource +named \"backgroundMode\" (if FRAME is an X frame), and finally +the `background-mode' terminal parameter." + (or frame-background-mode + (let ((bg-resource + (and (window-system frame) + (x-get-resource "backgroundMode" "BackgroundMode")))) + (if bg-resource + (intern (downcase bg-resource)))) + (terminal-parameter frame 'background-mode))) + ;;;; Frame configurations diff --git a/lisp/fringe.el b/lisp/fringe.el index ce24bb60100..fa5ebb6f0c6 100644 --- a/lisp/fringe.el +++ b/lisp/fringe.el @@ -192,7 +192,7 @@ frame parameter is used." (concat "Select fringe mode for " (if all-frames "all frames" "selected frame") - " (type ? for list): ") + ": ") fringe-styles nil t)) (style (assoc (downcase mode) fringe-styles))) (if style (cdr style) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index f0b8c205c9e..9dec22de872 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,307 @@ +2011-07-06 Glenn Morris <rgm@gnu.org> + + * gnus-group.el (gnus-read-ephemeral-emacs-bug-group): Silence compiler. + +2011-07-05 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.el (gnus-refer-article-method): Remove mention of nnspool, which + no longer is much used. + (gnus-summary-line-format): Link to "Marking Articles" instead of "Read + Articles". + +2011-04-03 Kan-Ru Chen <kanru@kanru.info> + + * nnir.el (nnir-notmuch-program, nnir-notmuch-additional-switches) + (nnir-notmuch-remove-prefix, nnir-engines, nnir-run-notmuch): New nnir + `notmuch' backend. + +2011-07-05 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * mm-decode.el (mm-text-html-renderer): Doc fix. + + * gnus-msg.el (gnus-bug): Fix the MML tag. + + * pop3.el (pop3-open-server): -ERR is a valid response to CAPA. + +2011-07-05 Daiki Ueno <ueno@unixuser.org> + + * gnus-start.el (gnus-get-unread-articles): Don't connect to the + secondary methods if started with `gnus-no-server'. + +2011-07-05 Juanma Barranquero <lekktu@gmail.com> + + * message.el (message-return-action): Fix typo in docstring. + +2011-07-04 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-group.el (gnus-read-ephemeral-bug-group): Allow fetching several + bug reports at once. + + * nnimap.el (nnimap-request-scan): Say that splitting has finished. + +2011-07-04 Katsumi Yamaoka <yamaoka@jpl.org> + + * nndraft.el: Require gnus-group. + (nndraft-request-list): Declare. + + * nndraft.el (nndraft-update-unread-articles): Don't show group having + no unread article unless it matches gnus-permanently-visible-groups. + + * nndraft.el (nndraft-update-unread-articles): New function. + (nndraft-request-associate-buffer): Use it to update the number of + unread articles for the nndraft groups in the group buffer when saving + or killing a draft message. + +2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-group.el (gnus-read-ephemeral-bug-group): Bind the coding + systems to binary before writing and reading the mbox files. + + * gnus.el (gnus-summary-line-format): Link to the info node for %U + instead of trying to list them all (bug#8978). + +2011-07-03 Wolfgang Jenkner <wjenkner@inode.at> (tiny change) + + * pop3.el (pop3-open-server): Use :end-of-capability. + +2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-group.el (gnus-read-ephemeral-emacs-bug-group): Make sure that + the id is always a number. + + * gnus-group.el (gnus-read-ephemeral-emacs-bug-group): Hook into + debbugs mode, if possible. + +2011-07-02 Daiki Ueno <ueno@unixuser.org> + + * auth-source.el (auth-source-token-passphrase-callback-function): + Reindent. + (epg-context-operation): Remove unnecessary autoload. + +2011-07-02 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.el (gnus-list-debbugs): New command. + + * gnus-group.el (gnus-bug-group-download-format-alist): Get the + mboxstat instead of the maintbox, since the stat seems to be fuller. + + * gnus-msg.el (gnus-configure-posting-styles): Don't try to select dead + summary buffers. + + * message.el (message-get-reply-headers): Delete all duplicates, + instead of the first. + (message-get-reply-headers): Ensure that we have progress while + deleting duplicates. + + * gnus-msg.el (gnus-configure-posting-styles): Get the local + gnus-posting-style value from the summary buffer to make it easier to + make that a per-buffer conf. + +2011-07-02 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el (nnir-run-imap): Allow halting a search when an article is + found by setting `shortcut' in 'query. + (nnir-request-article): Use `shortcut' setting when requesting article + by Message-ID. + +2011-07-02 Teodor Zlatanov <tzz@lifelogs.com> + + * gnus-msg.el (gnus-bug): Give the Version and Package headers to + debbugs with the X-Debbugs-Package and X-Debbugs-Version headers. + Bring the pseudo-headers back too. + +2011-07-01 Daiki Ueno <ueno@unixuser.org> + + * auth-source.el (auth-source-token-passphrase-callback-function): + Simplify and remove EPA dependency. + +2011-07-01 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el (nnir-request-article): Fix error message text. + +2011-07-01 Daiki Ueno <ueno@unixuser.org> + + * auth-source.el (plstore-delete): Autoload. + (auth-source-plstore-search): Support delete operation. + * plstore.el (plstore-delete): New function. + +2011-07-01 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-draft.el (gnus-draft-clear-marks): Revert last change; + mark actually existing articles as unread rather than the ones that + active asserts. + +2011-07-01 Paul Eggert <eggert@cs.ucla.edu> + + * nntp.el (nntp-record-command): + * gnus-util.el (gnus-message-with-timestamp-1): + Use format-time-string rather than decoding time stamps by hand. + This is simpler and insulates the code from potential changes to + current-time format. + +2011-07-01 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-draft.el (gnus-draft-clear-marks): Mark deleted articles as read. + +2011-07-01 Daiki Ueno <ueno@unixuser.org> + + * plstore.el (plstore-select-keys, plstore-encrypt-to): New variable. + (plstore-save): Support public key encryption. + (plstore--init-from-buffer): New function. + (plstore-open): Use it; fix error when opening a non-existent file. + (plstore-revert): Use plstore--init-from-buffer. + +2011-07-01 Daiki Ueno <ueno@unixuser.org> + + * auth-source.el (auth-source-backend): Fix :initarg for data slot. + +2011-06-30 Katsumi Yamaoka <yamaoka@jpl.org> + + * mml2015.el (mml2015-use): Replace string-match-p with string-match + for old Emacsen. + +2011-06-30 Daiki Ueno <ueno@unixuser.org> + + * mml2015.el (mml2015-use): Don't try to load PGG on Emacs 24, when EPG + is not fully working. + +2011-06-30 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * dgnushack.el: Autoload sha1 on XEmacs. + + * gnus-group.el (gnus-read-ephemeral-emacs-bug-group): Take an optional + quit window configuration. + + * auth-source.el (epg-context-set-passphrase-callback): Remove + duplicate autoload. + +2011-06-30 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el (nnir-request-article): Allow requesting articles by + Message-ID with nnimap. + + * gnus-sum.el (gnus-refer-article-methods): Allow (nnir) entry to use + current server. + +2011-06-30 Teodor Zlatanov <tzz@lifelogs.com> + + * auth-source.el: Autoload EPA/EPG functions. + (auth-source-netrc-use-gpg-tokens): Clarify that it should not be + changed when EPA/EPG is not available. + (auth-source-backend): Rename "arg" member to "data". + (auth-source-backend-parse, auth-source-plstore-search) + (auth-source-plstore-create): Use it. + +2011-06-30 Andrew Cohen <cohen@andy.bu.edu> + + * gnus-art.el (gnus-request-article-this-buffer): Use existing function + `gnus-refer-article-methods'. + +2011-06-30 Teodor Zlatanov <tzz@lifelogs.com> + + * auth-source.el: Require EPA and EPG. + (auth-source-passphrase-alist): New variable. + (auth-source-passphrase-callback-function) + (auth-source-token-passphrase-callback-function): Callbacks for the + netrc field encryption (GPG tokens). + (auth-source-epa-extract-gpg-token, auth-source-epa-make-gpg-token): + Symmetric encryption and decryption of the netrc GPG tokens. + (auth-source-netrc-normalize): Use them, simplifying the closure. + +2011-06-30 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnimap.el (nnimap-split-incoming-mail): If `nnimap-split-fancy' is + non-nil, and `nnimap-split-methods' is nil, use the former. + +2011-06-30 Daiki Ueno <ueno@unixuser.org> + + * plstore.el (plstore-revert): New function. + (plstore-open): Use it; hide the buffer from user. + +2011-06-30 Daiki Ueno <ueno@unixuser.org> + + * auth-source.el (auth-source-backend): New member "arg". + (auth-source-backend-parse): Handle new backend 'plstore. + * plstore.el: New file. + +2011-06-30 Glenn Morris <rgm@gnu.org> + + * gnus-fun.el (gnus-convert-image-to-x-face-command): Doc fix. + + * mm-util.el (mm-charset-synonym-alist): Move definition before use. + +2011-06-30 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnimap.el (nnimap-process-expiry-targets): Say what target we're + expiring articles to. + + * mm-util.el (mm-charset-to-coding-system): Recognise all ANSI.x3.4 + variations as ASCII (bug#5458). + +2011-06-30 Katsumi Yamaoka <yamaoka@jpl.org> + + * nnmh.el (nnmh-request-list-1): Work on MS Windows. + +2011-06-30 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * message.el (message-point-in-header-p): Tweak the function to default + to saying that we're not in the headers if there is no separator at + all. This makes it possible to use the Message version of `M-q' in + buffers with no headers (bug#7987). + (message-point-in-header-p): Fix last checkin to work with an empty + mail-header-separator, too. + + * auth-source.el (auth-source-netrc-saver): If the user says "don't ask + again, save the choice via customize. + +2011-06-29 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * message.el (message-send-mail-function): Add `sendmail-query-once'. + + * nnimap.el (nnimap-finish-retrieve-group-infos): If the server has + ended the connection, bail out before waiting infinitely on a new + connection. + +2011-06-28 Teodor Zlatanov <tzz@lifelogs.com> + + * gnus-msg.el (gnus-bug): Add Package and Version pseudo-headers to bug + reports. + + * gnus.el (gnus-bug-package): Use "gnus." + (gnus-maintainer): Direct bug reports to submit@debbugs.gnu.org. + +2011-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-art.el (gnus-article-stop-animations): New function to stop any + animations going on at article exit time. + + * gnus-registry.el (gnus-registry-user-format-function-M): Reinstate, + since removing it breaks people upgrading. + + * shr.el (shr-put-image): Use the new interface for animating images. + (shr-put-image): Animate for 60 seconds. + + * auth-source.el (with-auth-source-epa-overrides): Fix compilation + error with `find-file-hooks' on Emacs 22. + (with-auth-source-epa-overrides): Ugly hack to Wrap the + `find-file-hook' things in `symbol-value' to avoid compilation warnings + on all architectures. + + * spam.el (spam-stat): Require in a normal fashion without binding + `spam-stat-install-hooks' to avoid compilation warnings. + + * spam-stat.el (spam-stat-install-hooks): Removed. + (spam-stat-install-hooks): Don't run automatically. + +2011-06-26 Timo Juhani Lindfors <timo.lindfors@iki.fi> (tiny change) + + * gnus-msg.el (gnus-summary-reply-to-list-with-original): New command + and keystroke. + +2011-06-23 Katsumi Yamaoka <yamaoka@jpl.org> + + * auth-source.el (auth-source-netrc-cache): Move forward. + 2011-06-22 Lars Magne Ingebrigtsen <larsi@gnus.org> * auth-source.el (auth-source-netrc-create): Don't query the bits that @@ -528,12 +832,6 @@ * Makefile.in (fail-on-warning): New rule to compile with warnings as errors. - * dgnushack.el (dgnushack-compile-error-on-warn): New function to call - dgnushack-compile with error-on-warn enabled, and to signal an error if - clean compilation failed. - (dgnushack-compile): New argument 'error-on-warn'. If non-nil, compile - with `byte-compile-error-on-warn'. Return nil if errors occured. - 2011-04-06 Teodor Zlatanov <tzz@lifelogs.com> * gnus-registry.el: Don't use ERT if it's not available. Load it diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index 6fe033fea79..e249e97e826 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el @@ -43,6 +43,7 @@ (require 'mm-util) (require 'gnus-util) (require 'assoc) + (eval-when-compile (require 'cl)) (require 'eieio) @@ -56,6 +57,19 @@ (autoload 'rfc2104-hash "rfc2104") +(autoload 'plstore-open "plstore") +(autoload 'plstore-find "plstore") +(autoload 'plstore-put "plstore") +(autoload 'plstore-delete "plstore") +(autoload 'plstore-save "plstore") +(autoload 'plstore-get-file "plstore") + +(autoload 'epg-make-context "epg") +(autoload 'epg-context-set-passphrase-callback "epg") +(autoload 'epg-decrypt-string "epg") +(autoload 'epg-context-set-armor "epg") +(autoload 'epg-encrypt-string "epg") + (defvar secrets-enabled) (defgroup auth-source nil @@ -75,6 +89,9 @@ let-binding." (const :tag "30 Minutes" 1800) (integer :tag "Seconds"))) +;;; The slots below correspond with the `auth-source-search' spec, +;;; so a backend with :host set, for instance, would match only +;;; searches for that host. Normally they are nil. (defclass auth-source-backend () ((type :initarg :type :initform 'netrc @@ -100,6 +117,9 @@ let-binding." :type t :custom string :documentation "The backend protocol.") + (data :initarg :data + :initform nil + :documentation "Internal backend data.") (create-function :initarg :create-function :initform ignore :type function @@ -159,7 +179,8 @@ let-binding." (defcustom auth-source-netrc-use-gpg-tokens 'never "Set this to tell auth-source when to create GPG password -tokens in netrc files. It's either an alist or `never'." +tokens in netrc files. It's either an alist or `never'. +Note that if EPA/EPG is not available, this should NOT be used." :group 'auth-source :version "23.2" ;; No Gnus :type `(choice @@ -264,9 +285,9 @@ can get pretty complex." (const :format "" :value :user) (choice :tag "Personality/Username" - (const :tag "Any" t) - (string - :tag "Name"))))))))) + (const :tag "Any" t) + (string + :tag "Name"))))))))) (defcustom auth-source-gpg-encrypt-to t "List of recipient keys that `authinfo.gpg' encrypted to. @@ -307,8 +328,8 @@ If the value is not a list, symmetric encryption will be used." (defun auth-source-do-warn (&rest msg) (apply - ;; set logger to either the function in auth-source-debug or 'message - ;; note that it will be 'message if auth-source-debug is nil + ;; set logger to either the function in auth-source-debug or 'message + ;; note that it will be 'message if auth-source-debug is nil (if (functionp auth-source-debug) auth-source-debug 'message) @@ -375,12 +396,20 @@ with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)." ;; a file name with parameters ((stringp (plist-get entry :source)) - (auth-source-backend - (plist-get entry :source) - :source (plist-get entry :source) - :type 'netrc - :search-function 'auth-source-netrc-search - :create-function 'auth-source-netrc-create)) + (if (equal (file-name-extension (plist-get entry :source)) "plist") + (auth-source-backend + (plist-get entry :source) + :source (plist-get entry :source) + :type 'plstore + :search-function 'auth-source-plstore-search + :create-function 'auth-source-plstore-create + :data (plstore-open (plist-get entry :source))) + (auth-source-backend + (plist-get entry :source) + :source (plist-get entry :source) + :type 'netrc + :search-function 'auth-source-netrc-search + :create-function 'auth-source-netrc-create))) ;; the Secrets API. We require the package, in order to have a ;; defined value for `secrets-enabled'. @@ -654,7 +683,7 @@ must call it to obtain the actual value." (when auth-source-do-cache (auth-source-remember spec found))) - found)) + found)) (defun auth-source-search-backends (backends spec max create delete require) (let (matches) @@ -705,6 +734,8 @@ Returns the deleted entries." (equal collection value) (member value collection))) +(defvar auth-source-netrc-cache nil) + (defun auth-source-forget-all-cached () "Forget all cached auth-source data." (interactive) @@ -774,7 +805,7 @@ while \(:host t) would find all host entries." (defun auth-source-specmatchp (spec stored) (let ((keys (loop for i below (length spec) by 2 - collect (nth i spec)))) + collect (nth i spec)))) (not (eq (dolist (key keys) (unless (auth-source-search-collection (plist-get stored key) @@ -809,15 +840,13 @@ while \(:host t) would find all host entries." (unless (listp values) (setq values (list values))) (mapcar (lambda (value) - (if (numberp value) - (format "%s" value) - value)) - values)) + (if (numberp value) + (format "%s" value) + value)) + values)) ;;; Backend specific parsing: netrc/authinfo backend -(defvar auth-source-netrc-cache nil) - ;;; (auth-source-netrc-parse "~/.authinfo.gpg") (defun* auth-source-netrc-parse (&rest spec @@ -859,7 +888,7 @@ Note that the MAX parameter is used so we can exit the parse early." (base64-encode-string (buffer-string))))) (lambda () (base64-decode-string - (rot13-string v))))))) + (rot13-string v))))))) (goto-char (point-min)) ;; Go through the file, line by line. (while (and (not (eobp)) @@ -926,7 +955,7 @@ Note that the MAX parameter is used so we can exit the parse early." (null require) ;; every element of require is in the normalized list (let ((normalized (nth 0 (auth-source-netrc-normalize - (list alist) file)))) + (list alist) file)))) (loop for req in require always (plist-get normalized req))))) (decf max) @@ -962,54 +991,59 @@ Note that the MAX parameter is used so we can exit the parse early." (nreverse result)))))) -(defmacro with-auth-source-epa-overrides (&rest body) - `(let ((file-name-handler-alist - ',(if (boundp 'epa-file-handler) - (remove (symbol-value 'epa-file-handler) - file-name-handler-alist) - file-name-handler-alist)) - (,(if (boundp 'find-file-hook) 'find-file-hook 'find-file-hooks) - ',(remove - 'epa-file-find-file-hook - (if (boundp 'find-file-hook) 'find-file-hook 'find-file-hooks))) - (auto-mode-alist - ',(if (boundp 'epa-file-auto-mode-alist-entry) - (remove (symbol-value 'epa-file-auto-mode-alist-entry) - auto-mode-alist) - auto-mode-alist))) - ,@body)) - +(defvar auth-source-passphrase-alist nil) + +(defun auth-source-token-passphrase-callback-function (context key-id file) + (let* ((file (file-truename file)) + (entry (assoc file auth-source-passphrase-alist)) + passphrase) + ;; return the saved passphrase, calling a function if needed + (or (copy-sequence (if (functionp (cdr entry)) + (funcall (cdr entry)) + (cdr entry))) + (progn + (unless entry + (setq entry (list file)) + (push entry auth-source-passphrase-alist)) + (setq passphrase + (read-passwd + (format "Passphrase for %s tokens: " file) + t)) + (setcdr entry (lexical-let ((p (copy-sequence passphrase))) + (lambda () p))) + passphrase)))) + +;; (auth-source-epa-extract-gpg-token "gpg:LS0tLS1CRUdJTiBQR1AgTUVTU0FHRS0tLS0tClZlcnNpb246IEdudVBHIHYxLjQuMTEgKEdOVS9MaW51eCkKCmpBMEVBd01DT25qMjB1ak9rZnRneVI3K21iNm9aZWhuLzRad3cySkdlbnVaKzRpeEswWDY5di9icDI1U1dsQT0KPS9yc2wKLS0tLS1FTkQgUEdQIE1FU1NBR0UtLS0tLQo=" "~/.netrc") +(defun auth-source-epa-extract-gpg-token (secret file) + "Pass either the decoded SECRET or the gpg:BASE64DATA version. +FILE is the file from which we obtained this token." + (when (string-match "^gpg:\\(.+\\)" secret) + (setq secret (base64-decode-string (match-string 1 secret)))) + (let ((context (epg-make-context 'OpenPGP)) + plain) + (epg-context-set-passphrase-callback + context + (cons #'auth-source-token-passphrase-callback-function + file)) + (epg-decrypt-string context secret))) + +;; (insert (auth-source-epa-make-gpg-token "mysecret" "~/.netrc")) (defun auth-source-epa-make-gpg-token (secret file) - (require 'epa nil t) - (unless (featurep 'epa) - (error "EPA could not be loaded.")) - (let* ((base (file-name-sans-extension file)) - (passkey (format "gpg:-%s" base)) - (stash (concat base ".gpg")) - ;; temporarily disable EPA - (stashfile - (with-auth-source-epa-overrides - (make-temp-file "gpg-token" nil - stash))) - (epa-file-passphrase-alist - `((,stashfile - . ,(password-read - (format - "token pass for %s? " - file) - passkey))))) - (write-region secret nil stashfile) - ;; temporarily disable EPA - (unwind-protect - (with-auth-source-epa-overrides - (with-temp-buffer - (insert-file-contents stashfile) - (base64-encode-region (point-min) (point-max) t) - (concat "gpg:" - (buffer-substring-no-properties - (point-min) - (point-max))))) - (delete-file stashfile)))) + (let ((context (epg-make-context 'OpenPGP)) + (pp-escape-newlines nil) + cipher) + (epg-context-set-armor context t) + (epg-context-set-passphrase-callback + context + (cons #'auth-source-token-passphrase-callback-function + file)) + (setq cipher (epg-encrypt-string context secret nil)) + (with-temp-buffer + (insert cipher) + (base64-encode-region (point-min) (point-max) t) + (concat "gpg:" (buffer-substring-no-properties + (point-min) + (point-max)))))) (defun auth-source-netrc-normalize (alist filename) (mapcar (lambda (entry) @@ -1027,65 +1061,27 @@ Note that the MAX parameter is used so we can exit the parse early." ;; send back the secret in a function (lexical binding) (when (equal k "secret") - (setq v (lexical-let ((v v) - (filename filename) - (base (file-name-nondirectory - filename)) - (token-decoder nil) - (gpgdata nil) - (stash nil)) - (setq stash (concat base ".gpg")) - (when (string-match "gpg:\\(.+\\)" v) - (require 'epa nil t) - (unless (featurep 'epa) - (error "EPA could not be loaded.")) - (setq gpgdata (base64-decode-string - (match-string 1 v))) - ;; it's a GPG token - (setq - token-decoder - (lambda (gpgdata) -;;; FIXME: this relies on .gpg files being handled by EPA/EPG - (let* ((passkey (format "gpg:-%s" base)) - ;; temporarily disable EPA - (stashfile - (with-auth-source-epa-overrides - (make-temp-file "gpg-token" nil - stash))) - (epa-file-passphrase-alist - `((,stashfile - . ,(password-read - (format - "token pass for %s? " - filename) - passkey))))) - (unwind-protect - (progn - ;; temporarily disable EPA - (with-auth-source-epa-overrides - (write-region gpgdata - nil - stashfile)) - (setq - v - (with-temp-buffer - (insert-file-contents stashfile) - (buffer-substring-no-properties - (point-min) - (point-max))))) - (delete-file stashfile))) - ;; clear out the decoder at end - (setq token-decoder nil - gpgdata nil)))) - (lambda () - (when token-decoder - (funcall token-decoder gpgdata)) - v)))) - (setq ret (plist-put ret - (intern (concat ":" k)) - v)))) - ret)) - alist)) + (setq v (lexical-let ((lexv v) + (token-decoder nil)) + (when (string-match "^gpg:" lexv) + ;; it's a GPG token: create a token decoder + ;; which unsets itself once + (setq token-decoder + (lambda (val) + (prog1 + (auth-source-epa-extract-gpg-token + val + filename) + (setq token-decoder nil))))) + (lambda () + (when token-decoder + (setq lexv (funcall token-decoder lexv))) + lexv)))) + (setq ret (plist-put ret + (intern (concat ":" k)) + v)))) + ret)) + alist)) ;;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret)) ;;; (funcall secret) @@ -1095,7 +1091,7 @@ Note that the MAX parameter is used so we can exit the parse early." &key backend require create delete type max host user port &allow-other-keys) -"Given a property list SPEC, return search matches from the :backend. + "Given a property list SPEC, return search matches from the :backend. See `auth-source-search' for details on SPEC." ;; just in case, check that the type is correct (null or same as the backend) (assert (or (null type) (eq type (oref backend type))) @@ -1145,9 +1141,9 @@ See `auth-source-search' for details on SPEC." ;; 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))) + (current-data (car (auth-source-search :max 1 + :host host + :port port))) (required (append base-required create-extra)) (file (oref backend source)) (add "") @@ -1183,8 +1179,8 @@ See `auth-source-search' for details on SPEC." (let* ((data (aget valist r)) ;; take the first element if the data is a list (data (or (auth-source-netrc-element-or-first data) - (plist-get current-data - (intern (format ":%s" r) obarray)))) + (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: @@ -1231,8 +1227,8 @@ See `auth-source-search' for details on SPEC." (cond ((and (null data) (eq r 'secret)) ;; Special case prompt for passwords. -;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car (symbol-value 'epa-file-auto-mode-alist-entry)) "\\.gpg\\'") nil) (t gpg))) -;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never) + ;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car (symbol-value 'epa-file-auto-mode-alist-entry)) "\\.gpg\\'") nil) (t gpg))) + ;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never) (let* ((ep (format "Use GPG password tokens in %s?" file)) (gpg-encrypt (cond @@ -1249,7 +1245,7 @@ See `auth-source-search' for details on SPEC." (setq ret (cdr item)) (setq check nil))))) (t 'never))) - (plain (read-passwd prompt))) + (plain (read-passwd prompt))) ;; ask if we don't know what to do (in which case ;; auth-source-netrc-use-gpg-tokens must be a list) (unless gpg-encrypt @@ -1297,9 +1293,9 @@ See `auth-source-search' for details on SPEC." (secret "password") (port "port") ; redundant but clearer (t (symbol-name r))) - (if (string-match "[\" ]" data) - (format "%S" data) - data))))) + (if (string-match "[\" ]" data) + (format "%S" data) + data))))) (setq add (concat add (funcall printer))))))) (plist-put @@ -1361,9 +1357,10 @@ Respects `auth-source-save-behavior'. Uses (help-mode)))) (?n (setq add "" done t)) - (?N (setq add "" - done t - auth-source-save-behavior nil)) + (?N + (setq add "" + done t) + (customize-save-variable 'auth-source-save-behavior nil)) (?e (setq add (read-string "Line to add: " add))) (t nil))) @@ -1454,11 +1451,11 @@ authentication tokens: (eq t (plist-get spec k))) nil (list k (plist-get spec k)))) - search-keys))) + search-keys))) ;; needed keys (always including host, login, port, and secret) (returned-keys (mm-delete-duplicates (append - '(:host :login :port :secret) - search-keys))) + '(:host :login :port :secret) + search-keys))) (items (loop for item in (apply 'secrets-search-items coll search-spec) unless (and (stringp label) (not (string-match label item))) @@ -1500,6 +1497,210 @@ authentication tokens: ;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec) (debug spec)) +;;; Backend specific parsing: PLSTORE backend + +(defun* auth-source-plstore-search (&rest + spec + &key backend create delete label + type max host user port + &allow-other-keys) + "Search the PLSTORE; spec is like `auth-source'." + (let* ((store (oref backend data)) + (max (or max 5000)) ; sanity check: default to stop at 5K + (ignored-keys '(:create :delete :max :backend :require)) + (search-keys (loop for i below (length spec) by 2 + unless (memq (nth i spec) ignored-keys) + collect (nth i spec))) + ;; build a search spec without the ignored keys + ;; if a search key is nil or t (match anything), we skip it + (search-spec (apply 'append (mapcar + (lambda (k) + (let ((v (plist-get spec k))) + (if (or (null v) + (eq t v)) + nil + (if (stringp v) + (setq v (list v))) + (list k v)))) + search-keys))) + ;; needed keys (always including host, login, port, and secret) + (returned-keys (mm-delete-duplicates (append + '(:host :login :port :secret) + search-keys))) + (items (plstore-find store search-spec)) + (item-names (mapcar #'car items)) + (items (butlast items (- (length items) max))) + ;; convert the item to a full plist + (items (mapcar (lambda (item) + (let* ((plist (copy-tree (cdr item))) + (secret (plist-member plist :secret))) + (if secret + (setcar + (cdr secret) + (lexical-let ((v (car (cdr secret)))) + (lambda () v)))) + plist)) + items)) + ;; ensure each item has each key in `returned-keys' + (items (mapcar (lambda (plist) + (append + (apply 'append + (mapcar (lambda (req) + (if (plist-get plist req) + nil + (list req nil))) + returned-keys)) + plist)) + items))) + (cond + ;; if we need to create an entry AND none were found to match + ((and create + (not items)) + + ;; create based on the spec and record the value + (setq items (or + ;; if the user did not want to create the entry + ;; in the file, it will be returned + (apply (slot-value backend 'create-function) spec) + ;; if not, we do the search again without :create + ;; to get the updated data. + + ;; the result will be returned, even if the search fails + (apply 'auth-source-plstore-search + (plist-put spec :create nil))))) + ((and delete + item-names) + (dolist (item-name item-names) + (plstore-delete store item-name)) + (plstore-save store))) + items)) + +(defun* auth-source-plstore-create (&rest spec + &key backend + secret host user port create + &allow-other-keys) + (let* ((base-required '(host user port secret)) + (base-secret '(secret)) + ;; 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 "") + ;; `valist' is an alist + valist + ;; `artificial' will be returned if no creation is needed + artificial + secret-artificial) + + ;; only for base required elements (defined as function parameters): + ;; fill in the valist with whatever data we may have from the search + ;; we complete the first value if it's a list and use the value otherwise + (dolist (br base-required) + (when (symbol-value br) + (let ((br-choice (cond + ;; all-accepting choice (predicate is t) + ((eq t (symbol-value br)) nil) + ;; just the value otherwise + (t (symbol-value br))))) + (when br-choice + (aput 'valist br br-choice))))) + + ;; for extra required elements, see if the spec includes a value for them + (dolist (er create-extra) + (let ((name (concat ":" (symbol-name er))) + (keys (loop for i below (length spec) by 2 + collect (nth i spec)))) + (dolist (k keys) + (when (equal (symbol-name k) name) + (aput 'valist er (plist-get spec k)))))) + + ;; for each required element + (dolist (r required) + (let* ((data (aget valist r)) + ;; take the first element if the data is a list + (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: + ;; for the user, try `given-default' and then (user-login-name); + ;; otherwise take `given-default' + (default (cond + ((and (not given-default) (eq r 'user)) + (user-login-name)) + (t given-default))) + (printable-defaults (list + (cons 'user + (or + (auth-source-netrc-element-or-first + (aget valist 'user)) + (plist-get artificial :user) + "[any user]")) + (cons 'host + (or + (auth-source-netrc-element-or-first + (aget valist 'host)) + (plist-get artificial :host) + "[any host]")) + (cons 'port + (or + (auth-source-netrc-element-or-first + (aget valist 'port)) + (plist-get artificial :port) + "[any port]")))) + (prompt (or (aget auth-source-creation-prompts r) + (case r + (secret "%p password for %u@%h: ") + (user "%p user name for %h: ") + (host "%p host name for user %u: ") + (port "%p port for %u@%h: ")) + (format "Enter %s (%%u@%%h:%%p): " r))) + (prompt (auth-source-format-prompt + prompt + `((?u ,(aget printable-defaults 'user)) + (?h ,(aget printable-defaults 'host)) + (?p ,(aget printable-defaults 'port)))))) + + ;; Store the data, prompting for the password if needed. + (setq data + (cond + ((and (null data) (eq r 'secret)) + ;; Special case prompt for passwords. + (read-passwd prompt)) + ((null data) + (when default + (setq prompt + (if (string-match ": *\\'" prompt) + (concat (substring prompt 0 (match-beginning 0)) + " (default " default "): ") + (concat prompt "(default " default ") ")))) + (read-string prompt nil nil default)) + (t (or data default)))) + + (when data + (if (member r base-secret) + (setq secret-artificial + (plist-put secret-artificial + (intern (concat ":" (symbol-name r))) + data)) + (setq artificial (plist-put artificial + (intern (concat ":" (symbol-name r))) + data)))))) + (plstore-put (oref backend data) + (sha1 (format "%s@%s:%s" + (plist-get artificial :user) + (plist-get artificial :host) + (plist-get artificial :port))) + artificial secret-artificial) + (if (y-or-n-p (format "Save auth info to file %s? " + (plstore-get-file (oref backend data)))) + (plstore-save (oref backend data))))) + ;;; older API ;;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz") @@ -1574,14 +1775,14 @@ MODE can be \"login\" or \"password\"." (cond ((equal "password" m) (push (if (plist-get choice :secret) - (funcall (plist-get choice :secret)) - nil) found)) + (funcall (plist-get choice :secret)) + nil) found)) ((equal "login" m) (push (plist-get choice :user) found))))) (setq found (nreverse found)) (setq found (if listy found (car-safe found))))) - found)) + found)) (provide 'auth-source) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 3ebb5cc719b..7e2d213d20c 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -4509,6 +4509,7 @@ commands: t))) (with-current-buffer name (set (make-local-variable 'gnus-article-edit-mode) nil) + (gnus-article-stop-animations) (when gnus-article-mime-handles (mm-destroy-parts gnus-article-mime-handles) (setq gnus-article-mime-handles nil)) @@ -4533,6 +4534,12 @@ commands: (gnus-start-date-timer gnus-article-update-date-headers)) (current-buffer))))) +(defun gnus-article-stop-animations () + (dolist (timer (and (boundp 'timer-list) + timer-list)) + (when (eq (aref timer 5) 'image-animate-timeout) + (cancel-timer timer)))) + ;; Set article window start at LINE, where LINE is the number of lines ;; from the head of the article. (defun gnus-article-set-window-start (&optional line) @@ -6825,23 +6832,16 @@ If given a prefix, show the hidden text instead." (numberp article)) (let ((gnus-override-method gnus-override-method) (methods (and (stringp article) - gnus-refer-article-method)) + (with-current-buffer gnus-summary-buffer + (gnus-refer-article-methods)))) (backend (car (gnus-find-method-for-group gnus-newsgroup-name))) result (inhibit-read-only t)) - (if (or (not (listp methods)) - (and (symbolp (car methods)) - (assq (car methods) nnoo-definition-alist))) - (setq methods (list methods))) (when (and (null gnus-override-method) methods) (setq gnus-override-method (pop methods))) (while (not result) - (when (eq gnus-override-method 'current) - (setq gnus-override-method - (with-current-buffer gnus-summary-buffer - gnus-current-select-method))) (erase-buffer) (gnus-kill-all-overlays) (let ((gnus-newsgroup-name group)) diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el index 1709b1c4a05..40f5abda4f8 100644 --- a/lisp/gnus/gnus-draft.el +++ b/lisp/gnus/gnus-draft.el @@ -327,8 +327,7 @@ If DONT-POP is nil, display the buffer after setting it up." (defun gnus-draft-clear-marks () (setq gnus-newsgroup-reads nil gnus-newsgroup-marked nil - gnus-newsgroup-unreads - (gnus-uncompress-range (gnus-active gnus-newsgroup-name)))) + gnus-newsgroup-unreads (nndraft-articles))) (provide 'gnus-draft) diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index cb495623af2..1cc11383893 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -54,10 +54,7 @@ "convert -scale 48x48! %s xbm:- | xbm2xface.pl" "Command for converting an image to an X-Face. The command must take a image filename (use \"%s\") as input. -The output must be the Face header data on stdout in PNG format. - -By default it takes a GIF filename and output the X-Face header data -on stdout." +The output must be the X-Face header data on stdout in PNG format." :version "22.1" :group 'gnus-fun :type '(choice (const :tag "giftopnm, netpbm (GIF input only)" diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 518f215a7ba..da925700bd2 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -2415,7 +2415,7 @@ Valid input formats include: (gnus-read-ephemeral-gmane-group group start range))) (defcustom gnus-bug-group-download-format-alist - '((emacs . "http://debbugs.gnu.org/%s;mbox=yes;mboxmaint=yes") + '((emacs . "http://debbugs.gnu.org/%s;mboxstat=yes") (debian . "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s&mbox=yes;mboxmaint=yes")) "Alist of symbols for bug trackers and the corresponding URL format string. @@ -2428,23 +2428,28 @@ the bug number, and browsing the URL must return mbox output." :version "24.1" :type '(repeat (cons (symbol) (string :tag "URL format string")))) -(defun gnus-read-ephemeral-bug-group (number mbox-url) +(defun gnus-read-ephemeral-bug-group (ids mbox-url &optional window-conf) "Browse bug NUMBER as ephemeral group." (interactive (list (read-string "Enter bug number: " (thing-at-point 'word) nil) ;; FIXME: Add completing-read from ;; `gnus-emacs-bug-group-download-format' ... (cdr (assoc 'emacs gnus-bug-group-download-format-alist)))) - (when (stringp number) - (setq number (string-to-number number))) - (let ((tmpfile (mm-make-temp-file "gnus-temp-group-"))) + (when (stringp ids) + (setq ids (string-to-number ids))) + (unless (listp ids) + (setq ids (list ids))) + (let ((tmpfile (mm-make-temp-file "gnus-temp-group-")) + (coding-system-for-write 'binary) + (coding-system-for-read 'binary)) (with-temp-file tmpfile - (url-insert-file-contents (format mbox-url number)) + (dolist (id ids) + (url-insert-file-contents (format mbox-url id))) (goto-char (point-min)) ;; Add the debbugs address so that we can respond to reports easily. (while (re-search-forward "^To: " nil t) (end-of-line) - (insert (format ", %s@%s" number + (insert (format ", %s@%s" (car ids) (gnus-replace-in-string (gnus-replace-in-string mbox-url "^http://" "") "/.*$" "")))) @@ -2452,7 +2457,8 @@ the bug number, and browsing the URL must return mbox output." (gnus-group-read-ephemeral-group "gnus-read-ephemeral-bug" `(nndoc ,tmpfile - (nndoc-article-type mbox)))) + (nndoc-article-type mbox)) + nil window-conf)) (delete-file tmpfile))) (defun gnus-read-ephemeral-debian-bug-group (number) @@ -2463,13 +2469,23 @@ the bug number, and browsing the URL must return mbox output." number (cdr (assoc 'debian gnus-bug-group-download-format-alist)))) -(defun gnus-read-ephemeral-emacs-bug-group (number) - "Browse Emacs bug NUMBER as ephemeral group." - (interactive (list (read-string "Enter bug number: " - (thing-at-point 'word) nil))) +(defvar debbugs-bug-number) ; debbugs-gnu + +(defun gnus-read-ephemeral-emacs-bug-group (ids &optional window-conf) + "Browse Emacs bugs IDS as an ephemeral group." + (interactive (list (string-to-number + (read-string "Enter bug number: " + (thing-at-point 'word) nil)))) + (unless (listp ids) + (setq ids (list ids))) (gnus-read-ephemeral-bug-group - number - (cdr (assoc 'emacs gnus-bug-group-download-format-alist)))) + ids + (cdr (assoc 'emacs gnus-bug-group-download-format-alist)) + window-conf) + (when (fboundp 'debbugs-summary-mode) + (with-current-buffer (window-buffer (selected-window)) + (debbugs-summary-mode 1) + (set (make-local-variable 'debbugs-bug-number) (car ids))))) (defun gnus-group-jump-to-group (group &optional prompt) "Jump to newsgroup GROUP. diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index 093eec33fcd..bad474b4057 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -351,6 +351,7 @@ Thank you for your help in stamping out bugs. "r" gnus-summary-reply "y" gnus-summary-yank-message "R" gnus-summary-reply-with-original + "L" gnus-summary-reply-to-list-with-original "w" gnus-summary-wide-reply "W" gnus-summary-wide-reply-with-original "v" gnus-summary-very-wide-reply @@ -1154,6 +1155,16 @@ The original article will be yanked." (interactive "P") (gnus-summary-reply (gnus-summary-work-articles n) wide)) +(defun gnus-summary-reply-to-list-with-original (n &optional wide) + "Start composing a reply mail to the current message. +The reply goes only to the mailing list. +The original article will be yanked." + (interactive "P") + (let ((message-reply-to-function + (lambda nil + `((To . ,(gnus-mailing-list-followup-to)))))) + (gnus-summary-reply (gnus-summary-work-articles n) wide))) + (defun gnus-summary-reply-broken-reply-to (&optional yank wide very-wide) "Like `gnus-summary-reply' except removing reply-to field. If prefix argument YANK is non-nil, the original article is yanked @@ -1444,12 +1455,20 @@ If YANK is non-nil, include the original article." (goto-char (point-min))) (message-pop-to-buffer "*Gnus Bug*")) (let ((message-this-is-mail t)) - (message-setup `((To . ,gnus-maintainer) (Subject . "")))) + (message-setup `((To . ,gnus-maintainer) + (Subject . "") + (X-Debbugs-Package + . ,(format "%s" gnus-bug-package)) + (X-Debbugs-Version + . ,(format "%s" (gnus-continuum-version)))))) (when gnus-bug-create-help-buffer (push `(gnus-bug-kill-buffer) message-send-actions)) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) + (insert (format "Package: %s\n" gnus-bug-package)) + (insert (format "Version: %s\n" (gnus-continuum-version))) + (insert "\n") (insert (gnus-version) "\n" (emacs-version) "\n") (when (and (boundp 'nntp-server-type) @@ -1461,7 +1480,10 @@ If YANK is non-nil, include the original article." (erase-buffer) (gnus-debug) (setq text (buffer-string))) - (insert "<#part type=application/emacs-lisp disposition=inline description=\"User settings\">\n" text "\n<#/part>")) + (insert "<#part type=application/emacs-lisp " + "disposition=inline description=\"User settings\">\n" + text + "\n<#/part>")) (goto-char (point-min)) (search-forward "Subject: " nil t) (message ""))) @@ -1777,7 +1799,10 @@ this is a reply." "Configure posting styles according to `gnus-posting-styles'." (unless gnus-inhibit-posting-styles (let ((group (or group-name gnus-newsgroup-name "")) - (styles gnus-posting-styles) + (styles (if (gnus-buffer-live-p gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer + gnus-posting-styles) + gnus-posting-styles)) style match attribute value v results filep name address element) ;; If the group has a posting-style parameter, add it at the end with a diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index a44986e2499..f8ff52f128f 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -914,6 +914,9 @@ Uses `gnus-registry-marks' to find what shortcuts to install." (make-obsolete 'gnus-registry-user-format-function-M 'gnus-registry-article-marks-to-chars "24.1") ? +(defalias 'gnus-registry-user-format-function-M + 'gnus-registry-article-marks-to-chars) + ;; use like this: ;; (defalias 'gnus-user-format-function-M 'gnus-registry-article-marks-to-chars) (defun gnus-registry-article-marks-to-chars (headers) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index aa9af012a1c..7c63d5e2653 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -1043,7 +1043,7 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." ;; Find the number of unread articles in each non-dead group. (let ((gnus-read-active-file (and (not level) gnus-read-active-file))) - (gnus-get-unread-articles level)))) + (gnus-get-unread-articles level dont-connect)))) (defun gnus-call-subscribe-functions (method group) "Call METHOD to subscribe GROUP. @@ -1606,7 +1606,7 @@ If SCAN, request a scan of that group as well." ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb' ;; and compute how many unread articles there are in each group. -(defun gnus-get-unread-articles (&optional level) +(defun gnus-get-unread-articles (&optional level dont-connect) (setq gnus-server-method-cache nil) (require 'gnus-agent) (let* ((newsrc (cdr gnus-newsrc-alist)) @@ -1702,12 +1702,13 @@ If SCAN, request a scan of that group as well." ;; If we have primary/secondary select methods, but no groups from ;; them, we still want to issue a retrieval request from them. - (dolist (method (cons gnus-select-method - gnus-secondary-select-methods)) - (when (and (not (assoc method type-cache)) - (gnus-check-backend-function 'request-list (car method))) - (with-current-buffer nntp-server-buffer - (gnus-read-active-file-1 method nil)))) + (unless dont-connect + (dolist (method (cons gnus-select-method + gnus-secondary-select-methods)) + (when (and (not (assoc method type-cache)) + (gnus-check-backend-function 'request-list (car method))) + (with-current-buffer nntp-server-buffer + (gnus-read-active-file-1 method nil))))) ;; Start early async retrieval of data. (let ((done-methods nil) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index f974d386acb..798ae964460 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -7298,6 +7298,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (run-hooks 'gnus-summary-prepare-exit-hook) (when (gnus-buffer-live-p gnus-article-buffer) (with-current-buffer gnus-article-buffer + (gnus-article-stop-animations) (mm-destroy-parts gnus-article-mime-handles) ;; Set it to nil for safety reason. (setq gnus-article-mime-handle-alist nil) @@ -9049,7 +9050,12 @@ variable." (dolist (method gnus-refer-article-method) (push (if (eq 'current method) gnus-current-select-method - method) + (if (eq 'nnir (car method)) + (list + 'nnir + (or (cadr method) + (gnus-method-to-server gnus-current-select-method))) + method)) out)) (nreverse out))) ;; One single select method. @@ -9579,6 +9585,7 @@ C-u g', show the raw article." ;; Destroy any MIME parts. (when (gnus-buffer-live-p gnus-article-buffer) (with-current-buffer gnus-article-buffer + (gnus-article-stop-animations) (mm-destroy-parts gnus-article-mime-handles) ;; Set it to nil for safety reason. (setq gnus-article-mime-handle-alist nil) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 3f66b45aaab..7155c7f9607 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -540,8 +540,7 @@ but also to the ones displayed in the echo area." (eval-when-compile (defmacro gnus-message-with-timestamp-1 (format-string args) - (let ((timestamp '((format-time-string "%Y%m%dT%H%M%S" time) - "." (format "%03d" (/ (nth 2 time) 1000)) "> "))) + (let ((timestamp '(format-time-string "%Y%m%dT%H%M%S.%3N> " time))) (if (featurep 'xemacs) `(let (str time) (if (or (and (null ,format-string) (null ,args)) @@ -554,10 +553,10 @@ but also to the ones displayed in the echo area." (cond ((eq gnus-add-timestamp-to-message 'log) (setq time (current-time)) (display-message 'no-log str) - (log-message 'message (concat ,@timestamp str))) + (log-message 'message (concat ,timestamp str))) (gnus-add-timestamp-to-message (setq time (current-time)) - (display-message 'message (concat ,@timestamp str))) + (display-message 'message (concat ,timestamp str))) (t (display-message 'message str)))) str) @@ -571,7 +570,7 @@ but also to the ones displayed in the echo area." (setq time (current-time)) (with-current-buffer (get-buffer-create "*Messages*") (goto-char (point-max)) - (insert ,@timestamp str "\n") + (insert ,timestamp str "\n") (forward-line (- message-log-max)) (delete-region (point-min) (point)) (goto-char (point-max)))) @@ -585,7 +584,7 @@ but also to the ones displayed in the echo area." (and ,format-string str) (message nil)) (setq time (current-time)) - (message "%s" (concat ,@timestamp str)) + (message "%s" (concat ,timestamp str)) str)) (t (apply 'message ,format-string ,args)))))))) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 20986d25942..ac7db0e1d69 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1423,10 +1423,6 @@ no need to set this variable." (defcustom gnus-refer-article-method 'current "Preferred method for fetching an article by Message-ID. -If you are reading news from the local spool (with nnspool), fetching -articles by Message-ID is painfully slow. By setting this method to an -nntp method, you might get acceptable results. - The value of this variable must be a valid select method as discussed in the documentation of `gnus-select-method'. @@ -2655,9 +2651,13 @@ such as a mark that says whether an article is stored in the cache (defvar gnus-have-read-active-file nil) (defconst gnus-maintainer - "bugs@gnus.org (The Gnus Bugfixing Girls + Boys)" + "submit@debbugs.gnu.org (The Gnus Bugfixing Girls + Boys)" "The mail address of the Gnus maintainers.") +(defconst gnus-bug-package + "gnus" + "The package to use in the bug submission.") + (defvar gnus-info-nodes '((gnus-group-mode "(gnus)Group Buffer") (gnus-summary-mode "(gnus)Summary Buffer") @@ -2962,8 +2962,8 @@ with some simple extensions. on level one %R \"A\" if this article has been replied to, \" \" otherwise (character) -%U Status of this article (character, \"R\", \"K\", - \"-\" or \" \") +%U \"Read\" status of this article. + See Info node `(gnus)Marking Articles' %[ Opening bracket (character, \"[\" or \"<\") %] Closing bracket (character, \"]\" or \">\") %> Spaces of length thread-level (string) @@ -4381,6 +4381,13 @@ prompt the user for the name of an NNTP server to use." (gnus-1 arg dont-connect slave) (gnus-final-warning))) +(autoload 'debbugs-emacs "debbugs-gnu") +(defun gnus-list-debbugs () + "List all open Gnus bug reports." + (interactive) + (debbugs-emacs '("important" "normal" "minor" "wishlist") + "gnus")) + ;; Allow redefinition of Gnus functions. (gnus-ems-redefine) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 58740c32e9c..7d7cc01225b 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -659,6 +659,7 @@ Done before generating the new subject of a forward." (defcustom message-send-mail-function (cond ((eq send-mail-function 'smtpmail-send-it) 'message-smtpmail-send-it) ((eq send-mail-function 'feedmail-send-it) 'feedmail-send-it) + ((eq send-mail-function 'sendmail-query-once) 'sendmail-query-once) ((eq send-mail-function 'mailclient-send-it) 'message-send-mail-with-mailclient) (t (message-send-mail-function))) @@ -1184,7 +1185,7 @@ It is a vector of the following headers: (defvar message-send-actions nil "A list of actions to be performed upon successful sending of a message.") (defvar message-return-action nil - "Action to return to the caller after sending or postphoning a message.") + "Action to return to the caller after sending or postponing a message.") (defvar message-exit-actions nil "A list of actions to be performed upon exiting after sending a message.") (defvar message-kill-actions nil @@ -3424,8 +3425,12 @@ Message buffers and is not meant to be called directly." (defun message-point-in-header-p () "Return t if point is in the header." (save-excursion - (not (re-search-backward - (concat "^" (regexp-quote mail-header-separator) "\n") nil t)))) + (and + (not + (re-search-backward + (concat "^" (regexp-quote mail-header-separator) "\n") nil t)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n") nil t)))) (defun message-do-auto-fill () "Like `do-auto-fill', but don't fill in message header." @@ -6744,10 +6749,13 @@ want to get rid of this query permanently."))) addr)) (cons (downcase (mail-strip-quoted-names addr)) addr))) (message-tokenize-header recipients))) - ;; Remove first duplicates. (Why not all duplicates? Is this a bug?) + ;; Remove all duplicates. (let ((s recipients)) (while s - (setq recipients (delq (assoc (car (pop s)) s) recipients)))) + (let ((address (car (pop s)))) + (while (assoc address s) + (setq recipients (delq (assoc address s) recipients) + s (delq (assoc address s) s)))))) ;; Remove hierarchical lists that are contained within each other, ;; if message-hierarchical-addresses is defined. diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index f543920446b..a51c6630ac5 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -114,14 +114,14 @@ "Render of HTML contents. It is one of defined renderer types, or a rendering function. The defined renderer types are: -`shr': use Gnus simple HTML renderer; -`gnus-w3m' : use Gnus renderer based on w3m; -`w3m' : use emacs-w3m; -`w3m-standalone': use w3m; +`shr': use the built-in Gnus HTML renderer; +`gnus-w3m': use Gnus renderer based on w3m; +`w3m': use emacs-w3m; +`w3m-standalone': use plain w3m; `links': use links; -`lynx' : use lynx; -`w3' : use Emacs/W3; -`html2text' : use html2text; +`lynx': use lynx; +`w3': use Emacs/W3; +`html2text': use html2text; nil : use external viewer (default web browser)." :version "24.1" :type '(choice (const shr) diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 435c3bba00f..d57b61dac83 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -300,34 +300,6 @@ system object in XEmacs." ;; no-MULE XEmacs: (car (memq cs (mm-get-coding-system-list)))))) -(defun mm-codepage-setup (number &optional alias) - "Create a coding system cpNUMBER. -The coding system is created using `codepage-setup'. If ALIAS is -non-nil, an alias is created and added to -`mm-charset-synonym-alist'. If ALIAS is a string, it's used as -the alias. Else windows-NUMBER is used." - (interactive - (let ((completion-ignore-case t) - (candidates (if (fboundp 'cp-supported-codepages) - (cp-supported-codepages) - ;; Removed in Emacs 23 (unicode), so signal an error: - (error "`codepage-setup' not present in this Emacs version")))) - (list (gnus-completing-read "Setup DOS Codepage" candidates - t nil nil "437")))) - (when alias - (setq alias (if (stringp alias) - (intern alias) - (intern (format "windows-%s" number))))) - (let* ((cp (intern (format "cp%s" number)))) - (unless (mm-coding-system-p cp) - (if (fboundp 'codepage-setup) ; silence compiler - (codepage-setup number) - (error "`codepage-setup' not present in this Emacs version"))) - (when (and alias - ;; Don't add alias if setup of cp failed. - (mm-coding-system-p cp)) - (add-to-list 'mm-charset-synonym-alist (cons alias cp))))) - (defvar mm-charset-synonym-alist `( ;; Not in XEmacs, but it's not a proper MIME charset anyhow. @@ -376,6 +348,34 @@ the alias. Else windows-NUMBER is used." See `mm-codepage-iso-8859-list' and `mm-codepage-ibm-list'.") +(defun mm-codepage-setup (number &optional alias) + "Create a coding system cpNUMBER. +The coding system is created using `codepage-setup'. If ALIAS is +non-nil, an alias is created and added to +`mm-charset-synonym-alist'. If ALIAS is a string, it's used as +the alias. Else windows-NUMBER is used." + (interactive + (let ((completion-ignore-case t) + (candidates (if (fboundp 'cp-supported-codepages) + (cp-supported-codepages) + ;; Removed in Emacs 23 (unicode), so signal an error: + (error "`codepage-setup' not present in this Emacs version")))) + (list (gnus-completing-read "Setup DOS Codepage" candidates + t nil nil "437")))) + (when alias + (setq alias (if (stringp alias) + (intern alias) + (intern (format "windows-%s" number))))) + (let* ((cp (intern (format "cp%s" number)))) + (unless (mm-coding-system-p cp) + (if (fboundp 'codepage-setup) ; silence compiler + (codepage-setup number) + (error "`codepage-setup' not present in this Emacs version"))) + (when (and alias + ;; Don't add alias if setup of cp failed. + (mm-coding-system-p cp)) + (add-to-list 'mm-charset-synonym-alist (cons alias cp))))) + (defcustom mm-codepage-iso-8859-list (list 1250 ;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft ;; Outlook users in Czech republic. Use this to allow reading of @@ -550,7 +550,8 @@ is not available." (let ((cs (cdr (assq charset mm-charset-override-alist)))) (and cs (mm-coding-system-p cs) cs)))) ;; ascii - ((eq charset 'us-ascii) + ((or (eq charset 'us-ascii) + (string-match "ansi.x3.4" (symbol-name charset))) 'ascii) ;; Check to see whether we can handle this charset. (This depends ;; on there being some coding system matching each `mime-charset' diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index df106bb6de8..7d8a4119c0e 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -55,9 +55,15 @@ 'epg) (error)) (progn - (ignore-errors (require 'pgg)) - (and (fboundp 'pgg-sign-region) - 'pgg)) + (let ((abs-file (locate-library "pgg"))) + ;; Don't load PGG if it is marked as obsolete + ;; (Emacs 24). + (when (and abs-file + (not (string-match "/obsolete/[^/]*\\'" + abs-file))) + (ignore-errors (require 'pgg)) + (and (fboundp 'pgg-sign-region) + 'pgg)))) (progn (ignore-errors (load "mc-toplev")) (and (fboundp 'mc-encrypt-generic) diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el index 006348869ef..f528222dd16 100644 --- a/lisp/gnus/nndraft.el +++ b/lisp/gnus/nndraft.el @@ -24,14 +24,21 @@ ;;; Code: +;; For Emacs <22.2 and XEmacs. +(eval-and-compile + (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) + (require 'nnheader) (require 'nnmail) (require 'gnus-start) +(require 'gnus-group) (require 'nnmh) (require 'nnoo) (require 'mm-util) (eval-when-compile (require 'cl)) +(declare-function nndraft-request-list "nnmh" (&rest args)) + (nnoo-declare nndraft nnmh) @@ -161,6 +168,25 @@ are generated if and only if they are also in `message-draft-headers'.") (message-headers-to-generate nndraft-required-headers message-draft-headers nil)))) +(defun nndraft-update-unread-articles () + "Update groups' unread articles in the group buffer." + (nndraft-request-list) + (with-current-buffer gnus-group-buffer + (let* ((groups (mapcar (lambda (elem) + (gnus-group-prefixed-name (car elem) + (list 'nndraft ""))) + (nnmail-get-active))) + (gnus-group-marked (copy-sequence groups)) + (inhibit-read-only t)) + (gnus-group-get-new-news-this-group nil t) + (dolist (group groups) + (unless (and gnus-permanently-visible-groups + (string-match gnus-permanently-visible-groups + group)) + (gnus-group-goto-group group) + (when (zerop (gnus-group-group-unread)) + (gnus-delete-line))))))) + (deffoo nndraft-request-associate-buffer (group) "Associate the current buffer with some article in the draft group." (nndraft-open-server "") @@ -182,6 +208,10 @@ are generated if and only if they are also in `message-draft-headers'.") 'write-contents-hooks))) (gnus-make-local-hook hook) (add-hook hook 'nndraft-generate-headers nil t)) + (gnus-make-local-hook 'after-save-hook) + (add-hook 'after-save-hook 'nndraft-update-unread-articles nil t) + (message-add-action '(nndraft-update-unread-articles) + 'exit 'postpone 'kill) article)) (deffoo nndraft-request-group (group &optional server dont-check info) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 2cfc88987f6..43a3cbd859d 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -880,15 +880,18 @@ textual parts.") (with-temp-buffer (mm-disable-multibyte) (when (nnimap-request-article article group server (current-buffer)) - (nnheader-message 7 "Expiring article %s:%d" group article) (when (functionp target) (setq target (funcall target group))) - (when (and target - (not (eq target 'delete))) - (if (or (gnus-request-group target t) - (gnus-request-create-group target)) - (nnmail-expiry-target-group target group) - (setq target nil))) + (if (and target + (not (eq target 'delete))) + (if (or (gnus-request-group target t) + (gnus-request-create-group target)) + (progn + (nnmail-expiry-target-group target group) + (nnheader-message 7 "Expiring article %s:%d to %s" + group article target)) + (setq target nil)) + (nnheader-message 7 "Expiring article %s:%d" group article)) (when target (push article deleted-articles)))))))) ;; Change back to the current group again. @@ -953,7 +956,8 @@ textual parts.") nnimap-inbox nnimap-split-methods) (nnheader-message 7 "nnimap %s splitting mail..." server) - (nnimap-split-incoming-mail))) + (nnimap-split-incoming-mail) + (nnheader-message 7 "nnimap %s splitting mail...done" server))) (defun nnimap-marks-to-flags (marks) (let (flags flag) @@ -1227,6 +1231,10 @@ textual parts.") (deffoo nnimap-finish-retrieve-group-infos (server infos sequences) (when (and sequences + ;; Check that the process is still alive. + (get-buffer-process (nnimap-buffer)) + (memq (process-status (get-buffer-process (nnimap-buffer))) + '(open run)) (nnimap-possibly-change-group nil server)) (with-current-buffer (nnimap-buffer) ;; Wait for the final data to trickle in. @@ -1798,9 +1806,14 @@ textual parts.") (defun nnimap-split-incoming-mail () (with-current-buffer (nnimap-buffer) (let ((nnimap-incoming-split-list nil) - (nnmail-split-methods (if (eq nnimap-split-methods 'default) - nnmail-split-methods - nnimap-split-methods)) + (nnmail-split-methods + (cond + ((eq nnimap-split-methods 'default) + nnmail-split-methods) + (nnimap-split-methods + nnimap-split-methods) + (nnimap-split-fancy + 'nnmail-split-fancy))) (nnmail-split-fancy (or nnimap-split-fancy nnmail-split-fancy)) (nnmail-inhibit-default-split-group t) diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index eaaac3f88ce..8099cc2a7cc 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -499,6 +499,31 @@ arrive at the correct group name, \"mail.misc\"." :type '(directory) :group 'nnir) +(defcustom nnir-notmuch-program "notmuch" + "*Name of notmuch search executable." + :type '(string) + :group 'nnir) + +(defcustom nnir-notmuch-additional-switches '() + "*A list of strings, to be given as additional arguments to notmuch. + +Note that this should be a list. Ie, do NOT use the following: + (setq nnir-notmuch-additional-switches \"-i -w\") ; wrong +Instead, use this: + (setq nnir-notmuch-additional-switches '(\"-i\" \"-w\"))" + :type '(repeat (string)) + :group 'nnir) + +(defcustom nnir-notmuch-remove-prefix (concat (getenv "HOME") "/Mail/") + "*The prefix to remove from each file name returned by notmuch +in order to get a group name (albeit with / instead of .). This is a +regular expression. + +This variable is very similar to `nnir-namazu-remove-prefix', except +that it is for notmuch, not Namazu." + :type '(regexp) + :group 'nnir) + ;;; Developer Extension Variable: (defvar nnir-engines @@ -519,6 +544,8 @@ arrive at the correct group name, \"mail.misc\"." ((group . "Swish-e Group spec: "))) (namazu nnir-run-namazu ()) + (notmuch nnir-run-notmuch + ()) (hyrex nnir-run-hyrex ((group . "Hyrex Group spec: "))) (find-grep nnir-run-find-grep @@ -657,22 +684,40 @@ Add an entry here when adding a new search engine.") 'nov))) (deffoo nnir-request-article (article &optional group server to-buffer) - (if (stringp article) + (if (and (stringp article) + (not (eq 'nnimap (car (gnus-server-to-method server))))) (nnheader-report 'nnir - "nnir-retrieve-headers doesn't grok message ids: %s" - article) + "nnir-request-article only groks message ids for nnimap servers: %s" + server) (save-excursion - (let ((artfullgroup (nnir-article-group article)) - (artno (nnir-article-number article))) - (message "Requesting article %d from group %s" - artno artfullgroup) - (if to-buffer - (with-current-buffer to-buffer - (let ((gnus-article-decode-hook nil)) - (gnus-request-article-this-buffer artno artfullgroup))) - (gnus-request-article artno artfullgroup)) - (cons artfullgroup artno))))) + (let ((article article) + query) + (when (stringp article) + (setq gnus-override-method (gnus-server-to-method server)) + (setq query + (list + (cons 'query (format "HEADER Message-ID %s" article)) + (cons 'unique-id article) + (cons 'criteria "") + (cons 'shortcut t))) + (unless (and (equal query nnir-current-query) + (equal server nnir-current-server)) + (setq nnir-artlist (nnir-run-imap query server)) + (setq nnir-current-query query) + (setq nnir-current-server server)) + (setq article 1)) + (unless (zerop (length nnir-artlist)) + (let ((artfullgroup (nnir-article-group article)) + (artno (nnir-article-number article))) + (message "Requesting article %d from group %s" + artno artfullgroup) + (if to-buffer + (with-current-buffer to-buffer + (let ((gnus-article-decode-hook nil)) + (gnus-request-article-this-buffer artno artfullgroup))) + (gnus-request-article artno artfullgroup)) + (cons artfullgroup artno))))))) (deffoo nnir-request-move-article (article group server accept-form &optional last internal-move-group) @@ -774,7 +819,7 @@ ready to be added to the list of search results." (defun nnir-run-imap (query srv &optional groups) "Run a search against an IMAP back-end server. This uses a custom query language parser; see `nnir-imap-make-query' for -details on the language and supported extensions" +details on the language and supported extensions." (save-excursion (let ((qstring (cdr (assq 'query query))) (server (cadr (gnus-server-to-method srv))) @@ -787,33 +832,36 @@ details on the language and supported extensions" (message "Opening server %s" server) (apply 'vconcat - (mapcar - (lambda (group) - (let (artlist) - (condition-case () - (when (nnimap-possibly-change-group - (gnus-group-short-name group) server) - (with-current-buffer (nnimap-buffer) - (message "Searching %s..." group) - (let ((arts 0) - (result (nnimap-command "UID SEARCH %s" - (if (string= criteria "") - qstring - (nnir-imap-make-query - criteria qstring))))) - (mapc - (lambda (artnum) - (let ((artn (string-to-number artnum))) - (when (> artn 0) - (push (vector group artn 100) - artlist) - (setq arts (1+ arts))))) - (and (car result) (cdr (assoc "SEARCH" (cdr result))))) - (message "Searching %s... %d matches" group arts))) - (message "Searching %s...done" group)) - (quit nil)) - (nreverse artlist))) - groups))))) + (catch 'found + (mapcar + (lambda (group) + (let (artlist) + (condition-case () + (when (nnimap-possibly-change-group + (gnus-group-short-name group) server) + (with-current-buffer (nnimap-buffer) + (message "Searching %s..." group) + (let ((arts 0) + (result (nnimap-command "UID SEARCH %s" + (if (string= criteria "") + qstring + (nnir-imap-make-query + criteria qstring))))) + (mapc + (lambda (artnum) + (let ((artn (string-to-number artnum))) + (when (> artn 0) + (push (vector group artn 100) + artlist) + (when (assq 'shortcut query) + (throw 'found (list artlist))) + (setq arts (1+ arts))))) + (and (car result) (cdr (assoc "SEARCH" (cdr result))))) + (message "Searching %s... %d matches" group arts))) + (message "Searching %s...done" group)) + (quit nil)) + (nreverse artlist))) + groups)))))) (defun nnir-imap-make-query (criteria qstring) "Parse the query string and criteria into an appropriate IMAP search @@ -1317,6 +1365,80 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (> (nnir-artitem-rsv x) (nnir-artitem-rsv y))))))))) +(defun nnir-run-notmuch (query server &optional group) + "Run QUERY against notmuch. +Returns a vector of (group name, file name) pairs (also vectors, +actually)." + + ;; (when group + ;; (error "The notmuch backend cannot search specific groups")) + + (save-excursion + (let ( (qstring (cdr (assq 'query query))) + (groupspec (cdr (assq 'group query))) + (prefix (nnir-read-server-parm 'nnir-notmuch-remove-prefix server)) + artlist + (article-pattern (if (string= (gnus-group-server server) "nnmaildir") + ":[0-9]+" + "^[0-9]+$")) + artno dirnam filenam) + + (when (equal "" qstring) + (error "notmuch: You didn't enter anything")) + + (set-buffer (get-buffer-create nnir-tmp-buffer)) + (erase-buffer) + + (if groupspec + (message "Doing notmuch query %s on %s..." qstring groupspec) + (message "Doing notmuch query %s..." qstring)) + + (let* ((cp-list `( ,nnir-notmuch-program + nil ; input from /dev/null + t ; output + nil ; don't redisplay + "search" + "--format=text" + "--output=files" + ,@(nnir-read-server-parm 'nnir-notmuch-additional-switches server) + ,qstring ; the query, in notmuch format + )) + (exitstatus + (progn + (message "%s args: %s" nnir-notmuch-program + (mapconcat 'identity (cddddr cp-list) " ")) ;; ??? + (apply 'call-process cp-list)))) + (unless (or (null exitstatus) + (zerop exitstatus)) + (nnheader-report 'nnir "Couldn't run notmuch: %s" exitstatus) + ;; notmuch failure reason is in this buffer, show it if + ;; the user wants it. + (when (> gnus-verbose 6) + (display-buffer nnir-tmp-buffer)))) + + ;; The results are output in the format of: + ;; absolute-path-name + (goto-char (point-min)) + (while (not (eobp)) + (setq filenam (buffer-substring-no-properties (line-beginning-position) + (line-end-position)) + artno (file-name-nondirectory filenam) + dirnam (file-name-directory filenam)) + (forward-line 1) + + ;; don't match directories + (when (string-match article-pattern artno) + (when (not (null dirnam)) + + ;; maybe limit results to matching groups. + (when (or (not groupspec) + (string-match groupspec dirnam)) + (nnir-add-result dirnam artno "" prefix server artlist))))) + + (message "Massaging notmuch output...done") + + artlist))) + (defun nnir-run-find-grep (query server &optional grouplist) "Run find and grep to obtain matching articles." (let* ((method (gnus-server-to-method server)) diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el index 5fa1a89cf48..ec270eba2ce 100644 --- a/lisp/gnus/nnmh.el +++ b/lisp/gnus/nnmh.el @@ -210,7 +210,9 @@ as unread by Gnus.") (max 0) min rdir num subdirectoriesp file) ;; Recurse down directories. - (setq subdirectoriesp (> (nth 1 (file-attributes dir)) 2)) + (setq subdirectoriesp + ;; nth 1 of file-attributes always 1 on MS Windows :( + (/= (nth 1 (file-attributes (file-truename dir))) 2)) (dolist (rdir files) (if (or (not subdirectoriesp) (file-regular-p rdir)) diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index a8ffc6576ca..986fd51a613 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -338,10 +338,8 @@ backend doesn't catch this error.") "Record the command STRING." (with-current-buffer (get-buffer-create "*nntp-log*") (goto-char (point-max)) - (let ((time (current-time))) - (insert (format-time-string "%Y%m%dT%H%M%S" time) - "." (format "%03d" (/ (nth 2 time) 1000)) - " " nntp-address " " string "\n")))) + (insert (format-time-string "%Y%m%dT%H%M%S.%3N") + " " nntp-address " " string "\n"))) (defun nntp-report (&rest args) "Report an error from the nntp backend. The first string in ARGS diff --git a/lisp/gnus/plstore.el b/lisp/gnus/plstore.el new file mode 100644 index 00000000000..8d973a9b0ae --- /dev/null +++ b/lisp/gnus/plstore.el @@ -0,0 +1,399 @@ +;;; plstore.el --- searchable, partially encrypted, persistent plist store -*- lexical-binding: t -*- +;; Copyright (C) 2011 Free Software Foundation, Inc. + +;; Author: Daiki Ueno <ueno@unixuser.org> +;; Keywords: PGP, GnuPG + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary + +;; Creating: +;; +;; (setq store (plstore-open (expand-file-name "~/.emacs.d/auth.plist"))) +;; (plstore-put store "foo" '(:host "foo.example.org" :port 80) nil) +;; (plstore-save store) +;; ;; :user property is secret +;; (plstore-put store "bar" '(:host "bar.example.org") '(:user "test")) +;; (plstore-put store "baz" '(:host "baz.example.org") '(:user "test")) +;; (plstore-save store) ;<= will ask passphrase via GPG +;; (plstore-close store) +;; +;; Searching: +;; +;; (setq store (plstore-open (expand-file-name "~/.emacs.d/auth.plist"))) +;; (plstore-find store '(:host ("foo.example.org"))) +;; (plstore-find store '(:host ("bar.example.org"))) ;<= will ask passphrase via GPG +;; (plstore-close store) +;; + +;;; Code: + +(require 'epg) + +(defgroup plstore nil + "Searchable, partially encrypted, persistent plist store" + :version "24.1" + :group 'files) + +(defcustom plstore-select-keys 'silent + "Control whether or not to pop up the key selection dialog. + +If t, always asks user to select recipients. +If nil, query user only when `plstore-encrypt-to' is not set. +If neither t nor nil, doesn't ask user. In this case, symmetric +encryption is used." + :type '(choice (const :tag "Ask always" t) + (const :tag "Ask when recipients are not set" nil) + (const :tag "Don't ask" silent)) + :group 'plstore) + +(defvar plstore-encrypt-to nil + "*Recipient(s) used for encrypting secret entries. +May either be a string or a list of strings.") + +(put 'plstore-encrypt-to 'safe-local-variable + (lambda (val) + (or (stringp val) + (and (listp val) + (catch 'safe + (mapc (lambda (elt) + (unless (stringp elt) + (throw 'safe nil))) + val) + t))))) + +(put 'plstore-encrypt-to 'permanent-local t) + +(defvar plstore-cache-passphrase-for-symmetric-encryption nil) +(defvar plstore-passphrase-alist nil) + +(defun plstore-passphrase-callback-function (_context _key-id plstore) + (if plstore-cache-passphrase-for-symmetric-encryption + (let* ((file (file-truename (plstore--get-buffer plstore))) + (entry (assoc file plstore-passphrase-alist)) + passphrase) + (or (copy-sequence (cdr entry)) + (progn + (unless entry + (setq entry (list file) + plstore-passphrase-alist + (cons entry + plstore-passphrase-alist))) + (setq passphrase + (read-passwd (format "Passphrase for PLSTORE %s: " + (plstore--get-buffer plstore)))) + (setcdr entry (copy-sequence passphrase)) + passphrase))) + (read-passwd (format "Passphrase for PLSTORE %s: " + (plstore--get-buffer plstore))))) + +(defun plstore-progress-callback-function (_context _what _char current total + handback) + (if (= current total) + (message "%s...done" handback) + (message "%s...%d%%" handback + (if (> total 0) (floor (* (/ current (float total)) 100)) 0)))) + +(defun plstore--get-buffer (this) + (aref this 0)) + +(defun plstore--get-alist (this) + (aref this 1)) + +(defun plstore--get-encrypted-data (this) + (aref this 2)) + +(defun plstore--get-secret-alist (this) + (aref this 3)) + +(defun plstore--get-merged-alist (this) + (aref this 4)) + +(defun plstore--set-file (this file) + (aset this 0 file)) + +(defun plstore--set-alist (this plist) + (aset this 1 plist)) + +(defun plstore--set-encrypted-data (this encrypted-data) + (aset this 2 encrypted-data)) + +(defun plstore--set-secret-alist (this secret-alist) + (aset this 3 secret-alist)) + +(defun plstore--set-merged-alist (this merged-alist) + (aset this 4 merged-alist)) + +(defun plstore-get-file (this) + (buffer-file-name (plstore--get-buffer this))) + +(defun plstore--init-from-buffer (plstore) + (goto-char (point-min)) + (when (looking-at ";;; public entries") + (forward-line) + (plstore--set-alist plstore (read (point-marker))) + (forward-sexp) + (forward-char) + (when (looking-at ";;; secret entries") + (forward-line) + (plstore--set-encrypted-data plstore (read (point-marker)))) + (plstore--merge-secret plstore))) + +;;;###autoload +(defun plstore-open (file) + "Create a plstore instance associated with FILE." + (with-current-buffer (find-file-noselect file) + ;; make the buffer invisible from user + (rename-buffer (format " plstore %s" (buffer-file-name))) + (let ((store (vector + (current-buffer) + nil ;plist (plist) + nil ;encrypted data (string) + nil ;secret plist (plist) + nil ;merged plist (plist) + ))) + (plstore--init-from-buffer store) + store))) + +(defun plstore-revert (plstore) + "Replace current data in PLSTORE with the file on disk." + (with-current-buffer (plstore--get-buffer plstore) + (revert-buffer t t) + (plstore--init-from-buffer plstore))) + +(defun plstore-close (plstore) + "Destroy a plstore instance PLSTORE." + (kill-buffer (plstore--get-buffer plstore))) + +(defun plstore--merge-secret (plstore) + (let ((alist (plstore--get-secret-alist plstore)) + modified-alist + modified-plist + modified-entry + entry + plist + placeholder) + (plstore--set-merged-alist + plstore + (copy-tree (plstore--get-alist plstore))) + (setq modified-alist (plstore--get-merged-alist plstore)) + (while alist + (setq entry (car alist) + alist (cdr alist) + plist (cdr entry) + modified-entry (assoc (car entry) modified-alist) + modified-plist (cdr modified-entry)) + (while plist + (setq placeholder + (plist-member + modified-plist + (intern (concat ":secret-" + (substring (symbol-name (car plist)) 1))))) + (if placeholder + (setcar placeholder (car plist))) + (setq modified-plist + (plist-put modified-plist (car plist) (car (cdr plist)))) + (setq plist (nthcdr 2 plist))) + (setcdr modified-entry modified-plist)))) + +(defun plstore--decrypt (plstore) + (if (plstore--get-encrypted-data plstore) + (let ((context (epg-make-context 'OpenPGP)) + plain) + (epg-context-set-passphrase-callback + context + (cons #'plstore-passphrase-callback-function + plstore)) + (epg-context-set-progress-callback + context + (cons #'plstore-progress-callback-function + (format "Decrypting %s" (plstore-get-file plstore)))) + (setq plain + (epg-decrypt-string context + (plstore--get-encrypted-data plstore))) + (plstore--set-secret-alist plstore (car (read-from-string plain))) + (plstore--merge-secret plstore) + (plstore--set-encrypted-data plstore nil)))) + +(defun plstore--match (entry keys skip-if-secret-found) + (let ((result t) key-name key-value prop-value secret-name) + (while keys + (setq key-name (car keys) + key-value (car (cdr keys)) + prop-value (plist-get (cdr entry) key-name)) + (unless (member prop-value key-value) + (if skip-if-secret-found + (progn + (setq secret-name + (intern (concat ":secret-" + (substring (symbol-name key-name) 1)))) + (if (plist-member (cdr entry) secret-name) + (setq result 'secret) + (setq result nil + keys nil))) + (setq result nil + keys nil))) + (setq keys (nthcdr 2 keys))) + result)) + +(defun plstore-find (plstore keys) + "Perform search on PLSTORE with KEYS. +KEYS is a plist." + (let (entries alist entry match decrypt plist) + ;; First, go through the merged plist alist and collect entries + ;; matched with keys. + (setq alist (plstore--get-merged-alist plstore)) + (while alist + (setq entry (car alist) + alist (cdr alist) + match (plstore--match entry keys t)) + (if (eq match 'secret) + (setq decrypt t) + (when match + (setq plist (cdr entry)) + (while plist + (if (string-match "\\`:secret-" (symbol-name (car plist))) + (setq decrypt t + plist nil)) + (setq plist (nthcdr 2 plist))) + (setq entries (cons entry entries))))) + ;; Second, decrypt the encrypted plist and try again. + (when decrypt + (setq entries nil) + (plstore--decrypt plstore) + (setq alist (plstore--get-merged-alist plstore)) + (while alist + (setq entry (car alist) + alist (cdr alist) + match (plstore--match entry keys nil)) + (if match + (setq entries (cons entry entries))))) + (nreverse entries))) + +(defun plstore-get (plstore name) + "Get an entry with NAME in PLSTORE." + (let ((entry (assoc name (plstore--get-merged-alist plstore))) + plist) + (setq plist (cdr entry)) + (while plist + (if (string-match "\\`:secret-" (symbol-name (car plist))) + (progn + (plstore--decrypt plstore) + (setq entry (assoc name (plstore--get-merged-alist plstore)) + plist nil)) + (setq plist (nthcdr 2 plist)))) + entry)) + +(defun plstore-put (plstore name keys secret-keys) + "Put an entry with NAME in PLSTORE. +KEYS is a plist containing non-secret data. +SECRET-KEYS is a plist containing secret data." + (let (entry + plist + secret-plist + symbol) + (if secret-keys + (plstore--decrypt plstore)) + (while secret-keys + (setq symbol + (intern (concat ":secret-" + (substring (symbol-name (car secret-keys)) 1)))) + (setq plist (plist-put plist symbol t) + secret-plist (plist-put secret-plist + (car secret-keys) (car (cdr secret-keys))) + secret-keys (nthcdr 2 secret-keys))) + (while keys + (setq symbol + (intern (concat ":secret-" + (substring (symbol-name (car keys)) 1)))) + (setq plist (plist-put plist (car keys) (car (cdr keys))) + keys (nthcdr 2 keys))) + (setq entry (assoc name (plstore--get-alist plstore))) + (if entry + (setcdr entry plist) + (plstore--set-alist + plstore + (cons (cons name plist) (plstore--get-alist plstore)))) + (when secret-plist + (setq entry (assoc name (plstore--get-secret-alist plstore))) + (if entry + (setcdr entry secret-plist) + (plstore--set-secret-alist + plstore + (cons (cons name secret-plist) (plstore--get-secret-alist plstore))))) + (plstore--merge-secret plstore))) + +(defun plstore-delete (plstore name) + "Delete an entry with NAME from PLSTORE." + (let ((entry (assoc name (plstore--get-alist plstore)))) + (if entry + (plstore--set-alist + plstore + (delq entry (plstore--get-alist plstore)))) + (setq entry (assoc name (plstore--get-secret-alist plstore))) + (if entry + (plstore--set-secret-alist + plstore + (delq entry (plstore--get-secret-alist plstore)))) + (setq entry (assoc name (plstore--get-merged-alist plstore))) + (if entry + (plstore--set-merged-alist + plstore + (delq entry (plstore--get-merged-alist plstore)))))) + +(defvar pp-escape-newlines) +(defun plstore-save (plstore) + "Save the contents of PLSTORE associated with a FILE." + (with-current-buffer (plstore--get-buffer plstore) + (erase-buffer) + (insert ";;; public entries -*- mode: emacs-lisp -*- \n" + (pp-to-string (plstore--get-alist plstore))) + (if (plstore--get-secret-alist plstore) + (let ((context (epg-make-context 'OpenPGP)) + (pp-escape-newlines nil) + (recipients + (cond + ((listp plstore-encrypt-to) plstore-encrypt-to) + ((stringp plstore-encrypt-to) (list plstore-encrypt-to)))) + cipher) + (epg-context-set-armor context t) + (epg-context-set-passphrase-callback + context + (cons #'plstore-passphrase-callback-function + plstore)) + (setq cipher (epg-encrypt-string + context + (pp-to-string + (plstore--get-secret-alist plstore)) + (if (or (eq plstore-select-keys t) + (and (null plstore-select-keys) + (not (local-variable-p 'plstore-encrypt-to + (current-buffer))))) + (epa-select-keys + context + "Select recipents for encryption. +If no one is selected, symmetric encryption will be performed. " + recipients) + (if plstore-encrypt-to + (epg-list-keys context recipients))))) + (goto-char (point-max)) + (insert ";;; secret entries\n" (pp-to-string cipher)))) + (save-buffer))) + +(provide 'plstore) + +;;; plstore.el ends here diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el index 90e11b3ca8f..e29ddb0d44e 100644 --- a/lisp/gnus/pop3.el +++ b/lisp/gnus/pop3.el @@ -306,7 +306,8 @@ Returns the process associated with the connection." (t (or pop3-stream-type 'network))) :capability-command "CAPA\r\n" - :end-of-command "^\\.\r?\n\\|^\\(-ERR\\|+OK \\).*\n" + :end-of-command "^\\(-ERR\\|+OK \\).*\n" + :end-of-capability "^\\.\r?\n\\|^-ERR" :success "^\\+OK.*\n" :return-list t :starttls-function diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el index 67effc07ee2..f8a85579b4f 100644 --- a/lisp/gnus/shr.el +++ b/lisp/gnus/shr.el @@ -526,7 +526,9 @@ the URL of the image to the kill buffer instead." (when (and (> (current-column) 0) (> (car (image-size image t)) 400)) (insert "\n")) - (insert-image image (or alt "*"))) + (insert-image image (or alt "*")) + (when (image-animated-p image) + (image-animate image nil 60))) image) (insert alt))) @@ -557,10 +559,6 @@ the URL of the image to the kill buffer instead." :width window-width :ascent 100) image))) - (when (and (fboundp 'create-animated-image) - (eq (image-type data nil t) 'gif)) - (setq image (create-animated-image data 'gif t - :ascent 100))) image))) ;; url-cache-extract autoloads url-cache. diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el index b56d0c416ef..8b56c7bd537 100644 --- a/lisp/gnus/spam-stat.el +++ b/lisp/gnus/spam-stat.el @@ -138,12 +138,6 @@ See `spam-stat-to-hash-table' for the format of the file." :type 'file :group 'spam-stat) -(defcustom spam-stat-install-hooks t - "Whether spam-stat should install its hooks in Gnus. -This is set to nil if you use spam-stat through spam.el." - :type 'boolean - :group 'spam-stat) - (defcustom spam-stat-unknown-word-score 0.2 "The score to use for unknown words. Also used for words that don't appear often enough." @@ -658,9 +652,6 @@ COUNT defaults to 5" (add-hook 'gnus-select-article-hook 'spam-stat-store-gnus-article-buffer)) -(when spam-stat-install-hooks - (spam-stat-install-hooks-function)) - (defun spam-stat-unload-hook () "Uninstall the spam-stat function hooks." (interactive) diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index cbffeeab69e..33dbaaa1f0c 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -2260,51 +2260,44 @@ Uses `gnus-newsgroup-name' if category is nil (for ham registration)." (autoload 'spam-stat-save "spam-stat") (autoload 'spam-stat-split-fancy "spam-stat")) -(eval-and-compile - (when (condition-case nil - (let ((spam-stat-install-hooks nil)) - (require 'spam-stat)) - (file-error - (defalias 'spam-stat-register-ham-routine 'ignore) - (defalias 'spam-stat-register-spam-routine 'ignore) - nil)) +(require 'spam-stat) - (defun spam-check-stat () - "Check the spam-stat backend for the classification of this message" - (let ((spam-stat-split-fancy-spam-group spam-split-group) ; override - (spam-stat-buffer (buffer-name)) ; stat the current buffer - category return) - (spam-stat-split-fancy))) +(defun spam-check-stat () + "Check the spam-stat backend for the classification of this message" + (let ((spam-stat-split-fancy-spam-group spam-split-group) ; override + (spam-stat-buffer (buffer-name)) ; stat the current buffer + category return) + (spam-stat-split-fancy))) - (defun spam-stat-register-spam-routine (articles &optional unregister) - (dolist (article articles) - (let ((article-string (spam-get-article-as-string article))) - (with-temp-buffer - (insert article-string) - (if unregister - (spam-stat-buffer-change-to-non-spam) - (spam-stat-buffer-is-spam)))))) +(defun spam-stat-register-spam-routine (articles &optional unregister) + (dolist (article articles) + (let ((article-string (spam-get-article-as-string article))) + (with-temp-buffer + (insert article-string) + (if unregister + (spam-stat-buffer-change-to-non-spam) + (spam-stat-buffer-is-spam)))))) - (defun spam-stat-unregister-spam-routine (articles) - (spam-stat-register-spam-routine articles t)) +(defun spam-stat-unregister-spam-routine (articles) + (spam-stat-register-spam-routine articles t)) - (defun spam-stat-register-ham-routine (articles &optional unregister) - (dolist (article articles) - (let ((article-string (spam-get-article-as-string article))) - (with-temp-buffer - (insert article-string) - (if unregister - (spam-stat-buffer-change-to-spam) - (spam-stat-buffer-is-non-spam)))))) +(defun spam-stat-register-ham-routine (articles &optional unregister) + (dolist (article articles) + (let ((article-string (spam-get-article-as-string article))) + (with-temp-buffer + (insert article-string) + (if unregister + (spam-stat-buffer-change-to-spam) + (spam-stat-buffer-is-non-spam)))))) - (defun spam-stat-unregister-ham-routine (articles) - (spam-stat-register-ham-routine articles t)) +(defun spam-stat-unregister-ham-routine (articles) + (spam-stat-register-ham-routine articles t)) - (defun spam-maybe-spam-stat-load () - (when spam-use-stat (spam-stat-load))) +(defun spam-maybe-spam-stat-load () + (when spam-use-stat (spam-stat-load))) - (defun spam-maybe-spam-stat-save () - (when spam-use-stat (spam-stat-save))))) +(defun spam-maybe-spam-stat-save () + (when spam-use-stat (spam-stat-save))) ;;}}} diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 1cd62c1dfa4..b13e6a77d5d 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -731,12 +731,18 @@ it is displayed along with the global value." (delete-region (1- from) from))))))) (terpri) (when locus - (if (bufferp locus) - (princ (format "%socal in buffer %s; " - (if (get variable 'permanent-local) - "Permanently l" "L") - (buffer-name))) - (princ (format "It is a frame-local variable; "))) + (cond + ((bufferp locus) + (princ (format "%socal in buffer %s; " + (if (get variable 'permanent-local) + "Permanently l" "L") + (buffer-name)))) + ((framep locus) + (princ (format "It is a frame-local variable; "))) + ((terminal-live-p locus) + (princ (format "It is a terminal-local variable; "))) + (t + (princ (format "It is local to %S" locus)))) (if (not (default-boundp variable)) (princ "globally void") (let ((val (default-value variable))) diff --git a/lisp/hl-line.el b/lisp/hl-line.el index 55704dccb33..846f5f95187 100644 --- a/lisp/hl-line.el +++ b/lisp/hl-line.el @@ -93,14 +93,26 @@ (overlay-put global-hl-line-overlay 'face hl-line-face)))) (defcustom hl-line-sticky-flag t - "Non-nil means highlight the current line in all windows. + "Non-nil means the HL-Line mode highlight appears in all windows. Otherwise Hl-Line mode will highlight only in the selected window. Setting this variable takes effect the next time you use -the command `hl-line-mode' to turn Hl-Line mode on." +the command `hl-line-mode' to turn Hl-Line mode on. + +This variable has no effect in Global Highlight Line mode. +For that, use `global-hl-line-sticky-flag'." :type 'boolean :version "22.1" :group 'hl-line) +(defcustom global-hl-line-sticky-flag nil + "Non-nil means the Global HL-Line mode highlight appears in all windows. +Otherwise Global Hl-Line mode will highlight only in the selected +window. Setting this variable takes effect the next time you use +the command `global-hl-line-mode' to turn Global Hl-Line mode on." + :type 'boolean + :version "24.1" + :group 'hl-line) + (defvar hl-line-range-function nil "If non-nil, function to call to return highlight range. The function of no args should return a cons cell; its car value @@ -162,6 +174,10 @@ addition to `hl-line-highlight' on `post-command-hook'." "Global minor mode to highlight the line about point in the current window. With ARG, turn Global-Hl-Line mode on if ARG is positive, off otherwise. +If `global-hl-line-sticky-flag' is non-nil, Global Hl-Line mode +highlights the line about the current buffer's point in all +windows. + Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and `global-hl-line-highlight' on `pre-command-hook' and `post-command-hook'." :global t @@ -181,7 +197,9 @@ Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and (unless global-hl-line-overlay (setq global-hl-line-overlay (make-overlay 1 1)) ; to be moved (overlay-put global-hl-line-overlay 'face hl-line-face)) - (overlay-put global-hl-line-overlay 'window (selected-window)) + (overlay-put global-hl-line-overlay 'window + (unless global-hl-line-sticky-flag + (selected-window))) (hl-line-move global-hl-line-overlay)))) (defun global-hl-line-unhighlight () diff --git a/lisp/info-look.el b/lisp/info-look.el index 2cfaa81d4c7..13edc0269dd 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -127,9 +127,9 @@ OTHER-MODES is a list of cross references to other help modes.") (defun info-lookup-add-help (&rest arg) "Add or update a help specification. -Function arguments are one or more options of the form +Function arguments are specified as keyword/argument pairs: - KEYWORD ARGUMENT + \(KEYWORD . ARGUMENT) KEYWORD is either `:topic', `:mode', `:regexp', `:ignore-case', `:doc-spec', `:parse-rule', or `:other-modes'. diff --git a/lisp/info.el b/lisp/info.el index bca41c29d0f..047a1b340a0 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -2092,7 +2092,7 @@ If SAME-FILE is non-nil, do not move to a different Info file." )) (defun Info-directory-toc-nodes (filename) - "Directory-specific implementation of `Info-directory-toc-nodes'." + "Directory-specific implementation of `Info-toc-nodes'." `(,filename ("Top" nil nil nil))) @@ -3281,7 +3281,6 @@ MATCHES is a list of index matches found by `Info-apropos-matches'.") "Collect STRING matches from all known Info files on your system. Return a list of matches where each element is in the format \((FILENAME INDEXTEXT NODENAME LINENUMBER))." - (interactive "sIndex apropos: ") (unless (string= string "") (let ((pattern (format "\n\\* +\\([^\n]*%s[^\n]*\\):[ \t]+\\([^\n]+\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" (regexp-quote string))) diff --git a/lisp/isearch.el b/lisp/isearch.el index 7f018ab14c7..50e7b331c85 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -2226,10 +2226,13 @@ If there is no completion possible, say so and continue searching." ;; Searching (defvar isearch-search-fun-function nil - "Override `isearch-search-fun'. -This function should return the search function for Isearch to use. -It will call this function with three arguments -as if it were `search-forward'.") + "Overrides the default `isearch-search-fun' behaviour. +This variable's value should be a function, which will be called +with no arguments, and should return a function that takes three +arguments: STRING, BOUND, and NOERROR. + +This returned function will be used by `isearch-search-string' to +search for the first occurrence of STRING or its translation.") (defun isearch-search-fun () "Return the function to use for the search. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index bbf59e4e376..75de9a9f9b2 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -5,7 +5,7 @@ ;;;### (autoloads (5x5-crack 5x5-crack-xor-mutate 5x5-crack-mutating-best ;;;;;; 5x5-crack-mutating-current 5x5-crack-randomly 5x5) "5x5" -;;;;;; "play/5x5.el" (19932 573)) +;;;;;; "play/5x5.el" (19968 28627)) ;;; Generated autoloads from play/5x5.el (autoload '5x5 "5x5" "\ @@ -16,18 +16,21 @@ squares you must fill the grid. 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] \(fn &optional SIZE)" t nil) @@ -486,7 +489,7 @@ A replacement function for `newline-and-indent', aligning as it goes. ;;;### (autoloads (outlineify-sticky allout-mode allout-mode-p allout-auto-activation ;;;;;; allout-setup allout-auto-activation-helper) "allout" "allout.el" -;;;;;; (19931 11784)) +;;;;;; (19981 40664)) ;;; Generated autoloads from allout.el (autoload 'allout-auto-activation-helper "allout" "\ @@ -844,7 +847,7 @@ for details on preparing emacs for automatic allout activation. ;;;### (autoloads (allout-widgets-mode allout-widgets-auto-activation ;;;;;; allout-widgets-setup allout-widgets) "allout-widgets" "allout-widgets.el" -;;;;;; (19931 11784)) +;;;;;; (19981 40664)) ;;; Generated autoloads from allout-widgets.el (let ((loads (get 'allout-widgets 'custom-loads))) (if (member '"allout-widgets" loads) nil (put 'allout-widgets 'custom-loads (cons '"allout-widgets" loads)))) @@ -903,7 +906,7 @@ outline hot-spot navigation (see `allout-mode'). ;;;*** ;;;### (autoloads (ange-ftp-hook-function ange-ftp-reread-dir) "ange-ftp" -;;;;;; "net/ange-ftp.el" (19931 11784)) +;;;;;; "net/ange-ftp.el" (19977 43600)) ;;; Generated autoloads from net/ange-ftp.el (defalias 'ange-ftp-re-read-dir 'ange-ftp-reread-dir) @@ -1015,7 +1018,7 @@ Used in `antlr-mode'. Also a useful function in `java-mode-hook'. ;;;*** ;;;### (autoloads (appt-activate appt-add) "appt" "calendar/appt.el" -;;;;;; (19922 19303)) +;;;;;; (19956 37456)) ;;; Generated autoloads from calendar/appt.el (autoload 'appt-add "appt" "\ @@ -1469,7 +1472,7 @@ Special commands: ;;;*** ;;;### (autoloads (auth-source-cache-expiry) "auth-source" "gnus/auth-source.el" -;;;;;; (19845 45374)) +;;;;;; (19981 40664)) ;;; Generated autoloads from gnus/auth-source.el (defvar auth-source-cache-expiry 7200 "\ @@ -1759,7 +1762,7 @@ definition of \"random distance\".) ;;;*** ;;;### (autoloads (display-battery-mode battery) "battery" "battery.el" -;;;;;; (19845 45374)) +;;;;;; (19976 22732)) ;;; Generated autoloads from battery.el (put 'battery-mode-line-string 'risky-local-variable t) @@ -1791,7 +1794,7 @@ seconds. ;;;*** ;;;### (autoloads (benchmark benchmark-run-compiled benchmark-run) -;;;;;; "benchmark" "emacs-lisp/benchmark.el" (19845 45374)) +;;;;;; "benchmark" "emacs-lisp/benchmark.el" (19981 40664)) ;;; Generated autoloads from emacs-lisp/benchmark.el (autoload 'benchmark-run "benchmark" "\ @@ -1824,7 +1827,7 @@ For non-interactive use see also `benchmark-run' and ;;;*** ;;;### (autoloads (bibtex-search-entry bibtex-mode bibtex-initialize) -;;;;;; "bibtex" "textmodes/bibtex.el" (19931 11784)) +;;;;;; "bibtex" "textmodes/bibtex.el" (19971 4823)) ;;; Generated autoloads from textmodes/bibtex.el (autoload 'bibtex-initialize "bibtex" "\ @@ -1903,8 +1906,10 @@ is limited to the current buffer. Optional arg START is buffer position where the search starts. If it is nil, start search at beginning of buffer. If DISPLAY is non-nil, display the buffer containing KEY. Otherwise, use `set-buffer'. -When called interactively, GLOBAL is t if there is a prefix arg or the current -mode is not `bibtex-mode', START is nil, and DISPLAY is t. +When called interactively, START is nil, DISPLAY is t. +Also, GLOBAL is t if the current mode is not `bibtex-mode' +or `bibtex-search-entry-globally' is non-nil. +A prefix arg negates the value of `bibtex-search-entry-globally'. \(fn KEY &optional GLOBAL START DISPLAY)" t nil) @@ -2271,7 +2276,7 @@ Incremental search of bookmarks, hiding the non-matches as we go. ;;;;;; browse-url-at-mouse browse-url-at-point browse-url browse-url-of-region ;;;;;; browse-url-of-dired-file browse-url-of-buffer browse-url-of-file ;;;;;; browse-url-browser-function) "browse-url" "net/browse-url.el" -;;;;;; (19911 48973)) +;;;;;; (19973 46551)) ;;; Generated autoloads from net/browse-url.el (defvar browse-url-browser-function (cond ((memq system-type '(windows-nt ms-dos cygwin)) 'browse-url-default-windows-browser) ((memq system-type '(darwin)) 'browse-url-default-macosx-browser) (t 'browse-url-default-browser)) "\ @@ -2593,7 +2598,7 @@ Return a vector containing the lines from `bruce-phrases-file'. ;;;*** ;;;### (autoloads (bs-show bs-customize bs-cycle-previous bs-cycle-next) -;;;;;; "bs" "bs.el" (19870 57559)) +;;;;;; "bs" "bs.el" (19976 22732)) ;;; Generated autoloads from bs.el (autoload 'bs-cycle-next "bs" "\ @@ -2676,7 +2681,7 @@ Like `bug-reference-mode', but only buttonize in comments and strings. ;;;;;; batch-byte-compile-if-not-done display-call-tree byte-compile ;;;;;; compile-defun byte-compile-file byte-recompile-directory ;;;;;; byte-force-recompile byte-compile-enable-warning byte-compile-disable-warning) -;;;;;; "bytecomp" "emacs-lisp/bytecomp.el" (19940 49234)) +;;;;;; "bytecomp" "emacs-lisp/bytecomp.el" (19968 28627)) ;;; Generated autoloads from emacs-lisp/bytecomp.el (put 'byte-compile-dynamic 'safe-local-variable 'booleanp) (put 'byte-compile-disable-print-circle 'safe-local-variable 'booleanp) @@ -2834,8 +2839,8 @@ from the cursor position. ;;;### (autoloads (defmath calc-embedded-activate calc-embedded calc-grab-rectangle ;;;;;; calc-grab-region full-calc-keypad calc-keypad calc-eval quick-calc -;;;;;; full-calc calc calc-dispatch) "calc" "calc/calc.el" (19845 -;;;;;; 45374)) +;;;;;; full-calc calc calc-dispatch) "calc" "calc/calc.el" (19943 +;;;;;; 25429)) ;;; Generated autoloads from calc/calc.el (define-key ctl-x-map "*" 'calc-dispatch) @@ -2942,8 +2947,8 @@ See the documentation for `calculator-mode' for more information. ;;;*** -;;;### (autoloads (calendar) "calendar" "calendar/calendar.el" (19923 -;;;;;; 40175)) +;;;### (autoloads (calendar) "calendar" "calendar/calendar.el" (19956 +;;;;;; 37456)) ;;; Generated autoloads from calendar/calendar.el (autoload 'calendar "calendar" "\ @@ -3048,7 +3053,7 @@ Obsoletes `c-forward-into-nomenclature'. ;;;*** ;;;### (autoloads (c-guess-basic-syntax) "cc-engine" "progmodes/cc-engine.el" -;;;;;; (19893 19022)) +;;;;;; (19981 40664)) ;;; Generated autoloads from progmodes/cc-engine.el (autoload 'c-guess-basic-syntax "cc-engine" "\ @@ -3058,9 +3063,109 @@ Return the syntactic context of the current line. ;;;*** +;;;### (autoloads (c-guess-install c-guess-region-no-install c-guess-region +;;;;;; c-guess-buffer-no-install c-guess-buffer c-guess-no-install +;;;;;; c-guess) "cc-guess" "progmodes/cc-guess.el" (19981 40664)) +;;; Generated autoloads from progmodes/cc-guess.el + +(defvar c-guess-guessed-offsets-alist nil "\ +Currently guessed offsets-alist.") + +(defvar c-guess-guessed-basic-offset nil "\ +Currently guessed basic-offset.") + +(autoload 'c-guess "cc-guess" "\ +Guess the style in the region up to `c-guess-region-max', and install it. + +The style is given a name based on the file's absolute file name. + +If given a prefix argument (or if the optional argument ACCUMULATE is +non-nil) then the previous guess is extended, otherwise a new guess is +made from scratch. + +\(fn &optional ACCUMULATE)" t nil) + +(autoload 'c-guess-no-install "cc-guess" "\ +Guess the style in the region up to `c-guess-region-max'; don't install it. + +If given a prefix argument (or if the optional argument ACCUMULATE is +non-nil) then the previous guess is extended, otherwise a new guess is +made from scratch. + +\(fn &optional ACCUMULATE)" t nil) + +(autoload 'c-guess-buffer "cc-guess" "\ +Guess the style on the whole current buffer, and install it. + +The style is given a name based on the file's absolute file name. + +If given a prefix argument (or if the optional argument ACCUMULATE is +non-nil) then the previous guess is extended, otherwise a new guess is +made from scratch. + +\(fn &optional ACCUMULATE)" t nil) + +(autoload 'c-guess-buffer-no-install "cc-guess" "\ +Guess the style on the whole current buffer; don't install it. + +If given a prefix argument (or if the optional argument ACCUMULATE is +non-nil) then the previous guess is extended, otherwise a new guess is +made from scratch. + +\(fn &optional ACCUMULATE)" t nil) + +(autoload 'c-guess-region "cc-guess" "\ +Guess the style on the region and install it. + +The style is given a name based on the file's absolute file name. + +If given a prefix argument (or if the optional argument ACCUMULATE is +non-nil) then the previous guess is extended, otherwise a new guess is +made from scratch. + +\(fn START END &optional ACCUMULATE)" t nil) + +(autoload 'c-guess-region-no-install "cc-guess" "\ +Guess the style on the region; don't install it. + +Every line of code in the region is examined and values for the following two +variables are guessed: + +* `c-basic-offset', and +* the indentation values of the various syntactic symbols in + `c-offsets-alist'. + +The guessed values are put into `c-guess-guessed-basic-offset' and +`c-guess-guessed-offsets-alist'. + +Frequencies of use are taken into account when guessing, so minor +inconsistencies in the indentation style shouldn't produce wrong guesses. + +If given a prefix argument (or if the optional argument ACCUMULATE is +non-nil) then the previous examination is extended, otherwise a new +guess is made from scratch. + +Note that the larger the region to guess in, the slower the guessing. +So you can limit the region with `c-guess-region-max'. + +\(fn START END &optional ACCUMULATE)" t nil) + +(autoload 'c-guess-install "cc-guess" "\ +Install the latest guessed style into the current buffer. +\(This guessed style is a combination of `c-guess-guessed-basic-offset', +`c-guess-guessed-offsets-alist' and `c-offsets-alist'.) + +The style is entered into CC Mode's style system by +`c-add-style'. Its name is either STYLE-NAME, or a name based on +the absolute file name of the file if STYLE-NAME is nil. + +\(fn &optional STYLE-NAME)" t nil) + +;;;*** + ;;;### (autoloads (awk-mode pike-mode idl-mode java-mode objc-mode ;;;;;; c++-mode c-mode c-initialize-cc-mode) "cc-mode" "progmodes/cc-mode.el" -;;;;;; (19938 7518)) +;;;;;; (19981 40664)) ;;; Generated autoloads from progmodes/cc-mode.el (autoload 'c-initialize-cc-mode "cc-mode" "\ @@ -3237,7 +3342,7 @@ Key bindings: ;;;*** ;;;### (autoloads (c-set-offset c-add-style c-set-style) "cc-styles" -;;;;;; "progmodes/cc-styles.el" (19845 45374)) +;;;;;; "progmodes/cc-styles.el" (19981 40664)) ;;; Generated autoloads from progmodes/cc-styles.el (autoload 'c-set-style "cc-styles" "\ @@ -3298,7 +3403,7 @@ and exists only for compatibility reasons. ;;;### (autoloads (ccl-execute-with-args check-ccl-program define-ccl-program ;;;;;; declare-ccl-program ccl-dump ccl-compile) "ccl" "international/ccl.el" -;;;;;; (19845 45374)) +;;;;;; (19943 25429)) ;;; Generated autoloads from international/ccl.el (autoload 'ccl-compile "ccl" "\ @@ -3559,7 +3664,7 @@ See the documentation of `define-ccl-program' for the detail of CCL program. ;;;*** ;;;### (autoloads (cconv-closure-convert) "cconv" "emacs-lisp/cconv.el" -;;;;;; (19869 36706)) +;;;;;; (19943 25429)) ;;; Generated autoloads from emacs-lisp/cconv.el (autoload 'cconv-closure-convert "cconv" "\ @@ -3573,10 +3678,19 @@ Returns a form where all lambdas don't have any free variables. ;;;*** -;;;### (autoloads (cfengine-mode) "cfengine" "progmodes/cfengine.el" -;;;;;; (19845 45374)) +;;;### (autoloads (cfengine-mode cfengine3-mode) "cfengine" "progmodes/cfengine.el" +;;;;;; (19981 40664)) ;;; Generated autoloads from progmodes/cfengine.el +(autoload 'cfengine3-mode "cfengine" "\ +Major mode for editing cfengine input. +There are no special keybindings by default. + +Action blocks are treated as defuns, i.e. \\[beginning-of-defun] moves +to the action header. + +\(fn)" t nil) + (autoload 'cfengine-mode "cfengine" "\ Major mode for editing cfengine input. There are no special keybindings by default. @@ -4045,7 +4159,7 @@ If FRAME cannot display COLOR, return nil. ;;;### (autoloads (comint-redirect-results-list-from-process comint-redirect-results-list ;;;;;; comint-redirect-send-command-to-process comint-redirect-send-command ;;;;;; comint-run make-comint make-comint-in-buffer) "comint" "comint.el" -;;;;;; (19931 11784)) +;;;;;; (19981 40664)) ;;; Generated autoloads from comint.el (defvar comint-output-filter-functions '(comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt) "\ @@ -4177,8 +4291,8 @@ on third call it again advances points to the next difference and so on. ;;;;;; compilation-shell-minor-mode compilation-mode compilation-start ;;;;;; compile compilation-disable-input compile-command compilation-search-path ;;;;;; compilation-ask-about-save compilation-window-height compilation-start-hook -;;;;;; compilation-mode-hook) "compile" "progmodes/compile.el" (19913 -;;;;;; 4309)) +;;;;;; compilation-mode-hook) "compile" "progmodes/compile.el" (19968 +;;;;;; 28627)) ;;; Generated autoloads from progmodes/compile.el (defvar compilation-mode-hook nil "\ @@ -4602,7 +4716,7 @@ If FIX is non-nil, run `copyright-fix-years' instead. ;;;*** ;;;### (autoloads (cperl-perldoc-at-point cperl-perldoc cperl-mode) -;;;;;; "cperl-mode" "progmodes/cperl-mode.el" (19931 11784)) +;;;;;; "cperl-mode" "progmodes/cperl-mode.el" (19975 1875)) ;;; Generated autoloads from progmodes/cperl-mode.el (put 'cperl-indent-level 'safe-local-variable 'integerp) (put 'cperl-brace-offset 'safe-local-variable 'integerp) @@ -4879,8 +4993,8 @@ INHERIT-INPUT-METHOD. ;;;*** -;;;### (autoloads (css-mode) "css-mode" "textmodes/css-mode.el" (19863 -;;;;;; 8742)) +;;;### (autoloads (css-mode) "css-mode" "textmodes/css-mode.el" (19978 +;;;;;; 37530)) ;;; Generated autoloads from textmodes/css-mode.el (autoload 'css-mode "css-mode" "\ @@ -4947,10 +5061,10 @@ Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings. ;;;;;; customize-rogue customize-unsaved customize-face-other-window ;;;;;; customize-face customize-changed-options customize-option-other-window ;;;;;; customize-option customize-group-other-window customize-group -;;;;;; customize-mode customize customize-save-variable customize-set-variable -;;;;;; customize-set-value custom-menu-sort-alphabetically custom-buffer-sort-alphabetically -;;;;;; custom-browse-sort-alphabetically) "cus-edit" "cus-edit.el" -;;;;;; (19886 45771)) +;;;;;; customize-mode customize customize-push-and-save customize-save-variable +;;;;;; customize-set-variable customize-set-value custom-menu-sort-alphabetically +;;;;;; custom-buffer-sort-alphabetically custom-browse-sort-alphabetically) +;;;;;; "cus-edit" "cus-edit.el" (19980 19797)) ;;; Generated autoloads from cus-edit.el (defvar custom-browse-sort-alphabetically nil "\ @@ -5016,6 +5130,17 @@ If given a prefix (or a COMMENT argument), also prompt for a comment. \(fn VARIABLE VALUE &optional COMMENT)" t nil) +(autoload 'customize-push-and-save "cus-edit" "\ +Add ELTS to LIST-VAR and save for future sessions, safely. +ELTS should be a list. This function adds each entry to the +value of LIST-VAR using `add-to-list'. + +If Emacs is initialized, call `customize-save-variable' to save +the resulting list value now. Otherwise, add an entry to +`after-init-hook' to save it after initialization. + +\(fn LIST-VAR ELTS)" nil nil) + (autoload 'customize "cus-edit" "\ Select a customization buffer which you can use to set user options. User options are structured into \"groups\". @@ -5253,8 +5378,8 @@ The format is suitable for use with `easy-menu-define'. ;;;*** ;;;### (autoloads (customize-themes describe-theme custom-theme-visit-theme -;;;;;; customize-create-theme) "cus-theme" "cus-theme.el" (19886 -;;;;;; 45771)) +;;;;;; customize-create-theme) "cus-theme" "cus-theme.el" (19980 +;;;;;; 19797)) ;;; Generated autoloads from cus-theme.el (autoload 'customize-create-theme "cus-theme" "\ @@ -5572,7 +5697,7 @@ There is some minimal font-lock support (see vars ;;;*** ;;;### (autoloads (cancel-debug-on-entry debug-on-entry debug) "debug" -;;;;;; "emacs-lisp/debug.el" (19942 4565)) +;;;;;; "emacs-lisp/debug.el" (19961 55377)) ;;; Generated autoloads from emacs-lisp/debug.el (setq debugger 'debug) @@ -5670,8 +5795,8 @@ START and END delimits the corners of text rectangle. ;;;*** -;;;### (autoloads (delphi-mode) "delphi" "progmodes/delphi.el" (19890 -;;;;;; 42850)) +;;;### (autoloads (delphi-mode) "delphi" "progmodes/delphi.el" (19965 +;;;;;; 52428)) ;;; Generated autoloads from progmodes/delphi.el (autoload 'delphi-mode "delphi" "\ @@ -5718,7 +5843,7 @@ Coloring: Turning on Delphi mode calls the value of the variable `delphi-mode-hook' with no args, if that value is non-nil. -\(fn &optional SKIP-INITIAL-PARSING)" t nil) +\(fn)" t nil) ;;;*** @@ -6064,7 +6189,7 @@ Deuglify broken Outlook (Express) articles and redisplay. ;;;*** ;;;### (autoloads (diary-mode diary-mail-entries diary) "diary-lib" -;;;;;; "calendar/diary-lib.el" (19923 40175)) +;;;;;; "calendar/diary-lib.el" (19975 1875)) ;;; Generated autoloads from calendar/diary-lib.el (autoload 'diary "diary-lib" "\ @@ -6191,7 +6316,7 @@ Optional arguments are passed to `dig-invoke'. ;;;*** ;;;### (autoloads (dired-mode dired-noselect dired-other-frame dired-other-window -;;;;;; dired dired-listing-switches) "dired" "dired.el" (19927 37312)) +;;;;;; dired dired-listing-switches) "dired" "dired.el" (19966 16984)) ;;; Generated autoloads from dired.el (defvar dired-listing-switches (purecopy "-al") "\ @@ -6543,8 +6668,8 @@ Locate SOA record and increment the serial field. ;;;*** ;;;### (autoloads (doc-view-bookmark-jump doc-view-minor-mode doc-view-mode-maybe -;;;;;; doc-view-mode doc-view-mode-p) "doc-view" "doc-view.el" (19913 -;;;;;; 4309)) +;;;;;; doc-view-mode doc-view-mode-p) "doc-view" "doc-view.el" (19953 +;;;;;; 8437)) ;;; Generated autoloads from doc-view.el (autoload 'doc-view-mode-p "doc-view" "\ @@ -7715,7 +7840,7 @@ Display Ediff's registry. ;;;*** ;;;### (autoloads (ediff-toggle-use-toolbar ediff-toggle-multiframe) -;;;;;; "ediff-util" "vc/ediff-util.el" (19931 11784)) +;;;;;; "ediff-util" "vc/ediff-util.el" (19981 40664)) ;;; Generated autoloads from vc/ediff-util.el (autoload 'ediff-toggle-multiframe "ediff-util" "\ @@ -7989,8 +8114,8 @@ optional prefix argument REINIT is non-nil. ;;;*** ;;;### (autoloads (elp-results elp-instrument-package elp-instrument-list -;;;;;; elp-instrument-function) "elp" "emacs-lisp/elp.el" (19845 -;;;;;; 45374)) +;;;;;; elp-instrument-function) "elp" "emacs-lisp/elp.el" (19981 +;;;;;; 40664)) ;;; Generated autoloads from emacs-lisp/elp.el (autoload 'elp-instrument-function "elp" "\ @@ -8025,7 +8150,7 @@ displayed. ;;;*** ;;;### (autoloads (report-emacs-bug) "emacsbug" "mail/emacsbug.el" -;;;;;; (19942 4565)) +;;;;;; (19978 37530)) ;;; Generated autoloads from mail/emacsbug.el (autoload 'report-emacs-bug "emacsbug" "\ @@ -8454,7 +8579,7 @@ Look at CONFIG and try to expand GROUP. ;;;*** ;;;### (autoloads (erc-handle-irc-url erc erc-select-read-args) "erc" -;;;;;; "erc/erc.el" (19903 54862)) +;;;;;; "erc/erc.el" (19981 40664)) ;;; Generated autoloads from erc/erc.el (autoload 'erc-select-read-args "erc" "\ @@ -9802,7 +9927,7 @@ This is used only in conjunction with `expand-add-abbrevs'. ;;;*** -;;;### (autoloads (f90-mode) "f90" "progmodes/f90.el" (19931 11784)) +;;;### (autoloads (f90-mode) "f90" "progmodes/f90.el" (19975 1875)) ;;; Generated autoloads from progmodes/f90.el (autoload 'f90-mode "f90" "\ @@ -9829,6 +9954,10 @@ Variables controlling indentation style and extra features: `f90-program-indent' Extra indentation within program/module/subroutine/function blocks (default 2). +`f90-associate-indent' + Extra indentation within associate blocks (default 2). +`f90-critical-indent' + Extra indentation within critical/block blocks (default 2). `f90-continuation-indent' Extra indentation applied to continuation lines (default 5). `f90-comment-region' @@ -10284,7 +10413,7 @@ result is a string that should be ready for the command line. ;;;*** ;;;### (autoloads (find-grep-dired find-name-dired find-dired) "find-dired" -;;;;;; "find-dired.el" (19864 29553)) +;;;;;; "find-dired.el" (19980 19797)) ;;; Generated autoloads from find-dired.el (autoload 'find-dired "find-dired" "\ @@ -10418,7 +10547,7 @@ Visit the file you click on in another window. ;;;;;; find-variable find-variable-noselect find-function-other-frame ;;;;;; find-function-other-window find-function find-function-noselect ;;;;;; find-function-search-for-symbol find-library) "find-func" -;;;;;; "emacs-lisp/find-func.el" (19845 45374)) +;;;;;; "emacs-lisp/find-func.el" (19981 40664)) ;;; Generated autoloads from emacs-lisp/find-func.el (autoload 'find-library "find-func" "\ @@ -10654,7 +10783,7 @@ to get the effect of a C-q. ;;;*** ;;;### (autoloads (flymake-mode-off flymake-mode-on flymake-mode) -;;;;;; "flymake" "progmodes/flymake.el" (19890 42850)) +;;;;;; "flymake" "progmodes/flymake.el" (19976 22732)) ;;; Generated autoloads from progmodes/flymake.el (autoload 'flymake-mode "flymake" "\ @@ -10678,7 +10807,7 @@ Turn flymake mode off. ;;;### (autoloads (flyspell-buffer flyspell-region flyspell-mode-off ;;;;;; turn-off-flyspell turn-on-flyspell flyspell-mode flyspell-prog-mode) -;;;;;; "flyspell" "textmodes/flyspell.el" (19931 11784)) +;;;;;; "flyspell" "textmodes/flyspell.el" (19981 40664)) ;;; Generated autoloads from textmodes/flyspell.el (autoload 'flyspell-prog-mode "flyspell" "\ @@ -10873,7 +11002,7 @@ Visit a file in Forms mode in other window. ;;;*** ;;;### (autoloads (fortran-mode) "fortran" "progmodes/fortran.el" -;;;;;; (19905 10215)) +;;;;;; (19956 37456)) ;;; Generated autoloads from progmodes/fortran.el (autoload 'fortran-mode "fortran" "\ @@ -11208,7 +11337,7 @@ DEFAULT-MAP specifies the default key map for ICON-LIST. ;;;*** ;;;### (autoloads (gnus gnus-other-frame gnus-slave gnus-no-server -;;;;;; gnus-slave-no-server) "gnus" "gnus/gnus.el" (19931 11784)) +;;;;;; gnus-slave-no-server) "gnus" "gnus/gnus.el" (19978 37530)) ;;; Generated autoloads from gnus/gnus.el (when (fboundp 'custom-autoload) (custom-autoload 'gnus-select-method "gnus")) @@ -11261,7 +11390,7 @@ prompt the user for the name of an NNTP server to use. ;;;;;; gnus-agent-get-undownloaded-list gnus-agent-delete-group ;;;;;; gnus-agent-rename-group gnus-agent-possibly-save-gcc gnus-agentize ;;;;;; gnus-slave-unplugged gnus-plugged gnus-unplugged) "gnus-agent" -;;;;;; "gnus/gnus-agent.el" (19903 54862)) +;;;;;; "gnus/gnus-agent.el" (19953 61266)) ;;; Generated autoloads from gnus/gnus-agent.el (autoload 'gnus-unplugged "gnus-agent" "\ @@ -11352,7 +11481,7 @@ If CLEAN, obsolete (ignore). ;;;*** ;;;### (autoloads (gnus-article-prepare-display) "gnus-art" "gnus/gnus-art.el" -;;;;;; (19931 34253)) +;;;;;; (19981 40664)) ;;; Generated autoloads from gnus/gnus-art.el (autoload 'gnus-article-prepare-display "gnus-art" "\ @@ -11494,7 +11623,7 @@ Convenience method to turn on gnus-dired-mode. ;;;*** ;;;### (autoloads (gnus-draft-reminder) "gnus-draft" "gnus/gnus-draft.el" -;;;;;; (19881 27850)) +;;;;;; (19981 40664)) ;;; Generated autoloads from gnus/gnus-draft.el (autoload 'gnus-draft-reminder "gnus-draft" "\ @@ -11506,8 +11635,8 @@ Reminder user if there are unsent drafts. ;;;### (autoloads (gnus-convert-png-to-face gnus-convert-face-to-png ;;;;;; gnus-face-from-file gnus-x-face-from-file gnus-insert-random-x-face-header -;;;;;; gnus-random-x-face) "gnus-fun" "gnus/gnus-fun.el" (19845 -;;;;;; 45374)) +;;;;;; gnus-random-x-face) "gnus-fun" "gnus/gnus-fun.el" (19980 +;;;;;; 19797)) ;;; Generated autoloads from gnus/gnus-fun.el (autoload 'gnus-random-x-face "gnus-fun" "\ @@ -11570,7 +11699,7 @@ If gravatars are already displayed, remove them. ;;;*** ;;;### (autoloads (gnus-fetch-group-other-frame gnus-fetch-group) -;;;;;; "gnus-group" "gnus/gnus-group.el" (19940 49234)) +;;;;;; "gnus-group" "gnus/gnus-group.el" (19981 40664)) ;;; Generated autoloads from gnus/gnus-group.el (autoload 'gnus-fetch-group "gnus-group" "\ @@ -11745,7 +11874,7 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns: ;;;*** ;;;### (autoloads (gnus-button-reply gnus-button-mailto gnus-msg-mail) -;;;;;; "gnus-msg" "gnus/gnus-msg.el" (19845 45374)) +;;;;;; "gnus-msg" "gnus/gnus-msg.el" (19978 37530)) ;;; Generated autoloads from gnus/gnus-msg.el (autoload 'gnus-msg-mail "gnus-msg" "\ @@ -11866,7 +11995,7 @@ Add NUM into sorted LIST by side effect. ;;;*** ;;;### (autoloads (gnus-registry-install-hooks gnus-registry-initialize) -;;;;;; "gnus-registry" "gnus/gnus-registry.el" (19942 4565)) +;;;;;; "gnus-registry" "gnus/gnus-registry.el" (19976 22732)) ;;; Generated autoloads from gnus/gnus-registry.el (autoload 'gnus-registry-initialize "gnus-registry" "\ @@ -11922,7 +12051,7 @@ Update the format specification near point. ;;;*** ;;;### (autoloads (gnus-declare-backend) "gnus-start" "gnus/gnus-start.el" -;;;;;; (19906 31087)) +;;;;;; (19953 61266)) ;;; Generated autoloads from gnus/gnus-start.el (autoload 'gnus-declare-backend "gnus-start" "\ @@ -11933,7 +12062,7 @@ Declare back end NAME with ABILITIES as a Gnus back end. ;;;*** ;;;### (autoloads (gnus-summary-bookmark-jump) "gnus-sum" "gnus/gnus-sum.el" -;;;;;; (19942 4565)) +;;;;;; (19981 40664)) ;;; Generated autoloads from gnus/gnus-sum.el (autoload 'gnus-summary-bookmark-jump "gnus-sum" "\ @@ -12056,7 +12185,7 @@ Retrieve MAIL-ADDRESS gravatar and returns it. ;;;### (autoloads (zrgrep rgrep lgrep grep-find grep grep-mode grep-compute-defaults ;;;;;; grep-process-setup grep-setup-hook grep-find-command grep-command -;;;;;; grep-window-height) "grep" "progmodes/grep.el" (19930 13389)) +;;;;;; grep-window-height) "grep" "progmodes/grep.el" (19980 19797)) ;;; Generated autoloads from progmodes/grep.el (defvar grep-window-height nil "\ @@ -12332,7 +12461,7 @@ Variables: `handwrite-linespace' (default 12) ;;;*** ;;;### (autoloads (hanoi-unix-64 hanoi-unix hanoi) "hanoi" "play/hanoi.el" -;;;;;; (19889 21967)) +;;;;;; (19981 40664)) ;;; Generated autoloads from play/hanoi.el (autoload 'hanoi "hanoi" "\ @@ -12536,7 +12665,7 @@ different regions. With numeric argument ARG, behaves like ;;;### (autoloads (doc-file-to-info doc-file-to-man describe-categories ;;;;;; describe-syntax describe-variable variable-at-point describe-function-1 ;;;;;; find-lisp-object-file-name help-C-file-name describe-function) -;;;;;; "help-fns" "help-fns.el" (19938 7518)) +;;;;;; "help-fns" "help-fns.el" (19977 43600)) ;;; Generated autoloads from help-fns.el (autoload 'describe-function "help-fns" "\ @@ -12632,8 +12761,8 @@ gives the window that lists the options.") ;;;### (autoloads (help-xref-on-pp help-insert-xref-button help-xref-button ;;;;;; help-make-xrefs help-buffer help-setup-xref help-mode-finish -;;;;;; help-mode-setup help-mode) "help-mode" "help-mode.el" (19886 -;;;;;; 45771)) +;;;;;; help-mode-setup help-mode) "help-mode" "help-mode.el" (19958 +;;;;;; 33091)) ;;; Generated autoloads from help-mode.el (autoload 'help-mode "help-mode" "\ @@ -13278,7 +13407,7 @@ argument VERBOSE non-nil makes the function verbose. ;;;*** ;;;### (autoloads (global-hl-line-mode hl-line-mode) "hl-line" "hl-line.el" -;;;;;; (19845 45374)) +;;;;;; (19976 22732)) ;;; Generated autoloads from hl-line.el (autoload 'hl-line-mode "hl-line" "\ @@ -13311,6 +13440,10 @@ or call the function `global-hl-line-mode'.") Global minor mode to highlight the line about point in the current window. With ARG, turn Global-Hl-Line mode on if ARG is positive, off otherwise. +If `global-hl-line-sticky-flag' is non-nil, Global Hl-Line mode +highlights the line about the current buffer's point in all +windows. + Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and `global-hl-line-highlight' on `pre-command-hook' and `post-command-hook'. @@ -14215,12 +14348,12 @@ Toggle inline image minor mode. ;;;*** -;;;### (autoloads (imagemagick-register-types create-animated-image -;;;;;; defimage find-image remove-images insert-sliced-image insert-image -;;;;;; put-image create-image image-type-auto-detected-p image-type-available-p +;;;### (autoloads (imagemagick-register-types defimage find-image +;;;;;; remove-images insert-sliced-image insert-image put-image +;;;;;; create-image image-type-auto-detected-p image-type-available-p ;;;;;; image-type image-type-from-file-name image-type-from-file-header ;;;;;; image-type-from-buffer image-type-from-data) "image" "image.el" -;;;;;; (19939 28373)) +;;;;;; (19956 37456)) ;;; Generated autoloads from image.el (autoload 'image-type-from-data "image" "\ @@ -14396,22 +14529,6 @@ Example: (put 'defimage 'doc-string-elt '3) -(autoload 'create-animated-image "image" "\ -Create an animated image, and begin animating it. -FILE-OR-DATA is an image file name or image data. -Optional TYPE is a symbol describing the image type. If TYPE is omitted -or nil, try to determine the image type from its first few bytes -of image data. If that doesn't work, and FILE-OR-DATA is a file name, -use its file extension as image type. -Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data. -Optional PROPS are additional image attributes to assign to the image, -like, e.g. `:mask MASK'. -Value is the image created, or nil if images of type TYPE are not supported. - -Images should not be larger than specified by `max-image-size'. - -\(fn FILE-OR-DATA &optional TYPE DATA-P &rest PROPS)" nil nil) - (autoload 'imagemagick-register-types "image" "\ Register file types that can be handled by ImageMagick. This adds the file types returned by `imagemagick-types' @@ -14632,7 +14749,7 @@ Image files are those whose name has an extension in ;;;*** ;;;### (autoloads (image-bookmark-jump image-mode-as-text image-minor-mode -;;;;;; image-mode) "image-mode" "image-mode.el" (19939 28373)) +;;;;;; image-mode) "image-mode" "image-mode.el" (19951 19539)) ;;; Generated autoloads from image-mode.el (autoload 'image-mode "image-mode" "\ @@ -14890,7 +15007,7 @@ of `inferior-lisp-program'). Runs the hooks from ;;;;;; Info-goto-emacs-key-command-node Info-goto-emacs-command-node ;;;;;; Info-mode info-finder info-apropos Info-index Info-directory ;;;;;; Info-on-current-buffer info-standalone info-emacs-manual -;;;;;; info info-other-window) "info" "info.el" (19867 52471)) +;;;;;; info info-other-window) "info" "info.el" (19967 7755)) ;;; Generated autoloads from info.el (autoload 'info-other-window "info" "\ @@ -15616,8 +15733,8 @@ You can bind this to the key C-c i in GNUS or mail by adding to ;;;*** -;;;### (autoloads (iswitchb-mode) "iswitchb" "iswitchb.el" (19931 -;;;;;; 11784)) +;;;### (autoloads (iswitchb-mode) "iswitchb" "iswitchb.el" (19946 +;;;;;; 29209)) ;;; Generated autoloads from iswitchb.el (defvar iswitchb-mode nil "\ @@ -15743,7 +15860,7 @@ by `jka-compr-installed'. ;;;*** -;;;### (autoloads (js-mode) "js" "progmodes/js.el" (19914 25180)) +;;;### (autoloads (js-mode) "js" "progmodes/js.el" (19981 40664)) ;;; Generated autoloads from progmodes/js.el (autoload 'js-mode "js" "\ @@ -16131,7 +16248,7 @@ use either \\[customize] or the function `latin1-display'.") ;;;*** ;;;### (autoloads (ld-script-mode) "ld-script" "progmodes/ld-script.el" -;;;;;; (19917 1372)) +;;;;;; (19961 55377)) ;;; Generated autoloads from progmodes/ld-script.el (autoload 'ld-script-mode "ld-script" "\ @@ -16229,8 +16346,8 @@ See `linum-mode' for more information on Linum mode. ;;;*** -;;;### (autoloads (unload-feature) "loadhist" "loadhist.el" (19845 -;;;;;; 45374)) +;;;### (autoloads (unload-feature) "loadhist" "loadhist.el" (19975 +;;;;;; 1875)) ;;; Generated autoloads from loadhist.el (autoload 'unload-feature "loadhist" "\ @@ -16341,8 +16458,8 @@ uses the current buffer. ;;;*** -;;;### (autoloads (log-view-mode) "log-view" "vc/log-view.el" (19863 -;;;;;; 8742)) +;;;### (autoloads (log-view-mode) "log-view" "vc/log-view.el" (19946 +;;;;;; 1612)) ;;; Generated autoloads from vc/log-view.el (autoload 'log-view-mode "log-view" "\ @@ -16746,8 +16863,8 @@ matches may be returned from the message body. ;;;*** ;;;### (autoloads (define-mail-abbrev build-mail-abbrevs mail-abbrevs-setup -;;;;;; mail-abbrevs-mode) "mailabbrev" "mail/mailabbrev.el" (19845 -;;;;;; 45374)) +;;;;;; mail-abbrevs-mode) "mailabbrev" "mail/mailabbrev.el" (19968 +;;;;;; 28627)) ;;; Generated autoloads from mail/mailabbrev.el (defvar mail-abbrevs-mode nil "\ @@ -16856,7 +16973,7 @@ The mail client is taken to be the handler of mailto URLs. ;;;### (autoloads (makefile-imake-mode makefile-bsdmake-mode makefile-makepp-mode ;;;;;; makefile-gmake-mode makefile-automake-mode makefile-mode) -;;;;;; "make-mode" "progmodes/make-mode.el" (19890 42850)) +;;;;;; "make-mode" "progmodes/make-mode.el" (19968 28627)) ;;; Generated autoloads from progmodes/make-mode.el (autoload 'makefile-mode "make-mode" "\ @@ -17094,7 +17211,7 @@ Returns non-nil if the new state is enabled. ;;;;;; message-forward-make-body message-forward message-recover ;;;;;; message-supersede message-cancel-news message-followup message-wide-reply ;;;;;; message-reply message-news message-mail message-mode) "message" -;;;;;; "gnus/message.el" (19940 49234)) +;;;;;; "gnus/message.el" (19980 19797)) ;;; Generated autoloads from gnus/message.el (define-mail-user-agent 'message-user-agent 'message-mail 'message-send-and-exit 'message-kill-buffer 'message-send-hook) @@ -17260,7 +17377,7 @@ which specify the range to operate on. ;;;*** ;;;### (autoloads (metapost-mode metafont-mode) "meta-mode" "progmodes/meta-mode.el" -;;;;;; (19845 45374)) +;;;;;; (19968 28627)) ;;; Generated autoloads from progmodes/meta-mode.el (autoload 'metafont-mode "meta-mode" "\ @@ -17566,7 +17683,7 @@ Returns non-nil if the new state is enabled. ;;;*** ;;;### (autoloads (list-dynamic-libraries butterfly) "misc" "misc.el" -;;;;;; (19913 4309)) +;;;;;; (19968 28627)) ;;; Generated autoloads from misc.el (autoload 'butterfly "misc" "\ @@ -17678,7 +17795,7 @@ whose file names match the specified wildcard. ;;;*** ;;;### (autoloads (mixal-mode) "mixal-mode" "progmodes/mixal-mode.el" -;;;;;; (19931 11784)) +;;;;;; (19961 55377)) ;;; Generated autoloads from progmodes/mixal-mode.el (autoload 'mixal-mode "mixal-mode" "\ @@ -17776,7 +17893,7 @@ Assume text has been decoded if DECODED is non-nil. ;;;### (autoloads (mml2015-self-encrypt mml2015-sign mml2015-encrypt ;;;;;; mml2015-verify-test mml2015-verify mml2015-decrypt-test mml2015-decrypt) -;;;;;; "mml2015" "gnus/mml2015.el" (19845 45374)) +;;;;;; "mml2015" "gnus/mml2015.el" (19981 40664)) ;;; Generated autoloads from gnus/mml2015.el (autoload 'mml2015-decrypt "mml2015" "\ @@ -17977,7 +18094,7 @@ primary selection and region. ;;;*** -;;;### (autoloads (mpc) "mpc" "mpc.el" (19863 8742)) +;;;### (autoloads (mpc) "mpc" "mpc.el" (19946 1612)) ;;; Generated autoloads from mpc.el (autoload 'mpc "mpc" "\ @@ -18410,7 +18527,7 @@ listed in the PORTS list. ;;;*** ;;;### (autoloads (open-network-stream) "network-stream" "net/network-stream.el" -;;;;;; (19906 31087)) +;;;;;; (19976 22732)) ;;; Generated autoloads from net/network-stream.el (autoload 'open-network-stream "network-stream" "\ @@ -18474,8 +18591,22 @@ values: capability command, and should return the command to switch on 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. + +: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. + +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. + asynchronously, if possible. \(fn NAME BUFFER HOST SERVICE &rest PARAMETERS)" nil nil) @@ -19218,7 +19349,7 @@ exported source code blocks by language. ;;;*** ;;;### (autoloads (inferior-octave) "octave-inf" "progmodes/octave-inf.el" -;;;;;; (19894 39890)) +;;;;;; (19968 28627)) ;;; Generated autoloads from progmodes/octave-inf.el (autoload 'inferior-octave "octave-inf" "\ @@ -19241,7 +19372,7 @@ startup file, `~/.emacs-octave'. ;;;*** ;;;### (autoloads (octave-mode) "octave-mod" "progmodes/octave-mod.el" -;;;;;; (19894 39890)) +;;;;;; (19968 28627)) ;;; Generated autoloads from progmodes/octave-mod.el (autoload 'octave-mode "octave-mod" "\ @@ -20979,16 +21110,16 @@ unknown are returned as nil. ;;;*** -;;;### (autoloads (pascal-mode) "pascal" "progmodes/pascal.el" (19899 -;;;;;; 57784)) +;;;### (autoloads (pascal-mode) "pascal" "progmodes/pascal.el" (19968 +;;;;;; 28627)) ;;; Generated autoloads from progmodes/pascal.el (autoload 'pascal-mode "pascal" "\ Major mode for editing Pascal code. \\<pascal-mode-map> 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 to position in code -\\[pascal-show-completions] shows all possible completions at this point. +\\[completion-at-point] completes the word around current point with respect to position in code +\\[completion-help-at-point] shows all possible completions at this point. Other useful functions are: @@ -21174,8 +21305,8 @@ Completion for GNU/Linux `mount'. ;;;*** -;;;### (autoloads (pcomplete/rpm) "pcmpl-rpm" "pcmpl-rpm.el" (19845 -;;;;;; 45374)) +;;;### (autoloads (pcomplete/rpm) "pcmpl-rpm" "pcmpl-rpm.el" (19961 +;;;;;; 55377)) ;;; Generated autoloads from pcmpl-rpm.el (autoload 'pcomplete/rpm "pcmpl-rpm" "\ @@ -21244,8 +21375,8 @@ Includes files as well as host names followed by a colon. ;;;### (autoloads (pcomplete-shell-setup pcomplete-comint-setup pcomplete-list ;;;;;; pcomplete-help pcomplete-expand pcomplete-continue pcomplete-expand-and-complete -;;;;;; pcomplete-reverse pcomplete) "pcomplete" "pcomplete.el" (19931 -;;;;;; 11784)) +;;;;;; pcomplete-reverse pcomplete) "pcomplete" "pcomplete.el" (19964 +;;;;;; 31562)) ;;; Generated autoloads from pcomplete.el (autoload 'pcomplete "pcomplete" "\ @@ -21529,6 +21660,17 @@ they are not defaultly assigned to keys. ;;;*** +;;;### (autoloads (plstore-open) "plstore" "gnus/plstore.el" (19981 +;;;;;; 40664)) +;;; Generated autoloads from gnus/plstore.el + +(autoload 'plstore-open "plstore" "\ +Create a plstore instance associated with FILE. + +\(fn FILE)" nil nil) + +;;;*** + ;;;### (autoloads (po-find-file-coding-system) "po" "textmodes/po.el" ;;;;;; (19845 45374)) ;;; Generated autoloads from textmodes/po.el @@ -22225,7 +22367,7 @@ are both set to t. ;;;*** -;;;### (autoloads (proced) "proced" "proced.el" (19886 45771)) +;;;### (autoloads (proced) "proced" "proced.el" (19975 1875)) ;;; Generated autoloads from proced.el (autoload 'proced "proced" "\ @@ -22288,8 +22430,8 @@ The default value is '(\"/usr/local/share/emacs/fonts/bdf\").") ;;;*** -;;;### (autoloads (ps-mode) "ps-mode" "progmodes/ps-mode.el" (19890 -;;;;;; 42850)) +;;;### (autoloads (ps-mode) "ps-mode" "progmodes/ps-mode.el" (19961 +;;;;;; 55377)) ;;; Generated autoloads from progmodes/ps-mode.el (autoload 'ps-mode "ps-mode" "\ @@ -22537,8 +22679,8 @@ If EXTENSION is any other symbol, it is ignored. ;;;*** -;;;### (autoloads (jython-mode python-mode run-python) "python" "progmodes/python.el" -;;;;;; (19931 11784)) +;;;### (autoloads (jython-mode python-mode python-after-info-look +;;;;;; run-python) "python" "progmodes/python.el" (19975 1875)) ;;; Generated autoloads from progmodes/python.el (add-to-list 'interpreter-mode-alist (cons (purecopy "jython") 'jython-mode)) @@ -22570,6 +22712,12 @@ behavior, change `python-remove-cwd-from-path' to nil. \(fn &optional CMD NOSHOW NEW)" t nil) +(autoload 'python-after-info-look "python" "\ +Set up info-look for Python. +Used with `eval-after-load'. + +\(fn)" nil nil) + (autoload 'python-mode "python" "\ Major mode for editing Python files. Turns on Font Lock mode unconditionally since it is currently required @@ -22641,7 +22789,7 @@ them into characters should be done separately. ;;;;;; quail-defrule quail-install-decode-map quail-install-map ;;;;;; quail-define-rules quail-show-keyboard-layout quail-set-keyboard-layout ;;;;;; quail-define-package quail-use-package quail-title) "quail" -;;;;;; "international/quail.el" (19931 11784)) +;;;;;; "international/quail.el" (19943 25429)) ;;; Generated autoloads from international/quail.el (autoload 'quail-title "quail" "\ @@ -22945,7 +23093,7 @@ Display `quickurl-list' as a formatted list using `quickurl-list-mode'. ;;;*** ;;;### (autoloads (rcirc-track-minor-mode rcirc-connect rcirc) "rcirc" -;;;;;; "net/rcirc.el" (19942 4565)) +;;;;;; "net/rcirc.el" (19968 28627)) ;;; Generated autoloads from net/rcirc.el (autoload 'rcirc "rcirc" "\ @@ -22993,7 +23141,7 @@ See \\[compile]. ;;;*** ;;;### (autoloads (re-builder) "re-builder" "emacs-lisp/re-builder.el" -;;;;;; (19938 7518)) +;;;;;; (19975 1875)) ;;; Generated autoloads from emacs-lisp/re-builder.el (defalias 'regexp-builder 're-builder) @@ -23322,7 +23470,7 @@ Here are all local bindings. ;;;*** ;;;### (autoloads (reftex-all-document-files) "reftex-parse" "textmodes/reftex-parse.el" -;;;;;; (19845 45374)) +;;;;;; (19980 19797)) ;;; Generated autoloads from textmodes/reftex-parse.el (autoload 'reftex-all-document-files "reftex-parse" "\ @@ -23407,7 +23555,7 @@ Extract diary entries from the region. ;;;*** -;;;### (autoloads (repeat) "repeat" "repeat.el" (19845 45374)) +;;;### (autoloads (repeat) "repeat" "repeat.el" (19951 19539)) ;;; Generated autoloads from repeat.el (autoload 'repeat "repeat" "\ @@ -23589,7 +23737,7 @@ variable. ;;;;;; rmail-secondary-file-directory rmail-primary-inbox-list rmail-highlighted-headers ;;;;;; rmail-retry-ignored-headers rmail-displayed-headers rmail-ignored-headers ;;;;;; rmail-user-mail-address-regexp rmail-movemail-variant-p) -;;;;;; "rmail" "mail/rmail.el" (19845 45374)) +;;;;;; "rmail" "mail/rmail.el" (19976 23054)) ;;; Generated autoloads from mail/rmail.el (autoload 'rmail-movemail-variant-p "rmail" "\ @@ -23642,7 +23790,7 @@ If nil, display all header fields except those matched by (custom-autoload 'rmail-displayed-headers "rmail" t) -(defvar rmail-retry-ignored-headers (purecopy "^x-authentication-warning:\\|^x-detected-operating-system:\\|^x-spam[-a-z]*:\\|content-type:\\|content-transfer-encoding:\\|mime-version:") "\ +(defvar rmail-retry-ignored-headers (purecopy "^x-authentication-warning:\\|^x-detected-operating-system:\\|^x-spam[-a-z]*:\\|content-type:\\|content-transfer-encoding:\\|mime-version:\\|message-id:") "\ Headers that should be stripped when retrying a failed message.") (custom-autoload 'rmail-retry-ignored-headers "rmail" t) @@ -24068,8 +24216,8 @@ In Ruler mode, Emacs displays a ruler in the header line. ;;;*** -;;;### (autoloads (rx rx-to-string) "rx" "emacs-lisp/rx.el" (19845 -;;;;;; 45374)) +;;;### (autoloads (rx rx-to-string) "rx" "emacs-lisp/rx.el" (19965 +;;;;;; 52428)) ;;; Generated autoloads from emacs-lisp/rx.el (autoload 'rx-to-string "rx" "\ @@ -24299,6 +24447,11 @@ CHAR like `and', but makes the match accessible with `match-end', `match-beginning', and `match-string'. +`(submatch-n N SEXP1 SEXP2 ...)' +`(group-n N SEXP1 SEXP2 ...)' + like `group', but make it an explicitly-numbered group with + group number N. + `(or SEXP1 SEXP2 ...)' `(| SEXP1 SEXP2 ...)' matches anything that matches SEXP1 or SEXP2, etc. If all @@ -24505,7 +24658,7 @@ during scrolling. ;;;*** ;;;### (autoloads (semantic-mode semantic-default-submodes) "semantic" -;;;;;; "cedet/semantic.el" (19845 45374)) +;;;;;; "cedet/semantic.el" (19981 40664)) ;;; Generated autoloads from cedet/semantic.el (defvar semantic-default-submodes '(global-semantic-idle-scheduler-mode global-semanticdb-minor-mode) "\ @@ -24556,7 +24709,7 @@ Semantic mode. ;;;;;; mail-yank-prefix mail-setup-hook mail-personal-alias-file ;;;;;; mail-default-reply-to mail-archive-file-name mail-header-separator ;;;;;; send-mail-function mail-interactive mail-self-blind mail-specify-envelope-from -;;;;;; mail-from-style) "sendmail" "mail/sendmail.el" (19935 31309)) +;;;;;; mail-from-style) "sendmail" "mail/sendmail.el" (19980 19797)) ;;; Generated autoloads from mail/sendmail.el (defvar mail-from-style 'default "\ @@ -24835,8 +24988,8 @@ Like `mail' command, but display mail buffer in another frame. ;;;*** ;;;### (autoloads (server-save-buffers-kill-terminal server-mode -;;;;;; server-force-delete server-start) "server" "server.el" (19902 -;;;;;; 34006)) +;;;;;; server-force-delete server-start) "server" "server.el" (19975 +;;;;;; 1875)) ;;; Generated autoloads from server.el (put 'server-host 'risky-local-variable t) @@ -24899,7 +25052,7 @@ only these files will be asked to be saved. ;;;*** -;;;### (autoloads (ses-mode) "ses" "ses.el" (19845 45374)) +;;;### (autoloads (ses-mode) "ses" "ses.el" (19980 19797)) ;;; Generated autoloads from ses.el (autoload 'ses-mode "ses" "\ @@ -25139,7 +25292,7 @@ Set up file shadowing. ;;;*** ;;;### (autoloads (shell shell-dumb-shell-regexp) "shell" "shell.el" -;;;;;; (19935 983)) +;;;;;; (19964 31562)) ;;; Generated autoloads from shell.el (defvar shell-dumb-shell-regexp (purecopy "cmd\\(proxy\\)?\\.exe") "\ @@ -25188,8 +25341,8 @@ Otherwise, one argument `-i' is passed to the shell. ;;;*** -;;;### (autoloads (shr-insert-document) "shr" "gnus/shr.el" (19942 -;;;;;; 4565)) +;;;### (autoloads (shr-insert-document) "shr" "gnus/shr.el" (19976 +;;;;;; 22732)) ;;; Generated autoloads from gnus/shr.el (autoload 'shr-insert-document "shr" "\ @@ -25396,7 +25549,7 @@ symmetrical ones, and the same character twice for the others. ;;;*** ;;;### (autoloads (smerge-start-session smerge-mode smerge-ediff) -;;;;;; "smerge-mode" "vc/smerge-mode.el" (19931 11784)) +;;;;;; "smerge-mode" "vc/smerge-mode.el" (19946 1612)) ;;; Generated autoloads from vc/smerge-mode.el (autoload 'smerge-ediff "smerge-mode" "\ @@ -25439,7 +25592,7 @@ interactively. If there's no argument, do it at the current buffer. ;;;*** ;;;### (autoloads (smtpmail-send-queued-mail smtpmail-send-it) "smtpmail" -;;;;;; "mail/smtpmail.el" (19940 49234)) +;;;;;; "mail/smtpmail.el" (19978 37530)) ;;; Generated autoloads from mail/smtpmail.el (autoload 'smtpmail-send-it "smtpmail" "\ @@ -25745,8 +25898,8 @@ From a program takes two point or marker arguments, BEG and END. ;;;*** -;;;### (autoloads (spam-initialize) "spam" "gnus/spam.el" (19867 -;;;;;; 52471)) +;;;### (autoloads (spam-initialize) "spam" "gnus/spam.el" (19976 +;;;;;; 22732)) ;;; Generated autoloads from gnus/spam.el (autoload 'spam-initialize "spam" "\ @@ -27306,7 +27459,7 @@ Connect to the Emacs talk group from the current X display or tty frame. ;;;*** -;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (19886 45771)) +;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (19977 43600)) ;;; Generated autoloads from tar-mode.el (autoload 'tar-mode "tar-mode" "\ @@ -27486,7 +27639,7 @@ subprocess started. ;;;*** ;;;### (autoloads (testcover-this-defun) "testcover" "emacs-lisp/testcover.el" -;;;;;; (19845 45374)) +;;;;;; (19943 25429)) ;;; Generated autoloads from emacs-lisp/testcover.el (autoload 'testcover-this-defun "testcover" "\ @@ -27984,7 +28137,7 @@ Compose Thai characters in the current buffer. ;;;### (autoloads (list-at-point number-at-point symbol-at-point ;;;;;; sexp-at-point thing-at-point bounds-of-thing-at-point forward-thing) -;;;;;; "thingatpt" "thingatpt.el" (19918 22236)) +;;;;;; "thingatpt" "thingatpt.el" (19980 19797)) ;;; Generated autoloads from thingatpt.el (autoload 'forward-thing "thingatpt" "\ @@ -28402,7 +28555,7 @@ With ARG, turn time stamping on if and only if arg is positive. ;;;;;; timeclock-workday-remaining-string timeclock-reread-log timeclock-query-out ;;;;;; timeclock-change timeclock-status-string timeclock-out timeclock-in ;;;;;; timeclock-modeline-display) "timeclock" "calendar/timeclock.el" -;;;;;; (19909 7240)) +;;;;;; (19981 40664)) ;;; Generated autoloads from calendar/timeclock.el (autoload 'timeclock-modeline-display "timeclock" "\ @@ -28808,7 +28961,7 @@ BUFFER defaults to `trace-buffer'. ;;;### (autoloads (tramp-unload-tramp tramp-completion-handle-file-name-completion ;;;;;; tramp-completion-handle-file-name-all-completions tramp-unload-file-name-handlers ;;;;;; tramp-file-name-handler tramp-syntax tramp-mode) "tramp" -;;;;;; "net/tramp.el" (19924 47209)) +;;;;;; "net/tramp.el" (19981 40664)) ;;; Generated autoloads from net/tramp.el (defvar tramp-mode t "\ @@ -28946,7 +29099,7 @@ Discard Tramp from loading remote files. ;;;*** ;;;### (autoloads (tramp-ftp-enable-ange-ftp) "tramp-ftp" "net/tramp-ftp.el" -;;;;;; (19931 11784)) +;;;;;; (19946 29209)) ;;; Generated autoloads from net/tramp-ftp.el (autoload 'tramp-ftp-enable-ange-ftp "tramp-ftp" "\ @@ -29044,7 +29197,7 @@ First column's text sSs Second column's text ;;;;;; type-break type-break-mode type-break-keystroke-threshold ;;;;;; type-break-good-break-interval type-break-good-rest-interval ;;;;;; type-break-interval type-break-mode) "type-break" "type-break.el" -;;;;;; (19919 43103)) +;;;;;; (19981 40664)) ;;; Generated autoloads from type-break.el (defvar type-break-mode nil "\ @@ -29805,7 +29958,7 @@ Setup variables that expose info about you and your system. ;;;*** ;;;### (autoloads (url-queue-retrieve) "url-queue" "url/url-queue.el" -;;;;;; (19942 4565)) +;;;;;; (19943 25429)) ;;; Generated autoloads from url/url-queue.el (autoload 'url-queue-retrieve "url-queue" "\ @@ -30057,8 +30210,8 @@ If FILE-NAME is non-nil, save the result to FILE-NAME. ;;;;;; vc-print-log vc-retrieve-tag vc-create-tag vc-merge vc-insert-headers ;;;;;; vc-revision-other-window vc-root-diff vc-ediff vc-version-ediff ;;;;;; vc-diff vc-version-diff vc-register vc-next-action vc-before-checkin-hook -;;;;;; vc-checkin-hook vc-checkout-hook) "vc" "vc/vc.el" (19888 -;;;;;; 1100)) +;;;;;; vc-checkin-hook vc-checkout-hook) "vc" "vc/vc.el" (19976 +;;;;;; 22732)) ;;; Generated autoloads from vc/vc.el (defvar vc-checkout-hook nil "\ @@ -30601,7 +30754,7 @@ Key bindings: ;;;*** ;;;### (autoloads (verilog-mode) "verilog-mode" "progmodes/verilog-mode.el" -;;;;;; (19931 11784)) +;;;;;; (19973 46551)) ;;; Generated autoloads from progmodes/verilog-mode.el (autoload 'verilog-mode "verilog-mode" "\ @@ -31382,7 +31535,7 @@ Convert Vietnamese characters of the current buffer to `VIQR' mnemonics. ;;;;;; view-mode view-buffer-other-frame view-buffer-other-window ;;;;;; view-buffer view-file-other-frame view-file-other-window ;;;;;; view-file kill-buffer-if-not-modified view-remove-frame-by-deleting) -;;;;;; "view" "view.el" (19886 45771)) +;;;;;; "view" "view.el" (19958 33091)) ;;; Generated autoloads from view.el (defvar view-remove-frame-by-deleting t "\ @@ -31469,15 +31622,16 @@ EXIT-ACTION to `kill-buffer-if-not-modified' avoids this. (autoload 'view-buffer-other-window "view" "\ View BUFFER in View mode in another window. -Return to previous buffer when done, unless optional NOT-RETURN is -non-nil. Emacs commands editing the buffer contents are not available; -instead, a special set of commands (mostly letters and punctuation) are -defined for moving around in the buffer. +Emacs commands editing the buffer contents are not available; +instead, a special set of commands (mostly letters and +punctuation) are defined for moving around in the buffer. Space scrolls forward, Delete scrolls backward. For a list of all View commands, type H or h while viewing. This command runs the normal hook `view-mode-hook'. +Optional argument NOT-RETURN is ignored. + Optional argument EXIT-ACTION is either nil or a function with buffer as argument. This function is called when finished viewing buffer. Use this argument instead of explicitly setting `view-exit-action'. @@ -31486,15 +31640,16 @@ this argument instead of explicitly setting `view-exit-action'. (autoload 'view-buffer-other-frame "view" "\ View BUFFER in View mode in another frame. -Return to previous buffer when done, unless optional NOT-RETURN is -non-nil. Emacs commands editing the buffer contents are not available; -instead, a special set of commands (mostly letters and punctuation) are -defined for moving around in the buffer. +Emacs commands editing the buffer contents are not available; +instead, a special set of commands (mostly letters and +punctuation) are defined for moving around in the buffer. Space scrolls forward, Delete scrolls backward. For a list of all View commands, type H or h while viewing. This command runs the normal hook `view-mode-hook'. +Optional argument NOT-RETURN is ignored. + Optional argument EXIT-ACTION is either nil or a function with buffer as argument. This function is called when finished viewing buffer. Use this argument instead of explicitly setting `view-exit-action'. @@ -31595,31 +31750,20 @@ entry for the selected window, purge that entry from (autoload 'view-mode-enter "view" "\ Enter View mode and set up exit from view mode depending on optional arguments. -RETURN-TO non-nil means add RETURN-TO as an element to the buffer -local alist `view-return-to-alist'. Save EXIT-ACTION in buffer -local variable `view-exit-action'. It should be either nil or a +Optional argument QUIT-RESTORE if non-nil must specify a valid +entry for quitting and restoring any window showing the current +buffer. This entry replaces any parameter installed by +`display-buffer' and is used by `view-mode-exit'. + +Optional argument EXIT-ACTION, if non-nil, must specify a function that takes a buffer as argument. This function will be called by `view-mode-exit'. -RETURN-TO is either nil, meaning do nothing when exiting view -mode, or must have the format (WINDOW OLD-WINDOW . OLD-BUF-INFO). -WINDOW is the window used for viewing. OLD-WINDOW is nil or the -window to select after viewing. OLD-BUF-INFO tells what to do -with WINDOW when exiting. It is one of: -1) nil Do nothing. -2) t Delete WINDOW or, if it is the only window and - `view-remove-frame-by-deleting' is non-nil, its - frame. -3) (OLD-BUFF START POINT) Display buffer OLD-BUFF with displayed text - starting at START and point at POINT in WINDOW. -4) quit-window Do `quit-window' in WINDOW. -5) keep-frame Like case 2) but do not delete the frame. - For a list of all View commands, type H or h while viewing. This function runs the normal hook `view-mode-hook'. -\(fn &optional RETURN-TO EXIT-ACTION)" nil nil) +\(fn &optional QUIT-RESTORE EXIT-ACTION)" nil nil) (autoload 'View-exit-and-edit "view" "\ Exit View mode and make the current buffer editable. @@ -32246,8 +32390,8 @@ With arg, turn widget mode on if and only if arg is positive. ;;;*** ;;;### (autoloads (widget-setup widget-insert widget-delete widget-create -;;;;;; widget-prompt-value widgetp) "wid-edit" "wid-edit.el" (19927 -;;;;;; 37225)) +;;;;;; widget-prompt-value widgetp) "wid-edit" "wid-edit.el" (19968 +;;;;;; 28627)) ;;; Generated autoloads from wid-edit.el (autoload 'widgetp "wid-edit" "\ @@ -32363,7 +32507,7 @@ With arg, turn Winner mode on if and only if arg is positive. ;;;*** ;;;### (autoloads (woman-bookmark-jump woman-find-file woman-dired-find-file -;;;;;; woman woman-locale) "woman" "woman.el" (19886 45771)) +;;;;;; woman woman-locale) "woman" "woman.el" (19981 40664)) ;;; Generated autoloads from woman.el (defvar woman-locale nil "\ @@ -32872,7 +33016,7 @@ Zone out, completely. ;;;;;; "vc/ediff-ptch.el" "vc/ediff-vers.el" "vc/ediff-wind.el" ;;;;;; "vc/pcvs-info.el" "vc/pcvs-parse.el" "vc/pcvs-util.el" "vc/vc-dav.el" ;;;;;; "vcursor.el" "vt-control.el" "vt100-led.el" "w32-fns.el" -;;;;;; "w32-vars.el" "x-dnd.el") (19942 4644 183664)) +;;;;;; "w32-vars.el" "x-dnd.el") (19981 41048 99944)) ;;;*** diff --git a/lisp/loadhist.el b/lisp/loadhist.el index 8e00c33cd81..943eac42b02 100644 --- a/lisp/loadhist.el +++ b/lisp/loadhist.el @@ -143,6 +143,19 @@ documentation of `unload-feature' for details.") (define-obsolete-variable-alias 'unload-hook-features-list 'unload-function-defs-list "22.2") +(defun unload--set-major-mode () + (save-current-buffer + (dolist (buffer (buffer-list)) + (set-buffer buffer) + (let ((proposed major-mode)) + ;; Look for an antecessor mode not defined in the feature we're processing + (while (and proposed (rassq proposed unload-function-defs-list)) + (setq proposed (get proposed 'derived-mode-parent))) + (unless (eq proposed major-mode) + ;; Two cases: either proposed is nil, and we want to switch to fundamental + ;; mode, or proposed is not nil and not major-mode, and so we use it. + (funcall (or proposed 'fundamental-mode))))))) + ;;;###autoload (defun unload-feature (feature &optional force) "Unload the library that provided FEATURE. @@ -222,6 +235,10 @@ something strange, such as redefining an Emacs function." (not (get (cdr y) 'autoload))) (setq auto-mode-alist (rassq-delete-all (cdr y) auto-mode-alist))))) + + ;; Change major mode in all buffers using one defined in the feature being unloaded. + (unload--set-major-mode) + (when (fboundp 'elp-restore-function) ; remove ELP stuff first (dolist (elt unload-function-defs-list) (when (symbolp elt) diff --git a/lisp/longlines.el b/lisp/longlines.el index 387ce394f50..e81a235a17b 100644 --- a/lisp/longlines.el +++ b/lisp/longlines.el @@ -95,11 +95,15 @@ This is used when `longlines-show-hard-newlines' is on." ;;;###autoload (define-minor-mode longlines-mode - "Toggle Long Lines mode. + "Minor mode to wrap long lines. In Long Lines mode, long lines are wrapped if they extend beyond `fill-column'. The soft newlines used for line wrapping will not show up when the text is yanked or saved to disk. +With no argument, this command toggles Flyspell mode. +With a prefix argument ARG, turn Flyspell minor mode on if ARG is positive, +otherwise turn it off. + If the variable `longlines-auto-wrap' is non-nil, lines are automatically wrapped whenever the buffer is changed. You can always call `fill-paragraph' to fill individual paragraphs. diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index 6b062f2298f..0722227d3d2 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -150,8 +150,8 @@ Prompts for bug subject. Leaves you in a mail buffer." ;; Put these properties on semantically-void text. ;; report-emacs-bug-hook deletes these regions before sending. (prompt-properties '(field emacsbug-prompt - intangible but-helpful - rear-nonsticky t)) + intangible but-helpful + rear-nonsticky t)) (can-insert-mail (or (report-emacs-bug-can-use-xdg-email) (report-emacs-bug-can-use-osx-open))) user-point message-end-point) @@ -175,25 +175,36 @@ Prompts for bug subject. Leaves you in a mail buffer." (backward-char (length signature))) (unless report-emacs-bug-no-explanations ;; Insert warnings for novice users. - (when (string-match "@gnu\\.org$" report-emacs-bug-address) - (insert "This bug report will be sent to the Free Software Foundation,\n") - (let ((pos (point))) - (insert "not to your local site managers!") - (overlay-put (make-overlay pos (point)) 'face 'highlight))) - (insert "\nPlease write in ") - (let ((pos (point))) - (insert "English") - (overlay-put (make-overlay pos (point)) 'face 'highlight)) - (insert " if possible, because the Emacs maintainers -usually do not have translators to read other languages for them.\n\n") - (insert "Please check that the From: line gives an address where you can be reached.\n") - (insert (format "Your report will be posted to the %s mailing list" - report-emacs-bug-address)) - (insert "\nand the gnu.emacs.bug news group, and at http://debbugs.gnu.org.\n\n")) - - (insert "Please describe exactly what actions triggered the bug\n" - "and the precise symptoms of the bug. If you can, give\n" - "a recipe starting from `emacs -Q':\n\n") + (if (not (equal "bug-gnu-emacs@gnu.org" report-emacs-bug-address)) + (insert (format "The report will be sent to %s.\n\n" + report-emacs-bug-address)) + (insert "This bug report will be sent to the ") + (insert-button + "Bug-GNU-Emacs" + 'face 'link + 'help-echo (concat "mouse-2, RET: Follow this link") + 'action (lambda (button) + (browse-url "http://lists.gnu.org/archive/html/bug-gnu-emacs/")) + 'follow-link t) + (insert " mailing list\nand the GNU bug tracker at ") + (insert-button + "debbugs.gnu.org" + 'face 'link + 'help-echo (concat "mouse-2, RET: Follow this link") + 'action (lambda (button) + (browse-url "http://debbugs.gnu.org/")) + 'follow-link t) + + (insert ". Please check that +the From: line contains a valid email address. After a delay of up +to one day, you should receive an acknowledgement at that address. + +Please write in English if possible, as the Emacs maintainers +usually do not have translators for other languages.\n\n"))) + + (insert "Please describe exactly what actions triggered the bug, and\n" + "the precise symptoms of the bug. If you can, give a recipe\n" + "starting from `emacs -Q':\n\n") (add-text-properties (save-excursion (rfc822-goto-eoh) (line-beginning-position 2)) diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index 934637ecbbd..f4b29958aab 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -351,7 +351,7 @@ ;; systems with non-classic /bin/[r]mail behavior ;; guard against nil user-mail-address in generating MESSAGE-ID: ;; feedmail-queue-slug-suspect-regexp is now a variable to -;; accomodate non-ASCII environments (thanks to +;; accommodate non-ASCII environments (thanks to ;; Makoto.Nakagawa@jp.compaq.com for this suggestion) ;; feedmail-buffer-to-smtp, to parallel feedmail-buffer-to-smtpmail ;; patchlevel 10, 22 April 2001 @@ -1633,22 +1633,21 @@ local gurus." ;; no evil. (feedmail-say-debug ">in-> feedmail-buffer-to-smtpmail %s" addr-listoid) (require 'smtpmail) - (if (not (smtpmail-via-smtp addr-listoid prepped)) - (progn - (set-buffer errors-to) - (insert "Send via smtpmail failed. Probable SMTP protocol error.\n") - (insert "Look for details below or in the *Messages* buffer.\n\n") - (let ((case-fold-search t) - ;; don't be overconfident about the name of the trace buffer - (tracer (concat "trace.*smtp.*" (regexp-quote smtpmail-smtp-server)))) - (mapcar - (lambda (buffy) - (if (string-match tracer (buffer-name buffy)) - (progn - (insert "SMTP Trace from " (buffer-name buffy) "\n---------------") - (insert-buffer-substring buffy) - (insert "\n\n")))) - (buffer-list)))))) + (let ((result (smtpmail-via-smtp addr-listoid prepped))) + (when result + (set-buffer errors-to) + (insert "Send via smtpmail failed: %s" result) + (let ((case-fold-search t) + ;; don't be overconfident about the name of the trace buffer + (tracer (concat "trace.*smtp.*" (regexp-quote smtpmail-smtp-server)))) + (mapcar + (lambda (buffy) + (if (string-match tracer (buffer-name buffy)) + (progn + (insert "SMTP Trace from " (buffer-name buffy) "\n---------------") + (insert-buffer-substring buffy) + (insert "\n\n")))) + (buffer-list)))))) (declare-function smtp-via-smtp "ext:smtp" (sender recipients smtp-text-buffer)) (defvar smtp-server) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 200aadda651..02f78635e26 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -349,7 +349,7 @@ If nil, display all header fields except those matched by :group 'rmail-headers) ;;;###autoload -(defcustom rmail-retry-ignored-headers (purecopy "^x-authentication-warning:\\|^x-detected-operating-system:\\|^x-spam[-a-z]*:\\|content-type:\\|content-transfer-encoding:\\|mime-version:") +(defcustom rmail-retry-ignored-headers (purecopy "^x-authentication-warning:\\|^x-detected-operating-system:\\|^x-spam[-a-z]*:\\|content-type:\\|content-transfer-encoding:\\|mime-version:\\|message-id:") "Headers that should be stripped when retrying a failed message." :type '(choice regexp (const nil :tag "None")) :group 'rmail-headers @@ -1444,7 +1444,8 @@ If so restore the actual mbox message collection." (make-local-variable 'file-precious-flag) (setq file-precious-flag t) (make-local-variable 'desktop-save-buffer) - (setq desktop-save-buffer t)) + (setq desktop-save-buffer t) + (setq next-error-move-function 'rmail-next-error-move)) ;; Handle M-x revert-buffer done in an rmail-mode buffer. (defun rmail-revert (arg noconfirm) @@ -2669,8 +2670,11 @@ The current mail message becomes the message displayed." (t (setq rmail-current-message msg))) (with-current-buffer rmail-buffer (setq header-style rmail-header-style) - ;; Mark the message as seen - (rmail-set-attribute rmail-unseen-attr-index nil) + ;; Mark the message as seen, but preserve buffer modified flag. + (let ((modiff (buffer-modified-p))) + (rmail-set-attribute rmail-unseen-attr-index nil) + (unless modiff + (restore-buffer-modified-p modiff))) ;; bracket the message in the mail ;; buffer and determine the coding system the transfer encoding. (rmail-swap-buffers-maybe) @@ -3016,15 +3020,73 @@ or forward if N is negative." (rmail-maybe-set-message-counters) (rmail-show-message rmail-total-messages)) -(defun rmail-what-message () - "For debugging Rmail: find the message number that point is in." +(defun rmail-next-error-move (msg-pos bad-marker) + "Move to an error locus (probably grep hit) in an Rmail buffer. +MSG-POS is a marker pointing at the error message in the grep buffer. +BAD-MARKER is a marker that ought to point at where to move to, +but probably is garbage." + (let* ((message (car (get-text-property msg-pos 'message (marker-buffer msg-pos)))) + (column (car message)) + (linenum (cadr message)) + pos + msgnum msgbeg msgend + header-field + line-number-within) + + ;; Look at the whole Rmail file. + (rmail-swap-buffers-maybe) + + (save-restriction + (widen) + (save-excursion + ;; Find the line that the error message points at. + (goto-char (point-min)) + (forward-line linenum) + (setq pos (point)) + + ;; Find which message that's in, + ;; and the limits of that message. + (setq msgnum (rmail-what-message pos)) + (setq msgbeg (rmail-msgbeg msgnum)) + (setq msgend (rmail-msgend msgnum)) + + ;; Find which header this locus is in, + ;; or if it's in the message body, + ;; and the line-based position within that. + (goto-char msgbeg) + (let ((header-end msgend)) + (if (search-forward "\n\n" nil t) + (setq header-end (point))) + (if (>= pos header-end) + (setq line-number-within + (count-lines header-end pos)) + (goto-char pos) + (unless (looking-at "^[^ \t]") + (re-search-backward "^[^ \t]")) + (looking-at "[^:\n]*[:\n]") + (setq header-field (match-string 0) + line-number-within (count-lines (point) pos)))))) + + ;; Display the right message. + (rmail-show-message msgnum) + + ;; Move to the right position within the displayed message. + (if header-field + (re-search-forward (concat "^" (regexp-quote header-field)) nil t) + (search-forward "\n\n" nil t)) + (forward-line line-number-within) + (forward-char column))) + +(defun rmail-what-message (&optional pos) + "Return message number POS (or point) is in." (let* ((high rmail-total-messages) (mid (/ high 2)) (low 1) - (where (with-current-buffer (if (rmail-buffers-swapped-p) - rmail-view-buffer - (current-buffer)) - (point)))) + (where (or pos + (with-current-buffer (if (rmail-buffers-swapped-p) + rmail-view-buffer + (current-buffer)) + (point))))) (while (> (- high low) 1) (if (>= where (rmail-msgbeg mid)) (setq low mid) @@ -3455,15 +3517,15 @@ does not pop any summary buffer." (if (stringp subject) (setq subject (rfc2047-decode-string subject))) (prog1 (compose-mail to subject other-headers noerase - switch-function yank-action sendactions - '(rmail-mail-return)) + switch-function yank-action sendactions) (if (eq switch-function 'switch-to-buffer-other-frame) ;; This is not a standard frame parameter; nothing except ;; sendmail.el looks at it. (modify-frame-parameters (selected-frame) '((mail-dedicated-frame . t))))))) -(defun rmail-mail-return () +(defun rmail-mail-return (&optional newbuf) + "NEWBUF is a buffer to switch to." (cond ;; If there is only one visible frame with no special handling, ;; consider deleting the mail window to return to Rmail. @@ -3488,7 +3550,8 @@ does not pop any summary buffer." (if rmail-flag ;; If the Rmail buffer has a summary, show that. (if summary-buffer (switch-to-buffer summary-buffer) - (delete-window))))) + (delete-window)) + (switch-to-buffer newbuf)))) ;; If the frame was probably made for this buffer, the user ;; probably wants to delete it now. ((display-multi-frame-p) @@ -4316,7 +4379,7 @@ With prefix argument N moves forward N messages with these labels. ;;;*** -;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "c530622b53038152ca84f2ec9313bd7a") +;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "30ab95e291380f184dff5fa6cde75520") ;;; Generated autoloads from rmailmm.el (autoload 'rmail-mime "rmailmm" "\ diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el index a02d388a6f7..597068562b5 100644 --- a/lisp/mail/rmailmm.el +++ b/lisp/mail/rmailmm.el @@ -153,20 +153,21 @@ MIME entities.") ;;; MIME-entity object (defun rmail-mime-entity (type disposition transfer-encoding - display header tagline body children handler) + display header tagline body children handler + &optional truncated) "Retrun a newly created MIME-entity object from arguments. -A MIME-entity is a vector of 9 elements: +A MIME-entity is a vector of 10 elements: [TYPE DISPOSITION TRANSFER-ENCODING DISPLAY HEADER TAGLINE BODY - CHILDREN HANDLER] + CHILDREN HANDLER TRUNCATED] TYPE and DISPOSITION correspond to MIME headers Content-Type and -Cotent-Disposition respectively, and has this format: +Content-Disposition respectively, and have this format: \(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...) -VALUE is a string and ATTRIBUTE is a symbol. +Each VALUE is a string and each ATTRIBUTE is a string. Consider the following header, for example: @@ -192,8 +193,8 @@ has these values: raw: displayed by the raw MIME data (for the header and body only) HEADER and BODY are vectors [BEG END DISPLAY-FLAG], where BEG and -END specify the region of the header or body lines in RMAIL's -data (mbox) buffer, and DISPLAY-FLAG non-nil means that the +END are markers that specify the region of the header or body lines +in RMAIL's data (mbox) buffer, and DISPLAY-FLAG non-nil means that the header or body is, by default, displayed by the decoded presentation form. @@ -208,9 +209,12 @@ entity have one or more children. A \"message/rfc822\" entity has just one child. Any other entity has no child. HANDLER is a function to insert the entity according to DISPLAY. -It is called with one argument ENTITY." +It is called with one argument ENTITY. + +TRUNCATED is non-nil if the text of this entity was truncated." + (vector type disposition transfer-encoding - display header tagline body children handler)) + display header tagline body children handler truncated)) ;; Accessors for a MIME-entity object. (defsubst rmail-mime-entity-type (entity) (aref entity 0)) @@ -222,6 +226,9 @@ It is called with one argument ENTITY." (defsubst rmail-mime-entity-body (entity) (aref entity 6)) (defsubst rmail-mime-entity-children (entity) (aref entity 7)) (defsubst rmail-mime-entity-handler (entity) (aref entity 8)) +(defsubst rmail-mime-entity-truncated (entity) (aref entity 9)) +(defsubst rmail-mime-entity-set-truncated (entity truncated) + (aset entity 9 truncated)) (defsubst rmail-mime-message-p () "Non-nil if and only if the current message is a MIME." @@ -237,6 +244,10 @@ It is called with one argument ENTITY." (directory (button-get button 'directory)) (data (button-get button 'data)) (ofilename filename)) + (if (and (not (stringp data)) + (rmail-mime-entity-truncated data)) + (unless (y-or-n-p "This entity is truncated; save anyway? ") + (error "Aborted"))) (setq filename (expand-file-name (read-file-name (format "Save as (default: %s): " filename) directory @@ -387,6 +398,11 @@ The value is a vector [ INDEX HEADER TAGLINE BODY END], where (if (and rmail-mime-mbox-buffer (= (aref segment 1) (point-min))) (let ((new (aref (rmail-mime-entity-display entity) 1))) (aset new 0 t)))) + ;; Query as a warning before showing if truncated. + (if (and (not (stringp entity)) + (rmail-mime-entity-truncated entity)) + (unless (y-or-n-p "This entity is truncated; show anyway? ") + (error "Aborted"))) ;; Enter the shown mode. (rmail-mime-shown-mode entity) ;; Force this body shown. @@ -531,7 +547,7 @@ HEADER is a header component of a MIME-entity object (see (beg (point)) (segment (rmail-mime-entity-segment (point) entity))) - (or (integerp (aref body 0)) + (or (integerp (aref body 0)) (markerp (aref body 0)) (let ((data (buffer-string))) (aset body 0 data) (delete-region (point-min) (point-max)))) @@ -688,7 +704,7 @@ directly." (segment (rmail-mime-entity-segment (point) entity)) beg data size) - (if (integerp (aref body 0)) + (if (or (integerp (aref body 0)) (markerp (aref body 0))) (setq data entity size (car bulk-data)) (if (stringp (aref body 0)) @@ -816,7 +832,7 @@ The other arguments are the same as `rmail-mime-multipart-handler'." (let ((boundary (cdr (assq 'boundary content-type))) (subtype (cadr (split-string (car content-type) "/"))) (index 0) - beg end next entities) + beg end next entities truncated) (unless boundary (rmail-mm-get-boundary-error-message "No boundary defined" content-type content-disposition @@ -843,8 +859,18 @@ The other arguments are the same as `rmail-mime-multipart-handler'." ;; the beginning of the next part. The current point is just ;; after the boundary tag. (setq beg (point-min)) - (while (search-forward boundary nil t) - (setq end (match-beginning 0)) + + (while (or (and (search-forward boundary nil t) + (setq truncated nil end (match-beginning 0))) + ;; If the boundary does not appear at all, + ;; the message was truncated. + ;; Handle the rest of the truncated message + ;; (if it isn't empty) by pretending that the boundary + ;; appears at the end of the message. + (and (save-excursion + (skip-chars-forward "\n") + (> (point-max) (point))) + (setq truncated t end (point-max)))) ;; If this is the last boundary according to RFC 2046, hide the ;; epilogue, else hide the boundary only. Use a marker for ;; `next' because `rmail-mime-show' may change the buffer. @@ -852,6 +878,9 @@ The other arguments are the same as `rmail-mime-multipart-handler'." (setq next (point-max-marker))) ((looking-at "[ \t]*\n") (setq next (copy-marker (match-end 0) t))) + (truncated + ;; We're handling what's left of a truncated message. + (setq next (point-max-marker))) (t ;; The original code signalled an error as below, but ;; this line may be a boundary of nested multipart. So, @@ -873,6 +902,7 @@ The other arguments are the same as `rmail-mime-multipart-handler'." ;; Display a tagline. (aset (aref (rmail-mime-entity-display child) 1) 1 (aset (rmail-mime-entity-tagline child) 2 t)) + (rmail-mime-entity-set-truncated child truncated) (push child entities))) (delete-region end next) @@ -1099,9 +1129,10 @@ modified." (if parse-tag (let* ((is-inline (string= (car content-disposition) "inline")) - (header (vector (point-min) end nil)) + (hdr-end (copy-marker end)) + (header (vector (point-min-marker) hdr-end nil)) (tagline (vector parse-tag (cons nil nil) t)) - (body (vector end (point-max) is-inline)) + (body (vector hdr-end (point-max-marker) is-inline)) (new (vector (aref header 2) (aref tagline 2) (aref body 2))) children handler entity) (cond ((string-match "multipart/.*" (car content-type)) @@ -1150,11 +1181,11 @@ modified." ;; Hide headers and handle the part. (put-text-property (point-min) (point-max) 'rmail-mime-entity (rmail-mime-entity - content-type content-disposition - content-transfer-encoding - (vector (vector 'raw nil 'raw) (vector 'raw nil 'raw)) - (vector nil nil 'raw) (vector "" (cons nil nil) nil) - (vector nil nil 'raw) nil nil)) + content-type content-disposition + content-transfer-encoding + (vector (vector 'raw nil 'raw) (vector 'raw nil 'raw)) + (vector nil nil 'raw) (vector "" (cons nil nil) nil) + (vector nil nil 'raw) nil nil)) (save-restriction (cond ((string= (car content-type) "message/rfc822") (narrow-to-region end (point-max))) @@ -1378,6 +1409,8 @@ This is the usual value of `rmail-insert-mime-forwarded-message-function'." (re-search-forward regexp nil t)) ;; Next, search the body. (if (and entity + ;; RMS: I am not sure why, but sometimes this is a string. + (not (stringp entity)) (let* ((content-type (rmail-mime-entity-type entity)) (charset (cdr (assq 'charset (cdr content-type))))) (or (not (string-match "text/.*" (car content-type))) diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index c1405ec5ff3..6480d6a393f 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -144,19 +144,11 @@ Otherwise, let mailer send back a message to report errors." ;;;###autoload (put 'send-mail-function 'standard-value ;; MS-Windows can access the clipboard even under -nw. - '((if (or (and window-system (eq system-type 'darwin)) - (eq system-type 'windows-nt)) - 'mailclient-send-it - 'sendmail-send-it))) + '('sendmail-query-once)) ;; Useful to set in site-init.el ;;;###autoload -(defcustom send-mail-function - (if (or (and window-system (eq system-type 'darwin)) - ;; MS-Windows can access the clipboard even under -nw. - (eq system-type 'windows-nt)) - 'mailclient-send-it - 'sendmail-send-it) +(defcustom send-mail-function 'sendmail-query-once "Function to call to send the current buffer as mail. The headers should be delimited by a line which is not a valid RFC822 header or continuation line, @@ -164,13 +156,58 @@ that matches the variable `mail-header-separator'. This is used by the default mail-sending commands. See also `message-send-mail-function' for use with the Message package." :type '(radio (function-item sendmail-send-it :tag "Use Sendmail package") + (function-item sendmail-query-once :tag "Query the user") (function-item smtpmail-send-it :tag "Use SMTPmail package") (function-item feedmail-send-it :tag "Use Feedmail package") (function-item mailclient-send-it :tag "Use Mailclient package") function) :initialize 'custom-initialize-delay + :version "24.1" :group 'sendmail) +(defvar sendmail-query-once-function 'query + "Either a function to send email, or the symbol `query'.") + +;;;###autoload +(defun sendmail-query-once () + "Send an email via `sendmail-query-once-function'. +If `sendmail-query-once-function' is `query', ask the user what +function to use, and then save that choice." + (when (equal sendmail-query-once-function 'query) + (let ((default + (cond + ((or (and window-system (eq system-type 'darwin)) + (eq system-type 'windows-nt)) + 'mailclient-send-it) + ((and sendmail-program + (executable-find sendmail-program)) + 'sendmail-send-it)))) + (customize-save-variable + 'sendmail-query-once-function + (if (or (not default) + ;; We have detected no OS-level mail senders, or we + ;; have already configured smtpmail, so we use the + ;; internal SMTP service. + (and (boundp 'smtpmail-smtp-server) + smtpmail-smtp-server)) + 'smtpmail-send-it + ;; Query the user. + (unwind-protect + (progn + (pop-to-buffer "*Mail Help*") + (erase-buffer) + (insert "Sending mail from Emacs hasn't been set up yet.\n\n" + "Type `y' to configure outgoing SMTP, or `n' to use\n" + "the default mail sender on your system.\n\n" + "To change this again at a later date, customize the\n" + "`send-mail-function' variable.\n") + (goto-char (point-min)) + (if (y-or-n-p "Configure outgoing SMTP in Emacs? ") + 'smtpmail-send-it + default)) + (kill-buffer (current-buffer))))))) + (funcall sendmail-query-once-function)) + ;;;###autoload(custom-initialize-delay 'send-mail-function nil) ;;;###autoload diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 3c9ea9de573..1b53b47499b 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -71,9 +71,11 @@ :group 'mail) -(defvar smtpmail-default-smtp-server nil +(defcustom smtpmail-default-smtp-server nil "Specify default SMTP server. -This only has effect if you specify it before loading the smtpmail library.") +This only has effect if you specify it before loading the smtpmail library." + :type '(choice (const nil) string) + :group 'smtpmail) (defcustom smtpmail-smtp-server (or (getenv "SMTPSERVER") smtpmail-default-smtp-server) @@ -488,9 +490,9 @@ The list is in preference order.") (secret . "SMTP password for %u@%h: "))) (auth-info (car (auth-source-search - :max 1 :host host :port port + :max 1 :require (and ask-for-password '(:user :secret)) :create ask-for-password))) @@ -615,6 +617,8 @@ The list is in preference order.") (and mail-specify-envelope-from (mail-envelope-from)) user-mail-address)) + (coding-system-for-read 'binary) + (coding-system-for-write 'binary) response-code process-buffer result @@ -651,7 +655,9 @@ The list is in preference order.") ;; If we couldn't access the server at all, we give up. (unless (setq process (car result)) - (throw 'done "Unable to contact server")) + (throw 'done (if (plist-get (cdr result) :error) + (plist-get (cdr result) :error) + "Unable to contact server"))) ;; set the send-filter (set-process-filter process 'smtpmail-process-filter) diff --git a/lisp/man.el b/lisp/man.el index 7a9e6e3cca5..b5a70395e59 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -276,7 +276,9 @@ This regexp should not start with a `^' character.") This regular expression should start with a `^' character.") (defvar Man-reference-regexp - (concat "\\(" Man-name-regexp "\\)[ \t]*(\\(" Man-section-regexp "\\))") + (concat "\\(" Man-name-regexp + "\\(\n[ \t]+" Man-name-regexp "\\)*\\)[ \t]*(\\(" + Man-section-regexp "\\))") "Regular expression describing a reference to another manpage.") (defvar Man-apropos-regexp @@ -597,8 +599,8 @@ and the `Man-section-translations-alist' variables)." (cond ;; "chmod(2V)" case ? ((string-match (concat "^" Man-reference-regexp "$") ref) - (setq name (match-string 1 ref) - section (match-string 2 ref))) + (setq name (replace-regexp-in-string "[\n\t ]" "" (match-string 1 ref)) + section (match-string 3 ref))) ;; "2v chmod" case ? ((string-match (concat "^\\(" Man-section-regexp "\\) +\\(" Man-name-regexp "\\)$") ref) diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog index 93e486adb0f..365c444d591 100644 --- a/lisp/mh-e/ChangeLog +++ b/lisp/mh-e/ChangeLog @@ -1,3 +1,36 @@ +2011-07-04 Bill Wohler <wohler@newt.com> + + * mh-e.el: Just require mh-loaddefs since loading it in an + eval-and-compile block causes compilation errors in XEmacs. + + * mh-acros.el, mh-comp.el, mh-e.el, mh-folder.el, mh-letter.el: + * mh-mime.el, mh-search.el, mh-seq.el: Shush XEmacs compiler in + mh-do-in-xemacs block. + + * mh-compat.el (mh-window-full-height-p): Add compatibility + function for XEmacs. + * mh-show.el (mh-show-msg): Use it, and avoid compiler warning on + XEmacs. + + * mh-letter.el (mh-letter-mode-map, mh-letter-complete) + (mh-complete-word): Remove FIXME comments since these functions + are still needed in other Emacsen. However, they can probably + stand to be generalized like completion-at-point. + (mh-letter-complete-or-space): Remove unused variable. + +2011-07-03 Bill Wohler <wohler@newt.com> + + * mh-compat.el (mh-test-completion): Add compatibility function + for XEmacs. + * mh-alias.el (mh-alias-letter-expand-alias): Use it, and avoid + compiler warning on XEmacs. + + * mh-utils.el: + * mh-mime.el: Shush XEmacs compiler in mh-do-in-xemacs block. + + * mh-folder.el: Use boundp instead of fboundp when testing + existence of desktop-buffer-mode-handlers. + 2011-05-10 Jim Meyering <meyering@redhat.com> Fix doubled-word typos. diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el index c1964d5a4ea..2144eef7308 100644 --- a/lisp/mh-e/mh-acros.el +++ b/lisp/mh-e/mh-acros.el @@ -132,9 +132,10 @@ check if variable `transient-mark-mode' is active." (boundp 'mark-active) mark-active)))) ;; Shush compiler. -(defvar struct) ; XEmacs -(defvar x) ; XEmacs -(defvar y) ; XEmacs +(mh-do-in-xemacs + (defvar struct) + (defvar x) + (defvar y)) ;;;###mh-autoload (defmacro mh-defstruct (name-spec &rest fields) diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el index 2df6025bf09..d1b3ccebf46 100644 --- a/lisp/mh-e/mh-alias.el +++ b/lisp/mh-e/mh-alias.el @@ -316,8 +316,7 @@ Blind aliases or users from /etc/passwd are not expanded." res) res))) ((t) (all-completions string mh-alias-alist pred)) - ((lambda) (if (fboundp 'test-completion) - (test-completion string mh-alias-alist pred)))))))))) + ((lambda) (mh-test-completion string mh-alias-alist pred))))))))) ;;; Alias File Updating diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el index 169679e88ae..1aa57316f50 100644 --- a/lisp/mh-e/mh-comp.el +++ b/lisp/mh-e/mh-comp.el @@ -223,7 +223,8 @@ RETURN-ACTION are ignored." (setq other-headers (cdr other-headers))))) ;; Shush compiler. -(defvar sendmail-coding-system) ; XEmacs +(mh-do-in-xemacs + (defvar sendmail-coding-system)) ;;;###autoload (defun mh-send-letter (&optional arg) diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el index 01a0f26b9e8..ae2cbff408f 100644 --- a/lisp/mh-e/mh-compat.el +++ b/lisp/mh-e/mh-compat.el @@ -122,6 +122,16 @@ introduced in Emacs 22." "XEmacs does not have `font-lock-add-keywords'. This function returns nil on that system.") +(defun-mh mh-window-full-height-p + window-full-height-p (&optional WINDOW) + "Return non-nil if WINDOW is not the result of a vertical split. +This function is defined in XEmacs as it lacks +`window-full-height-p'. The values of the functions +`window-height' and `frame-height' are compared instead. The +argument WINDOW is ignored." + (= (1+ (window-height)) + (frame-height))) + (defun-mh mh-image-load-path-for-library image-load-path-for-library (library image &optional path no-error) "Return a suitable search path for images used by LIBRARY. @@ -260,6 +270,12 @@ The arguments FIXEDCASE, SUBEXP, and START, used by `replace-in-string' are ignored." (replace-in-string string regexp rep literal)) +(defun-mh mh-test-completion + test-completion (string collection &optional predicate) + "Return non-nil if STRING is a valid completion. +XEmacs does not have `test-completion'. This function returns nil +on that system." nil) + ;; Copy of constant from url-util.el in Emacs 22; needed by Emacs 21. (if (not (boundp 'url-unreserved-chars)) (defconst mh-url-unreserved-chars diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index 90803d183d2..87272b1c83b 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -90,10 +90,7 @@ ;; Provide functions to the rest of MH-E. However, mh-e.el must not ;; use any definitions in files that require mh-e from mh-loaddefs, ;; for if it does it will introduce a require loop. -(eval-and-compile - ;; Load it during compilation as well, since it defines the macro - ;; mh-require-cl. - (load "mh-loaddefs" nil 'nomessage)) +(require 'mh-loaddefs) (mh-require-cl) @@ -616,7 +613,8 @@ Output is expected to be shown to user, not parsed by MH-E." (mh-exchange-point-and-mark-preserving-active-mark)) ;; Shush compiler. -(defvar mark-active) ; XEmacs +(mh-do-in-xemacs + (defvar mark-active)) (defun mh-exchange-point-and-mark-preserving-active-mark () "Put the mark where point is now, and point where the mark is now. diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el index aab40c7be13..40febd641de 100644 --- a/lisp/mh-e/mh-folder.el +++ b/lisp/mh-e/mh-folder.el @@ -77,7 +77,7 @@ the MH mail system." ;;; Desktop Integration ;; desktop-buffer-mode-handlers appeared in Emacs 22. -(if (fboundp 'desktop-buffer-mode-handlers) +(if (boundp 'desktop-buffer-mode-handlers) (add-to-list 'desktop-buffer-mode-handlers '(mh-folder-mode . mh-restore-desktop-buffer))) @@ -526,7 +526,8 @@ font-lock is done highlighting.") ;; Shush compiler. (defvar desktop-save-buffer) (defvar font-lock-auto-fontify) -(defvar font-lock-defaults) ; XEmacs +(mh-do-in-xemacs + (defvar font-lock-defaults)) ;; Ensure new buffers won't get this mode if default major-mode is nil. (put 'mh-folder-mode 'mode-class 'special) diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el index 2ced886c05e..f269faf3a51 100644 --- a/lisp/mh-e/mh-letter.el +++ b/lisp/mh-e/mh-letter.el @@ -185,7 +185,7 @@ semi-obsolete and is only used if `mail-citation-hook' is nil.") "\C-c\C-w" mh-check-whom "\C-c\C-y" mh-yank-cur-msg "\C-c\M-d" mh-insert-auto-fields - "\M-\t" mh-letter-complete ;; FIXME: completion-at-point + "\M-\t" mh-letter-complete "\t" mh-letter-next-header-field-or-indent [backtab] mh-letter-previous-header-field) @@ -273,7 +273,8 @@ searching for `mh-mail-header-separator' in the buffer." ;;; MH-Letter Mode ;; Shush compiler. -(defvar font-lock-defaults) ; XEmacs +(mh-do-in-xemacs + (defvar font-lock-defaults)) ;; Ensure new buffers won't get this mode if default major-mode is nil. (put 'mh-letter-mode 'mode-class 'special) @@ -502,10 +503,13 @@ This provides alias and folder completion in header fields according to (or (funcall func) #'ignore) mh-letter-complete-function))) -(defalias 'mh-letter-complete - (if (fboundp 'completion-at-point) #'completion-at-point - (lambda () - "Perform completion on header field or word preceding point. +;; TODO Now that completion-at-point performs the task of +;; mh-letter-complete, perhaps mh-letter-complete along with +;; mh-complete-word should be rewritten as a more general function for +;; XEmacs, renamed to mh-completion-at-point, and moved to +;; mh-compat.el. +(defun-mh mh-letter-complete completion-at-point () + "Perform completion on header field or word preceding point. If the field contains addresses (for example, \"To:\" or \"Cc:\") or folders (for example, \"Fcc:\") then this command will provide @@ -521,7 +525,7 @@ alias completion. In the body of the message, this command runs (end (nth 1 data)) (table (nth 2 data))) (mh-complete-word (buffer-substring-no-properties start end) - table start end)))))))) + table start end)))))) (defun mh-letter-complete-or-space (arg) "Perform completion or insert space. @@ -531,8 +535,7 @@ this command to perform completion in the header. Otherwise, a space is inserted; use a prefix argument ARG to specify more than one space." (interactive "p") - (let ((func nil) - (end-of-prev (save-excursion + (let ((end-of-prev (save-excursion (goto-char (mh-beginning-of-word)) (mh-beginning-of-word -1)))) (cond ((not mh-compose-space-does-completion-flag) @@ -889,7 +892,6 @@ downcasing the field name." ;;;###mh-autoload (defun mh-complete-word (word choices begin end) - ;; FIXME: Only needed when completion-at-point doesn't exist. "Complete WORD from CHOICES. Any match found replaces the text from BEGIN to END." (let ((completion (try-completion word choices)) diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index 48c6a3793ef..25554b7822e 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -835,7 +835,7 @@ being used to highlight the signature in a MIME part." ;;; Button Display ;; Shush compiler. -(when (featurep 'xemacs) +(mh-do-in-xemacs (defvar dots) (defvar type) (defvar ov)) @@ -885,7 +885,8 @@ by commands like \"K v\" which operate on individual MIME parts." ;; Shush compiler. (defvar mm-verify-function-alist) ; < Emacs 22 (defvar mm-decrypt-function-alist) ; < Emacs 22 -(defvar pressed-details) ; XEmacs +(mh-do-in-xemacs + (defvar pressed-details)) (defun mh-insert-mime-security-button (handle) "Display buttons for PGP message, HANDLE." diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index a90a26ab2a4..1e764291f5d 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -321,7 +321,8 @@ folder containing the index search results." count (> (hash-table-count msg-hash) 0))))))) ;; Shush compiler. -(defvar pick-folder) ; XEmacs +(mh-do-in-xemacs + (defvar pick-folder)) (defun mh-search-folder (folder window-config) "Search FOLDER for messages matching a pattern. @@ -401,8 +402,9 @@ or nothing to search all folders." (mh-index-sequenced-messages folders mh-tick-seq)) ;; Shush compiler. -(defvar mh-mairix-folder) ; XEmacs -(defvar mh-flists-search-folders) ; XEmacs +(mh-do-in-xemacs + (defvar mh-mairix-folder) + (defvar mh-flists-search-folders)) ;;;###mh-autoload (defun mh-index-sequenced-messages (folders sequence) @@ -1442,7 +1444,8 @@ being the list of messages originally from that folder." mh-index-data) ;; Shush compiler -(defvar mh-speed-flists-inhibit-flag) ; XEmacs +(mh-do-in-xemacs + (defvar mh-speed-flists-inhibit-flag)) ;;;###mh-autoload (defun mh-index-execute-commands () diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el index 145b689c6b9..fc3e5c08143 100644 --- a/lisp/mh-e/mh-seq.el +++ b/lisp/mh-e/mh-seq.el @@ -198,7 +198,8 @@ MESSAGE appears." " ")))) ;; Shush compiler. -(defvar tool-bar-mode) ; XEmacs +(mh-do-in-xemacs + (defvar tool-bar-mode)) (defvar tool-bar-map) ;;;###mh-autoload diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el index 5c2f08cefe5..7b5593ba608 100644 --- a/lisp/mh-e/mh-show.el +++ b/lisp/mh-e/mh-show.el @@ -146,9 +146,7 @@ displayed." (if (not clean-message-header) (mh-start-of-uncleaned-message))) (mh-display-msg msg folder))) - (unless (if (fboundp 'window-full-height-p) - (window-full-height-p) - (= (1+ (window-height)) (frame-height))) ; not vertically split + (unless (mh-window-full-height-p) ; not vertically split (shrink-window (- (window-height) (or mh-summary-height (mh-summary-height))))) (mh-recenter nil) diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index 4394e1b1b22..a77633cd4bd 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -732,8 +732,9 @@ See Info node `(elisp) Programmed Completion' for details." (t (file-directory-p path)))))))) ;; Shush compiler. -(defvar completion-root-regexp) ; XEmacs -(defvar minibuffer-completing-file-name) ; XEmacs +(mh-do-in-xemacs + (defvar completion-root-regexp) + (defvar minibuffer-completing-file-name)) (defun mh-folder-completing-read (prompt default allow-root-folder-flag) "Read folder name with PROMPT and default result DEFAULT. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index a7ffc8d061a..d62b377954d 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1442,7 +1442,9 @@ we entered `completion-in-region-mode'.") (defun completion-in-region (start end collection &optional predicate) "Complete the text between START and END using COLLECTION. Return nil if there is no valid completion, else t. -Point needs to be somewhere between START and END." +Point needs to be somewhere between START and END. +PREDICATE (a function called with no arguments) says when to +exit." (assert (<= start (point)) (<= (point) end)) (with-wrapper-hook ;; FIXME: Maybe we should use this hook to provide a "display @@ -1634,30 +1636,43 @@ The completion method is determined by `completion-at-point-functions'." ;;; Key bindings. -(define-obsolete-variable-alias 'minibuffer-local-must-match-filename-map - 'minibuffer-local-filename-must-match-map "23.1") - (let ((map minibuffer-local-map)) (define-key map "\C-g" 'abort-recursive-edit) (define-key map "\r" 'exit-minibuffer) (define-key map "\n" 'exit-minibuffer)) -(let ((map minibuffer-local-completion-map)) - (define-key map "\t" 'minibuffer-complete) - ;; M-TAB is already abused for many other purposes, so we should find - ;; another binding for it. - ;; (define-key map "\e\t" 'minibuffer-force-complete) - (define-key map " " 'minibuffer-complete-word) - (define-key map "?" 'minibuffer-completion-help)) +(defvar minibuffer-local-completion-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (define-key map "\t" 'minibuffer-complete) + ;; M-TAB is already abused for many other purposes, so we should find + ;; another binding for it. + ;; (define-key map "\e\t" 'minibuffer-force-complete) + (define-key map " " 'minibuffer-complete-word) + (define-key map "?" 'minibuffer-completion-help) + map) + "Local keymap for minibuffer input with completion.") + +(defvar minibuffer-local-must-match-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-completion-map) + (define-key map "\r" 'minibuffer-complete-and-exit) + (define-key map "\n" 'minibuffer-complete-and-exit) + map) + "Local keymap for minibuffer input with completion, for exact match.") -(let ((map minibuffer-local-must-match-map)) - (define-key map "\r" 'minibuffer-complete-and-exit) - (define-key map "\n" 'minibuffer-complete-and-exit)) +(defvar minibuffer-local-filename-completion-map + (let ((map (make-sparse-keymap))) + (define-key map " " nil) + map) + "Local keymap for minibuffer input with completion for filenames. +Gets combined either with `minibuffer-local-completion-map' or +with `minibuffer-local-must-match-map'.") -(let ((map minibuffer-local-filename-completion-map)) - (define-key map " " nil)) -(let ((map minibuffer-local-filename-must-match-map)) - (define-key map " " nil)) +(defvar minibuffer-local-filename-must-match-map (make-sparse-keymap)) +(make-obsolete-variable 'minibuffer-local-filename-must-match-map nil "24.1") +(define-obsolete-variable-alias 'minibuffer-local-must-match-filename-map + 'minibuffer-local-filename-must-match-map "23.1") (let ((map minibuffer-local-ns-map)) (define-key map " " 'exit-minibuffer) @@ -2710,7 +2725,49 @@ filter out additional entries (because TABLE migth not obey PRED)." (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)) + (base-keymap (if require-match + minibuffer-local-must-match-map + minibuffer-local-completion-map)) + (keymap (if (memq minibuffer-completing-file-name '(nil lambda)) + base-keymap + ;; Layer minibuffer-local-filename-completion-map + ;; on top of the base map. + ;; Use make-composed-keymap so that set-keymap-parent + ;; doesn't modify minibuffer-local-filename-completion-map. + (let ((map (make-composed-keymap + minibuffer-local-filename-completion-map))) + ;; Set base-keymap as the parent, so that nil bindings + ;; in minibuffer-local-filename-completion-map can + ;; override bindings in base-keymap. + (set-keymap-parent map base-keymap) + 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 diff --git a/lisp/mouse.el b/lisp/mouse.el index f35069763bd..4de3e175a4a 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -2092,17 +2092,19 @@ choose a font." (global-set-key [double-mouse-1] 'mouse-set-point) (global-set-key [triple-mouse-1] 'mouse-set-point) -;; Clicking on the fringes causes hscrolling: -(global-set-key [left-fringe mouse-1] 'mouse-set-point) -(global-set-key [right-fringe mouse-1] 'mouse-set-point) +(defun mouse--strip-first-event (_prompt) + (substring (this-single-command-raw-keys) 1)) + +(define-key function-key-map [left-fringe mouse-1] 'mouse--strip-first-event) +(define-key function-key-map [right-fringe mouse-1] 'mouse--strip-first-event) (global-set-key [mouse-2] 'mouse-yank-primary) ;; Allow yanking also when the corresponding cursor is "in the fringe". -(global-set-key [right-fringe mouse-2] 'mouse-yank-at-click) -(global-set-key [left-fringe mouse-2] 'mouse-yank-at-click) +(define-key function-key-map [right-fringe mouse-2] 'mouse--strip-first-event) +(define-key function-key-map [left-fringe mouse-2] 'mouse--strip-first-event) (global-set-key [mouse-3] 'mouse-save-then-kill) -(global-set-key [right-fringe mouse-3] 'mouse-save-then-kill) -(global-set-key [left-fringe mouse-3] 'mouse-save-then-kill) +(define-key function-key-map [right-fringe mouse-3] 'mouse--strip-first-event) +(define-key function-key-map [left-fringe mouse-3] 'mouse--strip-first-event) ;; By binding these to down-going events, we let the user use the up-going ;; event to make the selection, saving a click. diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 0493ead7bbf..41716dbdacd 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -1723,11 +1723,12 @@ good, skip, fatal, or unknown." ;;; Temporary file location and deletion... ;;; ------------------------------------------------------------ -(defun ange-ftp-make-tmp-name (host) +(defun ange-ftp-make-tmp-name (host &optional suffix) "This routine will return the name of a new file." (make-temp-file (if (ange-ftp-use-gateway-p host) ange-ftp-gateway-tmp-name-template - ange-ftp-tmp-name-template))) + ange-ftp-tmp-name-template) + nil suffix)) (defun ange-ftp-del-tmp-name (filename) "Force to delete temporary file." @@ -3278,6 +3279,7 @@ system TYPE.") (name (ange-ftp-quote-string (nth 2 parsed))) (temp (ange-ftp-make-tmp-name host)) (binary (ange-ftp-binary-file filename)) + (buffer-file-type buffer-file-type) (abbr (ange-ftp-abbreviate-filename filename)) (coding-system-used last-coding-system-used) size) @@ -4138,7 +4140,8 @@ directory, so that Emacs will know its current contents." (let* ((fn1 (expand-file-name file)) (pa1 (ange-ftp-ftp-name fn1))) (if pa1 - (let ((tmp1 (ange-ftp-make-tmp-name (car pa1)))) + (let ((tmp1 (ange-ftp-make-tmp-name (car pa1) + (file-name-extension file t)))) (ange-ftp-copy-file-internal fn1 tmp1 t nil (format "Getting %s" fn1)) tmp1)))) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index d9e6827d2df..ac12030471e 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -322,7 +322,7 @@ Defaults to the value of `browse-url-mozilla-arguments' at the time :group 'browse-url) (defcustom browse-url-firefox-program - (let ((candidates '("firefox" "iceweasel"))) + (let ((candidates '("firefox" "iceweasel" "icecat"))) (while (and candidates (not (executable-find (car candidates)))) (setq candidates (cdr candidates))) (or (car candidates) "firefox")) diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index 161d7252d6e..038794e117d 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -46,7 +46,8 @@ (require 'starttls) (require 'auth-source) -(declare-function gnutls-negotiate "gnutls" t t) ; defun* +(autoload 'gnutls-negotiate "gnutls") +(autoload 'open-gnutls-stream "gnutls") ;;;###autoload (defun open-network-stream (name buffer host service &rest parameters) @@ -97,6 +98,10 @@ values: :end-of-command specifies a regexp matching the end of a command. +:end-of-capability specifies a regexp matching the end of the + response to the command specified for :capability-command. + It defaults to the regexp specified for :end-of-command. + :success specifies a regexp matching a message indicating a successful STARTTLS negotiation. For instance, the default should be \"^3\" for an NNTP connection. @@ -161,7 +166,8 @@ functionality. (list (car result) :greeting (nth 1 result) :capabilities (nth 2 result) - :type (nth 3 result)) + :type (nth 3 result) + :error (nth 4 result)) (car result)))))) (defun network-stream-certificate (host service parameters) @@ -201,27 +207,34 @@ functionality. (success-string (plist-get parameters :success)) (capability-command (plist-get parameters :capability-command)) (eoc (plist-get parameters :end-of-command)) + (eo-capa (or (plist-get parameters :end-of-capability) + eoc)) ;; Return (STREAM GREETING CAPABILITIES RESULTING-TYPE) (stream (make-network-process :name name :buffer buffer :host host :service service)) (greeting (network-stream-get-response stream start eoc)) - (capabilities (network-stream-command stream capability-command eoc)) + (capabilities (network-stream-command stream capability-command + eo-capa)) (resulting-type 'plain) - starttls-command) - + (builtin-starttls (and (fboundp 'gnutls-available-p) + (gnutls-available-p))) + starttls-command error) + + ;; First check whether the server supports STARTTLS at all. + (when (and capabilities success-string starttls-function) + (setq starttls-command + (funcall starttls-function capabilities))) ;; If we have built-in STARTTLS support, try to upgrade the ;; connection. - (when (and (or (fboundp 'open-gnutls-stream) + (when (and starttls-command + (or builtin-starttls (and (or require-tls (plist-get parameters :use-starttls-if-possible)) (executable-find "gnutls-cli"))) - capabilities success-string starttls-function - (setq starttls-command - (funcall starttls-function capabilities)) (not (eq (plist-get parameters :type) 'plain))) ;; If using external STARTTLS, drop this connection and start ;; anew with `starttls-open-stream'. - (unless (fboundp 'open-gnutls-stream) + (unless builtin-starttls (delete-process stream) (setq start (with-current-buffer buffer (point-max))) (let* ((starttls-use-gnutls t) @@ -240,15 +253,15 @@ functionality. "--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)) - ;; 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)) + (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 eo-capa))) (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) + (if builtin-starttls (let ((cert (network-stream-certificate host service parameters))) (gnutls-negotiate :process stream :hostname host :keylist (and cert (list cert)))) @@ -265,14 +278,21 @@ functionality. (network-stream-get-response stream start eoc))) ;; Re-get the capabilities, which may have now changed. (setq capabilities - (network-stream-command stream capability-command eoc)))) + (network-stream-command stream capability-command eo-capa)))) ;; If TLS is mandatory, close the connection if it's unencrypted. - (and require-tls - (eq resulting-type 'plain) - (delete-process stream)) + (when (and require-tls + ;; ... but Emacs wasn't able to -- either no built-in + ;; support, or no gnutls-cli installed. + (eq resulting-type 'plain)) + (setq error + (if require-tls + "Server does not support TLS" + "Server supports STARTTLS, but Emacs does not have support for it")) + (delete-process stream) + (setq stream nil)) ;; Return value: - (list stream greeting capabilities resulting-type))) + (list stream greeting capabilities resulting-type error))) (defun network-stream-command (stream command eoc) (when command @@ -296,7 +316,8 @@ functionality. (defun network-stream-open-tls (name buffer host service parameters) (with-current-buffer buffer (let* ((start (point-max)) - (use-builtin-gnutls (fboundp 'open-gnutls-stream)) + (use-builtin-gnutls (and (fboundp 'gnutls-available-p) + (gnutls-available-p))) (stream (funcall (if use-builtin-gnutls 'open-gnutls-stream @@ -307,7 +328,8 @@ functionality. (list nil nil nil 'plain) ;; If we're using tls.el, we have to delete the output from ;; openssl/gnutls-cli. - (when (and (null use-builtin-gnutls) eoc) + (when (and (null use-builtin-gnutls) + eoc) (network-stream-get-response stream start eoc) (goto-char (point-min)) (when (re-search-forward eoc nil t) @@ -334,7 +356,9 @@ functionality. ?p service)))))) (list stream (network-stream-get-response stream start eoc) - (network-stream-command stream capability-command eoc) + (network-stream-command stream capability-command + (or (plist-get parameters :end-of-capability) + eoc)) 'plain))) (provide 'network-stream) diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el index b7b0b61f4e1..42c698876cd 100644 --- a/lisp/net/soap-client.el +++ b/lisp/net/soap-client.el @@ -729,9 +729,7 @@ traverse an element tree." (incf nprocessed) (soap-resolve-references-for-element e wsdl) (setf (soap-element-namespace-tag e) nstag)))))) - (soap-namespace-elements ns)))) - - (message "Processed %d" nprocessed)) + (soap-namespace-elements ns))))) wsdl) ;;;;; Loading WSDL from XML documents @@ -1714,10 +1712,6 @@ operations in a WSDL document." ;; error) (warn "Error in SOAP response: HTTP code %s" url-http-response-status)) - (when (> (buffer-size) 1000000) - (soap-warning - "Received large message: %s bytes" - (buffer-size))) (let ((mime-part (mm-dissect-buffer t t))) (unless mime-part (error "Failed to decode response from server")) diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 764ee35d45b..f20040e8a9a 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -100,6 +100,15 @@ When called interactively, a Tramp connection has to be selected." (when (bufferp buf) (kill-buffer buf))))) ;;;###tramp-autoload +(defun tramp-cleanup-this-connection () + "Flush all connection related objects of the current buffer's connection." + (interactive) + (and (stringp default-directory) + (file-remote-p default-directory) + (tramp-cleanup-connection + (tramp-dissect-file-name default-directory 'noexpand)))) + +;;;###tramp-autoload (defun tramp-cleanup-all-connections () "Flush all Tramp internal objects. This includes password cache, file cache, connection cache, buffers." @@ -299,7 +308,7 @@ buffer in your bug report. ;; There is at least one Tramp buffer. (when buffer-list - (switch-to-buffer (list-buffers-noselect nil)) + (tramp-compat-pop-to-buffer-same-window (list-buffers-noselect nil)) (delete-other-windows) (setq buffer-read-only nil) (goto-char (point-min)) @@ -334,7 +343,7 @@ the debug buffer(s).") ;; OK, let's send. First we delete the buffer list. (progn (kill-buffer nil) - (switch-to-buffer curbuf) + (tramp-compat-pop-to-buffer-same-window curbuf) (goto-char (point-max)) (insert "\n\ This is a special notion of the `gnus/message' package. If you diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 3c0642c3c78..e7ea4354b51 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -23,9 +23,9 @@ ;;; Commentary: -;; Tramp's main Emacs version for development is GNU Emacs 24. This -;; package provides compatibility functions for GNU Emacs 22, GNU -;; Emacs 23 and XEmacs 21.4+. +;; Tramp's main Emacs version for development is Emacs 24. This +;; package provides compatibility functions for Emacs 22, Emacs 23, +;; XEmacs 21.4+ and SXEmacs 22. ;;; Code: @@ -286,9 +286,8 @@ Not actually used. Use `(format \"%o\" i)' instead?" (tramp-compat-funcall 'file-attributes filename id-format) (wrong-number-of-arguments (file-attributes filename)))))) -;; PRESERVE-UID-GID has been introduced with Emacs 23. It does not -;; hurt to ignore it for other (X)Emacs versions. -;; PRESERVE-SELINUX-CONTEXT has been introduced with Emacs 24. +;; PRESERVE-UID-GID does not exist in XEmacs. +;; PRESERVE-SELINUX-CONTEXT has been introduced with Emacs 24.1. (defun tramp-compat-copy-file (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid preserve-selinux-context) @@ -484,10 +483,7 @@ exiting if process is running." (tramp-compat-funcall 'set-process-query-on-exit-flag process flag) (tramp-compat-funcall 'process-kill-without-query process flag))) -(add-hook 'tramp-unload-hook - (lambda () - (unload-feature 'tramp-compat 'force))) - +;; There exist different implementations for this function. (defun tramp-compat-coding-system-change-eol-conversion (coding-system eol-type) "Return a coding system like CODING-SYSTEM but with given EOL-TYPE. EOL-TYPE can be one of `dos', `unix', or `mac'." @@ -506,6 +502,19 @@ EOL-TYPE can be one of `dos', `unix', or `mac'." "`dos', `unix', or `mac'"))))) (t (error "Can't change EOL conversion -- is MULE missing?")))) +;; `pop-to-buffer-same-window' has been introduced with Emacs 24.1. +(defun tramp-compat-pop-to-buffer-same-window + (&optional buffer-or-name norecord label) + "Pop to buffer specified by BUFFER-OR-NAME in the selected window." + (if (fboundp 'pop-to-buffer-same-window) + (tramp-compat-funcall + 'pop-to-buffer-same-window buffer-or-name norecord label) + (tramp-compat-funcall 'switch-to-buffer buffer-or-name norecord))) + +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-compat 'force))) + (provide 'tramp-compat) ;;; TODO: diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 025b4ab6cf3..f342b005c4c 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -66,6 +66,9 @@ files conditionalize this setup based on the TERM environment variable." :group 'tramp :type 'string) +(defconst tramp-color-escape-sequence-regexp "\e[[;0-9]+m" + "Escape sequences produced by the \"ls\" command.") + ;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for ;; root users. It uses the `$' character for other users. In order ;; to guarantee a proper prompt, we use "#$ " for the prompt. @@ -484,7 +487,7 @@ detected as prompt when being sent on echoing hosts, therefore.") ;; FreeBSD: /usr/bin:/bin:/usr/sbin:/sbin: - beware trailing ":"! ;; IRIX64: /usr/bin (defcustom tramp-remote-path - '(tramp-default-remote-path "/usr/sbin" "/usr/local/bin" + '(tramp-default-remote-path "/bin" "/usr/bin" "/usr/sbin" "/usr/local/bin" "/local/bin" "/local/freeware/bin" "/local/gnu/bin" "/usr/freeware/bin" "/usr/pkg/bin" "/usr/contrib/bin") "*List of directories to search for executables on remote host. @@ -2582,6 +2585,12 @@ This is like `dired-recursive-delete-directory' for Tramp files." (forward-line 1) (delete-region (match-beginning 0) (point))) + ;; Some busyboxes are reluctant to discard colors. + (unless (string-match "color" (tramp-get-connection-property v "ls" "")) + (goto-char beg) + (while (re-search-forward tramp-color-escape-sequence-regexp nil t) + (replace-match ""))) + ;; The inserted file could be from somewhere else. (when (and (not wildcard) (not full-directory-p)) (goto-char (point-max)) @@ -2669,6 +2678,7 @@ the result will be a local, non-Tramp, filename." (let ((vec (tramp-get-connection-property proc "vector" nil))) (when vec (tramp-message vec 5 "Sentinel called: `%s' `%s'" proc event) + (tramp-flush-connection-property proc) (tramp-flush-directory-property vec ""))))) ;; We use BUFFER also as connection buffer during setup. Because of @@ -2721,9 +2731,7 @@ the result will be a local, non-Tramp, filename." v 'file-error "pty association is not supported for `%s'" name))))) (let ((p (tramp-get-connection-process v))) - ;; Set sentinel and query flag for this process. - (tramp-set-connection-property p "vector" v) - (set-process-sentinel p 'tramp-process-sentinel) + ;; Set query flag for this process. (tramp-compat-set-process-query-on-exit-flag p t) ;; Return process. p))) @@ -3834,10 +3842,9 @@ process to set up. VEC specifies the connection." (tramp-send-command vec "stty -oxtabs" t)) ;; Set `remote-tty' process property. - (ignore-errors - (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\""))) - (unless (zerop (length tty)) - (tramp-compat-process-put proc 'remote-tty tty)))) + (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"" 'noerror))) + (unless (zerop (length tty)) + (tramp-compat-process-put proc 'remote-tty tty))) ;; Dump stty settings in the traces. (when (>= tramp-verbose 9) @@ -4291,16 +4298,24 @@ connection if a previous connection has died for some reason." ;; This must be done in order to avoid our file name handler. (p (let ((default-directory (tramp-compat-temporary-file-directory))) - (start-process + (apply + 'start-process (tramp-get-connection-name vec) (tramp-get-connection-buffer vec) - tramp-encoding-shell)))) + (if tramp-encoding-command-interactive + (list tramp-encoding-shell + tramp-encoding-command-interactive) + (list tramp-encoding-shell)))))) + + ;; Set sentinel and query flag. + (tramp-set-connection-property p "vector" vec) + (set-process-sentinel p 'tramp-process-sentinel) + (tramp-compat-set-process-query-on-exit-flag p nil) (tramp-message vec 6 "%s" (mapconcat 'identity (process-command p) " ")) ;; Check whether process is alive. - (tramp-compat-set-process-query-on-exit-flag p nil) (tramp-barf-if-no-shell-prompt p 60 "Couldn't find local shell prompt %s" tramp-encoding-shell) @@ -4488,9 +4503,10 @@ FMT and ARGS which are passed to `error'." (unless (tramp-send-command-and-check vec command) (apply 'tramp-error vec 'file-error fmt args))) -(defun tramp-send-command-and-read (vec command) +(defun tramp-send-command-and-read (vec command &optional noerror) "Run COMMAND and return the output, which must be a Lisp expression. -In case there is no valid Lisp expression, it raises an error" +In case there is no valid Lisp expression and NOERROR is nil, it +raises an error." (tramp-barf-unless-okay vec command "`%s' returns with error" command) (with-current-buffer (tramp-get-connection-buffer vec) ;; Read the expression. @@ -4500,16 +4516,21 @@ In case there is no valid Lisp expression, it raises an error" ;; Error handling. (when (re-search-forward "\\S-" (point-at-eol) t) (error nil))) - (error (tramp-error - vec 'file-error - "`%s' does not return a valid Lisp expression: `%s'" - command (buffer-string)))))) + (error (unless noerror + (tramp-error + vec 'file-error + "`%s' does not return a valid Lisp expression: `%s'" + command (buffer-string))))))) (defun tramp-convert-file-attributes (vec attr) "Convert file-attributes ATTR generated by perl script, stat or ls. Convert file mode bits to string and set virtual device number. Return ATTR." (when attr + ;; Remove color escape sequences from symlink. + (when (stringp (car attr)) + (while (string-match tramp-color-escape-sequence-regexp (car attr)) + (setcar attr (replace-match "" nil nil (car attr))))) ;; Convert last access time. (unless (listp (nth 4 attr)) (setcar (nthcdr 4 attr) @@ -4661,6 +4682,8 @@ This is used internally by `tramp-file-mode-from-int'." (and ;; It shall be an out-of-band method. (tramp-get-method-parameter (tramp-file-name-method vec) 'tramp-copy-program) + ;; There must be a size, otherwise the file doesn't exist. + (numberp size) ;; Either the file size is large enough, or (in rare cases) there ;; does not exist a remote encoding. (or (null tramp-copy-size-limit) @@ -4685,8 +4708,7 @@ This is used internally by `tramp-file-mode-from-int'." (when elt1 (or (tramp-send-command-and-read - vec - "x=`getconf PATH 2>/dev/null` && echo \\\"$x\\\" || echo nil") + vec "echo \\\"`getconf PATH 2>/dev/null`\\\"" 'noerror) ;; Default if "getconf" is not available. (progn (tramp-message @@ -4848,15 +4870,12 @@ This is used internally by `tramp-file-mode-from-int'." (let ((result (tramp-find-executable vec "stat" (tramp-get-remote-path vec))) tmp) - ;; Check whether stat(1) returns usable syntax. %s does not + ;; Check whether stat(1) returns usable syntax. "%s" does not ;; work on older AIX systems. (when result (setq tmp - ;; We don't want to display an error message. - (tramp-compat-with-temp-message (or (current-message) "") - (ignore-errors - (tramp-send-command-and-read - vec (format "%s -c '(\"%%N\" %%s)' /" result))))) + (tramp-send-command-and-read + vec (format "%s -c '(\"%%N\" %%s)' /" result) 'noerror)) (unless (and (listp tmp) (stringp (car tmp)) (string-match "^./.$" (car tmp)) (integerp (cadr tmp))) @@ -4869,11 +4888,8 @@ This is used internally by `tramp-file-mode-from-int'." (let ((result (tramp-find-executable vec "readlink" (tramp-get-remote-path vec)))) (when (and result - ;; We don't want to display an error message. - (tramp-compat-with-temp-message (or (current-message) "") - (ignore-errors - (tramp-send-command-and-check - vec (format "%s --canonicalize-missing /" result))))) + (tramp-send-command-and-check + vec (format "%s --canonicalize-missing /" result))) result)))) (defun tramp-get-remote-trash (vec) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 9aff06031fc..82d878a6fa8 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -159,6 +159,9 @@ For encoding and deocding, commands like the following are executed: This variable can be used to change the \"/bin/sh\" part. See the variable `tramp-encoding-command-switch' for the \"-c\" part. +If the shell must be forced to be interactive, see +`tramp-encoding-command-interactive'. + Note that this variable is not used for remote commands. There are mechanisms in tramp.el which automatically determine the right shell to use for the remote host." @@ -174,6 +177,13 @@ See the variable `tramp-encoding-shell' for more information." :group 'tramp :type 'string) +(defcustom tramp-encoding-command-interactive + (unless (string-match "cmd\\.exe" tramp-encoding-shell) "-i") + "*Use this switch together with `tramp-encoding-shell' for interactive shells. +See the variable `tramp-encoding-shell' for more information." + :group 'tramp + :type '(choice (const nil) string)) + ;;;###tramp-autoload (defvar tramp-methods nil "*Alist of methods for remote files. diff --git a/lisp/nxml/rng-maint.el b/lisp/nxml/rng-maint.el index d31740f0ca2..bd5b3136d54 100644 --- a/lisp/nxml/rng-maint.el +++ b/lisp/nxml/rng-maint.el @@ -224,19 +224,13 @@ ;;; Timing -(defun rng-time-to-float (time) - (+ (* (nth 0 time) 65536.0) - (nth 1 time) - (/ (nth 2 time) 1000000.0))) - (defun rng-time-function (function &rest args) (let* ((start (current-time)) (val (apply function args)) (end (current-time))) (message "%s ran in %g seconds" function - (- (rng-time-to-float end) - (rng-time-to-float start))) + (float-time (time-subtract end start))) val)) (defun rng-time-tokenize-buffer () diff --git a/lisp/obsolete/old-emacs-lock.el b/lisp/obsolete/old-emacs-lock.el new file mode 100644 index 00000000000..b45003fcecc --- /dev/null +++ b/lisp/obsolete/old-emacs-lock.el @@ -0,0 +1,102 @@ +;;; emacs-lock.el --- prevents you from exiting Emacs if a buffer is locked + +;; Copyright (C) 1994, 1997, 2001-2011 Free Software Foundation, Inc + +;; Author: Tom Wurgler <twurgler@goodyear.com> +;; Created: 12/8/94 +;; Keywords: extensions, processes +;; Obsolete-since: 24.1 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This code sets a buffer-local variable to t if toggle-emacs-lock is run, +;; then if the user attempts to exit Emacs, the locked buffer name will be +;; displayed and the exit aborted. This is just a way of protecting +;; yourself from yourself. For example, if you have a shell running a big +;; program and exiting Emacs would abort that program, you may want to lock +;; that buffer, then if you forget about it after a while, you won't +;; accidentally exit Emacs. To unlock the buffer, just goto the buffer and +;; run toggle-emacs-lock again. + +;;; Code: + +(defvar emacs-lock-from-exiting nil + "Whether Emacs is locked to prevent exiting. See `check-emacs-lock'.") +(make-variable-buffer-local 'emacs-lock-from-exiting) + +(defvar emacs-lock-buffer-locked nil + "Whether a shell or telnet buffer was locked when its process was killed.") +(make-variable-buffer-local 'emacs-lock-buffer-locked) +(put 'emacs-lock-buffer-locked 'permanent-local t) + +(defun check-emacs-lock () + "Check if variable `emacs-lock-from-exiting' is t for any buffer. +If any locked buffer is found, signal error and display the buffer's name." + (save-excursion + (dolist (buffer (buffer-list)) + (set-buffer buffer) + (when emacs-lock-from-exiting + (error "Emacs is locked from exit due to buffer: %s" (buffer-name)))))) + +(defun toggle-emacs-lock () + "Toggle `emacs-lock-from-exiting' for the current buffer. +See `check-emacs-lock'." + (interactive) + (setq emacs-lock-from-exiting (not emacs-lock-from-exiting)) + (if emacs-lock-from-exiting + (message "Buffer is now locked") + (message "Buffer is now unlocked"))) + +(defun emacs-lock-check-buffer-lock () + "Check if variable `emacs-lock-from-exiting' is t for a buffer. +If the buffer is locked, signal error and display its name." + (when emacs-lock-from-exiting + (error "Buffer `%s' is locked, can't delete it" (buffer-name)))) + +; These next defuns make it so if you exit a shell that is locked, the lock +; is shut off for that shell so you can exit Emacs. Same for telnet. +; Also, if a shell or a telnet buffer was locked and the process killed, +; turn the lock back on again if the process is restarted. + +(defun emacs-lock-shell-sentinel () + (set-process-sentinel + (get-buffer-process (buffer-name)) (function emacs-lock-clear-sentinel))) + +(defun emacs-lock-clear-sentinel (_proc _str) + (if emacs-lock-from-exiting + (progn + (setq emacs-lock-from-exiting nil) + (setq emacs-lock-buffer-locked t) + (message "Buffer is now unlocked")) + (setq emacs-lock-buffer-locked nil))) + +(defun emacs-lock-was-buffer-locked () + (if emacs-lock-buffer-locked + (setq emacs-lock-from-exiting t))) + +(unless noninteractive + (add-hook 'kill-emacs-hook 'check-emacs-lock)) +(add-hook 'kill-buffer-hook 'emacs-lock-check-buffer-lock) +(add-hook 'shell-mode-hook 'emacs-lock-was-buffer-locked) +(add-hook 'shell-mode-hook 'emacs-lock-shell-sentinel) +(add-hook 'telnet-mode-hook 'emacs-lock-was-buffer-locked) +(add-hook 'telnet-mode-hook 'emacs-lock-shell-sentinel) + +(provide 'emacs-lock) + +;;; emacs-lock.el ends here diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el index 8090397627e..d75479fab3e 100644 --- a/lisp/pcmpl-linux.el +++ b/lisp/pcmpl-linux.el @@ -83,6 +83,19 @@ (forward-line))) (pcomplete-uniqify-list points)))) +(defun pcomplete-pare-list (l r) + "Destructively remove from list L all elements matching any in list R. +Test is done using `equal'." + (while (and l (and r (member (car l) r))) + (setq l (cdr l))) + (let ((m l)) + (while m + (while (and (cdr m) + (and r (member (cadr m) r))) + (setcdr m (cddr m))) + (setq m (cdr m)))) + l) + (defun pcmpl-linux-mountable-directories () "Return a list of mountable directory names." (let (points) diff --git a/lisp/play/animate.el b/lisp/play/animate.el index 157a2fe7593..facdfa2f347 100644 --- a/lisp/play/animate.el +++ b/lisp/play/animate.el @@ -89,11 +89,15 @@ (insert-char char 1)) (defvar animate-n-steps 10 - "Number of steps to use `animate-string'.") +"*Number of steps `animate-string' will place a char before its last position.") + +(defvar animation-buffer-name nil + "*String naming the default buffer for animations. +When nil animations dipslayed in the buffer named *Animation*.") ;;;###autoload (defun animate-string (string vpos &optional hpos) - "Display STRING starting at position VPOS, HPOS, using animation. + "Display STRING animations starting at position VPOS, HPOS. The characters start at randomly chosen places, and all slide in parallel to their final positions, passing through `animate-n-steps' positions before the final ones. @@ -138,14 +142,19 @@ in the current window." ;;;###autoload (defun animate-sequence (list-of-strings space) - "Display strings from LIST-OF-STRING with animation in a new buffer. -Strings will be separated from each other by SPACE lines." + "Display animation strings from LIST-OF-STRING with buffer *Animation*. +Strings will be separated from each other by SPACE lines. + When the variable `animation-buffer-name' is non-nil display +animation in the buffer named by variable's value, creating the +buffer if one does not exist." (let ((vpos (/ (- (window-height) 1 ;; For the mode-line (* (1- (length list-of-strings)) space) (length list-of-strings)) 2))) - (switch-to-buffer (get-buffer-create "*Animation*")) + (switch-to-buffer (get-buffer-create + (or animation-buffer-name + "*Animation*"))) (erase-buffer) (sit-for 0) (while list-of-strings @@ -155,19 +164,25 @@ Strings will be separated from each other by SPACE lines." ;;;###autoload (defun animate-birthday-present (&optional name) - "Display one's birthday present in a new buffer. -You can specify the one's name by NAME; the default value is \"Sarah\"." - (interactive (list (read-string "Name (default Sarah): " - nil nil "Sarah"))) + "Return a birthday present in the buffer *Birthday-Present*. +When optional arg NAME is non-nil or called-interactively, prompt for +NAME of birthday present receiver and return a birthday present in +the buffer *Birthday-Present-for-Name*." + (interactive (list (read-string "Birthday present for: " + nil nil))) ;; Make a suitable buffer to display the birthday present in. - (switch-to-buffer (get-buffer-create (format "*%s*" name))) + (switch-to-buffer (get-buffer-create + (if name + (concat "*A-Present-for-" (capitalize name) "*") + "*Birthday-Present*"))) (erase-buffer) ;; Display the empty buffer. (sit-for 0) - (animate-string "Happy Birthday," 6) - (animate-string (format "%s" name) 7) - + (if name + (animate-string "Happy Birthday," 6) + (animate-string "Happy Birthday" 6)) + (when name (animate-string (format "%s" (capitalize name)) 7)) (sit-for 1) (animate-string "You are my sunshine," 10 30) diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el index ac78a86757c..31a6d6f425b 100644 --- a/lisp/play/hanoi.el +++ b/lisp/play/hanoi.el @@ -113,7 +113,7 @@ intermediate positions." (prefix-numeric-value current-prefix-arg)))) (if (< nrings 0) (error "Negative number of rings")) - (hanoi-internal nrings (make-list nrings 0) (hanoi-current-time-float))) + (hanoi-internal nrings (make-list nrings 0) (float-time))) ;;;###autoload (defun hanoi-unix () @@ -123,7 +123,7 @@ second since 1970-01-01 00:00:00 GMT. Repent before ring 31 moves." (interactive) - (let* ((start (ftruncate (hanoi-current-time-float))) + (let* ((start (ftruncate (float-time))) (bits (loop repeat 32 for x = (/ start (expt 2.0 31)) then (* x 2.0) collect (truncate (mod x 2.0)))) @@ -137,7 +137,7 @@ This is, necessarily (as of Emacs 20.3), a crock. When the current-time interface is made s2G-compliant, hanoi.el will need to be updated." (interactive) - (let* ((start (ftruncate (hanoi-current-time-float))) + (let* ((start (ftruncate (float-time))) (bits (loop repeat 64 for x = (/ start (expt 2.0 63)) then (* x 2.0) collect (truncate (mod x 2.0)))) @@ -283,11 +283,6 @@ BITS must be of length nrings. Start at START-TIME." (setq buffer-read-only t) (force-mode-line-update))) -(defun hanoi-current-time-float () - "Return values from current-time combined into a single float." - (destructuring-bind (high low micros) (current-time) - (+ (* high 65536.0) low (/ micros 1000000.0)))) - (defun hanoi-put-face (start end value &optional object) "If hanoi-use-faces is non-nil, call put-text-property for face property." (if hanoi-use-faces @@ -383,7 +378,7 @@ BITS must be of length nrings. Start at START-TIME." (/ (- tick flyward-ticks fly-ticks) ticks-per-pole-step)))))))) (if hanoi-move-period - (loop for elapsed = (- (hanoi-current-time-float) start-time) + (loop for elapsed = (- (float-time) start-time) while (< elapsed hanoi-move-period) with tick-period = (/ (float hanoi-move-period) total-ticks) for tick = (ceiling (/ elapsed tick-period)) do diff --git a/lisp/proced.el b/lisp/proced.el index 4436129ce16..11598d7350f 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -1869,16 +1869,6 @@ buffer. You can use it to recover marks." (message "Change in Proced buffer undone. Killed processes cannot be recovered by Emacs.")) -(defun proced-unload-function () - "Unload the Proced library." - (save-current-buffer - (dolist (buf (buffer-list)) - (set-buffer buf) - (when (eq major-mode 'proced-mode) - (funcall (or (default-value 'major-mode) 'fundamental-mode))))) - ;; continue standard unloading - nil) - (provide 'proced) ;;; proced.el ends here diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 0eec54fab6f..38f66b4504e 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -8712,6 +8712,35 @@ comment at the start of cc-engine.el for more info." (c-beginning-of-statement-1 containing-sexp) (c-add-syntax 'annotation-var-cont (point))) + ;; CASE G: a template list continuation? + ;; Mostly a duplication of case 5D.3 to fix templates-19: + ((and (c-major-mode-is 'c++-mode) + (save-excursion + (goto-char indent-point) + (c-with-syntax-table c++-template-syntax-table + (setq placeholder (c-up-list-backward))) + (and placeholder + (eq (char-after placeholder) ?<) + (/= (char-before placeholder) ?<) + (progn + (goto-char (1+ placeholder)) + (not (looking-at c-<-op-cont-regexp)))))) + (c-with-syntax-table c++-template-syntax-table + (goto-char placeholder) + (c-beginning-of-statement-1 containing-sexp t) + (if (save-excursion + (c-backward-syntactic-ws containing-sexp) + (eq (char-before) ?<)) + ;; In a nested template arglist. + (progn + (goto-char placeholder) + (c-syntactic-skip-backward "^,;" containing-sexp t) + (c-forward-syntactic-ws)) + (back-to-indentation))) + ;; FIXME: Should use c-add-stmt-syntax, but it's not yet + ;; template aware. + (c-add-syntax 'template-args-cont (point) placeholder)) + ;; CASE D: continued statement. (t (c-beginning-of-statement-1 containing-sexp) diff --git a/lisp/progmodes/cc-guess.el b/lisp/progmodes/cc-guess.el new file mode 100644 index 00000000000..6553021e783 --- /dev/null +++ b/lisp/progmodes/cc-guess.el @@ -0,0 +1,574 @@ +;;; cc-guess.el --- guess indentation values by scanning existing code + +;; Copyright (C) 1985, 1987, 1992-2006, 2011 +;; Free Software Foundation, Inc. + +;; Author: 1994-1995 Barry A. Warsaw +;; 2011- Masatake YAMATO +;; Maintainer: bug-cc-mode@gnu.org +;; Created: August 1994, split from cc-mode.el +;; Version: See cc-mode.el +;; Keywords: c languages oop + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; This file contains routines that help guess the cc-mode style in a +;; particular region/buffer. Here style means `c-offsets-alist' and +;; `c-basic-offset'. +;; +;; The main entry point of this program is `c-guess' command but there +;; are some variants. +;; +;; Suppose the major mode for the current buffer is one of the modes +;; provided by cc-mode. `c-guess' guesses the indentation style by +;; examining the indentation in the region between beginning of buffer +;; and `c-guess-region-max'. + +;; and installs the guessed style. The name for installed style is given +;; by `c-guess-style-name'. +;; +;; `c-guess-buffer' does the same but in the whole buffer. +;; `c-guess-region' does the same but in the region between the point +;; and the mark. `c-guess-no-install', `c-guess-buffer-no-install' +;; and `c-guess-region-no-install' guess the indentation style but +;; don't install it. You can review a guessed style with `c-guess-view'. +;; After reviewing, use `c-guess-install' to install the style +;; if you prefer it. +;; +;; If you want to reuse the guessed style in another buffer, +;; run `c-set-style' command with the name of the guessed style: +;; "*c-guess*:<name-of-file-which-examined-when-guessing>". +;; Once the guessed style is installed explicitly with `c-guess-install' +;; or implicitly with `c-guess', `c-guess-buffer', or `c-guess-region', +;; a style name is given by `c-guess-style-name' with the above form. +;; +;; If you want to reuse the guessed style in future emacs sessions, +;; you may want to put it to your .emacs. `c-guess-view' is for +;; you. It emits emacs lisp code which defines the last guessed +;; style, in a temporary buffer. You can put the emitted code into +;; your .emacs. This command was suggested by Alan Mackenzie. + +;;; Code: + +(eval-when-compile + (let ((load-path + (if (and (boundp 'byte-compile-dest-file) + (stringp byte-compile-dest-file)) + (cons (file-name-directory byte-compile-dest-file) load-path) + load-path))) + (load "cc-bytecomp" nil t))) + +(cc-require 'cc-defs) +(cc-require 'cc-engine) +(cc-require 'cc-styles) + + + +(defcustom c-guess-offset-threshold 10 + "Threshold of acceptable offsets when examining indent information. +Discard an examined offset if its absolute value is greater than this. + +The offset of a line included in the indent information returned by +`c-guess-basic-syntax'." + :type 'integer + :group 'c) + +(defcustom c-guess-region-max 50000 + "The maximum region size for examining indent information with `c-guess'. +It takes a long time to examine indent information from a large region; +this option helps you limit that time. `nil' means no limit." + :type 'integer + :group 'c) + + +;;;###autoload +(defvar c-guess-guessed-offsets-alist nil + "Currently guessed offsets-alist.") +;;;###autoload +(defvar c-guess-guessed-basic-offset nil + "Currently guessed basic-offset.") + +(defvar c-guess-accumulator nil) +;; Accumulated examined indent information. Information is represented +;; in a list. Each element in it has following structure: +;; +;; (syntactic-symbol ((indentation-offset1 . number-of-times1) +;; (indentation-offset2 . number-of-times2) +;; ...)) +;; +;; This structure is built by `c-guess-accumulate-offset'. +;; +;; Here we call the pair (indentation-offset1 . number-of-times1) a +;; counter. `c-guess-sort-accumulator' sorts the order of +;; counters by number-of-times. +;; Use `c-guess-dump-accumulator' to see the value. + +(defconst c-guess-conversions + '((c . c-lineup-C-comments) + (inher-cont . c-lineup-multi-inher) + (string . -1000) + (comment-intro . c-lineup-comment) + (arglist-cont-nonempty . c-lineup-arglist) + (arglist-close . c-lineup-close-paren) + (cpp-macro . -1000))) + + +;;;###autoload +(defun c-guess (&optional accumulate) + "Guess the style in the region up to `c-guess-region-max', and install it. + +The style is given a name based on the file's absolute file name. + +If given a prefix argument (or if the optional argument ACCUMULATE is +non-nil) then the previous guess is extended, otherwise a new guess is +made from scratch." + (interactive "P") + (c-guess-region (point-min) + (min (point-max) (or c-guess-region-max + (point-max))) + accumulate)) + +;;;###autoload +(defun c-guess-no-install (&optional accumulate) + "Guess the style in the region up to `c-guess-region-max'; don't install it. + +If given a prefix argument (or if the optional argument ACCUMULATE is +non-nil) then the previous guess is extended, otherwise a new guess is +made from scratch." + (interactive "P") + (c-guess-region-no-install (point-min) + (min (point-max) (or c-guess-region-max + (point-max))) + accumulate)) + +;;;###autoload +(defun c-guess-buffer (&optional accumulate) + "Guess the style on the whole current buffer, and install it. + +The style is given a name based on the file's absolute file name. + +If given a prefix argument (or if the optional argument ACCUMULATE is +non-nil) then the previous guess is extended, otherwise a new guess is +made from scratch." + (interactive "P") + (c-guess-region (point-min) + (point-max) + accumulate)) + +;;;###autoload +(defun c-guess-buffer-no-install (&optional accumulate) + "Guess the style on the whole current buffer; don't install it. + +If given a prefix argument (or if the optional argument ACCUMULATE is +non-nil) then the previous guess is extended, otherwise a new guess is +made from scratch." + (interactive "P") + (c-guess-region-no-install (point-min) + (point-max) + accumulate)) + +;;;###autoload +(defun c-guess-region (start end &optional accumulate) + "Guess the style on the region and install it. + +The style is given a name based on the file's absolute file name. + +If given a prefix argument (or if the optional argument ACCUMULATE is +non-nil) then the previous guess is extended, otherwise a new guess is +made from scratch." + (interactive "r\nP") + (c-guess-region-no-install start end accumulate) + (c-guess-install)) + + +(defsubst c-guess-empty-line-p () + (eq (line-beginning-position) + (line-end-position))) + +;;;###autoload +(defun c-guess-region-no-install (start end &optional accumulate) + "Guess the style on the region; don't install it. + +Every line of code in the region is examined and values for the following two +variables are guessed: + +* `c-basic-offset', and +* the indentation values of the various syntactic symbols in + `c-offsets-alist'. + +The guessed values are put into `c-guess-guessed-basic-offset' and +`c-guess-guessed-offsets-alist'. + +Frequencies of use are taken into account when guessing, so minor +inconsistencies in the indentation style shouldn't produce wrong guesses. + +If given a prefix argument (or if the optional argument ACCUMULATE is +non-nil) then the previous examination is extended, otherwise a new +guess is made from scratch. + +Note that the larger the region to guess in, the slower the guessing. +So you can limit the region with `c-guess-region-max'." + (interactive "r\nP") + (let ((accumulator (when accumulate c-guess-accumulator))) + (setq c-guess-accumulator (c-guess-examine start end accumulator)) + (let ((pair (c-guess-guess c-guess-accumulator))) + (setq c-guess-guessed-basic-offset (car pair) + c-guess-guessed-offsets-alist (cdr pair))))) + + +(defun c-guess-examine (start end accumulator) + (let ((reporter (when (fboundp 'make-progress-reporter) + (make-progress-reporter "Examining Indentation " + start + end)))) + (save-excursion + (goto-char start) + (while (< (point) end) + (unless (c-guess-empty-line-p) + (mapc (lambda (s) + (setq accumulator (or (c-guess-accumulate accumulator s) + accumulator))) + (c-save-buffer-state () (c-guess-basic-syntax)))) + (when reporter (progress-reporter-update reporter (point))) + (forward-line 1))) + (when reporter (progress-reporter-done reporter))) + (c-guess-sort-accumulator accumulator)) + +(defun c-guess-guess (accumulator) + ;; Guess basic-offset and offsets-alist from ACCUMULATOR, + ;; then return them as a cons: (basic-offset . offsets-alist). + ;; See the comments at `c-guess-accumulator' about the format + ;; ACCUMULATOR. + (let* ((basic-offset (c-guess-make-basic-offset accumulator)) + (typical-offsets-alist (c-guess-make-offsets-alist + accumulator)) + (symbolic-offsets-alist (c-guess-symbolize-offsets-alist + typical-offsets-alist + basic-offset)) + (merged-offsets-alist (c-guess-merge-offsets-alists + (copy-tree c-guess-conversions) + symbolic-offsets-alist))) + (cons basic-offset merged-offsets-alist))) + +(defun c-guess-current-offset (relpos) + ;; Calculate relative indentation (point) to RELPOS. + (- (progn (back-to-indentation) + (current-column)) + (save-excursion + (goto-char relpos) + (current-column)))) + +(defun c-guess-accumulate (accumulator syntax-element) + ;; Add SYNTAX-ELEMENT to ACCUMULATOR. + (let ((symbol (car syntax-element)) + (relpos (cadr syntax-element))) + (when (numberp relpos) + (let ((offset (c-guess-current-offset relpos))) + (when (< (abs offset) c-guess-offset-threshold) + (c-guess-accumulate-offset accumulator + symbol + offset)))))) + +(defun c-guess-accumulate-offset (accumulator symbol offset) + ;; Added SYMBOL and OFFSET to ACCUMULATOR. See + ;; `c-guess-accumulator' about the structure of ACCUMULATOR. + (let* ((entry (assoc symbol accumulator)) + (counters (cdr entry)) + counter) + (if entry + (progn + (setq counter (assoc offset counters)) + (if counter + (setcdr counter (1+ (cdr counter))) + (setq counters (cons (cons offset 1) counters)) + (setcdr entry counters)) + accumulator) + (cons (cons symbol (cons (cons offset 1) nil)) accumulator)))) + +(defun c-guess-sort-accumulator (accumulator) + ;; Sort each element of ACCUMULATOR by the number-of-times. See + ;; `c-guess-accumulator' for more details. + (mapcar + (lambda (entry) + (let ((symbol (car entry)) + (counters (cdr entry))) + (cons symbol (sort counters + (lambda (a b) + (if (> (cdr a) (cdr b)) + t + (and + (eq (cdr a) (cdr b)) + (< (car a) (car b))))))))) + accumulator)) + +(defun c-guess-make-offsets-alist (accumulator) + ;; Throw away the rare cases in accumulator and make an offsets-alist structure. + (mapcar + (lambda (entry) + (cons (car entry) + (car (car (cdr entry))))) + accumulator)) + +(defun c-guess-merge-offsets-alists (strong weak) + ;; Merge two offsets-alists into one. + ;; When two offsets-alists have the same symbol + ;; entry, give STRONG priority over WEAK. + (mapc + (lambda (weak-elt) + (unless (assoc (car weak-elt) strong) + (setq strong (cons weak-elt strong)))) + weak) + strong) + +(defun c-guess-make-basic-offset (accumulator) + ;; As candidate for `c-basic-offset', find the most frequently appearing + ;; indentation-offset in ACCUMULATOR. + (let* (;; Drop the value related to `c' syntactic-symbol. + ;; (`c': Inside a multiline C style block comment.) + ;; The impact for values of `c' is too large for guessing + ;; `basic-offset' if the target source file is small and its license + ;; notice is at top of the file. + (accumulator (assq-delete-all 'c (copy-tree accumulator))) + ;; Drop syntactic-symbols from ACCUMULATOR. + (alist (apply #'append (mapcar (lambda (elts) + (mapcar (lambda (elt) + (cons (abs (car elt)) + (cdr elt))) + (cdr elts))) + accumulator))) + ;; Gather all indentation-offsets other than 0. + ;; 0 is meaningless as `basic-offset'. + (offset-list (delete 0 + (delete-dups (mapcar + (lambda (elt) (car elt)) + alist)))) + ;; Sum of number-of-times for offset: + ;; (offset . sum) + (summed (mapcar (lambda (offset) + (cons offset + (apply #'+ + (mapcar (lambda (a) + (if (eq (car a) offset) + (cdr a) + 0)) + alist)))) + offset-list))) + ;; + ;; Find the majority. + ;; + (let ((majority '(nil . 0))) + (while summed + (when (< (cdr majority) (cdr (car summed))) + (setq majority (car summed))) + (setq summed (cdr summed))) + (car majority)))) + +(defun c-guess-symbolize-offsets-alist (offsets-alist basic-offset) + ;; Convert the representation of OFFSETS-ALIST to an alist using + ;; `+', `-', `++', `--', `*', or `/'. These symbols represent + ;; a value relative to BASIC-OFFSET. Their meaning can be found + ;; in the CC Mode manual. + (mapcar + (lambda (elt) + (let ((s (car elt)) + (v (cdr elt))) + (cond + ((integerp v) + (cons s (c-guess-symbolize-integer v + basic-offset))) + (t elt)))) + offsets-alist)) + +(defun c-guess-symbolize-integer (int basic-offset) + (let ((aint (abs int))) + (cond + ((eq int basic-offset) '+) + ((eq aint basic-offset) '-) + ((eq int (* 2 basic-offset)) '++) + ((eq aint (* 2 basic-offset)) '--) + ((eq (* 2 int) basic-offset) '*) + ((eq (* 2 aint) basic-offset) '-) + (t int)))) + +(defun c-guess-style-name () + ;; Make a style name for the guessed style. + (format "*c-guess*:%s" (buffer-file-name))) + +(defun c-guess-make-style (basic-offset offsets-alist) + (when basic-offset + ;; Make a style from guessed values. + (let* ((offsets-alist (c-guess-merge-offsets-alists + offsets-alist + c-offsets-alist))) + `((c-basic-offset . ,basic-offset) + (c-offsets-alist . ,offsets-alist))))) + +;;;###autoload +(defun c-guess-install (&optional style-name) + "Install the latest guessed style into the current buffer. +\(This guessed style is a combination of `c-guess-guessed-basic-offset', +`c-guess-guessed-offsets-alist' and `c-offsets-alist'.) + +The style is entered into CC Mode's style system by +`c-add-style'. Its name is either STYLE-NAME, or a name based on +the absolute file name of the file if STYLE-NAME is nil." + (interactive "sNew style name (empty for default name): ") + (let* ((style (c-guess-make-style c-guess-guessed-basic-offset + c-guess-guessed-offsets-alist))) + (if style + (let ((style-name (or (if (equal style-name "") + nil + style-name) + (c-guess-style-name)))) + (c-add-style style-name style t) + (message "Style \"%s\" is installed" style-name)) + (error "Not yet guessed")))) + +(defun c-guess-dump-accumulator () + "Show `c-guess-accumulator'." + (interactive) + (with-output-to-temp-buffer "*Accumulated Examined Indent Information*" + (pp c-guess-accumulator))) + +(defun c-guess-reset-accumulator () + "Reset `c-guess-accumulator'." + (interactive) + (setq c-guess-accumulator nil)) + +(defun c-guess-dump-guessed-values () + "Show `c-guess-guessed-basic-offset' and `c-guess-guessed-offsets-alist'." + (interactive) + (with-output-to-temp-buffer "*Guessed Values*" + (princ "basic-offset: \n\t") + (pp c-guess-guessed-basic-offset) + (princ "\n\n") + (princ "offsets-alist: \n") + (pp c-guess-guessed-offsets-alist) + )) + +(defun c-guess-dump-guessed-style (&optional printer) + "Show the guessed style. +`pp' is used to print the style but if PRINTER is given, +PRINTER is used instead. If PRINTER is not `nil', it +is called with one argument, the guessed style." + (interactive) + (let ((style (c-guess-make-style c-guess-guessed-basic-offset + c-guess-guessed-offsets-alist))) + (if style + (with-output-to-temp-buffer "*Guessed Style*" + (funcall (if printer printer 'pp) style)) + (error "Not yet guessed")))) + +(defun c-guess-guessed-syntactic-symbols () + ;; Return syntactic symbols in c-guess-guessed-offsets-alist + ;; but not in c-guess-conversions. + (let ((alist c-guess-guessed-offsets-alist) + elt + (symbols nil)) + (while alist + (setq elt (car alist) + alist (cdr alist)) + (unless (assq (car elt) c-guess-conversions) + (setq symbols (cons (car elt) + symbols)))) + symbols)) + +(defun c-guess-view-reorder-offsets-alist-in-style (style guessed-syntactic-symbols) + ;; Reorder the `c-offsets-alist' field of STYLE. + ;; If an entry in `c-offsets-alist' holds a guessed value, move it to + ;; front in the field. In addition alphabetical sort by entry name is done. + (setq style (copy-tree style)) + (let ((offsets-alist-cell (assq 'c-offsets-alist style)) + (guessed-syntactic-symbols (c-guess-guessed-syntactic-symbols))) + (setcdr offsets-alist-cell + (sort (cdr offsets-alist-cell) + (lambda (a b) + (let ((a-guessed? (memq (car a) guessed-syntactic-symbols)) + (b-guessed? (memq (car b) guessed-syntactic-symbols))) + (cond + ((or (and a-guessed? b-guessed?) + (not (or a-guessed? b-guessed?))) + (string-lessp (symbol-name (car a)) + (symbol-name (car b)))) + (a-guessed? t) + (b-guessed? nil))))))) + style) + +(defun c-guess-view-mark-guessed-entries (guessed-syntactic-symbols) + ;; Put " ; Guess value" markers on all entries which hold + ;; guessed values. + ;; `c-basic-offset' is always considered as holding a guessed value. + (let ((needs-markers (cons 'c-basic-offset + guessed-syntactic-symbols))) + (while needs-markers + (goto-char (point-min)) + (when (search-forward (concat "(" + (symbol-name (car needs-markers)) + " ") nil t) + (move-end-of-line 1) + (comment-dwim nil) + (insert " Guessed value")) + (setq needs-markers + (cdr needs-markers))))) + +(defun c-guess-view (&optional with-name) + "Emit emacs lisp code which defines the last guessed style. +So you can put the code into .emacs if you prefer the +guessed code. +\"STYLE NAME HERE\" is used as the name for the style in the +emitted code. If WITH-NAME is given, it is used instead. +WITH-NAME is expected as a string but if this function +called interactively with prefix argument, the value for +WITH-NAME is asked to the user." + (interactive "P") + (let* ((temporary-style-name (cond + ((stringp with-name) with-name) + (with-name (read-from-minibuffer + "New style name: ")) + (t + "STYLE NAME HERE"))) + (guessed-style-name (c-guess-style-name)) + (current-style-name c-indentation-style) + (parent-style-name (if (string-equal guessed-style-name + current-style-name) + ;; The guessed style is already installed. + ;; It cannot be used as the parent style. + ;; Use the default style for the current + ;; major mode as the parent style. + (cc-choose-style-for-mode + major-mode + c-default-style) + ;; The guessed style is not installed yet. + current-style-name))) + (c-guess-dump-guessed-style + (lambda (style) + (let ((guessed-syntactic-symbols (c-guess-guessed-syntactic-symbols))) + (pp `(c-add-style ,temporary-style-name + ',(cons parent-style-name + (c-guess-view-reorder-offsets-alist-in-style + style + guessed-syntactic-symbols)))) + (with-current-buffer standard-output + (lisp-interaction-mode) + (c-guess-view-mark-guessed-entries + guessed-syntactic-symbols) + (buffer-enable-undo))))))) + + +(cc-provide 'cc-guess) +;;; cc-guess.el ends here diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 86a963bcf55..a6459e1724f 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -295,6 +295,19 @@ the evaluated constant value at compile time." ["Backslashify" c-backslash-region (c-fn-region-is-active-p)])) "----" + ("Style..." + ["Set Style..." c-set-style t] + ["Show Current Style Name" (message + "Style Name: %s" + c-indentation-style) t] + ["Guess Style from this Buffer" c-guess-buffer-no-install t] + ["Install the Last Guessed Style..." c-guess-install + (and c-guess-guessed-offsets-alist + c-guess-guessed-basic-offset) ] + ["View the Last Guessed Style" c-guess-view + (and c-guess-guessed-offsets-alist + c-guess-guessed-basic-offset) ]) + "----" ("Toggle..." ["Syntactic indentation" c-toggle-syntactic-indentation :style toggle :selected c-syntactic-indentation] diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 3a5a643a2a8..1adc6c2eac0 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -93,6 +93,7 @@ (cc-require 'cc-cmds) (cc-require 'cc-align) (cc-require 'cc-menus) +(cc-require 'cc-guess) ;; Silence the compiler. (cc-bytecomp-defvar adaptive-fill-first-line-regexp) ; Emacs @@ -553,11 +554,7 @@ that requires a literal mode spec at compile time." (c-clear-found-types) ;; now set the mode style based on default-style - (let ((style (if (stringp default-style) - default-style - (or (cdr (assq mode default-style)) - (cdr (assq 'other default-style)) - "gnu")))) + (let ((style (cc-choose-style-for-mode mode default-style))) ;; Override style variables if `c-old-style-variable-behavior' is ;; set. Also override if we are using global style variables, ;; have already initialized a style once, and are switching to a @@ -692,7 +689,8 @@ This function is called from the hook `before-hack-local-variables-hook'." (c-count-cfss file-local-variables-alist)) (cfs-in-dir-count (c-count-cfss dir-local-variables-alist))) (c-set-style stile - (= cfs-in-file-and-dir-count cfs-in-dir-count))) + (and (= cfs-in-file-and-dir-count cfs-in-dir-count) + 'keep-defaults))) (c-set-style stile))) (when offsets (mapc diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el index e161eb6d0f5..96cb15f2a72 100644 --- a/lisp/progmodes/cc-styles.el +++ b/lisp/progmodes/cc-styles.el @@ -650,6 +650,15 @@ any reason to call this function directly." (setq c-style-variables-are-local-p t)) )) +(defun cc-choose-style-for-mode (mode default-style) + "Return suitable style for MODE from DEFAULT-STYLE. +DEFAULT-STYLE has the same format as `c-default-style'." + (if (stringp default-style) + default-style + (or (cdr (assq mode default-style)) + (cdr (assq 'other default-style)) + "gnu"))) + (cc-provide 'cc-styles) diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el index 22ece17cb28..7989c60f80c 100644 --- a/lisp/progmodes/cfengine.el +++ b/lisp/progmodes/cfengine.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2001-2011 Free Software Foundation, Inc. ;; Author: Dave Love <fx@gnu.org> +;; Maintainer: Ted Zlatanov <tzz@lifelogs.com> ;; Keywords: languages ;; This file is part of GNU Emacs. @@ -28,6 +29,13 @@ ;; Possible customization for auto-mode selection: ;; (push '(("^cfagent.conf\\'" . cfengine-mode)) auto-mode-alist) ;; (push '(("^cf\\." . cfengine-mode)) auto-mode-alist) +;; (push '(("\\.cf\\'" . cfengine-mode)) auto-mode-alist) + +;; Or, if you want to use the CFEngine 3.x support: + +;; (push '(("^cfagent.conf\\'" . cfengine3-mode)) auto-mode-alist) +;; (push '(("^cf\\." . cfengine3-mode)) auto-mode-alist) +;; (push '(("\\.cf\\'" . cfengine3-mode)) auto-mode-alist) ;; This is not the same as the mode written by Rolf Ebert ;; <ebert@waporo.muc.de>, distributed with cfengine-2.0.5. It does @@ -63,7 +71,27 @@ ;; cfservd "admit" "grant" "deny") "List of the action keywords supported by Cfengine. -This includes those for cfservd as well as cfagent.")) +This includes those for cfservd as well as cfagent.") + + (defconst cfengine3-defuns + (mapcar + 'symbol-name + '(bundle body)) + "List of the CFEngine 3.x defun headings.") + + (defconst cfengine3-defuns-regex + (regexp-opt cfengine3-defuns t) + "Regex to match the CFEngine 3.x defuns.") + + (defconst cfengine3-class-selector-regex "\\([[:alnum:]_().&|!]+\\)::") + + (defconst cfengine3-category-regex "\\([[:alnum:]_]+\\):") + + (defconst cfengine3-vartypes + (mapcar + 'symbol-name + '(string int real slist ilist rlist irange rrange counter)) + "List of the CFEngine 3.x variable types.")) (defvar cfengine-font-lock-keywords `(;; Actions. @@ -82,6 +110,31 @@ This includes those for cfservd as well as cfagent.")) ;; File, acl &c in group: { token ... } ("{[ \t]*\\([^ \t\n]+\\)" 1 font-lock-constant-face))) +(defvar cfengine3-font-lock-keywords + `( + (,(concat "^[ \t]*" cfengine3-class-selector-regex) + 1 font-lock-keyword-face) + (,(concat "^[ \t]*" cfengine3-category-regex) + 1 font-lock-builtin-face) + ;; Variables, including scope, e.g. module.var + ("[@$](\\([[:alnum:]_.]+\\))" 1 font-lock-variable-name-face) + ("[@$]{\\([[:alnum:]_.]+\\)}" 1 font-lock-variable-name-face) + ;; Variable definitions. + ("\\<\\([[:alnum:]_]+\\)[ \t]*=[ \t]*(" 1 font-lock-variable-name-face) + + ;; CFEngine 3.x faces + ;; defuns + (,(concat "\\<" cfengine3-defuns-regex "\\>" + "[ \t]+\\<\\([[:alnum:]_]+\\)\\>" + "[ \t]+\\<\\([[:alnum:]_]+\\)\\((\\([^)]*\\))\\)?") + (1 font-lock-builtin-face) + (2 font-lock-constant-name-face) + (3 font-lock-function-name-face) + (5 font-lock-variable-name-face)) + ;; variable types + (,(concat "\\<" (eval-when-compile (regexp-opt cfengine3-vartypes t)) "\\>") + 1 font-lock-type-face))) + (defvar cfengine-imenu-expression `((nil ,(concat "^[ \t]*" (eval-when-compile (regexp-opt cfengine-actions t)) @@ -197,6 +250,191 @@ Intended as the value of `indent-line-function'." (fill-paragraph justify)) t)) +(defun cfengine3-beginning-of-defun () + "`beginning-of-defun' function for Cfengine 3 mode. +Treats body/bundle blocks as defuns." + (unless (<= (current-column) (current-indentation)) + (end-of-line)) + (if (re-search-backward (concat "^[ \t]*" cfengine3-defuns-regex "\\>") nil t) + (beginning-of-line) + (goto-char (point-min))) + t) + +(defun cfengine3-end-of-defun () + "`end-of-defun' function for Cfengine 3 mode. +Treats body/bundle blocks as defuns." + (end-of-line) + (if (re-search-forward (concat "^[ \t]*" cfengine3-defuns-regex "\\>") nil t) + (beginning-of-line) + (goto-char (point-max))) + t) + +(defun cfengine3-indent-line () + "Indent a line in Cfengine 3 mode. +Intended as the value of `indent-line-function'." + (let ((pos (- (point-max) (point))) + parse) + (save-restriction + (narrow-to-defun) + (back-to-indentation) + (setq parse (parse-partial-sexp (point-min) (point))) + (message "%S" parse) + (cond + ;; body/bundle blocks start at 0 + ((looking-at (concat cfengine3-defuns-regex "\\>")) + (indent-line-to 0)) + ;; categories are indented one step + ((looking-at (concat cfengine3-category-regex "[ \t]*$")) + (indent-line-to cfengine-indent)) + ;; class selectors are indented two steps + ((looking-at (concat cfengine3-class-selector-regex "[ \t]*$")) + (indent-line-to (* 2 cfengine-indent))) + ;; Outdent leading close brackets one step. + ((or (eq ?\} (char-after)) + (eq ?\) (char-after))) + (condition-case () + (indent-line-to (save-excursion + (forward-char) + (backward-sexp) + (current-column))) + (error nil))) + ;; inside a string and it starts before this line + ((and (nth 3 parse) + (< (nth 8 parse) (save-excursion (beginning-of-line) (point)))) + (indent-line-to 0)) + ;; inside a defun, but not a nested list (depth is 1) + ((= 1 (nth 0 parse)) + (indent-line-to (* (+ 2 (nth 0 parse)) cfengine-indent))) + ;; Inside brackets/parens: indent to start column of non-comment + ;; token on line following open bracket or by one step from open + ;; bracket's column. + ((condition-case () + (progn (indent-line-to (save-excursion + (backward-up-list) + (forward-char) + (skip-chars-forward " \t") + (cond + ((looking-at "[^\n#]") + (current-column)) + ((looking-at "[^\n#]") + (current-column)) + (t + (skip-chars-backward " \t") + (+ (current-column) -1 + cfengine-indent))))) + t) + (error nil))) + ;; Else don't indent. + (t (indent-line-to 0)))) + ;; If initial point was within line's indentation, + ;; position after the indentation. Else stay at same point in text. + (if (> (- (point-max) pos) (point)) + (goto-char (- (point-max) pos))))) + +;; CFEngine 3.x grammar + +;; specification: blocks +;; blocks: block | blocks block; +;; block: bundle typeid blockid bundlebody +;; | bundle typeid blockid usearglist bundlebody +;; | body typeid blockid bodybody +;; | body typeid blockid usearglist bodybody; + +;; typeid: id +;; blockid: id +;; usearglist: '(' aitems ')'; +;; aitems: aitem | aitem ',' aitems |; +;; aitem: id + +;; bundlebody: '{' statements '}' +;; statements: statement | statements statement; +;; statement: category | classpromises; + +;; bodybody: '{' bodyattribs '}' +;; bodyattribs: bodyattrib | bodyattribs bodyattrib; +;; bodyattrib: class | selections; +;; selections: selection | selections selection; +;; selection: id ASSIGN rval ';' ; + +;; classpromises: classpromise | classpromises classpromise; +;; classpromise: class | promises; +;; promises: promise | promises promise; +;; category: CATEGORY +;; promise: promiser ARROW rval constraints ';' | promiser constraints ';'; +;; constraints: constraint | constraints ',' constraint |; +;; constraint: id ASSIGN rval; +;; class: CLASS +;; id: ID +;; rval: ID | QSTRING | NAKEDVAR | list | usefunction +;; list: '{' litems '}' ; +;; litems: litem | litem ',' litems |; +;; litem: ID | QSTRING | NAKEDVAR | list | usefunction + +;; functionid: ID | NAKEDVAR +;; promiser: QSTRING +;; usefunction: functionid givearglist +;; givearglist: '(' gaitems ')' +;; gaitems: gaitem | gaitems ',' gaitem |; +;; gaitem: ID | QSTRING | NAKEDVAR | list | usefunction + +;; # from lexer: + +;; bundle: "bundle" +;; body: "body" +;; COMMENT #[^\n]* +;; NAKEDVAR [$@][(][a-zA-Z0-9_\200-\377.]+[)]|[$@][{][a-zA-Z0-9_\200-\377.]+[}] +;; ID: [a-zA-Z0-9_\200-\377]+ +;; ASSIGN: "=>" +;; ARROW: "->" +;; QSTRING: \"((\\\")|[^"])*\"|\'((\\\')|[^'])*\'|`[^`]*` +;; CLASS: [.|&!()a-zA-Z0-9_\200-\377]+:: +;; CATEGORY: [a-zA-Z_]+: + +(defun cfengine-common-settings () + (set (make-local-variable 'syntax-propertize-function) + ;; In the main syntax-table, \ is marked as a punctuation, because + ;; of its use in DOS-style directory separators. Here we try to + ;; recognize the cases where \ is used as an escape inside strings. + (syntax-propertize-rules ("\\(\\(?:\\\\\\)+\\)\"" (1 "\\")))) + (set (make-local-variable 'parens-require-spaces) nil) + (set (make-local-variable 'comment-start) "# ") + (set (make-local-variable 'comment-start-skip) + "\\(\\(?:^\\|[^\\\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*") + ;; Like Lisp mode. Without this, we lose with, say, + ;; `backward-up-list' when there's an unbalanced quote in a + ;; preceding comment. + (set (make-local-variable 'parse-sexp-ignore-comments) t)) + +(defun cfengine-common-syntax (table) + ;; the syntax defaults seem OK to give reasonable word movement + (modify-syntax-entry ?# "<" table) + (modify-syntax-entry ?\n ">#" table) + (modify-syntax-entry ?\" "\"" table) + ;; variable substitution: + (modify-syntax-entry ?$ "." table) + ;; Doze path separators: + (modify-syntax-entry ?\\ "." table)) + +;;;###autoload +(define-derived-mode cfengine3-mode prog-mode "CFEngine3" + "Major mode for editing cfengine input. +There are no special keybindings by default. + +Action blocks are treated as defuns, i.e. \\[beginning-of-defun] moves +to the action header." + (cfengine-common-settings) + (cfengine-common-syntax cfengine3-mode-syntax-table) + + (set (make-local-variable 'indent-line-function) #'cfengine3-indent-line) + (setq font-lock-defaults + '(cfengine3-font-lock-keywords nil nil nil beginning-of-defun)) + + ;; use defuns as the essential syntax block + (set (make-local-variable 'beginning-of-defun-function) + #'cfengine3-beginning-of-defun) + (set (make-local-variable 'end-of-defun-function) + #'cfengine3-end-of-defun)) + ;;;###autoload (define-derived-mode cfengine-mode prog-mode "Cfengine" "Major mode for editing cfengine input. @@ -204,25 +442,15 @@ There are no special keybindings by default. Action blocks are treated as defuns, i.e. \\[beginning-of-defun] moves to the action header." - (modify-syntax-entry ?# "<" cfengine-mode-syntax-table) - (modify-syntax-entry ?\n ">#" cfengine-mode-syntax-table) + (cfengine-common-settings) + (cfengine-common-syntax cfengine-mode-syntax-table) + ;; Shell commands can be quoted by single, double or back quotes. ;; It's debatable whether we should define string syntax, but it ;; should avoid potential confusion in some cases. - (modify-syntax-entry ?\" "\"" cfengine-mode-syntax-table) (modify-syntax-entry ?\' "\"" cfengine-mode-syntax-table) (modify-syntax-entry ?\` "\"" cfengine-mode-syntax-table) - ;; variable substitution: - (modify-syntax-entry ?$ "." cfengine-mode-syntax-table) - ;; Doze path separators: - (modify-syntax-entry ?\\ "." cfengine-mode-syntax-table) - ;; Otherwise, syntax defaults seem OK to give reasonable word - ;; movement. - (set (make-local-variable 'parens-require-spaces) nil) - (set (make-local-variable 'comment-start) "# ") - (set (make-local-variable 'comment-start-skip) - "\\(\\(?:^\\|[^\\\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*") (set (make-local-variable 'indent-line-function) #'cfengine-indent-line) (set (make-local-variable 'outline-regexp) "[ \t]*\\(\\sw\\|\\s_\\)+:+") (set (make-local-variable 'outline-level) #'cfengine-outline-level) @@ -233,20 +461,12 @@ to the action header." '(cfengine-font-lock-keywords nil nil nil beginning-of-line)) ;; Fixme: set the args of functions in evaluated classes to string ;; syntax, and then obey syntax properties. - (set (make-local-variable 'syntax-propertize-function) - ;; In the main syntax-table, \ is marked as a punctuation, because - ;; of its use in DOS-style directory separators. Here we try to - ;; recognize the cases where \ is used as an escape inside strings. - (syntax-propertize-rules ("\\(\\(?:\\\\\\)+\\)\"" (1 "\\")))) (setq imenu-generic-expression cfengine-imenu-expression) (set (make-local-variable 'beginning-of-defun-function) #'cfengine-beginning-of-defun) - (set (make-local-variable 'end-of-defun-function) #'cfengine-end-of-defun) - ;; Like Lisp mode. Without this, we lose with, say, - ;; `backward-up-list' when there's an unbalanced quote in a - ;; preceding comment. - (set (make-local-variable 'parse-sexp-ignore-comments) t)) + (set (make-local-variable 'end-of-defun-function) #'cfengine-end-of-defun)) +(provide 'cfengine3) (provide 'cfengine) ;;; cfengine.el ends here diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 1a23cd112af..3a9463f0f97 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -400,15 +400,16 @@ File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?" "^# Failed test [0-9]+ in \\([^ \t\r\n]+\\) at line \\([0-9]+\\)" 1 2) (perl--Test2 - ;; Or when comparing got/want values, + ;; Or when comparing got/want values, with a "fail #n" if repeated ;; # Test 2 got: "xx" (t-compilation-perl-2.t at line 10) + ;; # Test 3 got: "xx" (t-compilation-perl-2.t at line 10 fail #2) ;; ;; And under Test::Harness they're preceded by progress stuff with ;; \r and "NOK", ;; ... NOK 1# Test 1 got: "1234" (t/foo.t at line 46) ;; "^\\(.*NOK.*\\)?# Test [0-9]+ got:.* (\\([^ \t\r\n]+\\) at line \ -\\([0-9]+\\))" +\\([0-9]+\\)\\( fail #[0-9]+\\)?)" 2 3) (perl--Test::Harness ;; perl Test::Harness output, eg. @@ -2409,9 +2410,7 @@ and overlay is highlighted between MK and END-MK." ;; display the source in another window. (let ((pop-up-windows t)) (pop-to-buffer (marker-buffer mk) 'other-window)) - (if (window-dedicated-p (selected-window)) - (pop-to-buffer (marker-buffer mk)) - (switch-to-buffer (marker-buffer mk)))) + (pop-to-buffer-same-window (marker-buffer mk))) (unless (eq (goto-char mk) (point)) ;; If narrowing gets in the way of going to the right place, widen. (widen) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 2cce5e13fb0..48df73a678f 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1522,7 +1522,7 @@ the last)." (defvar compilation-error-regexp-alist) ;;;###autoload -(defun cperl-mode () +(define-derived-mode cperl-mode prog-mode "CPerl" "Major mode for editing Perl code. Expression and list commands understand all C brackets. Tab indents for Perl code. @@ -1695,9 +1695,6 @@ with no args. DO NOT FORGET to read micro-docs (available from `Perl' menu) or as help on variables `cperl-tips', `cperl-problems', `cperl-praise', `cperl-speed'." - (interactive) - (kill-all-local-variables) - (use-local-map cperl-mode-map) (if (cperl-val 'cperl-electric-linefeed) (progn (local-set-key "\C-J" 'cperl-linefeed) @@ -1710,8 +1707,6 @@ or as help on variables `cperl-tips', `cperl-problems', (cperl-define-key "\C-hf" 'cperl-info-on-current-command [(control h) f]) (cperl-define-key "\C-c\C-hf" 'cperl-info-on-command [(control c) (control h) f]))) - (setq major-mode cperl-use-major-mode) - (setq mode-name "CPerl") (let ((prev-a-c abbrevs-changed)) (define-abbrev-table 'cperl-mode-abbrev-table '( ("if" "if" cperl-electric-keyword 0) @@ -8971,18 +8966,6 @@ do extra unwind via `cperl-unwind-to-safe'." (substring v (match-beginning 1) (match-end 1))) "Version of IZ-supported CPerl package this file is based on.") -(defun cperl-mode-unload-function () - "Unload the Cperl mode library." - (let ((new-mode (if (eq (symbol-function 'perl-mode) 'cperl-mode) - 'fundamental-mode - 'perl-mode))) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when (eq major-mode 'cperl-mode) - (funcall new-mode))))) - ;; continue standard unloading - nil) - (provide 'cperl-mode) ;;; cperl-mode.el ends here diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index 849b9c0c3f7..cdb5f2a715d 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -26,6 +26,7 @@ ;; Major mode for editing F90 programs in FREE FORMAT. ;; The minor language revision F95 is also supported (with font-locking). ;; Some/many (?) aspects of F2003 are supported. +;; Some aspects of F2008 are supported. ;; Knows about continuation lines, named structured statements, and other ;; features in F90 including HPF (High Performance Fortran) structures. @@ -207,6 +208,13 @@ :group 'f90-indent :version "23.1") +(defcustom f90-critical-indent 2 + "Extra indentation applied to BLOCK, CRITICAL blocks." + :type 'integer + :safe 'integerp + :group 'f90-indent + :version "24.1") + (defcustom f90-continuation-indent 5 "Extra indentation applied to continuation lines." :type 'integer @@ -310,6 +318,9 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil." "deferred" "enum" "enumerator" "extends" "extends_type_of" "final" "generic" "import" "non_intrinsic" "non_overridable" "nopass" "pass" "protected" "same_type_as" "value" "volatile" + ;; F2008. + "contiguous" "submodule" "concurrent" "codimension" + "sync all" "sync memory" "critical" "image_index" ) 'words) "Regexp used by the function `f90-change-keywords'.") @@ -327,6 +338,10 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil." ;; F2003. asynchronous separate. "abstract" "deferred" "import" "final" "non_intrinsic" "non_overridable" "nopass" "pass" "protected" "value" "volatile" + ;; F2008. + ;; "concurrent" is only in the sense of "do [,] concurrent", but given + ;; the [,] it's simpler to just do every instance (cf "do while"). + "contiguous" "concurrent" "codimension" "sync all" "sync memory" ) 'words) "Keyword-regexp for font-lock level >= 3.") @@ -365,6 +380,20 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil." ;; F2003 iso_c_binding intrinsic module. "c_loc" "c_funloc" "c_associated" "c_f_pointer" "c_f_procpointer" + ;; F2008. + "bge" "bgt" "ble" "blt" "dshiftl" "dshiftr" "leadz" "popcnt" + "poppar" "trailz" "maskl" "maskr" "shifta" "shiftl" "shiftr" + "merge_bits" "iall" "iany" "iparity" "storage_size" + "bessel_j0" "bessel_j1" "bessel_jn" + "bessel_y0" "bessel_y1" "bessel_yn" + "erf" "erfc" "erfc_scaled" "gamma" "hypot" "log_gamma" + "norm2" "parity" "findloc" "is_contiguous" + "sync images" "lock" "unlock" "image_index" + "lcobound" "ucobound" "num_images" "this_image" + ;; F2008 iso_fortran_env module. + "compiler_options" "compiler_version" + ;; F2008 iso_c_binding module. + "c_sizeof" ) t) ;; A left parenthesis to avoid highlighting non-procedures. "[ \t]*(") @@ -427,6 +456,11 @@ The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil." "ieee_exceptions" "ieee_arithmetic" "ieee_features" + ;; F2008 iso_fortran_env constants. + "character_kinds" "int8" "int16" "int32" "int64" + "integer_kinds" "iostat_inquire_internal_unit" + "logical_kinds" "real_kinds" "real32" "real64" "real128" + "lock_type" "atomic_int_kind" "atomic_logical_kind" ) 'words) "Regexp for Fortran intrinsic constants.") @@ -464,13 +498,18 @@ type-name parts, respectively." ;;; (1 font-lock-keyword-face) (3 font-lock-function-name-face)) '(f90-typedef-matcher (1 font-lock-keyword-face) (2 font-lock-function-name-face)) - ;; F2003. Prevent operators being highlighted as functions. - '("\\<\\(\\(?:end[ \t]*\\)?interface[ \t]*\\(?:assignment\\|operator\\|\ + ;; F2003. Prevent operators being highlighted as functions. + '("\\<\\(\\(?:end[ \t]*\\)?interface[ \t]*\\(?:assignment\\|operator\\|\ read\\|write\\)\\)[ \t]*(" (1 font-lock-keyword-face t)) ;; Other functions and declarations. Named interfaces = F2003. - '("\\<\\(\\(?:end[ \t]*\\)?\\(program\\|module\\|function\\|associate\\|\ -subroutine\\|interface\\)\\|use\\|call\\)\\>[ \t]*\\(\\sw+\\)?" + ;; F2008: end submodule submodule_name. + '("\\<\\(\\(?:end[ \t]*\\)?\\(program\\|\\(?:sub\\)?module\\|\ +function\\|associate\\|subroutine\\|interface\\)\\|use\\|call\\)\ +\\>[ \t]*\\(\\sw+\\)?" (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t)) + ;; F2008: submodule (parent_name) submodule_name. + '("\\<\\(submodule\\)\\>[ \t]*([^)\n]+)[ \t]*\\(\\sw+\\)?" + (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) ;; F2003. '("\\<\\(use\\)[ \t]*,[ \t]*\\(\\(?:non_\\)?intrinsic\\)[ \t]*::[ \t]*\ \\(\\sw+\\)" @@ -557,12 +596,16 @@ logical\\|double[ \t]*precision\\|\ ;; enum (F2003; must be followed by ", bind(C)"). '("\\<\\(enum\\)[ \t]*," (1 font-lock-keyword-face)) ;; end do, enum (F2003), if, select, where, and forall constructs. - '("\\<\\(end[ \t]*\\(do\\|if\\|enum\\|select\\|forall\\|where\\)\\)\\>\ + ;; block, critical (F2008). + ;; Note that "block data" may get somewhat mixed up with F2008 blocks, + ;; but since the former is obsolete I'm not going to worry about it. + '("\\<\\(end[ \t]*\\(do\\|if\\|enum\\|select\\|forall\\|where\\|\ +block\\|critical\\)\\)\\>\ \\([ \t]+\\(\\sw+\\)\\)?" (1 font-lock-keyword-face) (3 font-lock-constant-face nil t)) '("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|\ do\\([ \t]*while\\)?\\|select[ \t]*\\(?:case\\|type\\)\\|where\\|\ -forall\\)\\)\\>" +forall\\|block\\|critical\\)\\)\\>" (2 font-lock-constant-face nil t) (3 font-lock-keyword-face)) ;; Implicit declaration. '("\\<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\ @@ -776,12 +819,14 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") (regexp-opt '("do" "if" "interface" "function" "module" "program" "select" "subroutine" "type" "where" "forall" ;; F2003. - "enum" "associate")) + "enum" "associate" + ;; F2008. + "submodule" "block" "critical")) "\\)\\>") "Regexp potentially indicating a \"block\" of F90 code.") (defconst f90-program-block-re - (regexp-opt '("program" "module" "subroutine" "function") 'paren) + (regexp-opt '("program" "module" "subroutine" "function" "submodule") 'paren) "Regexp used to locate the start/end of a \"subprogram\".") ;; "class is" is F2003. @@ -839,7 +884,8 @@ allowed. This minor issue currently only affects \"(/\" and \"/)\".") (concat "^[ \t0-9]*\\<end[ \t]*" (regexp-opt '("do" "if" "forall" "function" "interface" "module" "program" "select" "subroutine" - "type" "where" "enum" "associate") t) + "type" "where" "enum" "associate" "submodule" + "block" "critical") t) "\\>") "Regexp matching the end of an F90 \"block\", from the line start. Used in the F90 entry in `hs-special-modes-alist'.") @@ -865,10 +911,10 @@ Used in the F90 entry in `hs-special-modes-alist'.") "[^i(!\n\"\& \t]\\|" ; not-i( "i[^s!\n\"\& \t]\\|" ; i not-s "is\\sw\\)\\|" - ;; "abstract interface" is F2003. - "program\\|\\(?:abstract[ \t]*\\)?interface\\|module\\|" + ;; "abstract interface" is F2003; "submodule" is F2008. + "program\\|\\(?:abstract[ \t]*\\)?interface\\|\\(?:sub\\)?module\\|" ;; "enum", but not "enumerator". - "function\\|subroutine\\|enum[^e]\\|associate" + "function\\|subroutine\\|enum[^e]\\|associate\\|block\\|critical" "\\)" "[ \t]*") "Regexp matching the start of an F90 \"block\", from the line start. @@ -906,6 +952,8 @@ Set subexpression 1 in the match-data to the name of the type." ) (list '(nil "^[ \t0-9]*program[ \t]+\\(\\sw+\\)" 1) + '("Submodules" "^[ \t0-9]*submodule[ \t]*([^)\n]+)[ \t]*\ +\\(\\sw+\\)[ \t]*\\(!\\|$\\)" 1) '("Modules" "^[ \t0-9]*module[ \t]+\\(\\sw+\\)[ \t]*\\(!\\|$\\)" 1) (list "Types" 'f90-imenu-type-matcher 1) ;; Does not handle: "type[, stuff] :: foo". @@ -953,11 +1001,13 @@ Set subexpression 1 in the match-data to the name of the type." ("`asy" . "asynchronous" ) ("`ba" . "backspace" ) ("`bd" . "block data" ) + ("`bl" . "block" ) ("`c" . "character" ) ("`cl" . "close" ) ("`cm" . "common" ) ("`cx" . "complex" ) ("`cn" . "contains" ) + ("`cr" . "critical" ) ("`cy" . "cycle" ) ("`de" . "deallocate" ) ("`df" . "define" ) @@ -1037,6 +1087,10 @@ Variables controlling indentation style and extra features: `f90-program-indent' Extra indentation within program/module/subroutine/function blocks (default 2). +`f90-associate-indent' + Extra indentation within associate blocks (default 2). +`f90-critical-indent' + Extra indentation within critical/block blocks (default 2). `f90-continuation-indent' Extra indentation applied to continuation lines (default 5). `f90-comment-region' @@ -1207,6 +1261,25 @@ NAME is nil if the statement has no label." (if (looking-at "\\<\\(associate\\)[ \t]*(") (list (match-string 1)))) +(defsubst f90-looking-at-critical () + "Return (KIND NAME) if a critical or block block starts after point." + (if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(critical\\|block\\)\\>") + (let ((struct (match-string 3)) + (label (match-string 2))) + (if (or (not (string-equal "block" struct)) + (save-excursion + (skip-chars-forward " \t") + (not (looking-at "data\\>")))) + (list struct label))))) + +(defsubst f90-looking-at-end-critical () + "Return non-nil if a critical or block block ends after point." + (if (looking-at "end[ \t]*\\(critical\\|block\\)\\>") + (or (not (string-equal "block" (match-string 1))) + (save-excursion + (skip-chars-forward " \t") + (not (looking-at "data\\>")))))) + (defsubst f90-looking-at-where-or-forall () "Return (KIND NAME) if a where or forall block starts after point. NAME is nil if the statement has no label." @@ -1257,6 +1330,8 @@ write\\)[ \t]*([^)\n]*)") ((and (not (looking-at "module[ \t]*procedure\\>")) (looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>")) (list (match-string 1) (match-string 2))) + ((looking-at "\\(submodule\\)[ \t]*([^)\n]+)[ \t]*\\(\\sw+\\)\\>") + (list (match-string 1) (match-string 2))) ((and (not (looking-at "end[ \t]*\\(function\\|subroutine\\)")) (looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)[ \t]+\ \\(\\sw+\\)")) @@ -1331,8 +1406,9 @@ if all else fails." (save-excursion (not (or (looking-at "end") (looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\ -\\|select[ \t]*\\(case\\|type\\)\\|case\\|where\\|forall\\)\\>") - (looking-at "\\(program\\|module\\|\ +\\|select[ \t]*\\(case\\|type\\)\\|case\\|where\\|forall\\|\ +block\\|critical\\)\\>") + (looking-at "\\(program\\|\\(?:sub\\)?module\\|\ \\(?:abstract[ \t]*\\)?interface\\|block[ \t]*data\\)\\>") (looking-at "\\(contains\\|\\sw+[ \t]*:\\)") (looking-at f90-type-def-re) @@ -1375,6 +1451,8 @@ Does not check type and subprogram indentation." (f90-looking-at-where-or-forall) (f90-looking-at-select-case)) (setq icol (+ icol f90-if-indent))) + ;; FIXME this makes no sense, because this section/function is + ;; only for if/do/select/where/forall ? ((f90-looking-at-associate) (setq icol (+ icol f90-associate-indent)))) (end-of-line)) @@ -1388,12 +1466,16 @@ Does not check type and subprogram indentation." (f90-looking-at-where-or-forall) (f90-looking-at-select-case)) (setq icol (+ icol f90-if-indent))) + ;; FIXME this makes no sense, because this section/function is + ;; only for if/do/select/where/forall ? ((f90-looking-at-associate) (setq icol (+ icol f90-associate-indent))) ((looking-at f90-end-if-re) (setq icol (- icol f90-if-indent))) ((looking-at f90-end-associate-re) (setq icol (- icol f90-associate-indent))) + ((f90-looking-at-end-critical) + (setq icol (- icol f90-critical-indent))) ((looking-at "end[ \t]*do\\>") (setq icol (- icol f90-do-indent)))) (end-of-line)) @@ -1441,6 +1523,8 @@ Does not check type and subprogram indentation." (setq icol (+ icol f90-type-indent))) ((f90-looking-at-associate) (setq icol (+ icol f90-associate-indent))) + ((f90-looking-at-critical) + (setq icol (+ icol f90-critical-indent))) ((or (f90-looking-at-program-block-start) (looking-at "contains[ \t]*\\($\\|!\\)")) (setq icol (+ icol f90-program-indent))))) @@ -1460,6 +1544,8 @@ Does not check type and subprogram indentation." (setq icol (- icol f90-type-indent))) ((looking-at f90-end-associate-re) (setq icol (- icol f90-associate-indent))) + ((f90-looking-at-end-critical) + (setq icol (- icol f90-critical-indent))) ((or (looking-at "contains[ \t]*\\(!\\|$\\)") (f90-looking-at-program-block-end)) (setq icol (- icol f90-program-indent)))))))))) @@ -1566,6 +1652,7 @@ Interactively, pushes mark before moving point." (f90-looking-at-select-case) (f90-looking-at-type-like) (f90-looking-at-associate) + (f90-looking-at-critical) (f90-looking-at-program-block-start) (f90-looking-at-if-then) (f90-looking-at-where-or-forall))) @@ -1627,6 +1714,7 @@ Interactively, pushes mark before moving point." (f90-looking-at-select-case) (f90-looking-at-type-like) (f90-looking-at-associate) + (f90-looking-at-critical) (f90-looking-at-program-block-start) (f90-looking-at-if-then) (f90-looking-at-where-or-forall))) @@ -1668,6 +1756,7 @@ A block is a subroutine, if-endif, etc." (f90-looking-at-select-case) (f90-looking-at-type-like) (f90-looking-at-associate) + (f90-looking-at-critical) (f90-looking-at-program-block-start) (f90-looking-at-if-then) (f90-looking-at-where-or-forall)) @@ -1804,6 +1893,8 @@ If run in the middle of a line, the line is not broken." f90-type-indent) ((setq struct (f90-looking-at-associate)) f90-associate-indent) + ((setq struct (f90-looking-at-critical)) + f90-critical-indent) ((or (setq struct (f90-looking-at-program-block-start)) (looking-at "contains[ \t]*\\($\\|!\\)")) f90-program-indent))) @@ -1839,6 +1930,8 @@ If run in the middle of a line, the line is not broken." f90-type-indent) ((setq struct (f90-looking-at-associate)) f90-associate-indent) + ((setq struct (f90-looking-at-critical)) + f90-critical-indent) ((setq struct (f90-looking-at-program-block-start)) f90-program-indent))) (setq ind-curr ind-lev) @@ -1857,6 +1950,7 @@ If run in the middle of a line, the line is not broken." ((looking-at f90-end-type-re) f90-type-indent) ((looking-at f90-end-associate-re) f90-associate-indent) + ((f90-looking-at-end-critical) f90-critical-indent) ((f90-looking-at-program-block-end) f90-program-indent))) (if ind-b (setq ind-lev (- ind-lev ind-b))) @@ -2062,6 +2156,7 @@ Leave point at the end of line." (f90-looking-at-select-case) (f90-looking-at-type-like) (f90-looking-at-associate) + (f90-looking-at-critical) (f90-looking-at-program-block-start) ;; Interpret a single END without a block ;; start to be the END of a program block diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index c01086c970e..1c138f053d3 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -924,8 +924,8 @@ Convert it to flymake internal format." ;; PHP ("\\(?:Parse\\|Fatal\\) error: \\(.*\\) in \\(.*\\) on line \\([0-9]+\\)" 2 3 nil 1) ;; LaTeX warnings (fileless) ("\\(LaTeX \\(Warning\\|Error\\): .*\\) on input line \\([0-9]+\\)" 20 3 nil 1) - ;; ant/javac - (" *\\(\\[javac\\] *\\)?\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)\:\\([0-9]+\\)\:[ \t\n]*\\(.+\\)" + ;; ant/javac. Note this also matches gcc warnings! + (" *\\(\\[javac\\] *\\)?\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)\:\\([0-9]+\\)\\(?:\:[0-9]+\\)?\:[ \t\n]*\\(.+\\)" 2 4 nil 5)) ;; compilation-error-regexp-alist) (flymake-reformat-err-line-patterns-from-compile-el compilation-error-regexp-alist-alist)) @@ -1339,8 +1339,12 @@ With arg, turn Flymake mode on if and only if arg is positive." ;; Turning the mode ON. (flymake-mode - (if (not (flymake-can-syntax-check-file buffer-file-name)) - (flymake-log 2 "flymake cannot check syntax in buffer %s" (buffer-name)) + (cond + ((not buffer-file-name) + (message "Flymake unable to run without a buffer file name")) + ((not (flymake-can-syntax-check-file buffer-file-name)) + (flymake-log 2 "flymake cannot check syntax in buffer %s" (buffer-name))) + (t (add-hook 'after-change-functions 'flymake-after-change-function nil t) (add-hook 'after-save-hook 'flymake-after-save-hook nil t) (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t) @@ -1352,7 +1356,7 @@ With arg, turn Flymake mode on if and only if arg is positive." (run-at-time nil 1 'flymake-on-timer-event (current-buffer))) (when flymake-start-syntax-check-on-find-file - (flymake-start-syntax-check)))) + (flymake-start-syntax-check))))) ;; Turning the mode OFF. (t @@ -1406,6 +1410,7 @@ With arg, turn Flymake mode on if and only if arg is positive." (cancel-timer flymake-timer) (setq flymake-timer nil))) +;;;###autoload (defun flymake-find-file-hook () ;;+(when flymake-start-syntax-check-on-find-file ;;+ (flymake-log 3 "starting syntax check on file open") diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 61055ef4342..87209a78ffb 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -104,7 +104,8 @@ (require 'bindat) (eval-when-compile (require 'cl)) -(declare-function speedbar-change-initial-expansion-list "speedbar" (new-default)) +(declare-function speedbar-change-initial-expansion-list + "speedbar" (new-default)) (declare-function speedbar-timer-fn "speedbar" ()) (declare-function speedbar-line-text "speedbar" (&optional p)) (declare-function speedbar-change-expand-button-char "speedbar" (char)) @@ -190,7 +191,8 @@ as returned from \"-break-list\" by `gdb-json-partial-output' (defvar gdb-current-language nil) (defvar gdb-var-list nil "List of variables in watch window. -Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS HAS_MORE FP) +Each element has the form + (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS HAS_MORE FP) where STATUS is nil (`unchanged'), `changed' or `out-of-scope', FP the frame address for root variables.") (defvar gdb-main-file nil "Source file from which program execution begins.") @@ -329,7 +331,7 @@ valid signal handlers.") "Maximum size of `gdb-debug-log'. If nil, size is unlimited." :group 'gdb :type '(choice (integer :tag "Number of elements") - (const :tag "Unlimited" nil)) + (const :tag "Unlimited" nil)) :version "22.1") (defcustom gdb-non-stop-setting t @@ -367,13 +369,18 @@ Emacs always switches to the thread which caused the stop." (set :tag "Selection of reasons..." (const :tag "A breakpoint was reached." "breakpoint-hit") (const :tag "A watchpoint was triggered." "watchpoint-trigger") - (const :tag "A read watchpoint was triggered." "read-watchpoint-trigger") - (const :tag "An access watchpoint was triggered." "access-watchpoint-trigger") + (const :tag "A read watchpoint was triggered." + "read-watchpoint-trigger") + (const :tag "An access watchpoint was triggered." + "access-watchpoint-trigger") (const :tag "Function finished execution." "function-finished") (const :tag "Location reached." "location-reached") - (const :tag "Watchpoint has gone out of scope" "watchpoint-scope") - (const :tag "End of stepping range reached." "end-stepping-range") - (const :tag "Signal received (like interruption)." "signal-received")) + (const :tag "Watchpoint has gone out of scope" + "watchpoint-scope") + (const :tag "End of stepping range reached." + "end-stepping-range") + (const :tag "Signal received (like interruption)." + "signal-received")) (const :tag "None" nil)) :group 'gdb-non-stop :version "23.2" @@ -488,17 +495,17 @@ predefined macros." :group 'gdb :version "22.1") - (defcustom gdb-create-source-file-list t - "Non-nil means create a list of files from which the executable was built. +(defcustom gdb-create-source-file-list t + "Non-nil means create a list of files from which the executable was built. Set this to nil if the GUD buffer displays \"initializing...\" in the mode line for a long time when starting, possibly because your executable was built from a large number of files. This allows quicker initialization but means that these files are not automatically enabled for debugging, e.g., you won't be able to click in the fringe to set a breakpoint until execution has already stopped there." - :type 'boolean - :group 'gdb - :version "23.1") + :type 'boolean + :group 'gdb + :version "23.1") (defcustom gdb-show-main nil "Non-nil means display source file containing the main routine at startup. @@ -644,12 +651,12 @@ detailed description of this mode. (interactive (list (gud-query-cmdline 'gdb))) (when (and gud-comint-buffer - (buffer-name gud-comint-buffer) - (get-buffer-process gud-comint-buffer) - (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))) - (gdb-restore-windows) - (error - "Multiple debugging requires restarting in text command mode")) + (buffer-name gud-comint-buffer) + (get-buffer-process gud-comint-buffer) + (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))) + (gdb-restore-windows) + (error + "Multiple debugging requires restarting in text command mode")) ;; (gud-common-init command-line nil 'gud-gdbmi-marker-filter) (set (make-local-variable 'gud-minor-mode) 'gdbmi) @@ -663,7 +670,7 @@ detailed description of this mode. (hsize (getenv "HISTSIZE"))) (dolist (file (append '("~/.gdbinit") (unless (string-equal (expand-file-name ".") - (expand-file-name "~")) + (expand-file-name "~")) '(".gdbinit")))) (if (file-readable-p (setq file (expand-file-name file))) (with-temp-buffer @@ -763,7 +770,7 @@ detailed description of this mode. 'gdb-mouse-set-clear-breakpoint) (define-key gud-minor-mode-map [left-fringe mouse-1] 'gdb-mouse-set-clear-breakpoint) - (define-key gud-minor-mode-map [left-margin C-mouse-1] + (define-key gud-minor-mode-map [left-margin C-mouse-1] 'gdb-mouse-toggle-breakpoint-margin) (define-key gud-minor-mode-map [left-fringe C-mouse-1] 'gdb-mouse-toggle-breakpoint-fringe) @@ -786,7 +793,10 @@ detailed description of this mode. (define-key gud-minor-mode-map [left-margin C-mouse-3] 'gdb-mouse-jump) - (local-set-key "\C-i" 'gud-gdb-complete-command) + (add-hook 'completion-at-point-functions #'gud-gdb-completion-at-point + nil 'local) + (local-set-key "\C-i" 'completion-at-point) + (setq gdb-first-prompt t) (setq gud-running nil) @@ -846,11 +856,11 @@ detailed description of this mode. ;; find source file and compilation directory here (gdb-input - ; Needs GDB 6.2 onwards. + ; Needs GDB 6.2 onwards. (list "-file-list-exec-source-files" 'gdb-get-source-file-list)) (if gdb-create-source-file-list (gdb-input - ; Needs GDB 6.0 onwards. + ; Needs GDB 6.0 onwards. (list "-file-list-exec-source-file" 'gdb-get-source-file))) (gdb-input (list "-gdb-show prompt" 'gdb-get-prompt))) @@ -859,7 +869,8 @@ detailed description of this mode. (goto-char (point-min)) (if (re-search-forward "No symbol" nil t) (progn - (message "This version of GDB doesn't support non-stop mode. Turning it off.") + (message + "This version of GDB doesn't support non-stop mode. Turning it off.") (setq gdb-non-stop nil) (setq gdb-version "pre-7.0")) (setq gdb-version "7.0+") @@ -882,8 +893,8 @@ detailed description of this mode. (list t nil) nil "-c" (concat gdb-cpp-define-alist-program " " gdb-cpp-define-alist-flags)))))) - (define-list (split-string output "\n" t)) - (name)) + (define-list (split-string output "\n" t)) + (name)) (setq gdb-define-alist nil) (dolist (define define-list) (setq name (nth 1 (split-string define "[( ]"))) @@ -893,13 +904,13 @@ detailed description of this mode. (defvar tooltip-use-echo-area) (defun gdb-tooltip-print (expr) - (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) - (goto-char (point-min)) - (if (re-search-forward ".*value=\\(\".*\"\\)" nil t) - (tooltip-show - (concat expr " = " (read (match-string 1))) - (or gud-tooltip-echo-area tooltip-use-echo-area - (not (display-graphic-p))))))) + (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) + (goto-char (point-min)) + (if (re-search-forward ".*value=\\(\".*\"\\)" nil t) + (tooltip-show + (concat expr " = " (read (match-string 1))) + (or gud-tooltip-echo-area tooltip-use-echo-area + (not (display-graphic-p))))))) ;; If expr is a macro for a function don't print because of possible dangerous ;; side-effects. Also printing a function within a tooltip generates an @@ -923,13 +934,13 @@ detailed description of this mode. (defmacro gdb-if-arrow (arrow-position &rest body) `(if ,arrow-position - (let ((buffer (marker-buffer ,arrow-position)) (line)) - (if (equal buffer (window-buffer (posn-window end))) - (with-current-buffer buffer - (when (or (equal start end) - (equal (posn-point start) - (marker-position ,arrow-position))) - ,@body)))))) + (let ((buffer (marker-buffer ,arrow-position)) (line)) + (if (equal buffer (window-buffer (posn-window end))) + (with-current-buffer buffer + (when (or (equal start end) + (equal (posn-point start) + (marker-position ,arrow-position))) + ,@body)))))) (defun gdb-mouse-until (event) "Continue running until a source line past the current line. @@ -1060,7 +1071,7 @@ With arg, enter name of variable to be watched in the minibuffer." (bindat-get-field result 'value) nil (bindat-get-field result 'has_more) - gdb-frame-address))) + gdb-frame-address))) (push var gdb-var-list) (speedbar 1) (unless (string-equal @@ -1091,20 +1102,20 @@ With arg, enter name of variable to be watched in the minibuffer." (setcar (nthcdr 4 var) (read (match-string 1))))) (gdb-speedbar-update)) -; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards. + ; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards. (defun gdb-var-list-children (varnum) (gdb-input (list (concat "-var-update " varnum) 'ignore)) (gdb-input (list (concat "-var-list-children --all-values " - varnum) - `(lambda () (gdb-var-list-children-handler ,varnum))))) + varnum) + `(lambda () (gdb-var-list-children-handler ,varnum))))) (defun gdb-var-list-children-handler (varnum) (let* ((var-list nil) (output (bindat-get-field (gdb-json-partial-output "child"))) (children (bindat-get-field output 'children))) - (catch 'child-already-watched + (catch 'child-already-watched (dolist (var gdb-var-list) (if (string-equal varnum (car var)) (progn @@ -1147,11 +1158,11 @@ With arg, enter name of variable to be watched in the minibuffer." (interactive) (let ((text (speedbar-line-text))) (string-match "\\(\\S-+\\)" text) - (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list)) - (varnum (car var))) - (if (string-match "\\." (car var)) - (message-box "Can only delete a root expression") - (gdb-var-delete-1 var varnum))))) + (let* ((var (nth (- (count-lines (point-min) (point)) 2) gdb-var-list)) + (varnum (car var))) + (if (string-match "\\." (car var)) + (message-box "Can only delete a root expression") + (gdb-var-delete-1 var varnum))))) (defun gdb-var-delete-children (varnum) "Delete children of variable object at point from the speedbar." @@ -1174,7 +1185,7 @@ With arg, enter name of variable to be watched in the minibuffer." (if (re-search-forward gdb-error-regexp nil t) (message-box "Invalid number or expression (%s)" value))) -; Uses "-var-update --all-values". Needs GDB 6.4 onwards. + ; Uses "-var-update --all-values". Needs GDB 6.4 onwards. (defun gdb-var-update () (if (not (gdb-pending-p 'gdb-var-update)) (gdb-input @@ -1210,38 +1221,38 @@ With arg, enter name of variable to be watched in the minibuffer." (gdb-var-delete-1 var varnum))))) (let ((var-list nil) var1 (children (bindat-get-field change 'new_children))) - (if new-num - (progn - (setq var1 (pop temp-var-list)) - (while var1 - (if (string-equal varnum (car var1)) - (let ((new (string-to-number new-num)) - (previous (string-to-number (nth 2 var1)))) - (setcar (nthcdr 2 var1) new-num) - (push var1 var-list) - (cond ((> new previous) - ;; Add new children to list. - (dotimes (dummy previous) - (push (pop temp-var-list) var-list)) - (dolist (child children) - (let ((varchild - (list (bindat-get-field child 'name) - (bindat-get-field child 'exp) - (bindat-get-field child 'numchild) - (bindat-get-field child 'type) - (bindat-get-field child 'value) - 'changed - (bindat-get-field child 'has_more)))) - (push varchild var-list)))) - ;; Remove deleted children from list. - ((< new previous) - (dotimes (dummy new) - (push (pop temp-var-list) var-list)) - (dotimes (dummy (- previous new)) - (pop temp-var-list))))) - (push var1 var-list)) - (setq var1 (pop temp-var-list))) - (setq gdb-var-list (nreverse var-list))))))))) + (when new-num + (setq var1 (pop temp-var-list)) + (while var1 + (if (string-equal varnum (car var1)) + (let ((new (string-to-number new-num)) + (previous (string-to-number (nth 2 var1)))) + (setcar (nthcdr 2 var1) new-num) + (push var1 var-list) + (cond + ((> new previous) + ;; Add new children to list. + (dotimes (dummy previous) + (push (pop temp-var-list) var-list)) + (dolist (child children) + (let ((varchild + (list (bindat-get-field child 'name) + (bindat-get-field child 'exp) + (bindat-get-field child 'numchild) + (bindat-get-field child 'type) + (bindat-get-field child 'value) + 'changed + (bindat-get-field child 'has_more)))) + (push varchild var-list)))) + ;; Remove deleted children from list. + ((< new previous) + (dotimes (dummy new) + (push (pop temp-var-list) var-list)) + (dotimes (dummy (- previous new)) + (pop temp-var-list))))) + (push var1 var-list)) + (setq var1 (pop temp-var-list))) + (setq gdb-var-list (nreverse var-list)))))))) (setq gdb-pending-triggers (delq 'gdb-var-update gdb-pending-triggers)) (gdb-speedbar-update)) @@ -1369,7 +1380,8 @@ this trigger is subscribed to `gdb-buf-publisher' and called with (when trigger (gdb-add-subscriber gdb-buf-publisher (cons (current-buffer) - (gdb-bind-function-to-buffer trigger (current-buffer)))) + (gdb-bind-function-to-buffer + trigger (current-buffer)))) (funcall trigger 'start)) (current-buffer)))))) @@ -1783,8 +1795,8 @@ is running." ;; visited breakpoint is, use that window. (defun gdb-display-source-buffer (buffer) (let* ((last-window (if gud-last-last-frame - (get-buffer-window - (gud-find-file (car gud-last-last-frame))))) + (get-buffer-window + (gud-find-file (car gud-last-last-frame))))) (source-window (or last-window (if (and gdb-source-window (window-live-p gdb-source-window)) @@ -1857,7 +1869,7 @@ is running." ;; Suppress "No registers." since GDB 6.8 and earlier duplicates MI ;; error message on internal stream. Don't print to GUD buffer. (unless (and (eq record-type 'gdb-internals) - (string-equal (read arg1) "No registers.\n")) + (string-equal (read arg1) "No registers.\n")) (funcall record-type arg1)))))) (setq gdb-output-sink 'user) @@ -1881,15 +1893,15 @@ is running." (defun gdb-thread-exited (output-field) "Handle =thread-exited async record: unset `gdb-thread-number' if current thread exited and update threads list." - (let* ((thread-id (bindat-get-field (gdb-json-string output-field) 'id))) - (if (string= gdb-thread-number thread-id) - (gdb-setq-thread-number nil)) - ;; When we continue current thread and it quickly exits, - ;; gdb-pending-triggers left after gdb-running disallow us to - ;; properly call -thread-info without --thread option. Thus we - ;; need to use gdb-wait-for-pending. - (gdb-wait-for-pending - (gdb-emit-signal gdb-buf-publisher 'update-threads)))) + (let* ((thread-id (bindat-get-field (gdb-json-string output-field) 'id))) + (if (string= gdb-thread-number thread-id) + (gdb-setq-thread-number nil)) + ;; When we continue current thread and it quickly exits, + ;; gdb-pending-triggers left after gdb-running disallow us to + ;; properly call -thread-info without --thread option. Thus we + ;; need to use gdb-wait-for-pending. + (gdb-wait-for-pending + (gdb-emit-signal gdb-buf-publisher 'update-threads)))) (defun gdb-thread-selected (output-field) "Handler for =thread-selected MI output record. @@ -1909,7 +1921,8 @@ Sets `gdb-thread-number' to new id." (gdb-update)))) (defun gdb-running (output-field) - (let* ((thread-id (bindat-get-field (gdb-json-string output-field) 'thread-id))) + (let* ((thread-id + (bindat-get-field (gdb-json-string output-field) 'thread-id))) ;; We reset gdb-frame-number to nil if current thread has gone ;; running. This can't be done in gdb-thread-list-handler-custom ;; because we need correct gdb-frame-number by the time @@ -1984,23 +1997,23 @@ current thread and update GDB buffers." ;; reasons (if (or (eq gdb-switch-reasons t) (member reason gdb-switch-reasons)) - (when (not (string-equal gdb-thread-number thread-id)) - (message (concat "Switched to thread " thread-id)) - (gdb-setq-thread-number thread-id)) + (when (not (string-equal gdb-thread-number thread-id)) + (message (concat "Switched to thread " thread-id)) + (gdb-setq-thread-number thread-id)) (message (format "Thread %s stopped" thread-id))))) - ;; Print "(gdb)" to GUD console - (when gdb-first-done-or-error - (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name))) + ;; Print "(gdb)" to GUD console + (when gdb-first-done-or-error + (setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name))) - ;; In non-stop, we update information as soon as another thread gets - ;; stopped - (when (or gdb-first-done-or-error - gdb-non-stop) - ;; In all-stop this updates gud-running properly as well. - (gdb-update) - (setq gdb-first-done-or-error nil)) - (run-hook-with-args 'gdb-stopped-hooks result))) + ;; In non-stop, we update information as soon as another thread gets + ;; stopped + (when (or gdb-first-done-or-error + gdb-non-stop) + ;; In all-stop this updates gud-running properly as well. + (gdb-update) + (setq gdb-first-done-or-error nil)) + (run-hook-with-args 'gdb-stopped-hooks result))) ;; Remove the trimmings from log stream containing debugging messages ;; being produced by GDB's internals, use warning face and send to GUD @@ -2020,7 +2033,7 @@ current thread and update GDB buffers." ;; Remove the trimmings from the console stream and send to GUD buffer ;; (frontend MI commands should not print to this stream) (defun gdb-console (output-field) - (setq gdb-filter-output + (setq gdb-filter-output (gdb-concat-output gdb-filter-output (read output-field)))) @@ -2033,11 +2046,11 @@ current thread and update GDB buffers." (setq token-number nil) ;; MI error - send to minibuffer (when (eq type 'error) - ;; Skip "msg=" from `output-field' - (message (read (substring output-field 4))) - ;; Don't send to the console twice. (If it is a console error - ;; it is also in the console stream.) - (setq output-field nil))) + ;; Skip "msg=" from `output-field' + (message (read (substring output-field 4))) + ;; Don't send to the console twice. (If it is a console error + ;; it is also in the console stream.) + (setq output-field nil))) ;; Output from command from frontend. (setq gdb-output-sink 'emacs)) @@ -2215,11 +2228,11 @@ calling `gdb-table-string'." (append row-properties (list properties))) (setf (gdb-table-column-sizes table) (gdb-mapcar* (lambda (x s) - (let ((new-x - (max (abs x) (string-width (or s ""))))) - (if right-align new-x (- new-x)))) - (gdb-table-column-sizes table) - row)) + (let ((new-x + (max (abs x) (string-width (or s ""))))) + (if right-align new-x (- new-x)))) + (gdb-table-column-sizes table) + row)) ;; Avoid trailing whitespace at eol (if (not (gdb-table-right-align table)) (setcar (last (gdb-table-column-sizes table)) 0)))) @@ -2308,8 +2321,8 @@ If NOPRESERVE is non-nil, window point is not restored after CUSTOM-DEFUN." '(set-window-point window p))))) (defmacro def-gdb-trigger-and-handler (trigger-name gdb-command - handler-name custom-defun - &optional signal-list) + handler-name custom-defun + &optional signal-list) "Define trigger and handler. TRIGGER-NAME trigger is defined to send GDB-COMMAND. See @@ -2353,29 +2366,29 @@ HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See (pending (bindat-get-field breakpoint 'pending)) (func (bindat-get-field breakpoint 'func)) (type (bindat-get-field breakpoint 'type))) - (gdb-table-add-row table - (list - (bindat-get-field breakpoint 'number) - type - (bindat-get-field breakpoint 'disp) - (let ((flag (bindat-get-field breakpoint 'enabled))) - (if (string-equal flag "y") - (propertize "y" 'font-lock-face font-lock-warning-face) - (propertize "n" 'font-lock-face font-lock-comment-face))) - (bindat-get-field breakpoint 'addr) - (bindat-get-field breakpoint 'times) - (if (string-match ".*watchpoint" type) - (bindat-get-field breakpoint 'what) - (or pending at - (concat "in " - (propertize (or func "unknown") - 'font-lock-face font-lock-function-name-face) - (gdb-frame-location breakpoint))))) - ;; Add clickable properties only for breakpoints with file:line - ;; information - (append (list 'gdb-breakpoint breakpoint) - (when func '(help-echo "mouse-2, RET: visit breakpoint" - mouse-face highlight)))))) + (gdb-table-add-row table + (list + (bindat-get-field breakpoint 'number) + type + (bindat-get-field breakpoint 'disp) + (let ((flag (bindat-get-field breakpoint 'enabled))) + (if (string-equal flag "y") + (propertize "y" 'font-lock-face font-lock-warning-face) + (propertize "n" 'font-lock-face font-lock-comment-face))) + (bindat-get-field breakpoint 'addr) + (bindat-get-field breakpoint 'times) + (if (string-match ".*watchpoint" type) + (bindat-get-field breakpoint 'what) + (or pending at + (concat "in " + (propertize (or func "unknown") + 'font-lock-face font-lock-function-name-face) + (gdb-frame-location breakpoint))))) + ;; Add clickable properties only for breakpoints with file:line + ;; information + (append (list 'gdb-breakpoint breakpoint) + (when func '(help-echo "mouse-2, RET: visit breakpoint" + mouse-face highlight)))))) (insert (gdb-table-string table " ")) (gdb-place-breakpoints))) @@ -2389,7 +2402,7 @@ HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See (gdb-remove-breakpoint-icons (point-min) (point-max))))) (dolist (breakpoint gdb-breakpoints-list) (let* ((breakpoint (cdr breakpoint)) ; gdb-breakpoints-list is - ; an associative list + ; an associative list (line (bindat-get-field breakpoint 'line))) (when line (let ((file (bindat-get-field breakpoint 'fullname)) @@ -2411,7 +2424,7 @@ HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See (gdb-input (list "-file-list-exec-source-file" `(lambda () (gdb-get-location - ,bptno ,line ,flag)))))))))) + ,bptno ,line ,flag)))))))))) (defvar gdb-source-file-regexp "fullname=\"\\(.*?\\)\"") @@ -2422,7 +2435,7 @@ Put in buffer and place breakpoint icon." (catch 'file-not-found (if (re-search-forward gdb-source-file-regexp nil t) (delete (cons bptno "File not found") gdb-location-alist) - (push (cons bptno (match-string 1)) gdb-location-alist) + (push (cons bptno (match-string 1)) gdb-location-alist) (gdb-resync) (unless (assoc bptno gdb-location-alist) (push (cons bptno "File not found") gdb-location-alist) @@ -2510,20 +2523,20 @@ If not in a source or disassembly buffer just set point." (if (get-text-property 0 'gdb-enabled obj) "-break-disable " "-break-enable ") - (get-text-property 0 'gdb-bptno obj))))))))) + (get-text-property 0 'gdb-bptno obj))))))))) (defun gdb-breakpoints-buffer-name () (concat "*breakpoints of " (gdb-get-target-string) "*")) (def-gdb-display-buffer - gdb-display-breakpoints-buffer - 'gdb-breakpoints-buffer - "Display status of user-settable breakpoints.") + gdb-display-breakpoints-buffer + 'gdb-breakpoints-buffer + "Display status of user-settable breakpoints.") (def-gdb-frame-for-buffer - gdb-frame-breakpoints-buffer - 'gdb-breakpoints-buffer - "Display status of user-settable breakpoints in a new frame.") + gdb-frame-breakpoints-buffer + 'gdb-breakpoints-buffer + "Display status of user-settable breakpoints in a new frame.") (defvar gdb-breakpoints-mode-map (let ((map (make-sparse-keymap)) @@ -2540,9 +2553,9 @@ If not in a source or disassembly buffer just set point." (define-key map "q" 'gdb-delete-frame-or-window) (define-key map "\r" 'gdb-goto-breakpoint) (define-key map "\t" (lambda () - (interactive) - (gdb-set-window-buffer - (gdb-get-buffer-create 'gdb-threads-buffer) t))) + (interactive) + (gdb-set-window-buffer + (gdb-get-buffer-create 'gdb-threads-buffer) t))) (define-key map [mouse-2] 'gdb-goto-breakpoint) (define-key map [follow-link] 'mouse-face) map)) @@ -2585,14 +2598,14 @@ corresponding to the mode line clicked." (concat "*threads of " (gdb-get-target-string) "*")) (def-gdb-display-buffer - gdb-display-threads-buffer - 'gdb-threads-buffer - "Display GDB threads.") + gdb-display-threads-buffer + 'gdb-threads-buffer + "Display GDB threads.") (def-gdb-frame-for-buffer - gdb-frame-threads-buffer - 'gdb-threads-buffer - "Display GDB threads in a new frame.") + gdb-frame-threads-buffer + 'gdb-threads-buffer + "Display GDB threads in a new frame.") (def-gdb-trigger-and-handler gdb-invalidate-threads (gdb-current-context-command "-thread-info") @@ -2626,18 +2639,20 @@ corresponding to the mode line clicked." (define-key map "i" 'gdb-interrupt-thread) (define-key map "c" 'gdb-continue-thread) (define-key map "s" 'gdb-step-thread) - (define-key map "\t" (lambda () - (interactive) - (gdb-set-window-buffer - (gdb-get-buffer-create 'gdb-breakpoints-buffer) t))) + (define-key map "\t" + (lambda () + (interactive) + (gdb-set-window-buffer + (gdb-get-buffer-create 'gdb-breakpoints-buffer) t))) (define-key map [mouse-2] 'gdb-select-thread) (define-key map [follow-link] 'mouse-face) map)) (defvar gdb-threads-header (list - (gdb-propertize-header "Breakpoints" gdb-breakpoints-buffer - "mouse-1: select" mode-line-highlight mode-line-inactive) + (gdb-propertize-header + "Breakpoints" gdb-breakpoints-buffer + "mouse-1: select" mode-line-highlight mode-line-inactive) " " (gdb-propertize-header "Threads" gdb-threads-buffer nil nil mode-line))) @@ -2661,44 +2676,45 @@ corresponding to the mode line clicked." (set-marker gdb-thread-position nil) (dolist (thread (reverse threads-list)) - (let ((running (string-equal (bindat-get-field thread 'state) "running"))) - (add-to-list 'gdb-threads-list - (cons (bindat-get-field thread 'id) - thread)) - (if running - (incf gdb-running-threads-count) - (incf gdb-stopped-threads-count)) - - (gdb-table-add-row table - (list - (bindat-get-field thread 'id) - (concat - (if gdb-thread-buffer-verbose-names - (concat (bindat-get-field thread 'target-id) " ") "") - (bindat-get-field thread 'state) - ;; Include frame information for stopped threads - (if (not running) - (concat - " in " (bindat-get-field thread 'frame 'func) - (if gdb-thread-buffer-arguments - (concat - " (" - (let ((args (bindat-get-field thread 'frame 'args))) - (mapconcat - (lambda (arg) - (apply 'format `("%s=%s" ,@(gdb-get-many-fields arg 'name 'value)))) - args ",")) - ")") - "") - (if gdb-thread-buffer-locations - (gdb-frame-location (bindat-get-field thread 'frame)) "") - (if gdb-thread-buffer-addresses - (concat " at " (bindat-get-field thread 'frame 'addr)) "")) - ""))) - (list - 'gdb-thread thread - 'mouse-face 'highlight - 'help-echo "mouse-2, RET: select thread"))) + (let ((running (equal (bindat-get-field thread 'state) "running"))) + (add-to-list 'gdb-threads-list + (cons (bindat-get-field thread 'id) + thread)) + (if running + (incf gdb-running-threads-count) + (incf gdb-stopped-threads-count)) + + (gdb-table-add-row table + (list + (bindat-get-field thread 'id) + (concat + (if gdb-thread-buffer-verbose-names + (concat (bindat-get-field thread 'target-id) " ") "") + (bindat-get-field thread 'state) + ;; Include frame information for stopped threads + (if (not running) + (concat + " in " (bindat-get-field thread 'frame 'func) + (if gdb-thread-buffer-arguments + (concat + " (" + (let ((args (bindat-get-field thread 'frame 'args))) + (mapconcat + (lambda (arg) + (apply #'format "%s=%s" + (gdb-get-many-fields arg 'name 'value))) + args ",")) + ")") + "") + (if gdb-thread-buffer-locations + (gdb-frame-location (bindat-get-field thread 'frame)) "") + (if gdb-thread-buffer-addresses + (concat " at " (bindat-get-field thread 'frame 'addr)) "")) + ""))) + (list + 'gdb-thread thread + 'mouse-face 'highlight + 'help-echo "mouse-2, RET: select thread"))) (when (string-equal gdb-thread-number (bindat-get-field thread 'id)) (setq marked-line (length gdb-threads-list)))) @@ -2727,7 +2743,8 @@ be the value of 'gdb-thread property of the current line. If ,custom-defun (error "Not recognized as thread line")))))) -(defmacro def-gdb-thread-buffer-simple-command (name buffer-command &optional doc) +(defmacro def-gdb-thread-buffer-simple-command (name buffer-command + &optional doc) "Define a NAME which will call BUFFER-COMMAND with id of thread on the current line." `(def-gdb-thread-buffer-command ,name @@ -2830,19 +2847,19 @@ line." (defcustom gdb-memory-format "x" "Display format of data items in memory window." :type '(choice (const :tag "Hexadecimal" "x") - (const :tag "Signed decimal" "d") - (const :tag "Unsigned decimal" "u") - (const :tag "Octal" "o") - (const :tag "Binary" "t")) + (const :tag "Signed decimal" "d") + (const :tag "Unsigned decimal" "u") + (const :tag "Octal" "o") + (const :tag "Binary" "t")) :group 'gud :version "22.1") (defcustom gdb-memory-unit 4 "Unit size of data items in memory window." :type '(choice (const :tag "Byte" 1) - (const :tag "Halfword" 2) - (const :tag "Word" 4) - (const :tag "Giant word" 8)) + (const :tag "Halfword" 2) + (const :tag "Word" 4) + (const :tag "Giant word" 8)) :group 'gud :version "23.2") @@ -2893,14 +2910,14 @@ in `gdb-memory-format'." (setq gdb-memory-next-page (bindat-get-field res 'next-page)) (setq gdb-memory-prev-page (bindat-get-field res 'prev-page)) (setq gdb-memory-last-address gdb-memory-address) - (dolist (row memory) - (insert (concat (bindat-get-field row 'addr) ":")) - (dolist (column (bindat-get-field row 'data)) - (insert (gdb-pad-string column - (+ 2 (gdb-memory-column-width - gdb-memory-unit - gdb-memory-format))))) - (newline))) + (dolist (row memory) + (insert (concat (bindat-get-field row 'addr) ":")) + (dolist (column (bindat-get-field row 'data)) + (insert (gdb-pad-string column + (+ 2 (gdb-memory-column-width + gdb-memory-unit + gdb-memory-format))))) + (newline))) ;; Show last page instead of empty buffer when out of bounds (progn (let ((gdb-memory-address gdb-memory-last-address)) @@ -2925,7 +2942,7 @@ in `gdb-memory-format'." (define-key map "g" 'gdb-memory-unit-giant) (define-key map "R" 'gdb-memory-set-rows) (define-key map "C" 'gdb-memory-set-columns) - map)) + map)) (defun gdb-memory-set-address-event (event) "Handle a click on address field in memory buffer header." @@ -3115,8 +3132,8 @@ DOC is an optional documentation string." (defvar gdb-memory-font-lock-keywords '(;; <__function.name+n> - ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>" (1 font-lock-function-name-face)) - ) + ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>" + (1 font-lock-function-name-face))) "Font lock keywords used in `gdb-memory-mode'.") (defvar gdb-memory-header @@ -3124,52 +3141,52 @@ DOC is an optional documentation string." (concat "Start address[" (propertize "-" - 'face font-lock-warning-face - 'help-echo "mouse-1: decrement address" - 'mouse-face 'mode-line-highlight - 'local-map (gdb-make-header-line-mouse-map - 'mouse-1 - #'gdb-memory-show-previous-page)) + 'face font-lock-warning-face + 'help-echo "mouse-1: decrement address" + 'mouse-face 'mode-line-highlight + 'local-map (gdb-make-header-line-mouse-map + 'mouse-1 + #'gdb-memory-show-previous-page)) "|" (propertize "+" - 'face font-lock-warning-face - 'help-echo "mouse-1: increment address" + 'face font-lock-warning-face + 'help-echo "mouse-1: increment address" 'mouse-face 'mode-line-highlight 'local-map (gdb-make-header-line-mouse-map 'mouse-1 #'gdb-memory-show-next-page)) - "]: " - (propertize gdb-memory-address + "]: " + (propertize gdb-memory-address 'face font-lock-warning-face 'help-echo "mouse-1: set start address" 'mouse-face 'mode-line-highlight 'local-map (gdb-make-header-line-mouse-map 'mouse-1 #'gdb-memory-set-address-event)) - " Rows: " - (propertize (number-to-string gdb-memory-rows) + " Rows: " + (propertize (number-to-string gdb-memory-rows) 'face font-lock-warning-face 'help-echo "mouse-1: set number of columns" 'mouse-face 'mode-line-highlight 'local-map (gdb-make-header-line-mouse-map 'mouse-1 #'gdb-memory-set-rows)) - " Columns: " - (propertize (number-to-string gdb-memory-columns) + " Columns: " + (propertize (number-to-string gdb-memory-columns) 'face font-lock-warning-face 'help-echo "mouse-1: set number of columns" 'mouse-face 'mode-line-highlight 'local-map (gdb-make-header-line-mouse-map 'mouse-1 #'gdb-memory-set-columns)) - " Display Format: " - (propertize gdb-memory-format + " Display Format: " + (propertize gdb-memory-format 'face font-lock-warning-face 'help-echo "mouse-3: select display format" 'mouse-face 'mode-line-highlight 'local-map gdb-memory-format-map) - " Unit Size: " - (propertize (number-to-string gdb-memory-unit) + " Unit Size: " + (propertize (number-to-string gdb-memory-unit) 'face font-lock-warning-face 'help-echo "mouse-3: select unit size" 'mouse-face 'mode-line-highlight @@ -3210,18 +3227,18 @@ DOC is an optional documentation string." (concat "disassembly of " (gdb-get-target-string)))) (def-gdb-display-buffer - gdb-display-disassembly-buffer - 'gdb-disassembly-buffer - "Display disassembly for current stack frame.") + gdb-display-disassembly-buffer + 'gdb-disassembly-buffer + "Display disassembly for current stack frame.") (def-gdb-preempt-display-buffer gdb-preemptively-display-disassembly-buffer 'gdb-disassembly-buffer) (def-gdb-frame-for-buffer - gdb-frame-disassembly-buffer - 'gdb-disassembly-buffer - "Display disassembly in a new frame.") + gdb-frame-disassembly-buffer + 'gdb-disassembly-buffer + "Display disassembly in a new frame.") (def-gdb-auto-update-trigger gdb-invalidate-disassembly (let* ((frame (gdb-current-buffer-frame)) @@ -3266,7 +3283,7 @@ DOC is an optional documentation string." (let ((map (make-sparse-keymap))) (suppress-keymap map) (define-key map "q" 'kill-this-buffer) - map)) + map)) (define-derived-mode gdb-disassembly-mode gdb-parent-mode "Disassembly" "Major mode for GDB disassembly information." @@ -3283,12 +3300,13 @@ DOC is an optional documentation string." (address (bindat-get-field (gdb-current-buffer-frame) 'addr)) (table (make-gdb-table)) (marked-line nil)) - (dolist (instr instructions) + (dolist (instr instructions) (gdb-table-add-row table - (list - (bindat-get-field instr 'address) - (apply 'format `("<%s+%s>:" ,@(gdb-get-many-fields instr 'func-name 'offset))) - (bindat-get-field instr 'inst))) + (list + (bindat-get-field instr 'address) + (apply #'format "<%s+%s>:" + (gdb-get-many-fields instr 'func-name 'offset)) + (bindat-get-field instr 'inst))) (when (string-equal (bindat-get-field instr 'address) address) (progn @@ -3297,17 +3315,18 @@ DOC is an optional documentation string." (if (string-equal gdb-frame-number "0") nil '((overlay-arrow . hollow-right-triangle))))))) - (insert (gdb-table-string table " ")) - (gdb-disassembly-place-breakpoints) - ;; Mark current position with overlay arrow and scroll window to - ;; that point - (when marked-line - (let ((window (get-buffer-window (current-buffer) 0))) - (set-window-point window (gdb-mark-line marked-line gdb-disassembly-position)))) - (setq mode-name - (gdb-current-context-mode-name - (concat "Disassembly: " - (bindat-get-field (gdb-current-buffer-frame) 'func)))))) + (insert (gdb-table-string table " ")) + (gdb-disassembly-place-breakpoints) + ;; Mark current position with overlay arrow and scroll window to + ;; that point + (when marked-line + (let ((window (get-buffer-window (current-buffer) 0))) + (set-window-point window (gdb-mark-line marked-line + gdb-disassembly-position)))) + (setq mode-name + (gdb-current-context-mode-name + (concat "Disassembly: " + (bindat-get-field (gdb-current-buffer-frame) 'func)))))) (defun gdb-disassembly-place-breakpoints () (gdb-remove-breakpoint-icons (point-min) (point-max)) @@ -3328,7 +3347,8 @@ DOC is an optional documentation string." nil nil mode-line) " " (gdb-propertize-header "Threads" gdb-threads-buffer - "mouse-1: select" mode-line-highlight mode-line-inactive))) + "mouse-1: select" mode-line-highlight + mode-line-inactive))) ;;; Breakpoints view (define-derived-mode gdb-breakpoints-mode gdb-parent-mode "Breakpoints" @@ -3344,7 +3364,7 @@ DOC is an optional documentation string." (let ((breakpoint (get-text-property (point) 'gdb-breakpoint))) (if breakpoint (gud-basic-call - (concat (if (string-equal "y" (bindat-get-field breakpoint 'enabled)) + (concat (if (equal "y" (bindat-get-field breakpoint 'enabled)) "-break-disable " "-break-enable ") (bindat-get-field breakpoint 'number))) @@ -3354,11 +3374,12 @@ DOC is an optional documentation string." "Delete the breakpoint at current line of breakpoints buffer." (interactive) (save-excursion - (beginning-of-line) - (let ((breakpoint (get-text-property (point) 'gdb-breakpoint))) - (if breakpoint - (gud-basic-call (concat "-break-delete " (bindat-get-field breakpoint 'number))) - (error "Not recognized as break/watchpoint line"))))) + (beginning-of-line) + (let ((breakpoint (get-text-property (point) 'gdb-breakpoint))) + (if breakpoint + (gud-basic-call (concat "-break-delete " + (bindat-get-field breakpoint 'number))) + (error "Not recognized as break/watchpoint line"))))) (defun gdb-goto-breakpoint (&optional event) "Go to the location of breakpoint at current line of @@ -3369,24 +3390,24 @@ breakpoints buffer." (let ((window (get-buffer-window gud-comint-buffer))) (if window (save-selected-window (select-window window)))) (save-excursion - (beginning-of-line) - (let ((breakpoint (get-text-property (point) 'gdb-breakpoint))) - (if breakpoint - (let ((bptno (bindat-get-field breakpoint 'number)) - (file (bindat-get-field breakpoint 'fullname)) - (line (bindat-get-field breakpoint 'line))) - (save-selected-window - (let* ((buffer (find-file-noselect - (if (file-exists-p file) file - (cdr (assoc bptno gdb-location-alist))))) - (window (or (gdb-display-source-buffer buffer) - (display-buffer buffer)))) - (setq gdb-source-window window) - (with-current-buffer buffer - (goto-char (point-min)) - (forward-line (1- (string-to-number line))) - (set-window-point window (point)))))) - (error "Not recognized as break/watchpoint line"))))) + (beginning-of-line) + (let ((breakpoint (get-text-property (point) 'gdb-breakpoint))) + (if breakpoint + (let ((bptno (bindat-get-field breakpoint 'number)) + (file (bindat-get-field breakpoint 'fullname)) + (line (bindat-get-field breakpoint 'line))) + (save-selected-window + (let* ((buffer (find-file-noselect + (if (file-exists-p file) file + (cdr (assoc bptno gdb-location-alist))))) + (window (or (gdb-display-source-buffer buffer) + (display-buffer buffer)))) + (setq gdb-source-window window) + (with-current-buffer buffer + (goto-char (point-min)) + (forward-line (1- (string-to-number line))) + (set-window-point window (point)))))) + (error "Not recognized as break/watchpoint line"))))) ;; Frames buffer. This displays a perpetually correct bactrack trace. @@ -3418,21 +3439,21 @@ member." (let ((stack (bindat-get-field (gdb-json-partial-output "frame") 'stack)) (table (make-gdb-table))) (set-marker gdb-stack-position nil) - (dolist (frame stack) - (gdb-table-add-row table - (list - (bindat-get-field frame 'level) - "in" - (concat - (bindat-get-field frame 'func) - (if gdb-stack-buffer-locations - (gdb-frame-location frame) "") - (if gdb-stack-buffer-addresses - (concat " at " (bindat-get-field frame 'addr)) ""))) - `(mouse-face highlight - help-echo "mouse-2, RET: Select frame" - gdb-frame ,frame))) - (insert (gdb-table-string table " "))) + (dolist (frame stack) + (gdb-table-add-row table + (list + (bindat-get-field frame 'level) + "in" + (concat + (bindat-get-field frame 'func) + (if gdb-stack-buffer-locations + (gdb-frame-location frame) "") + (if gdb-stack-buffer-addresses + (concat " at " (bindat-get-field frame 'addr)) ""))) + `(mouse-face highlight + help-echo "mouse-2, RET: Select frame" + gdb-frame ,frame))) + (insert (gdb-table-string table " "))) (when (and gdb-frame-number (gdb-buffer-shows-main-thread-p)) (gdb-mark-line (1+ (string-to-number gdb-frame-number)) @@ -3445,18 +3466,18 @@ member." (concat "stack frames of " (gdb-get-target-string)))) (def-gdb-display-buffer - gdb-display-stack-buffer - 'gdb-stack-buffer - "Display backtrace of current stack.") + gdb-display-stack-buffer + 'gdb-stack-buffer + "Display backtrace of current stack.") (def-gdb-preempt-display-buffer gdb-preemptively-display-stack-buffer 'gdb-stack-buffer nil t) (def-gdb-frame-for-buffer - gdb-frame-stack-buffer - 'gdb-stack-buffer - "Display backtrace of current stack in a new frame.") + gdb-frame-stack-buffer + 'gdb-stack-buffer + "Display backtrace of current stack in a new frame.") (defvar gdb-frames-mode-map (let ((map (make-sparse-keymap))) @@ -3489,7 +3510,8 @@ member." (if (gdb-buffer-shows-main-thread-p) (let ((new-level (bindat-get-field frame 'level))) (setq gdb-frame-number new-level) - (gdb-input (list (concat "-stack-select-frame " new-level) 'ignore)) + (gdb-input (list (concat "-stack-select-frame " new-level) + 'ignore)) (gdb-update)) (error "Could not select frame for non-current thread")) (error "Not recognized as frame line")))) @@ -3499,7 +3521,8 @@ member." ;; uses "-stack-list-locals --simple-values". Needs GDB 6.1 onwards. (def-gdb-trigger-and-handler gdb-invalidate-locals - (concat (gdb-current-context-command "-stack-list-locals") " --simple-values") + (concat (gdb-current-context-command "-stack-list-locals") + " --simple-values") gdb-locals-handler gdb-locals-handler-custom '(start update)) @@ -3515,7 +3538,7 @@ member." (define-key map "\r" 'gud-watch) (define-key map [mouse-2] 'gud-watch) map) - "Keymap to create watch expression of a complex data type local variable.") + "Keymap to create watch expression of a complex data type local variable.") (defvar gdb-edit-locals-map-1 (let ((map (make-sparse-keymap))) @@ -3523,7 +3546,7 @@ member." (define-key map "\r" 'gdb-edit-locals-value) (define-key map [mouse-2] 'gdb-edit-locals-value) map) - "Keymap to edit value of a simple data type local variable.") + "Keymap to edit value of a simple data type local variable.") (defun gdb-edit-locals-value (&optional event) "Assign a value to a variable displayed in the locals buffer." @@ -3549,14 +3572,14 @@ member." (if (or (not value) (string-match "\\0x" value)) (add-text-properties 0 (length name) - `(mouse-face highlight - help-echo "mouse-2: create watch expression" - local-map ,gdb-locals-watch-map) - name) + `(mouse-face highlight + help-echo "mouse-2: create watch expression" + local-map ,gdb-locals-watch-map) + name) (add-text-properties 0 (length value) `(mouse-face highlight - help-echo "mouse-2: edit value" - local-map ,gdb-edit-locals-map-1) + help-echo "mouse-2: edit value" + local-map ,gdb-edit-locals-map-1) value)) (gdb-table-add-row table @@ -3568,7 +3591,8 @@ member." (insert (gdb-table-string table " ")) (setq mode-name (gdb-current-context-mode-name - (concat "Locals: " (bindat-get-field (gdb-current-buffer-frame) 'func)))))) + (concat "Locals: " + (bindat-get-field (gdb-current-buffer-frame) 'func)))))) (defvar gdb-locals-header (list @@ -3576,19 +3600,20 @@ member." nil nil mode-line) " " (gdb-propertize-header "Registers" gdb-registers-buffer - "mouse-1: select" mode-line-highlight mode-line-inactive))) + "mouse-1: select" mode-line-highlight + mode-line-inactive))) (defvar gdb-locals-mode-map (let ((map (make-sparse-keymap))) (suppress-keymap map) (define-key map "q" 'kill-this-buffer) (define-key map "\t" (lambda () - (interactive) - (gdb-set-window-buffer - (gdb-get-buffer-create - 'gdb-registers-buffer - gdb-thread-number) t))) - map)) + (interactive) + (gdb-set-window-buffer + (gdb-get-buffer-create + 'gdb-registers-buffer + gdb-thread-number) t))) + map)) (define-derived-mode gdb-locals-mode gdb-parent-mode "Locals" "Major mode for gdb locals." @@ -3600,18 +3625,18 @@ member." (concat "locals of " (gdb-get-target-string)))) (def-gdb-display-buffer - gdb-display-locals-buffer - 'gdb-locals-buffer - "Display local variables of current stack and their values.") + gdb-display-locals-buffer + 'gdb-locals-buffer + "Display local variables of current stack and their values.") (def-gdb-preempt-display-buffer - gdb-preemptively-display-locals-buffer - 'gdb-locals-buffer nil t) + gdb-preemptively-display-locals-buffer + 'gdb-locals-buffer nil t) (def-gdb-frame-for-buffer - gdb-frame-locals-buffer - 'gdb-locals-buffer - "Display local variables of current stack and their values in a new frame.") + gdb-frame-locals-buffer + 'gdb-locals-buffer + "Display local variables of current stack and their values in a new frame.") ;; Registers buffer. @@ -3631,7 +3656,8 @@ member." (defun gdb-registers-handler-custom () (when gdb-register-names - (let ((register-values (bindat-get-field (gdb-json-partial-output) 'register-values)) + (let ((register-values + (bindat-get-field (gdb-json-partial-output) 'register-values)) (table (make-gdb-table))) (dolist (register register-values) (let* ((register-number (bindat-get-field register 'number)) @@ -3641,7 +3667,8 @@ member." (gdb-table-add-row table (list - (propertize register-name 'font-lock-face font-lock-variable-name-face) + (propertize register-name + 'font-lock-face font-lock-variable-name-face) (if (member register-number gdb-changed-registers) (propertize value 'font-lock-face font-lock-warning-face) value)) @@ -3671,17 +3698,18 @@ member." (define-key map [mouse-2] 'gdb-edit-register-value) (define-key map "q" 'kill-this-buffer) (define-key map "\t" (lambda () - (interactive) - (gdb-set-window-buffer - (gdb-get-buffer-create - 'gdb-locals-buffer - gdb-thread-number) t))) + (interactive) + (gdb-set-window-buffer + (gdb-get-buffer-create + 'gdb-locals-buffer + gdb-thread-number) t))) map)) (defvar gdb-registers-header (list (gdb-propertize-header "Locals" gdb-locals-buffer - "mouse-1: select" mode-line-highlight mode-line-inactive) + "mouse-1: select" mode-line-highlight + mode-line-inactive) " " (gdb-propertize-header "Registers" gdb-registers-buffer nil nil mode-line))) @@ -3696,17 +3724,17 @@ member." (concat "registers of " (gdb-get-target-string)))) (def-gdb-display-buffer - gdb-display-registers-buffer - 'gdb-registers-buffer - "Display integer register contents.") + gdb-display-registers-buffer + 'gdb-registers-buffer + "Display integer register contents.") (def-gdb-preempt-display-buffer gdb-preemptively-display-registers-buffer - 'gdb-registers-buffer nil t) + 'gdb-registers-buffer nil t) (def-gdb-frame-for-buffer - gdb-frame-registers-buffer - 'gdb-registers-buffer + gdb-frame-registers-buffer + 'gdb-registers-buffer "Display integer register contents in a new frame.") ;; Needs GDB 6.4 onwards (used to fail with no stack). @@ -3723,14 +3751,16 @@ member." (defun gdb-changed-registers-handler () (gdb-delete-pending 'gdb-get-changed-registers) (setq gdb-changed-registers nil) - (dolist (register-number (bindat-get-field (gdb-json-partial-output) 'changed-registers)) + (dolist (register-number + (bindat-get-field (gdb-json-partial-output) 'changed-registers)) (push register-number gdb-changed-registers))) (defun gdb-register-names-handler () ;; Don't use gdb-pending-triggers because this handler is called ;; only once (in gdb-init-1) (setq gdb-register-names nil) - (dolist (register-name (bindat-get-field (gdb-json-partial-output) 'register-names)) + (dolist (register-name + (bindat-get-field (gdb-json-partial-output) 'register-names)) (push register-name gdb-register-names)) (setq gdb-register-names (reverse gdb-register-names))) @@ -3755,7 +3785,8 @@ thread. Called from `gdb-update'." (if (not (gdb-pending-p 'gdb-get-main-selected-frame)) (progn (gdb-input - (list (gdb-current-context-command "-stack-info-frame") 'gdb-frame-handler)) + (list (gdb-current-context-command "-stack-info-frame") + 'gdb-frame-handler)) (gdb-add-pending 'gdb-get-main-selected-frame)))) (defun gdb-frame-handler () @@ -3806,10 +3837,10 @@ window and show BUF there, if the window is not used for GDB already, in which case that window is splitted first." (let ((answer (get-buffer-window buf (or frame 0)))) (if answer - (display-buffer buf nil (or frame 0)) ;Deiconify the frame if necessary. + (display-buffer buf nil (or frame 0)) ;Deiconify frame if necessary. (let ((window (get-lru-window))) (if (eq (buffer-local-value 'gud-minor-mode (window-buffer window)) - 'gdbmi) + 'gdbmi) (let ((largest (get-largest-window))) (setq answer (split-window largest)) (set-window-buffer answer buf) @@ -3872,7 +3903,8 @@ SPLIT-HORIZONTAL and show BUF in the new window." (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer)) (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer)) (define-key menu [memory] '("Memory" . gdb-frame-memory-buffer)) - (define-key menu [disassembly] '("Disassembly" . gdb-frame-disassembly-buffer)) + (define-key menu [disassembly] + '("Disassembly" . gdb-frame-disassembly-buffer)) (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer)) (define-key menu [inferior] '("IO" . gdb-frame-io-buffer)) @@ -3883,40 +3915,41 @@ SPLIT-HORIZONTAL and show BUF in the new window." (let ((menu (make-sparse-keymap "GDB-MI"))) (define-key menu [gdb-customize] - '(menu-item "Customize" (lambda () (interactive) (customize-group 'gdb)) - :help "Customize Gdb Graphical Mode options.")) + '(menu-item "Customize" (lambda () (interactive) (customize-group 'gdb)) + :help "Customize Gdb Graphical Mode options.")) (define-key menu [gdb-many-windows] - '(menu-item "Display Other Windows" gdb-many-windows - :help "Toggle display of locals, stack and breakpoint information" - :button (:toggle . gdb-many-windows))) + '(menu-item "Display Other Windows" gdb-many-windows + :help "Toggle display of locals, stack and breakpoint information" + :button (:toggle . gdb-many-windows))) (define-key menu [gdb-restore-windows] - '(menu-item "Restore Window Layout" gdb-restore-windows - :help "Restore standard layout for debug session.")) + '(menu-item "Restore Window Layout" gdb-restore-windows + :help "Restore standard layout for debug session.")) (define-key menu [sep1] '(menu-item "--")) (define-key menu [all-threads] '(menu-item "GUD controls all threads" - (lambda () - (interactive) - (setq gdb-gud-control-all-threads t)) - :help "GUD start/stop commands apply to all threads" - :button (:radio . gdb-gud-control-all-threads))) + (lambda () + (interactive) + (setq gdb-gud-control-all-threads t)) + :help "GUD start/stop commands apply to all threads" + :button (:radio . gdb-gud-control-all-threads))) (define-key menu [current-thread] '(menu-item "GUD controls current thread" - (lambda () - (interactive) - (setq gdb-gud-control-all-threads nil)) - :help "GUD start/stop commands apply to current thread only" - :button (:radio . (not gdb-gud-control-all-threads)))) + (lambda () + (interactive) + (setq gdb-gud-control-all-threads nil)) + :help "GUD start/stop commands apply to current thread only" + :button (:radio . (not gdb-gud-control-all-threads)))) (define-key menu [sep2] '(menu-item "--")) (define-key menu [gdb-customize-reasons] '(menu-item "Customize switching..." - (lambda () - (interactive) - (customize-option 'gdb-switch-reasons)))) + (lambda () + (interactive) + (customize-option 'gdb-switch-reasons)))) (define-key menu [gdb-switch-when-another-stopped] - (menu-bar-make-toggle gdb-toggle-switch-when-another-stopped gdb-switch-when-another-stopped + (menu-bar-make-toggle gdb-toggle-switch-when-another-stopped + gdb-switch-when-another-stopped "Automatically switch to stopped thread" "GDB thread switching %s" "Switch to stopped thread")) @@ -3930,18 +3963,18 @@ SPLIT-HORIZONTAL and show BUF in the new window." ;; show up right before Run button. (define-key-after gud-tool-bar-map [all-threads] '(menu-item "Switch to non-stop/A mode" gdb-control-all-threads - :image (find-image '((:type xpm :file "gud/thread.xpm"))) - :visible (and (eq gud-minor-mode 'gdbmi) - gdb-non-stop - (not gdb-gud-control-all-threads))) + :image (find-image '((:type xpm :file "gud/thread.xpm"))) + :visible (and (eq gud-minor-mode 'gdbmi) + gdb-non-stop + (not gdb-gud-control-all-threads))) 'run) (define-key-after gud-tool-bar-map [current-thread] '(menu-item "Switch to non-stop/T mode" gdb-control-current-thread - :image (find-image '((:type xpm :file "gud/all.xpm"))) - :visible (and (eq gud-minor-mode 'gdbmi) - gdb-non-stop - gdb-gud-control-all-threads)) + :image (find-image '((:type xpm :file "gud/all.xpm"))) + :visible (and (eq gud-minor-mode 'gdbmi) + gdb-non-stop + gdb-gud-control-all-threads)) 'all-threads) (defun gdb-frame-gdb-buffer () @@ -3960,15 +3993,16 @@ SPLIT-HORIZONTAL and show BUF in the new window." (let ((same-window-regexps nil)) (select-window (display-buffer gud-comint-buffer nil 0)))) -(defun gdb-set-window-buffer (name &optional ignore-dedicated) +(defun gdb-set-window-buffer (name &optional ignore-dedicated window) "Set buffer of selected window to NAME and dedicate window. When IGNORE-DEDICATED is non-nil, buffer is set even if selected window is dedicated." + (unless window (setq window (selected-window))) (when ignore-dedicated - (set-window-dedicated-p (selected-window) nil)) - (set-window-buffer (selected-window) (get-buffer name)) - (set-window-dedicated-p (selected-window) t)) + (set-window-dedicated-p window nil)) + (set-window-buffer window (get-buffer name)) + (set-window-dedicated-p window t)) (defun gdb-setup-windows () "Layout the window pattern for `gdb-many-windows'." @@ -3977,35 +4011,35 @@ window is dedicated." (delete-other-windows) (gdb-display-breakpoints-buffer) (delete-other-windows) - ; Don't dedicate. + ;; Don't dedicate. (pop-to-buffer gud-comint-buffer) - (split-window nil ( / ( * (window-height) 3) 4)) - (split-window nil ( / (window-height) 3)) - (split-window-horizontally) - (other-window 1) - (gdb-set-window-buffer (gdb-locals-buffer-name)) - (other-window 1) - (switch-to-buffer - (if gud-last-last-frame - (gud-find-file (car gud-last-last-frame)) - (if gdb-main-file - (gud-find-file gdb-main-file) - ;; Put buffer list in window if we - ;; can't find a source file. - (list-buffers-noselect)))) - (setq gdb-source-window (selected-window)) - (split-window-horizontally) - (other-window 1) - (gdb-set-window-buffer - (gdb-get-buffer-create 'gdb-inferior-io)) - (other-window 1) - (gdb-set-window-buffer (gdb-stack-buffer-name)) - (split-window-horizontally) - (other-window 1) - (gdb-set-window-buffer (if gdb-show-threads-by-default - (gdb-threads-buffer-name) - (gdb-breakpoints-buffer-name))) - (other-window 1)) + (let ((win0 (selected-window)) + (win1 (split-window nil ( / ( * (window-height) 3) 4))) + (win2 (split-window nil ( / (window-height) 3))) + (win3 (split-window-horizontally))) + (gdb-set-window-buffer (gdb-locals-buffer-name) nil win3) + (select-window win2) + (set-window-buffer + win2 + (if gud-last-last-frame + (gud-find-file (car gud-last-last-frame)) + (if gdb-main-file + (gud-find-file gdb-main-file) + ;; Put buffer list in window if we + ;; can't find a source file. + (list-buffers-noselect)))) + (setq gdb-source-window (selected-window)) + (let ((win4 (split-window-horizontally))) + (gdb-set-window-buffer + (gdb-get-buffer-create 'gdb-inferior-io) nil win4)) + (select-window win1) + (gdb-set-window-buffer (gdb-stack-buffer-name)) + (let ((win5 (split-window-horizontally))) + (gdb-set-window-buffer (if gdb-show-threads-by-default + (gdb-threads-buffer-name) + (gdb-breakpoints-buffer-name)) + nil win5)) + (select-window win0))) (defcustom gdb-many-windows nil "If nil just pop up the GUD buffer unless `gdb-show-main' is t. @@ -4022,34 +4056,33 @@ of the debugged program. Non-nil means display the layout shown for With arg, display additional buffers iff arg is positive." (interactive "P") (setq gdb-many-windows - (if (null arg) - (not gdb-many-windows) - (> (prefix-numeric-value arg) 0))) + (if (null arg) + (not gdb-many-windows) + (> (prefix-numeric-value arg) 0))) (message (format "Display of other windows %sabled" - (if gdb-many-windows "en" "dis"))) + (if gdb-many-windows "en" "dis"))) (if (and gud-comint-buffer - (buffer-name gud-comint-buffer)) + (buffer-name gud-comint-buffer)) (condition-case nil - (gdb-restore-windows) - (error nil)))) + (gdb-restore-windows) + (error nil)))) (defun gdb-restore-windows () "Restore the basic arrangement of windows used by gdb. This arrangement depends on the value of `gdb-many-windows'." (interactive) - (pop-to-buffer gud-comint-buffer) ;Select the right window and frame. - (delete-other-windows) + (pop-to-buffer gud-comint-buffer) ;Select the right window and frame. + (delete-other-windows) (if gdb-many-windows (gdb-setup-windows) (when (or gud-last-last-frame gdb-show-main) - (split-window) - (other-window 1) - (switch-to-buffer - (if gud-last-last-frame - (gud-find-file (car gud-last-last-frame)) - (gud-find-file gdb-main-file))) - (setq gdb-source-window (selected-window)) - (other-window 1)))) + (let ((win (split-window))) + (set-window-buffer + win + (if gud-last-last-frame + (gud-find-file (car gud-last-last-frame)) + (gud-find-file gdb-main-file))) + (setq gdb-source-window win))))) (defun gdb-reset () "Exit a debugging session cleanly. @@ -4057,23 +4090,23 @@ Kills the gdb buffers, and resets variables and the source buffers." (dolist (buffer (buffer-list)) (unless (eq buffer gud-comint-buffer) (with-current-buffer buffer - (if (eq gud-minor-mode 'gdbmi) - (if (string-match "\\` ?\\*.+\\*\\'" (buffer-name)) - (kill-buffer nil) - (gdb-remove-breakpoint-icons (point-min) (point-max) t) - (setq gud-minor-mode nil) - (kill-local-variable 'tool-bar-map) - (kill-local-variable 'gdb-define-alist)))))) + (if (eq gud-minor-mode 'gdbmi) + (if (string-match "\\` ?\\*.+\\*\\'" (buffer-name)) + (kill-buffer nil) + (gdb-remove-breakpoint-icons (point-min) (point-max) t) + (setq gud-minor-mode nil) + (kill-local-variable 'tool-bar-map) + (kill-local-variable 'gdb-define-alist)))))) (setq gdb-disassembly-position nil) (setq overlay-arrow-variable-list - (delq 'gdb-disassembly-position overlay-arrow-variable-list)) + (delq 'gdb-disassembly-position overlay-arrow-variable-list)) (setq fringe-indicator-alist '((overlay-arrow . right-triangle))) (setq gdb-stack-position nil) (setq overlay-arrow-variable-list - (delq 'gdb-stack-position overlay-arrow-variable-list)) + (delq 'gdb-stack-position overlay-arrow-variable-list)) (setq gdb-thread-position nil) (setq overlay-arrow-variable-list - (delq 'gdb-thread-position overlay-arrow-variable-list)) + (delq 'gdb-thread-position overlay-arrow-variable-list)) (if (boundp 'speedbar-frame) (speedbar-timer-fn)) (setq gud-running nil) (setq gdb-active-process nil) @@ -4085,12 +4118,12 @@ buffers, if required." (goto-char (point-min)) (if (re-search-forward gdb-source-file-regexp nil t) (setq gdb-main-file (match-string 1))) - (if gdb-many-windows + (if gdb-many-windows (gdb-setup-windows) - (gdb-get-buffer-create 'gdb-breakpoints-buffer) - (if gdb-show-main - (let ((pop-up-windows t)) - (display-buffer (gud-find-file gdb-main-file)))))) + (gdb-get-buffer-create 'gdb-breakpoints-buffer) + (if gdb-show-main + (let ((pop-up-windows t)) + (display-buffer (gud-find-file gdb-main-file)))))) ;;from put-image (defun gdb-put-string (putstring pos &optional dprop &rest sprops) @@ -4099,14 +4132,14 @@ PUTSTRING is displayed by putting an overlay into the current buffer with a `before-string' string that has a `display' property whose value is PUTSTRING." (let ((string (make-string 1 ?x)) - (buffer (current-buffer))) + (buffer (current-buffer))) (setq putstring (copy-sequence putstring)) (let ((overlay (make-overlay pos pos buffer)) - (prop (or dprop - (list (list 'margin 'left-margin) putstring)))) + (prop (or dprop + (list (list 'margin 'left-margin) putstring)))) (put-text-property 0 1 'display prop string) (if sprops - (add-text-properties 0 1 sprops string)) + (add-text-properties 0 1 sprops string)) (overlay-put overlay 'put-break t) (overlay-put overlay 'before-string string)))) @@ -4119,7 +4152,7 @@ BUFFER nil or omitted means use the current buffer." (setq buffer (current-buffer))) (dolist (overlay (overlays-in start end)) (when (overlay-get overlay 'put-break) - (delete-overlay overlay)))) + (delete-overlay overlay)))) (defun gdb-put-breakpoint-icon (enabled bptno &optional line) (let* ((posns (gdb-line-posns (or line (line-number-at-pos)))) @@ -4131,62 +4164,63 @@ BUFFER nil or omitted means use the current buffer." 0 1 '(help-echo "mouse-1: clear bkpt, mouse-3: enable/disable bkpt") putstring) (if enabled - (add-text-properties - 0 1 `(gdb-bptno ,bptno gdb-enabled t) putstring) + (add-text-properties + 0 1 `(gdb-bptno ,bptno gdb-enabled t) putstring) (add-text-properties 0 1 `(gdb-bptno ,bptno gdb-enabled nil) putstring)) (gdb-remove-breakpoint-icons start end) (if (display-images-p) - (if (>= (or left-fringe-width - (if source-window (car (window-fringes source-window))) - gdb-buffer-fringe-width) 8) - (gdb-put-string - nil (1+ start) - `(left-fringe breakpoint - ,(if enabled - 'breakpoint-enabled - 'breakpoint-disabled)) - 'gdb-bptno bptno - 'gdb-enabled enabled) - (when (< left-margin-width 2) - (save-current-buffer - (setq left-margin-width 2) - (if source-window - (set-window-margins - source-window - left-margin-width right-margin-width)))) - (put-image - (if enabled - (or breakpoint-enabled-icon - (setq breakpoint-enabled-icon - (find-image `((:type xpm :data - ,breakpoint-xpm-data - :ascent 100 :pointer hand) - (:type pbm :data - ,breakpoint-enabled-pbm-data - :ascent 100 :pointer hand))))) - (or breakpoint-disabled-icon - (setq breakpoint-disabled-icon - (find-image `((:type xpm :data - ,breakpoint-xpm-data - :conversion disabled - :ascent 100 :pointer hand) - (:type pbm :data - ,breakpoint-disabled-pbm-data - :ascent 100 :pointer hand)))))) - (+ start 1) - putstring - 'left-margin)) + (if (>= (or left-fringe-width + (if source-window (car (window-fringes source-window))) + gdb-buffer-fringe-width) 8) + (gdb-put-string + nil (1+ start) + `(left-fringe breakpoint + ,(if enabled + 'breakpoint-enabled + 'breakpoint-disabled)) + 'gdb-bptno bptno + 'gdb-enabled enabled) + (when (< left-margin-width 2) + (save-current-buffer + (setq left-margin-width 2) + (if source-window + (set-window-margins + source-window + left-margin-width right-margin-width)))) + (put-image + (if enabled + (or breakpoint-enabled-icon + (setq breakpoint-enabled-icon + (find-image `((:type xpm :data + ,breakpoint-xpm-data + :ascent 100 :pointer hand) + (:type pbm :data + ,breakpoint-enabled-pbm-data + :ascent 100 :pointer hand))))) + (or breakpoint-disabled-icon + (setq breakpoint-disabled-icon + (find-image `((:type xpm :data + ,breakpoint-xpm-data + :conversion disabled + :ascent 100 :pointer hand) + (:type pbm :data + ,breakpoint-disabled-pbm-data + :ascent 100 :pointer hand)))))) + (+ start 1) + putstring + 'left-margin)) (when (< left-margin-width 2) - (save-current-buffer - (setq left-margin-width 2) - (let ((window (get-buffer-window (current-buffer) 0))) - (if window - (set-window-margins - window left-margin-width right-margin-width))))) + (save-current-buffer + (setq left-margin-width 2) + (let ((window (get-buffer-window (current-buffer) 0))) + (if window + (set-window-margins + window left-margin-width right-margin-width))))) (gdb-put-string (propertize putstring - 'face (if enabled 'breakpoint-enabled 'breakpoint-disabled)) + 'face (if enabled + 'breakpoint-enabled 'breakpoint-disabled)) (1+ start))))) (defun gdb-remove-breakpoint-icons (start end &optional remove-margin) @@ -4197,8 +4231,8 @@ BUFFER nil or omitted means use the current buffer." (setq left-margin-width 0) (let ((window (get-buffer-window (current-buffer) 0))) (if window - (set-window-margins - window left-margin-width right-margin-width))))) + (set-window-margins + window left-margin-width right-margin-width))))) (provide 'gdb-mi) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index db8e82193b3..5561575ea20 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -1023,7 +1023,8 @@ This command shares argument histories with \\[lgrep] and \\[grep-find]." (read-from-minibuffer "Confirm: " command nil nil 'grep-find-history)) (add-to-history 'grep-find-history command)) - (let ((default-directory dir)) + (let ((default-directory dir) + (process-connection-type nil)) (compilation-start command 'grep-mode)) ;; Set default-directory if we started rgrep in the *grep* buffer. (if (eq next-error-last-buffer (current-buffer)) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 259ee81c9ba..a54d1438368 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -1581,7 +1581,8 @@ and source-file directory for your debugger." ;; Last group is for return value, e.g. "> test.py(2)foo()->None" ;; Either file or function name may be omitted: "> <string>(0)?()" (defvar gud-pdb-marker-regexp - "^> \\([-a-zA-Z0-9_/.:\\]*\\|<string>\\)(\\([0-9]+\\))\\([a-zA-Z0-9_]*\\|\\?\\|<module>\\)()\\(->[^\n]*\\)?\n") + "^> \\([-a-zA-Z0-9_/.:\\]*\\|<string>\\)(\\([0-9]+\\))\\([a-zA-Z0-9_]*\\|\\?\\|<module>\\)()\\(->[^\n\r]*\\)?[\n\r]") + (defvar gud-pdb-marker-regexp-file-group 1) (defvar gud-pdb-marker-regexp-line-group 2) (defvar gud-pdb-marker-regexp-fnname-group 3) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index a0437ccf9ae..1bdcb4cfa89 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3306,8 +3306,8 @@ If one hasn't been set, or if it's stale, prompt for a new one." #'js--which-func-joiner) ;; Comments - (setq comment-start "// ") - (setq comment-end "") + (set (make-local-variable 'comment-start) "// ") + (set (make-local-variable 'comment-end) "") (set (make-local-variable 'fill-paragraph-function) 'js-c-fill-paragraph) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 3d243f14f07..4d2f15c69d8 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1868,6 +1868,7 @@ instance. Assumes an inferior Python is running." (declare-function info-lookup-maybe-add-help "info-look" (&rest arg)) +;;;###autoload (defun python-after-info-look () "Set up info-look for Python. Used with `eval-after-load'." @@ -2731,6 +2732,16 @@ comint believe the user typed this string so that (defun python-sentinel (_proc _msg) (setq overlay-arrow-position nil)) +(defun python-unload-function () + "Unload the Python library." + (remove-hook 'comint-output-filter-functions 'python-pdbtrack-track-stack-file) + (setq minor-mode-alist (assq-delete-all 'python-pdbtrack-is-tracking-p + minor-mode-alist)) + (dolist (error '("^No symbol" "^Can't shift all lines enough")) + (setq debug-ignored-errors (delete error debug-ignored-errors))) + ;; continue standard unloading + nil) + (provide 'python) (provide 'python-21) diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 1da819660d2..80358e1c651 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -4,10 +4,9 @@ ;; Author: Alex Schroeder <alex@gnu.org> ;; Maintainer: Michael Mauger <mmaug@yahoo.com> -;; Version: 2.8 +;; Version: 3.0 ;; Keywords: comm languages processes ;; URL: http://savannah.gnu.org/projects/emacs/ -;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SqlMode ;; This file is part of GNU Emacs. @@ -46,7 +45,7 @@ ;; available in early versions of sql.el. This support has been ;; extended and formalized in later versions. Part of the impetus for ;; the improved support of SQL flavors was borne out of the current -;; maintainer's consulting experience. In the past fifteen years, I +;; maintainers consulting experience. In the past twenty years, I ;; have used Oracle, Sybase, Informix, MySQL, Postgres, and SQLServer. ;; On some assignments, I have used two or more of these concurrently. @@ -130,7 +129,7 @@ ;; identifier characters. ;; (sql-set-product-feature 'xyz -;; :syntax-alist ((?# . "w"))) +;; :syntax-alist ((?# . "_"))) ;; 4) Define the interactive command interpreter for the database ;; product. @@ -184,7 +183,7 @@ ;; (sql-set-product-feature 'xyz ;; :sqli-comint-func 'my-sql-comint-xyz) -;; 6) Define a convienence function to invoke the SQL interpreter. +;; 6) Define a convenience function to invoke the SQL interpreter. ;; (defun my-sql-xyz (&optional buffer) ;; "Run ixyz by XyzDB as an inferior process." @@ -230,9 +229,18 @@ (eval-when-compile (require 'regexp-opt)) (require 'custom) +(require 'thingatpt) (eval-when-compile ;; needed in Emacs 19, 20 (setq max-specpdl-size (max max-specpdl-size 2000))) +(defun sql-signum (n) + "Return 1, 0, or -1 to identify the sign of N." + (cond + ((not (numberp n)) nil) + ((< n 0) -1) + ((> n 0) 1) + (t 0))) + (defvar font-lock-keyword-face) (defvar font-lock-set-defaults) (defvar font-lock-string-face) @@ -327,7 +335,8 @@ Customizing your password will store it in your ~/.emacs file." (defvar sql-product-alist '((ansi :name "ANSI" - :font-lock sql-mode-ansi-font-lock-keywords) + :font-lock sql-mode-ansi-font-lock-keywords + :statement sql-ansi-statement-starters) (db2 :name "DB2" @@ -392,7 +401,7 @@ Customizing your password will store it in your ~/.emacs file." :sqli-comint-func sql-comint-ms :prompt-regexp "^[0-9]*>" :prompt-length 5 - :syntax-alist ((?@ . "w")) + :syntax-alist ((?@ . "_")) :terminator ("^go" . "go")) (mysql @@ -408,6 +417,7 @@ Customizing your password will store it in your ~/.emacs file." :prompt-regexp "^mysql> " :prompt-length 6 :prompt-cont-regexp "^ -> " + :syntax-alist ((?# . "< b")) :input-filter sql-remove-tabs-filter) (oracle @@ -417,11 +427,15 @@ Customizing your password will store it in your ~/.emacs file." :sqli-options sql-oracle-options :sqli-login sql-oracle-login-params :sqli-comint-func sql-comint-oracle + :list-all sql-oracle-list-all + :list-table sql-oracle-list-table + :completion-object sql-oracle-completion-object :prompt-regexp "^SQL> " :prompt-length 5 - :prompt-cont-regexp "^\\s-*\\d+> " - :syntax-alist ((?$ . "w") (?# . "w")) - :terminator ("\\(^/\\|;\\)" . "/") + :prompt-cont-regexp "^\\s-*[[:digit:]]+ " + :statement sql-oracle-statement-starters + :syntax-alist ((?$ . "_") (?# . "_")) + :terminator ("\\(^/\\|;\\)$" . "/") :input-filter sql-placeholders-filter) (postgres @@ -434,11 +448,12 @@ Customizing your password will store it in your ~/.emacs file." :sqli-comint-func sql-comint-postgres :list-all ("\\d+" . "\\dS+") :list-table ("\\d+ %s" . "\\dS+ %s") - :prompt-regexp "^.*=[#>] " + :completion-object sql-postgres-completion-object + :prompt-regexp "^\\w*=[#>] " :prompt-length 5 - :prompt-cont-regexp "^.*[-(][#>] " + :prompt-cont-regexp "^\\w*[-(][#>] " :input-filter sql-remove-tabs-filter - :terminator ("\\(^\\s-*\\\\g\\|;\\)" . ";")) + :terminator ("\\(^\\s-*\\\\g$\\|;\\)" . "\\g")) (solid :name "Solid" @@ -460,9 +475,10 @@ Customizing your password will store it in your ~/.emacs file." :sqli-comint-func sql-comint-sqlite :list-all ".tables" :list-table ".schema %s" + :completion-object sql-sqlite-completion-object :prompt-regexp "^sqlite> " :prompt-length 8 - :prompt-cont-regexp "^ ...> " + :prompt-cont-regexp "^ \.\.\.> " :terminator ";") (sybase @@ -474,7 +490,7 @@ Customizing your password will store it in your ~/.emacs file." :sqli-comint-func sql-comint-sybase :prompt-regexp "^SQL> " :prompt-length 5 - :syntax-alist ((?@ . "w")) + :syntax-alist ((?@ . "_")) :terminator ("^go" . "go")) ) "An alist of product specific configuration settings. @@ -513,10 +529,11 @@ may be any one of the following: :sqli-comint-func name of a function which accepts no parameters that will use the values of `sql-user', `sql-password', - `sql-database' and `sql-server' to open a - comint buffer and connect to the - database. Do product specific - configuration of comint in this function. + `sql-database', `sql-server' and + `sql-port' to open a comint buffer and + connect to the database. Do product + specific configuration of comint in this + function. :list-all Command string or function which produces a listing of all objects in the database. @@ -535,6 +552,20 @@ may be any one of the following: produces the standard list and the cdr produces an enhanced list. + :completion-object A function that returns a list of + objects. Called with a single + parameter--if nil then list objects + accessible in the current schema, if + not-nil it is the name of a schema whose + objects should be listed. + + :completion-column A function that returns a list of + columns. Called with a single + parameter--if nil then list objects + accessible in the current schema, if + not-nil it is the name of a schema whose + objects should be listed. + :prompt-regexp regular expression string that matches the prompt issued by the product interpreter. @@ -555,6 +586,9 @@ may be any one of the following: filtered string. May also be a list of such functions. + :statement name of a variable containing a regexp that + matches the beginning of SQL statements. + :terminator the terminator to be sent after a `sql-send-string', `sql-send-region', `sql-send-paragraph' and @@ -574,7 +608,7 @@ using `sql-get-product-feature' to lookup the product specific settings.") (defvar sql-indirect-features - '(:font-lock :sqli-program :sqli-options :sqli-login)) + '(:font-lock :sqli-program :sqli-options :sqli-login :statement)) (defcustom sql-connection-alist nil "An alist of connection parameters for interacting with a SQL @@ -683,6 +717,13 @@ it automatically." :version "22.2" :group 'SQL) +(defvar sql-contains-names nil + "When non-nil, the current buffer contains database names. + +Globally should be set to nil; it will be non-nil in `sql-mode', +`sql-interactive-mode' and list all buffers.") + + (defcustom sql-pop-to-buffer-after-send-region nil "When non-nil, pop to the buffer SQL statements are sent to. @@ -770,6 +811,19 @@ is changed." :type 'hook :group 'SQL) +;; Customization for ANSI + +(defcustom sql-ansi-statement-starters (regexp-opt '( + "create" "alter" "drop" + "select" "insert" "update" "delete" "merge" + "grant" "revoke" +)) + "Regexp of keywords that start SQL commands + +All products share this list; products should define a regexp to +identify additional keywords in a variable defined by +the :statement feature.") + ;; Customization for Oracle (defcustom sql-oracle-program "sqlplus" @@ -795,18 +849,22 @@ You will find the file in your Orant\\bin directory." :version "24.1" :group 'SQL) +(defcustom sql-oracle-statement-starters (regexp-opt '("declare" "begin" "with")) + "Additional statement starting keywords in Oracle.") + (defcustom sql-oracle-scan-on t "Non-nil if placeholders should be replaced in Oracle SQLi. When non-nil, Emacs will scan text sent to sqlplus and prompt for replacement text for & placeholders as sqlplus does. This -is needed on Windows where sqlplus output is buffered and the +is needed on Windows where SQL*Plus output is buffered and the prompts are not shown until after the text is entered. -You will probably want to issue the following command in sqlplus -to be safe: +You need to issue the following command in SQL*Plus to be safe: + + SET DEFINE OFF - SET SCAN OFF" +In older versions of SQL*Plus, this was the SET SCAN OFF command." :type 'boolean :group 'SQL) @@ -833,7 +891,7 @@ Starts `sql-interactive-mode' after doing some setup." :version "24.1" :group 'SQL) -;; Customization for MySql +;; Customization for MySQL (defcustom sql-mysql-program "mysql" "Command to start mysql by TcX. @@ -851,7 +909,7 @@ on Windows: \"-C\" \"-t\" \"-f\" \"-n\"." :group 'SQL) (defcustom sql-mysql-login-params '(user password database server) - "List of login parameters needed to connect to MySql." + "List of login parameters needed to connect to MySQL." :type 'sql-login-params :version "24.1" :group 'SQL) @@ -1085,13 +1143,13 @@ You can change `sql-prompt-length' on `sql-interactive-mode-hook'.") Used by `sql-rename-buffer'.") -(defun sql-buffer-live-p (buffer &optional product) +(defun sql-buffer-live-p (buffer &optional product connection) "Returns non-nil if the process associated with buffer is live. BUFFER can be a buffer object or a buffer name. The buffer must be a live buffer, have an running process attached to it, be in -`sql-interactive-mode', and, if PRODUCT is specified, it's -`sql-product' must match." +`sql-interactive-mode', and, if PRODUCT or CONNECTION are +specified, it's `sql-product' or `sql-connection' must match." (when buffer (setq buffer (get-buffer buffer)) @@ -1102,7 +1160,9 @@ be a live buffer, have an running process attached to it, be in (with-current-buffer buffer (and (derived-mode-p 'sql-interactive-mode) (or (not product) - (eq product sql-product))))))) + (eq product sql-product)) + (or (not connection) + (eq connection sql-connection))))))) ;; Keymap for sql-interactive-mode. @@ -1136,6 +1196,8 @@ Based on `comint-mode-map'.") (define-key map (kbd "C-c C-i") 'sql-product-interactive) (define-key map (kbd "C-c C-l a") 'sql-list-all) (define-key map (kbd "C-c C-l t") 'sql-list-table) + (define-key map [remap beginning-of-defun] 'sql-beginning-of-statement) + (define-key map [remap end-of-defun] 'sql-end-of-statement) map) "Mode map used for `sql-mode'.") @@ -1151,8 +1213,10 @@ Based on `comint-mode-map'.") ["Send Buffer" sql-send-buffer (sql-buffer-live-p sql-buffer)] ["Send String" sql-send-string (sql-buffer-live-p sql-buffer)] "--" - ["List all objects" sql-list-all (sql-buffer-live-p sql-buffer)] - ["List table details" sql-list-table (sql-buffer-live-p sql-buffer)] + ["List all objects" sql-list-all (and (sql-buffer-live-p sql-buffer) + (sql-get-product-feature sql-product :list-all))] + ["List table details" sql-list-table (and (sql-buffer-live-p sql-buffer) + (sql-get-product-feature sql-product :list-table))] "--" ["Start SQLi session" sql-product-interactive :visible (not sql-connection-alist) @@ -1194,8 +1258,8 @@ Based on `comint-mode-map'.") ["Rename Buffer" sql-rename-buffer t] ["Save Connection" sql-save-connection (not sql-connection)] "--" - ["List all objects" sql-list-all t] - ["List table details" sql-list-table t])) + ["List all objects" sql-list-all (sql-get-product-feature sql-product :list-all)] + ["List table details" sql-list-table (sql-get-product-feature sql-product :list-table)])) ;; Abbreviations -- if you want more of them, define them in your ;; ~/.emacs file. Abbrevs have to be enabled in your ~/.emacs, too. @@ -1238,8 +1302,9 @@ Based on `comint-mode-map'.") (modify-syntax-entry ?' "\"" table) ;; double quotes (") don't delimit strings (modify-syntax-entry ?\" "." table) - ;; backslash is no escape character - (modify-syntax-entry ?\\ "." table) + ;; Make these all punctuation + (mapc (lambda (c) (modify-syntax-entry c "." table)) + (string-to-list "!#$%&+,.:;<=>?@\\|")) table) "Syntax table used in `sql-mode' and `sql-interactive-mode'.") @@ -1298,20 +1363,45 @@ statement. The format of variable should be a valid ;; Remove keywords that are defined in ANSI (setq kwd keywords) - (dolist (k keywords) - (catch 'next - (dolist (a sql-mode-ansi-font-lock-keywords) - (when (and (eq face (cdr a)) - (eq (string-match (car a) k 0) 0) - (eq (match-end 0) (length k))) - (setq kwd (delq k kwd)) - (throw 'next nil))))) + ;; (dolist (k keywords) + ;; (catch 'next + ;; (dolist (a sql-mode-ansi-font-lock-keywords) + ;; (when (and (eq face (cdr a)) + ;; (eq (string-match (car a) k 0) 0) + ;; (eq (match-end 0) (length k))) + ;; (setq kwd (delq k kwd)) + ;; (throw 'next nil))))) ;; Create a properly formed font-lock-keywords item (cons (concat (car bdy) (regexp-opt kwd t) (cdr bdy)) - face)))) + face))) + + (defun sql-regexp-abbrev (keyword) + (let ((brk (string-match "[~]" keyword)) + (len (length keyword)) + (sep "\\(?:") + re i) + (if (not brk) + keyword + (setq re (substring keyword 0 brk) + i (+ 2 brk) + brk (1+ brk)) + (while (<= i len) + (setq re (concat re sep (substring keyword brk i)) + sep "\\|" + i (1+ i))) + (concat re "\\)?")))) + + (defun sql-regexp-abbrev-list (&rest keyw-list) + (let ((re nil) + (sep "\\<\\(?:")) + (while keyw-list + (setq re (concat re sep (sql-regexp-abbrev (car keyw-list))) + sep "\\|" + keyw-list (cdr keyw-list))) + (concat re "\\)\\>")))) (eval-when-compile (setq sql-mode-ansi-font-lock-keywords @@ -1346,6 +1436,7 @@ statement. The format of variable should be a valid "user_defined_type_catalog" "user_defined_type_name" "user_defined_type_schema" ) + ;; ANSI Reserved keywords (sql-font-lock-keywords-builder 'font-lock-keyword-face nil "absolute" "action" "add" "admin" "after" "aggregate" "alias" "all" @@ -1395,6 +1486,7 @@ statement. The format of variable should be a valid "substring" "sum" "system_user" "translate" "treat" "trim" "upper" "user" ) + ;; ANSI Data Types (sql-font-lock-keywords-builder 'font-lock-type-face nil "array" "binary" "bit" "blob" "boolean" "char" "character" "clob" @@ -1414,86 +1506,142 @@ function `regexp-opt'. Therefore, take a look at the source before you define your own `sql-mode-ansi-font-lock-keywords'. You may want to add functions and PL/SQL keywords.") +(defun sql-oracle-show-reserved-words () + ;; This function is for use by the maintainer of SQL.EL only. + (interactive) + (if (or (and (not (derived-mode-p 'sql-mode)) + (not (derived-mode-p 'sql-interactive-mode))) + (not sql-buffer) + (not (eq sql-product 'oracle))) + (error "Not an Oracle buffer") + + (let ((b "*RESERVED WORDS*")) + (sql-execute sql-buffer b + (concat "SELECT " + " keyword " + ", reserved AS \"Res\" " + ", res_type AS \"Type\" " + ", res_attr AS \"Attr\" " + ", res_semi AS \"Semi\" " + ", duplicate AS \"Dup\" " + "FROM V$RESERVED_WORDS " + "WHERE length > 1 " + "AND SUBSTR(keyword, 1, 1) BETWEEN 'A' AND 'Z' " + "ORDER BY 2 DESC, 3 DESC, 4 DESC, 5 DESC, 6 DESC, 1;") + nil nil) + (with-current-buffer b + (set (make-local-variable 'sql-product) 'oracle) + (sql-product-font-lock t nil) + (font-lock-mode +1))))) + (defvar sql-mode-oracle-font-lock-keywords (eval-when-compile (list ;; Oracle SQL*Plus Commands - (cons - (concat - "^\\s-*\\(?:\\(?:" (regexp-opt '( -"@" "@@" "accept" "append" "archive" "attribute" "break" -"btitle" "change" "clear" "column" "connect" "copy" "define" -"del" "describe" "disconnect" "edit" "execute" "exit" "get" "help" -"host" "input" "list" "password" "pause" "print" "prompt" "recover" -"remark" "repfooter" "repheader" "run" "save" "show" "shutdown" -"spool" "start" "startup" "store" "timing" "ttitle" "undefine" -"variable" "whenever" -) t) + ;; Only recognized in they start in column 1 and the + ;; abbreviation is followed by a space or the end of line. - "\\)\\|" - "\\(?:compute\\s-+\\(?:avg\\|cou\\|min\\|max\\|num\\|sum\\|std\\|var\\)\\)\\|" - "\\(?:set\\s-+\\(" - - (regexp-opt - '("appi" "appinfo" "array" "arraysize" "auto" "autocommit" - "autop" "autoprint" "autorecovery" "autot" "autotrace" "blo" - "blockterminator" "buffer" "closecursor" "cmds" "cmdsep" - "colsep" "com" "compatibility" "con" "concat" "constraint" - "constraints" "copyc" "copycommit" "copytypecheck" "database" - "def" "define" "document" "echo" "editf" "editfile" "emb" - "embedded" "esc" "escape" "feed" "feedback" "flagger" "flu" - "flush" "hea" "heading" "heads" "headsep" "instance" "lin" - "linesize" "lobof" "loboffset" "logsource" "long" "longc" - "longchunksize" "maxdata" "newp" "newpage" "null" "num" - "numf" "numformat" "numwidth" "pages" "pagesize" "pau" - "pause" "recsep" "recsepchar" "role" "scan" "serveroutput" - "shift" "shiftinout" "show" "showmode" "space" "sqlbl" - "sqlblanklines" "sqlc" "sqlcase" "sqlco" "sqlcontinue" "sqln" - "sqlnumber" "sqlp" "sqlpluscompat" "sqlpluscompatibility" - "sqlpre" "sqlprefix" "sqlprompt" "sqlt" "sqlterminator" - "statement_id" "suf" "suffix" "tab" "term" "termout" "ti" - "time" "timi" "timing" "transaction" "trim" "trimout" "trims" - "trimspool" "truncate" "und" "underline" "ver" "verify" "wra" - "wrap")) "\\)\\)" - - "\\)\\b.*" - ) - 'font-lock-doc-face) - '("^\\s-*rem\\(?:ark\\)?\\>.*" . font-lock-comment-face) + "\\|" + (list (concat "^" (sql-regexp-abbrev "rem~ark") "\\(?:\\s-.*\\)?$") + 0 'font-lock-comment-face t) + + (list + (concat + "^\\(?:" + (sql-regexp-abbrev-list + "[@]\\{1,2\\}" "acc~ept" "a~ppend" "archive" "attribute" + "bre~ak" "bti~tle" "c~hange" "cl~ear" "col~umn" "conn~ect" + "copy" "def~ine" "del" "desc~ribe" "disc~onnect" "ed~it" + "exec~ute" "exit" "get" "help" "ho~st" "[$]" "i~nput" "l~ist" + "passw~ord" "pau~se" "pri~nt" "pro~mpt" "quit" "recover" + "repf~ooter" "reph~eader" "r~un" "sav~e" "sho~w" "shutdown" + "spo~ol" "sta~rt" "startup" "store" "tim~ing" "tti~tle" + "undef~ine" "var~iable" "whenever") + "\\|" + (concat "\\(?:" + (sql-regexp-abbrev "comp~ute") + "\\s-+" + (sql-regexp-abbrev-list + "avg" "cou~nt" "min~imum" "max~imum" "num~ber" "sum" + "std" "var~iance") + "\\)") + "\\|" + (concat "\\(?:set\\s-+" + (sql-regexp-abbrev-list + "appi~nfo" "array~size" "auto~commit" "autop~rint" + "autorecovery" "autot~race" "blo~ckterminator" + "cmds~ep" "colsep" "com~patibility" "con~cat" + "copyc~ommit" "copytypecheck" "def~ine" "describe" + "echo" "editf~ile" "emb~edded" "esc~ape" "feed~back" + "flagger" "flu~sh" "hea~ding" "heads~ep" "instance" + "lin~esize" "lobof~fset" "long" "longc~hunksize" + "mark~up" "newp~age" "null" "numf~ormat" "num~width" + "pages~ize" "pau~se" "recsep" "recsepchar" + "scan" "serverout~put" "shift~inout" "show~mode" + "sqlbl~anklines" "sqlc~ase" "sqlco~ntinue" + "sqln~umber" "sqlpluscompat~ibility" "sqlpre~fix" + "sqlp~rompt" "sqlt~erminator" "suf~fix" "tab" + "term~out" "ti~me" "timi~ng" "trim~out" "trims~pool" + "und~erline" "ver~ify" "wra~p") + "\\)") + + "\\)\\(?:\\s-.*\\)?\\(?:[-]\n.*\\)*$") + 0 'font-lock-doc-face t) ;; Oracle Functions (sql-font-lock-keywords-builder 'font-lock-builtin-face nil -"abs" "acos" "add_months" "ascii" "asciistr" "asin" "atan" "atan2" -"avg" "bfilename" "bin_to_num" "bitand" "cast" "ceil" "chartorowid" -"chr" "coalesce" "compose" "concat" "convert" "corr" "cos" "cosh" -"count" "covar_pop" "covar_samp" "cume_dist" "current_date" -"current_timestamp" "current_user" "dbtimezone" "decode" "decompose" -"dense_rank" "depth" "deref" "dump" "empty_clob" "existsnode" "exp" -"extract" "extractvalue" "first" "first_value" "floor" "following" -"from_tz" "greatest" "group_id" "grouping_id" "hextoraw" "initcap" -"instr" "lag" "last" "last_day" "last_value" "lead" "least" "length" -"ln" "localtimestamp" "lower" "lpad" "ltrim" "make_ref" "max" "min" -"mod" "months_between" "new_time" "next_day" "nls_charset_decl_len" +"abs" "acos" "add_months" "appendchildxml" "ascii" "asciistr" "asin" +"atan" "atan2" "avg" "bfilename" "bin_to_num" "bitand" "cardinality" +"cast" "ceil" "chartorowid" "chr" "cluster_id" "cluster_probability" +"cluster_set" "coalesce" "collect" "compose" "concat" "convert" "corr" +"corr_k" "corr_s" "cos" "cosh" "count" "covar_pop" "covar_samp" +"cube_table" "cume_dist" "currrent_date" "currrent_timestamp" "cv" +"dataobj_to_partition" "dbtimezone" "decode" "decompose" "deletexml" +"dense_rank" "depth" "deref" "dump" "empty_blob" "empty_clob" +"existsnode" "exp" "extract" "extractvalue" "feature_id" "feature_set" +"feature_value" "first" "first_value" "floor" "from_tz" "greatest" +"grouping" "grouping_id" "group_id" "hextoraw" "initcap" +"insertchildxml" "insertchildxmlafter" "insertchildxmlbefore" +"insertxmlafter" "insertxmlbefore" "instr" "instr2" "instr4" "instrb" +"instrc" "iteration_number" "lag" "last" "last_day" "last_value" +"lead" "least" "length" "length2" "length4" "lengthb" "lengthc" +"listagg" "ln" "lnnvl" "localtimestamp" "log" "lower" "lpad" "ltrim" +"make_ref" "max" "median" "min" "mod" "months_between" "nanvl" "nchr" +"new_time" "next_day" "nlssort" "nls_charset_decl_len" "nls_charset_id" "nls_charset_name" "nls_initcap" "nls_lower" -"nls_upper" "nlssort" "ntile" "nullif" "numtodsinterval" -"numtoyminterval" "nvl" "nvl2" "over" "path" "percent_rank" -"percentile_cont" "percentile_disc" "power" "preceding" "rank" -"ratio_to_report" "rawtohex" "rawtonhex" "reftohex" "regr_" -"regr_avgx" "regr_avgy" "regr_count" "regr_intercept" "regr_r2" -"regr_slope" "regr_sxx" "regr_sxy" "regr_syy" "replace" "round" -"row_number" "rowidtochar" "rowidtonchar" "rpad" "rtrim" -"sessiontimezone" "sign" "sin" "sinh" "soundex" "sqrt" "stddev" -"stddev_pop" "stddev_samp" "substr" "sum" "sys_connect_by_path" -"sys_context" "sys_dburigen" "sys_extract_utc" "sys_guid" "sys_typeid" -"sys_xmlagg" "sys_xmlgen" "sysdate" "systimestamp" "tan" "tanh" +"nls_upper" "nth_value" "ntile" "nullif" "numtodsinterval" +"numtoyminterval" "nvl" "nvl2" "ora_dst_affected" "ora_dst_convert" +"ora_dst_error" "ora_hash" "path" "percentile_cont" "percentile_disc" +"percent_rank" "power" "powermultiset" "powermultiset_by_cardinality" +"prediction" "prediction_bounds" "prediction_cost" +"prediction_details" "prediction_probability" "prediction_set" +"presentnnv" "presentv" "previous" "rank" "ratio_to_report" "rawtohex" +"rawtonhex" "ref" "reftohex" "regexp_count" "regexp_instr" +"regexp_replace" "regexp_substr" "regr_avgx" "regr_avgy" "regr_count" +"regr_intercept" "regr_r2" "regr_slope" "regr_sxx" "regr_sxy" +"regr_syy" "remainder" "replace" "round" "rowidtochar" "rowidtonchar" +"row_number" "rpad" "rtrim" "scn_to_timestamp" "sessiontimezone" "set" +"sign" "sin" "sinh" "soundex" "sqrt" "stats_binomial_test" +"stats_crosstab" "stats_f_test" "stats_ks_test" "stats_mode" +"stats_mw_test" "stats_one_way_anova" "stats_t_test_indep" +"stats_t_test_indepu" "stats_t_test_one" "stats_t_test_paired" +"stats_wsr_test" "stddev" "stddev_pop" "stddev_samp" "substr" +"substr2" "substr4" "substrb" "substrc" "sum" "sysdate" "systimestamp" +"sys_connect_by_path" "sys_context" "sys_dburigen" "sys_extract_utc" +"sys_guid" "sys_typeid" "sys_xmlagg" "sys_xmlgen" "tan" "tanh" +"timestamp_to_scn" "to_binary_double" "to_binary_float" "to_blob" "to_char" "to_clob" "to_date" "to_dsinterval" "to_lob" "to_multi_byte" "to_nchar" "to_nclob" "to_number" "to_single_byte" "to_timestamp" "to_timestamp_tz" "to_yminterval" "translate" "treat" "trim" "trunc" -"tz_offset" "uid" "unbounded" "unistr" "updatexml" "upper" "user" -"userenv" "var_pop" "var_samp" "variance" "vsize" "width_bucket" "xml" -"xmlagg" "xmlattribute" "xmlcolattval" "xmlconcat" "xmlelement" -"xmlforest" "xmlsequence" "xmltransform" +"tz_offset" "uid" "unistr" "updatexml" "upper" "user" "userenv" +"value" "variance" "var_pop" "var_samp" "vsize" "width_bucket" +"xmlagg" "xmlcast" "xmlcdata" "xmlcolattval" "xmlcomment" "xmlconcat" +"xmldiff" "xmlelement" "xmlexists" "xmlforest" "xmlisvalid" "xmlparse" +"xmlpatch" "xmlpi" "xmlquery" "xmlroot" "xmlsequence" "xmlserialize" +"xmltable" "xmltransform" ) + + ;; See the table V$RESERVED_WORDS ;; Oracle Keywords (sql-font-lock-keywords-builder 'font-lock-keyword-face nil "abort" "access" "accessed" "account" "activate" "add" "admin" @@ -1582,52 +1730,120 @@ to add functions and PL/SQL keywords.") "varray" "version" "view" "wait" "when" "whenever" "where" "with" "without" "wnds" "wnps" "work" "write" "xmldata" "xmlschema" "xmltype" ) + ;; Oracle Data Types (sql-font-lock-keywords-builder 'font-lock-type-face nil -"bfile" "blob" "byte" "char" "character" "clob" "date" "dec" "decimal" -"double" "float" "int" "integer" "interval" "long" "national" "nchar" -"nclob" "number" "numeric" "nvarchar2" "precision" "raw" "real" -"rowid" "second" "smallint" "time" "timestamp" "urowid" "varchar" -"varchar2" "varying" "year" "zone" +"bfile" "binary_double" "binary_float" "blob" "byte" "char" "charbyte" +"clob" "date" "day" "float" "interval" "local" "long" "longraw" +"minute" "month" "nchar" "nclob" "number" "nvarchar2" "raw" "rowid" "second" +"time" "timestamp" "urowid" "varchar2" "with" "year" "zone" ) ;; Oracle PL/SQL Attributes - (sql-font-lock-keywords-builder 'font-lock-builtin-face '("" . "\\b") -"%bulk_rowcount" "%found" "%isopen" "%notfound" "%rowcount" "%rowtype" -"%type" + (sql-font-lock-keywords-builder 'font-lock-builtin-face '("%" . "\\b") +"bulk_exceptions" "bulk_rowcount" "found" "isopen" "notfound" +"rowcount" "rowtype" "type" ) ;; Oracle PL/SQL Functions (sql-font-lock-keywords-builder 'font-lock-builtin-face nil -"extend" "prior" +"delete" "trim" "extend" "exists" "first" "last" "count" "limit" +"prior" "next" +) + + ;; Oracle PL/SQL Reserved words + (sql-font-lock-keywords-builder 'font-lock-keyword-face nil +"all" "alter" "and" "any" "as" "asc" "at" "begin" "between" "by" +"case" "check" "clusters" "cluster" "colauth" "columns" "compress" +"connect" "crash" "create" "cursor" "declare" "default" "desc" +"distinct" "drop" "else" "end" "exception" "exclusive" "fetch" "for" +"from" "function" "goto" "grant" "group" "having" "identified" "if" +"in" "index" "indexes" "insert" "intersect" "into" "is" "like" "lock" +"minus" "mode" "nocompress" "not" "nowait" "null" "of" "on" "option" +"or" "order" "overlaps" "procedure" "public" "resource" "revoke" +"select" "share" "size" "sql" "start" "subtype" "tabauth" "table" +"then" "to" "type" "union" "unique" "update" "values" "view" "views" +"when" "where" "with" + +"true" "false" +"raise_application_error" ) ;; Oracle PL/SQL Keywords (sql-font-lock-keywords-builder 'font-lock-keyword-face nil -"autonomous_transaction" "bulk" "char_base" "collect" "constant" -"cursor" "declare" "do" "elsif" "exception_init" "execute" "exit" -"extends" "false" "fetch" "forall" "goto" "hour" "if" "interface" -"loop" "minute" "number_base" "ocirowid" "opaque" "others" "rowtype" -"separate" "serially_reusable" "sql" "sqlcode" "sqlerrm" "subtype" -"the" "timezone_abbr" "timezone_hour" "timezone_minute" -"timezone_region" "true" "varrying" "while" +"a" "add" "agent" "aggregate" "array" "attribute" "authid" "avg" +"bfile_base" "binary" "blob_base" "block" "body" "both" "bound" "bulk" +"byte" "c" "call" "calling" "cascade" "char" "char_base" "character" +"charset" "charsetform" "charsetid" "clob_base" "close" "collect" +"comment" "commit" "committed" "compiled" "constant" "constructor" +"context" "continue" "convert" "count" "current" "customdatum" +"dangling" "data" "date" "date_base" "day" "define" "delete" +"deterministic" "double" "duration" "element" "elsif" "empty" "escape" +"except" "exceptions" "execute" "exists" "exit" "external" "final" +"fixed" "float" "forall" "force" "general" "hash" "heap" "hidden" +"hour" "immediate" "including" "indicator" "indices" "infinite" +"instantiable" "int" "interface" "interval" "invalidate" "isolation" +"java" "language" "large" "leading" "length" "level" "library" "like2" +"like4" "likec" "limit" "limited" "local" "long" "loop" "map" "max" +"maxlen" "member" "merge" "min" "minute" "mod" "modify" "month" +"multiset" "name" "nan" "national" "native" "nchar" "new" "nocopy" +"number_base" "object" "ocicoll" "ocidate" "ocidatetime" "ociduration" +"ociinterval" "ociloblocator" "ocinumber" "ociraw" "ociref" +"ocirefcursor" "ocirowid" "ocistring" "ocitype" "old" "only" "opaque" +"open" "operator" "oracle" "oradata" "organization" "orlany" "orlvary" +"others" "out" "overriding" "package" "parallel_enable" "parameter" +"parameters" "parent" "partition" "pascal" "pipe" "pipelined" "pragma" +"precision" "prior" "private" "raise" "range" "raw" "read" "record" +"ref" "reference" "relies_on" "rem" "remainder" "rename" "result" +"result_cache" "return" "returning" "reverse" "rollback" "row" +"sample" "save" "savepoint" "sb1" "sb2" "sb4" "second" "segment" +"self" "separate" "sequence" "serializable" "set" "short" "size_t" +"some" "sparse" "sqlcode" "sqldata" "sqlname" "sqlstate" "standard" +"static" "stddev" "stored" "string" "struct" "style" "submultiset" +"subpartition" "substitutable" "sum" "synonym" "tdo" "the" "time" +"timestamp" "timezone_abbr" "timezone_hour" "timezone_minute" +"timezone_region" "trailing" "transaction" "transactional" "trusted" +"ub1" "ub2" "ub4" "under" "unsigned" "untrusted" "use" "using" +"valist" "value" "variable" "variance" "varray" "varying" "void" +"while" "work" "wrapped" "write" "year" "zone" +;; Pragma +"autonomous_transaction" "exception_init" "inline" +"restrict_references" "serially_reusable" ) ;; Oracle PL/SQL Data Types (sql-font-lock-keywords-builder 'font-lock-type-face nil -"binary_integer" "boolean" "naturaln" "pls_integer" "positive" -"positiven" "record" "signtype" "string" +"\"BINARY LARGE OBJECT\"" "\"CHAR LARGE OBJECT\"" "\"CHAR VARYING\"" +"\"CHARACTER LARGE OBJECT\"" "\"CHARACTER VARYING\"" +"\"DOUBLE PRECISION\"" "\"INTERVAL DAY TO SECOND\"" +"\"INTERVAL YEAR TO MONTH\"" "\"LONG RAW\"" "\"NATIONAL CHAR\"" +"\"NATIONAL CHARACTER LARGE OBJECT\"" "\"NATIONAL CHARACTER\"" +"\"NCHAR LARGE OBJECT\"" "\"NCHAR\"" "\"NCLOB\"" "\"NVARCHAR2\"" +"\"TIME WITH TIME ZONE\"" "\"TIMESTAMP WITH LOCAL TIME ZONE\"" +"\"TIMESTAMP WITH TIME ZONE\"" +"bfile" "bfile_base" "binary_double" "binary_float" "binary_integer" +"blob" "blob_base" "boolean" "char" "character" "char_base" "clob" +"clob_base" "cursor" "date" "day" "dec" "decimal" +"dsinterval_unconstrained" "float" "int" "integer" "interval" "local" +"long" "mlslabel" "month" "natural" "naturaln" "nchar_cs" "number" +"number_base" "numeric" "pls_integer" "positive" "positiven" "raw" +"real" "ref" "rowid" "second" "signtype" "simple_double" +"simple_float" "simple_integer" "smallint" "string" "time" "timestamp" +"timestamp_ltz_unconstrained" "timestamp_tz_unconstrained" +"timestamp_unconstrained" "time_tz_unconstrained" "time_unconstrained" +"to" "urowid" "varchar" "varchar2" "with" "year" +"yminterval_unconstrained" "zone" ) ;; Oracle PL/SQL Exceptions (sql-font-lock-keywords-builder 'font-lock-warning-face nil "access_into_null" "case_not_found" "collection_is_null" "cursor_already_open" "dup_val_on_index" "invalid_cursor" -"invalid_number" "login_denied" "no_data_found" "not_logged_on" -"program_error" "rowtype_mismatch" "self_is_null" "storage_error" -"subscript_beyond_count" "subscript_outside_limit" "sys_invalid_rowid" -"timeout_on_resource" "too_many_rows" "value_error" "zero_divide" -"exception" "notfound" +"invalid_number" "login_denied" "no_data_found" "no_data_needed" +"not_logged_on" "program_error" "rowtype_mismatch" "self_is_null" +"storage_error" "subscript_beyond_count" "subscript_outside_limit" +"sys_invalid_rowid" "timeout_on_resource" "too_many_rows" +"value_error" "zero_divide" ))) "Oracle SQL keywords used by font-lock. @@ -2296,10 +2512,7 @@ also be configured." (let ;; Get the product-specific syntax-alist. - ((syntax-alist - (append - (sql-get-product-feature sql-product :syntax-alist) - '((?_ . "w") (?. . "w"))))) + ((syntax-alist (sql-product-font-lock-syntax-alist))) ;; Get the product-specific keywords. (set (make-local-variable 'sql-mode-font-lock-keywords) @@ -2388,9 +2601,30 @@ adds a fontification pattern to fontify identifiers ending in ;;; Functions to switch highlighting +(defun sql-product-syntax-table () + (let ((table (copy-syntax-table sql-mode-syntax-table))) + (mapc (lambda (entry) + (modify-syntax-entry (car entry) (cdr entry) table)) + (sql-get-product-feature sql-product :syntax-alist)) + table)) + +(defun sql-product-font-lock-syntax-alist () + (append + ;; Change all symbol character to word characters + (mapcar + (lambda (entry) (if (string= (substring (cdr entry) 0 1) "_") + (cons (car entry) + (concat "w" (substring (cdr entry) 1))) + entry)) + (sql-get-product-feature sql-product :syntax-alist)) + '((?_ . "w")))) + (defun sql-highlight-product () "Turn on the font highlighting for the SQL product selected." (when (derived-mode-p 'sql-mode) + ;; Enhance the syntax table for the product + (set-syntax-table (sql-product-syntax-table)) + ;; Setup font-lock (sql-product-font-lock nil t) @@ -2418,11 +2652,77 @@ adds a fontification pattern to fontify identifiers ending in ;; comint-line-beginning-position is defined in Emacs 21 (defun comint-line-beginning-position () "Return the buffer position of the beginning of the line, after any prompt. -The prompt is assumed to be any text at the beginning of the line matching -the regular expression `comint-prompt-regexp', a buffer local variable." +The prompt is assumed to be any text at the beginning of the line +matching the regular expression `comint-prompt-regexp', a buffer +local variable." (save-excursion (comint-bol nil) (point)))) - +;;; Motion Functions + +(defun sql-statement-regexp (prod) + (let* ((ansi-stmt (sql-get-product-feature 'ansi :statement)) + (prod-stmt (sql-get-product-feature prod :statement))) + (concat "^\\<" + (if prod-stmt + ansi-stmt + (concat "\\(" ansi-stmt "\\|" prod-stmt "\\)")) + "\\>"))) + +(defun sql-beginning-of-statement (arg) + "Moves the cursor to the beginning of the current SQL statement." + (interactive "p") + + (let ((here (point)) + (regexp (sql-statement-regexp sql-product)) + last next) + + ;; Go to the end of the statement before the start we desire + (setq last (or (sql-end-of-statement (- arg)) + (point-min))) + ;; And find the end after that + (setq next (or (sql-end-of-statement 1) + (point-max))) + + ;; Our start must be between them + (goto-char last) + ;; Find an beginning-of-stmt that's not in a comment + (while (and (re-search-forward regexp next t 1) + (nth 7 (syntax-ppss))) + (goto-char (match-end 0))) + (goto-char + (if (match-data) + (match-beginning 0) + last)) + (beginning-of-line) + ;; If we didn't move, try again + (when (= here (point)) + (sql-beginning-of-statement (* 2 (sql-signum arg)))))) + +(defun sql-end-of-statement (arg) + "Moves the cursor to the end of the current SQL statement." + (interactive "p") + (let ((term (sql-get-product-feature sql-product :terminator)) + (re-search (if (> 0 arg) 're-search-backward 're-search-forward)) + (here (point)) + (n 0)) + (when (consp term) + (setq term (car term))) + ;; Iterate until we've moved the desired number of stmt ends + (while (not (= (sql-signum arg) 0)) + ;; if we're looking at the terminator, jump by 2 + (if (or (and (> 0 arg) (looking-back term)) + (and (< 0 arg) (looking-at term))) + (setq n 2) + (setq n 1)) + ;; If we found another end-of-stmt + (if (not (apply re-search term nil t n nil)) + (setq arg 0) + ;; count it if we're not in a comment + (unless (nth 7 (syntax-ppss)) + (setq arg (- arg (sql-signum arg)))))) + (goto-char (if (match-data) + (match-end 0) + here)))) ;;; Small functions @@ -2456,7 +2756,7 @@ the regular expression `comint-prompt-regexp', a buffer local variable." (defun sql-help-list-products (indent freep) "Generate listing of products available for use under SQLi. -List products with :free-softare attribute set to FREEP. Indent +List products with :free-software attribute set to FREEP. Indent each line with INDENT." (let (sqli-func doc) @@ -2649,7 +2949,7 @@ function like this: (sql-get-login 'user 'password 'database)." nil (append '(:number t) plist))))))) what)) -(defun sql-find-sqli-buffer (&optional product) +(defun sql-find-sqli-buffer (&optional product connection) "Returns the name of the current default SQLi buffer or nil. In order to qualify, the SQLi buffer must be alive, be in `sql-interactive-mode' and have a process." @@ -2657,16 +2957,16 @@ In order to qualify, the SQLi buffer must be alive, be in (prod (or product sql-product))) (or ;; Current sql-buffer, if there is one. - (and (sql-buffer-live-p buf prod) + (and (sql-buffer-live-p buf prod connection) buf) ;; Global sql-buffer (and (setq buf (default-value 'sql-buffer)) - (sql-buffer-live-p buf prod) + (sql-buffer-live-p buf prod connection) buf) ;; Look thru each buffer (car (apply 'append (mapcar (lambda (b) - (and (sql-buffer-live-p b prod) + (and (sql-buffer-live-p b prod connection) (list (buffer-name b)))) (buffer-list))))))) @@ -2722,7 +3022,8 @@ If you call it from anywhere else, it sets the global copy of This is the buffer SQL strings are sent to. It is stored in the variable `sql-buffer'. See `sql-help' on how to create such a buffer." (interactive) - (if (null (buffer-live-p (get-buffer sql-buffer))) + (if (or (null sql-buffer) + (null (buffer-live-p (get-buffer sql-buffer)))) (message "%s has no SQLi buffer set." (buffer-name (current-buffer))) (if (null (get-buffer-process sql-buffer)) (message "Buffer %s has no process." sql-buffer) @@ -2932,37 +3233,58 @@ Allows the suppression of continuation prompts.") ;;; Strip out continuation prompts +(defvar sql-preoutput-hold nil) + (defun sql-interactive-remove-continuation-prompt (oline) "Strip out continuation prompts out of the OLINE. Added to the `comint-preoutput-filter-functions' hook in a SQL -interactive buffer. If `sql-outut-newline-count' is greater than +interactive buffer. If `sql-output-newline-count' is greater than zero, then an output line matching the continuation prompt is filtered -out. If the count is one, then the prompt is replaced with a newline -to force the output from the query to appear on a new line." - (if (and sql-prompt-cont-regexp - sql-output-newline-count - (numberp sql-output-newline-count) - (>= sql-output-newline-count 1)) - (progn - (while (and oline - sql-output-newline-count - (> sql-output-newline-count 0) - (string-match sql-prompt-cont-regexp oline)) - - (setq oline - (replace-match (if (and - (= 1 sql-output-newline-count) - sql-output-by-send) - "\n" "") - nil nil oline) - sql-output-newline-count - (1- sql-output-newline-count))) - (if (= sql-output-newline-count 0) - (setq sql-output-newline-count nil)) - (setq sql-output-by-send nil)) - (setq sql-output-newline-count nil)) - oline) +out. If the count is zero, then a newline is inserted into the output +to force the output from the query to appear on a new line. + +The complication to this filter is that the continuation prompts +may arrive in multiple chunks. If they do, then the function +saves any unfiltered output in a buffer and prepends that buffer +to the next chunk to properly match the broken-up prompt. + +If the filter gets confused, it should reset and stop filtering +to avoid deleting non-prompt output." + + (let (did-filter) + (setq oline (concat (or sql-preoutput-hold "") oline) + sql-preoutput-hold nil) + + (if (and comint-prompt-regexp + (integerp sql-output-newline-count) + (>= sql-output-newline-count 1)) + (progn + (while (and (not (string= oline "")) + (> sql-output-newline-count 0) + (string-match comint-prompt-regexp oline) + (= (match-beginning 0) 0)) + + (setq oline (replace-match "" nil nil oline) + sql-output-newline-count (1- sql-output-newline-count) + did-filter t)) + + (if (= sql-output-newline-count 0) + (setq sql-output-newline-count nil + oline (concat "\n" oline) + sql-output-by-send nil) + + (setq sql-preoutput-hold oline + oline "")) + + (unless did-filter + (setq oline (or sql-preoutput-hold "") + sql-preoutput-hold nil + sql-output-newline-count nil))) + + (setq sql-output-newline-count nil)) + + oline)) ;;; Sending the region to the SQLi buffer. @@ -3066,16 +3388,35 @@ If given the optional parameter VALUE, sets ;;; Redirect output functions -(defun sql-redirect (command combuf &optional outbuf save-prior) +(defvar sql-debug-redirect nil + "If non-nil, display messages related to the use of redirection.") + +(defun sql-str-literal (s) + (concat "'" (replace-regexp-in-string "[']" "''" s) "'")) + +(defun sql-redirect (sqlbuf command &optional outbuf save-prior) "Execute the SQL command and send output to OUTBUF. -COMBUF must be an active SQL interactive buffer. OUTBUF may be +SQLBUF must be an active SQL interactive buffer. OUTBUF may be an existing buffer, or the name of a non-existing buffer. If omitted the output is sent to a temporary buffer which will be killed after the command completes. COMMAND should be a string -of commands accepted by the SQLi program." - - (with-current-buffer combuf +of commands accepted by the SQLi program. COMMAND may also be a +list of SQLi command strings." + + (let* ((visible (and outbuf + (not (string= " " (substring outbuf 0 1)))))) + (when visible + (message "Executing SQL command...")) + (if (consp command) + (mapc (lambda (c) (sql-redirect-one sqlbuf c outbuf save-prior)) + command) + (sql-redirect-one sqlbuf command outbuf save-prior)) + (when visible + (message "Executing SQL command...done")))) + +(defun sql-redirect-one (sqlbuf command outbuf save-prior) + (with-current-buffer sqlbuf (let ((buf (get-buffer-create (or outbuf " *SQL-Redirect*"))) (proc (get-buffer-process (current-buffer))) (comint-prompt-regexp (sql-get-product-feature sql-product @@ -3090,12 +3431,13 @@ of commands accepted by the SQLi program." (insert "\n")) (setq start (point))) + (when sql-debug-redirect + (message ">>SQL> %S" command)) + ;; Run the command - (message "Executing SQL command...") (comint-redirect-send-command-to-process command buf proc nil t) (while (null comint-redirect-completed) (accept-process-output nil 1)) - (message "Executing SQL command...done") ;; Clean up the output results (with-current-buffer buf @@ -3107,12 +3449,16 @@ of commands accepted by the SQLi program." (goto-char start) (when (looking-at (concat "^" (regexp-quote command) "[\\n]")) (delete-region (match-beginning 0) (match-end 0))) + ;; Remove Ctrl-Ms + (goto-char start) + (while (re-search-forward "\r+$" nil t) + (replace-match "" t t)) (goto-char start))))) -(defun sql-redirect-value (command combuf regexp &optional regexp-groups) +(defun sql-redirect-value (sqlbuf command regexp &optional regexp-groups) "Execute the SQL command and return part of result. -COMBUF must be an active SQL interactive buffer. COMMAND should +SQLBUF must be an active SQL interactive buffer. COMMAND should be a string of commands accepted by the SQLi program. From the output, the REGEXP is repeatedly matched and the list of REGEXP-GROUPS submatches is returned. This behaves much like @@ -3122,18 +3468,19 @@ for each match." (let ((outbuf " *SQL-Redirect-values*") (results nil)) - (sql-redirect command combuf outbuf nil) + (sql-redirect sqlbuf command outbuf nil) (with-current-buffer outbuf (while (re-search-forward regexp nil t) (push (cond ;; no groups-return all of them ((null regexp-groups) - (let ((i 1) + (let ((i (/ (length (match-data)) 2)) (r nil)) - (while (match-beginning i) + (while (> i 0) + (setq i (1- i)) (push (match-string i) r)) - (nreverse r))) + r)) ;; one group specified ((numberp regexp-groups) (match-string regexp-groups)) @@ -3152,10 +3499,14 @@ for each match." (error "sql-redirect-value: unknown REGEXP-GROUPS value - %s" regexp-groups))) results))) - (nreverse results))) -(defun sql-execute (sqlbuf outbuf command arg) - "Executes a command in a SQL interacive buffer and captures the output. + (when sql-debug-redirect + (message ">>SQL> = %S" (reverse results))) + + (nreverse results))) + +(defun sql-execute (sqlbuf outbuf command enhanced arg) + "Executes a command in a SQL interactive buffer and captures the output. The commands are run in SQLBUF and the output saved in OUTBUF. COMMAND must be a string, a function or a list of such elements. @@ -3168,9 +3519,9 @@ buffer is popped into a view window. " (lambda (c) (cond ((stringp c) - (sql-redirect (if arg (format c arg) c) sqlbuf outbuf) t) + (sql-redirect sqlbuf (if arg (format c arg) c) outbuf) t) ((functionp c) - (apply c sqlbuf outbuf arg)) + (apply c sqlbuf outbuf enhanced arg nil)) (t (error "Unknown sql-execute item %s" c)))) (if (consp command) command (cons command nil))) @@ -3197,14 +3548,92 @@ buffer is popped into a view window. " (setq command (if enhanced (cdr command) (car command)))) - (sql-execute sqlbuf outbuf command arg))) + (sql-execute sqlbuf outbuf command enhanced arg))) + +(defvar sql-completion-object nil + "A list of database objects used for completion. + +The list is maintained in SQL interactive buffers.") + +(defvar sql-completion-column nil + "A list of column names used for completion. + +The list is maintained in SQL interactive buffers.") + +(defun sql-build-completions-1 (schema completion-list feature) + "Generate a list of objects in the database for use as completions." + (let ((f (sql-get-product-feature sql-product feature))) + (when f + (set completion-list + (let (cl) + (dolist (e (append (symbol-value completion-list) + (apply f (current-buffer) (cons schema nil))) + cl) + (unless (member e cl) (setq cl (cons e cl)))) + (sort cl (function string<))))))) + +(defun sql-build-completions (schema) + "Generate a list of names in the database for use as completions." + (sql-build-completions-1 schema 'sql-completion-object :completion-object) + (sql-build-completions-1 schema 'sql-completion-column :completion-column)) + +(defvar sql-completion-sqlbuf nil) + +(defun sql-try-completion (string collection &optional predicate) + (when sql-completion-sqlbuf + (with-current-buffer sql-completion-sqlbuf + (let ((schema (and (string-match "\\`\\(\\sw\\(:?\\sw\\|\\s_\\)*\\)[.]" string) + (downcase (match-string 1 string))))) + + ;; If we haven't loaded any object name yet, load local schema + (unless sql-completion-object + (sql-build-completions nil)) + + ;; If they want another schema, load it if we haven't yet + (when schema + (let ((schema-dot (concat schema ".")) + (schema-len (1+ (length schema))) + (names sql-completion-object) + has-schema) + + (while (and (not has-schema) names) + (setq has-schema (and + (>= (length (car names)) schema-len) + (string= schema-dot + (downcase (substring (car names) + 0 schema-len)))) + names (cdr names))) + (unless has-schema + (sql-build-completions schema))))) + + ;; Try to find the completion + (cond + ((not predicate) + (try-completion string sql-completion-object)) + ((eq predicate t) + (all-completions string sql-completion-object)) + ((eq predicate 'lambda) + (test-completion string sql-completion-object)) + ((eq (car predicate) 'boundaries) + (completion-boundaries string sql-completion-object nil (cdr predicate))))))) (defun sql-read-table-name (prompt) "Read the name of a database table." - ;; TODO: Fetch table/view names from database and provide completion. - ;; Also implement thing-at-point if the buffer has valid names in it - ;; (i.e. sql-mode, sql-interactive-mode, or sql-list-all buffers) - (read-from-minibuffer prompt)) + (let* ((tname + (and (buffer-local-value 'sql-contains-names (current-buffer)) + (thing-at-point-looking-at + (concat "\\_<\\sw\\(:?\\sw\\|\\s_\\)*" + "\\(?:[.]+\\sw\\(?:\\sw\\|\\s_\\)*\\)*\\_>")) + (buffer-substring-no-properties (match-beginning 0) + (match-end 0)))) + (sql-completion-sqlbuf (sql-find-sqli-buffer)) + (product (with-current-buffer sql-completion-sqlbuf sql-product)) + (completion-ignore-case t)) + + (if (sql-get-product-feature product :completion-object) + (completing-read prompt (function sql-try-completion) + nil nil tname) + (read-from-minibuffer prompt tname)))) (defun sql-list-all (&optional enhanced) "List all database objects." @@ -3212,7 +3641,11 @@ buffer is popped into a view window. " (let ((sqlbuf (sql-find-sqli-buffer))) (unless sqlbuf (error "No SQL interactive buffer found")) - (sql-execute-feature sqlbuf "*List All*" :list-all enhanced nil))) + (sql-execute-feature sqlbuf "*List All*" :list-all enhanced nil) + (with-current-buffer sqlbuf + ;; Contains the name of database objects + (set (make-local-variable 'sql-contains-names) t) + (set (make-local-variable 'sql-buffer) sqlbuf)))) (defun sql-list-table (name &optional enhanced) "List the details of a database table. " @@ -3226,7 +3659,6 @@ buffer is popped into a view window. " (error "No table name specified")) (sql-execute-feature sqlbuf (format "*List %s*" name) :list-table enhanced name))) - ;;; SQL mode -- uses SQL interactive mode @@ -3277,6 +3709,8 @@ you must tell Emacs. Here's how to do that in your `~/.emacs' file: (set (make-local-variable 'paragraph-start) "[\n\f]") ;; Abbrevs (setq abbrev-all-caps 1) + ;; Contains the name of database objects + (set (make-local-variable 'sql-contains-names) t) ;; Catch changes to sql-product and highlight accordingly (add-hook 'hack-local-variables-hook 'sql-highlight-product t t)) @@ -3362,7 +3796,7 @@ you entered, right above the output it created. sql-product)) ;; Setup the mode. - (setq major-mode 'sql-interactive-mode) ;FIXME: Use define-derived-mode. + (setq major-mode 'sql-interactive-mode) (setq mode-name (concat "SQLi[" (or (sql-get-product-feature sql-product :name) (symbol-name sql-product)) "]")) @@ -3385,9 +3819,18 @@ you entered, right above the output it created. (setq abbrev-all-caps 1) ;; Exiting the process will call sql-stop. (set-process-sentinel (get-buffer-process (current-buffer)) 'sql-stop) - ;; Save the connection name - (make-local-variable 'sql-connection) - ;; Create a usefull name for renaming this buffer later. + ;; Save the connection and login params + (set (make-local-variable 'sql-user) sql-user) + (set (make-local-variable 'sql-database) sql-database) + (set (make-local-variable 'sql-server) sql-server) + (set (make-local-variable 'sql-port) sql-port) + (set (make-local-variable 'sql-connection) sql-connection) + ;; Contains the name of database objects + (set (make-local-variable 'sql-contains-names) t) + ;; Keep track of existing object names + (set (make-local-variable 'sql-completion-object) nil) + (set (make-local-variable 'sql-completion-column) nil) + ;; Create a useful name for renaming this buffer later. (set (make-local-variable 'sql-alternate-buffer-name) (sql-make-alternate-buffer-name)) ;; User stuff. Initialize before the hook. @@ -3398,6 +3841,7 @@ you entered, right above the output it created. (set (make-local-variable 'sql-prompt-cont-regexp) (sql-get-product-feature sql-product :prompt-cont-regexp)) (make-local-variable 'sql-output-newline-count) + (make-local-variable 'sql-preoutput-hold) (make-local-variable 'sql-output-by-send) (add-hook 'comint-preoutput-filter-functions 'sql-interactive-remove-continuation-prompt nil t) @@ -3450,7 +3894,7 @@ Sentinels will always get the two parameters PROCESS and EVENT." nil t initial 'sql-connection-history default))) ;;;###autoload -(defun sql-connect (connection) +(defun sql-connect (connection &optional new-name) "Connect to an interactive session using CONNECTION settings. See `sql-connection-alist' to see how to define connections and @@ -3462,7 +3906,8 @@ is specified in the connection settings." ;; Prompt for the connection from those defined in the alist (interactive (if sql-connection-alist - (list (sql-read-connection "Connection: " nil '(nil))) + (list (sql-read-connection "Connection: " nil '(nil)) + current-prefix-arg) nil)) ;; Are there connections defined @@ -3500,14 +3945,15 @@ is specified in the connection settings." (unless (member token set-params) (if plist (cons token plist) - token))))) - ;; Remember the connection - (sql-connection connection)) + token)))))) ;; Set the remaining parameters and start the ;; interactive session - (eval `(let ((,param-var ',rem-params)) - (sql-product-interactive sql-product))))) + (eval `(let ((sql-connection ,connection) + (,param-var ',rem-params)) + (sql-product-interactive sql-product + new-name))))) + (message "SQL Connection <%s> does not exist" connection) nil))) (message "No SQL Connections defined") @@ -3521,39 +3967,51 @@ optionally is saved to the user's init file." (interactive "sNew connection name: ") - (if sql-connection - (message "This session was started by a connection; it's already been saved.") - - (let ((login (sql-get-product-feature sql-product :sqli-login)) - (alist sql-connection-alist) - connect) - - ;; Remove the existing connection if the user says so - (when (and (assoc name alist) - (yes-or-no-p (format "Replace connection definition <%s>? " name))) - (setq alist (assq-delete-all name alist))) - - ;; Add the new connection if it doesn't exist - (if (assoc name alist) - (message "Connection <%s> already exists" name) - (setq connect - (append (list name) - (sql-for-each-login - `(product ,@login) - (lambda (token _plist) - (cond - ((eq token 'product) `(sql-product ',sql-product)) - ((eq token 'user) `(sql-user ,sql-user)) - ((eq token 'database) `(sql-database ,sql-database)) - ((eq token 'server) `(sql-server ,sql-server)) - ((eq token 'port) `(sql-port ,sql-port))))))) - - (setq alist (append alist (list connect))) - - ;; confirm whether we want to save the connections - (if (yes-or-no-p "Save the connections for future sessions? ") - (customize-save-variable 'sql-connection-alist alist) - (customize-set-variable 'sql-connection-alist alist)))))) + (unless (derived-mode-p 'sql-interactive-mode) + (error "Not in a SQL interactive mode!")) + + ;; Capture the buffer local settings + (let* ((buf (current-buffer)) + (connection (buffer-local-value 'sql-connection buf)) + (product (buffer-local-value 'sql-product buf)) + (user (buffer-local-value 'sql-user buf)) + (database (buffer-local-value 'sql-database buf)) + (server (buffer-local-value 'sql-server buf)) + (port (buffer-local-value 'sql-port buf))) + + (if connection + (message "This session was started by a connection; it's already been saved.") + + (let ((login (sql-get-product-feature product :sqli-login)) + (alist sql-connection-alist) + connect) + + ;; Remove the existing connection if the user says so + (when (and (assoc name alist) + (yes-or-no-p (format "Replace connection definition <%s>? " name))) + (setq alist (assq-delete-all name alist))) + + ;; Add the new connection if it doesn't exist + (if (assoc name alist) + (message "Connection <%s> already exists" name) + (setq connect + (append (list name) + (sql-for-each-login + `(product ,@login) + (lambda (token _plist) + (cond + ((eq token 'product) `(sql-product ',product)) + ((eq token 'user) `(sql-user ,user)) + ((eq token 'database) `(sql-database ,database)) + ((eq token 'server) `(sql-server ,server)) + ((eq token 'port) `(sql-port ,port))))))) + + (setq alist (append alist (list connect))) + + ;; confirm whether we want to save the connections + (if (yes-or-no-p "Save the connections for future sessions? ") + (customize-save-variable 'sql-connection-alist alist) + (customize-set-variable 'sql-connection-alist alist))))))) (defun sql-connection-menu-filter (tail) "Generates menu entries for using each connection." @@ -3561,7 +4019,10 @@ optionally is saved to the user's init file." (mapcar (lambda (conn) (vector - (format "Connection <%s>" (car conn)) + (format "Connection <%s>\t%s" (car conn) + (let ((sql-user "") (sql-database "") + (sql-server "") (sql-port 0)) + (eval `(let ,(cdr conn) (sql-make-alternate-buffer-name))))) (list 'sql-connect (car conn)) t)) sql-connection-alist) @@ -3599,10 +4060,10 @@ the call to \\[sql-product-interactive] with ;; Get the value of product that we need (setq product (cond - ((and product ; Product specified - (symbolp product)) product) ((= (prefix-numeric-value product) 4) ; C-u, prompt for product (sql-read-product "SQL product: " sql-product)) + ((and product ; Product specified + (symbolp product)) product) (t sql-product))) ; Default to sql-product ;; If we have a product and it has a interactive mode @@ -3610,7 +4071,7 @@ the call to \\[sql-product-interactive] with (when (sql-get-product-feature product :sqli-comint-func) ;; If no new name specified, try to pop to an active SQL ;; interactive for the same product - (let ((buf (sql-find-sqli-buffer product))) + (let ((buf (sql-find-sqli-buffer product sql-connection))) (if (and (not new-name) buf) (pop-to-buffer buf) @@ -3629,23 +4090,24 @@ the call to \\[sql-product-interactive] with (sql-get-product-feature product :sqli-options)) ;; Set SQLi mode. - (setq new-sqli-buffer (current-buffer)) (let ((sql-interactive-product product)) (sql-interactive-mode)) ;; Set the new buffer name + (setq new-sqli-buffer (current-buffer)) (when new-name (sql-rename-buffer new-name)) - - ;; Set `sql-buffer' in the new buffer and the start buffer (setq sql-buffer (buffer-name new-sqli-buffer)) + + ;; Set `sql-buffer' in the start buffer (with-current-buffer start-buffer - (setq sql-buffer (buffer-name new-sqli-buffer)) - (run-hooks 'sql-set-sqli-hook)) + (when (derived-mode-p 'sql-mode) + (setq sql-buffer (buffer-name new-sqli-buffer)) + (run-hooks 'sql-set-sqli-hook))) ;; All done. (message "Login...done") - (pop-to-buffer sql-buffer))))) + (pop-to-buffer new-sqli-buffer))))) (message "No default SQL product defined. Set `sql-product'."))) (defun sql-comint (product params) @@ -3720,6 +4182,157 @@ The default comes from `process-coding-system-alist' and (setq parameter options)) (sql-comint product parameter))) +(defun sql-oracle-save-settings (sqlbuf) + "Saves most SQL*Plus settings so they may be reset by \\[sql-redirect]." + ;; Note: does not capture the following settings: + ;; + ;; APPINFO + ;; BTITLE + ;; COMPATIBILITY + ;; COPYTYPECHECK + ;; MARKUP + ;; RELEASE + ;; REPFOOTER + ;; REPHEADER + ;; SQLPLUSCOMPATIBILITY + ;; TTITLE + ;; USER + ;; + + (append + ;; (apply 'concat (append + ;; '("SET") + + ;; option value... + (sql-redirect-value + sqlbuf + (concat "SHOW ARRAYSIZE AUTOCOMMIT AUTOPRINT AUTORECOVERY AUTOTRACE" + " CMDSEP COLSEP COPYCOMMIT DESCRIBE ECHO EDITFILE EMBEDDED" + " ESCAPE FLAGGER FLUSH HEADING INSTANCE LINESIZE LNO LOBOFFSET" + " LOGSOURCE LONG LONGCHUNKSIZE NEWPAGE NULL NUMFORMAT NUMWIDTH" + " PAGESIZE PAUSE PNO RECSEP SERVEROUTPUT SHIFTINOUT SHOWMODE" + " SPOOL SQLBLANKLINES SQLCASE SQLCODE SQLCONTINUE SQLNUMBER" + " SQLPROMPT SUFFIX TAB TERMOUT TIMING TRIMOUT TRIMSPOOL VERIFY") + "^.+$" + "SET \\&") + + ;; option "c" (hex xx) + (sql-redirect-value + sqlbuf + (concat "SHOW BLOCKTERMINATOR CONCAT DEFINE SQLPREFIX SQLTERMINATOR" + " UNDERLINE HEADSEP RECSEPCHAR") + "^\\(.+\\) (hex ..)$" + "SET \\1") + + ;; FEDDBACK ON for 99 or more rows + ;; feedback OFF + (sql-redirect-value + sqlbuf + "SHOW FEEDBACK" + "^\\(?:FEEDBACK ON for \\([[:digit:]]+\\) or more rows\\|feedback \\(OFF\\)\\)" + "SET FEEDBACK \\1\\2") + + ;; wrap : lines will be wrapped + ;; wrap : lines will be truncated + (list (concat "SET WRAP " + (if (string= + (car (sql-redirect-value + sqlbuf + "SHOW WRAP" + "^wrap : lines will be \\(wrapped\\|truncated\\)" 1)) + "wrapped") + "ON" "OFF"))))) + +(defun sql-oracle-restore-settings (sqlbuf saved-settings) + "Restore the SQL*Plus settings in SAVED-SETTINGS." + + ;; Remove any settings that haven't changed + (mapc + (lambda (one-cur-setting) + (setq saved-settings (delete one-cur-setting saved-settings))) + (sql-oracle-save-settings sqlbuf)) + + ;; Restore the changed settings + (sql-redirect sqlbuf saved-settings)) + +(defun sql-oracle-list-all (sqlbuf outbuf enhanced table-name) + ;; Query from USER_OBJECTS or ALL_OBJECTS + (let ((settings (sql-oracle-save-settings sqlbuf)) + (simple-sql + (concat + "SELECT INITCAP(x.object_type) AS SQL_EL_TYPE " + ", x.object_name AS SQL_EL_NAME " + "FROM user_objects x " + "WHERE x.object_type NOT LIKE '%% BODY' " + "ORDER BY 2, 1;")) + (enhanced-sql + (concat + "SELECT INITCAP(x.object_type) AS SQL_EL_TYPE " + ", x.owner ||'.'|| x.object_name AS SQL_EL_NAME " + "FROM all_objects x " + "WHERE x.object_type NOT LIKE '%% BODY' " + "AND x.owner <> 'SYS' " + "ORDER BY 2, 1;"))) + + (sql-redirect sqlbuf + (concat "SET LINESIZE 80 PAGESIZE 50000 TRIMOUT ON" + " TAB OFF TIMING OFF FEEDBACK OFF")) + + (sql-redirect sqlbuf + (list "COLUMN SQL_EL_TYPE HEADING \"Type\" FORMAT A19" + "COLUMN SQL_EL_NAME HEADING \"Name\"" + (format "COLUMN SQL_EL_NAME FORMAT A%d" + (if enhanced 60 35)))) + + (sql-redirect sqlbuf + (if enhanced enhanced-sql simple-sql) + outbuf) + + (sql-redirect sqlbuf + '("COLUMN SQL_EL_NAME CLEAR" + "COLUMN SQL_EL_TYPE CLEAR")) + + (sql-oracle-restore-settings sqlbuf settings))) + +(defun sql-oracle-list-table (sqlbuf outbuf enhanced table-name) + "Implements :list-table under Oracle." + (let ((settings (sql-oracle-save-settings sqlbuf))) + + (sql-redirect sqlbuf + (format + (concat "SET LINESIZE %d PAGESIZE 50000" + " DESCRIBE DEPTH 1 LINENUM OFF INDENT ON") + (max 65 (min 120 (window-width))))) + + (sql-redirect sqlbuf (format "DESCRIBE %s" table-name) + outbuf) + + (sql-oracle-restore-settings sqlbuf settings))) + +(defcustom sql-oracle-completion-types '("FUNCTION" "PACKAGE" "PROCEDURE" + "SEQUENCE" "SYNONYM" "TABLE" "TRIGGER" + "TYPE" "VIEW") + "List of object types to include for completion under Oracle. + +See the distinct values in ALL_OBJECTS.OBJECT_TYPE for possible values." + :version "24.1" + :type '(repeat string) + :group 'SQL) + +(defun sql-oracle-completion-object (sqlbuf schema) + (sql-redirect-value + sqlbuf + (concat + "SELECT CHR(1)||" + (if schema + (format "owner||'.'||object_name AS o FROM all_objects WHERE owner = %s AND " + (sql-str-literal (upcase schema))) + "object_name AS o FROM user_objects WHERE ") + "temporary = 'N' AND generated = 'N' AND secondary = 'N' AND " + "object_type IN (" + (mapconcat (function sql-str-literal) sql-oracle-completion-types ",") + ");") + "^[\001]\\(.+\\)$" 1)) ;;;###autoload @@ -3858,6 +4471,9 @@ The default comes from `process-coding-system-alist' and (setq params (append options params)) (sql-comint product params))) +(defun sql-sqlite-completion-object (sqlbuf schema) + (sql-redirect-value sqlbuf ".tables" "\\sw\\(?:\\sw\\|\\s_\\)*" 0)) + ;;;###autoload @@ -4112,6 +4728,33 @@ Try to set `comint-output-filter-functions' like this: (setq params (append (list "-p" sql-port) params))) (sql-comint product params))) +(defun sql-postgres-completion-object (sqlbuf schema) + (let (cl re fs a r) + (sql-redirect sqlbuf "\\t on") + (setq a (car (sql-redirect-value sqlbuf "\\a" "Output format is \\(.*\\)[.]$" 1))) + (when (string= a "aligned") + (sql-redirect sqlbuf "\\a")) + (setq fs (or (car (sql-redirect-value sqlbuf "\\f" "Field separator is \"\\(.\\)[.]$" 1)) "|")) + + (setq re (concat "^\\([^" fs "]*\\)" fs "\\([^" fs "]*\\)" fs "[^" fs "]*" fs "[^" fs "]*$")) + (setq cl (if (not schema) + (sql-redirect-value sqlbuf "\\d" re '(1 2)) + (append (sql-redirect-value sqlbuf (format "\\dt %s.*" schema) re '(1 2)) + (sql-redirect-value sqlbuf (format "\\dv %s.*" schema) re '(1 2)) + (sql-redirect-value sqlbuf (format "\\ds %s.*" schema) re '(1 2))))) + + ;; Restore tuples and alignment to what they were + (sql-redirect sqlbuf "\\t off") + (when (not (string= a "aligned")) + (sql-redirect sqlbuf "\\a")) + + ;; Return the list of table names (public schema name can be omitted) + (mapcar (lambda (tbl) + (if (string= (car tbl) "public") + (cadr tbl) + (format "%s.%s" (car tbl) (cadr tbl)))) + cl))) + ;;;###autoload @@ -4199,8 +4842,7 @@ The default comes from `process-coding-system-alist' and "Create comint buffer and connect to DB2." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. - (sql-comint product options) -) + (sql-comint product options)) ;;;###autoload (defun sql-linter (&optional buffer) @@ -4257,3 +4899,6 @@ buffer. (provide 'sql) ;;; sql.el ends here + +; LocalWords: sql SQL SQLite sqlite Sybase Informix MySQL +; LocalWords: Postgres SQLServer SQLi diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index eab34f6f026..f7cb1318dc0 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -3110,7 +3110,7 @@ Key bindings specific to `verilog-mode-map' are: #'verilog-indent-line-relative) (setq comment-indent-function 'verilog-comment-indent) (set (make-local-variable 'parse-sexp-ignore-comments) nil) - + (set (make-local-variable 'comment-start) "// ") (set (make-local-variable 'comment-end) "") (set (make-local-variable 'comment-start-skip) "/\\*+ *\\|// *") @@ -3157,7 +3157,7 @@ Key bindings specific to `verilog-mode-map' are: (set (make-local-variable 'imenu-generic-expression) verilog-imenu-generic-expression) ;; Tell which-func-modes that imenu knows about verilog - (when (boundp 'which-function-modes) + (when (boundp 'which-func-modes) (add-to-list 'which-func-modes 'verilog-mode)) ;; hideshow support (when (boundp 'hs-special-modes-alist) diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 4e4d7b15053..97e188139e9 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -206,7 +206,8 @@ It creates the Imenu index for the buffer, if necessary." (setq imenu--index-alist (save-excursion (funcall imenu-create-index-function)))) (error - (message "which-func-ff-hook error: %S" err) + (unless (equal err '(error "This buffer cannot use `imenu-default-create-index-function'")) + (message "which-func-ff-hook error: %S" err)) (setq which-func-mode nil)))) (defun which-func-update () diff --git a/lisp/register.el b/lisp/register.el index af1a421a0a2..221242546ec 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -28,6 +28,8 @@ ;; pieces of buffer state to named variables. The entry points are ;; documented in the Emacs user's manual. +(eval-when-compile (require 'cl)) + (declare-function semantic-insert-foreign-tag "semantic/tag" (foreign-tag)) (declare-function semantic-tag-buffer "semantic/tag" (tag)) (declare-function semantic-tag-start "semantic/tag" (tag)) @@ -50,9 +52,36 @@ ;;; Code: +(defstruct + (registerv (:constructor nil) + (:constructor registerv--make (&optional data print-func + jump-func insert-func)) + (:copier nil) + (:type vector) + :named) + (data nil :read-only t) + (print-func nil :read-only t) + (jump-func nil :read-only t) + (insert-func nil :read-only t)) + +(defun* registerv-make (data &key print-func jump-func insert-func) + "Create a register value object. + +DATA can be any value. +PRINT-FUNC if provided controls how `list-registers' and +`view-register' print the register. It should be a function +receiving one argument DATA and print text that completes +this sentence: + Register X contains [TEXT PRINTED BY PRINT-FUNC] +JUMP-FUNC if provided, controls how `jump-to-register' jumps to the register. +INSERT-FUNC if provided, controls how `insert-register' insert the register. +They both receive DATA as argument." + (registerv--make data print-func jump-func insert-func)) + (defvar register-alist nil "Alist of elements (NAME . CONTENTS), one for each Emacs register. -NAME is a character (a number). CONTENTS is a string, number, marker or list. +NAME is a character (a number). CONTENTS is a string, number, marker, list +or a struct returned by `registerv-make'. A list of strings represents a rectangle. A list of the form (file . FILE-NAME) represents the file named FILE-NAME. A list of the form (file-query FILE-NAME POSITION) represents @@ -120,6 +149,11 @@ delete any existing frames that the frame configuration doesn't mention. (interactive "cJump to register: \nP") (let ((val (get-register register))) (cond + ((registerv-p val) + (assert (registerv-jump-func val) nil + "Don't know how to jump to register %s" + (single-key-description register)) + (funcall (registerv-jump-func val) (registerv-data val))) ((and (consp val) (frame-configuration-p (car val))) (set-frame-configuration (car val) (not delete)) (goto-char (cadr val))) @@ -209,6 +243,11 @@ The Lisp value REGISTER is a character." (princ " contains ") (let ((val (get-register register))) (cond + ((registerv-p val) + (if (registerv-print-func val) + (funcall (registerv-print-func val) (registerv-data val)) + (princ "[UNPRINTABLE CONTENTS]."))) + ((numberp val) (princ val)) @@ -285,8 +324,11 @@ Interactively, second arg is non-nil if prefix arg is supplied." (push-mark) (let ((val (get-register register))) (cond - ((consp val) - (insert-rectangle val)) + ((registerv-p val) + (assert (registerv-insert-func val) nil + "Don't know how to insert register %s" + (single-key-description register)) + (funcall (registerv-insert-func val) (registerv-data val))) ((stringp val) (insert-for-yank val)) ((numberp val) diff --git a/lisp/replace.el b/lisp/replace.el index 0578ed09b1c..fb98a714dff 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1140,7 +1140,8 @@ are not modified." "Show all lines in buffers BUFS containing a match for REGEXP. This function acts on multiple buffers; otherwise, it is exactly like `occur'. When you invoke this command interactively, you must specify -the buffer names that you want, one by one." +the buffer names that you want, one by one. +See also `multi-occur-in-matching-buffers'." (interactive (cons (let* ((bufs (list (read-buffer "First buffer to search: " diff --git a/lisp/server.el b/lisp/server.el index 04d35695c57..c91f10b6584 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -679,7 +679,7 @@ Server mode runs a process that accepts commands from the (defun server-eval-and-print (expr proc) "Eval EXPR and send the result back to client PROC." (let ((v (eval (car (read-from-string expr))))) - (when (and v proc) + (when proc (with-temp-buffer (let ((standard-output (current-buffer))) (pp v) @@ -736,7 +736,8 @@ Server mode runs a process that accepts commands from the frame)) -(defun server-create-window-system-frame (display nowait proc parent-id) +(defun server-create-window-system-frame (display nowait proc parent-id + &optional parameters) (add-to-list 'frame-inherited-parameters 'client) (if (not (fboundp 'make-frame-on-display)) (progn @@ -751,7 +752,8 @@ Server mode runs a process that accepts commands from the ;; killing emacs on that frame. (let* ((params `((client . ,(if nowait 'nowait proc)) ;; This is a leftover, see above. - (environment . ,(process-get proc 'env)))) + (environment . ,(process-get proc 'env)) + ,@parameters)) (display (or display (frame-parameter nil 'display) (getenv "DISPLAY") @@ -832,6 +834,9 @@ The following commands are accepted by the server: `-current-frame' Forbid the creation of new frames. +`-frame-parameters ALIST' + Set the parameters of the created frame. + `-nowait' Request that the next frame created should not be associated with this client. @@ -940,6 +945,7 @@ The following commands are accepted by the client: commands dir use-current-frame + frame-parameters ;parameters for newly created frame tty-name ; nil, `window-system', or the tty name. tty-type ; string. files @@ -960,6 +966,13 @@ The following commands are accepted by the client: ;; -current-frame: Don't create frames. (`"-current-frame" (setq use-current-frame t)) + ;; -frame-parameters: Set frame parameters + (`"-frame-parameters" + (let ((alist (pop args-left))) + (if coding-system + (setq alist (decode-coding-string alist coding-system))) + (setq frame-parameters (car (read-from-string alist))))) + ;; -display DISPLAY: ;; Open X frames on the given display instead of the default. (`"-display" @@ -1075,7 +1088,8 @@ The following commands are accepted by the client: (if display (server-select-display display))) ((eq tty-name 'window-system) (server-create-window-system-frame display nowait proc - parent-id)) + parent-id + frame-parameters)) ;; When resuming on a tty, tty-name is nil. (tty-name (server-create-tty-frame tty-name tty-type proc)))) @@ -1139,7 +1153,10 @@ The following commands are accepted by the client: "When done with a buffer, type \\[server-edit]"))))) (when (and frame (null tty-name)) (server-unselect-display frame))) - (error (server-return-error proc err))))) + ((quit error) + (when (eq (car err) 'quit) + (message "Quit emacsclient request")) + (server-return-error proc err))))) (defun server-return-error (proc err) (ignore-errors @@ -1186,12 +1203,12 @@ so don't mark these buffers specially, just visit them normally." (add-to-history 'file-name-history filen) (if (null obuf) (progn - (run-hooks 'pre-command-hook) + (run-hooks 'pre-command-hook) (set-buffer (find-file-noselect filen))) (set-buffer obuf) ;; separately for each file, in sync with post-command hooks, ;; with the new buffer current: - (run-hooks 'pre-command-hook) + (run-hooks 'pre-command-hook) (cond ((file-exists-p filen) (when (not (verify-visited-file-modtime obuf)) (revert-buffer t nil))) @@ -1205,7 +1222,7 @@ so don't mark these buffers specially, just visit them normally." (server-goto-line-column (cdr file)) (run-hooks 'server-visit-hook) ;; hooks may be specific to current buffer: - (run-hooks 'post-command-hook)) + (run-hooks 'post-command-hook)) (unless nowait ;; When the buffer is killed, inform the clients. (add-hook 'kill-buffer-hook 'server-kill-buffer nil t) diff --git a/lisp/ses.el b/lisp/ses.el index 2fc85d27df9..9b2048eae83 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -3,8 +3,8 @@ ;; Copyright (C) 2002-2011 Free Software Foundation, Inc. ;; Author: Jonathan Yavner <jyavner@member.fsf.org> -;; Maintainer: Jonathan Yavner <jyavner@member.fsf.org> -;; Keywords: spreadsheet +;; Maintainer: Vincent BelaĂŻche <vincentb1@users.sourceforge.net> +;; Keywords: spreadsheet Dijkstra ;; This file is part of GNU Emacs. @@ -25,6 +25,7 @@ ;;; To-do list: +;; * split (catch 'cycle ...) call back into one or more functions ;; * Use $ or … for truncated fields ;; * Add command to make a range of columns be temporarily invisible. ;; * Allow paste of one cell to a range of cells -- copy formula to each. @@ -36,10 +37,26 @@ ;; * Left-margin column for row number. ;; * Move a row by dragging its number in the left-margin. +;;; Cycle detection + +;; Cycles used to be detected by stationarity of ses--deferred-recalc. This was +;; working fine in most cases, however failed in some cases of several path +;; racing together. +;; +;; The current algorithm is based on Dijksta algorithm. The ``cycle length'' is +;; stored in some cell property. In order not to reset in all cells such +;; property at each update, the cycle length is stored in this property along +;; with some update attempt id that is incremented at each update. The current +;; update id is ses--Dijkstra-attempt-nb. In case there is a cycle the cycle +;; length diverge to infinite so it will exceed ses--Dijkstra-weight-bound at +;; some point of time that allows detection. Otherwise it converges to the +;; longest path length in the update tree. + ;;; Code: (require 'unsafep) +(eval-when-compile (require 'cl)) ;;---------------------------------------------------------------------------- @@ -154,7 +171,7 @@ Each function is called with ARG=1." (defalias 'ses-mode-print-map (let ((keys '([backtab] backward-char [tab] ses-forward-or-insert - "\C-i" ses-forward-or-insert ;Needed for ses-coverage.el? + "\C-i" ses-forward-or-insert ; Needed for ses-coverage.el? "\M-o" ses-insert-column "\C-o" ses-insert-row "\C-m" ses-edit-cell @@ -225,10 +242,10 @@ Each function is called with ARG=1." "Initial contents for the file-trailer area at the bottom of the file.") (defconst ses-initial-file-contents - (concat " \n" ;One blank cell in print area + (concat " \n" ; One blank cell in print area. ses-print-data-boundary - "(ses-cell A1 nil nil nil nil)\n" ;One blank cell in data area - "\n" ;End-of-row terminator for the one row in data area + "(ses-cell A1 nil nil nil nil)\n" ; One blank cell in data area. + "\n" ; End-of-row terminator for the one row in data area. "(ses-column-widths [7])\n" "(ses-column-printers [nil])\n" "(ses-default-printer \"%.7g\")\n" @@ -255,23 +272,34 @@ default printer and then modify its output.") (eval-and-compile (defconst ses-localvars - '(ses--blank-line ses--cells ses--col-printers ses--col-widths ses--curcell - ses--curcell-overlay ses--default-printer ses--deferred-narrow - ses--deferred-recalc ses--deferred-write ses--file-format - ses--header-hscroll ses--header-row ses--header-string ses--linewidth - ses--numcols ses--numrows ses--symbolic-formulas ses--data-marker - ses--params-marker - ;;Global variables that we override + '(ses--blank-line ses--cells ses--col-printers + ses--col-widths ses--curcell ses--curcell-overlay + ses--default-printer + ses--deferred-narrow ses--deferred-recalc + ses--deferred-write ses--file-format + (ses--header-hscroll . -1) ; Flag for "initial recalc needed" + ses--header-row ses--header-string ses--linewidth + ses--numcols ses--numrows ses--symbolic-formulas + ses--data-marker ses--params-marker (ses--Dijkstra-attempt-nb . 0) + ses--Dijkstra-weight-bound + ;; Global variables that we override mode-line-process next-line-add-newlines transient-mark-mode) - "Buffer-local variables used by SES.")) + "Buffer-local variables used by SES.") -;;When compiling, create all the buffer locals and give them values -(eval-when-compile +(defun ses-set-localvars () + "Set buffer-local and initialize some SES variables." (dolist (x ses-localvars) - (make-local-variable x) - (set x nil))) + (cond + ((symbolp x) + (set (make-local-variable x) nil)) + ((consp x) + (set (make-local-variable (car x)) (cdr x))) + (t (error "Unexpected elements `%S' in list `ses-localvars'" x)))))) + +(eval-when-compile ; silence compiler + (ses-set-localvars)) -;;;This variable is documented as being permitted in file-locals: +;;; This variable is documented as being permitted in file-locals: (put 'ses--symbolic-formulas 'safe-local-variable 'consp) (defconst ses-paramlines-plist @@ -317,12 +345,14 @@ when to emit a progress message.") ;; We might want to use defstruct here, but cells are explicitly used as ;; arrays in ses-set-cell, so we'd need to fix this first. --Stef -(defsubst ses-make-cell (&optional symbol formula printer references) - (vector symbol formula printer references)) +(defsubst ses-make-cell (&optional symbol formula printer references + property-list) + (vector symbol formula printer references property-list)) (defmacro ses-cell-symbol (row &optional col) "From a CELL or a pair (ROW,COL), get the symbol that names the local-variable holding its value. (0,0) => A1." `(aref ,(if col `(ses-get-cell ,row ,col) row) 0)) +(put 'ses-cell-symbol 'safe-function t) (defmacro ses-cell-formula (row &optional col) "From a CELL or a pair (ROW,COL), get the function that computes its value." @@ -337,6 +367,116 @@ when to emit a progress message.") functions refer to its value." `(aref ,(if col `(ses-get-cell ,row ,col) row) 3)) +(defun ses-cell-property-get-fun (property-name cell) + ;; To speed up property fetching, each time a property is found it is placed + ;; in the first position. This way, after the first get, the full property + ;; list needs to be scanned only when the property does not exist for that + ;; cell. + (let* ((plist (aref cell 4)) + (ret (plist-member plist property-name))) + (if ret + ;; Property was found. + (let ((val (cadr ret))) + (if (eq ret plist) + ;; Property found is already in the first position, so just return + ;; its value. + val + ;; Property is not in the first position, the following will move it + ;; there before returning its value. + (let ((next (cddr ret))) + (if next + (progn + (setcdr ret (cdr next)) + (setcar ret (car next))) + (setcdr (last plist 1) nil))) + (aset cell 4 + `(,property-name ,val ,@plist)) + val))))) + +(defmacro ses-cell-property-get (property-name row &optional col) + "Get property named PROPERTY-NAME From a CELL or a pair (ROW,COL). + +When COL is omitted, CELL=ROW is a cell object. When COL is +present ROW and COL are the integer coordinates of the cell of +interest." + (declare (debug t)) + `(ses-cell-property-get-fun + ,property-name + ,(if col `(ses-get-cell ,row ,col) row))) + +(defun ses-cell-property-delq-fun (property-name cell) + (let ((ret (plist-get (aref cell 4) property-name))) + (if ret + (setcdr ret (cddr ret))))) + +(defun ses-cell-property-set-fun (property-name property-val cell) + (let* ((plist (aref cell 4)) + (ret (plist-member plist property-name))) + (if ret + (setcar (cdr ret) property-val) + (aset cell 4 `(,property-name ,property-val ,@plist))))) + +(defmacro ses-cell-property-set (property-name property-value row &optional col) + "From a CELL or a pair (ROW,COL), set the property value of +the corresponding cell with name PROPERTY-NAME to PROPERTY-VALUE." + (if property-value + `(ses-cell-property-set-fun ,property-name ,property-value + ,(if col `(ses-get-cell ,row ,col) row)) + `(ses-cell-property-delq-fun ,property-name + ,(if col `(ses-get-cell ,row ,col) row)))) + +(defun ses-cell-property-pop-fun (property-name cell) + (let* ((plist (aref cell 4)) + (ret (plist-member plist property-name))) + (if ret + (prog1 (cadr ret) + (let ((next (cddr ret))) + (if next + (progn + (setcdr ret (cdr next)) + (setcar ret (car next))) + (if (eq plist ret) + (aset cell 4 nil) + (setcdr (last plist 2) nil)))))))) + + +(defmacro ses-cell-property-pop (property-name row &optional col) + "From a CELL or a pair (ROW,COL), get and remove the property value of +the corresponding cell with name PROPERTY-NAME." + `(ses-cell-property-pop-fun ,property-name + ,(if col `(ses-get-cell ,row ,col) row))) + +(defun ses-cell-property-get-handle-fun (property-name cell) + (let* ((plist (aref cell 4)) + (ret (plist-member plist property-name))) + (if ret + (if (eq ret plist) + (cdr ret) + (let ((val (cadr ret)) + (next (cddr ret))) + (if next + (progn + (setcdr ret (cdr next)) + (setcar ret (car next))) + (setcdr (last plist 2) nil)) + (setq ret (cons val plist)) + (aset cell 4 (cons property-name ret)) + ret)) + (setq ret (cons nil plist)) + (aset cell 4 (cons property-name ret)) + ret))) + +(defmacro ses-cell-property-get-handle (property-name row &optional col) + "From a CELL or a pair (ROW,COL), get a cons cell whose car is +the property value of the corresponding cell property with name +PROPERTY-NAME." + `(ses-cell-property-get-handle-fun ,property-name + ,(if col `(ses-get-cell ,row ,col) row))) + + +(defalias 'ses-cell-property-handle-car 'car) +(defalias 'ses-cell-property-handle-setcar 'setcar) + (defmacro ses-cell-value (row &optional col) "From a CELL or a pair (ROW,COL), get the current value for that cell." `(symbol-value (ses-cell-symbol ,row ,col))) @@ -514,7 +654,7 @@ for this spreadsheet." 0-25 become A-Z; 26-701 become AA-ZZ, and so on." (let ((units (char-to-string (+ ?A (% col 26))))) (if (< col 26) - units + units (concat (ses-column-letter (1- (/ col 26))) units)))) (defun ses-create-cell-symbol (row col) @@ -534,9 +674,9 @@ for this spreadsheet." (put sym 'ses-cell (cons xrow xcol)) (make-local-variable sym))))) -;;We do not delete the ses-cell properties for the cell-variables, in case a -;;formula that refers to this cell is in the kill-ring and is later pasted -;;back in. +;; We do not delete the ses-cell properties for the cell-variables, in +;; case a formula that refers to this cell is in the kill-ring and is +;; later pasted back in. (defun ses-destroy-cell-variable-range (minrow maxrow mincol maxcol) "Destroy buffer-local variables for cells. This is undoable." (let (sym) @@ -584,7 +724,7 @@ cell (ROW,COL). This is undoable. The cell's data will be updated through (ses-aset-with-undo cell elt val))) (if change (add-to-list 'ses--deferred-write (cons row col)))) - nil) ;Make coverage-tester happy + nil) ; Make coverage-tester happy. (defun ses-cell-set-formula (row col formula) "Store a new formula for (ROW . COL) and enqueues the cell for @@ -620,6 +760,75 @@ means Emacs will crash if FORMULA contains a circular list." (ses-formula-record formula) (ses-set-cell row col 'formula formula)))) + +(defun ses-repair-cell-reference-all () + "Repair cell reference and warn if there was some reference corruption." + (interactive "*") + (let (errors) + ;; Step 1, reset :ses-repair-reference cell property in the whole sheet. + (dotimes (row ses--numrows) + (dotimes (col ses--numcols) + (let ((references (ses-cell-property-pop :ses-repair-reference + row col))) + (when references + (push (list + (ses-cell-symbol row col) + :corrupt-property + references) errors))))) + + ;; Step 2, build new. + (dotimes (row ses--numrows) + (dotimes (col ses--numcols) + (let* ((cell (ses-get-cell row col)) + (sym (ses-cell-symbol cell)) + (formula (ses-cell-formula cell)) + (new-ref (ses-formula-references formula))) + (dolist (ref new-ref) + (let* ((rowcol (ses-sym-rowcol ref)) + (h (ses-cell-property-get-handle :ses-repair-reference + (car rowcol) (cdr rowcol)))) + (unless (memq ref (ses-cell-property-handle-car h)) + (ses-cell-property-handle-setcar + h + (cons sym + (ses-cell-property-handle-car h))))))))) + + ;; Step 3, overwrite with check. + (dotimes (row ses--numrows) + (dotimes (col ses--numcols) + (let* ((cell (ses-get-cell row col)) + (irrelevant (ses-cell-references cell)) + (new-ref (ses-cell-property-pop :ses-repair-reference cell)) + missing) + (dolist (ref new-ref) + (if (memq ref irrelevant) + (setq irrelevant (delq ref irrelevant)) + (push ref missing))) + (ses-set-cell row col 'references new-ref) + (when (or missing irrelevant) + (push `( ,(ses-cell-symbol cell) + ,@(and missing (list :missing missing)) + ,@(and irrelevant (list :irrelevant irrelevant))) + errors))))) + (if errors + (warn "---------------------------------------------------------------- +Some reference where corrupted. + +The following is a list of where each element ELT is such +that (car ELT) is the reference of cell CELL with corruption, +and (cdr ELT) is a property list where + +* property `:corrupt-property' means that + property `:ses-repair-reference' of cell CELL was initially non + nil, + +* property `:missing' is a list of missing references + +* property `:irrelevant' is a list of non needed references + +%S" errors) + (message "No reference corruption found")))) + (defun ses-calculate-cell (row col force) "Calculate and print the value for cell (ROW,COL) using the cell's formula function and print functions, if any. Result is nil for normal operation, or @@ -629,34 +838,95 @@ left unchanged if it was *skip* and the new value is nil. processing for the current keystroke, unless the new value is the same as the old and FORCE is nil." (let ((cell (ses-get-cell row col)) - formula-error printer-error) + cycle-error formula-error printer-error) (let ((oldval (ses-cell-value cell)) (formula (ses-cell-formula cell)) - newval) + newval + this-cell-Dijkstra-attempt-h + this-cell-Dijkstra-attempt + this-cell-Dijkstra-attempt+1 + ref-cell-Dijkstra-attempt-h + ref-cell-Dijkstra-attempt + ref-rowcol) (when (eq (car-safe formula) 'ses-safe-formula) (setq formula (ses-safe-formula (cadr formula))) (ses-set-cell row col 'formula formula)) (condition-case sig (setq newval (eval formula)) (error + ;; Variable `sig' can't be nil. + (nconc sig (list (ses-cell-symbol cell))) (setq formula-error sig newval '*error*))) (if (and (not newval) (eq oldval '*skip*)) - ;;Don't lose the *skip* - previous field spans this one + ;; Don't lose the *skip* --- previous field spans this one. (setq newval '*skip*)) - (when (or force (not (eq newval oldval))) - (add-to-list 'ses--deferred-write (cons row col)) ;In case force=t - (ses-set-cell row col 'value newval) - (dolist (ref (ses-cell-references cell)) - (add-to-list 'ses--deferred-recalc ref)))) + (catch 'cycle + (when (or force (not (eq newval oldval))) + (add-to-list 'ses--deferred-write (cons row col)) ; In case force=t. + (setq this-cell-Dijkstra-attempt-h + (ses-cell-property-get-handle :ses-Dijkstra-attempt cell); + this-cell-Dijkstra-attempt + (ses-cell-property-handle-car this-cell-Dijkstra-attempt-h)) + (if (null this-cell-Dijkstra-attempt) + (ses-cell-property-handle-setcar + this-cell-Dijkstra-attempt-h + (setq this-cell-Dijkstra-attempt + (cons ses--Dijkstra-attempt-nb 0))) + (unless (= ses--Dijkstra-attempt-nb + (car this-cell-Dijkstra-attempt)) + (setcar this-cell-Dijkstra-attempt ses--Dijkstra-attempt-nb) + (setcdr this-cell-Dijkstra-attempt 0))) + (setq this-cell-Dijkstra-attempt+1 + (1+ (cdr this-cell-Dijkstra-attempt))) + (ses-set-cell row col 'value newval) + (dolist (ref (ses-cell-references cell)) + (add-to-list 'ses--deferred-recalc ref) + (setq ref-rowcol (ses-sym-rowcol ref) + ref-cell-Dijkstra-attempt-h + (ses-cell-property-get-handle + :ses-Dijkstra-attempt + (car ref-rowcol) (cdr ref-rowcol)) + ref-cell-Dijkstra-attempt + (ses-cell-property-handle-car ref-cell-Dijkstra-attempt-h)) + + (if (null ref-cell-Dijkstra-attempt) + (ses-cell-property-handle-setcar + ref-cell-Dijkstra-attempt-h + (setq ref-cell-Dijkstra-attempt + (cons ses--Dijkstra-attempt-nb + this-cell-Dijkstra-attempt+1))) + (if (= (car ref-cell-Dijkstra-attempt) ses--Dijkstra-attempt-nb) + (setcdr ref-cell-Dijkstra-attempt + (max (cdr ref-cell-Dijkstra-attempt) + this-cell-Dijkstra-attempt+1)) + (setcar ref-cell-Dijkstra-attempt ses--Dijkstra-attempt-nb) + (setcdr ref-cell-Dijkstra-attempt + this-cell-Dijkstra-attempt+1))) + + (when (> this-cell-Dijkstra-attempt+1 ses--Dijkstra-weight-bound) + ;; Update print of this cell. + (throw 'cycle (setq formula-error + `(error ,(format "Found cycle on cells %S" + (ses-cell-symbol cell))) + cycle-error formula-error))))))) (setq printer-error (ses-print-cell row col)) - (or formula-error printer-error))) + (or + (and cycle-error + (error (error-message-string cycle-error))) + formula-error printer-error))) (defun ses-clear-cell (row col) "Delete formula and printer for cell (ROW,COL)." (ses-set-cell row col 'printer nil) (ses-cell-set-formula row col nil)) +(defcustom ses-self-reference-early-detection nil + "True if cycle detection is early for cells that refer to +themselves." + :type 'boolean + :group 'ses) + (defun ses-update-cells (list &optional force) "Recalculate cells in LIST, checking for dependency loops. Prints progress messages every second. Dependent cells are not recalculated @@ -664,13 +934,13 @@ if the cell's value is unchanged and FORCE is nil." (let ((ses--deferred-recalc list) (nextlist list) (pos (point)) - curlist prevlist rowcol formula) + curlist prevlist this-sym this-rowcol formula) (with-temp-message " " - (while (and ses--deferred-recalc (not (equal nextlist prevlist))) - ;;In each loop, recalculate cells that refer only to other cells that - ;;have already been recalculated or aren't in the recalculation - ;;region. Repeat until all cells have been processed or until the - ;;set of cells being worked on stops changing. + (while ses--deferred-recalc + ;; In each loop, recalculate cells that refer only to other cells that + ;; have already been recalculated or aren't in the recalculation region. + ;; Repeat until all cells have been processed or until the set of cells + ;; being worked on stops changing. (if prevlist (message "Recalculating... (%d cells left)" (length ses--deferred-recalc))) @@ -678,38 +948,39 @@ if the cell's value is unchanged and FORCE is nil." ses--deferred-recalc nil prevlist nextlist) (while curlist - (setq rowcol (ses-sym-rowcol (car curlist)) - formula (ses-cell-formula (car rowcol) (cdr rowcol))) + ;; this-sym has to be popped from curlist *BEFORE* the check, and not + ;; after because of the case of cells referring to themselves. + (setq this-sym (pop curlist) + this-rowcol (ses-sym-rowcol this-sym) + formula (ses-cell-formula (car this-rowcol) + (cdr this-rowcol))) (or (catch 'ref (dolist (ref (ses-formula-references formula)) - (when (or (memq ref curlist) - (memq ref ses--deferred-recalc)) - ;;This cell refers to another that isn't done yet - (add-to-list 'ses--deferred-recalc (car curlist)) - (throw 'ref t)))) - ;;ses-update-cells is called from post-command-hook, so - ;;inhibit-quit is implicitly bound to t. + (if (and ses-self-reference-early-detection (eq ref this-sym)) + (error "Cycle found: cell %S is self-referring" this-sym) + (when (or (memq ref curlist) + (memq ref ses--deferred-recalc)) + ;; This cell refers to another that isn't done yet + (add-to-list 'ses--deferred-recalc this-sym) + (throw 'ref t))))) + ;; ses-update-cells is called from post-command-hook, so + ;; inhibit-quit is implicitly bound to t. (when quit-flag - ;;Abort the recalculation. User will probably undo now. + ;; Abort the recalculation. User will probably undo now. (error "Quit")) - (ses-calculate-cell (car rowcol) (cdr rowcol) force)) - (setq curlist (cdr curlist))) + (ses-calculate-cell (car this-rowcol) (cdr this-rowcol) force))) (dolist (ref ses--deferred-recalc) - (add-to-list 'nextlist ref)) - (setq nextlist (sort (copy-sequence nextlist) 'string<)) - (if (equal nextlist prevlist) - ;;We'll go around the loop one more time. - (add-to-list 'nextlist t))) + (add-to-list 'nextlist ref))) (when ses--deferred-recalc - ;;Just couldn't finish these + ;; Just couldn't finish these. (dolist (x ses--deferred-recalc) - (let ((rowcol (ses-sym-rowcol x))) - (ses-set-cell (car rowcol) (cdr rowcol) 'value '*error*) - (1value (ses-print-cell (car rowcol) (cdr rowcol))))) + (let ((this-rowcol (ses-sym-rowcol x))) + (ses-set-cell (car this-rowcol) (cdr this-rowcol) 'value '*error*) + (1value (ses-print-cell (car this-rowcol) (cdr this-rowcol))))) (error "Circular references: %s" ses--deferred-recalc)) (message " ")) - ;;Can't use save-excursion here: if the cell under point is - ;;updated, save-excusion's marker will move past the cell. + ;; Can't use save-excursion here: if the cell under point is updated, + ;; save-excusion's marker will move past the cell. (goto-char pos))) @@ -721,22 +992,22 @@ if the cell's value is unchanged and FORCE is nil." "Returns t if point is in print area of spreadsheet." (<= (point) ses--data-marker)) -;;We turn off point-motion-hooks and explicitly position the cursor, in case -;;the intangible properties have gotten screwed up (e.g., when -;;ses-goto-print is called during a recursive ses-print-cell). +;; We turn off point-motion-hooks and explicitly position the cursor, in case +;; the intangible properties have gotten screwed up (e.g., when ses-goto-print +;; is called during a recursive ses-print-cell). (defun ses-goto-print (row col) "Move point to print area for cell (ROW,COL)." (let ((inhibit-point-motion-hooks t) (n 0)) (goto-char (point-min)) (forward-line row) - ;; calculate column position + ;; Calculate column position. (dotimes (c col) (setq n (+ n (ses-col-width c) 1))) - ;; move to the position + ;; Move to the position. (and (> n (move-to-column n)) (eolp) - ;; move point to the bol of next line (for TAB at the last cell) + ;; Move point to the bol of next line (for TAB at the last cell). (forward-char)))) (defun ses-set-curcell () @@ -745,13 +1016,13 @@ region, or nil if cursor is not at a cell." (if (or (not mark-active) deactivate-mark (= (region-beginning) (region-end))) - ;;Single cell + ;; Single cell. (setq ses--curcell (get-text-property (point) 'intangible)) - ;;Range + ;; Range. (let ((bcell (get-text-property (region-beginning) 'intangible)) (ecell (get-text-property (1- (region-end)) 'intangible))) (when (= (region-end) ses--data-marker) - ;;Correct for overflow + ;; Correct for overflow. (setq ecell (get-text-property (- (region-end) 2) 'intangible))) (setq ses--curcell (if (and bcell ecell) (cons bcell ecell) @@ -764,7 +1035,7 @@ appropriate if some argument is 'end. A range is appropriate if some argument is 'range. A single cell is appropriate unless some argument is 'needrange." (if (eq ses--curcell t) - ;;curcell recalculation was postponed, but user typed ahead + ;; curcell recalculation was postponed, but user typed ahead. (ses-set-curcell)) (cond ((not ses--curcell) @@ -791,53 +1062,53 @@ preceding cell has spilled over." (printer (ses-cell-printer cell)) (maxcol (1+ col)) text sig startpos x) - ;;Create the string to print + ;; Create the string to print. (cond ((eq value '*skip*) - ;;Don't print anything + ;; Don't print anything. (throw 'ses-print-cell nil)) ((eq value '*error*) (setq text (make-string (ses-col-width col) ?#))) (t - ;;Deferred safety-check on printer + ;; Deferred safety-check on printer. (if (eq (car-safe printer) 'ses-safe-printer) (ses-set-cell row col 'printer (setq printer (ses-safe-printer (cadr printer))))) - ;;Print the value + ;; Print the value. (setq text (ses-call-printer (or printer (ses-col-printer col) ses--default-printer) value)) (if (consp ses-call-printer-return) - ;;Printer returned an error + ;; Printer returned an error. (setq sig ses-call-printer-return)))) - ;;Adjust print width to match column width + ;; Adjust print width to match column width. (let ((width (ses-col-width col)) (len (string-width text))) (cond ((< len width) - ;;Fill field to length with spaces + ;; Fill field to length with spaces. (setq len (make-string (- width len) ?\s) text (if (eq ses-call-printer-return t) (concat text len) (concat len text)))) ((> len width) - ;;Spill over into following cells, if possible + ;; Spill over into following cells, if possible. (let ((maxwidth width)) (while (and (> len maxwidth) (< maxcol ses--numcols) (or (not (setq x (ses-cell-value row maxcol))) (eq x '*skip*))) (unless x - ;;Set this cell to '*skip* so it won't overwrite our spillover + ;; Set this cell to '*skip* so it won't overwrite our spillover. (ses-set-cell row maxcol 'value '*skip*)) (setq maxwidth (+ maxwidth (ses-col-width maxcol) 1) maxcol (1+ maxcol))) (if (<= len maxwidth) - ;;Fill to complete width of all the fields spanned + ;; Fill to complete width of all the fields spanned. (setq text (concat text (make-string (- maxwidth len) ?\s))) - ;;Not enough room to end of line or next non-nil field. Truncate - ;;if string or decimal; otherwise fill with error indicator + ;; Not enough room to end of line or next non-nil field. Truncate + ;; if string or decimal; otherwise fill with error indicator. (setq sig `(error "Too wide" ,text)) (cond ((stringp value) @@ -854,12 +1125,12 @@ preceding cell has spilled over." (substring text (match-end 0))))) (t (setq text (make-string maxwidth ?#))))))))) - ;;Substitute question marks for tabs and newlines. Newlines are - ;;used as row-separators; tabs could confuse the reimport logic. + ;; Substitute question marks for tabs and newlines. Newlines are used as + ;; row-separators; tabs could confuse the reimport logic. (setq text (replace-regexp-in-string "[\t\n]" "?" text)) (ses-goto-print row col) (setq startpos (point)) - ;;Install the printed result. This is not interruptible. + ;; Install the printed result. This is not interruptible. (let ((inhibit-read-only t) (inhibit-quit t)) (let ((inhibit-point-motion-hooks t)) @@ -867,32 +1138,32 @@ preceding cell has spilled over." (move-to-column (+ (current-column) (string-width text))) (1+ (point))))) - ;;We use concat instead of inserting separate strings in order to - ;;reduce the number of cells in the undo list. + ;; We use concat instead of inserting separate strings in order to + ;; reduce the number of cells in the undo list. (setq x (concat text (if (< maxcol ses--numcols) " " "\n"))) - ;;We use set-text-properties to prevent a wacky print function - ;;from inserting rogue properties, and to ensure that the keymap - ;;property is inherited (is it a bug that only unpropertied strings - ;;actually inherit from surrounding text?) + ;; We use set-text-properties to prevent a wacky print function from + ;; inserting rogue properties, and to ensure that the keymap property is + ;; inherited (is it a bug that only unpropertied strings actually + ;; inherit from surrounding text?) (set-text-properties 0 (length x) nil x) (insert-and-inherit x) (put-text-property startpos (point) 'intangible (ses-cell-symbol cell)) (when (and (zerop row) (zerop col)) - ;;Reconstruct special beginning-of-buffer attributes + ;; Reconstruct special beginning-of-buffer attributes. (put-text-property (point-min) (point) 'keymap 'ses-mode-print-map) (put-text-property (point-min) (point) 'read-only 'ses) (put-text-property (point-min) (1+ (point-min)) 'front-sticky t))) (if (= row (1- ses--header-row)) - ;;This line is part of the header - force recalc + ;; This line is part of the header --- force recalc. (ses-reset-header-string)) - ;;If this cell (or a preceding one on the line) previously spilled over - ;;and has gotten shorter, redraw following cells on line recursively. + ;; If this cell (or a preceding one on the line) previously spilled over + ;; and has gotten shorter, redraw following cells on line recursively. (when (and (< maxcol ses--numcols) (eq (ses-cell-value row maxcol) '*skip*)) (ses-set-cell row maxcol 'value nil) (ses-print-cell row maxcol)) - ;;Return to start of cell + ;; Return to start of cell. (goto-char startpos) sig))) @@ -903,17 +1174,19 @@ The variable `ses-call-printer-return' is set to t if the printer used parenthesis to request left-justification, or the error-signal if the printer signaled one (and \"%s\" is used as the default printer), else nil." (setq ses-call-printer-return nil) - (unless value - (setq value "")) (condition-case signal (cond ((stringp printer) - (format printer value)) + (if value + (format printer value) + "")) ((stringp (car-safe printer)) (setq ses-call-printer-return t) - (format (car printer) value)) + (if value + (format (car printer) value) + "")) (t - (setq value (funcall printer value)) + (setq value (funcall printer (or value ""))) (if (stringp value) value (or (stringp (car-safe value)) @@ -932,13 +1205,13 @@ inhibit-quit to t." (blank (if (> change 0) (make-string change ?\s))) (at-end (= col ses--numcols))) (ses-set-with-undo 'ses--linewidth (+ ses--linewidth change)) - ;;ses-set-with-undo always returns t for strings. + ;; ses-set-with-undo always returns t for strings. (1value (ses-set-with-undo 'ses--blank-line (concat (make-string ses--linewidth ?\s) "\n"))) (dotimes (row ses--numrows) (ses-goto-print row col) (when at-end - ;;Insert new columns before newline + ;; Insert new columns before newline. (let ((inhibit-point-motion-hooks t)) (backward-char 1))) (if blank @@ -976,13 +1249,13 @@ number, COL is the column number for a data cell -- otherwise DEF is one of the symbols ses--col-widths, ses--col-printers, ses--default-printer, ses--numrows, or ses--numcols." (ses-widen) - (let ((inhibit-point-motion-hooks t)) ;In case intangible attrs are wrong + (let ((inhibit-point-motion-hooks t)) ; In case intangible attrs are wrong. (if col - ;;It's a cell + ;; It's a cell. (progn (goto-char ses--data-marker) (forward-line (+ 1 (* def (1+ ses--numcols)) col))) - ;;Convert def-symbol to offset + ;; Convert def-symbol to offset. (setq def (plist-get ses-paramlines-plist def)) (or def (signal 'args-out-of-range nil)) (goto-char ses--params-marker) @@ -993,8 +1266,8 @@ ses--default-printer, ses--numrows, or ses--numcols." See `ses-goto-data' for meaning of DEF. Newlines in the data are escaped. If ELEM is specified, it is the array subscript within DEF to be set to VALUE." (save-excursion - ;;We call ses-goto-data early, using the old values of numrows and - ;;numcols in case one of them is being changed. + ;; We call ses-goto-data early, using the old values of numrows and numcols + ;; in case one of them is being changed. (ses-goto-data def) (let ((inhibit-read-only t) (fmt (plist-get '(ses--col-widths "(ses-column-widths %S)" @@ -1012,7 +1285,7 @@ If ELEM is specified, it is the array subscript within DEF to be set to VALUE." (aset (symbol-value def) elem value)) (setq oldval (symbol-value def)) (set def value)) - ;;Special undo since it's outside the narrowed buffer + ;; Special undo since it's outside the narrowed buffer. (let (buffer-undo-list) (delete-region (point) (line-end-position)) (insert (format fmt (symbol-value def)))) @@ -1042,7 +1315,7 @@ Newlines in the data are escaped." (setq formula (cadr formula))) (if (eq (car-safe printer) 'ses-safe-printer) (setq printer (cadr printer))) - ;;This is noticably faster than (format "%S %S %S %S %S") + ;; This is noticably faster than (format "%S %S %S %S %S") (setq text (concat "(ses-cell " (symbol-name sym) " " @@ -1072,29 +1345,30 @@ Newlines in the data are escaped." (defun ses-formula-references (formula &optional result-so-far) "Produce a list of symbols for cells that this formula's value -refers to. For recursive calls, RESULT-SO-FAR is the list being constructed, -or t to get a wrong-type-argument error when the first reference is found." - (if (atom formula) - (if (ses-sym-rowcol formula) - ;;Entire formula is one symbol - (add-to-list 'result-so-far formula) - ) ;;Ignore other atoms - (dolist (cur formula) - (cond - ((ses-sym-rowcol cur) - ;;Save this reference - (add-to-list 'result-so-far cur)) - ((eq (car-safe cur) 'ses-range) - ;;All symbols in range are referenced - (dolist (x (cdr (macroexpand cur))) - (add-to-list 'result-so-far x))) - ((and (consp cur) (not (eq (car cur) 'quote))) - ;;Recursive call for subformulas - (setq result-so-far (ses-formula-references cur result-so-far))) - (t - ;;Ignore other stuff - )))) - result-so-far) +refers to. For recursive calls, RESULT-SO-FAR is the list being +constructed, or t to get a wrong-type-argument error when the +first reference is found." + (if (ses-sym-rowcol formula) + ;;Entire formula is one symbol + (add-to-list 'result-so-far formula) + (if (consp formula) + (cond + ((eq (car formula) 'ses-range) + (dolist (cur + (cdr (funcall 'macroexpand + (list 'ses-range (nth 1 formula) + (nth 2 formula))))) + (add-to-list 'result-so-far cur))) + ((null (eq (car formula) 'quote)) + ;;Recursive call for subformulas + (dolist (cur formula) + (setq result-so-far (ses-formula-references cur result-so-far)))) + (t + ;;Ignore other stuff + )) + ;; other type of atom are ignored + )) + result-so-far) (defsubst ses-relocate-symbol (sym rowcol startrow startcol rowincr colincr) "Relocate one symbol SYM, whichs corresponds to ROWCOL (a cons of ROW and @@ -1129,7 +1403,7 @@ Sets `ses-relocate-return' to 'delete if cell-references were removed." (if (setq rowcol (ses-sym-rowcol formula)) (ses-relocate-symbol formula rowcol startrow startcol rowincr colincr) - formula) ;Pass through as-is + formula) ; Pass through as-is. (dolist (cur formula) (setq rowcol (ses-sym-rowcol cur)) (cond @@ -1138,9 +1412,9 @@ Sets `ses-relocate-return' to 'delete if cell-references were removed." startrow startcol rowincr colincr)) (if cur (push cur result) - ;;Reference to a deleted cell. Set a flag in ses-relocate-return. - ;;don't change the flag if it's already 'range, since range - ;;implies 'delete. + ;; Reference to a deleted cell. Set a flag in ses-relocate-return. + ;; don't change the flag if it's already 'range, since range implies + ;; 'delete. (unless ses-relocate-return (setq ses-relocate-return 'delete)))) ((eq (car-safe cur) 'ses-range) @@ -1148,10 +1422,10 @@ Sets `ses-relocate-return' to 'delete if cell-references were removed." (if cur (push cur result))) ((or (atom cur) (eq (car cur) 'quote)) - ;;Constants pass through unchanged + ;; Constants pass through unchanged. (push cur result)) (t - ;;Recursively copy and alter subformulas + ;; Recursively copy and alter subformulas. (push (ses-relocate-formula cur startrow startcol rowincr colincr) result)))) @@ -1177,47 +1451,47 @@ if the range was altered." field) (cond ((and (not min) (not max)) - (setq range nil)) ;;The entire range is deleted + (setq range nil)) ; The entire range is deleted. ((zerop colincr) - ;;Inserting or deleting rows + ;; Inserting or deleting rows. (setq field 'car) (if (not min) - ;;Chopped off beginning of range + ;; Chopped off beginning of range. (setq min (ses-create-cell-symbol startrow (cdr minrowcol)) ses-relocate-return 'range)) (if (not max) (if (> rowincr 0) - ;;Trying to insert a nonexistent row + ;; Trying to insert a nonexistent row. (setq max (ses-create-cell-symbol (1- ses--numrows) (cdr minrowcol))) - ;;End of range is being deleted + ;; End of range is being deleted. (setq max (ses-create-cell-symbol (1- startrow) (cdr minrowcol)) ses-relocate-return 'range)) (and (> rowincr 0) (= (car maxrowcol) (1- startrow)) (= (cdr minrowcol) (cdr maxrowcol)) - ;;Insert after ending row of vertical range - include it + ;; Insert after ending row of vertical range --- include it. (setq max (ses-create-cell-symbol (+ startrow rowincr -1) (cdr maxrowcol)))))) (t - ;;Inserting or deleting columns + ;; Inserting or deleting columns. (setq field 'cdr) (if (not min) - ;;Chopped off beginning of range + ;; Chopped off beginning of range. (setq min (ses-create-cell-symbol (car minrowcol) startcol) ses-relocate-return 'range)) (if (not max) (if (> colincr 0) - ;;Trying to insert a nonexistent column + ;; Trying to insert a nonexistent column. (setq max (ses-create-cell-symbol (car maxrowcol) (1- ses--numcols))) - ;;End of range is being deleted + ;; End of range is being deleted. (setq max (ses-create-cell-symbol (car maxrowcol) (1- startcol)) ses-relocate-return 'range)) (and (> colincr 0) (= (cdr maxrowcol) (1- startcol)) (= (car minrowcol) (car maxrowcol)) - ;;Insert after ending column of horizontal range - include it + ;; Insert after ending column of horizontal range --- include it. (setq max (ses-create-cell-symbol (car maxrowcol) (+ startcol colincr -1))))))) (when range @@ -1225,9 +1499,9 @@ if the range was altered." (funcall field minrowcol)) (- (funcall field (ses-sym-rowcol max)) (funcall field (ses-sym-rowcol min)))) - ;;This range has changed size + ;; This range has changed size. (setq ses-relocate-return 'range)) - (list 'ses-range min max)))) + `(ses-range ,min ,max ,@(cdddr range))))) (defun ses-relocate-all (minrow mincol rowincr colincr) "Alter all cell values, symbols, formulas, and reference-lists to relocate @@ -1236,7 +1510,7 @@ to each symbol." (let (reform) (let (mycell newval) (dotimes-with-progress-reporter - (row ses--numrows) "Relocating formulas..." + (row ses--numrows) "Relocating formulas..." (dotimes (col ses--numcols) (setq ses-relocate-return nil mycell (ses-get-cell row col) @@ -1244,13 +1518,13 @@ to each symbol." minrow mincol rowincr colincr)) (ses-set-cell row col 'formula newval) (if (eq ses-relocate-return 'range) - ;;This cell contains a (ses-range X Y) where a cell has been - ;;inserted or deleted in the middle of the range. + ;; This cell contains a (ses-range X Y) where a cell has been + ;; inserted or deleted in the middle of the range. (push (cons row col) reform)) (if ses-relocate-return - ;;This cell referred to a cell that's been deleted or is no - ;;longer part of the range. We can't fix that now because - ;;reference lists cells have been partially updated. + ;; This cell referred to a cell that's been deleted or is no + ;; longer part of the range. We can't fix that now because + ;; reference lists cells have been partially updated. (add-to-list 'ses--deferred-recalc (ses-create-cell-symbol row col))) (setq newval (ses-relocate-formula (ses-cell-references mycell) @@ -1259,13 +1533,13 @@ to each symbol." (and (>= row minrow) (>= col mincol) (ses-set-cell row col 'symbol (ses-create-cell-symbol row col)))))) - ;;Relocate the cell values + ;; Relocate the cell values. (let (oldval myrow mycol xrow xcol) (cond ((and (<= rowincr 0) (<= colincr 0)) - ;;Deletion of rows and/or columns + ;; Deletion of rows and/or columns. (dotimes-with-progress-reporter - (row (- ses--numrows minrow)) "Relocating variables..." + (row (- ses--numrows minrow)) "Relocating variables..." (setq myrow (+ row minrow)) (dotimes (col (- ses--numcols mincol)) (setq mycol (+ col mincol) @@ -1273,11 +1547,11 @@ to each symbol." xcol (- mycol colincr)) (if (and (< xrow ses--numrows) (< xcol ses--numcols)) (setq oldval (ses-cell-value xrow xcol)) - ;;Cell is off the end of the array + ;; Cell is off the end of the array. (setq oldval (symbol-value (ses-create-cell-symbol xrow xcol)))) (ses-set-cell myrow mycol 'value oldval)))) ((and (wholenump rowincr) (wholenump colincr)) - ;;Insertion of rows and/or columns. Run the loop backwards. + ;; Insertion of rows and/or columns. Run the loop backwards. (let ((disty (1- ses--numrows)) (distx (1- ses--numcols)) myrow mycol) @@ -1289,16 +1563,16 @@ to each symbol." xrow (- myrow rowincr) xcol (- mycol colincr)) (if (or (< xrow minrow) (< xcol mincol)) - ;;Newly-inserted value + ;; Newly-inserted value. (setq oldval nil) - ;;Transfer old value + ;; Transfer old value. (setq oldval (ses-cell-value xrow xcol))) (ses-set-cell myrow mycol 'value oldval))) - t)) ;Make testcover happy by returning non-nil here + t)) ; Make testcover happy by returning non-nil here. (t (error "ROWINCR and COLINCR must have the same sign")))) - ;;Reconstruct reference lists for cells that contain ses-ranges that - ;;have changed size. + ;; Reconstruct reference lists for cells that contain ses-ranges that have + ;; changed size. (when reform (message "Fixing ses-ranges...") (let (row col) @@ -1324,9 +1598,9 @@ to each symbol." (defun ses-set-with-undo (sym newval) "Like set, but undoable. Result is t if value has changed." - ;;We try to avoid adding redundant entries to the undo list, but this is - ;;unavoidable for strings because equal ignores text properties and there's - ;;no easy way to get the whole property list to see if it's different! + ;; We try to avoid adding redundant entries to the undo list, but this is + ;; unavoidable for strings because equal ignores text properties and there's + ;; no easy way to get the whole property list to see if it's different! (unless (and (boundp sym) (equal (symbol-value sym) newval) (not (stringp newval))) @@ -1339,14 +1613,15 @@ to each symbol." (defun ses-unset-with-undo (sym) "Set SYM to be unbound. This is undoable." - (when (1value (boundp sym)) ;;Always bound, except after a programming error + (when (1value (boundp sym)) ; Always bound, except after a programming error. (push `(apply ses-set-with-undo ,sym ,(symbol-value sym)) buffer-undo-list) (makunbound sym))) (defun ses-aset-with-undo (array idx newval) "Like aset, but undoable. Result is t if element has changed" (unless (equal (aref array idx) newval) - (push `(apply ses-aset-with-undo ,array ,idx ,(aref array idx)) buffer-undo-list) + (push `(apply ses-aset-with-undo ,array ,idx + ,(aref array idx)) buffer-undo-list) (aset array idx newval) t)) @@ -1359,7 +1634,7 @@ to each symbol." "Parse the current buffer and sets up buffer-local variables. Does not execute cell formulas or print functions." (widen) - ;;Read our global parameters, which should be a 3-element list + ;; Read our global parameters, which should be a 3-element list. (goto-char (point-max)) (search-backward ";; Local Variables:\n" nil t) (backward-list 1) @@ -1376,7 +1651,7 @@ execute cell formulas or print functions." ses--numrows (cadr params) ses--numcols (nth 2 params)) (when (= ses--file-format 1) - (let (buffer-undo-list) ;This is not undoable + (let (buffer-undo-list) ; This is not undoable. (ses-goto-data 'ses--header-row) (insert "(ses-header-row 0)\n") (ses-set-parameter 'ses--file-format 2) @@ -1384,11 +1659,11 @@ execute cell formulas or print functions." (or (= ses--file-format 2) (error "This file needs a newer version of the SES library code")) (ses-create-cell-variable-range 0 (1- ses--numrows) 0 (1- ses--numcols)) - ;;Initialize cell array + ;; Initialize cell array. (setq ses--cells (make-vector ses--numrows nil)) (dotimes (row ses--numrows) (aset ses--cells row (make-vector ses--numcols nil)))) - ;;Skip over print area, which we assume is correct + ;; Skip over print area, which we assume is correct. (goto-char (point-min)) (forward-line ses--numrows) (or (looking-at ses-print-data-boundary) @@ -1396,10 +1671,10 @@ execute cell formulas or print functions." (forward-char 1) (setq ses--data-marker (point-marker)) (forward-char (1- (length ses-print-data-boundary))) - ;;Initialize printer and symbol lists + ;; Initialize printer and symbol lists. (mapc 'ses-printer-record ses-standard-printer-functions) (setq ses--symbolic-formulas nil) - ;;Load cell definitions + ;; Load cell definitions. (dotimes (row ses--numrows) (dotimes (col ses--numcols) (let* ((x (read (current-buffer))) @@ -1412,7 +1687,7 @@ execute cell formulas or print functions." (eval x))) (or (looking-at "\n\n") (error "Missing blank line between rows"))) - ;;Load global parameters + ;; Load global parameters. (let ((widths (read (current-buffer))) (n1 (char-after (point))) (printers (read (current-buffer))) @@ -1434,12 +1709,12 @@ execute cell formulas or print functions." (1value (eval def-printer)) (1value (eval printers)) (1value (eval head-row))) - ;;Should be back at global-params + ;; Should be back at global-params. (forward-char 1) (or (looking-at (replace-regexp-in-string "1" "[0-9]+" ses-initial-global-parameters)) (error "Problem with column-defs or global-params")) - ;;Check for overall newline count in definitions area + ;; Check for overall newline count in definitions area. (forward-line 3) (let ((start (point))) (ses-goto-data 'ses--numrows) @@ -1457,23 +1732,23 @@ Narrows the buffer to show only the print area. Gives it `read-only' and (inhibit-point-motion-hooks t) (was-modified (buffer-modified-p)) pos sym) - (ses-goto-data 0 0) ;;Include marker between print-area and data-area - (set-text-properties (point) (point-max) nil) ;Delete garbage props + (ses-goto-data 0 0) ; Include marker between print-area and data-area. + (set-text-properties (point) (point-max) nil) ; Delete garbage props. (mapc 'delete-overlay (overlays-in (point-min) (point-max))) - ;;The print area is read-only (except for our special commands) and uses a - ;;special keymap. + ;; The print area is read-only (except for our special commands) and uses a + ;; special keymap. (put-text-property (point-min) (1- (point)) 'read-only 'ses) (put-text-property (point-min) (1- (point)) 'keymap 'ses-mode-print-map) - ;;For the beginning of the buffer, we want the read-only and keymap - ;;attributes to be inherited from the first character + ;; For the beginning of the buffer, we want the read-only and keymap + ;; attributes to be inherited from the first character. (put-text-property (point-min) (1+ (point-min)) 'front-sticky t) - ;;Create intangible properties, which also indicate which cell the text - ;;came from. + ;; Create intangible properties, which also indicate which cell the text + ;; came from. (dotimes-with-progress-reporter (row ses--numrows) "Finding cells..." (dotimes (col ses--numcols) (setq pos end sym (ses-cell-symbol row col)) - ;;Include skipped cells following this one + ;; Include skipped cells following this one. (while (and (< col (1- ses--numcols)) (eq (ses-cell-value row (1+ col)) '*skip*)) (setq end (+ end (ses-col-width col) 1) @@ -1487,13 +1762,13 @@ Narrows the buffer to show only the print area. Gives it `read-only' and (forward-char) (point)))) (put-text-property pos end 'intangible sym))) - ;;Adding these properties did not actually alter the text + ;; Adding these properties did not actually alter the text. (unless was-modified (restore-buffer-modified-p nil) (buffer-disable-undo) (buffer-enable-undo))) - ;;Create the underlining overlay. It's impossible for (point) to be 2, - ;;because column A must be at least 1 column wide. + ;; Create the underlining overlay. It's impossible for (point) to be 2, + ;; because column A must be at least 1 column wide. (setq ses--curcell-overlay (make-overlay (1+ (point-min)) (1+ (point-min)))) (overlay-put ses--curcell-overlay 'face 'underline)) @@ -1502,15 +1777,15 @@ Narrows the buffer to show only the print area. Gives it `read-only' and Delete overlays, remove special text properties." (widen) (let ((inhibit-read-only t) - ;; When reverting, hide the buffer name, otherwise Emacs will ask - ;; the user "the file is modified, do you really want to make - ;; modifications to this buffer", where the "modifications" refer to - ;; the irrelevant set-text-properties below. - (buffer-file-name nil) + ;; When reverting, hide the buffer name, otherwise Emacs will ask the + ;; user "the file is modified, do you really want to make modifications + ;; to this buffer", where the "modifications" refer to the irrelevant + ;; set-text-properties below. + (buffer-file-name nil) (was-modified (buffer-modified-p))) - ;;Delete read-only, keymap, and intangible properties + ;; Delete read-only, keymap, and intangible properties. (set-text-properties (point-min) (point-max) nil) - ;;Delete overlay + ;; Delete overlay. (mapc 'delete-overlay (overlays-in (point-min) (point-max))) (unless was-modified (restore-buffer-modified-p nil)))) @@ -1530,30 +1805,26 @@ These are active only in the minibuffer, when entering or editing a formula: (unless (and (boundp 'ses--deferred-narrow) (eq ses--deferred-narrow 'ses-mode)) (kill-all-local-variables) - (mapc 'make-local-variable ses-localvars) + (ses-set-localvars) (setq major-mode 'ses-mode mode-name "SES" next-line-add-newlines nil truncate-lines t - ;;SES deliberately puts lots of trailing whitespace in its buffer + ;; SES deliberately puts lots of trailing whitespace in its buffer. show-trailing-whitespace nil - ;;Cell ranges do not work reasonably without this + ;; Cell ranges do not work reasonably without this. transient-mark-mode t - ;;not to use tab characters for safe - ;;(tabs may do bad for column calculation) + ;; Not to use tab characters for safe (tabs may do bad for column + ;; calculation). indent-tabs-mode nil) (1value (add-hook 'change-major-mode-hook 'ses-cleanup nil t)) (1value (add-hook 'before-revert-hook 'ses-cleanup nil t)) - (setq ses--curcell nil - ses--deferred-recalc nil - ses--deferred-write nil - ses--header-hscroll -1 ;Flag for "initial recalc needed" - header-line-format '(:eval (progn + (setq header-line-format '(:eval (progn (when (/= (window-hscroll) ses--header-hscroll) - ;;Reset ses--header-hscroll first, to - ;;avoid recursion problems when - ;;debugging ses-create-header-string + ;; Reset ses--header-hscroll first, + ;; to avoid recursion problems when + ;; debugging ses-create-header-string (setq ses--header-hscroll (window-hscroll)) (ses-create-header-string)) @@ -1562,12 +1833,13 @@ These are active only in the minibuffer, when entering or editing a formula: (was-modified (buffer-modified-p))) (save-excursion (if was-empty - ;;Initialize buffer to contain one cell, for now + ;; Initialize buffer to contain one cell, for now. (insert ses-initial-file-contents)) (ses-load) (ses-setup)) (when was-empty - (unless (equal ses-initial-default-printer (1value ses--default-printer)) + (unless (equal ses-initial-default-printer + (1value ses--default-printer)) (1value (ses-read-default-printer ses-initial-default-printer))) (unless (= ses-initial-column-width (1value (ses-col-width 0))) (1value (ses-set-column-width 0 ses-initial-column-width))) @@ -1582,12 +1854,12 @@ These are active only in the minibuffer, when entering or editing a formula: (buffer-enable-undo) (goto-char (point-min)))) (use-local-map ses-mode-map) - ;;Set the deferred narrowing flag (we can't narrow until after - ;;after-find-file completes). If .ses is on the auto-load alist and the - ;;file has "mode: ses", our ses-mode function will be called twice! Use - ;;a special flag to detect this (will be reset by ses-command-hook). - ;;For find-alternate-file, post-command-hook doesn't get run for some - ;;reason, so use an idle timer to make sure. + ;; Set the deferred narrowing flag (we can't narrow until after + ;; after-find-file completes). If .ses is on the auto-load alist and the + ;; file has "mode: ses", our ses-mode function will be called twice! Use a + ;; special flag to detect this (will be reset by ses-command-hook). For + ;; find-alternate-file, post-command-hook doesn't get run for some reason, + ;; so use an idle timer to make sure. (setq ses--deferred-narrow 'ses-mode) (1value (add-hook 'post-command-hook 'ses-command-hook nil t)) (run-with-idle-timer 0.01 nil 'ses-command-hook) @@ -1601,26 +1873,28 @@ moves the underlining overlay. Performs any recalculations or cell-data writes that have been deferred. If buffer-narrowing has been deferred, narrows the buffer now." (condition-case err - (when (eq major-mode 'ses-mode) ;Otherwise, not our buffer anymore + (when (eq major-mode 'ses-mode) ; Otherwise, not our buffer anymore. (when ses--deferred-recalc - ;;We reset the deferred list before starting on the recalc -- in case - ;;of error, we don't want to retry the recalc after every keystroke! + ;; We reset the deferred list before starting on the recalc --- in + ;; case of error, we don't want to retry the recalc after every + ;; keystroke! + (ses-initialize-Dijkstra-attempt) (let ((old ses--deferred-recalc)) (setq ses--deferred-recalc nil) (ses-update-cells old))) (when ses--deferred-write - ;;We don't reset the deferred list before starting -- the most - ;;likely error is keyboard-quit, and we do want to keep trying - ;;these writes after a quit. + ;; We don't reset the deferred list before starting --- the most + ;; likely error is keyboard-quit, and we do want to keep trying these + ;; writes after a quit. (ses-write-cells) (push '(apply ses-widen) buffer-undo-list)) (when ses--deferred-narrow - ;;We're not allowed to narrow the buffer until after-find-file has - ;;read the local variables at the end of the file. Now it's safe to - ;;do the narrowing. + ;; We're not allowed to narrow the buffer until after-find-file has + ;; read the local variables at the end of the file. Now it's safe to + ;; do the narrowing. (narrow-to-region (point-min) ses--data-marker) (setq ses--deferred-narrow nil)) - ;;Update the modeline + ;; Update the modeline. (let ((oldcell ses--curcell)) (ses-set-curcell) (unless (eq ses--curcell oldcell) @@ -1636,34 +1910,34 @@ narrows the buffer now." "-" (symbol-name (cdr ses--curcell)))))) (force-mode-line-update))) - ;;Use underline overlay for single-cells only, turn off otherwise + ;; Use underline overlay for single-cells only, turn off otherwise. (if (listp ses--curcell) (move-overlay ses--curcell-overlay 2 2) (let ((next (next-single-property-change (point) 'intangible))) (move-overlay ses--curcell-overlay (point) (1- next)))) (when (not (pos-visible-in-window-p)) - ;;Scrolling will happen later + ;; Scrolling will happen later. (run-with-idle-timer 0.01 nil 'ses-command-hook) (setq ses--curcell t))) - ;;Prevent errors in this post-command-hook from silently erasing the hook! + ;; Prevent errors in this post-command-hook from silently erasing the hook! (error (unless executing-kbd-macro (ding)) (message "%s" (error-message-string err)))) - nil) ;Make coverage-tester happy + nil) ; Make coverage-tester happy. (defun ses-create-header-string () "Set up `ses--header-string' as the buffer's header line. Based on the current set of columns and `window-hscroll' position." (let ((totwidth (- (window-hscroll))) result width x) - ;;Leave room for the left-side fringe and scrollbar + ;; Leave room for the left-side fringe and scrollbar. (push (propertize " " 'display '((space :align-to 0))) result) (dotimes (col ses--numcols) (setq width (ses-col-width col) totwidth (+ totwidth width 1)) (if (= totwidth 1) - ;;Scrolled so intercolumn space is leftmost + ;; Scrolled so intercolumn space is leftmost. (push " " result)) (when (> totwidth 1) (if (> ses--header-row 0) @@ -1683,8 +1957,8 @@ Based on the current set of columns and `window-hscroll' position." 'display `((space :align-to ,(1- totwidth))) 'face ses-box-prop) result) - ;;Allow the following space to be squished to make room for the 3-D box - ;;Coverage test ignores properties, thinks this is always a space! + ;; Allow the following space to be squished to make room for the 3-D box + ;; Coverage test ignores properties, thinks this is always a space! (push (1value (propertize " " 'display `((space :align-to ,totwidth)))) result))) (if (> ses--header-row 0) @@ -1727,19 +2001,23 @@ print area if NONARROW is nil." (search-forward ses-print-data-boundary) (backward-char (length ses-print-data-boundary)) (delete-region (point-min) (point)) - ;;Insert all blank lines before printing anything, so ses-print-cell can - ;;find the data area when inserting or deleting *skip* values for cells + ;; Insert all blank lines before printing anything, so ses-print-cell can + ;; find the data area when inserting or deleting *skip* values for cells. (dotimes (row ses--numrows) (insert-and-inherit ses--blank-line)) (dotimes-with-progress-reporter (row ses--numrows) "Reprinting..." (if (eq (ses-cell-value row 0) '*skip*) - ;;Column deletion left a dangling skip + ;; Column deletion left a dangling skip. (ses-set-cell row 0 'value nil)) (dotimes (col ses--numcols) (ses-print-cell row col)) (beginning-of-line 2)) (ses-jump-safe startcell))) +(defun ses-initialize-Dijkstra-attempt () + (setq ses--Dijkstra-attempt-nb (1+ ses--Dijkstra-attempt-nb) + ses--Dijkstra-weight-bound (* ses--numrows ses--numcols))) + (defun ses-recalculate-cell () "Recalculate and reprint the current cell or range. @@ -1750,25 +2028,37 @@ to are recalculated first." (interactive "*") (ses-check-curcell 'range) (ses-begin-change) - (let (sig) + (ses-initialize-Dijkstra-attempt) + (let (sig cur-rowcol) (setq ses-start-time (float-time)) (if (atom ses--curcell) - (setq sig (ses-sym-rowcol ses--curcell) - sig (ses-calculate-cell (car sig) (cdr sig) t)) - ;;First, recalculate all cells that don't refer to other cells and - ;;produce a list of cells with references. + (when + (setq cur-rowcol (ses-sym-rowcol ses--curcell) + sig (progn + (ses-cell-property-set :ses-Dijkstra-attempt + (cons ses--Dijkstra-attempt-nb 0) + (car cur-rowcol) (cdr cur-rowcol) ) + (ses-calculate-cell (car cur-rowcol) (cdr cur-rowcol) t))) + (nconc sig (list (ses-cell-symbol (car cur-rowcol) + (cdr cur-rowcol))))) + ;; First, recalculate all cells that don't refer to other cells and + ;; produce a list of cells with references. (ses-dorange ses--curcell (ses-time-check "Recalculating... %s" '(ses-cell-symbol row col)) (condition-case nil (progn - ;;The t causes an error if the cell has references. - ;;If no references, the t will be the result value. + ;; The t causes an error if the cell has references. If no + ;; references, the t will be the result value. (1value (ses-formula-references (ses-cell-formula row col) t)) - (setq sig (ses-calculate-cell row col t))) + (ses-cell-property-set :ses-Dijkstra-attempt + (cons ses--Dijkstra-attempt-nb 0) + row col) + (when (setq sig (ses-calculate-cell row col t)) + (nconc sig (list (ses-cell-symbol row col))))) (wrong-type-argument - ;;The formula contains a reference + ;; The formula contains a reference. (add-to-list 'ses--deferred-recalc (ses-cell-symbol row col)))))) - ;;Do the update now, so we can force recalculation + ;; Do the update now, so we can force recalculation. (let ((x ses--deferred-recalc)) (setq ses--deferred-recalc nil) (condition-case hold @@ -1801,11 +2091,11 @@ cells." (col (cdr rowcol))) (when (and (< col (1- ses--numcols)) ;;Last column can't spill over, anyway (eq (ses-cell-value row (1+ col)) '*skip*)) - ;;This cell has spill-over. We'll momentarily pretend the following - ;;cell has a `t' in it. + ;; This cell has spill-over. We'll momentarily pretend the following cell + ;; has a `t' in it. (eval `(let ((,(ses-cell-symbol row (1+ col)) t)) (ses-print-cell row col))) - ;;Now remove the *skip*. ses-print-cell is always nil here + ;; Now remove the *skip*. ses-print-cell is always nil here. (ses-set-cell row (1+ col) 'value nil) (1value (ses-print-cell row (1+ col)))))) @@ -1817,12 +2107,12 @@ cells." (let (x yrow ycol) ;;Delete old reference lists (dotimes-with-progress-reporter - (row ses--numrows) "Deleting references..." + (row ses--numrows) "Deleting references..." (dotimes (col ses--numcols) (ses-set-cell row col 'references nil))) ;;Create new reference lists (dotimes-with-progress-reporter - (row ses--numrows) "Computing references..." + (row ses--numrows) "Computing references..." (dotimes (col ses--numcols) (dolist (ref (ses-formula-references (ses-cell-formula row col))) (setq x (ses-sym-rowcol ref) @@ -1831,26 +2121,27 @@ cells." (ses-set-cell yrow ycol 'references (cons (ses-cell-symbol row col) (ses-cell-references yrow ycol))))))) - ;;Delete everything and reconstruct basic data area + ;; Delete everything and reconstruct basic data area. (ses-widen) (let ((inhibit-read-only t)) (goto-char (point-max)) (if (search-backward ";; Local Variables:\n" nil t) (delete-region (point-min) (point)) - ;;Buffer is quite screwed up - can't even save the user-specified locals + ;; Buffer is quite screwed up --- can't even save the user-specified + ;; locals. (delete-region (point-min) (point-max)) (insert ses-initial-file-trailer) (goto-char (point-min))) - ;;Create a blank display area + ;; Create a blank display area. (dotimes (row ses--numrows) (insert ses--blank-line)) (insert ses-print-data-boundary) (backward-char (1- (length ses-print-data-boundary))) (setq ses--data-marker (point-marker)) (forward-char (1- (length ses-print-data-boundary))) - ;;Placeholders for cell data + ;; Placeholders for cell data. (insert (make-string (* ses--numrows (1+ ses--numcols)) ?\n)) - ;;Placeholders for col-widths, col-printers, default-printer, header-row + ;; Placeholders for col-widths, col-printers, default-printer, header-row. (insert "\n\n\n\n") (insert ses-initial-global-parameters) (backward-char (1- (length ses-initial-global-parameters))) @@ -1890,13 +2181,13 @@ cell formula was unsafe and user declined confirmation." (setq initial (format "'%S" (cadr formula))) (setq initial (prin1-to-string formula))) (if (stringp formula) - ;;Position cursor inside close-quote + ;; Position cursor inside close-quote. (setq initial (cons initial (length initial)))) (list row col (read-from-minibuffer (format "Cell %s: " ses--curcell) initial ses-mode-edit-map - t ;Convert to Lisp object + t ; Convert to Lisp object. 'ses-read-cell-history))))) (when (ses-warn-unsafe newval 'unsafep) (ses-begin-change) @@ -1917,13 +2208,13 @@ cell formula was unsafe and user declined confirmation." (cons (if (equal initial "\"") "\"\"" (if (equal initial "(") "()" initial)) 2) ses-mode-edit-map - t ;Convert to Lisp object + t ; Convert to Lisp object. 'ses-read-cell-history (prin1-to-string (if (eq (car-safe curval) 'ses-safe-formula) (cadr curval) curval)))))) (when (ses-edit-cell row col newval) - (ses-command-hook) ;Update cell widths before movement + (ses-command-hook) ; Update cell widths before movement. (dolist (x ses-after-entry-functions) (funcall x 1)))) @@ -1939,10 +2230,10 @@ have been used as formulas in this spreadsheet is available for completions." (list (car rowcol) (cdr rowcol) (if (string= newval "") - nil ;Don't create zero-length symbols! + nil ; Don't create zero-length symbols! (list 'quote (intern newval)))))) (when (ses-edit-cell row col symb) - (ses-command-hook) ;Update cell widths before movement + (ses-command-hook) ; Update cell widths before movement. (dolist (x ses-after-entry-functions) (funcall x 1)))) @@ -1970,7 +2261,7 @@ cells." (ses-check-curcell 'end) (ses-begin-change) (dotimes (x count) - (backward-char 1) ;Will signal 'beginning-of-buffer if appropriate + (backward-char 1) ; Will signal 'beginning-of-buffer if appropriate. (ses-set-curcell) (let ((rowcol (ses-sym-rowcol ses--curcell))) (ses-clear-cell (car rowcol) (cdr rowcol)))))) @@ -1990,13 +2281,13 @@ PROMPT should end with \": \". Result is t if operation was cancelled." (substring prompt 0 -2) default))) (let ((new (read-from-minibuffer prompt - nil ;Initial contents + nil ; Initial contents. ses-mode-edit-map - t ;Evaluate the result + t ; Evaluate the result. 'ses-read-printer-history (prin1-to-string default)))) (if (equal new default) - ;;User changed mind, decided not to change printer + ;; User changed mind, decided not to change printer. (setq new t) (ses-printer-validate new) (or (not new) @@ -2197,7 +2488,7 @@ If COL is specified, the new column(s) get the specified WIDTH and PRINTER ;;ses-relocate-all) (ses-goto-data row col) (insert ?\n)) - ;;Insert column width and printer + ;; Insert column width and printer. (setq widths (ses-vector-insert widths col width) printers (ses-vector-insert printers col printer))) (ses-set-parameter 'ses--col-widths widths) @@ -2208,11 +2499,11 @@ If COL is specified, the new column(s) get the specified WIDTH and PRINTER (ses-reprint-all t) (when (or (> (length (ses-call-printer printer)) 0) (> (length (ses-call-printer ses--default-printer)) 0)) - ;;Either column printer or global printer inserts some constant text - ;;Reprint the new columns to insert that text. + ;; Either column printer or global printer inserts some constant text. + ;; Reprint the new columns to insert that text. (dotimes (x ses--numrows) (dotimes (y count) - ;Always nil here - this is a blank column + ;; Always nil here --- this is a blank column. (1value (ses-print-cell-new-width x (+ y col)))))) (ses-setup))) (ses-jump-safe ses--curcell)) @@ -2272,19 +2563,19 @@ from the current one." inserts a new row if at bottom of print area. Repeat COUNT times." (interactive "p") (ses-check-curcell 'end) - (setq deactivate-mark t) ;Doesn't combine well with ranges + (setq deactivate-mark t) ; Doesn't combine well with ranges. (dotimes (x count) (ses-set-curcell) (if (not ses--curcell) - (progn ;At bottom of print area + (progn ; At bottom of print area. (barf-if-buffer-read-only) (ses-insert-row 1)) (let ((col (cdr (ses-sym-rowcol ses--curcell)))) (when (/= 32 (char-before (next-single-property-change (point) 'intangible))) - ;;We're already in last nonskipped cell on line. Need to create a - ;;new column. + ;; We're already in last nonskipped cell on line. Need to create a + ;; new column. (barf-if-buffer-read-only) (ses-insert-column (- count x) ses--numcols @@ -2312,12 +2603,12 @@ inserts a new row if at bottom of print area. Repeat COUNT times." (read-from-minibuffer (format "Column %s width [currently %d]: " (ses-column-letter col) (ses-col-width col)) - nil ;No initial contents - nil ;No override keymap - t ;Convert to Lisp object - nil ;No history + nil ; No initial contents. + nil ; No override keymap. + t ; Convert to Lisp object. + nil ; No history. (number-to-string - (ses-col-width col))))))) ;Default value + (ses-col-width col))))))) ; Default value. (if (< newwidth 1) (error "Invalid column width")) (ses-begin-change) @@ -2349,7 +2640,7 @@ hard to override how mouse-1 works." (if (not (and (eq major-mode 'ses-mode) (eq (get-text-property beg 'read-only) 'ses) (eq (get-text-property (1- end) 'read-only) 'ses))) - ad-do-it ;Normal copy-region-as-kill + ad-do-it ; Normal copy-region-as-kill. (kill-new (ses-copy-region beg end)) (if transient-mark-mode (setq deactivate-mark t)) @@ -2400,17 +2691,17 @@ the corresponding data cell." cells instead of deleting them." (interactive "r") (ses-check-curcell 'needrange) - ;;For some reason, the text-read-only error is not caught by - ;;`delete-region', so we have to use subterfuge. + ;; For some reason, the text-read-only error is not caught by `delete-region', + ;; so we have to use subterfuge. (let ((buffer-read-only t)) (1value (condition-case x (noreturn (funcall (lookup-key (current-global-map) (this-command-keys)) beg end)) - (buffer-read-only nil)))) ;The expected error - ;;Because the buffer was marked read-only, the kill command turned itself - ;;into a copy. Now we clear the cells or signal the error. First we - ;;check whether the buffer really is read-only. + (buffer-read-only nil)))) ; The expected error. + ;; Because the buffer was marked read-only, the kill command turned itself + ;; into a copy. Now we clear the cells or signal the error. First we check + ;; whether the buffer really is read-only. (barf-if-buffer-read-only) (ses-begin-change) (ses-dorange ses--curcell @@ -2437,7 +2728,7 @@ explicitly insert a symbol, or use the C-u prefix to treat all unmarked words as symbols." (if (not (and (eq major-mode 'ses-mode) (eq (get-text-property (point) 'keymap) 'ses-mode-print-map))) - ad-do-it ;Normal non-SES yank + ad-do-it ; Normal non-SES yank. (ses-check-curcell 'end) (push-mark (point)) (let ((text (current-kill (cond @@ -2450,7 +2741,7 @@ as symbols." text 0 (if (memq (aref text (1- (length text))) '(?\t ?\n)) - ;;Just one cell - delete final tab or newline + ;; Just one cell --- delete final tab or newline. (1- (length text))) arg))) (if (consp arg) @@ -2499,21 +2790,21 @@ formulas are to be inserted without relocation." pos (next-single-property-change pos 'ses text) x (ses-sym-rowcol (car last))) (if (not last) - ;;Newline - all remaining cells on row are skipped + ;; Newline --- all remaining cells on row are skipped. (setq x (cons (- myrow rowincr) (+ needcols colincr -1)) last (list nil nil nil) pos (1- pos))) (if (/= (car x) (- myrow rowincr)) (error "Cell row error")) (if (< (- mycol colincr) (cdr x)) - ;;Some columns were skipped + ;; Some columns were skipped. (let ((oldcol mycol)) (while (< (- mycol colincr) (cdr x)) (ses-clear-cell myrow mycol) (setq col (1+ col) mycol (1+ mycol))) - (ses-print-cell myrow (1- oldcol)))) ;;This inserts *skip* - (when (car last) ;Skip this for *skip* cells + (ses-print-cell myrow (1- oldcol)))) ;; This inserts *skip*. + (when (car last) ; Skip this for *skip* cells. (setq x (nth 2 last)) (unless (equal x (ses-cell-printer myrow mycol)) (or (not x) @@ -2542,12 +2833,12 @@ cons of ROW and COL). Treat plain symbols as strings unless ARG is a list." (error (cons nil from))))) (cond ((< (cdr val) (or to (length text))) - ;;Invalid sexp - leave it as a string + ;; Invalid sexp --- leave it as a string. (setq val (substring text from to))) ((and (car val) (symbolp (car val))) (if (consp arg) - (setq val (list 'quote (car val))) ;Keep symbol - (setq val (substring text from to)))) ;Treat symbol as text + (setq val (list 'quote (car val))) ; Keep symbol. + (setq val (substring text from to)))) ; Treat symbol as text. (t (setq val (car val)))) (let ((row (car rowcol)) @@ -2729,27 +3020,28 @@ The top row is row 1. Selecting row 0 displays the default header row." "Move point to last cell on line." (interactive) (ses-check-curcell 'end 'range) - (when ses--curcell ;Otherwise we're at the bottom row, which is empty anyway + (when ses--curcell ; Otherwise we're at the bottom row, which is empty + ; anyway. (let ((col (1- ses--numcols)) row rowcol) (if (symbolp ses--curcell) - ;;Single cell + ;; Single cell. (setq row (car (ses-sym-rowcol ses--curcell))) - ;;Range - use whichever end of the range the point is at + ;; Range --- use whichever end of the range the point is at. (setq rowcol (ses-sym-rowcol (if (< (point) (mark)) (car ses--curcell) (cdr ses--curcell)))) - ;;If range already includes the last cell in a row, point is actually - ;;in the following row + ;; If range already includes the last cell in a row, point is actually + ;; in the following row. (if (<= (cdr rowcol) (1- col)) (setq row (car rowcol)) (setq row (1+ (car rowcol))) (if (= row ses--numrows) ;;Already at end - can't go anywhere (setq col 0)))) - (when (< row ses--numrows) ;Otherwise it's a range that includes last cell + (when (< row ses--numrows) ; Otherwise it's a range that includes last cell. (while (eq (ses-cell-value row col) '*skip*) - ;;Back to beginning of multi-column cell + ;; Back to beginning of multi-column cell. (setq col (1- col))) (ses-goto-print row col))))) @@ -2801,7 +3093,7 @@ REVERSE order." (interactive "*e\nP") (setq event (event-end event)) (select-window (posn-window event)) - (setq event (car (posn-col-row event))) ;Click column + (setq event (car (posn-col-row event))) ; Click column. (let ((col 0)) (while (and (< col ses--numcols) (> event (ses-col-width col))) (setq event (- event (ses-col-width col) 1) @@ -2816,7 +3108,7 @@ spreadsheet." (interactive "*") (let (x) (with-current-buffer (window-buffer minibuffer-scroll-window) - (ses-command-hook) ;For ses-coverage + (ses-command-hook) ; For ses-coverage. (ses-check-curcell 'needrange) (setq x (cdr (macroexpand `(ses-range ,(car ses--curcell) ,(cdr ses--curcell)))))) @@ -2828,7 +3120,7 @@ highlighted range in the spreadsheet." (interactive "*") (let (x) (with-current-buffer (window-buffer minibuffer-scroll-window) - (ses-command-hook) ;For ses-coverage + (ses-command-hook) ; For ses-coverage. (ses-check-curcell 'needrange) (setq x (format "(ses-range %S %S)" (car ses--curcell) @@ -2885,15 +3177,128 @@ is safe or user allows execution anyway. Always returns t if ;; Standard formulas ;;---------------------------------------------------------------------------- -(defmacro ses-range (from to) - "Expands to a list of cell-symbols for the range. The range automatically -expands to include any new row or column inserted into its middle. The SES -library code specifically looks for the symbol `ses-range', so don't create an -alias for this macro!" - (let (result) +(defun ses--clean-! (&rest x) + "Clean by delq list X from any occurrence of `nil' or `*skip*'." + (delq nil (delq '*skip* x))) + +(defun ses--clean-_ (x y) + "Clean list X by replacing by Y any occurrence of `nil' or `*skip*'. + +This will change X by making setcar on its cons cells." + (let ((ret x) ret-elt) + (while ret + (setq ret-elt (car ret)) + (when (memq ret-elt '(nil *skip*)) + (setcar ret y)) + (setq ret (cdr ret)))) + x) + +(defmacro ses-range (from to &rest rest) + "Expands to a list of cell-symbols for the range going from +FROM up to TO. The range automatically expands to include any +new row or column inserted into its middle. The SES library code +specifically looks for the symbol `ses-range', so don't create an +alias for this macro! + +By passing in REST some flags one can configure the way the range +is read and how it is formatted. + +In the sequel we assume that cells A1, B1, A2 B2 have respective values +1 2 3 and 4 for examplication. + +Readout direction is specified by a `>v', '`>^', `<v', `<^', +`v>', `v<', `^>', `^<' flag. For historical reasons, in absence +of such a flag, a default direction of `^<' is assumed. This +way `(ses-range A1 B2 ^>)' will evaluate to `(1 3 2 4)', +while `(ses-range A1 B2 >^)' will evaluate to (3 4 1 2). + +If the range is one row, then `>' can be used as a shorthand to +`>v' or `>^', and `<' to `<v' or `<^'. + +If the range is one column, then `v' can be used as a shorthand to +`v>' or `v<', and `^' to `^>' or `v<'. + +A `!' flag will remove all cells whose value is nil or `*skip*'. + +A `_' flag will replace nil or `*skip*' by the value following +the `_' flag. If the `_' flag is the last argument, then they are +replaced by integer 0. + +A `*', `*1' or `*2' flag will vectorize the range in the sense of +Calc. See info node `(Calc) Top'. Flag `*' will output either a +vector or a matrix depending on the number of rows, `*1' will +flatten the result to a one row vector, and `*2' will make a +matrix whatever the number of rows. + +Warning: interaction with Calc is expermimental and may produce +confusing results if you are not aware of Calc data format. Use +`math-format-value' as a printer for Calc objects." + (let (result-row + result + (prev-row -1) + (reorient-x nil) + (reorient-y nil) + transpose vectorize + (clean 'list)) (ses-dorange (cons from to) - (push (ses-cell-symbol row col) result)) - (cons 'list result))) + (when (/= prev-row row) + (push result-row result) + (setq result-row nil)) + (push (ses-cell-symbol row col) result-row) + (setq prev-row row)) + (push result-row result) + (while rest + (let ((x (pop rest))) + (case x + ((>v) (setq transpose nil reorient-x nil reorient-y nil)) + ((>^)(setq transpose nil reorient-x nil reorient-y t)) + ((<^)(setq transpose nil reorient-x t reorient-y t)) + ((<v)(setq transpose nil reorient-x t reorient-y nil)) + ((v>)(setq transpose t reorient-x nil reorient-y t)) + ((^>)(setq transpose t reorient-x nil reorient-y nil)) + ((^<)(setq transpose t reorient-x t reorient-y nil)) + ((v<)(setq transpose t reorient-x t reorient-y t)) + ((* *2 *1) (setq vectorize x)) + ((!) (setq clean 'ses--clean-!)) + ((_) (setq clean `(lambda (&rest x) (ses--clean-_ x ,(if rest (pop rest) 0))))) + (t + (cond + ; shorthands one row + ((and (null (cddr result)) (memq x '(> <))) + (push (intern (concat (symbol-name x) "v")) rest)) + ; shorthands one col + ((and (null (cdar result)) (memq x '(v ^))) + (push (intern (concat (symbol-name x) ">")) rest)) + (t (error "Unexpected flag `%S' in ses-range" x))))))) + (if reorient-y + (setcdr (last result 2) nil) + (setq result (cdr (nreverse result)))) + (unless reorient-x + (setq result (mapcar 'nreverse result))) + (when transpose + (let ((ret (mapcar (lambda (x) (list x)) (pop result))) iter) + (while result + (setq iter ret) + (dolist (elt (pop result)) + (setcar iter (cons elt (car iter))) + (setq iter (cdr iter)))) + (setq result ret))) + + (flet ((vectorize-*1 + (clean result) + (cons clean (cons (quote 'vec) (apply 'append result)))) + (vectorize-*2 + (clean result) + (cons clean (cons (quote 'vec) (mapcar (lambda (x) + (cons clean (cons (quote 'vec) x))) + result))))) + (case vectorize + ((nil) (cons clean (apply 'append result))) + ((*1) (vectorize-*1 clean result)) + ((*2) (vectorize-*2 clean result)) + ((*) (if (cdr result) + (vectorize-*2 clean result) + (vectorize-*1 clean result))))))) (defun ses-delete-blanks (&rest args) "Return ARGS reversed, with the blank elements (nil and *skip*) removed." @@ -2940,13 +3345,11 @@ TEST is evaluated." ;; Standard print functions ;;---------------------------------------------------------------------------- -;;These functions use the variables 'row' and 'col' that are -;;dynamically bound by ses-print-cell. We define these variables at -;;compile-time to make the compiler happy. -(eval-when-compile - (dolist (x '(row col)) - (make-local-variable x) - (set x nil))) +;; These functions use the variables 'row' and 'col' that are dynamically bound +;; by ses-print-cell. We define these variables at compile-time to make the +;; compiler happy. +(defvar row) +(defvar col) (defun ses-center (value &optional span fill) "Print VALUE, centered within column. FILL is the fill character for @@ -2960,10 +3363,10 @@ columns to include in width (default = 0)." (setq value (ses-call-printer printer value)) (dotimes (x span) (setq width (+ width 1 (ses-col-width (+ col span (- x)))))) - ;; set column width + ;; Set column width. (setq width (- width (string-width value))) (if (<= width 0) - value ;Too large for field, anyway + value ; Too large for field, anyway. (setq half (make-string (/ width 2) fill)) (concat half value half (if (> (% width 2) 0) (char-to-string fill)))))) @@ -3006,11 +3409,6 @@ current column and continues until the next nonblank column." (dolist (fun '(copy-region-as-kill yank)) (ad-remove-advice fun 'around (intern (concat "ses-" (symbol-name fun)))) (ad-update fun)) - (save-current-buffer - (dolist (buf (buffer-list)) - (set-buffer buf) - (when (eq major-mode 'ses-mode) - (funcall (or (default-value 'major-mode) 'fundamental-mode))))) ;; continue standard unloading nil) diff --git a/lisp/simple.el b/lisp/simple.el index b36cf2ec3ec..2c792a2c78e 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2531,7 +2531,11 @@ specifies the value of ERROR-BUFFER." (let ((output (if (and error-file (< 0 (nth 7 (file-attributes error-file)))) - "some error output" + (format "some error output%s" + (if shell-command-default-error-buffer + (format " to the \"%s\" buffer" + shell-command-default-error-buffer) + "")) "no output"))) (cond ((null exit-status) (message "(Shell command failed with error)")) diff --git a/lisp/subr.el b/lisp/subr.el index 4d2f3b1808c..48158466c6b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -490,6 +490,7 @@ SEQ must be a list, vector, or string. The comparison is done with `equal'." "Return LIST with all occurrences of ELT removed. The comparison is done with `eq'. Contrary to `delq', this does not use side-effects, and the argument LIST is not modified." + (while (eq elt (car list)) (setq list (cdr list))) (if (memq elt list) (delq elt (copy-sequence list)) list)) @@ -591,31 +592,88 @@ Don't call this function; it is for internal use only." (dolist (p list) (funcall function (car p) (cdr p))))) +(defun keymap--menu-item-binding (val) + "Return the binding part of a menu-item." + (cond + ((not (consp val)) val) ;Not a menu-item. + ((eq 'menu-item (car val)) + (let* ((binding (nth 2 val)) + (plist (nthcdr 3 val)) + (filter (plist-get plist :filter))) + (if filter (funcall filter binding) + binding))) + ((and (consp (cdr val)) (stringp (cadr val))) + (cddr val)) + ((stringp (car val)) + (cdr val)) + (t val))) ;Not a menu-item either. + +(defun keymap--menu-item-with-binding (item binding) + "Build a menu-item like ITEM but with its binding changed to BINDING." + (cond + ((eq 'menu-item (car item)) + (setq item (copy-sequence item)) + (let ((tail (nthcdr 2 item))) + (setcar tail binding) + ;; Remove any potential filter. + (if (plist-get (cdr tail) :filter) + (setcdr tail (plist-put (cdr tail) :filter nil)))) + item) + ((and (consp (cdr item)) (stringp (cadr item))) + (cons (car item) (cons (cadr item) binding))) + (t (cons (car item) binding)))) + +(defun keymap--merge-bindings (val1 val2) + "Merge bindings VAL1 and VAL2." + (let ((map1 (keymap--menu-item-binding val1)) + (map2 (keymap--menu-item-binding val2))) + (if (not (and (keymapp map1) (keymapp map2))) + ;; There's nothing to merge: val1 takes precedence. + val1 + (let ((map (list 'keymap map1 map2)) + (item (if (keymapp val1) (if (keymapp val2) nil val2) val1))) + (keymap--menu-item-with-binding item map))))) + (defun keymap-canonicalize (map) - "Return an equivalent keymap, without inheritance." + "Return a simpler equivalent keymap. +This resolves inheritance and redefinitions. The returned keymap +should behave identically to a copy of KEYMAP w.r.t `lookup-key' +and use in active keymaps and menus. +Subkeymaps may be modified but are not canonicalized." + ;; FIXME: Problem with the difference between a nil binding + ;; that hides a binding in an inherited map and a nil binding that's ignored + ;; to let some further binding visible. Currently a nil binding hides all. + ;; FIXME: we may want to carefully (re)order elements in case they're + ;; menu-entries. (let ((bindings ()) (ranges ()) (prompt (keymap-prompt map))) (while (keymapp map) - (setq map (map-keymap-internal + (setq map (map-keymap ;; -internal (lambda (key item) (if (consp key) ;; Treat char-ranges specially. (push (cons key item) ranges) (push (cons key item) bindings))) map))) + ;; Create the new map. (setq map (funcall (if ranges 'make-keymap 'make-sparse-keymap) prompt)) (dolist (binding ranges) - ;; Treat char-ranges specially. + ;; Treat char-ranges specially. FIXME: need to merge as well. (define-key map (vector (car binding)) (cdr binding))) + ;; Process the bindings starting from the end. (dolist (binding (prog1 bindings (setq bindings ()))) (let* ((key (car binding)) (item (cdr binding)) (oldbind (assq key bindings))) - ;; Newer bindings override older. - (if oldbind (setq bindings (delq oldbind bindings))) - (when item ;nil bindings just hide older ones. - (push binding bindings)))) + (push (if (not oldbind) + ;; The normal case: no duplicate bindings. + binding + ;; This is the second binding for this key. + (setq bindings (delq oldbind bindings)) + (cons key (keymap--merge-bindings (cdr binding) + (cdr oldbind)))) + bindings))) (nconc map bindings))) (put 'keyboard-translate-table 'char-table-extra-slots 0) diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 39855a1c8cc..62171328979 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -474,7 +474,8 @@ MODE should be an integer which is a file mode value." (if (and dir (not (file-exists-p dir))) (make-directory dir t)) (unless (file-directory-p name) - (write-region start end name)) + (let ((coding-system-for-write 'no-conversion)) + (write-region start end name))) (set-file-modes name (tar-header-mode descriptor)))))))) (defun tar-summarize-buffer () diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index fbf3e91d3d9..447d7fd2533 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -892,6 +892,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (declare-function ns-list-services "nsfns.m" ()) (declare-function x-open-connection "nsfns.m" (display &optional xrm-string must-succeed)) +(declare-function ns-set-resource "nsfns.m" (owner name value)) ;; Do the actual Nextstep Windows setup here; the above code just ;; defines functions and variables that we use now. @@ -916,7 +917,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") ;; 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. + ;; 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") diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 107a0728bae..930d3200234 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -90,8 +90,8 @@ If this is a function, call it to generate the initial field text." (defcustom bibtex-user-optional-fields '(("annote" "Personal annotation (ignored)")) "List of optional fields the user wants to have always present. -Entries should be of the same form as the OPTIONAL and -CROSSREF-OPTIONAL lists in `bibtex-entry-field-alist' (which see)." +Entries should be of the same form as the OPTIONAL list +in `bibtex-BibTeX-entry-alist' (which see)." :group 'bibtex :type '(repeat (group (string :tag "Field") (string :tag "Comment") @@ -127,7 +127,7 @@ braces Enclose parts of field entries by braces according to strings Replace parts of field entries by string constants according to `bibtex-field-strings-alist'. sort-fields Sort fields to match the field order in - `bibtex-entry-field-alist'. + `bibtex-BibTeX-entry-alist'. The value t means do all of the above formatting actions. The value nil means do no formatting at all." @@ -264,265 +264,584 @@ If parsing fails, try to set this variable to nil." :group 'bibtex :type 'boolean) -(defcustom bibtex-entry-field-alist - '(("Article" - ((("author" "Author1 [and Author2 ...] [and others]") - ("title" "Title of the article (BibTeX converts it to lowercase)") - ("journal" "Name of the journal (use string, remove braces)") - ("year" "Year of publication")) - (("volume" "Volume of the journal") - ("number" "Number of the journal (only allowed if entry contains volume)") - ("pages" "Pages in the journal") - ("month" "Month of the publication as a string (remove braces)") - ("note" "Remarks to be put at the end of the \\bibitem"))) - ((("author" "Author1 [and Author2 ...] [and others]") - ("title" "Title of the article (BibTeX converts it to lowercase)")) - (("pages" "Pages in the journal") - ("journal" "Name of the journal (use string, remove braces)") - ("year" "Year of publication") - ("volume" "Volume of the journal") - ("number" "Number of the journal") - ("month" "Month of the publication as a string (remove braces)") - ("note" "Remarks to be put at the end of the \\bibitem")))) - ("Book" - ((("author" "Author1 [and Author2 ...] [and others]" nil t) - ("editor" "Editor1 [and Editor2 ...] [and others]" nil t) - ("title" "Title of the book") - ("publisher" "Publishing company") - ("year" "Year of publication")) - (("volume" "Volume of the book in the series") - ("number" "Number of the book in a small series (overwritten by volume)") - ("series" "Series in which the book appeared") - ("address" "Address of the publisher") - ("edition" "Edition of the book as a capitalized English word") - ("month" "Month of the publication as a string (remove braces)") - ("note" "Remarks to be put at the end of the \\bibitem"))) - ((("author" "Author1 [and Author2 ...] [and others]" nil t) - ("editor" "Editor1 [and Editor2 ...] [and others]" nil t) - ("title" "Title of the book")) - (("publisher" "Publishing company") - ("year" "Year of publication") - ("volume" "Volume of the book in the series") - ("number" "Number of the book in a small series (overwritten by volume)") - ("series" "Series in which the book appeared") - ("address" "Address of the publisher") - ("edition" "Edition of the book as a capitalized English word") - ("month" "Month of the publication as a string (remove braces)") - ("note" "Remarks to be put at the end of the \\bibitem")))) - ("Booklet" - ((("title" "Title of the booklet (BibTeX converts it to lowercase)")) - (("author" "Author1 [and Author2 ...] [and others]") - ("howpublished" "The way in which the booklet was published") - ("address" "Address of the publisher") - ("month" "Month of the publication as a string (remove braces)") - ("year" "Year of publication") - ("note" "Remarks to be put at the end of the \\bibitem")))) - ("InBook" - ((("author" "Author1 [and Author2 ...] [and others]" nil t) - ("editor" "Editor1 [and Editor2 ...] [and others]" nil t) - ("title" "Title of the book") - ("chapter" "Chapter in the book") - ("publisher" "Publishing company") - ("year" "Year of publication")) - (("volume" "Volume of the book in the series") - ("number" "Number of the book in a small series (overwritten by volume)") - ("series" "Series in which the book appeared") - ("type" "Word to use instead of \"chapter\"") - ("address" "Address of the publisher") - ("edition" "Edition of the book as a capitalized English word") - ("month" "Month of the publication as a string (remove braces)") - ("pages" "Pages in the book") - ("note" "Remarks to be put at the end of the \\bibitem"))) - ((("author" "Author1 [and Author2 ...] [and others]" nil t) - ("editor" "Editor1 [and Editor2 ...] [and others]" nil t) - ("title" "Title of the book") - ("chapter" "Chapter in the book")) - (("pages" "Pages in the book") - ("publisher" "Publishing company") - ("year" "Year of publication") - ("volume" "Volume of the book in the series") - ("number" "Number of the book in a small series (overwritten by volume)") - ("series" "Series in which the book appeared") - ("type" "Word to use instead of \"chapter\"") - ("address" "Address of the publisher") - ("edition" "Edition of the book as a capitalized English word") - ("month" "Month of the publication as a string (remove braces)") - ("note" "Remarks to be put at the end of the \\bibitem")))) - ("InCollection" - ((("author" "Author1 [and Author2 ...] [and others]") - ("title" "Title of the article in book (BibTeX converts it to lowercase)") - ("booktitle" "Name of the book") - ("publisher" "Publishing company") - ("year" "Year of publication")) - (("editor" "Editor1 [and Editor2 ...] [and others]") - ("volume" "Volume of the book in the series") - ("number" "Number of the book in a small series (overwritten by volume)") - ("series" "Series in which the book appeared") - ("type" "Word to use instead of \"chapter\"") - ("chapter" "Chapter in the book") - ("pages" "Pages in the book") - ("address" "Address of the publisher") - ("edition" "Edition of the book as a capitalized English word") - ("month" "Month of the publication as a string (remove braces)") - ("note" "Remarks to be put at the end of the \\bibitem"))) - ((("author" "Author1 [and Author2 ...] [and others]") - ("title" "Title of the article in book (BibTeX converts it to lowercase)") - ("booktitle" "Name of the book")) - (("pages" "Pages in the book") - ("publisher" "Publishing company") - ("year" "Year of publication") - ("editor" "Editor1 [and Editor2 ...] [and others]") - ("volume" "Volume of the book in the series") - ("number" "Number of the book in a small series (overwritten by volume)") - ("series" "Series in which the book appeared") - ("type" "Word to use instead of \"chapter\"") - ("chapter" "Chapter in the book") - ("address" "Address of the publisher") - ("edition" "Edition of the book as a capitalized English word") - ("month" "Month of the publication as a string (remove braces)") - ("note" "Remarks to be put at the end of the \\bibitem")))) - ("InProceedings" - ((("author" "Author1 [and Author2 ...] [and others]") - ("title" "Title of the article in proceedings (BibTeX converts it to lowercase)") - ("booktitle" "Name of the conference proceedings") - ("year" "Year of publication")) - (("editor" "Editor1 [and Editor2 ...] [and others]") - ("volume" "Volume of the conference proceedings in the series") - ("number" "Number of the conference proceedings in a small series (overwritten by volume)") - ("series" "Series in which the conference proceedings appeared") - ("pages" "Pages in the conference proceedings") - ("address" "Location of the Proceedings") - ("month" "Month of the publication as a string (remove braces)") - ("organization" "Sponsoring organization of the conference") - ("publisher" "Publishing company, its location") - ("note" "Remarks to be put at the end of the \\bibitem"))) - ((("author" "Author1 [and Author2 ...] [and others]") - ("title" "Title of the article in proceedings (BibTeX converts it to lowercase)")) - (("booktitle" "Name of the conference proceedings") - ("pages" "Pages in the conference proceedings") - ("year" "Year of publication") - ("editor" "Editor1 [and Editor2 ...] [and others]") - ("volume" "Volume of the conference proceedings in the series") - ("number" "Number of the conference proceedings in a small series (overwritten by volume)") - ("series" "Series in which the conference proceedings appeared") - ("address" "Location of the Proceedings") - ("month" "Month of the publication as a string (remove braces)") - ("organization" "Sponsoring organization of the conference") - ("publisher" "Publishing company, its location") - ("note" "Remarks to be put at the end of the \\bibitem")))) - ("Manual" - ((("title" "Title of the manual")) - (("author" "Author1 [and Author2 ...] [and others]") - ("organization" "Publishing organization of the manual") - ("address" "Address of the organization") - ("edition" "Edition of the manual as a capitalized English word") - ("month" "Month of the publication as a string (remove braces)") - ("year" "Year of publication") - ("note" "Remarks to be put at the end of the \\bibitem")))) - ("MastersThesis" - ((("author" "Author1 [and Author2 ...] [and others]") - ("title" "Title of the master\'s thesis (BibTeX converts it to lowercase)") - ("school" "School where the master\'s thesis was written") - ("year" "Year of publication")) - (("type" "Type of the master\'s thesis (if other than \"Master\'s thesis\")") - ("address" "Address of the school (if not part of field \"school\") or country") - ("month" "Month of the publication as a string (remove braces)") - ("note" "Remarks to be put at the end of the \\bibitem")))) - ("Misc" - (() - (("author" "Author1 [and Author2 ...] [and others]") - ("title" "Title of the work (BibTeX converts it to lowercase)") - ("howpublished" "The way in which the work was published") - ("month" "Month of the publication as a string (remove braces)") - ("year" "Year of publication") - ("note" "Remarks to be put at the end of the \\bibitem")))) - ("PhdThesis" - ((("author" "Author1 [and Author2 ...] [and others]") - ("title" "Title of the PhD. thesis") - ("school" "School where the PhD. thesis was written") - ("year" "Year of publication")) - (("type" "Type of the PhD. thesis") - ("address" "Address of the school (if not part of field \"school\") or country") - ("month" "Month of the publication as a string (remove braces)") - ("note" "Remarks to be put at the end of the \\bibitem")))) - ("Proceedings" - ((("title" "Title of the conference proceedings") - ("year" "Year of publication")) - (("booktitle" "Title of the proceedings for cross references") - ("editor" "Editor1 [and Editor2 ...] [and others]") - ("volume" "Volume of the conference proceedings in the series") - ("number" "Number of the conference proceedings in a small series (overwritten by volume)") - ("series" "Series in which the conference proceedings appeared") - ("address" "Location of the Proceedings") - ("month" "Month of the publication as a string (remove braces)") - ("organization" "Sponsoring organization of the conference") - ("publisher" "Publishing company, its location") - ("note" "Remarks to be put at the end of the \\bibitem")))) - ("TechReport" - ((("author" "Author1 [and Author2 ...] [and others]") - ("title" "Title of the technical report (BibTeX converts it to lowercase)") - ("institution" "Sponsoring institution of the report") - ("year" "Year of publication")) - (("type" "Type of the report (if other than \"technical report\")") - ("number" "Number of the technical report") - ("address" "Address of the institution (if not part of field \"institution\") or country") - ("month" "Month of the publication as a string (remove braces)") - ("note" "Remarks to be put at the end of the \\bibitem")))) - ("Unpublished" - ((("author" "Author1 [and Author2 ...] [and others]") - ("title" "Title of the unpublished work (BibTeX converts it to lowercase)") - ("note" "Remarks to be put at the end of the \\bibitem")) - (("month" "Month of the publication as a string (remove braces)") - ("year" "Year of publication"))))) - - "List of BibTeX entry types and their associated fields. -List elements are triples -\(ENTRY-TYPE (REQUIRED OPTIONAL) (CROSSREF-REQUIRED CROSSREF-OPTIONAL)). -ENTRY-TYPE is the type of a BibTeX entry. The remaining pairs contain -the required and optional fields of the BibTeX entry. -The second pair is used if a crossref field is present -and the first pair is used if a crossref field is absent. -If the second pair is nil, the first pair is always used. -REQUIRED, OPTIONAL, CROSSREF-REQUIRED and CROSSREF-OPTIONAL are lists. +(define-widget 'bibtex-entry-alist 'lazy + "Format of `bibtex-BibTeX-entry-alist' and friends." + :type '(repeat (group (string :tag "Entry type") + (string :tag "Documentation") + (repeat :tag "Required fields" + (group (string :tag "Field") + (option (choice :tag "Comment" :value nil + (const nil) string)) + (option (choice :tag "Init" :value nil + (const nil) string function)) + (option (choice :tag "Alternative" :value nil + (const nil) integer)))) + (repeat :tag "Crossref fields" + (group (string :tag "Field") + (option (choice :tag "Comment" :value nil + (const nil) string)) + (option (choice :tag "Init" :value nil + (const nil) string function)) + (option (choice :tag "Alternative" :value nil + (const nil) integer)))) + (repeat :tag "Optional fields" + (group (string :tag "Field") + (option (choice :tag "Comment" :value nil + (const nil) string)) + (option (choice :tag "Init" :value nil + (const nil) string function))))))) + +(define-obsolete-variable-alias 'bibtex-entry-field-alist + 'bibtex-BibTeX-entry-alist "24.1") +(defcustom bibtex-BibTeX-entry-alist + '(("Article" "Article in Journal" + (("author") + ("title" "Title of the article (BibTeX converts it to lowercase)")) + (("journal") ("year")) + (("volume" "Volume of the journal") + ("number" "Number of the journal (only allowed if entry contains volume)") + ("pages" "Pages in the journal") + ("month") ("note"))) + ("InProceedings" "Article in Conference Proceedings" + (("author") + ("title" "Title of the article in proceedings (BibTeX converts it to lowercase)")) + (("booktitle" "Name of the conference proceedings") + ("year")) + (("editor") + ("volume" "Volume of the conference proceedings in the series") + ("number" "Number of the conference proceedings in a small series (overwritten by volume)") + ("series" "Series in which the conference proceedings appeared") + ("pages" "Pages in the conference proceedings") + ("month") ("address") + ("organization" "Sponsoring organization of the conference") + ("publisher" "Publishing company, its location") + ("note"))) + ("InCollection" "Article in a Collection" + (("author") + ("title" "Title of the article in book (BibTeX converts it to lowercase)") + ("booktitle" "Name of the book")) + (("publisher") ("year")) + (("editor") + ("volume" "Volume of the book in the series") + ("number" "Number of the book in a small series (overwritten by volume)") + ("series" "Series in which the book appeared") + ("type" "Word to use instead of \"chapter\"") + ("chapter" "Chapter in the book") + ("pages" "Pages in the book") + ("edition" "Edition of the book as a capitalized English word") + ("month") ("address") ("note"))) + ("InBook" "Chapter or Pages in a Book" + (("author" nil nil 0) + ("editor" nil nil 0) + ("title" "Title of the book") + ("chapter" "Chapter in the book")) + (("publisher") ("year")) + (("volume" "Volume of the book in the series") + ("number" "Number of the book in a small series (overwritten by volume)") + ("series" "Series in which the book appeared") + ("type" "Word to use instead of \"chapter\"") + ("address") + ("edition" "Edition of the book as a capitalized English word") + ("month") + ("pages" "Pages in the book") + ("note"))) + ("Proceedings" "Conference Proceedings" + (("title" "Title of the conference proceedings") + ("year")) + nil + (("booktitle" "Title of the proceedings for cross references") + ("editor") + ("volume" "Volume of the conference proceedings in the series") + ("number" "Number of the conference proceedings in a small series (overwritten by volume)") + ("series" "Series in which the conference proceedings appeared") + ("address") + ("month") + ("organization" "Sponsoring organization of the conference") + ("publisher" "Publishing company, its location") + ("note"))) + ("Book" "Book" + (("author" nil nil 0) + ("editor" nil nil 0) + ("title" "Title of the book")) + (("publisher") ("year")) + (("volume" "Volume of the book in the series") + ("number" "Number of the book in a small series (overwritten by volume)") + ("series" "Series in which the book appeared") + ("address") + ("edition" "Edition of the book as a capitalized English word") + ("month") ("note"))) + ("Booklet" "Booklet (Bound, but no Publisher)" + (("title" "Title of the booklet (BibTeX converts it to lowercase)")) + nil + (("author") + ("howpublished" "The way in which the booklet was published") + ("address") ("month") ("year") ("note"))) + ("PhdThesis" "PhD. Thesis" + (("author") + ("title" "Title of the PhD. thesis") + ("school" "School where the PhD. thesis was written") + ("year")) + nil + (("type" "Type of the PhD. thesis") + ("address" "Address of the school (if not part of field \"school\") or country") + ("month") ("note"))) + ("MastersThesis" "Master's Thesis" + (("author") + ("title" "Title of the master's thesis (BibTeX converts it to lowercase)") + ("school" "School where the master's thesis was written") + ("year")) + nil + (("type" "Type of the master's thesis (if other than \"Master's thesis\")") + ("address" "Address of the school (if not part of field \"school\") or country") + ("month") ("note"))) + ("TechReport" "Technical Report" + (("author") + ("title" "Title of the technical report (BibTeX converts it to lowercase)") + ("institution" "Sponsoring institution of the report") + ("year")) + nil + (("type" "Type of the report (if other than \"technical report\")") + ("number" "Number of the technical report") + ("address") ("month") ("note"))) + ("Manual" "Technical Manual" + (("title" "Title of the manual")) + nil + (("author") + ("organization" "Publishing organization of the manual") + ("address") + ("edition" "Edition of the manual as a capitalized English word") + ("month") ("year") ("note"))) + ("Unpublished" "Unpublished" + (("author") + ("title" "Title of the unpublished work (BibTeX converts it to lowercase)") + ("note")) + nil + (("month") ("year"))) + ("Misc" "Miscellaneous" nil nil + (("author") + ("title" "Title of the work (BibTeX converts it to lowercase)") + ("howpublished" "The way in which the work was published") + ("month") ("year") ("note")))) + "Alist of BibTeX entry types and their associated fields. +Elements are lists (ENTRY-TYPE DOC REQUIRED CROSSREF OPTIONAL). +ENTRY-TYPE is the type of a BibTeX entry. +DOC is a brief doc string used for menus. If nil ENTRY-TYPE is used. +REQUIRED is a list of required fields. +CROSSREF is a list of fields that are optional if a crossref field +is present; but these fields are required otherwise. +OPTIONAL is a list of optional fields. + Each element of these lists is a list of the form -\(FIELD-NAME COMMENT-STRING INIT ALTERNATIVE-FLAG). -COMMENT-STRING, INIT, and ALTERNATIVE-FLAG are optional. -FIELD-NAME is the name of the field, COMMENT-STRING is the comment that -appears in the echo area, INIT is either the initial content of the -field or a function, which is called to determine the initial content -of the field, and ALTERNATIVE-FLAG (either nil or t) marks if the -field is an alternative. ALTERNATIVE-FLAG may be t only in the -REQUIRED or CROSSREF-REQUIRED lists." + \(FIELD COMMENT INIT ALTERNATIVE). +COMMENT, INIT, and ALTERNATIVE are optional. + +FIELD is the name of the field. +COMMENT is the comment string that appears in the echo area. +If COMMENT is nil use `bibtex-BibTeX-field-alist' if possible. +INIT is either the initial content of the field or a function, +which is called to determine the initial content of the field. +ALTERNATIVE if non-nil is an integer that numbers sets of +alternatives, starting from zero." + :group 'BibTeX + :type 'bibtex-entry-alist) +(put 'bibtex-BibTeX-entry-alist 'risky-local-variable t) + +(defcustom bibtex-biblatex-entry-alist + ;; Compare in biblatex documentation: + ;; Sec. 2.1.1 Regular types (required and optional fields) + ;; Appendix A Default Crossref setup + '(("Article" "Article in Journal" + (("author") ("title") ("journaltitle") + ("year" nil nil 0) ("date" nil nil 0)) + nil + (("translator") ("annotator") ("commentator") ("subtitle") ("titleaddon") + ("editor") ("editora") ("editorb") ("editorc") + ("journalsubtitle") ("issuetitle") ("issuesubtitle") + ("language") ("origlanguage") ("series") ("volume") ("number") ("eid") + ("issue") ("month") ("pages") ("version") ("note") ("issn") + ("addendum") ("pubstate") ("doi") ("eprint") ("eprintclass") + ("eprinttype") ("url") ("urldate"))) + ("Book" "Single-Volume Book" + (("author") ("title") ("year" nil nil 0) ("date" nil nil 0)) + nil + (("editor") ("editora") ("editorb") ("editorc") + ("translator") ("annotator") ("commentator") + ("introduction") ("foreword") ("afterword") ("titleaddon") + ("maintitle") ("mainsubtitle") ("maintitleaddon") + ("language") ("origlanguage") ("volume") ("part") ("edition") ("volumes") + ("series") ("number") ("note") ("publisher") ("location") ("isbn") + ("chapter") ("pages") ("pagetotal") ("addendum") ("pubstate") ("doi") + ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate"))) + ("MVBook" "Multi-Volume Book" + (("author") ("title") ("year" nil nil 0) ("date" nil nil 0)) + nil + (("editor") ("editora") ("editorb") ("editorc") + ("translator") ("annotator") ("commentator") + ("introduction") ("foreword") ("afterword") ("subtitle") + ("titleaddon") ("language") ("origlanguage") ("edition") ("volumes") + ("series") ("number") ("note") ("publisher") + ("location") ("isbn") ("pagetotal") ("addendum") ("pubstate") ("doi") + ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate"))) + ("InBook" "Chapter or Pages in a Book" + (("title") ("year" nil nil 0) ("date" nil nil 0)) + (("author") ("booktitle")) + (("bookauthor") ("editor") ("editora") ("editorb") ("editorc") + ("translator") ("annotator") ("commentator") ("introduction") ("foreword") + ("afterword") ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle") + ("maintitleaddon") ("booksubtitle") ("booktitleaddon") + ("language") ("origlanguage") ("volume") ("part") ("edition") ("volumes") + ("series") ("number") ("note") ("publisher") ("location") ("isbn") + ("chapter") ("pages") ("addendum") ("pubstate") + ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate"))) + ("BookInBook" "Book in Collection" ; same as @inbook + (("title") ("year" nil nil 0) ("date" nil nil 0)) + (("author") ("booktitle")) + (("bookauthor") ("editor") ("editora") ("editorb") ("editorc") + ("translator") ("annotator") ("commentator") ("introduction") ("foreword") + ("afterword") ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle") + ("maintitleaddon") ("booksubtitle") ("booktitleaddon") + ("language") ("origlanguage") ("volume") ("part") ("edition") ("volumes") + ("series") ("number") ("note") ("publisher") ("location") ("isbn") + ("chapter") ("pages") ("addendum") ("pubstate") + ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate"))) + ("SuppBook" "Supplemental Material in a Book" ; same as @inbook + (("title") ("year" nil nil 0) ("date" nil nil 0)) + (("author") ("booktitle")) + (("bookauthor") ("editor") ("editora") ("editorb") ("editorc") + ("translator") ("annotator") ("commentator") ("introduction") ("foreword") + ("afterword") ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle") + ("maintitleaddon") ("booksubtitle") ("booktitleaddon") + ("language") ("origlanguage") ("volume") ("part") ("edition") ("volumes") + ("series") ("number") ("note") ("publisher") ("location") ("isbn") + ("chapter") ("pages") ("addendum") ("pubstate") + ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate"))) + ("Booklet" "Booklet (Bound, but no Publisher)" + (("author" nil nil 0) ("editor" nil nil 0) ("title") + ("year" nil nil 1) ("date" nil nil 1)) + nil + (("subtitle") ("titleaddon") ("language") ("howpublished") ("type") + ("note") ("location") ("chapter") ("pages") ("pagetotal") ("addendum") + ("pubstate") ("doi") ("eprint") ("eprintclass") ("eprinttype") + ("url") ("urldate"))) + ("Collection" "Single-Volume Collection" + (("editor") ("title") ("year" nil nil 0) ("date" nil nil 0)) + nil + (("editora") ("editorb") ("editorc") ("translator") ("annotator") + ("commentator") ("introduction") ("foreword") ("afterword") + ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle") + ("maintitleaddon") ("language") ("origlanguage") ("volume") + ("part") ("edition") ("volumes") ("series") ("number") ("note") + ("publisher") ("location") ("isbn") ("chapter") ("pages") ("pagetotal") + ("addendum") ("pubstate") ("doi") ("eprint") ("eprintclass") + ("eprinttype") ("url") ("urldate"))) + ("MVCollection" "Multi-Volume Collection" + (("editor") ("title") ("year" nil nil 0) ("date" nil nil 0)) + nil + (("editora") ("editorb") ("editorc") ("translator") ("annotator") + ("commentator") ("introduction") ("foreword") ("afterword") + ("subtitle") ("titleaddon") ("language") ("origlanguage") ("edition") + ("volumes") ("series") ("number") ("note") ("publisher") + ("location") ("isbn") ("pagetotal") ("addendum") ("pubstate") ("doi") + ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate"))) + ("InCollection" "Article in a Collection" + (("author") ("editor") ("title") ("year" nil nil 0) ("date" nil nil 0)) + (("booktitle")) + (("editora") ("editorb") ("editorc") ("translator") ("annotator") + ("commentator") ("introduction") ("foreword") ("afterword") + ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle") + ("maintitleaddon") ("booksubtitle") ("booktitleaddon") + ("language") ("origlanguage") ("volume") ("part") ("edition") + ("volumes") ("series") ("number") ("note") ("publisher") ("location") + ("isbn") ("chapter") ("pages") ("addendum") ("pubstate") ("doi") + ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate"))) + ("SuppCollection" "Supplemental Material in a Collection" ; same as @incollection + (("author") ("editor") ("title") ("year" nil nil 0) ("date" nil nil 0)) + (("booktitle")) + (("editora") ("editorb") ("editorc") ("translator") ("annotator") + ("commentator") ("introduction") ("foreword") ("afterword") + ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle") + ("maintitleaddon") ("booksubtitle") ("booktitleaddon") + ("language") ("origlanguage") ("volume") ("part") ("edition") + ("volumes") ("series") ("number") ("note") ("publisher") ("location") + ("isbn") ("chapter") ("pages") ("addendum") ("pubstate") ("doi") + ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate"))) + ("Manual" "Technical Manual" + (("author" nil nil 0) ("editor" nil nil 0) ("title") + ("year" nil nil 1) ("date" nil nil 1)) + nil + (("subtitle") ("titleaddon") ("language") ("edition") + ("type") ("series") ("number") ("version") ("note") + ("organization") ("publisher") ("location") ("isbn") ("chapter") + ("pages") ("pagetotal") ("addendum") ("pubstate") + ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate"))) + ("Misc" "Miscellaneous" + (("author" nil nil 0) ("editor" nil nil 0) ("title") + ("year" nil nil 1) ("date" nil nil 1)) + nil + (("subtitle") ("titleaddon") ("language") ("howpublished") ("type") + ("version") ("note") ("organization") ("location") + ("date") ("month") ("year") ("addendum") ("pubstate") + ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate"))) + ("Online" "Online Resource" + (("author" nil nil 0) ("editor" nil nil 0) ("title") + ("year" nil nil 1) ("date" nil nil 1) ("url")) + nil + (("subtitle") ("titleaddon") ("language") ("version") ("note") + ("organization") ("date") ("month") ("year") ("addendum") + ("pubstate") ("urldate"))) + ("Patent" "Patent" + (("author") ("title") ("number") ("year" nil nil 0) ("date" nil nil 0)) + nil + (("holder") ("subtitle") ("titleaddon") ("type") ("version") ("location") + ("note") ("date") ("month") ("year") ("addendum") ("pubstate") + ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate"))) + ("Periodical" "Complete Issue of a Periodical" + (("editor") ("title") ("year" nil nil 0) ("date" nil nil 0)) + nil + (("editora") ("editorb") ("editorc") ("subtitle") ("issuetitle") + ("issuesubtitle") ("language") ("series") ("volume") ("number") ("issue") + ("date") ("month") ("year") ("note") ("issn") ("addendum") ("pubstate") + ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate"))) + ("SuppPeriodical" "Supplemental Material in a Periodical" ; same as @article + (("author") ("title") ("journaltitle") + ("year" nil nil 0) ("date" nil nil 0)) + nil + (("translator") ("annotator") ("commentator") ("subtitle") ("titleaddon") + ("editor") ("editora") ("editorb") ("editorc") + ("journalsubtitle") ("issuetitle") ("issuesubtitle") + ("language") ("origlanguage") ("series") ("volume") ("number") ("eid") + ("issue") ("month") ("pages") ("version") ("note") ("issn") + ("addendum") ("pubstate") ("doi") ("eprint") ("eprintclass") + ("eprinttype") ("url") ("urldate"))) + ("Proceedings" "Single-Volume Conference Proceedings" + (("editor") ("title") ("year" nil nil 0) ("date" nil nil 0)) + nil + (("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle") + ("maintitleaddon") ("eventtitle") ("eventdate") ("venue") ("language") + ("volume") ("part") ("volumes") ("series") ("number") ("note") + ("organization") ("publisher") ("location") ("month") + ("isbn") ("chapter") ("pages") ("pagetotal") ("addendum") ("pubstate") + ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate"))) + ("MVProceedings" "Multi-Volume Conference Proceedings" + (("editor") ("title") ("year" nil nil 0) ("date" nil nil 0)) + nil + (("subtitle") ("titleaddon") ("eventtitle") ("eventdate") ("venue") + ("language") ("volumes") ("series") ("number") ("note") + ("organization") ("publisher") ("location") ("month") + ("isbn") ("pagetotal") ("addendum") ("pubstate") + ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate"))) + ("InProceedings" "Article in Conference Proceedings" + (("author") ("editor") ("title") ("year" nil nil 0) ("date" nil nil 0)) + (("booktitle")) + (("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle") + ("maintitleaddon") ("booksubtitle") ("booktitleaddon") + ("eventtitle") ("eventdate") ("venue") ("language") + ("volume") ("part") ("volumes") ("series") ("number") ("note") + ("organization") ("publisher") ("location") ("month") ("isbn") + ("chapter") ("pages") ("addendum") ("pubstate") + ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate"))) + ("Reference" "Single-Volume Work of Reference" ; same as @collection + (("editor") ("title") ("year" nil nil 0) ("date" nil nil 0)) + nil + (("editora") ("editorb") ("editorc") ("translator") ("annotator") + ("commentator") ("introduction") ("foreword") ("afterword") + ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle") + ("maintitleaddon") ("language") ("origlanguage") ("volume") + ("part") ("edition") ("volumes") ("series") ("number") ("note") + ("publisher") ("location") ("isbn") ("chapter") ("pages") ("pagetotal") + ("addendum") ("pubstate") ("doi") ("eprint") ("eprintclass") + ("eprinttype") ("url") ("urldate"))) + ("MVReference" "Multi-Volume Work of Reference" ; same as @mvcollection + (("editor") ("title") ("year" nil nil 0) ("date" nil nil 0)) + nil + (("editora") ("editorb") ("editorc") ("translator") ("annotator") + ("commentator") ("introduction") ("foreword") ("afterword") + ("subtitle") ("titleaddon") ("language") ("origlanguage") ("edition") + ("volumes") ("series") ("number") ("note") ("publisher") + ("location") ("isbn") ("pagetotal") ("addendum") ("pubstate") ("doi") + ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate"))) + ("InReference" "Article in a Work of Reference" ; same as @incollection + (("author") ("editor") ("title") ("year" nil nil 0) ("date" nil nil 0)) + (("booktitle")) + (("editora") ("editorb") ("editorc") ("translator") ("annotator") + ("commentator") ("introduction") ("foreword") ("afterword") + ("subtitle") ("titleaddon") ("maintitle") ("mainsubtitle") + ("maintitleaddon") ("booksubtitle") ("booktitleaddon") + ("language") ("origlanguage") ("volume") ("part") ("edition") + ("volumes") ("series") ("number") ("note") ("publisher") ("location") + ("isbn") ("chapter") ("pages") ("addendum") ("pubstate") ("doi") + ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate"))) + ("Report" "Technical or Research Report" + (("author") ("title") ("type") ("institution") + ("year" nil nil 0) ("date" nil nil 0)) + nil + (("subtitle") ("titleaddon") ("language") ("number") ("version") ("note") + ("location") ("month") ("isrn") ("chapter") ("pages") ("pagetotal") + ("addendum") ("pubstate") + ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate"))) + ("Thesis" "PhD. or Master's Thesis" + (("author") ("title") ("type") ("institution") + ("year" nil nil 0) ("date" nil nil 0)) + nil + (("subtitle") ("titleaddon") ("language") ("note") ("location") + ("month") ("isbn") ("chapter") ("pages") ("pagetotal") + ("addendum") ("pubstate") + ("doi") ("eprint") ("eprintclass") ("eprinttype") ("url") ("urldate"))) + ("Unpublished" "Unpublished" + (("author") ("title") ("year" nil nil 0) ("date" nil nil 0)) + nil + (("subtitle") ("titleaddon") ("language") ("howpublished") + ("note") ("location") ("isbn") ("date") ("month") ("year") + ("addendum") ("pubstate") ("url") ("urldate")))) + "Alist of biblatex entry types and their associated fields. +It has the same format as `bibtex-BibTeX-entry-alist'." :group 'bibtex - :type '(repeat (group (string :tag "Entry type") - (group (repeat :tag "Required fields" - (group (string :tag "Field") - (string :tag "Comment") - (option (choice :tag "Init" :value nil - (const nil) string function)) - (option (choice :tag "Alternative" - (const :tag "No" nil) - (const :tag "Yes" t))))) - (repeat :tag "Optional fields" - (group (string :tag "Field") - (string :tag "Comment") - (option (choice :tag "Init" :value nil - (const nil) string function))))) - (option :extra-offset -4 - (group (repeat :tag "Crossref: required fields" - (group (string :tag "Field") - (string :tag "Comment") - (option (choice :tag "Init" :value nil - (const nil) string function)) - (option (choice :tag "Alternative" - (const :tag "No" nil) - (const :tag "Yes" t))))) - (repeat :tag "Crossref: optional fields" - (group (string :tag "Field") - (string :tag "Comment") - (option (choice :tag "Init" :value nil - (const nil) string function))))))))) -(put 'bibtex-entry-field-alist 'risky-local-variable t) + :type 'bibtex-entry-alist) +(put 'bibtex-biblatex-entry-alist 'risky-local-variable t) + +(define-widget 'bibtex-field-alist 'lazy + "Format of `bibtex-BibTeX-entry-alist' and friends." + :type '(repeat (group (string :tag "Field type") + (string :tag "Comment")))) + +(defcustom bibtex-BibTeX-field-alist + '(("author" "Author1 [and Author2 ...] [and others]") + ("editor" "Editor1 [and Editor2 ...] [and others]") + ("journal" "Name of the journal (use string, remove braces)") + ("year" "Year of publication") + ("month" "Month of the publication as a string (remove braces)") + ("note" "Remarks to be put at the end of the \\bibitem") + ("publisher" "Publishing company") + ("address" "Address of the publisher")) + "Alist of BibTeX fields. +Each element is a list (FIELD COMMENT). COMMENT is used as a default +if `bibtex-BibTeX-entry-alist' does not define a comment for FIELD." + :group 'bibtex + :type 'bibtex-field-alist) + +(defcustom bibtex-biblatex-field-alist + ;; See 2.2.2 Data Fields + '(("abstract" "Abstract of the work") + ("addendum" "Miscellaneous bibliographic data") + ("afterword" "Author(s) of an afterword to the work") + ("annotation" "Annotation") + ("annotator" "Author(s) of annotations to the work") + ("author" "Author(s) of the title") + ("bookauthor" "Author(s) of the booktitle.") + ("bookpagination" "Pagination scheme of the enclosing work") + ("booksubtitle" "Subtitle related to the booktitle") + ("booktitle" "Title of the book") + ("booktitleaddon" "Annex to the booktitle") + ("chapter" "Chapter, section, or any other unit of a work") + ("commentator" "Author(s) of a commentary to the work") + ("date" "Publication date") + ("doi" "Digital Object Identifier") + ("edition" "Edition of a printed publication") + ("editor" "Editor(s) of the title, booktitle, or maintitle") + ("editora" "Secondary editor") + ("editorb" "Secondary editor") + ("editorc" "Secondary editor") + ("editortype" "Type of editorial role performed by the editor") + ("editoratype" "Type of editorial role performed by editora") + ("editorbtype" "Type of editorial role performed by editorb") + ("editorctype" "Type of editorial role performed by editorc") + ("eid" "Electronic identifier of an article") + ("eprint" "Electronic identifier of an online publication") + ("eprintclass" "Additional information related to the eprinttype") + ("eprinttype" "Type of eprint identifier") + ("eventdate" "Date of a conference or some other event") + ("eventtitle" "Title of a conference or some other event") + ("file" "Local link to an electronic version of the work") + ("foreword" "Author(s) of a foreword to the work") + ("holder" "Holder(s) of a patent") + ("howpublished" "Publication notice for unusual publications") + ("indextitle" "Title to use for indexing instead of the regular title") + ("institution" "Name of a university or some other institution") + ("introduction" "Author(s) of an introduction to the work") + ("isan" "International Standard Audiovisual Number of an audiovisual work") + ("isbn" "International Standard Book Number of a book.") + ("ismn" "International Standard Music Number for printed music") + ("isrn" "International Standard Technical Report Number") + ("issn" "International Standard Serial Number of a periodical.") + ("issue" "Issue of a journal") + ("issuesubtitle" "Subtitle of a specific issue of a journal or other periodical.") + ("issuetitle" "Title of a specific issue of a journal or other periodical.") + ("iswc" "International Standard Work Code of a musical work") + ("journalsubtitle" "Subtitle of a journal, a newspaper, or some other periodical.") + ("journaltitle" "Name of a journal, a newspaper, or some other periodical.") + ("label" "Substitute for the regular label to be used by the citation style") + ("language" "Language(s) of the work") + ("library" "Library name and a call number") + ("location" "Place(s) of publication") + ("mainsubtitle" "Subtitle related to the maintitle") + ("maintitle" "Main title of a multi-volume book, such as Collected Works") + ("maintitleaddon" "Annex to the maintitle") + ("month" "Publication month") + ("nameaddon" "Addon to be printed immediately after the author name") + ("note" "Miscellaneous bibliographic data") + ("number" "Number of a journal or the volume/number of a book in a series") + ("organization" "Organization(s) that published a work") + ("origdate" "Publication date of the original edition") + ("origlanguage" "Original publication language of a translated edition") + ("origlocation" "Location of the original edition") + ("origpublisher" "Publisher of the original edition") + ("origtitle" "Title of the original work") + ("pages" "Page number(s) or page range(s)") + ("pagetotal" "Total number of pages of the work.") + ("pagination" "Pagination of the work") + ("part" "Number of a partial volume") + ("publisher" "Name(s) of the publisher(s)") + ("pubstate" "Publication state of the work, e. g.,'in press'") + ("reprinttitle" "Title of a reprint of the work") + ("series" "Name of a publication series") + ("shortauthor" "Author(s) of the work, given in an abbreviated form") + ("shorteditor" "Editor(s) of the work, given in an abbreviated form") + ("shortjournal" "Short version or an acronym of the journal title") + ("shortseries" "Short version or an acronym of the series field") + ("shorttitle" "Title in an abridged form") + ("subtitle" "Subtitle of the work") + ("title" "Title of the work") + ("titleaddon" "Annex to the title") + ("translator" "Translator(s) of the work") + ("type" "Type of a manual, patent, report, or thesis") + ("url" " URL of an online publication.") + ("urldate" "Access date of the address specified in the url field") + ("venue" "Location of a conference, a symposium, or some other event") + ("version" "Revision number of a piece of software, a manual, etc.") + ("volume" "Volume of a multi-volume book or a periodical") + ("volumes" "Total number of volumes of a multi-volume work") + ("year" "Year of publication")) + "Alist of biblatex fields. +It has the same format as `bibtex-BibTeX-entry-alist'." + :group 'bibtex + :type 'bibtex-field-alist) + +(defcustom bibtex-dialect-list '(BibTeX biblatex) + "List of BibTeX dialects known to BibTeX mode. +For each DIALECT (a symbol) a variable bibtex-DIALECT-entry-alist defines +the allowed entries and bibtex-DIALECT-field-alist defines known field types. +Predefined dialects include BibTeX and biblatex." + :group 'bibtex + :type '(repeat (symbol :tag "Dialect"))) + +(defcustom bibtex-dialect 'BibTeX + "Current BibTeX dialect. For allowed values see `bibtex-dialect-list'. +During a session change it via `bibtex-set-dialect'." + :group 'bibtex + :set '(lambda (symbol value) + (set-default symbol value) + ;; `bibtex-set-dialect' is undefined during loading (no problem) + (if (fboundp 'bibtex-set-dialect) + (bibtex-set-dialect value))) + :type '(choice (const BibTeX) + (const biblatex) + (symbol :tag "Custom"))) + +(defcustom bibtex-no-opt-remove-re "\\`option" + "If a field name matches this regexp, the prefix OPT is not removed. +If nil prefix OPT is always removed" + :group 'bibtex + :type '(choice (regexp) (const nil))) (defcustom bibtex-comment-start "@Comment" "String starting a BibTeX comment." @@ -1120,29 +1439,15 @@ Set this variable before loading BibTeX mode." ["(Re)Initialize BibTeX Buffers" bibtex-initialize t] ["Validate Entries" bibtex-validate-globally t]))) -(easy-menu-define - bibtex-entry-menu bibtex-mode-map "Entry-Types Menu in BibTeX mode" - (list "Entry-Types" - ["Article in Journal" bibtex-Article t] - ["Article in Conference Proceedings" bibtex-InProceedings t] - ["Article in a Collection" bibtex-InCollection t] - ["Chapter or Pages in a Book" bibtex-InBook t] - ["Conference Proceedings" bibtex-Proceedings t] - ["Book" bibtex-Book t] - ["Booklet (Bound, but no Publisher/Institution)" bibtex-Booklet t] - ["PhD. Thesis" bibtex-PhdThesis t] - ["Master's Thesis" bibtex-MastersThesis t] - ["Technical Report" bibtex-TechReport t] - ["Technical Manual" bibtex-Manual t] - ["Unpublished" bibtex-Unpublished t] - ["Miscellaneous" bibtex-Misc t] - "--" - ["String" bibtex-String t] - ["Preamble" bibtex-Preamble t])) - ;; Internal Variables +(defvar bibtex-entry-alist bibtex-BibTeX-entry-alist + "Alist of currently active entry types.") + +(defvar bibtex-field-alist bibtex-BibTeX-field-alist + "Alist of currently active field types.") + (defvar bibtex-field-braces-opt nil "Optimized value of `bibtex-field-braces-alist'. Created by `bibtex-field-re-init'. @@ -1237,33 +1542,26 @@ The CDRs of the elements are t for header keys and nil for crossref keys.") (defconst bibtex-field-const "[][[:alnum:].:;?!`'/*@+=|<>&_^$-]+" "Regexp matching a BibTeX field constant.") -(defvar bibtex-entry-type - (concat "@[ \t]*\\(?:" - (regexp-opt (mapcar 'car bibtex-entry-field-alist)) "\\)") - "Regexp matching the type of a BibTeX entry.") +(defvar bibtex-entry-type nil + "Regexp matching the type of a BibTeX entry. +Initialized by `bibtex-set-dialect'.") -(defvar bibtex-entry-head - (concat "^[ \t]*\\(" - bibtex-entry-type - "\\)[ \t]*[({][ \t\n]*\\(" - bibtex-reference-key - "\\)") - "Regexp matching the header line of a BibTeX entry (including key).") +(defvar bibtex-entry-head nil + "Regexp matching the header line of a BibTeX entry (including key). +Initialized by `bibtex-set-dialect'.") -(defvar bibtex-entry-maybe-empty-head - (concat bibtex-entry-head "?") - "Regexp matching the header line of a BibTeX entry (possibly without key).") +(defvar bibtex-entry-maybe-empty-head nil + "Regexp matching the header line of a BibTeX entry (possibly without key). +Initialized by `bibtex-set-dialect'.") (defconst bibtex-any-entry-maybe-empty-head (concat "^[ \t]*\\(@[ \t]*" bibtex-field-name "\\)[ \t]*[({][ \t\n]*\\(" bibtex-reference-key "\\)?") "Regexp matching the header line of any BibTeX entry (possibly without key).") -(defvar bibtex-any-valid-entry-type - (concat "^[ \t]*@[ \t]*\\(?:" - (regexp-opt (append '("String" "Preamble") - (mapcar 'car bibtex-entry-field-alist))) "\\)") - "Regexp matching any valid BibTeX entry (including String and Preamble).") +(defvar bibtex-any-valid-entry-type nil + "Regexp matching any valid BibTeX entry (including String and Preamble). +Initialized by `bibtex-set-dialect'.") (defconst bibtex-type-in-head 1 "Regexp subexpression number of the type part in `bibtex-entry-head'.") @@ -1520,7 +1818,9 @@ If optional arg REMOVE-OPT-ALT is non-nil remove \"OPT\" and \"ALT\"." (bibtex-start-of-name-in-field bounds) (bibtex-end-of-name-in-field bounds)))) (if (and remove-opt-alt - (string-match "\\`\\(OPT\\|ALT\\)" name)) + (string-match "\\`\\(OPT\\|ALT\\)" name) + (not (and bibtex-no-opt-remove-re + (string-match bibtex-no-opt-remove-re name)))) (substring name 3) name))) @@ -1686,7 +1986,7 @@ Point must be at beginning of preamble. Do not move point." (defun bibtex-valid-entry (&optional empty-key) "Parse a valid BibTeX entry (maybe without key if EMPTY-KEY is t). A valid entry is a syntactical correct one with type contained in -`bibtex-entry-field-alist'. Ignore @String and @Preamble entries. +`bibtex-BibTeX-entry-alist'. Ignore @String and @Preamble entries. Return a cons pair with buffer positions of beginning and end of entry if a valid entry is found, nil otherwise. Do not move point. After a call to this function `match-data' corresponds to the header @@ -1717,7 +2017,7 @@ of the entry, see regexp `bibtex-entry-head'." Do not move if we are already at beginning of a valid BibTeX entry. With optional argument BACKWARD non-nil, move backward to beginning of previous valid one. A valid entry is a syntactical correct one -with type contained in `bibtex-entry-field-alist' or, if +with type contained in `bibtex-BibTeX-entry-alist' or, if `bibtex-sort-ignore-string-entries' is nil, a syntactical correct string entry. Return buffer position of beginning and end of entry if a valid entry is found, nil otherwise." @@ -1911,6 +2211,14 @@ Optional arg COMMA is as in `bibtex-enclosing-field'." (let ((key (bibtex-key-in-head))) (if key (push (cons key t) bibtex-reference-keys)))))))) +(defsubst bibtex-vec-push (vec idx newelt) + "Add NEWELT to the list stored in VEC at index IDX." + (aset vec idx (cons newelt (aref vec idx)))) + +(defsubst bibtex-vec-incr (vec idx) + "Add NEWELT to the list stored in VEC at index IDX." + (aset vec idx (1+ (aref vec idx)))) + (defun bibtex-format-entry () "Helper function for `bibtex-clean-entry'. Formats current entry according to variable `bibtex-entry-format'." @@ -1932,7 +2240,7 @@ Formats current entry according to variable `bibtex-entry-format'." bibtex-entry-format)) (left-delim-re (regexp-quote (bibtex-field-left-delimiter))) bounds crossref-key req-field-list default-field-list field-list - alt-fields error-field-name) + num-alt alt-fields idx error-field-name) (unwind-protect ;; formatting (undone if error occurs) (atomic-change-group @@ -1954,7 +2262,7 @@ Formats current entry according to variable `bibtex-entry-format'." (end-type (match-end 0)) (entry-list (assoc-string (buffer-substring-no-properties beg-type end-type) - bibtex-entry-field-alist t))) + bibtex-entry-alist t))) ;; unify case of entry type (when (memq 'unify-case format) @@ -1978,13 +2286,18 @@ Formats current entry according to variable `bibtex-entry-format'." ;; list of required fields appropriate for an entry with ;; or without crossref key. - (setq req-field-list (if (and crossref-key (nth 2 entry-list)) - (car (nth 2 entry-list)) - (car (nth 1 entry-list))) + (setq req-field-list (if crossref-key (nth 2 entry-list) + (append (nth 2 entry-list) (nth 3 entry-list))) ;; default list of fields that may appear in this entry - default-field-list (append (nth 0 (nth 1 entry-list)) - (nth 1 (nth 1 entry-list)) - bibtex-user-optional-fields)) + default-field-list (append (nth 2 entry-list) (nth 3 entry-list) + (nth 4 entry-list) + bibtex-user-optional-fields) + ;; number of ALT fields we expect to find + num-alt (length (delq nil (delete-dups + (mapcar (lambda (x) (nth 3 x)) + req-field-list)))) + ;; ALT fields of respective groups + alt-fields (make-vector num-alt nil)) (when (memq 'sort-fields format) (goto-char (point-min)) @@ -1995,10 +2308,10 @@ Formats current entry according to variable `bibtex-entry-format'." (dolist (field default-field-list) (when (setq elt (assoc-string (car field) fields-alist t)) (setq fields-alist (delete elt fields-alist)) - (bibtex-make-field (list (car elt) "" (cdr elt)) nil nil t))) + (bibtex-make-field (list (car elt) nil (cdr elt)) nil nil t))) (dolist (field fields-alist) (unless (member (car field) '("=key=" "=type=")) - (bibtex-make-field (list (car field) "" (cdr field)) nil nil t)))))) + (bibtex-make-field (list (car field) nil (cdr field)) nil nil t)))))) ;; process all fields (bibtex-beginning-first-field (point-min)) @@ -2009,17 +2322,18 @@ Formats current entry according to variable `bibtex-entry-format'." (end-name (copy-marker (bibtex-end-of-name-in-field bounds))) (beg-text (copy-marker (bibtex-start-of-text-in-field bounds))) (end-text (copy-marker (bibtex-end-of-text-in-field bounds) t)) - (opt-alt (string-match "OPT\\|ALT" - (buffer-substring-no-properties - beg-name (+ beg-name 3)))) - (field-name (buffer-substring-no-properties - (if opt-alt (+ beg-name 3) beg-name) end-name)) (empty-field (equal "" (bibtex-text-in-field-bounds bounds t))) + (field-name (buffer-substring-no-properties beg-name end-name)) + (opt-alt (and (string-match "\\`\\(OPT\\|ALT\\)" field-name) + (not (and bibtex-no-opt-remove-re + (string-match bibtex-no-opt-remove-re + field-name))))) deleted) + (if opt-alt (setq field-name (substring field-name 3))) ;; keep track of alternatives - (if (nth 3 (assoc-string field-name req-field-list t)) - (push field-name alt-fields)) + (if (setq idx (nth 3 (assoc-string field-name req-field-list t))) + (bibtex-vec-push alt-fields idx field-name)) (if (memq 'opts-or-alts format) ;; delete empty optional and alternative fields @@ -2170,12 +2484,14 @@ Formats current entry according to variable `bibtex-entry-format'." ;; check whether all required fields are present (if (memq 'required-fields format) - (let ((found 0) alt-list) + (let ((alt-expect (make-vector num-alt nil)) + (alt-found (make-vector num-alt 0))) (dolist (fname req-field-list) - (cond ((nth 3 fname) ; t if field has alternative flag - (push (car fname) alt-list) + (cond ((setq idx (nth 3 fname)) + ;; t if field has alternative flag + (bibtex-vec-push alt-expect idx (car fname)) (if (member-ignore-case (car fname) field-list) - (setq found (1+ found)))) + (bibtex-vec-incr alt-found idx))) ((not (member-ignore-case (car fname) field-list)) ;; If we use the crossref field, a required field ;; can have the OPT prefix. So if it was empty, @@ -2183,17 +2499,16 @@ Formats current entry according to variable `bibtex-entry-format'." ;; move point on this empty field. (setq error-field-name (car fname)) (error "Mandatory field `%s' is missing" (car fname))))) - (if alt-list - (cond ((= found 0) - (if alt-fields - (setq error-field-name (car (last alt-fields)))) - (error "Alternative mandatory field `%s' is missing" - alt-list)) - ((> found 1) - (if alt-fields - (setq error-field-name (car (last alt-fields)))) - (error "Alternative fields `%s' are defined %s times" - alt-list found)))))) + (dotimes (idx num-alt) + (cond ((= 0 (aref alt-found idx)) + (setq error-field-name (car (last (aref alt-fields idx)))) + (error "Alternative mandatory field `%s' is missing" + (aref alt-expect idx))) + ((< 1 (aref alt-found idx)) + (setq error-field-name (car (last (aref alt-fields idx)))) + (error "Alternative fields `%s' are defined %s times" + (aref alt-expect idx) + (length (aref alt-fields idx)))))))) ;; update comma after last field (if (memq 'last-comma format) @@ -2547,7 +2862,7 @@ for parsing BibTeX keys. If parsing fails, try to set this variable to nil." (push (list key) crossref-keys)))) ;; only keys of known entries ((assoc-string (bibtex-type-in-head) - bibtex-entry-field-alist t) + bibtex-entry-alist t) ;; This is an entry. (let ((key (bibtex-key-in-head))) (unless (assoc key ref-keys) @@ -3056,25 +3371,122 @@ if that value is non-nil. bibtex-font-lock-syntactic-keywords)) (setq imenu-generic-expression (list (list nil bibtex-entry-head bibtex-key-in-head)) - imenu-case-fold-search t)) + imenu-case-fold-search t) + (bibtex-set-dialect bibtex-dialect)) + +(defun bibtex-set-dialect (dialect) + "Select BibTeX mode DIALECT. +This sets the variable `bibtex-dialect' which holds the currently active +dialect. Dialects are listed in `bibtex-dialect-list'." + (interactive (list (intern (completing-read "Dialect: " + (mapcar 'list bibtex-dialect-list) + nil t)))) + (unless (eq dialect (get 'bibtex-dialect 'dialect)) + (put 'bibtex-dialect 'dialect dialect) + (setq bibtex-dialect dialect) + + ;; Bind variables + (setq bibtex-entry-alist + (let ((var (intern (format "bibtex-%s-entry-alist" dialect))) + entry-alist) + (if (boundp var) + (setq entry-alist (symbol-value var)) + (error "BibTeX dialect `%s' undefined" dialect)) + (if (not (consp (nth 1 (car entry-alist)))) + ;; new format + entry-alist + ;; Convert old format + (unless (get var 'entry-list-format) + (put var 'entry-list-format "pre-24") + (message "Old format of `%s' (pre GNU Emacs 24). +Please convert to the new format." + (if (eq (indirect-variable 'bibtex-entry-field-alist) var) + 'bibtex-entry-field-alist var)) + (sit-for 3)) + (let (lst) + (dolist (entry entry-alist) + (let ((fl (nth 1 entry)) req xref opt) + (dolist (field (copy-tree (car fl))) + (if (nth 3 field) (setcar (nthcdr 3 field) 0)) + (if (or (not (nth 2 entry)) + (assoc-string (car field) (car (nth 2 entry)) t)) + (push field req) + (push field xref))) + (dolist (field (nth 1 fl)) + (push field opt)) + (push (list (car entry) nil (nreverse req) + (nreverse xref) (nreverse opt)) + lst))) + (nreverse lst)))) + bibtex-field-alist + (let ((var (intern (format "bibtex-%s-field-alist" dialect)))) + (if (boundp var) + (symbol-value var) + (error "Field types for BibTeX dialect `%s' undefined" dialect))) + bibtex-entry-type + (concat "@[ \t]*\\(?:" + (regexp-opt (mapcar 'car bibtex-entry-alist)) "\\)") + bibtex-entry-head (concat "^[ \t]*\\(" + bibtex-entry-type + "\\)[ \t]*[({][ \t\n]*\\(" + bibtex-reference-key + "\\)") + bibtex-entry-maybe-empty-head (concat bibtex-entry-head "?") + bibtex-any-valid-entry-type + (concat "^[ \t]*@[ \t]*\\(?:" + (regexp-opt (append '("String" "Preamble") + (mapcar 'car bibtex-entry-alist))) "\\)")) + ;; Define entry commands + (dolist (elt bibtex-entry-alist) + (let* ((entry (car elt)) + (fname (intern (concat "bibtex-" entry)))) + (unless (fboundp fname) + (eval (list 'defun fname nil + (format "Insert a new BibTeX @%s entry; see also `bibtex-entry'." + entry) + '(interactive "*") + `(bibtex-entry ,entry)))))) + ;; Define menu + ;; We use the same keymap for all BibTeX buffers. So all these buffers + ;; have the same BibTeX dialect. To define entry types buffer-locally, + ;; it would be necessary to give each BibTeX buffer a new keymap that + ;; becomes a child of `bibtex-mode-map'. Useful?? + (easy-menu-define + nil bibtex-mode-map "Entry-Types Menu in BibTeX mode" + (apply 'list "Entry-Types" + (append + (mapcar (lambda (entry) + (vector (or (nth 1 entry) (car entry)) + (intern (format "bibtex-%s" (car entry))) t)) + bibtex-entry-alist) + `("---" + ["String" bibtex-String t] + ["Preamble" bibtex-Preamble t] + "---" + ,(append '("BibTeX dialect") + (mapcar (lambda (dialect) + (vector (symbol-name dialect) + `(lambda () (interactive) + (bibtex-set-dialect ',dialect)) + t)) + bibtex-dialect-list)))))))) (defun bibtex-field-list (entry-type) "Return list of allowed fields for entry ENTRY-TYPE. More specifically, the return value is a cons pair (REQUIRED . OPTIONAL), where REQUIRED and OPTIONAL are lists of the required and optional field -names for ENTRY-TYPE according to `bibtex-entry-field-alist', +names for ENTRY-TYPE according to `bibtex-BibTeX-entry-alist' and friends, `bibtex-include-OPTkey', `bibtex-include-OPTcrossref', and `bibtex-user-optional-fields'." - (let ((e (assoc-string entry-type bibtex-entry-field-alist t)) + (let ((e-list (assoc-string entry-type bibtex-entry-alist t)) required optional) - (unless e + (unless e-list (error "Fields for BibTeX entry type %s not defined" entry-type)) - (if (and (member-ignore-case entry-type bibtex-include-OPTcrossref) - (nth 2 e)) - (setq required (nth 0 (nth 2 e)) - optional (nth 1 (nth 2 e))) - (setq required (nth 0 (nth 1 e)) - optional (nth 1 (nth 1 e)))) + (if (member-ignore-case entry-type bibtex-include-OPTcrossref) + (setq required (nth 2 e-list) + optional (append (nth 3 e-list) (nth 4 e-list))) + (setq required (append (nth 2 e-list) (nth 3 e-list)) + optional (nth 4 e-list))) (if bibtex-include-OPTkey (push (list "key" "Used for reference key creation if author and editor fields are missing" @@ -3094,7 +3506,7 @@ After insertion call the value of `bibtex-add-entry-hook' if that value is non-nil." (interactive (let ((completion-ignore-case t)) - (list (completing-read "Entry Type: " bibtex-entry-field-alist + (list (completing-read "Entry Type: " bibtex-entry-alist nil t nil 'bibtex-entry-type-history)))) (let ((key (if bibtex-maintain-sorted-entries (bibtex-read-key (format "%s key: " entry-type)))) @@ -3127,7 +3539,7 @@ When called interactively with a prefix arg, query for a value of ENTRY-TYPE." (interactive (list (if current-prefix-arg (let ((completion-ignore-case t)) - (completing-read "New entry type: " bibtex-entry-field-alist + (completing-read "New entry type: " bibtex-entry-alist nil t nil 'bibtex-entry-type-history))))) (save-excursion (bibtex-beginning-of-entry) @@ -3264,14 +3676,16 @@ interactive calls." (field-list (bibtex-field-list type)) (comment (assoc-string field (append (car field-list) (cdr field-list)) t))) - (if comment (message "%s" (nth 1 comment)) - (message "No comment available"))))) + (message "%s" (cond ((nth 1 comment) (nth 1 comment)) + ((setq comment (assoc-string field bibtex-field-alist t)) + (nth 1 comment)) + (t "No comment available")))))) (defun bibtex-make-field (field &optional move interactive nodelim) "Make a field named FIELD in current BibTeX entry. FIELD is either a string or a list of the form \(FIELD-NAME COMMENT-STRING INIT ALTERNATIVE-FLAG) as in -`bibtex-entry-field-alist'. +`bibtex-BibTeX-entry-alist' and friends. If MOVE is non-nil, move point past the present field before making the new field. If INTERACTIVE is non-nil, move point to the end of the new field. Otherwise move point past the new field. @@ -3296,6 +3710,8 @@ INIT is surrounded by field delimiters, unless NODELIM is non-nil." (forward-char))) (insert ",\n") (indent-to-column (+ bibtex-entry-offset bibtex-field-indentation)) + ;; If there are multiple sets of alternatives, we could use + ;; the numeric value of (nth 3 field) to number these sets. Useful?? (if (nth 3 field) (insert "ALT")) (insert (car field) " ") (if bibtex-align-at-equal-sign @@ -3794,14 +4210,22 @@ Return t if test was successful, nil otherwise." "Checking required fields and month fields") (let ((bibtex-sort-ignore-string-entries t)) (bibtex-map-entries - (lambda (_key beg _end) + (lambda (_key beg end) (bibtex-progress-message) - (let* ((entry-list (assoc-string (bibtex-type-in-head) - bibtex-entry-field-alist t)) - (req (copy-sequence (elt (elt entry-list 1) 0))) - (creq (copy-sequence (elt (elt entry-list 2) 0))) - crossref-there bounds alt-there field) - (bibtex-beginning-first-field beg) + (bibtex-beginning-first-field beg) + (let* ((beg-line (save-excursion (goto-char beg) + (bibtex-current-line))) + (entry-list (assoc-string (bibtex-type-in-head) + bibtex-entry-alist t)) + (crossref (bibtex-search-forward-field "crossref" end)) + (req (if crossref (copy-sequence (nth 2 entry-list)) + (append (nth 2 entry-list) + (copy-sequence (nth 3 entry-list))))) + (num-alt (length (delq nil (delete-dups + (mapcar (lambda (x) (nth 3 x)) + req))))) + (alt-fields (make-vector num-alt nil)) + bounds field idx) (while (setq bounds (bibtex-parse-field)) (let ((field-name (bibtex-name-in-field bounds))) (if (and (bibtex-string= field-name "month") @@ -3815,36 +4239,28 @@ Return t if test was successful, nil otherwise." "Questionable month field") error-list)) (setq field (assoc-string field-name req t) - req (delete field req) - creq (delete (assoc-string field-name creq t) creq)) - (if (nth 3 field) - (if alt-there + req (delete field req)) + (if (setq idx (nth 3 field)) + (if (aref alt-fields idx) (push (cons (bibtex-current-line) "More than one non-empty alternative") error-list) - (setq alt-there t))) - (if (bibtex-string= field-name "crossref") - (setq crossref-there t))) + (aset alt-fields idx t)))) (goto-char (bibtex-end-of-field bounds))) - (if crossref-there (setq req creq)) - (let (alt) - (dolist (field req) - (if (nth 3 field) - (push (car field) alt) - (push (cons (save-excursion (goto-char beg) - (bibtex-current-line)) + (let ((alt-expect (make-vector num-alt nil))) + (dolist (field req) ; absent required fields + (if (setq idx (nth 3 field)) + (bibtex-vec-push alt-expect idx (car field)) + (push (cons beg-line (format "Required field `%s' missing" (car field))) error-list))) - ;; The following fails if there are more than two - ;; alternatives in a BibTeX entry, which isn't - ;; the case momentarily. - (if (cdr alt) - (push (cons (save-excursion (goto-char beg) - (bibtex-current-line)) - (format "Alternative fields `%s'/`%s' missing" - (car alt) (cadr alt))) - error-list))))))) + (dotimes (idx num-alt) + (unless (aref alt-fields idx) + (push (cons beg-line + (format "Alternative fields `%s' missing" + (aref alt-expect idx))) + error-list)))))))) (bibtex-progress-message 'done))))) (if error-list @@ -3890,7 +4306,7 @@ Return t if test was successful, nil otherwise." (setq entry-type (bibtex-type-in-head) key (bibtex-key-in-head)) (if (or (and strings (bibtex-string= entry-type "string")) - (assoc-string entry-type bibtex-entry-field-alist t)) + (assoc-string entry-type bibtex-entry-alist t)) (if (member key key-list) (push (format "%s:%d: Duplicate key `%s'\n" (buffer-file-name) @@ -4057,7 +4473,13 @@ is as in `bibtex-enclosing-field'. It is t for interactive calls." (bounds (bibtex-enclosing-field comma))) (save-excursion (goto-char (bibtex-start-of-name-in-field bounds)) - (when (looking-at "OPT\\|ALT") + (when (and (looking-at "OPT\\|ALT") + (not (and bibtex-no-opt-remove-re + (string-match + bibtex-no-opt-remove-re + (buffer-substring-no-properties + (bibtex-start-of-name-in-field bounds) + (bibtex-end-of-name-in-field bounds)))))) (delete-region (match-beginning 0) (match-end 0)) ;; make field non-OPT (search-forward "=") @@ -4600,71 +5022,6 @@ entries from minibuffer." (when (eq status 'finished) (save-excursion (bibtex-remove-delimiters))))))))) -(defun bibtex-Article () - "Insert a new BibTeX @Article entry; see also `bibtex-entry'." - (interactive "*") - (bibtex-entry "Article")) - -(defun bibtex-Book () - "Insert a new BibTeX @Book entry; see also `bibtex-entry'." - (interactive "*") - (bibtex-entry "Book")) - -(defun bibtex-Booklet () - "Insert a new BibTeX @Booklet entry; see also `bibtex-entry'." - (interactive "*") - (bibtex-entry "Booklet")) - -(defun bibtex-InBook () - "Insert a new BibTeX @InBook entry; see also `bibtex-entry'." - (interactive "*") - (bibtex-entry "InBook")) - -(defun bibtex-InCollection () - "Insert a new BibTeX @InCollection entry; see also `bibtex-entry'." - (interactive "*") - (bibtex-entry "InCollection")) - -(defun bibtex-InProceedings () - "Insert a new BibTeX @InProceedings entry; see also `bibtex-entry'." - (interactive "*") - (bibtex-entry "InProceedings")) - -(defun bibtex-Manual () - "Insert a new BibTeX @Manual entry; see also `bibtex-entry'." - (interactive "*") - (bibtex-entry "Manual")) - -(defun bibtex-MastersThesis () - "Insert a new BibTeX @MastersThesis entry; see also `bibtex-entry'." - (interactive "*") - (bibtex-entry "MastersThesis")) - -(defun bibtex-Misc () - "Insert a new BibTeX @Misc entry; see also `bibtex-entry'." - (interactive "*") - (bibtex-entry "Misc")) - -(defun bibtex-PhdThesis () - "Insert a new BibTeX @PhdThesis entry; see also `bibtex-entry'." - (interactive "*") - (bibtex-entry "PhdThesis")) - -(defun bibtex-Proceedings () - "Insert a new BibTeX @Proceedings entry; see also `bibtex-entry'." - (interactive "*") - (bibtex-entry "Proceedings")) - -(defun bibtex-TechReport () - "Insert a new BibTeX @TechReport entry; see also `bibtex-entry'." - (interactive "*") - (bibtex-entry "TechReport")) - -(defun bibtex-Unpublished () - "Insert a new BibTeX @Unpublished entry; see also `bibtex-entry'." - (interactive "*") - (bibtex-entry "Unpublished")) - (defun bibtex-String (&optional key) "Insert a new BibTeX @String entry with key KEY." (interactive (list (bibtex-read-string-key))) @@ -4822,10 +5179,8 @@ where FILE is the BibTeX file of ENTRY." (delete-dups (apply 'append bibtex-user-optional-fields - (mapcar (lambda (x) - (append (mapcar 'car (nth 0 (nth 1 x))) - (mapcar 'car (nth 1 (nth 1 x))))) - bibtex-entry-field-alist))) nil t) + (mapcar (lambda (x) (mapcar 'car (apply 'append (cdr x)))) + bibtex-entry-alist))) nil t) (read-string "Regexp: ") (if bibtex-search-entry-globally (not current-prefix-arg) diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index ef51fb25035..d98aa183f21 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -213,7 +213,7 @@ (defconst css-nmstart-re (concat "\\(?:[[:alpha:]]\\|" css-escapes-re "\\)")) (defconst css-ident-re (concat css-nmstart-re css-nmchar-re "*")) (defconst css-proprietary-nmstart-re ;; Vendor-specific properties. - "[-_]\\(?:ms\\|moz\\|o\\|webkit\\|khtml\\)-") + (concat "[-_]" (regexp-opt '("ms" "moz" "o" "khtml" "webkit")) "-")) (defconst css-name-re (concat css-nmchar-re "+")) (defface css-selector '((t :inherit font-lock-function-name-face)) @@ -240,7 +240,7 @@ ;; thus prevent this highlighting from being applied (actually now that ;; I use `append' this should work better). But really the part of hte ;; selector between [...] should simply not be highlighted. - (,(concat "^\\([ \t]*[^@:{\n][^:{\n]+\\(?::" (regexp-opt css-pseudo-ids t) + (,(concat "^\\([ \t]*[^@:{}\n][^:{}]+\\(?::" (regexp-opt css-pseudo-ids t) "\\(?:([^)]+)\\)?[^:{\n]*\\)*\\)\\(?:\n[ \t]*\\)*{") (1 'css-selector append)) ;; In the above rule, we allow the open-brace to be on some subsequent diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index a85ed982ab0..b264cc30850 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -988,7 +988,7 @@ can take care of filling. JUSTIFY is used as in `fill-paragraph'." (defun fill-region (from to &optional justify nosqueeze to-eop) "Fill each of the paragraphs in the region. A prefix arg means justify as well. -Ordinarily the variable `fill-column' controls the width. +The `fill-column' variable controls the width. Noninteractively, the third argument JUSTIFY specifies which kind of justification to do: `full', `left', `right', `center', diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index bc8644be786..e6837d0abde 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -993,14 +993,17 @@ Mostly we check word delimiters." ;;*---------------------------------------------------------------------*/ ;;* flyspell-word-search-backward ... */ ;;*---------------------------------------------------------------------*/ -(defun flyspell-word-search-backward (word bound) +(defun flyspell-word-search-backward (word bound &optional ignore-case) (save-excursion (let ((r '()) (inhibit-point-motion-hooks t) p) (while (and (not r) (setq p (search-backward word bound t))) (let ((lw (flyspell-get-word))) - (if (and (consp lw) (string-equal (car lw) word)) + (if (and (consp lw) + (if ignore-case + (string-equal (downcase (car lw)) (downcase word)) + (string-equal (car lw) word))) (setq r p) (goto-char p)))) r))) @@ -1069,7 +1072,7 @@ misspelling and skips redundant spell-checking step." (- end start) (- (skip-chars-backward " \t\n\f")))) (p (when (>= bound (point-min)) - (flyspell-word-search-backward word bound)))) + (flyspell-word-search-backward word bound t)))) (and p (/= p start))))) ;; yes, this is a doublon (flyspell-highlight-incorrect-region start end 'doublon) diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el index 6ffbf7a4621..b0f22085064 100644 --- a/lisp/textmodes/reftex-parse.el +++ b/lisp/textmodes/reftex-parse.el @@ -146,7 +146,7 @@ (unless (assq 'xr docstruct) (let* ((allxr (reftex-all-assq 'xr-doc docstruct)) (alist (mapcar - (lambda (x) + (lambda (x) (if (setq tmp (reftex-locate-file (nth 2 x) "tex" master-dir)) (cons (nth 1 x) tmp) @@ -157,7 +157,7 @@ (alist (delq nil alist)) (allprefix (delq nil (mapcar 'car alist))) (regexp (if allprefix - (concat "\\`\\(" + (concat "\\`\\(" (mapconcat 'identity allprefix "\\|") "\\)") "\\\\\\\\\\\\"))) ; this will never match @@ -189,6 +189,9 @@ of master file." (push file file-list)) (nreverse file-list))) +;; Bound in the caller, reftex-do-parse. +(defvar index-tags) + (defun reftex-parse-from-file (file docstruct master-dir) ;; Scan the buffer for labels and save them in a list. (let ((regexp (reftex-everything-regexp)) @@ -259,7 +262,7 @@ of master file." ;; It's an include or input (setq include-file (reftex-match-string 7)) ;; Test if this file should be ignored - (unless (delq nil (mapcar + (unless (delq nil (mapcar (lambda (x) (string-match x include-file)) reftex-no-include-regexps)) ;; Parse it @@ -308,10 +311,10 @@ of master file." (push (cons 'bib tmp) docstruct)) (goto-char 1) - (when (re-search-forward + (when (re-search-forward "\\(\\`\\|[\n\r]\\)[ \t]*\\\\begin{thebibliography}" nil t) (push (cons 'thebib file) docstruct)) - + ;; Find external document specifications (goto-char 1) (while (re-search-forward "[\n\r][ \t]*\\\\externaldocument\\(\\[\\([^]]*\\)\\]\\)?{\\([^}]+\\)}" nil t) @@ -330,7 +333,7 @@ of master file." (defun reftex-locate-bibliography-files (master-dir &optional files) ;; Scan buffer for bibliography macro and return file list. - + (unless files (save-excursion (goto-char (point-min)) @@ -340,11 +343,11 @@ of master file." "\\(^\\)[^%\n\r]*\\\\\\(" (mapconcat 'identity reftex-bibliography-commands "\\|") "\\){[ \t]*\\([^}]+\\)") nil t) - (setq files + (setq files (split-string (reftex-match-string 3) "[ \t\n\r]*,[ \t\n\r]*"))))) (when files - (setq files + (setq files (mapcar (lambda (x) (if (or (member x reftex-bibfile-ignore-list) @@ -398,13 +401,13 @@ of master file." (unnumbered (or star (< level 0))) (level (abs level)) (section-number (reftex-section-number level unnumbered)) - (text1 (save-match-data + (text1 (save-match-data (save-excursion (reftex-context-substring prefix)))) (literal (buffer-substring-no-properties (1- (match-beginning 3)) (min (point-max) (+ (match-end 0) (length text1) 1)))) - ;; Literal can be too short since text1 too short. No big problem. + ;; Literal can be too short since text1 too short. No big problem. (text (reftex-nicify-text text1))) ;; Add section number and indentation @@ -454,7 +457,7 @@ of master file." (throw 'exit nil))) (itag (nth 1 entry)) (prefix (nth 2 entry)) - (index-tag + (index-tag (cond ((stringp itag) itag) ((integerp itag) (progn (goto-char boa) @@ -476,16 +479,16 @@ of master file." (key-end (if (string-match reftex-index-key-end-re arg) (1+ (match-beginning 0)))) (rawkey (substring arg 0 key-end)) - + (key (if prefix (concat prefix rawkey) rawkey)) (sortkey (downcase key)) - (showkey (mapconcat 'identity + (showkey (mapconcat 'identity (split-string key reftex-index-level-re) " ! "))) (goto-char end-of-args) ;; 0 1 2 3 4 5 6 7 8 9 (list 'index index-tag context file bom arg key showkey sortkey key-end)))) - + (defun reftex-short-context (env parse &optional bound derive) ;; Get about one line of useful context for the label definition at point. @@ -608,7 +611,7 @@ of master file." ((match-end 10) ;; Index entry (when reftex-support-index - (let* ((index-info (save-excursion + (let* ((index-info (save-excursion (reftex-index-info-safe nil))) (list (member (list 'bof (buffer-file-name)) docstruct)) @@ -618,7 +621,7 @@ of master file." ;; Check all index entries with equal text (while (and list (not (eq endelt (car list)))) (when (and (eq (car (car list)) 'index) - (string= (nth 2 index-info) + (string= (nth 2 index-info) (nth 2 (car list)))) (incf n) (setq dist (abs (- (point) (nth 4 (car list))))) @@ -691,7 +694,7 @@ of master file." level (nth 5 entry)) ;; Insert the section info (push entry (cdr tail)) - + ;; We are done unless we use section numbers (unless (nth 1 reftex-label-menu-flags) (throw 'exit nil)) @@ -722,7 +725,7 @@ of master file." (setq entry (reftex-index-info-safe buffer-file-name)) ;; FIXME: (add-to-list 'index-tags (nth 1 index-entry)) (push entry (cdr tail)))))))))) - + (error nil)) ) @@ -875,7 +878,7 @@ of master file." reftex-special-env-parsers)) specials rtn) ;; Call all functions - (setq specials (mapcar + (setq specials (mapcar (lambda (fun) (save-excursion (setq rtn (and fun (funcall fun bound))) @@ -885,7 +888,7 @@ of master file." (setq specials (delq nil specials)) ;; Sort (setq specials (sort specials (lambda (a b) (> (cdr a) (cdr b))))) - (if (eq which t) + (if (eq which t) specials (car specials)))))) @@ -923,9 +926,9 @@ of master file." ;; Do the real thing. (let ((cnt 1)) - + (when (reftex-move-to-next-arg) - + (while (< cnt n) (while (and (member cnt opt-args) (eq (following-char) ?\{)) @@ -950,7 +953,7 @@ of master file." (condition-case nil (while (memq (following-char) '(?\[ ?\{)) (forward-list 1)) - (error nil))) + (error nil))) (defun reftex-context-substring (&optional to-end) ;; Return up to 150 chars from point @@ -979,7 +982,7 @@ of master file." (error (point-max)))))) (t ;; no list - just grab 150 characters - (buffer-substring-no-properties (point) + (buffer-substring-no-properties (point) (min (+ (point) 150) (point-max)))))) ;; Variable holding the vector with section numbers @@ -1016,7 +1019,7 @@ of master file." ;; not included in the numbering of other sectioning levels. (when level (when (and (> level -1) (not star)) - (aset reftex-section-numbers + (aset reftex-section-numbers level (1+ (aref reftex-section-numbers level)))) (setq idx (1+ level)) (when (not star) @@ -1042,7 +1045,7 @@ of master file." (setq string (replace-match "" nil nil string))) (if (and appendix (string-match "\\`[0-9]+" string)) - (setq string + (setq string (concat (char-to-string (1- (+ ?A (string-to-number (match-string 0 string))))) diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 9ed5309bb53..c1ce950522c 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -2800,7 +2800,7 @@ details check the Rst Faces Defaults group." rst-level-face-base-color (+ (* (1- i) rst-level-face-step-light) rst-level-face-base-light)))) - (unless (boundp sym) + (unless (facep sym) (make-empty-face sym) (set-face-doc-string sym doc) (set-face-background sym col) diff --git a/lisp/textmodes/texnfo-upd.el b/lisp/textmodes/texnfo-upd.el index 12a3e2a620b..047bba72ccd 100644 --- a/lisp/textmodes/texnfo-upd.el +++ b/lisp/textmodes/texnfo-upd.el @@ -687,7 +687,7 @@ is the menu entry name, and the cdr of P is the node name." (insert (format "%s: %s." (car node-part) (cdr node-part))))) ;; Insert the description, if present. - (when (cdr menu) + (when (> (length (cdr menu)) 0) ;; Move to right place. (indent-to texinfo-column-for-description 2) ;; Insert description. diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 8f797d13103..a7ff23949fe 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -235,7 +235,7 @@ a symbol as a valid THING." "A regular expression probably matching the host and filename or e-mail part of a URL.") (defvar thing-at-point-short-url-regexp - (concat "[-A-Za-z0-9.]+" thing-at-point-url-path-regexp) + (concat "[-A-Za-z0-9]+\\.[-A-Za-z0-9.]+" thing-at-point-url-path-regexp) "A regular expression probably matching a URL without an access scheme. Hostname matching is stricter in this case than for ``thing-at-point-url-regexp''.") diff --git a/lisp/type-break.el b/lisp/type-break.el index 58022ef8813..d276e64f6db 100644 --- a/lisp/type-break.el +++ b/lisp/type-break.el @@ -47,7 +47,7 @@ ;; or set the variable of the same name to `t'. ;; This program can truly cons up a storm because of all the calls to -;; `current-time' (which always returns 3 fresh conses). I'm dismayed by +;; `current-time' (which always returns fresh conses). I'm dismayed by ;; this, but I think the health of my hands is far more important than a ;; few pages of virtual memory. @@ -501,12 +501,9 @@ variable of the same name." (defun timep (time) "If TIME is in the format returned by `current-time' then return TIME, else return nil." - (and (listp time) - (eq (length time) 3) - (integerp (car time)) - (integerp (nth 1 time)) - (integerp (nth 2 time)) - time)) + (condition-case nil + (and (float-time time) time) + (error nil))) (defun type-break-choose-file () "Return file to read from." @@ -993,12 +990,8 @@ FRAC should be the inverse of the fractional value; for example, a value of ;; Compute the difference, in seconds, between a and b, two structures ;; similar to those returned by `current-time'. -;; Use addition rather than logand since that is more robust; the low 16 -;; bits of the seconds might have been incremented, making it more than 16 -;; bits wide. (defun type-break-time-difference (a b) - (+ (lsh (- (car b) (car a)) 16) - (- (car (cdr b)) (car (cdr a))))) + (round (float-time (time-subtract b a)))) ;; Return (in a new list the same in structure to that returned by ;; `current-time') the sum of the arguments. Each argument may be a time @@ -1008,34 +1001,11 @@ FRAC should be the inverse of the fractional value; for example, a value of ;; the result is passed to `current-time-string' it will toss some of the ;; "low" bits and format the time incorrectly. (defun type-break-time-sum (&rest tmlist) - (let ((high 0) - (low 0) - (micro 0) - tem) - (while tmlist - (setq tem (car tmlist)) - (setq tmlist (cdr tmlist)) - (cond - ((numberp tem) - (setq low (+ low tem))) - (t - (setq high (+ high (or (car tem) 0))) - (setq low (+ low (or (car (cdr tem)) 0))) - (setq micro (+ micro (or (car (cdr (cdr tem))) 0)))))) - - (and (>= micro 1000000) - (progn - (setq tem (/ micro 1000000)) - (setq low (+ low tem)) - (setq micro (- micro (* tem 1000000))))) - - (setq tem (lsh low -16)) - (and (> tem 0) - (progn - (setq low (logand low 65535)) - (setq high (+ high tem)))) - - (list high low micro))) + (let ((sum '(0 0 0))) + (dolist (tem tmlist sum) + (setq sum (time-add sum (if (integerp tem) + (list (floor tem 65536) (mod tem 65536)) + tem)))))) (defun type-break-time-stamp (&optional when) (if (fboundp 'format-time-string) diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 9f7ad1c1ca5..80b970ac02f 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,18 @@ +2011-07-06 Nick Dokos <nicholas.dokos@hp.com> (tiny change) + + * url-cache.el (url-cache-extract): Set buffer multibyte flag to + nil (bug#8827). + +2011-07-03 Nicolas Avrutin <nicolasavru@gmail.com> (tiny change) + + * url-http.el (url-http-create-request): Remove double carriage + return and newline (bug#8931). + +2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * url-http.el (url-http-wait-for-headers-change-function): Remove + pointless "HTTP/0.9 How I hate thee!" message (bug#6735). + 2011-06-04 Andreas Schwab <schwab@linux-m68k.org> * url-future.el (url-future-test): Fix scope of `saver'. diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el index 1615920e64c..80d77020456 100644 --- a/lisp/url/url-cache.el +++ b/lisp/url/url-cache.el @@ -192,6 +192,7 @@ Very fast if you have an `md5' primitive function, suitably fast otherwise." (defun url-cache-extract (fnam) "Extract FNAM from the local disk cache." (erase-buffer) + (set-buffer-multibyte nil) (insert-file-contents-literally fnam)) (defun url-cache-expired (url &optional expire-time) diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 28071e7165a..7e8b0d958cc 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -338,7 +338,7 @@ request.") ;; End request "\r\n" ;; Any data - url-http-data "\r\n")) + url-http-data)) "")) (url-http-debug "Request is: \n%s" request) request)) @@ -1059,19 +1059,16 @@ the end of the document." ;; Haven't seen the end of the headers yet, need to wait ;; for more data to arrive. nil - (if old-http - (message "HTTP/0.9 How I hate thee!") - (progn - (url-http-parse-response) - (mail-narrow-to-head) - ;;(narrow-to-region (point-min) url-http-end-of-headers) - (setq url-http-transfer-encoding (mail-fetch-field - "transfer-encoding") - url-http-content-type (mail-fetch-field "content-type")) - (if (mail-fetch-field "content-length") - (setq url-http-content-length - (string-to-number (mail-fetch-field "content-length")))) - (widen))) + (unless old-http + (url-http-parse-response) + (mail-narrow-to-head) + (setq url-http-transfer-encoding (mail-fetch-field + "transfer-encoding") + url-http-content-type (mail-fetch-field "content-type")) + (if (mail-fetch-field "content-length") + (setq url-http-content-length + (string-to-number (mail-fetch-field "content-length")))) + (widen)) (when url-http-transfer-encoding (setq url-http-transfer-encoding (downcase url-http-transfer-encoding))) diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index 40ffea624fb..df6a7e938af 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -4144,15 +4144,9 @@ Mail anyway? (y or n) ") ;; calculate time used by command (defun ediff-calc-command-time () - (let ((end (current-time)) - micro sec) - (setq micro - (if (>= (nth 2 end) (nth 2 ediff-command-begin-time)) - (- (nth 2 end) (nth 2 ediff-command-begin-time)) - (+ (nth 2 end) (- 1000000 (nth 2 ediff-command-begin-time))))) - (setq sec (- (nth 1 end) (nth 1 ediff-command-begin-time))) - (or (equal ediff-command-begin-time '(0 0 0)) - (message "Elapsed time: %d second(s) + %d microsecond(s)" sec micro)))) + (or (equal ediff-command-begin-time '(0 0 0)) + (message "Elapsed time: %g second(s)" + (float-time (time-since ediff-command-begin-time))))) (defsubst ediff-save-time () (setq ediff-command-begin-time (current-time))) diff --git a/lisp/vc/vc-arch.el b/lisp/vc/vc-arch.el index 59cefe047b6..eeac55ac0f8 100644 --- a/lisp/vc/vc-arch.el +++ b/lisp/vc/vc-arch.el @@ -39,7 +39,7 @@ ;; Bugs: -;; - *VC-log*'s initial content lacks the `Summary:' lines. +;; - *vc-log*'s initial content lacks the `Summary:' lines. ;; - All files under the tree are considered as "under Arch's control" ;; without regards to =tagging-method and such. ;; - Files are always considered as `edited'. diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index fa59b7ef19c..0fdb2230af8 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -1172,8 +1172,9 @@ stream. Standard error output is discarded." (eval-and-compile (defconst vc-bzr-revision-keywords - '("revno" "revid" "last" "before" - "tag" "date" "ancestor" "branch" "submit"))) + ;; bzr help revisionspec | sed -ne 's/^\([a-z]*\):$/"\1"/p' | sort -u + '("ancestor" "annotate" "before" "branch" "date" "last" "mainline" "revid" + "revno" "submit" "svn" "tag"))) (defun vc-bzr-revision-completion-table (files) (lexical-let ((files files)) @@ -1211,6 +1212,19 @@ stream. Standard error output is discarded." (push (match-string-no-properties 1) table))) (completion-table-with-context prefix table tag pred action))) + ((string-match "\\`annotate:" string) + (completion-table-with-context + (substring string 0 (match-end 0)) + (apply-partially #'completion-table-with-terminator '(":" . "\\`a\\`") + #'completion-file-name-table) + (substring string (match-end 0)) pred action)) + + ((string-match "\\`date:" string) + (completion-table-with-context + (substring string 0 (match-end 0)) + '("yesterday" "today" "tomorrow") + (substring string (match-end 0)) pred action)) + ((string-match "\\`\\([a-z]+\\):" string) ;; no actual completion for the remaining keywords. (completion-table-with-context (substring string 0 (match-end 0)) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 3809b5b4293..e3f3c153043 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -620,7 +620,7 @@ ;; buffer, if one is present, instead of adding to the ChangeLog. ;; ;; - When vc-next-action calls vc-checkin it could pre-fill the -;; *VC-log* buffer with some obvious items: the list of files that +;; *vc-log* buffer with some obvious items: the list of files that ;; were added, the list of files that were removed. If the diff is ;; available, maybe it could even call something like ;; `diff-add-change-log-entries-other-window' to create a detailed @@ -775,6 +775,12 @@ See `run-hooks'." :type 'hook :group 'vc) +(defcustom vc-revert-show-diff t + "If non-nil, `vc-revert' shows a `vc-diff' buffer before querying." + :type 'boolean + :group 'vc + :version "24.1") + ;; Header-insertion hair (defcustom vc-static-header-alist @@ -1408,7 +1414,7 @@ Runs the normal hooks `vc-before-checkin-hook' and `vc-checkin-hook'." (vc-start-logentry files comment initial-contents "Enter a change comment." - "*VC-log*" + "*vc-log*" (lambda () (vc-call-backend backend 'log-edit-mode)) (lexical-let ((rev rev)) @@ -1534,10 +1540,13 @@ to override the value of `vc-diff-switches' and `diff-switches'." (defvar vc-diff-added-files nil "If non-nil, diff added files by comparing them to /dev/null.") -(defun vc-diff-internal (async vc-fileset rev1 rev2 &optional verbose) +(defun vc-diff-internal (async vc-fileset rev1 rev2 &optional verbose buffer) "Report diffs between two revisions of a fileset. -Diff output goes to the *vc-diff* buffer. The function -returns t if the buffer had changes, nil otherwise." +Output goes to the buffer BUFFER, which defaults to *vc-diff*. +BUFFER, if non-nil, should be a buffer or a buffer name. +Return t if the buffer had changes, nil otherwise." + (unless buffer + (setq buffer "*vc-diff*")) (let* ((files (cadr vc-fileset)) (messages (cons (format "Finding changes in %s..." (vc-delistify files)) @@ -1549,7 +1558,7 @@ returns t if the buffer had changes, nil otherwise." ;; be to call the back end separately for each file. (coding-system-for-read (if files (vc-coding-system-for-diff (car files)) 'undecided))) - (vc-setup-buffer "*vc-diff*") + (vc-setup-buffer buffer) (message "%s" (car messages)) ;; Many backends don't handle well the case of a file that has been ;; added but not yet committed to the repo (notably CVS and Subversion). @@ -1574,13 +1583,13 @@ returns t if the buffer had changes, nil otherwise." (error "No revisions of %s exist" file) ;; We regard this as "changed". ;; Diff it against /dev/null. - (apply 'vc-do-command "*vc-diff*" + (apply 'vc-do-command buffer 1 "diff" file (append (vc-switches nil 'diff) '("/dev/null")))))) (setq files (nreverse filtered)))) (let ((vc-disable-async-diff (not async))) - (vc-call-backend (car vc-fileset) 'diff files rev1 rev2 "*vc-diff*")) - (set-buffer "*vc-diff*") + (vc-call-backend (car vc-fileset) 'diff files rev1 rev2 buffer)) + (set-buffer buffer) (if (and (zerop (buffer-size)) (not (get-buffer-process (current-buffer)))) ;; Treat this case specially so as not to pop the buffer. @@ -1867,7 +1876,7 @@ The headers are reset to their non-expanded form." (vc-start-logentry files oldcomment t "Enter a replacement change comment." - "*VC-log*" + "*vc-log*" (lambda () (vc-call-backend backend 'log-edit-mode)) (lexical-let ((rev rev)) (lambda (files comment) @@ -2256,11 +2265,12 @@ This asks for confirmation if the buffer contents are not identical to the working revision (except for keyword expansion)." (interactive) (let* ((vc-fileset (vc-deduce-fileset)) - (files (cadr vc-fileset))) - ;; If any of the files is visited by the current buffer, make - ;; sure buffer is saved. If the user says `no', abort since - ;; we cannot show the changes and ask for confirmation to - ;; discard them. + (files (cadr vc-fileset)) + (queried nil) + diff-buffer) + ;; If any of the files is visited by the current buffer, make sure + ;; buffer is saved. If the user says `no', abort since we cannot + ;; show the changes and ask for confirmation to discard them. (when (or (not files) (memq (buffer-file-name) files)) (vc-buffer-sync nil)) (dolist (file files) @@ -2268,20 +2278,29 @@ to the working revision (except for keyword expansion)." (when (and buf (buffer-modified-p buf)) (error "Please kill or save all modified buffers before reverting"))) (when (vc-up-to-date-p file) - (unless (yes-or-no-p (format "%s seems up-to-date. Revert anyway? " file)) + (if (yes-or-no-p (format "%s seems up-to-date. Revert anyway? " file)) + (setq queried t) (error "Revert canceled")))) - (when (vc-diff-internal vc-allow-async-revert vc-fileset nil nil) - (unless (yes-or-no-p - (format "Discard changes in %s? " - (let ((str (vc-delistify files)) - (nfiles (length files))) - (if (< (length str) 50) - str - (format "%d file%s" nfiles - (if (= nfiles 1) "" "s")))))) - (error "Revert canceled")) - (delete-windows-on "*vc-diff*") - (kill-buffer "*vc-diff*")) + (unwind-protect + (when (if vc-revert-show-diff + (progn + (setq diff-buffer (generate-new-buffer-name "*vc-diff*")) + (vc-diff-internal vc-allow-async-revert vc-fileset + nil nil nil diff-buffer)) + ;; Avoid querying the user again. + (null queried)) + (unless (yes-or-no-p + (format "Discard changes in %s? " + (let ((str (vc-delistify files)) + (nfiles (length files))) + (if (< (length str) 50) + str + (format "%d file%s" nfiles + (if (= nfiles 1) "" "s")))))) + (error "Revert canceled"))) + (when diff-buffer + (delete-windows-on diff-buffer) + (kill-buffer diff-buffer))) (dolist (file files) (message "Reverting %s..." (vc-delistify files)) (vc-revert-file file) diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index a002a63e3f8..cb21d4b08c0 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el @@ -335,6 +335,8 @@ This function is provided for backward compatibility, since (global-set-key [lwindow] 'ignore) (global-set-key [rwindow] 'ignore) +(defvar w32-charset-info-alist) ; w32font.c + (defun w32-add-charset-info (xlfd-charset windows-charset codepage) "Function to add character sets to display with Windows fonts. Creates entries in `w32-charset-info-alist'. diff --git a/lisp/window.el b/lisp/window.el index ac43fe7703c..2b98630a51e 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -63,25 +63,26 @@ are not altered by this macro (unless they are altered in BODY)." (when (window-live-p save-selected-window-window) (select-window save-selected-window-window 'norecord)))))) -;; The following two functions are like `window-next' and `window-prev' -;; but the WINDOW argument is _not_ optional (so they don't substitute -;; the selected window for nil), and they return nil when WINDOW doesn't -;; have a parent (like a frame's root window or a minibuffer window). +;; The following two functions are like `window-next-sibling' and +;; `window-prev-sibling' but the WINDOW argument is _not_ optional (so +;; they don't substitute the selected window for nil), and they return +;; nil when WINDOW doesn't have a parent (like a frame's root window or +;; a minibuffer window). (defsubst window-right (window) "Return WINDOW's right sibling. Return nil if WINDOW is the root window of its frame. WINDOW can be any window." - (and window (window-parent window) (window-next window))) + (and window (window-parent window) (window-next-sibling window))) (defsubst window-left (window) "Return WINDOW's left sibling. Return nil if WINDOW is the root window of its frame. WINDOW can be any window." - (and window (window-parent window) (window-prev window))) + (and window (window-parent window) (window-prev-sibling window))) (defsubst window-child (window) "Return WINDOW's first child window." - (or (window-vchild window) (window-hchild window))) + (or (window-top-child window) (window-left-child window))) (defun window-child-count (window) "Return number of WINDOW's child windows." @@ -89,14 +90,14 @@ be any window." (when (and (windowp window) (setq window (window-child window))) (while window (setq count (1+ count)) - (setq window (window-next window)))) + (setq window (window-next-sibling window)))) count)) (defun window-last-child (window) "Return last child window of WINDOW." (when (and (windowp window) (setq window (window-child window))) - (while (window-next window) - (setq window (window-next window)))) + (while (window-next-sibling window) + (setq window (window-next-sibling window)))) window) (defsubst window-any-p (object) @@ -105,8 +106,7 @@ be any window." (or (window-buffer object) (window-child object)) t)) -;; The following four functions should probably go to subr.el. -(defsubst normalize-live-buffer (buffer-or-name) +(defsubst window-normalize-buffer (buffer-or-name) "Return buffer specified by BUFFER-OR-NAME. BUFFER-OR-NAME must be either a buffer or a string naming a live buffer and defaults to the current buffer." @@ -121,7 +121,7 @@ buffer and defaults to the current buffer." (t (error "No such buffer %s" buffer-or-name)))) -(defsubst normalize-live-frame (frame) +(defsubst window-normalize-frame (frame) "Return frame specified by FRAME. FRAME must be a live frame and defaults to the selected frame." (if frame @@ -130,7 +130,7 @@ FRAME must be a live frame and defaults to the selected frame." (error "%s is not a live frame" frame)) (selected-frame))) -(defsubst normalize-any-window (window) +(defsubst window-normalize-any-window (window) "Return window specified by WINDOW. WINDOW must be a window that has not been deleted and defaults to the selected window." @@ -140,7 +140,7 @@ the selected window." (error "%s is not a window" window)) (selected-window))) -(defsubst normalize-live-window (window) +(defsubst window-normalize-live-window (window) "Return live window specified by WINDOW. WINDOW must be a live window and defaults to the selected one." (if window @@ -163,13 +163,13 @@ Anything less might crash Emacs.") (defcustom window-min-height 4 "The minimum number of lines of any window. -The value has to accomodate a mode- or header-line if present. A -value less than `window-safe-min-height' is ignored. The value +The value has to accommodate a mode- or header-line if present. +A value less than `window-safe-min-height' is ignored. The value of this variable is honored when windows are resized or split. Applications should never rebind this variable. To resize a window to a height less than the one specified here, an -application should instead call `resize-window' with a non-nil +application should instead call `window-resize' with a non-nil IGNORE argument. In order to have `split-window' make a window shorter, explictly specify the SIZE argument of that function." :type 'integer @@ -189,7 +189,7 @@ split. Applications should never rebind this variable. To resize a window to a width less than the one specified here, an -application should instead call `resize-window' with a non-nil +application should instead call `window-resize' with a non-nil IGNORE argument. In order to have `split-window' make a window narrower, explictly specify the SIZE argument of that function." :type 'integer @@ -201,17 +201,17 @@ narrower, explictly specify the SIZE argument of that function." WINDOW can be any window and defaults to the selected one. Optional argument HORIZONTAL non-nil means return WINDOW's first child if WINDOW is a horizontal combination." - (setq window (normalize-any-window window)) + (setq window (window-normalize-any-window window)) (if horizontal - (window-hchild window) - (window-vchild window))) + (window-left-child window) + (window-top-child window))) (defsubst window-iso-combined-p (&optional window horizontal) "Return non-nil if and only if WINDOW is vertically combined. WINDOW can be any window and defaults to the selected one. Optional argument HORIZONTAL non-nil means return non-nil if and only if WINDOW is horizontally combined." - (setq window (normalize-any-window window)) + (setq window (window-normalize-any-window window)) (let ((parent (window-parent window))) (and parent (window-iso-combination-p parent horizontal)))) @@ -220,7 +220,7 @@ only if WINDOW is horizontally combined." WINDOW can be any window and defaults to the selected one. Optional argument HORIZONTAL non-nil means to return the largest number of horizontally arranged subwindows of WINDOW." - (setq window (normalize-any-window window)) + (setq window (window-normalize-any-window window)) (cond ((window-live-p window) ;; If WINDOW is live, return 1. @@ -258,9 +258,9 @@ number of horizontally arranged subwindows of WINDOW." (funcall proc walk-window-tree-window)) (unless walk-window-tree-buffer (walk-window-tree-1 - proc (window-hchild walk-window-tree-window) any) + proc (window-left-child walk-window-tree-window) any) (walk-window-tree-1 - proc (window-vchild walk-window-tree-window) any)) + proc (window-top-child walk-window-tree-window) any)) (if sub-only (setq walk-window-tree-window nil) (setq walk-window-tree-window @@ -276,7 +276,7 @@ FRAME. This function performs a pre-order, depth-first traversal of the window tree. If PROC changes the window tree, the result is unpredictable." - (let ((walk-window-tree-frame (normalize-live-frame frame))) + (let ((walk-window-tree-frame (window-normalize-frame frame))) (walk-window-tree-1 proc (frame-root-window walk-window-tree-frame) any))) @@ -289,7 +289,7 @@ on all live and internal subwindows of WINDOW. This function performs a pre-order, depth-first traversal of the window tree rooted at WINDOW. If PROC changes that window tree, the result is unpredictable." - (setq window (normalize-any-window window)) + (setq window (window-normalize-any-window window)) (walk-window-tree-1 proc window any t)) (defun windows-with-parameter (parameter &optional value frame any values) @@ -335,14 +335,14 @@ too." "Return root of atomic window WINDOW is a part of. WINDOW can be any window and defaults to the selected one. Return nil if WINDOW is not part of a atomic window." - (setq window (normalize-any-window window)) + (setq window (window-normalize-any-window window)) (let (root) (while (and window (window-parameter window 'window-atom)) (setq root window) (setq window (window-parent window))) root)) -(defun make-window-atom (window) +(defun window-make-atom (window) "Make WINDOW an atomic window. WINDOW must be an internal window. Return WINDOW." (if (not (window-child window)) @@ -375,8 +375,8 @@ WINDOW must be an internal window. Return WINDOW." window t))) ;; Check children. (unless (window-buffer window) - (window-atom-check-1 (window-hchild window)) - (window-atom-check-1 (window-vchild window)))) + (window-atom-check-1 (window-left-child window)) + (window-atom-check-1 (window-top-child window)))) ;; Check right sibling (window-atom-check-1 (window-right window)))) @@ -547,7 +547,7 @@ windows may get as small as `window-safe-min-height' lines and `window-safe-min-width' columns. IGNORE a window means ignore restrictions for that window only." (window-min-size-1 - (normalize-any-window window) horizontal ignore)) + (window-normalize-any-window window) horizontal ignore)) (defun window-min-size-1 (window horizontal ignore) "Internal function of `window-min-size'." @@ -640,7 +640,7 @@ imposed by fixed size windows, `window-min-height' or windows may get as small as `window-safe-min-height' lines and `window-safe-min-width' columns. IGNORE any window means ignore restrictions for that window only." - (setq window (normalize-any-window window)) + (setq window (window-normalize-any-window window)) (cond ((< delta 0) (max (- (window-min-size window horizontal ignore) @@ -658,7 +658,7 @@ restrictions for that window only." "Return t if WINDOW can be resized by DELTA lines. For the meaning of the arguments of this function see the doc-string of `window-sizable'." - (setq window (normalize-any-window window)) + (setq window (window-normalize-any-window window)) (if (> delta 0) (>= (window-sizable window delta horizontal ignore) delta) (<= (window-sizable window delta horizontal ignore) delta))) @@ -706,7 +706,7 @@ If this function returns nil, this does not necessarily mean that WINDOW can be resized in the desired direction. The functions `window-resizable' and `window-resizable-p' will tell that." (window-size-fixed-1 - (normalize-any-window window) horizontal)) + (window-normalize-any-window window) horizontal)) (defun window-min-delta-1 (window delta &optional horizontal ignore trail noup) "Internal function for `window-min-delta'." @@ -772,7 +772,7 @@ tree but try to enlarge windows within WINDOW's combination only. Optional argument NODOWN non-nil means don't check whether WINDOW itself \(and its subwindows) can be shrunk; check only whether at least one other windows can be enlarged appropriately." - (setq window (normalize-any-window window)) + (setq window (window-normalize-any-window window)) (let ((size (window-total-size window horizontal)) (minimum (window-min-size window horizontal ignore))) (cond @@ -854,7 +854,7 @@ WINDOW's combination. Optional argument NODOWN non-nil means do not check whether WINDOW itself \(and its subwindows) can be enlarged; check only whether other windows can be shrunk appropriately." - (setq window (normalize-any-window window)) + (setq window (window-normalize-any-window window)) (if (and (not (window-size-ignore window ignore)) (not nodown) (window-size-fixed-p window horizontal)) ;; With IGNORE and NOWDON nil return zero if WINDOW has fixed @@ -898,7 +898,7 @@ within WINDOW's combination. Optional argument NODOWN non-nil means don't check whether WINDOW and its subwindows can be resized." - (setq window (normalize-any-window window)) + (setq window (window-normalize-any-window window)) (cond ((< delta 0) (max (- (window-min-delta window horizontal ignore trail noup nodown)) @@ -912,7 +912,7 @@ and its subwindows can be resized." "Return t if WINDOW can be resized vertically by DELTA lines. For the meaning of the arguments of this function see the doc-string of `window-resizable'." - (setq window (normalize-any-window window)) + (setq window (window-normalize-any-window window)) (if (> delta 0) (>= (window-resizable window delta horizontal ignore trail noup nodown) delta) @@ -941,7 +941,7 @@ More precisely, return t if and only if the total height of WINDOW equals the total height of the root window of WINDOW's frame. WINDOW can be any window and defaults to the selected one." - (setq window (normalize-any-window window)) + (setq window (window-normalize-any-window window)) (= (window-total-size window) (window-total-size (frame-root-window window)))) @@ -960,7 +960,7 @@ otherwise." More precisely, return t if and only if the total width of WINDOW equals the total width of the root window of WINDOW's frame. WINDOW can be any window and defaults to the selected one." - (setq window (normalize-any-window window)) + (setq window (window-normalize-any-window window)) (= (window-total-size window t) (window-total-size (frame-root-window window) t))) @@ -1001,7 +1001,7 @@ or nil). Unlike `window-scroll-bars', this function reports the scroll bar type actually used, once frame defaults and `scroll-bar-mode' are taken into account." - (setq window (normalize-live-window window)) + (setq window (window-normalize-live-window window)) (let ((vert (nth 2 (window-scroll-bars window))) (hor nil)) (when (or (eq vert t) (eq hor t)) @@ -1076,7 +1076,7 @@ DIRECTION must be one of `above', `below', `left' or `right'. WINDOW must be a live window and defaults to the selected one. IGNORE, when non-nil means a window can be returned even if its `no-other-window' parameter is non-nil." - (setq window (normalize-live-window window)) + (setq window (window-normalize-live-window window)) (unless (memq direction '(above below left right)) (error "Wrong direction %s" direction)) (let* ((frame (window-frame window)) @@ -1231,7 +1231,7 @@ have special meanings: 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 @@ have special meanings: 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 @@ Any other value of ALL-FRAMES means consider all windows on the 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))) @@ -1333,7 +1333,7 @@ non-nil values of ALL-FRAMES have special meanings: Anything else means consider all windows on the selected frame and no others." - (let ((buffer (normalize-live-buffer buffer-or-name)) + (let ((buffer (window-normalize-buffer buffer-or-name)) windows) (dolist (window (window-list-1 (selected-window) minibuf all-frames)) (when (eq (window-buffer window) buffer) @@ -1352,7 +1352,7 @@ meaning of this argument." (length (window-list-1 nil minibuf))) ;;; Resizing windows. -(defun resize-window-reset (&optional frame horizontal) +(defun window--resize-reset (&optional frame horizontal) "Reset resize values for all windows on FRAME. FRAME defaults to the selected frame. @@ -1360,23 +1360,23 @@ This function stores the current value of `window-total-size' applied with argument HORIZONTAL in the new total size of all windows on FRAME. It also resets the new normal size of each of these windows." - (resize-window-reset-1 - (frame-root-window (normalize-live-frame frame)) horizontal)) + (window--resize-reset-1 + (frame-root-window (window-normalize-frame frame)) horizontal)) -(defun resize-window-reset-1 (window horizontal) - "Internal function of `resize-window-reset'." +(defun window--resize-reset-1 (window horizontal) + "Internal function of `window--resize-reset'." ;; Register old size in the new total size. (set-window-new-total window (window-total-size window horizontal)) ;; Reset new normal size. (set-window-new-normal window) (when (window-child window) - (resize-window-reset-1 (window-child window) horizontal)) + (window--resize-reset-1 (window-child window) horizontal)) (when (window-right window) - (resize-window-reset-1 (window-right window) horizontal))) + (window--resize-reset-1 (window-right window) horizontal))) ;; The following routine is used to manually resize the minibuffer ;; window and is currently used, for example, by ispell.el. -(defun resize-mini-window (window delta) +(defun window--resize-mini-window (window delta) "Resize minibuffer window WINDOW by DELTA lines. If WINDOW cannot be resized by DELTA lines make it as large \(or as small) as possible but don't signal an error." @@ -1395,17 +1395,17 @@ as small) as possible but don't signal an error." (setq delta min-delta))) ;; Resize now. - (resize-window-reset frame) + (window--resize-reset frame) ;; Ideally we should be able to resize just the last subwindow of ;; root here. See the comment in `resize-root-window-vertically' ;; for why we do not do that. - (resize-this-window root (- delta) nil nil t) + (window--resize-this-window root (- delta) nil nil t) (set-window-new-total window (+ height delta)) ;; The following routine catches the case where we want to resize ;; a minibuffer-only frame. (resize-mini-window-internal window)))) -(defun resize-window (window delta &optional horizontal ignore) +(defun window-resize (window delta &optional horizontal ignore) "Resize WINDOW vertically by DELTA lines. WINDOW can be an arbitrary window and defaults to the selected one. An attempt to resize the root window of a frame will raise @@ -1431,17 +1431,17 @@ This function resizes other windows proportionally and never deletes any windows. If you want to move only the low (right) edge of WINDOW consider using `adjust-window-trailing-edge' instead." - (setq window (normalize-any-window window)) + (setq window (window-normalize-any-window window)) (let* ((frame (window-frame window)) sibling) (cond ((eq window (frame-root-window frame)) (error "Cannot resize the root window of a frame")) ((window-minibuffer-p window) - (resize-mini-window window delta)) + (window--resize-mini-window window delta)) ((window-resizable-p window delta horizontal ignore) - (resize-window-reset frame horizontal) - (resize-this-window window delta horizontal ignore t) + (window--resize-reset frame horizontal) + (window--resize-this-window window delta horizontal ignore t) (if (and (not (window-splits window)) (window-iso-combined-p window horizontal) (setq sibling (or (window-right window) (window-left window))) @@ -1452,7 +1452,7 @@ instead." (let ((normal-delta (/ (float delta) (window-total-size (window-parent window) horizontal)))) - (resize-this-window sibling (- delta) horizontal nil t) + (window--resize-this-window sibling (- delta) horizontal nil t) (set-window-new-normal window (+ (window-normal-size window horizontal) normal-delta)) @@ -1460,16 +1460,16 @@ instead." sibling (- (window-normal-size sibling horizontal) normal-delta))) ;; Otherwise, resize all other windows in the same combination. - (resize-other-windows window delta horizontal ignore)) - (resize-window-apply frame horizontal)) + (window--resize-siblings window delta horizontal ignore)) + (window-resize-apply frame horizontal)) (t (error "Cannot resize window %s" window))))) -(defsubst resize-subwindows-skip-p (window) +(defsubst window--resize-subwindows-skip-p (window) "Return non-nil if WINDOW shall be skipped by resizing routines." (memq (window-new-normal window) '(ignore stuck skip))) -(defun resize-subwindows-normal (parent horizontal window this-delta &optional trail other-delta) +(defun window--resize-subwindows-normal (parent horizontal window this-delta &optional trail other-delta) "Set the new normal height of subwindows of window PARENT. HORIZONTAL non-nil means set the new normal width of these windows. WINDOW specifies a subwindow of PARENT that has been @@ -1566,7 +1566,7 @@ PARENT in order to resize WINDOW." ;; Don't get larger than 1 or smaller than 0. (min 1.0 (max (- 1.0 sum) 0.0)))))) -(defun resize-subwindows (parent delta &optional horizontal window ignore trail edge) +(defun window--resize-subwindows (parent delta &optional horizontal window ignore trail edge) "Resize subwindows of window PARENT vertically by DELTA lines. PARENT must be a vertically combined internal window. @@ -1602,10 +1602,10 @@ already set by this routine." (setq sub first) (while (and (window-right sub) (or (and (eq trail 'before) - (not (resize-subwindows-skip-p + (not (window--resize-subwindows-skip-p (window-right sub)))) (and (eq trail 'after) - (resize-subwindows-skip-p sub)))) + (window--resize-subwindows-skip-p sub)))) (setq sub (window-right sub))) sub) (if horizontal @@ -1622,7 +1622,8 @@ already set by this routine." (window-sizable-p sub delta horizontal ignore)) ;; Resize only windows adjacent to EDGE. (progn - (resize-this-window sub delta horizontal ignore t trail edge) + (window--resize-this-window + sub delta horizontal ignore t trail edge) (if (and window (eq (window-parent sub) parent)) (progn ;; Assign new normal sizes. @@ -1632,15 +1633,16 @@ already set by this routine." window (- (window-normal-size window horizontal) (- (window-new-normal sub) (window-normal-size sub horizontal))))) - (resize-subwindows-normal parent horizontal sub 0 trail delta)) - ;; Return 'normalized to notify `resize-other-windows' that + (window--resize-subwindows-normal + parent horizontal sub 0 trail delta)) + ;; Return 'normalized to notify `window--resize-siblings' that ;; normal sizes have been already set. 'normalized) ;; Resize all windows proportionally. (setq sub first) (while sub (cond - ((or (resize-subwindows-skip-p sub) + ((or (window--resize-subwindows-skip-p sub) ;; Ignore windows to skip and fixed-size subwindows - in ;; the latter case make it a window to skip. (and (not ignore) @@ -1725,7 +1727,7 @@ already set by this routine." (while sub (when (or (consp (window-new-normal sub)) (numberp (window-new-normal sub))) - ;; Reset new normal size fields so `resize-window-apply' + ;; Reset new normal size fields so `window-resize-apply' ;; won't use them to apply new sizes. (set-window-new-normal sub)) @@ -1737,11 +1739,11 @@ already set by this routine." (unless (and (zerop delta) (not trail)) ;; For the TRAIL non-nil case we have to resize SUB ;; recursively even if it's size does not change. - (resize-this-window + (window--resize-this-window sub delta horizontal ignore nil trail edge)))) (setq sub (window-right sub))))))) -(defun resize-other-windows (window delta &optional horizontal ignore trail edge) +(defun window--resize-siblings (window delta &optional horizontal ignore trail edge) "Resize other windows when WINDOW is resized vertically by DELTA lines. Optional argument HORIZONTAL non-nil means resize other windows when WINDOW is resized horizontally by DELTA columns. WINDOW @@ -1813,17 +1815,19 @@ preferably only resize windows adjacent to EDGE." (if (zerop this-delta) ;; We haven't got anything from WINDOW's siblings but we ;; must update the normal sizes to respect other-delta. - (resize-subwindows-normal + (window--resize-subwindows-normal parent horizontal window this-delta trail other-delta) ;; We did get something from WINDOW's siblings which means ;; we have to resize their subwindows. - (unless (eq (resize-subwindows parent (- this-delta) horizontal - window ignore trail edge) - ;; `resize-subwindows' returning 'normalized, - ;; means it has set the normal sizes already. + (unless (eq (window--resize-subwindows + parent (- this-delta) horizontal + window ignore trail edge) + ;; If `window--resize-subwindows' returns + ;; 'normalized, this means it has set the + ;; normal sizes already. 'normalized) ;; Set the normal sizes. - (resize-subwindows-normal + (window--resize-subwindows-normal parent horizontal window this-delta trail other-delta)) ;; Set DELTA to what we still have to get from ancestor ;; windows. @@ -1834,14 +1838,15 @@ preferably only resize windows adjacent to EDGE." (set-window-new-total parent delta 'add) (while sub (unless (eq sub window) - (resize-this-window sub delta horizontal ignore t)) + (window--resize-this-window sub delta horizontal ignore t)) (setq sub (window-right sub)))) (unless (zerop delta) ;; "Go up." - (resize-other-windows parent delta horizontal ignore trail edge))))) + (window--resize-siblings + parent delta horizontal ignore trail edge))))) -(defun resize-this-window (window delta &optional horizontal ignore add trail edge) +(defun window--resize-this-window (window delta &optional horizontal ignore add trail edge) "Resize WINDOW vertically by DELTA lines. Optional argument HORIZONTAL non-nil means resize WINDOW horizontally by DELTA columns. @@ -1866,7 +1871,7 @@ This function recursively resizes WINDOW's subwindows to fit the new size. Make sure that WINDOW is `window-resizable' before calling this function. Note that this function does not resize siblings of WINDOW or WINDOW's parent window. You have to -eventually call `resize-window-apply' in order to make resizing +eventually call `window-resize-apply' in order to make resizing actually take effect." (when add ;; Add DELTA to the new total size of WINDOW. @@ -1878,14 +1883,16 @@ actually take effect." ((window-iso-combined-p sub horizontal) ;; In an iso-combination resize subwindows according to their ;; normal sizes. - (resize-subwindows window delta horizontal nil ignore trail edge)) + (window--resize-subwindows + window delta horizontal nil ignore trail edge)) ;; In an ortho-combination resize each subwindow by DELTA. (t (while sub - (resize-this-window sub delta horizontal ignore t trail edge) + (window--resize-this-window + sub delta horizontal ignore t trail edge) (setq sub (window-right sub))))))) -(defun resize-root-window (window delta horizontal ignore) +(defun window--resize-root-window (window delta horizontal ignore) "Resize root window WINDOW vertically by DELTA lines. HORIZONTAL non-nil means resize root window WINDOW horizontally by DELTA columns. @@ -1897,10 +1904,10 @@ This function is only called by the frame resizing routines. It resizes windows proportionally and never deletes any windows." (when (and (windowp window) (numberp delta) (window-sizable-p window delta horizontal ignore)) - (resize-window-reset (window-frame window) horizontal) - (resize-this-window window delta horizontal ignore t))) + (window--resize-reset (window-frame window) horizontal) + (window--resize-this-window window delta horizontal ignore t))) -(defun resize-root-window-vertically (window delta) +(defun window--resize-root-window-vertically (window delta) "Resize root window WINDOW vertically by DELTA lines. If DELTA is less than zero and we can't shrink WINDOW by DELTA lines, shrink it as much as possible. If DELTA is greater than @@ -1921,7 +1928,7 @@ any windows." (unless (window-sizable window delta) (setq ignore t)))) - (resize-window-reset (window-frame window)) + (window--resize-reset (window-frame window)) ;; Ideally, we would resize just the last window in a combination ;; but that's not feasible for the following reason: If we grow ;; the minibuffer window and the last window cannot be shrunk any @@ -1931,7 +1938,7 @@ any windows." ;; So, in practice, we'd need a history variable to record how to ;; proceed. But I'm not sure how such a variable could work with ;; repeated minibuffer window growing steps. - (resize-this-window window delta nil ignore t) + (window--resize-this-window window delta nil ignore t) delta))) (defun adjust-window-trailing-edge (window delta &optional horizontal) @@ -1943,7 +1950,7 @@ If DELTA is greater zero, then move the edge downwards or to the right. If DELTA is less than zero, move the edge upwards or to the left. If the edge can't be moved by DELTA lines or columns, move it as far as possible in the desired direction." - (setq window (normalize-any-window window)) + (setq window (window-normalize-any-window window)) (let ((frame (window-frame window)) (right window) left this-delta min-delta max-delta failed) @@ -1954,7 +1961,7 @@ move it as far as possible in the desired direction." (cond ((and (not right) (not horizontal) (not resize-mini-windows) (eq (window-frame (minibuffer-window frame)) frame)) - (resize-mini-window (minibuffer-window frame) (- delta))) + (window--resize-mini-window (minibuffer-window frame) (- delta))) ((or (not (setq left right)) (not (setq right (window-right right)))) (if horizontal (error "No window on the right of this one") @@ -1999,17 +2006,17 @@ move it as far as possible in the desired direction." (setq delta (min max-delta (- min-delta)))) (unless (zerop delta) ;; Start resizing. - (resize-window-reset frame horizontal) + (window--resize-reset frame horizontal) ;; Try to enlarge LEFT first. (setq this-delta (window-resizable left delta horizontal)) (unless (zerop this-delta) - (resize-this-window + (window--resize-this-window left this-delta horizontal nil t 'before (if horizontal (+ (window-left-column left) (window-total-size left t)) (+ (window-top-line left) (window-total-size left))))) ;; Shrink windows on right of LEFT. - (resize-other-windows + (window--resize-siblings left delta horizontal nil 'after (if horizontal (window-left-column right) @@ -2022,24 +2029,24 @@ move it as far as possible in the desired direction." (setq delta (max (- max-delta) min-delta))) (unless (zerop delta) ;; Start resizing. - (resize-window-reset frame horizontal) + (window--resize-reset frame horizontal) ;; Try to enlarge RIGHT. (setq this-delta (window-resizable right (- delta) horizontal)) (unless (zerop this-delta) - (resize-this-window + (window--resize-this-window right this-delta horizontal nil t 'after (if horizontal (window-left-column right) (window-top-line right)))) ;; Shrink windows on left of RIGHT. - (resize-other-windows + (window--resize-siblings right (- delta) horizontal nil 'before (if horizontal (+ (window-left-column left) (window-total-size left t)) (+ (window-top-line left) (window-total-size left))))))) (unless (zerop delta) ;; Don't report an error in the standard case. - (unless (resize-window-apply frame horizontal) + (unless (window-resize-apply frame horizontal) ;; But do report an error if applying the changes fails. (error "Failed adjusting window %s" window))))))) @@ -2056,9 +2063,9 @@ Return nil." ((window-size-fixed-p nil horizontal) (error "Selected window has fixed size")) ((window-resizable-p nil delta horizontal) - (resize-window nil delta horizontal)) + (window-resize nil delta horizontal)) (t - (resize-window + (window-resize nil (if (> delta 0) (window-max-delta nil horizontal) (- (window-min-delta nil horizontal))) @@ -2077,9 +2084,9 @@ Return nil." ((window-size-fixed-p nil horizontal) (error "Selected window has fixed size")) ((window-resizable-p nil (- delta) horizontal) - (resize-window nil (- delta) horizontal)) + (window-resize nil (- delta) horizontal)) (t - (resize-window + (window-resize nil (if (> delta 0) (- (window-min-delta nil horizontal)) (window-max-delta nil horizontal)) @@ -2090,18 +2097,18 @@ Return nil." Make WINDOW as large as possible without deleting any windows. WINDOW can be any window and defaults to the selected window." (interactive) - (setq window (normalize-any-window window)) - (resize-window window (window-max-delta window)) - (resize-window window (window-max-delta window t) t)) + (setq window (window-normalize-any-window window)) + (window-resize window (window-max-delta window)) + (window-resize window (window-max-delta window t) t)) (defun minimize-window (&optional window) "Minimize WINDOW. Make WINDOW as small as possible without deleting any windows. WINDOW can be any window and defaults to the selected window." (interactive) - (setq window (normalize-any-window window)) - (resize-window window (- (window-min-delta window))) - (resize-window window (- (window-min-delta window t)) t)) + (setq window (window-normalize-any-window window)) + (window-resize window (- (window-min-delta window))) + (window-resize window (- (window-min-delta window t)) t)) (defsubst frame-root-window-p (window) "Return non-nil if WINDOW is the root window of its frame." @@ -2119,15 +2126,15 @@ return value." (setq list (cons (cond - ((window-vchild window) + ((window-top-child window) (cons t (cons (window-edges window) - (window-tree-1 (window-vchild window) t)))) - ((window-hchild window) + (window-tree-1 (window-top-child window) t)))) + ((window-left-child window) (cons nil (cons (window-edges window) - (window-tree-1 (window-hchild window) t)))) + (window-tree-1 (window-left-child window) t)))) (t window)) list)) - (setq window (when next (window-next window)))) + (setq window (when next (window-next-sibling window)))) (nreverse list))) (defun window-tree (&optional frame) @@ -2145,7 +2152,7 @@ and the rest of the elements are the subwindows in the split. Each of the subwindows may again be a window or a list representing a window split, and so on. EDGES is a list \(LEFT TOP RIGHT BOTTOM) as returned by `window-edges'." - (setq frame (normalize-live-frame frame)) + (setq frame (window-normalize-frame frame)) (window-tree-1 (frame-root-window frame) t)) (defun other-window (count &optional all-frames) @@ -2277,7 +2284,7 @@ variable are `switch-to-prev-buffer', `delete-windows-on', "Return t if WINDOW can be safely deleted from its frame. Return `frame' if deleting WINDOW should delete its frame instead." - (setq window (normalize-any-window window)) + (setq window (window-normalize-any-window window)) (unless ignore-window-parameters ;; Handle atomicity. (when (window-parameter window 'window-atom) @@ -2335,7 +2342,7 @@ Otherwise, if WINDOW is part of an atomic window, call argument. If WINDOW is the only window on its frame or the last non-side window, signal an error." (interactive) - (setq window (normalize-any-window window)) + (setq window (window-normalize-any-window window)) (let* ((frame (window-frame window)) (function (window-parameter window 'delete-window)) (parent (window-parent window)) @@ -2363,28 +2370,28 @@ non-side window, signal an error." ((not parent) (error "Attempt to delete minibuffer or sole ordinary window"))) - (let* ((horizontal (window-hchild parent)) + (let* ((horizontal (window-left-child parent)) (size (window-total-size window horizontal)) (frame-selected (window-or-subwindow-p (frame-selected-window frame) window)) ;; Emacs 23 preferably gives WINDOW's space to its left ;; sibling. (sibling (or (window-left window) (window-right window)))) - (resize-window-reset frame horizontal) + (window--resize-reset frame horizontal) (cond ((and (not (window-splits window)) sibling (window-sizable-p sibling size)) ;; Resize WINDOW's sibling. - (resize-this-window sibling size horizontal nil t) + (window--resize-this-window sibling size horizontal nil t) (set-window-new-normal sibling (+ (window-normal-size sibling horizontal) (window-normal-size window horizontal)))) ((window-resizable-p window (- size) horizontal nil nil nil t) ;; Can do without resizing fixed-size windows. - (resize-other-windows window (- size) horizontal)) + (window--resize-siblings window (- size) horizontal)) (t ;; Can't do without resizing fixed-size windows. - (resize-other-windows window (- size) horizontal t))) + (window--resize-siblings window (- size) horizontal t))) ;; Actually delete WINDOW. (delete-window-internal window) (when (and frame-selected @@ -2416,7 +2423,7 @@ WINDOW is a non-side window, make WINDOW the only non-side window on the frame. Side windows are not deleted. If WINDOW is a side window signal an error." (interactive) - (setq window (normalize-any-window window)) + (setq window (window-normalize-any-window window)) (let* ((frame (window-frame window)) (function (window-parameter window 'delete-other-windows)) (window-side (window-parameter window 'window-side)) @@ -2498,7 +2505,7 @@ This may be a useful alternative binding for \\[delete-other-windows] (defun record-window-buffer (&optional window) "Record WINDOW's buffer. WINDOW must be a live window and defaults to the selected one." - (let* ((window (normalize-live-window window)) + (let* ((window (window-normalize-live-window window)) (buffer (window-buffer window)) (entry (assq buffer (window-prev-buffers window)))) ;; Reset WINDOW's next buffers. If needed, they are resurrected by @@ -2534,7 +2541,7 @@ WINDOW must be a live window and defaults to the selected one." WINDOW must be a live window and defaults to the selected one. BUFFER must be a live buffer and defaults to the buffer of WINDOW." - (let* ((window (normalize-live-window window)) + (let* ((window (window-normalize-live-window window)) (buffer (or buffer (window-buffer window)))) (set-window-prev-buffers window (assq-delete-all buffer (window-prev-buffers window))) @@ -2569,7 +2576,7 @@ Optional argument BURY-OR-KILL non-nil means the buffer currently shown in WINDOW is about to be buried or killed and consequently shall not be switched to in future invocations of this command." (interactive) - (let* ((window (normalize-live-window window)) + (let* ((window (window-normalize-live-window window)) (old-buffer (window-buffer window)) ;; Save this since it's destroyed by `set-window-buffer'. (next-buffers (window-next-buffers window)) @@ -2671,7 +2678,7 @@ shall not be switched to in future invocations of this command." "In WINDOW switch to next buffer. WINDOW must be a live window and defaults to the selected one." (interactive) - (let* ((window (normalize-live-window window)) + (let* ((window (window-normalize-live-window window)) (old-buffer (window-buffer window)) (next-buffers (window-next-buffers window)) new-buffer entry killed-buffers visible) @@ -2785,7 +2792,7 @@ current buffer. Also, if BUFFER-OR-NAME is nil or omitted, remove the current buffer from the selected window if it is displayed there." (interactive) - (let* ((buffer (normalize-live-buffer buffer-or-name))) + (let* ((buffer (window-normalize-buffer buffer-or-name))) ;; If `buffer-or-name' is not on the selected frame we unrecord it ;; although it's not "here" (call it a feature). (unrecord-buffer buffer) @@ -2795,7 +2802,9 @@ displayed there." ((or buffer-or-name (not (eq buffer (window-buffer))))) ((not (window-dedicated-p)) (switch-to-prev-buffer nil 'bury)) - ((frame-root-window-p (selected-window)) + ((and (frame-root-window-p (selected-window)) + ;; Don't iconify if it's the only frame. + (not (eq (next-frame nil 0) (selected-frame)))) (iconify-frame (window-frame (selected-window)))) ((window-deletable-p) (delete-window))) @@ -2842,7 +2851,7 @@ When a window showing BUFFER-OR-NAME is dedicated and the only window of its frame, that frame is deleted when there are other frames left." (interactive "BDelete windows on (buffer):\nP") - (let ((buffer (normalize-live-buffer buffer-or-name)) + (let ((buffer (window-normalize-buffer buffer-or-name)) ;; Handle the "inverted" meaning of the FRAME argument wrt other ;; `window-list-1' based function. (all-frames (cond ((not frame) t) ((eq frame t) nil) (t frame)))) @@ -2876,7 +2885,7 @@ left, some other buffer is displayed in that window. This function removes the buffer denoted by BUFFER-OR-NAME from all window-local buffer lists." - (let ((buffer (normalize-live-buffer buffer-or-name))) + (let ((buffer (window-normalize-buffer buffer-or-name))) (dolist (window (window-list-1 nil nil t)) (if (eq (window-buffer window) buffer) (let ((deletable (window-deletable-p window))) @@ -2909,7 +2918,7 @@ Optional argument KILL non-nil means in addition kill WINDOW's buffer. If KILL is nil, put WINDOW's buffer at the end of the buffer list. Interactively, KILL is the prefix argument." (interactive "i\nP") - (setq window (normalize-live-window window)) + (setq window (window-normalize-live-window window)) (let ((buffer (window-buffer window)) (quit-restore (window-parameter window 'quit-restore)) deletable resize) @@ -2944,7 +2953,7 @@ buffer list. Interactively, KILL is the prefix argument." (set-window-start window (nth 1 quit-restore)) (set-window-point window (nth 2 quit-restore)) (when (and resize (/= (nth 4 quit-restore) (window-total-size window))) - (resize-window + (window-resize window (- (nth 4 quit-restore) (window-total-size window)))) ;; Reset the quit-restore parameter. (set-window-parameter window 'quit-restore nil) @@ -3013,7 +3022,7 @@ window, these properties as well as the buffer displayed in the new window are inherited from the window selected on WINDOW's frame. The selected window is not changed by this function." (interactive "i") - (setq window (normalize-any-window window)) + (setq window (window-normalize-any-window window)) (let* ((side (cond ((not side) 'below) ((memq side '(below above right left)) side) @@ -3140,7 +3149,7 @@ frame. The selected window is not changed by this function." ;; SIZE specification violates minimum size restrictions. (error "Window %s too small for splitting" window))) - (resize-window-reset frame horizontal) + (window--resize-reset frame horizontal) (setq new-parent ;; Make new-parent non-nil if we need a new parent window; @@ -3161,7 +3170,7 @@ frame. The selected window is not changed by this function." ;; we won't be able to return space to those windows when we ;; delete the one we create here. Hence we do not go up. (progn - (resize-subwindows parent (- new-size) horizontal) + (window--resize-subwindows parent (- new-size) horizontal) (let* ((normal (- 1.0 new-normal)) (sub (window-child parent))) (while sub @@ -3170,7 +3179,7 @@ frame. The selected window is not changed by this function." (setq sub (window-right sub))))) ;; Get entire space from WINDOW. (set-window-new-total window (- old-size new-size)) - (resize-this-window window (- new-size) horizontal) + (window--resize-this-window window (- new-size) horizontal) (set-window-new-normal window (- (if new-parent 1.0 (window-normal-size window horizontal)) new-normal))) @@ -3286,8 +3295,8 @@ The selected window remains selected. Return the new window." ;;; Balancing windows. ;; The following routine uses the recycled code from an old version of -;; `resize-subwindows'. It's not very pretty, but coding it the way the -;; new `resize-subwindows' code does would hardly make it any shorter or +;; `window--resize-subwindows'. It's not very pretty, but coding it the way the +;; new `window--resize-subwindows' code does would hardly make it any shorter or ;; more readable (FWIW we'd need three loops - one to calculate the ;; minimum sizes per window, one to enlarge or shrink windows until the ;; new parent-size matches, and one where we shrink the largest/enlarge @@ -3316,7 +3325,7 @@ WINDOW must be an iso-combination." (setq sub first) (while (and sub (not failed)) ;; Ignore subwindows that should be ignored or are stuck. - (unless (resize-subwindows-skip-p sub) + (unless (window--resize-subwindows-skip-p sub) (setq found t) (setq sub-total (window-total-size sub horizontal)) (setq sub-delta (- size sub-total)) @@ -3337,7 +3346,7 @@ WINDOW must be an iso-combination." ;; (column) until `rest' is zero. (setq sub first) (while (and sub (> rest 0)) - (unless (resize-subwindows-skip-p window) + (unless (window--resize-subwindows-skip-p window) (set-window-new-total sub 1 t) (setq rest (1- rest))) (setq sub (window-right sub))) @@ -3371,7 +3380,7 @@ WINDOW must be an iso-combination." (balance-windows-2 window horizontal) (let ((size (window-new-total window))) (while sub - (set-window-new-total sub size) + (set-window-new-total sub size) (balance-windows-1 sub horizontal) (setq sub (window-right sub)))))))) @@ -3395,13 +3404,13 @@ window." (error "Not a window or frame %s" window-or-frame)))) (frame (window-frame window))) ;; Balance vertically. - (resize-window-reset (window-frame window)) + (window--resize-reset (window-frame window)) (balance-windows-1 window) - (resize-window-apply frame) + (window-resize-apply frame) ;; Balance horizontally. - (resize-window-reset (window-frame window) t) + (window--resize-reset (window-frame window) t) (balance-windows-1 window t) - (resize-window-apply frame t))) + (window-resize-apply frame t))) (defun window-fixed-size-p (&optional window direction) "Return t if WINDOW cannot be resized in DIRECTION. @@ -3421,13 +3430,13 @@ Changing this globally has no effect.") (make-variable-buffer-local 'window-area-factor) (defun balance-windows-area-adjust (window delta horizontal) - "Wrapper around `resize-window' with error checking. + "Wrapper around `window-resize' with error checking. Arguments WINDOW, DELTA and HORIZONTAL are passed on to that function." - ;; `resize-window' may fail if delta is too large. + ;; `window-resize' may fail if delta is too large. (while (>= (abs delta) 1) (condition-case nil (progn - (resize-window window delta horizontal) + (window-resize window delta horizontal) (setq delta 0)) (error ;;(message "adjust: %s" (error-message-string err)) @@ -3495,7 +3504,7 @@ specific buffers." ;; become significant. (setq carry (+ carry areadiff)) ;; This used `adjust-window-trailing-edge' before and uses - ;; `resize-window' now. Error wrapping is still needed. + ;; `window-resize' now. Error wrapping is still needed. (balance-windows-area-adjust win diff horiz) ;; (sit-for 0.5) (let ((change (cons win (window-edges win)))) @@ -3524,16 +3533,15 @@ specific buffers." "Helper function for `window-state-get'." (let* ((type (cond - ((window-vchild window) 'vc) - ((window-hchild window) 'hc) + ((window-top-child window) 'vc) + ((window-left-child 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)) + (unless (window-next-sibling window) (cons 'last t)) (cons 'total-height (window-total-size window)) (cons 'total-width (window-total-size window t)) (cons 'normal-height (window-normal-size window)) @@ -3545,6 +3553,9 @@ specific buffers." (unless (memq (car parameter) window-state-ignored-parameters) (setq list (cons parameter list)))) + (unless (window-parameter window 'clone-of) + ;; Make a clone-of parameter. + (setq list (cons (cons 'clone-of window) list))) (when list (cons 'parameters list))) (when buffer @@ -3685,13 +3696,10 @@ value can be also stored on disk and read back in a new session." "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. @@ -3720,13 +3728,13 @@ value can be also stored on disk and read back in a new session." (window-total-height window))) window-size-fixed) (when (window-resizable-p window delta) - (resize-window window delta))) + (window-resize 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)))) + (window-resize window delta nil ignore)))) ;; Adjust horizontally. (if (memq window-size-fixed '(t width)) ;; A fixed width window, try to restore the original size. @@ -3734,13 +3742,13 @@ value can be also stored on disk and read back in a new session." (window-total-width window))) window-size-fixed) (when (window-resizable-p window delta) - (resize-window window delta))) + (window-resize 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)))) + (window-resize 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 @@ -3766,7 +3774,7 @@ 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)) + (setq window (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 @@ -3897,7 +3905,7 @@ match occurs in one of the following three cases: Display specifiers are either symbols, cons cells, or lists. Five specifiers have been reserved to indicate the basic method for displaying the buffer: `reuse-window', `pop-up-window', -`pop-up-frame', `use-side-window', and `fun-with-args'. +`pop-up-frame', `use-side-window', and `function'. A list whose car is the symbol `reuse-window' indicates that an existing window shall be reused for displaying the buffer. The @@ -4087,11 +4095,11 @@ The following specifiers are useful in connection with the `pop-up-window-min-height', `pop-up-window-min-width', `pop-up-window-set-height' and `pop-up-window-set-width'. -A list whose car is the symbol `fun-with-args' specifies that the +A list whose car is the symbol `function' specifies that the function specified in the second element of the list is responsible for displaying the buffer. `display-buffer' calls this function with the buffer as first argument and the remaining -elements of the list as second argument. +elements of the list as the second. The function should choose or create a window, display the buffer in it, and return the window. It is also responsible for giving @@ -4182,7 +4190,7 @@ using the location specifiers `same-window' or `other-frame'." :tag "Label" :format "%v" :help-echo "A symbol equalling the buffer display label." - (const :format "" symbol) + (const :format "" label) (symbol :format "Label: %v\n" :size 32)))) ;; Display specifiers. @@ -4225,9 +4233,9 @@ using the location specifiers `same-window' or `other-frame'." :help-echo "Window to reuse." :value nil :format "%[Window%] %v" :size 15 - (const :tag "Any" :format "%t" nil) - (const :tag "Selected only" :format "%t" same) - (const :tag "Any but selected" :format "%t" other)) + (const :tag "Any window" :format "%t" nil) + (const :tag "Same window" :format "%t" same) + (const :tag "Other window" :format "%t" other)) ;; The window's buffer. (choice :tag "Buffer" @@ -4239,15 +4247,15 @@ using the location specifiers `same-window' or `other-frame'." (const :tag "Other buffer" :format "%t" other)) ;; The window's frame. (choice - :help-echo "Frame to search for a window to reuse." + :help-echo "Frames to search for a window to reuse." :tag "Frame" :value nil :format " %[Frame%] %v" :size 15 - (const :tag "Selected frame only" :format "%t" nil) + (const :tag "Same frame only" :format "%t" nil) (const :tag "Visible frames" :format "%t" visible) - (const :tag "Visible but unselected" :format "%t" other) - (const :tag "Visible and iconified" :format "%t" 0) - (const :tag "Any frame" :format "%t" t))) + (const :tag "Any other visible frame" :format "%t" other) + (const :tag "Visible and iconified frames" :format "%t" 0) + (const :tag "All frames" :format "%t" t))) ;; Whether window sizes should be evened out. (cons :format "%v\n" @@ -4513,18 +4521,18 @@ using the location specifiers `same-window' or `other-frame'." ;; Function with argument specifiers. (list :tag "Function with arguments" - :value (fun-with-args (fun-with-args 'ignore)) + :value (function (function 'ignore)) :format "%t\n%v" :inline t ;; For customization purposes only. - (const :format "" fun-with-args) + (const :format "" function) (set :format "%v" :inline t (list :format "%v" - :value (fun-with-args 'ignore) - (const :format "" fun-with-args) + :value (function 'ignore) + (const :format "" function) (function :tag "Function" :format "%t: %v\n" :size 25) (list :format "%v" @@ -4537,7 +4545,12 @@ using the location specifiers `same-window' or `other-frame'." ;; Macro specifiers. (list - :tag "Same frame only" + :tag "Same window" + :format "%t%v" + :inline t + (const :format "\n" same-window)) + (list + :tag "Same frame" :format "%t%v" :inline t (const :format "\n" same-frame)) @@ -4552,7 +4565,7 @@ using the location specifiers `same-window' or `other-frame'." :inline t (const :format "\n" same-frame-other-window)) (list - :tag "Other frame only" + :tag "Other frame" :format "%t%v" :inline t (const :format "\n" other-frame)) @@ -4590,9 +4603,9 @@ using the location specifiers `same-window' or `other-frame'." (const :format "" other-window-means-other-frame) (choice :help-echo "Whether other window means same or other frame." - :format "%[Same or other frame%] %v\n" :size 15 - (const :tag "Same frame" :format "%t" nil) - (const :tag "Other frame" :format "%t" t))) + :format "%[Other window means other frame%] %v\n" :size 15 + (const :tag "Off" :format "%t" nil) + (const :tag "On" :format "%t" t))) ;; Overriding. (cons :format "%v\n" @@ -4661,8 +4674,8 @@ larger than WINDOW." ;; Don't resize minibuffer windows. (window-minibuffer-p) ;; WINDOW must be adjacent to the selected one. - (not (or (eq window (window-prev)) - (eq window (window-next)))))) + (not (or (eq window (window-prev-sibling)) + (eq window (window-next-sibling)))))) ((and (window-iso-combined-p window) ;; Resize iff the selected window is higher than WINDOW. (> (window-total-height) (window-total-height window))) @@ -4672,7 +4685,7 @@ larger than WINDOW." ;; WINDOW and the selected one. But for a simple two windows ;; configuration the present behavior is good enough so why care? (ignore-errors - (resize-window + (window-resize window (/ (- (window-total-height) (window-total-height window)) 2)))) ((and (window-iso-combined-p window t) @@ -4681,7 +4694,7 @@ larger than WINDOW." ;; Don't throw an error if we can't even window widths, see ;; comment above. (ignore-errors - (resize-window + (window-resize window (/ (- (window-total-width) (window-total-width window)) 2) t))))) @@ -4700,7 +4713,7 @@ documentation of `display-buffer-alist' for a description." (delta (- height (window-total-size window)))) (when (and (window-resizable-p window delta nil 'safe) (window-iso-combined-p window)) - (resize-window window delta nil 'safe)))) + (window-resize window delta nil 'safe)))) ((functionp set-height) (ignore-errors (funcall set-height window)))))) @@ -4719,7 +4732,7 @@ documentation of `display-buffer-alist' for a description." (delta (- width (window-total-size window t)))) (when (and (window-resizable-p window delta t 'safe) (window-iso-combined-p window t)) - (resize-window window delta t 'safe)))) + (window-resize window delta t 'safe)))) ((functionp set-width) (ignore-errors (funcall set-width window)))))) @@ -4730,14 +4743,16 @@ Return WINDOW. SPECIFIERS must be a list of buffer display specifiers, see the documentation of `display-buffer-alist' for a description." - (setq buffer (normalize-live-buffer buffer)) - (setq window (normalize-live-window window)) + (setq buffer (window-normalize-buffer buffer)) + (setq window (window-normalize-live-window window)) (let* ((old-frame (selected-frame)) (new-frame (window-frame window)) (dedicated (cdr (assq 'dedicated specifiers))) (no-other-window (cdr (assq 'no-other-window specifiers)))) ;; Show BUFFER in WINDOW. - (set-window-dedicated-p window nil) + (unless (eq buffer (window-buffer window)) + ;; If we show another buffer in WINDOW, undedicate it first. + (set-window-dedicated-p window nil)) (set-window-buffer window buffer) (when dedicated (set-window-dedicated-p window dedicated)) @@ -4773,7 +4788,7 @@ none was found." (let* ((method-window (nth 0 method)) (method-buffer (nth 1 method)) (method-frame (nth 2 method)) - (reuse-dedicated (assq 'reuse-window-dedicated specifiers)) + (reuse-dedicated (cdr (assq 'reuse-window-dedicated specifiers))) windows other-frame dedicated time best-window best-time) (when (eq method-frame 'other) ;; `other' is not handled by `window-list-1'. @@ -5012,65 +5027,69 @@ specifiers, see the doc-string of `display-buffer-alist' for a 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. @@ -5160,6 +5179,7 @@ SPECIFIERS must be a list of buffer display specifiers." ;; `major' is the major window on SIDE, `windows' the life ;; windows on SIDE. (windows (when major (windows-with-parameter 'window-side side))) + (reuse-dedicated (cdr (assq 'reuse-window-dedicated specifiers))) (slots (when major (window-child-count major))) (max-slots (nth (cond @@ -5170,7 +5190,7 @@ SPECIFIERS must be a list of buffer display specifiers." window-sides-slots)) (selected-window (selected-window)) window this-window this-slot prev-window next-window - best-window best-slot abs-slot) + best-window best-slot abs-slot dedicated) (unless (numberp slot) (setq slot 0)) @@ -5185,8 +5205,13 @@ SPECIFIERS must be a list of buffer display specifiers." ((not (numberp this-slot))) ((and (= this-slot slot) ;; Dedicatedness check. - (or (not (window-dedicated-p window)) - (assq 'reuse-window-dedicated specifiers))) + (or (not (setq dedicated (window-dedicated-p window))) + ;; If the window is weakly dedicated to its + ;; buffer, reuse-dedicated must be non-nil. + (and (not (eq dedicated t)) reuse-dedicated) + ;; If the window is strongly dedicated to its + ;; buffer, reuse-dedicated must be t. + (eq reuse-dedicated t))) ;; Window with matching SLOT, use it. (setq this-window window) (throw 'found t)) @@ -5269,7 +5294,7 @@ SPECIFIERS must be a list of buffer display specifiers." (set-window-parameter window 'window-slot slot)) (display-buffer-in-window buffer window specifiers))))) -(defun normalize-buffer-to-display (buffer-or-name) +(defun window-normalize-buffer-to-display (buffer-or-name) "Normalize BUFFER-OR-NAME argument for buffer display functions. If BUFFER-OR-NAME is nil, return the curent buffer. Else, if a buffer specified by BUFFER-OR-NAME exists, return that buffer. @@ -5295,54 +5320,79 @@ Optional argument LABEL is like the same argument of The calculation of the return value is exclusively based on the user preferences expressed in `display-buffer-alist'." - (let* ((buffer (normalize-live-buffer buffer-or-name)) + (let* ((buffer (window-normalize-buffer buffer-or-name)) (list (display-buffer-normalize-alist (buffer-name buffer) label)) (value (assq 'other-window-means-other-frame (or (car list) (cdr list))))) (when value (cdr value)))) -(defun display-buffer-normalize-argument (buffer-name specifiers label other-frame) - "Normalize second argument of `display-buffer'. +(defun display-buffer-normalize-arguments (buffer-name specifiers label other-frame) + "Normalize second and third argument of `display-buffer'. 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-window." - (let (normalized entry) +SPECIFIERS is the second argument of `display-buffer'. LABEL is +the same argument of `display-buffer'. OTHER-FRAME non-nil means +use other-frame for other-window." + (let (normalized entry specifier pars) + (setq specifier + (cond + ((not specifiers) + nil) + ((listp specifiers) + ;; If SPECIFIERS is a list, we assume it is a list of specifiers. + (dolist (specifier specifiers) + (cond + ((consp specifier) + (setq normalized (cons specifier normalized))) + ((eq specifier 'other-window) + ;; `other-window' must be treated separately. + (let ((entry (assq (if other-frame + 'other-frame + 'same-frame-other-window) + display-buffer-macro-specifiers))) + (dolist (item (cdr entry)) + (setq normalized (cons item normalized))))) + ((symbolp specifier) + ;; Might be a macro specifier, try to expand it (the cdr is a + ;; list and we have to reverse it later, so do it one at a + ;; time). + (let ((entry (assq specifier display-buffer-macro-specifiers))) + (dolist (item (cdr entry)) + (setq normalized (cons item normalized))))))) + ;; Reverse list. + (nreverse normalized)) + ((setq entry (assq specifiers display-buffer-macro-specifiers)) + ;; A macro specifier. + (cdr entry)) + ((or other-frame (with-no-warnings pop-up-frames)) + ;; `special-display-p' group. + (if (and (with-no-warnings special-display-function) + ;; `special-display-p' returns either t or a list + ;; of frame parameters to pass to + ;; `special-display-function'. + (setq pars (with-no-warnings + (special-display-p buffer-name)))) + (list (list 'function + (with-no-warnings special-display-function) + (when (listp pars) pars))) + ;; Pop up another frame. + (cddr (assq 'other-frame display-buffer-macro-specifiers)))) + (t + ;; In any other case pop up a new window. + (cdr (assq 'same-frame-other-window + display-buffer-macro-specifiers))))) + + ;; Handle the old meaning of the LABEL argument of `display-buffer'. (cond - ((not specifiers) - nil) - ((listp specifiers) - ;; If SPECIFIERS is a list, we assume it is a list of specifiers. - (dolist (specifier specifiers) - (cond - ((consp specifier) - (setq normalized (cons specifier normalized))) - ((eq specifier 'other-window) - ;; `other-window' must be treated separately. - (let ((entry (assq (if other-frame - 'other-frame - 'same-frame-other-window) - display-buffer-macro-specifiers))) - (dolist (item (cdr entry)) - (setq normalized (cons item normalized))))) - ((symbolp specifier) - ;; Might be a macro specifier, try to expand it (the cdr is a - ;; list and we have to reverse it later, so do it one at a - ;; time). - (let ((entry (assq specifier display-buffer-macro-specifiers))) - (dolist (item (cdr entry)) - (setq normalized (cons item normalized))))))) - ;; Reverse list. - (nreverse normalized)) - ((setq entry (assq specifiers display-buffer-macro-specifiers)) - ;; A macro specifier. - (cdr entry)) - ((or other-frame (with-no-warnings pop-up-frames)) - ;; Pop up another frame. - (cdr (assq 'other-frame display-buffer-macro-specifiers))) + ((or (memq label '(visible 0 t)) (frame-live-p label)) + ;; LABEL must be one of visible (and visible frame), 0 (any + ;; visible or iconfied frame), t (any frame), or a live frame. + (cons `(reuse-window nil same ,label) specifier)) + ((or other-frame + (with-no-warnings pop-up-frames) + (with-no-warnings display-buffer-reuse-frames)) + (cons '(reuse-window nil same 0) specifier)) (t - ;; In any other case pop up a new window. - (cdr (assq 'same-frame-other-window display-buffer-macro-specifiers)))))) + specifier)))) (defun display-buffer-normalize-options (buffer-or-name) "Subroutine of `display-buffer-normalize-specifiers'. @@ -5350,7 +5400,7 @@ BUFFER-OR-NAME is the buffer to display. This routine provides a compatibility layer for the now obsolete Emacs 23 buffer display options." (with-no-warnings - (let* ((buffer (normalize-live-buffer buffer-or-name)) + (let* ((buffer (window-normalize-buffer buffer-or-name)) (buffer-name (buffer-name buffer)) (use-pop-up-frames (or (and (eq pop-up-frames 'graphic-only) @@ -5430,7 +5480,7 @@ options." (let ((pars (special-display-p buffer-name))) (when pars (setq specifiers - (cons (list 'fun-with-args special-display-function + (cons (list 'function special-display-function (when (listp pars) pars)) specifiers))))) @@ -5513,7 +5563,7 @@ LABEL the corresponding argument of `display-buffer'." (let* ((specifiers (cdr entry)) (normalized (display-buffer-normalize-alist-1 specifiers label))) - (if (assq 'override specifiers) + (if (cdr (assq 'override specifiers)) (setq list-1 (if list-1 (append list-1 normalized) @@ -5550,13 +5600,13 @@ specifiers: - `display-buffer-default-specifiers'." (let* ((list (display-buffer-normalize-alist buffer-name label)) - (other-frame (assq 'other-window-means-other-frame - (or (car list) (cdr list))))) + (other-frame (cdr (assq 'other-window-means-other-frame + (or (car list) (cdr list)))))) (append ;; Overriding user specifiers. (car list) ;; Application specifiers. - (display-buffer-normalize-argument + (display-buffer-normalize-arguments buffer-name specifiers label other-frame) ;; Emacs 23 compatibility specifiers. (unless display-buffer-normalize-options-inhibit @@ -5572,7 +5622,7 @@ specifiers: (defun display-buffer-frame (&optional frame) "Return FRAME if it is live and not a minibuffer-only frame. Return the value of `last-nonminibuffer-frame' otherwise." - (setq frame (normalize-live-frame frame)) + (setq frame (window-normalize-frame frame)) (if (and (frame-live-p frame) ;; A not very nice way to get that information. (not (window-minibuffer-p (frame-root-window frame)))) @@ -5619,6 +5669,21 @@ override SPECIFIERS by adding an entry to `display-buffer-alist' whose car contains LABEL and whose cdr specifies the preferred alternative display method. +The following values of LABEL have a special meaning and allow to +specify the set of frames to investigate when the buffer already +appears in a window: + +`visible' - the set of visible frames. + +0 - the set of visible or iconified frames. + +t - the set of all frames. + +A live frame - the set containing that frame as its only element. + +If the buffer is already displayed in a window on a frame in the +specified set, return that window. + The method to display the buffer is derived by combining the values of `display-buffer-alist' and SPECIFIERS. Highest priority is given to overriding elements of @@ -5630,9 +5695,9 @@ The result must be a list of valid buffer display specifiers. If `display-buffer-function' is non-nil, call it with the buffer and this list as arguments." (interactive "BDisplay buffer:\nP") - (let* ((buffer (normalize-buffer-to-display buffer-or-name)) + (let* ((buffer (window-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,38 +5711,38 @@ this list as arguments." (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)) - ((eq method 'fun-with-args) - (apply (cadr specifier) buffer (cddr specifier)))))) + buffer (nth 1 specifier) (nth 2 specifier) normalized)) + ((eq method 'function) + (funcall (nth 1 specifier) buffer (nth 2 specifier)))))) ;; If we don't have a window yet, try a fallback method. All ;; specifiers have been used up by now. (or (and (window-live-p window) window) ;; Try reusing a window showing BUFFER on any visible or ;; iconfied frame. - (display-buffer-reuse-window buffer '(nil buffer 0)) + (display-buffer-reuse-window buffer `(nil ,buffer 0)) ;; Try reusing a window not showing BUFFER on any visible or ;; iconified frame. (display-buffer-reuse-window buffer '(nil other 0)) - ;; Try making a new frame. - (display-buffer-pop-up-frame buffer) + ;; Eli says it's better to never try making a new frame. + ;; (display-buffer-pop-up-frame buffer) ;; Try using a weakly dedicated window. (display-buffer-reuse-window buffer '(nil nil t) '((reuse-window-dedicated . weak))) @@ -5685,7 +5750,7 @@ this list as arguments." (display-buffer-reuse-window buffer '(nil nil t) '((reuse-window-dedicated . t))))))) -(defsubst display-buffer-same-window (&optional buffer-or-name label) +(defsubst display-buffer-same-window (&optional buffer-or-name label) "Display buffer specified by BUFFER-OR-NAME in the selected window. Another window will be used only if the buffer can't be shown in the selected window, usually because it is dedicated to another @@ -5694,7 +5759,7 @@ buffer. Optional argument BUFFER-OR-NAME and LABEL are as for (interactive "BDisplay buffer in same window:\nP") (display-buffer buffer-or-name 'same-window label)) -(defsubst display-buffer-same-frame (&optional buffer-or-name label) +(defsubst display-buffer-same-frame (&optional buffer-or-name label) "Display buffer specified by BUFFER-OR-NAME in a window on the same frame. Another frame will be used only if there is no other choice. Optional argument BUFFER-OR-NAME and LABEL are as for @@ -5702,7 +5767,7 @@ Optional argument BUFFER-OR-NAME and LABEL are as for (interactive "BDisplay buffer on same frame:\nP") (display-buffer buffer-or-name 'same-frame label)) -(defsubst display-buffer-other-window (&optional buffer-or-name label) +(defsubst display-buffer-other-window (&optional buffer-or-name label) "Display buffer specified by BUFFER-OR-NAME in another window. The selected window will be used only if there is no other choice. Windows on the selected frame are preferred to windows @@ -5711,7 +5776,7 @@ for `display-buffer'." (interactive "BDisplay buffer in another window:\nP") (display-buffer buffer-or-name 'other-window label)) -(defun display-buffer-same-frame-other-window (&optional buffer-or-name label) +(defun display-buffer-same-frame-other-window (&optional buffer-or-name label) "Display buffer specified by BUFFER-OR-NAME in another window on the same frame. The selected window or another frame will be used only if there is no other choice. Optional argument BUFFER-OR-NAME and LABEL are @@ -5732,37 +5797,36 @@ If this command uses another frame, it will also select that frame." (defun pop-to-buffer (&optional buffer-or-name specifiers norecord label) "Display buffer specified by BUFFER-OR-NAME and select the window used. Optional argument BUFFER-OR-NAME may be a buffer, a string \(a -buffer name), or nil. If BUFFER-OR-NAME is a string not naming -an existent buffer, create a buffer with that name. If +buffer name), or nil. If BUFFER-OR-NAME is a string naming a buffer +that does not exist, create a buffer with that name. If BUFFER-OR-NAME is nil or omitted, display the current buffer. Interactively, prompt for the buffer name using the minibuffer. -Optional second argument SPECIFIERS must be a list of buffer -display specifiers, a single location specifier, `t' which means -the latter means to display the buffer in any but the selected -window, or nil which means to exclusively apply the specifiers -customized by the user. +Optional second argument SPECIFIERS can be: a list of buffer +display specifiers (see `display-buffer-alist'); a single +location specifier; t, which means to display the buffer in any +but the selected window; or nil, which means to exclusively apply +the specifiers customized by the user. See `display-buffer' for +more details. -Optional argument NORECORD non-nil means do not put the buffer -specified by BUFFER-OR-NAME at the front of the buffer list and -do not make the window displaying it the most recently selected -one. +Optional argument NORECORD non-nil means do not put the displayed +buffer at the front of the buffer list, and do not make the window +displaying it the most recently selected one. The optional argument LABEL, if non-nil, is a symbol specifying the display purpose. Applications should set this when the buffer -shall be displayed in a special way but BUFFER-OR-NAME does not +should be displayed in a special way but BUFFER-OR-NAME does not identify the buffer as special. Buffers that typically fit into this category are those whose names have been derived from the name of the file they are visiting. -Return the buffer specified by BUFFER-OR-NAME or nil if -displaying the buffer failed. +Returns the displayed buffer, or nil if displaying the buffer failed. This uses the function `display-buffer' as a subroutine; see the documentations of `display-buffer' and `display-buffer-alist' for additional information." (interactive "BPop to buffer:\nP") - (let ((buffer (normalize-buffer-to-display buffer-or-name)) + (let ((buffer (window-normalize-buffer-to-display buffer-or-name)) (old-window (selected-window)) (old-frame (selected-frame)) new-window new-frame) @@ -5788,7 +5852,7 @@ as for `pop-to-buffer'." (interactive "BPop to buffer in selected window:\nP") (pop-to-buffer buffer-or-name 'same-window norecord label)) -(defsubst pop-to-buffer-same-frame (&optional buffer-or-name norecord label) +(defsubst pop-to-buffer-same-frame (&optional buffer-or-name norecord label) "Pop to buffer specified by BUFFER-OR-NAME in a window on the selected frame. Another frame will be used only if there is no other choice. Optional arguments BUFFER-OR-NAME, NORECORD and LABEL are as for @@ -5805,7 +5869,7 @@ LABEL are as for `pop-to-buffer'." (interactive "BPop to buffer in another window:\nP") (pop-to-buffer buffer-or-name 'other-window norecord)) -(defsubst pop-to-buffer-same-frame-other-window (&optional buffer-or-name norecord label) +(defsubst pop-to-buffer-same-frame-other-window (&optional buffer-or-name norecord label) "Pop to buffer specified by BUFFER-OR-NAME in another window on the selected frame. The selected window or another frame will be used only if there is no other choice. Optional arguments BUFFER-OR-NAME, NORECORD @@ -5844,7 +5908,7 @@ from the list of completions and default values." (read-buffer prompt (other-buffer (current-buffer)) (confirm-nonexistent-file-or-buffer))))) -(defun normalize-buffer-to-switch-to (buffer-or-name) +(defun window-normalize-buffer-to-switch-to (buffer-or-name) "Normalize BUFFER-OR-NAME argument of buffer switching functions. If BUFFER-OR-NAME is nil, return the buffer returned by `other-buffer'. Else, if a buffer specified by BUFFER-OR-NAME @@ -5879,21 +5943,19 @@ This function is intended for interactive use only. Lisp functions should call `pop-to-buffer-same-window' instead." (interactive (list (read-buffer-to-switch "Switch to buffer: "))) - (let ((buffer (normalize-buffer-to-switch-to buffer-or-name))) - (if (and (or (window-minibuffer-p) (eq (window-dedicated-p) t)) - (not (eq buffer (window-buffer)))) - ;; Cannot switch to another buffer in a minibuffer or strongly - ;; dedicated window that does not show the buffer already. Call - ;; `pop-to-buffer' instead. - (pop-to-buffer buffer 'same-window norecord) - (unless (eq buffer (window-buffer)) - ;; I'm not sure why we should NOT call `set-window-buffer' here, - ;; but let's keep things as they are (otherwise we could always - ;; call `pop-to-buffer-same-window' here). - (set-window-buffer nil buffer)) - (unless norecord - (select-window (selected-window))) - (set-buffer buffer)))) + (let ((buffer (window-normalize-buffer-to-switch-to buffer-or-name))) + (cond + ;; Don't call set-window-buffer if it's not needed since it + ;; might signal an error (e.g. if the window is dedicated). + ((eq buffer (window-buffer)) nil) + ((window-minibuffer-p) + (error "Cannot switch buffers in minibuffer window")) + ((eq (window-dedicated-p) t) + (error "Cannot switch buffers in a dedicated window")) + (t (set-window-buffer nil buffer))) + (unless norecord + (select-window (selected-window))) + (set-buffer buffer))) (defun switch-to-buffer-same-frame (buffer-or-name &optional norecord) "Switch to buffer BUFFER-OR-NAME in a window on the selected frame. @@ -5905,7 +5967,7 @@ This function is intended for interactive use only. Lisp functions should call `pop-to-buffer-same-frame' instead." (interactive (list (read-buffer-to-switch "Switch to buffer in other window: "))) - (let ((buffer (normalize-buffer-to-switch-to buffer-or-name))) + (let ((buffer (window-normalize-buffer-to-switch-to buffer-or-name))) (pop-to-buffer buffer 'same-frame norecord))) (defun switch-to-buffer-other-window (buffer-or-name &optional norecord) @@ -5919,7 +5981,7 @@ This function is intended for interactive use only. Lisp functions should call `pop-to-buffer-other-window' instead." (interactive (list (read-buffer-to-switch "Switch to buffer in other window: "))) - (let ((buffer (normalize-buffer-to-switch-to buffer-or-name))) + (let ((buffer (window-normalize-buffer-to-switch-to buffer-or-name))) (pop-to-buffer buffer 'other-window norecord))) (defun switch-to-buffer-other-window-same-frame (buffer-or-name &optional norecord) @@ -5933,7 +5995,7 @@ functions should call `pop-to-buffer-other-window-same-frame' instead." (interactive (list (read-buffer-to-switch "Switch to buffer in other window: "))) - (let ((buffer (normalize-buffer-to-switch-to buffer-or-name))) + (let ((buffer (window-normalize-buffer-to-switch-to buffer-or-name))) (pop-to-buffer buffer 'same-frame-other-window norecord))) (defun switch-to-buffer-other-frame (buffer-or-name &optional norecord) @@ -5946,7 +6008,7 @@ This function is intended for interactive use only. Lisp functions should call `pop-to-buffer-other-frame' instead." (interactive (list (read-buffer-to-switch "Switch to buffer in other frame: "))) - (let ((buffer (normalize-buffer-to-switch-to buffer-or-name))) + (let ((buffer (window-normalize-buffer-to-switch-to buffer-or-name))) (pop-to-buffer buffer 'other-frame norecord))) ;;; Obsolete definitions of `display-buffer' below. @@ -5964,9 +6026,9 @@ ignored. See also `same-window-regexps'." :type '(repeat (string :format "%v")) :group 'windows) -(make-obsolete-variable - 'same-window-buffer-names - "use 2nd arg of `display-buffer' instead." "24.1") +;; (make-obsolete-variable + ;; 'same-window-buffer-names + ;; "use 2nd arg of `display-buffer' instead." "24.1") (defcustom same-window-regexps nil "List of regexps saying which buffers should appear in the \"same\" window. @@ -5982,9 +6044,9 @@ the buffer name. This is for compatibility with See also `same-window-buffer-names'." :type '(repeat (regexp :format "%v")) :group 'windows) -(make-obsolete-variable - 'same-window-regexps - "use 2nd arg of `display-buffer' instead." "24.1") +;; (make-obsolete-variable + ;; 'same-window-regexps + ;; "use 2nd arg of `display-buffer' instead." "24.1") (defun same-window-p (buffer-name) "Return non-nil if a buffer named BUFFER-NAME would be shown in the \"same\" window. @@ -6009,8 +6071,8 @@ selected rather than \(as usual\) some other window. See (and (consp regexp) (stringp (car regexp)) (string-match-p (car regexp) buffer-name))) (throw 'found t)))))))) -(make-obsolete - 'same-window-p "pass argument to buffer display function instead." "24.1") +;; (make-obsolete + ;; 'same-window-p "pass argument to buffer display function instead." "24.1") (defcustom special-display-frame-alist '((height . 14) (width . 80) (unsplittable . t)) @@ -6028,9 +6090,9 @@ These supersede the values given in `default-frame-alist'." (symbol :tag "Parameter") (sexp :tag "Value"))) :group 'frames) -(make-obsolete-variable - 'special-display-frame-alist - "use 2nd arg of `display-buffer' instead." "24.1") +;; (make-obsolete-variable + ;; 'special-display-frame-alist + ;; "use 2nd arg of `display-buffer' instead." "24.1") (defun special-display-popup-frame (buffer &optional args) "Display BUFFER in a special frame and return the window chosen. @@ -6045,7 +6107,7 @@ BUFFER in a window on 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." +and (cdr ARGS) as the rest of the arguments." (if (and args (symbolp (car args))) (apply (car args) buffer (cdr args)) (let ((window (get-buffer-window buffer 0))) @@ -6076,9 +6138,9 @@ and (cdr ARGS) as second." (set-window-buffer (frame-selected-window frame) buffer) (set-window-dedicated-p (frame-selected-window frame) t) (frame-selected-window frame)))))) -(make-obsolete - 'special-display-popup-frame - "use 2nd arg of `display-buffer' instead." "24.1") +;; (make-obsolete + ;; 'special-display-popup-frame + ;; "use 2nd arg of `display-buffer' instead." "24.1") (defcustom special-display-function 'special-display-popup-frame "Function to call for displaying special buffers. @@ -6095,9 +6157,9 @@ A buffer is special when its name is either listed in :type 'function :group 'windows :group 'frames) -(make-obsolete-variable - 'special-display-function - "use 2nd arg of `display-buffer' instead." "24.1") +;; (make-obsolete-variable + ;; 'special-display-function + ;; "use 2nd arg of `display-buffer' instead." "24.1") (defcustom special-display-buffer-names nil "List of names of buffers that should be displayed specially. @@ -6162,9 +6224,9 @@ See also `special-display-regexps'." (repeat :tag "Arguments" (sexp))))) :group 'windows :group 'frames) -(make-obsolete-variable - 'special-display-buffer-names - "use 2nd arg of `display-buffer' instead." "24.1") +;; (make-obsolete-variable + ;; 'special-display-buffer-names + ;; "use 2nd arg of `display-buffer' instead." "24.1") ;;;###autoload (put 'special-display-buffer-names 'risky-local-variable t) @@ -6233,9 +6295,9 @@ See also `special-display-buffer-names'." (repeat :tag "Arguments" (sexp))))) :group 'windows :group 'frames) -(make-obsolete-variable - 'special-display-regexps - "use 2nd arg of `display-buffer' instead." "24.1") +;; (make-obsolete-variable + ;; 'special-display-regexps + ;; "use 2nd arg of `display-buffer' instead." "24.1") (defun special-display-p (buffer-name) "Return non-nil if a buffer named BUFFER-NAME gets a special frame. @@ -6263,9 +6325,9 @@ entry." ((and (consp regexp) (stringp (car regexp)) (string-match-p (car regexp) buffer-name)) (throw 'found (cdr regexp)))))))))) -(make-obsolete - 'special-display-p - "pass argument to buffer display function instead." "24.1") +;; (make-obsolete + ;; 'special-display-p + ;; "pass argument to buffer display function instead." "24.1") (defcustom pop-up-frame-alist nil "Alist of parameters for automatically generated new frames. @@ -6285,9 +6347,9 @@ affected by this variable." (symbol :tag "Parameter") (sexp :tag "Value"))) :group 'frames) -(make-obsolete-variable - 'pop-up-frame-alist - "use 2nd arg of `display-buffer' instead." "24.1") +;; (make-obsolete-variable + ;; 'pop-up-frame-alist + ;; "use 2nd arg of `display-buffer' instead." "24.1") (defcustom pop-up-frame-function (lambda () (make-frame pop-up-frame-alist)) @@ -6297,9 +6359,9 @@ frame. The default value calls `make-frame' with the argument `pop-up-frame-alist'." :type 'function :group 'frames) -(make-obsolete-variable - 'pop-up-frame-function - "use 2nd arg of `display-buffer' instead." "24.1") +;; (make-obsolete-variable + ;; 'pop-up-frame-function + ;; "use 2nd arg of `display-buffer' instead." "24.1") (defcustom pop-up-frames nil "Whether `display-buffer' should make a separate frame. @@ -6313,9 +6375,9 @@ Any other non-nil value means always make a separate frame." (const :tag "Always" t)) :group 'windows :group 'frames) -(make-obsolete-variable - 'pop-up-frames - "use 2nd arg of `display-buffer' instead." "24.1") +;; (make-obsolete-variable + ;; 'pop-up-frames + ;; "use 2nd arg of `display-buffer' instead." "24.1") (defcustom display-buffer-reuse-frames nil "Set and non-nil means `display-buffer' should reuse frames. @@ -6325,18 +6387,18 @@ that frame." :version "21.1" :group 'windows :group 'frames) -(make-obsolete-variable - 'display-buffer-reuse-frames - "use 2nd arg of `display-buffer' instead." "24.1") +;; (make-obsolete-variable + ;; 'display-buffer-reuse-frames + ;; "use 2nd arg of `display-buffer' instead." "24.1") (defcustom pop-up-windows 'unset ; t "Set and non-nil means `display-buffer' should make a new window." :type 'boolean :version "24.1" :group 'windows) -(make-obsolete-variable - 'pop-up-windows - "use 2nd arg of `display-buffer' instead." "24.1") +;; (make-obsolete-variable + ;; 'pop-up-windows + ;; "use 2nd arg of `display-buffer' instead." "24.1") (defcustom split-window-preferred-function 'split-window-sensibly "Function called by `display-buffer' to split a window. @@ -6363,9 +6425,9 @@ not want to split the selected window." :type 'function :version "23.1" :group 'windows) -(make-obsolete-variable - 'split-window-preferred-function - "use 2nd arg of `display-buffer' instead." "24.1") +;; (make-obsolete-variable + ;; 'split-window-preferred-function + ;; "use 2nd arg of `display-buffer' instead." "24.1") (defcustom split-height-threshold 80 "Minimum height for splitting a window to display a buffer. @@ -6377,9 +6439,9 @@ split it vertically disregarding the value of this variable." :type '(choice (const nil) (integer :tag "lines")) :version "23.1" :group 'windows) -(make-obsolete-variable - 'split-height-threshold - "use 2nd arg of `display-buffer' instead." "24.1") +;; (make-obsolete-variable + ;; 'split-height-threshold + ;; "use 2nd arg of `display-buffer' instead." "24.1") (defcustom split-width-threshold 160 "Minimum width for splitting a window to display a buffer. @@ -6389,9 +6451,9 @@ is nil, `display-buffer' cannot split windows horizontally." :type '(choice (const nil) (integer :tag "columns")) :version "23.1" :group 'windows) -(make-obsolete-variable - 'split-width-threshold - "use 2nd arg of `display-buffer' instead." "24.1") +;; (make-obsolete-variable + ;; 'split-width-threshold + ;; "use 2nd arg of `display-buffer' instead." "24.1") (defcustom even-window-heights 'unset ; t "If set and non-nil `display-buffer' will try to even window heights. @@ -6401,17 +6463,17 @@ window that appears above or below the selected window." :type 'boolean :version "24.1" :group 'windows) -(make-obsolete-variable - 'even-window-heights - "use 2nd arg of `display-buffer' instead." "24.1") +;; (make-obsolete-variable + ;; 'even-window-heights + ;; "use 2nd arg of `display-buffer' instead." "24.1") (defvar display-buffer-mark-dedicated nil "Non-nil means `display-buffer' marks the windows it creates as dedicated. The actual non-nil value of this variable will be copied to the `window-dedicated-p' flag.") -(make-obsolete-variable - 'display-buffer-mark-dedicated - "use 2nd arg of `display-buffer' instead." "24.1") +;; (make-obsolete-variable + ;; 'display-buffer-mark-dedicated + ;; "use 2nd arg of `display-buffer' instead." "24.1") (defun window-splittable-p (window &optional horizontal) "Return non-nil if `split-window-sensibly' may split WINDOW. @@ -6462,8 +6524,8 @@ hold: (max split-height-threshold (* 2 (max window-min-height (if mode-line-format 2 1)))))))))) -(make-obsolete - 'window-splittable-p "use 2nd arg of `display-buffer' instead." "24.1") +;; (make-obsolete + ;; 'window-splittable-p "use 2nd arg of `display-buffer' instead." "24.1") (defun split-window-sensibly (window) "Split WINDOW in a way suitable for `display-buffer'. @@ -6513,8 +6575,8 @@ split." (when (with-no-warnings (window-splittable-p window)) (with-selected-window window (split-window-vertically))))))) -(make-obsolete - 'split-window-sensibly "use 2nd arg of `display-buffer' instead." "24.1") +;; (make-obsolete + ;; 'split-window-sensibly "use 2nd arg of `display-buffer' instead." "24.1") ;; Functions for converting Emacs 23 buffer display options to buffer ;; display specifiers. @@ -6599,8 +6661,8 @@ value of `display-buffer-alist'." (display-buffer-alist-add `((regexp . ,entry)) (list - 'fun-with-args - (list 'fun-with-args special-display-function + 'function + (list 'function special-display-function special-display-frame-alist)) no-custom)) ((consp entry) @@ -6612,9 +6674,9 @@ value of `display-buffer-alist'." (display-buffer-alist-add `((name . ,name)) (list - 'fun-with-args + 'function ;; Weary. - (list 'fun-with-args (car rest) (cadr rest))) + (list 'function (car rest) (cadr rest))) no-custom)) ((listp rest) ;; A list of parameters. @@ -6633,8 +6695,8 @@ value of `display-buffer-alist'." (display-buffer-alist-add `((name . ,name)) (list - 'fun-with-args - (list 'fun-with-args special-display-function + 'function + (list 'function special-display-function special-display-frame-alist)) no-custom))))))))) @@ -6646,8 +6708,8 @@ value of `display-buffer-alist'." (display-buffer-alist-add `((name . ,entry)) (list - 'fun-with-args - (list 'fun-with-args special-display-function + 'function + (list 'function special-display-function special-display-frame-alist)) no-custom)) ((consp entry) @@ -6659,9 +6721,9 @@ value of `display-buffer-alist'." (display-buffer-alist-add `((name . ,name)) (list - 'fun-with-args + 'function ;; Weary. - (list 'fun-with-args (car rest) (cadr rest))) + (list 'function (car rest) (cadr rest))) no-custom)) ((listp rest) ;; A list of parameters. @@ -6680,8 +6742,8 @@ value of `display-buffer-alist'." (display-buffer-alist-add `((name . ,name)) (list - 'fun-with-args - (list 'fun-with-args special-display-function + 'function + (list 'function special-display-function special-display-frame-alist)) no-custom))))))))) @@ -6722,7 +6784,7 @@ value of `display-buffer-alist'." (when (or display-buffer-reuse-frames pop-up-frames) ;; "0" (all visible and iconified frames) is hardcoded in ;; Emacs 23. - 0)) + 0)) (unless (memq even-window-heights '(nil unset)) (cons 'reuse-window-even-sizes t))) no-custom) @@ -6747,7 +6809,7 @@ Note that the current implementation of this function cannot always set the height exactly, but attempts to be conservative, by allocating more lines than are actually needed in the case where some error may be present." - (setq window (normalize-live-window window)) + (setq window (window-normalize-live-window window)) (let ((delta (- height (window-text-height window)))) (unless (zerop delta) ;; Setting window-min-height to a value like 1 can lead to very @@ -6755,7 +6817,7 @@ where some error may be present." ;; windows 1-line tall, which means that there's no more space for ;; the modeline. (let ((window-min-height (min 2 height))) ; One text line plus a modeline. - (resize-window window delta))))) + (window-resize window delta))))) (defun enlarge-window-horizontally (delta) "Make selected window DELTA columns wider. @@ -6843,9 +6905,9 @@ WINDOW was scrolled." (interactive) ;; Do all the work in WINDOW and its buffer and restore the selected ;; window and the current buffer when we're done. - (setq window (normalize-live-window window)) + (setq window (window-normalize-live-window window)) ;; Can't resize a full height or fixed-size window. - (unless (or (window-size-fixed-p window) + (unless (or (window-size-fixed-p window) (window-full-height-p window)) ;; `with-selected-window' should orderly restore the current buffer. (with-selected-window window @@ -6898,8 +6960,8 @@ WINDOW was scrolled." ;; It's silly to put `point' at the end of the previous ;; line and so maybe force horizontal scrolling. (set-window-point window (line-beginning-position 0))) - ;; Call `resize-window' with OVERRIDE argument equal WINDOW. - (resize-window window delta nil window) + ;; Call `window-resize' with OVERRIDE argument equal WINDOW. + (window-resize window delta nil window) ;; Check if the last line is surely fully visible. If ;; not, enlarge the window. (let ((end (save-excursion @@ -6922,7 +6984,7 @@ WINDOW was scrolled." (while (and (< desired-height max-height) (= desired-height (window-total-size)) (not (pos-visible-in-window-p end))) - (resize-window window 1 nil window) + (window-resize window 1 nil window) (setq desired-height (1+ desired-height))))) (error (setq delta nil))) delta)))) @@ -6938,8 +7000,8 @@ WINDOW defaults to the selected window." ;; `window-iso-combined-p' instead should handle that. (or (= (nth 2 edges) (nth 2 (window-edges (previous-window)))) (= (nth 0 edges) (nth 0 (window-edges (next-window)))))))) -(make-obsolete - 'window-safely-shrinkable-p "use `window-iso-combined-p' instead." "24.1") +;; (make-obsolete + ;; 'window-safely-shrinkable-p "use `window-iso-combined-p' instead." "24.1") (defun shrink-window-if-larger-than-buffer (&optional window) "Shrink height of WINDOW if its buffer doesn't need so many lines. @@ -6955,7 +7017,7 @@ window, or if the window is the only window of its frame. Return non-nil if the window was shrunk, nil otherwise." (interactive) - (setq window (normalize-live-window window)) + (setq window (window-normalize-live-window window)) ;; Make sure that WINDOW is vertically combined and `point-min' is ;; visible (for whatever reason that's needed). The remaining issues ;; should be taken care of by `fit-window-to-buffer'. diff --git a/lisp/woman.el b/lisp/woman.el index eb801b55d4d..c6bd4a4c8d1 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -2157,8 +2157,8 @@ No external programs are used." (run-hooks 'woman-pre-format-hook) (and (boundp 'font-lock-mode) font-lock-mode (font-lock-mode -1)) ;; (fundamental-mode) - (let ((start-time (current-time)) ; (HIGH LOW MICROSEC) - time) ; HIGH * 2**16 + LOW seconds + (let ((start-time (current-time)) + time) (message "WoMan formatting buffer...") ; (goto-char (point-min)) ; (cond @@ -2167,10 +2167,8 @@ No external programs are used." ; (delete-region (point-min) (point))) ; potentially dangerous! ; (t (message "WARNING: .TH request not found -- not man-page format?"))) (woman-decode-region (point-min) (point-max)) - (setq time (current-time) - time (+ (* (- (car time) (car start-time)) 65536) - (- (cadr time) (cadr start-time)))) - (message "WoMan formatting buffer...done in %d seconds" time) + (setq time (float-time (time-since start-time))) + (message "WoMan formatting buffer...done in %g seconds" time) (WoMan-log-end time)) (run-hooks 'woman-post-format-hook)) @@ -4529,7 +4527,7 @@ IGNORED is a string appended to the log message." "Log the end of formatting in *WoMan-Log*. TIME specifies the time it took to format the man page, to be printed with the message." - (WoMan-log-1 (format "Formatting time %d seconds." time) 'end)) + (WoMan-log-1 (format "Formatting time %g seconds." time) 'end)) (defun WoMan-log-1 (string &optional end) "Log a message STRING in *WoMan-Log*. diff --git a/lwlib/ChangeLog b/lwlib/ChangeLog index c8435eb562f..7e332a9fd5d 100644 --- a/lwlib/ChangeLog +++ b/lwlib/ChangeLog @@ -1,3 +1,8 @@ +2011-06-27 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * Makefile.in (ALL_CFLAGS): Add -I../lib for generated header files + in out-of-tree build. + 2011-06-06 Paul Eggert <eggert@cs.ucla.edu> * Makefile.in (ALL_CFLAGS): Add -I$(srcdir)/../lib. diff --git a/lwlib/Makefile.in b/lwlib/Makefile.in index fe6bbc31282..1193cee4110 100644 --- a/lwlib/Makefile.in +++ b/lwlib/Makefile.in @@ -56,7 +56,7 @@ ALL_CFLAGS= $(C_SWITCH_SYSTEM) $(C_SWITCH_X_SITE) \ $(C_SWITCH_X_SYSTEM) $(C_SWITCH_MACHINE) \ $(C_WARNINGS_SWITCH) $(PROFILING_CFLAGS) $(CFLAGS) \ -DHAVE_CONFIG_H -Demacs -I../src \ - -I$(srcdir) -I$(srcdir)/../src -I$(srcdir)/../lib + -I$(srcdir) -I$(srcdir)/../src -I../lib -I$(srcdir)/../lib .c.o: $(CC) -c $(CPPFLAGS) $(ALL_CFLAGS) $< diff --git a/m4/alloca.m4 b/m4/alloca.m4 index 891fc8bc36f..a8744a844f3 100644 --- a/m4/alloca.m4 +++ b/m4/alloca.m4 @@ -1,4 +1,4 @@ -# alloca.m4 serial 12 +# alloca.m4 serial 13 dnl Copyright (C) 2002-2004, 2006-2007, 2009-2011 Free Software Foundation, dnl Inc. dnl This file is free software; the Free Software Foundation @@ -76,17 +76,17 @@ wenotbecray 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.]) + [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_cv_c_stack_direction], [AC_RUN_IFELSE([AC_LANG_SOURCE( [AC_INCLUDES_DEFAULT int @@ -105,16 +105,16 @@ 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])]) + [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 */ + 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 diff --git a/m4/dup2.m4 b/m4/dup2.m4 new file mode 100644 index 00000000000..8d7f62c8876 --- /dev/null +++ b/m4/dup2.m4 @@ -0,0 +1,76 @@ +#serial 13 +dnl Copyright (C) 2002, 2005, 2007, 2009-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_FUNC_DUP2], +[ + AC_REQUIRE([gl_UNISTD_H_DEFAULTS]) + AC_REQUIRE([AC_CANONICAL_HOST]) + m4_ifdef([gl_FUNC_DUP2_OBSOLETE], [ + AC_CHECK_FUNCS_ONCE([dup2]) + if test $ac_cv_func_dup2 = no; then + HAVE_DUP2=0 + AC_LIBOBJ([dup2]) + fi + ], [ + AC_DEFINE([HAVE_DUP2], [1], [Define to 1 if you have the 'dup2' function.]) + ]) + if test $HAVE_DUP2 = 1; then + AC_CACHE_CHECK([whether dup2 works], [gl_cv_func_dup2_works], + [AC_RUN_IFELSE([ + AC_LANG_PROGRAM([[#include <unistd.h> +#include <fcntl.h> +#include <errno.h>]], + [int result = 0; +#ifdef FD_CLOEXEC + if (fcntl (1, F_SETFD, FD_CLOEXEC) == -1) + result |= 1; +#endif + if (dup2 (1, 1) == 0) + result |= 2; +#ifdef FD_CLOEXEC + if (fcntl (1, F_GETFD) != FD_CLOEXEC) + result |= 4; +#endif + close (0); + if (dup2 (0, 0) != -1) + result |= 8; + /* Many gnulib modules require POSIX conformance of EBADF. */ + if (dup2 (2, 1000000) == -1 && errno != EBADF) + result |= 16; + return result; + ]) + ], + [gl_cv_func_dup2_works=yes], [gl_cv_func_dup2_works=no], + [case "$host_os" in + mingw*) # on this platform, dup2 always returns 0 for success + gl_cv_func_dup2_works=no;; + cygwin*) # on cygwin 1.5.x, dup2(1,1) returns 0 + gl_cv_func_dup2_works=no;; + linux*) # On linux between 2008-07-27 and 2009-05-11, dup2 of a + # closed fd may yield -EBADF instead of -1 / errno=EBADF. + gl_cv_func_dup2_works=no;; + freebsd*) # on FreeBSD 6.1, dup2(1,1000000) gives EMFILE, not EBADF. + gl_cv_func_dup2_works=no;; + haiku*) # on Haiku alpha 2, dup2(1, 1) resets FD_CLOEXEC. + gl_cv_func_dup2_works=no;; + *) gl_cv_func_dup2_works=yes;; + esac]) + ]) + if test "$gl_cv_func_dup2_works" = no; then + gl_REPLACE_DUP2 + fi + fi +]) + +AC_DEFUN([gl_REPLACE_DUP2], +[ + AC_REQUIRE([gl_UNISTD_H_DEFAULTS]) + AC_CHECK_FUNCS_ONCE([dup2]) + if test $ac_cv_func_dup2 = yes; then + REPLACE_DUP2=1 + fi + AC_LIBOBJ([dup2]) +]) diff --git a/m4/gl-comp.m4 b/m4/gl-comp.m4 index 24141a2639b..16bb02e686f 100644 --- a/m4/gl-comp.m4 +++ b/m4/gl-comp.m4 @@ -37,6 +37,7 @@ AC_DEFUN([gl_EARLY], # Code from module crypto/sha512: # Code from module dosname: # Code from module dtoastr: + # Code from module dup2: # Code from module extensions: AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) # Code from module filemode: @@ -102,6 +103,8 @@ gl_SHA1 gl_SHA256 gl_SHA512 AC_REQUIRE([gl_C99_STRTOLD]) +gl_FUNC_DUP2 +gl_UNISTD_MODULE_INDICATOR([dup2]) gl_FILEMODE gl_GETLOADAVG if test $HAVE_GETLOADAVG = 0; then @@ -206,6 +209,9 @@ gl_SYS_STAT_MODULE_INDICATOR([stat]) if $condition; then func_gl_gnulib_m4code_dosname fi + if $condition; then + func_gl_gnulib_m4code_verify + fi fi } func_gl_gnulib_m4code_strtoull () @@ -401,6 +407,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/careadlinkat.h lib/dosname.h lib/dtoastr.c + lib/dup2.c lib/filemode.c lib/filemode.h lib/ftoastr.c @@ -450,6 +457,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/00gnulib.m4 m4/alloca.m4 m4/c-strtod.m4 + m4/dup2.m4 m4/extensions.m4 m4/filemode.m4 m4/getloadavg.m4 diff --git a/src/ChangeLog b/src/ChangeLog index 1a56298ee20..a3536cda7a4 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -40,6 +40,426 @@ * font.c (font_range): Adjusted for the change of Vunicode_category_table. +2011-07-06 Paul Eggert <eggert@cs.ucla.edu> + + Remove unportable assumption about struct layout (Bug#8884). + * alloc.c (mark_buffer): + * buffer.c (reset_buffer_local_variables, Fbuffer_local_variables) + (clone_per_buffer_values): Don't assume that + sizeof (struct buffer) is a multiple of sizeof (Lisp_Object). + This isn't true in general, and it's particularly not true + if Emacs is configured with --with-wide-int. + * buffer.h (FIRST_FIELD_PER_BUFFER, LAST_FIELD_PER_BUFFER): + New macros, used in the buffer.c change. + +2011-07-05 Jan Djärv <jan.h.d@swipnet.se> + + * xsettings.c: Use both GConf and GSettings if both are available. + (store_config_changed_event): Add comment. + (dpyinfo_valid, store_font_name_changed, map_tool_bar_style) + (store_tool_bar_style_changed): New functions. + (store_monospaced_changed): Add comment. Call dpyinfo_valid. + (struct xsettings): Move font inside HAVE_XFT. + (GSETTINGS_TOOL_BAR_STYLE, GSETTINGS_FONT_NAME): New defines. + (GSETTINGS_MONO_FONT): Renamed from SYSTEM_MONO_FONT. + Move inside HAVE_XFT. + (something_changed_gsettingsCB): Renamed from something_changedCB. + Check for changes in GSETTINGS_TOOL_BAR_STYLE and GSETTINGS_FONT_NAME + also. + (GCONF_TOOL_BAR_STYLE, GCONF_FONT_NAME): New defines. + (GCONF_MONO_FONT): Renamed from SYSTEM_MONO_FONT. Move inside HAVE_XFT. + (something_changed_gconfCB): Renamed from something_changedCB. + Check for changes in GCONF_TOOL_BAR_STYLE and GCONF_FONT_NAME also. + (parse_settings): Move check for font inside HAVE_XFT. + (read_settings, apply_xft_settings): Add comment. + (read_and_apply_settings): Add comment. Call map_tool_bar_style and + store_tool_bar_style_changed. Move check for font inside HAVE_XFT and + call store_font_name_changed. + (xft_settings_event): Add comment. + (init_gsettings): Add comment. Get values for GSETTINGS_TOOL_BAR_STYLE + and GSETTINGS_FONT_NAME. Move check for fonts within HAVE_XFT. + (init_gconf): Add comment. Get values for GCONF_TOOL_BAR_STYLE + and GCONF_FONT_NAME. Move check for fonts within HAVE_XFT. + (xsettings_initialize): Call init_gsettings last. + (xsettings_get_system_font, xsettings_get_system_normal_font): Add + comment. + +2011-07-05 Paul Eggert <eggert@cs.ucla.edu> + + Random fixes. E.g., (random) never returned negative values. + * fns.c (Frandom): Use GET_EMACS_TIME for random seed, and add the + subseconds part to the entropy, as that's a bit more random. + Prefer signed to unsigned, since the signedness doesn't matter and + in general we prefer signed. When given a limit, use a + denominator equal to INTMASK + 1, not to VALMASK + 1, because the + latter isn't right if USE_2_TAGS_FOR_INTS. + * sysdep.c (get_random): Return a value in the range 0..INTMASK, + not 0..VALMASK. Don't discard "excess" bits that random () returns. + +2011-07-04 Stefan Monnier <monnier@iro.umontreal.ca> + + * textprop.c (text_property_stickiness): + Obey Vtext_property_default_nonsticky. + (syms_of_textprop): Add `display' to Vtext_property_default_nonsticky. + * w32fns.c (syms_of_w32fns): + * xfns.c (syms_of_xfns): Don't Add `display' since it's there by default. + +2011-07-04 Paul Eggert <eggert@cs.ucla.edu> + + * fileio.c (barf_or_query_if_file_exists): Use S_ISDIR. + This is more efficient than Ffile_directory_p and avoids a minor race. + +2011-07-04 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * buffer.c (Foverlay_put): Say what the return value is + (bug#7835). + + * fileio.c (barf_or_query_if_file_exists): Check first if the file + is a directory before asking whether to use the file name + (bug#7564). + (barf_or_query_if_file_exists): Make the "File is a directory" + error be more correct. + + * fns.c (Frequire): Remove the mention of the .gz files, since + that's installation-specific, but keep the mention of + `get-load-suffixes'. + +2011-07-04 Paul Eggert <eggert@cs.ucla.edu> + + * editfns.c (Fformat_time_string): Don't assume strlen fits in int. + Report string overflow if the output is too long. + +2011-07-04 Juanma Barranquero <lekktu@gmail.com> + + * gnutls.c (Fgnutls_boot): Don't mention :verify-error. + (syms_of_gnutls): Remove duplicate DEFSYM for + Qgnutls_bootprop_verify_hostname_error, an error for + Qgnutls_bootprop_verify_error (which is no longer used). + + * eval.c (find_handler_clause): Remove parameters `sig' and `data', + unused since 2011-01-26T20:02:07Z!monnier@iro.umontreal.ca. All callers changed. + Also (re)move comments that are misplaced or no longer relevant. + +2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * callint.c (Finteractive): Clarify the meaning of "@" (bug#8813). + +2011-07-03 Chong Yidong <cyd@stupidchicken.com> + + * xfaces.c (Finternal_merge_in_global_face): Modify the foreground + and background color parameters if they have been changed. + +2011-07-03 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * editfns.c (Fformat): Clarify the - and 0 flags (bug#6659). + +2011-07-03 Paul Eggert <eggert@cs.ucla.edu> + + * xsettings.c (SYSTEM_FONT): Define only when used. + No need to define when HAVE_GSETTINGS || !HAVE_XFT. + + * keymap.c (access_keymap_1): Now static. + +2011-07-02 Chong Yidong <cyd@stupidchicken.com> + + * keyboard.c (command_loop_1): If a down-mouse event is unbound, + leave any prefix arg for the up event (Bug#1586). + +2011-07-02 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * lread.c (syms_of_lread): Mention single symbols defined by + `defvar' or `defconst' (bug#7154). + + * fns.c (Frequire): Mention .el.gz files (bug#7314). + (Frequire): Mention get-load-suffixes. + +2011-07-02 Martin Rudalics <rudalics@gmx.at> + + * window.h (window): Remove clone_number slot. + * window.c (Fwindow_clone_number, Fset_window_clone_number): + Remove. + (make_parent_window, make_window, saved_window) + (Fset_window_configuration, save_window_save): Don't deal with + clone numbers. + * buffer.c (Qclone_number): Remove declaration. + (sort_overlays, overlay_strings): Don't deal with clone numbers. + +2011-07-02 Stefan Monnier <monnier@iro.umontreal.ca> + + Add multiple inheritance to keymaps. + * keymap.c (Fmake_composed_keymap): New function. + (Fset_keymap_parent): Simplify. + (fix_submap_inheritance): Remove. + (access_keymap_1): New function extracted from access_keymap to handle + embedded parents and handle lists of maps. + (access_keymap): Use it. + (Fkeymap_prompt, map_keymap_internal, map_keymap, store_in_keymap) + (Fcopy_keymap): Handle embedded parents. + (Fcommand_remapping, define_as_prefix): Simplify. + (Fkey_binding): Simplify. + (syms_of_keymap): Move minibuffer-local-completion-map, + minibuffer-local-filename-completion-map, + minibuffer-local-must-match-map, and + minibuffer-local-filename-must-match-map to Elisp. + (syms_of_keymap): Defsubr make-composed-keymap. + * keyboard.c (menu_bar_items): Use map_keymap_canonical. + (parse_menu_item): Trivial simplification. + +2011-07-01 Glenn Morris <rgm@gnu.org> + + * Makefile.in (SETTINGS_LIBS): Fix typo. + +2011-07-01 Kazuhiro Ito <kzhr@d1.dion.ne.jp> (tiny patch) + + * coding.c (Fencode_coding_string): Record the last coding system + used, as the function doc string says (bug#8738). + +2011-07-01 Jan Djärv <jan.h.d@swipnet.se> + + * xsettings.c (store_monospaced_changed): Take new font as arg and + check for change against current_mono_font. + (EMACS_TYPE_SETTINGS): Remove this and related defines. + (emacs_settings_constructor, emacs_settings_get_property) + (emacs_settings_set_property, emacs_settings_class_init) + (emacs_settings_init, gsettings_obj): Remove. + (something_changedCB): New function for HAVE_GSETTINGS. + (something_changedCB): HAVE_GCONF: Call store_monospaced_changed + with value as argument. + (init_gsettings): Check that GSETTINGS_SCHEMA exists before calling + g_settings_new (Bug#8967). Do not create gsettings_obj. + Remove calls to g_settings_bind. Connect something_changedCB to + "changed". + + * xgselect.c: Add defined (HAVE_GSETTINGS). + (xgselect_initialize): Ditto. + + * process.c: Add defined (HAVE_GSETTINGS) for xgselect.h + (wait_reading_process_output): Add defined (HAVE_GSETTINGS) for + xg_select. + +2011-07-01 Paul Eggert <eggert@cs.ucla.edu> + + * eval.c (struct backtrace): Simplify and port the data structure. + Do not assume that "int nargs : BITS_PER_INT - 2;" produces a + signed bit field, as this assumption is not portable and it makes + Emacs crash when compiled with Sun C 5.8 on sparc. Do not use + "char debug_on_exit : 1" as this is not portable either; instead, + use the portable "unsigned int debug_on_exit : 1". Remove unused + member evalargs. Remove obsolete comments about cc bombing out. + +2011-06-30 Jan Djärv <jan.h.d@swipnet.se> + + * xsettings.c: Include glib-object.h, gio/gio.h if HAVE_GSETTINGS. + Let HAVE_GSETTINGS override HAVE_GCONF. + (store_monospaced_changed): New function. + (EMACS_SETTINGS): A new type derived from GObject to handle + GSettings notifications. + (emacs_settings_constructor, emacs_settings_get_property) + (emacs_settings_set_property, emacs_settings_class_init): + New functions. + (gsettings_client, gsettings_obj): New variables. + (GSETTINGS_SCHEMA): New define. + (something_changedCB): Call store_monospaced_changed. + (init_gsettings): New function. + (xsettings_initialize): Call init_gsettings. + (syms_of_xsettings): Initialize gsettings_client, gsettings_obj + to NULL. + + * Makefile.in (SETTINGS_CFLAGS, SETTINGS_LIBS): Renamed from + GCONF_CFLAGS/LIBS. + +2011-06-29 Martin Rudalics <rudalics@gmx.at> + + * window.c (resize_root_window, grow_mini_window) + (shrink_mini_window): Rename Qresize_root_window to + Qwindow_resize_root_window and Qresize_root_window_vertically to + Qwindow_resize_root_window_vertically. + +2011-06-28 Paul Eggert <eggert@cs.ucla.edu> + + * gnutls.c (Qgnutls_bootprop_verify_error): Remove unused var. + +2011-06-27 Juanma Barranquero <lekktu@gmail.com> + + * makefile.w32-in: Redesign dependencies so they reflect more + clearly which files are directly included by each source file, + and not through other includes. + +2011-06-27 Martin Rudalics <rudalics@gmx.at> + + * buffer.c (Qclone_number): Declare static and DEFSYM it. + (sort_overlays, overlay_strings): When an overlay's clone number + matches the window's clone number process the overlay even if + the overlay's window property doesn't match the current window. + + * window.c (Fwindow_vchild): Rename to Fwindow_top_child. + (Fwindow_hchild): Rename to Fwindow_left_child. + (Fwindow_next): Rename to Fwindow_next_sibling. + (Fwindow_prev): Rename to Fwindow_prev_sibling. + (resize_window_check): Rename to window_resize_check. + (resize_window_apply): Rename to window_resize_apply. + (Fresize_window_apply): Rename to Fwindow_resize_apply. + (Fdelete_other_windows_internal, resize_frame_windows) + (Fsplit_window_internal, Fdelete_window_internal) + (grow_mini_window, shrink_mini_window) + (Fresize_mini_window_internal): Fix callers accordingly. + +2011-06-26 Jan Djärv <jan.h.d@swipnet.se> + + * emacsgtkfixed.h: State that this is only used with Gtk+3. + (emacs_fixed_set_min_size): Remove. + (emacs_fixed_new): Take frame as argument. + + * emacsgtkfixed.c: State that this is only used with Gtk+3. + (_EmacsFixedPrivate): Remove minwidth/height. + Add struct frame *f. + (emacs_fixed_init): Initialize priv->f. + (get_parent_class, emacs_fixed_set_min_size): Remove. + (emacs_fixed_new): Set priv->f to argument. + (emacs_fixed_get_preferred_width) + (emacs_fixed_get_preferred_height): Use min_width/height from + frames size_hint to set minimum and natural (Bug#8919). + (XSetWMSizeHints, XSetWMNormalHints): Override these functions + and use min_width/height from frames size_hint to set + min_width/height (Bug#8919). + + * gtkutil.c (xg_create_frame_widgets): Pass f to emacs_fixed_new. + (x_wm_set_size_hint): Remove call to emacs_fixed_set_min_size. + Fix indentation. + +2011-06-26 Eli Zaretskii <eliz@gnu.org> + + * bidi.c (bidi_paragraph_init): Test for ZV_BYTE before calling + bidi_at_paragraph_end, since fast_looking_at doesn't like to be + called at ZV. + +2011-06-26 Chong Yidong <cyd@stupidchicken.com> + + * process.c (wait_reading_process_output): Bypass select if + waiting for a cell while ignoring keyboard input, and input is + pending. Suggested by Jan Djärv (Bug#8869). + +2011-06-25 Paul Eggert <eggert@cs.ucla.edu> + + Use gnulib's dup2 module instead of rolling our own. + * sysdep.c (dup2) [!HAVE_DUP2]: Remove; gnulib now does this. + +2011-06-25 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * dispnew.c (scrolling_window): Before scrolling, turn off a + mouse-highlight in the window being scrolled. + +2011-06-24 Juanma Barranquero <lekktu@gmail.com> + + Move DEFSYM to lisp.h and use everywhere. + + * character.h (DEFSYM): Move declaration... + * lisp.h (DEFSYM): ...here. + + * gnutls.c: + * minibuf.c: + * w32menu.c: + * w32proc.c: + * w32select.c: Don't include character.h. + + * alloc.c (syms_of_alloc): + * buffer.c (syms_of_buffer): + * bytecode.c (syms_of_bytecode): + * callint.c (syms_of_callint): + * casefiddle.c (syms_of_casefiddle): + * casetab.c (init_casetab_once): + * category.c (init_category_once, syms_of_category): + * ccl.c (syms_of_ccl): + * cmds.c (syms_of_cmds): + * composite.c (syms_of_composite): + * dbusbind.c (syms_of_dbusbind): + * dired.c (syms_of_dired): + * dispnew.c (syms_of_display): + * doc.c (syms_of_doc): + * editfns.c (syms_of_editfns): + * emacs.c (syms_of_emacs): + * eval.c (syms_of_eval): + * fileio.c (syms_of_fileio): + * fns.c (syms_of_fns): + * frame.c (syms_of_frame): + * fringe.c (syms_of_fringe): + * insdel.c (syms_of_insdel): + * keymap.c (syms_of_keymap): + * lread.c (init_obarray, syms_of_lread): + * macros.c (syms_of_macros): + * msdos.c (syms_of_msdos): + * print.c (syms_of_print): + * process.c (syms_of_process): + * search.c (syms_of_search): + * sound.c (syms_of_sound): + * syntax.c (init_syntax_once, syms_of_syntax): + * terminal.c (syms_of_terminal): + * textprop.c (syms_of_textprop): + * undo.c (syms_of_undo): + * w32.c (globals_of_w32): + * window.c (syms_of_window): + * xdisp.c (syms_of_xdisp): + * xfaces.c (syms_of_xfaces): + * xfns.c (syms_of_xfns): + * xmenu.c (syms_of_xmenu): + * xsettings.c (syms_of_xsettings): + * xterm.c (syms_of_xterm): Use DEFSYM. + +2011-06-24 Teodor Zlatanov <tzz@lifelogs.com> + + * gnutls.c (syms_of_gnutls): Use the DEFSYM macro from character.h. + +2011-06-23 Paul Eggert <eggert@cs.ucla.edu> + + 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 <sdl.web@gmail.com> + + * minibuf.c (Fcompleting_read_default, Vcompleting_read_function): + Move to minibuffer.el. + 2011-06-22 Paul Eggert <eggert@cs.ucla.edu> Fixes for GLYPH_DEBUG found by GCC 4.6.0 static checking. @@ -272,7 +692,7 @@ 2011-06-22 Jim Meyering <meyering@redhat.com> - don't leak an XBM-image-sized buffer + Don't leak an XBM-image-sized buffer * image.c (xbm_load): Free the image buffer after using it. 2011-06-21 Paul Eggert <eggert@cs.ucla.edu> @@ -292,7 +712,7 @@ * fns.c (secure_hash): Rename from crypto_hash_function and change the first arg to accept symbols. - (Fsecure_hash): New primtive. + (Fsecure_hash): New primitive. (syms_of_fns): New symbols. 2011-06-20 Deniz Dogan <deniz@dogan.se> @@ -1466,7 +1886,7 @@ and %.0c. Fix bug with strchr succeeding on '\0' when looking for flags. Fix bug with (format "%c" 256.0). Avoid integer overflow when formatting out-of-range floating point numbers with int - formats. (Bug#8668) + formats. (Bug#8668) * lisp.h (FIXNUM_OVERFLOW_P): Work even if arg is a NaN. @@ -2430,9 +2850,9 @@ :verify-hostname-error, :verify-error, and :verify-flags parameters of `gnutls-boot' and documented those parameters in the docstring. Start callback support. - (emacs_gnutls_handshake): Add Woe32 support. Retry handshake - unless a fatal error occured. Call gnutls_alert_send_appropriate - on error. Return error code. + (emacs_gnutls_handshake): Add Woe32 support. Retry handshake + unless a fatal error occurred. Call gnutls_alert_send_appropriate + on error. Return error code. (emacs_gnutls_write): Call emacs_gnutls_handle_error. (emacs_gnutls_read): Likewise. (Fgnutls_boot): Return handshake error code. diff --git a/src/ChangeLog.9 b/src/ChangeLog.9 index 0c39de74a6a..f25434087c1 100644 --- a/src/ChangeLog.9 +++ b/src/ChangeLog.9 @@ -5985,7 +5985,7 @@ GC_PROTECT_MALLOC_STATE]: New function. (PROTECT_MALLOC_STATE): New macro. (__malloc_initialize, morecore, _malloc_internal) - (_free_internal) _realloc_internal): Use it to make _heapinfo + (_free_internal, _realloc_internal): Use it to make _heapinfo read-only outside of gmalloc. * keymap.c: Update copyright. diff --git a/src/Makefile.in b/src/Makefile.in index c4250b90633..f628c321f70 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -152,8 +152,8 @@ DBUS_LIBS = @DBUS_LIBS@ ## dbusbind.o if HAVE_DBUS, else empty. DBUS_OBJ = @DBUS_OBJ@ -GCONF_CFLAGS = @GCONF_CFLAGS@ -GCONF_LIBS = @GCONF_LIBS@ +SETTINGS_CFLAGS = @SETTINGS_CFLAGS@ +SETTINGS_LIBS = @SETTINGS_LIBS@ ## gtkutil.o if USE_GTK, else empty. GTK_OBJ=@GTK_OBJ@ @@ -305,7 +305,7 @@ ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(MYCPPFLAGS) -I. -I$(srcdir) \ $(C_SWITCH_MACHINE) $(C_SWITCH_SYSTEM) $(C_SWITCH_X_SITE) \ $(C_SWITCH_X_SYSTEM) $(CFLAGS_SOUND) $(RSVG_CFLAGS) $(IMAGEMAGICK_CFLAGS) \ $(LIBXML2_CFLAGS) $(DBUS_CFLAGS) \ - $(GCONF_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \ + $(SETTINGS_CFLAGS) $(FREETYPE_CFLAGS) $(FONTCONFIG_CFLAGS) \ $(LIBOTF_CFLAGS) $(M17N_FLT_CFLAGS) $(DEPFLAGS) $(PROFILING_CFLAGS) \ $(LIBGNUTLS_CFLAGS) \ $(C_WARNINGS_SWITCH) $(CFLAGS) @@ -381,7 +381,7 @@ otherobj= $(TERMCAP_OBJ) $(PRE_ALLOC_OBJ) $(GMALLOC_OBJ) $(RALLOC_OBJ) \ LIBES = $(LIBS) $(LIBX_BASE) $(LIBX_OTHER) $(LIBSOUND) \ $(RSVG_LIBS) $(IMAGEMAGICK_LIBS) $(DBUS_LIBS) \ $(LIBXML2_LIBS) $(LIBGPM) $(LIBRESOLV) $(LIBS_SYSTEM) \ - $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(GCONF_LIBS) $(LIBSELINUX_LIBS) \ + $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \ $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ $(LIBGNUTLS_LIBS) \ $(LIB_GCC) $(LIB_MATH) $(LIB_STANDARD) $(LIB_GCC) diff --git a/src/alloc.c b/src/alloc.c index 69623d103c3..f679787e95c 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5619,7 +5619,8 @@ mark_buffer (Lisp_Object buf) /* buffer-local Lisp variables start at `undo_list', tho only the ones from `name' on are GC'd normally. */ for (ptr = &buffer->BUFFER_INTERNAL_FIELD (name); - (char *)ptr < (char *)buffer + sizeof (struct buffer); + ptr <= &PER_BUFFER_VALUE (buffer, + PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER)); ptr++) mark_object (*ptr); @@ -6251,8 +6252,7 @@ do hash-consing of the objects allocated to pure space. */); DEFVAR_LISP ("post-gc-hook", Vpost_gc_hook, doc: /* Hook run after garbage collection has finished. */); Vpost_gc_hook = Qnil; - Qpost_gc_hook = intern_c_string ("post-gc-hook"); - staticpro (&Qpost_gc_hook); + DEFSYM (Qpost_gc_hook, "post-gc-hook"); DEFVAR_LISP ("memory-signal-data", Vmemory_signal_data, doc: /* Precomputed `signal' argument for memory-full error. */); @@ -6266,11 +6266,8 @@ do hash-consing of the objects allocated to pure space. */); doc: /* Non-nil means Emacs cannot get much more Lisp memory. */); Vmemory_full = Qnil; - staticpro (&Qgc_cons_threshold); - Qgc_cons_threshold = intern_c_string ("gc-cons-threshold"); - - staticpro (&Qchar_table_extra_slots); - Qchar_table_extra_slots = intern_c_string ("char-table-extra-slots"); + DEFSYM (Qgc_cons_threshold, "gc-cons-threshold"); + DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots"); DEFVAR_LISP ("gc-elapsed", Vgc_elapsed, doc: /* Accumulated time elapsed in garbage collections. diff --git a/src/bidi.c b/src/bidi.c index 1f3b196d5a4..469afdb3819 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -744,8 +744,6 @@ bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it, int no_default_p) || type == LRE || type == LRO)); type = bidi_get_type (ch, NEUTRAL_DIR)) { - if (type == NEUTRAL_B && bidi_at_paragraph_end (pos, bytepos) >= -1) - break; if (bytepos >= ZV_BYTE) { /* Pretend there's a paragraph separator at end of @@ -753,6 +751,8 @@ bidi_paragraph_init (bidi_dir_t dir, struct bidi_it *bidi_it, int no_default_p) type = NEUTRAL_B; break; } + if (type == NEUTRAL_B && bidi_at_paragraph_end (pos, bytepos) >= -1) + break; /* Fetch next character and advance to get past it. */ ch = bidi_fetch_char (bytepos, pos, &disp_pos, bidi_it->frame_window_p, &ch_len, &nchars); diff --git a/src/buffer.c b/src/buffer.c index 238923a2ba0..e2f34d629e9 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -471,8 +471,8 @@ clone_per_buffer_values (struct buffer *from, struct buffer *to) /* buffer-local Lisp variables start at `undo_list', tho only the ones from `name' on are GC'd normally. */ - for (offset = PER_BUFFER_VAR_OFFSET (undo_list); - offset < sizeof *to; + for (offset = PER_BUFFER_VAR_OFFSET (FIRST_FIELD_PER_BUFFER); + offset <= PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER); offset += sizeof (Lisp_Object)) { Lisp_Object obj; @@ -830,8 +830,8 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too) /* buffer-local Lisp variables start at `undo_list', tho only the ones from `name' on are GC'd normally. */ - for (offset = PER_BUFFER_VAR_OFFSET (undo_list); - offset < sizeof *b; + for (offset = PER_BUFFER_VAR_OFFSET (FIRST_FIELD_PER_BUFFER); + offset <= PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER); offset += sizeof (Lisp_Object)) { int idx = PER_BUFFER_IDX (offset); @@ -1055,8 +1055,8 @@ No argument or nil as argument means use current buffer as BUFFER. */) /* buffer-local Lisp variables start at `undo_list', tho only the ones from `name' on are GC'd normally. */ - for (offset = PER_BUFFER_VAR_OFFSET (undo_list); - offset < sizeof (struct buffer); + for (offset = PER_BUFFER_VAR_OFFSET (FIRST_FIELD_PER_BUFFER); + offset <= PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER); /* sizeof EMACS_INT == sizeof Lisp_Object */ offset += (sizeof (EMACS_INT))) { @@ -4056,7 +4056,8 @@ DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0, } DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0, - doc: /* Set one property of overlay OVERLAY: give property PROP value VALUE. */) + doc: /* Set one property of overlay OVERLAY: give property PROP value VALUE. +VALUE will be returned.*/) (Lisp_Object overlay, Lisp_Object prop, Lisp_Object value) { Lisp_Object tail, buffer; @@ -5209,39 +5210,26 @@ syms_of_buffer (void) staticpro (&Vbuffer_alist); staticpro (&Qprotected_field); staticpro (&Qpermanent_local); - Qpermanent_local_hook = intern_c_string ("permanent-local-hook"); - staticpro (&Qpermanent_local_hook); staticpro (&Qkill_buffer_hook); - Qoverlayp = intern_c_string ("overlayp"); - staticpro (&Qoverlayp); - Qevaporate = intern_c_string ("evaporate"); - staticpro (&Qevaporate); - Qmodification_hooks = intern_c_string ("modification-hooks"); - staticpro (&Qmodification_hooks); - Qinsert_in_front_hooks = intern_c_string ("insert-in-front-hooks"); - staticpro (&Qinsert_in_front_hooks); - Qinsert_behind_hooks = intern_c_string ("insert-behind-hooks"); - staticpro (&Qinsert_behind_hooks); - Qget_file_buffer = intern_c_string ("get-file-buffer"); - staticpro (&Qget_file_buffer); - Qpriority = intern_c_string ("priority"); - staticpro (&Qpriority); - Qbefore_string = intern_c_string ("before-string"); - staticpro (&Qbefore_string); - Qafter_string = intern_c_string ("after-string"); - staticpro (&Qafter_string); - Qfirst_change_hook = intern_c_string ("first-change-hook"); - staticpro (&Qfirst_change_hook); - Qbefore_change_functions = intern_c_string ("before-change-functions"); - staticpro (&Qbefore_change_functions); - Qafter_change_functions = intern_c_string ("after-change-functions"); - staticpro (&Qafter_change_functions); + + DEFSYM (Qpermanent_local_hook, "permanent-local-hook"); + DEFSYM (Qoverlayp, "overlayp"); + DEFSYM (Qevaporate, "evaporate"); + DEFSYM (Qmodification_hooks, "modification-hooks"); + DEFSYM (Qinsert_in_front_hooks, "insert-in-front-hooks"); + DEFSYM (Qinsert_behind_hooks, "insert-behind-hooks"); + DEFSYM (Qget_file_buffer, "get-file-buffer"); + DEFSYM (Qpriority, "priority"); + DEFSYM (Qbefore_string, "before-string"); + DEFSYM (Qafter_string, "after-string"); + DEFSYM (Qfirst_change_hook, "first-change-hook"); + DEFSYM (Qbefore_change_functions, "before-change-functions"); + DEFSYM (Qafter_change_functions, "after-change-functions"); + DEFSYM (Qkill_buffer_query_functions, "kill-buffer-query-functions"); + /* The next one is initialized in init_buffer_once. */ staticpro (&Qucs_set_table_for_input); - Qkill_buffer_query_functions = intern_c_string ("kill-buffer-query-functions"); - staticpro (&Qkill_buffer_query_functions); - Fput (Qprotected_field, Qerror_conditions, pure_cons (Qprotected_field, pure_cons (Qerror, Qnil))); Fput (Qprotected_field, Qerror_message, @@ -6035,8 +6023,7 @@ If any of them returns nil, the buffer is not killed. */); doc: /* Normal hook run before changing the major mode of a buffer. The function `kill-all-local-variables' runs this before doing anything else. */); Vchange_major_mode_hook = Qnil; - Qchange_major_mode_hook = intern_c_string ("change-major-mode-hook"); - staticpro (&Qchange_major_mode_hook); + DEFSYM (Qchange_major_mode_hook, "change-major-mode-hook"); DEFVAR_LISP ("buffer-list-update-hook", Vbuffer_list_update_hook, doc: /* Hook run when the buffer list changes. @@ -6044,8 +6031,7 @@ Functions running this hook are `get-buffer-create', `make-indirect-buffer', `rename-buffer', `kill-buffer', `record-buffer' and `unrecord-buffer'. */); Vbuffer_list_update_hook = Qnil; - Qbuffer_list_update_hook = intern_c_string ("buffer-list-update-hook"); - staticpro (&Qbuffer_list_update_hook); + DEFSYM (Qbuffer_list_update_hook, "buffer-list-update-hook"); defsubr (&Sbuffer_live_p); defsubr (&Sbuffer_list); diff --git a/src/buffer.h b/src/buffer.h index 4643e0d9d0e..06864dd5789 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -612,6 +612,7 @@ struct buffer /* Everything from here down must be a Lisp_Object. */ /* buffer-local Lisp variables start at `undo_list', tho only the ones from `name' on are GC'd normally. */ + #define FIRST_FIELD_PER_BUFFER undo_list /* Changes in the buffer are recorded here for undo. t means don't record anything. @@ -846,6 +847,9 @@ struct buffer t means to use hollow box cursor. See `cursor-type' for other values. */ Lisp_Object BUFFER_INTERNAL_FIELD (cursor_in_non_selected_windows); + + /* This must be the last field in the above list. */ + #define LAST_FIELD_PER_BUFFER cursor_in_non_selected_windows }; diff --git a/src/bytecode.c b/src/bytecode.c index 58b26c79b84..9ed29e94b54 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1840,8 +1840,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, void syms_of_bytecode (void) { - Qbytecode = intern_c_string ("byte-code"); - staticpro (&Qbytecode); + DEFSYM (Qbytecode, "byte-code"); defsubr (&Sbyte_code); @@ -1863,8 +1862,7 @@ integer, it is incremented each time that symbol's function is called. */); byte_metering_on = 0; Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0)); - Qbyte_code_meter = intern_c_string ("byte-code-meter"); - staticpro (&Qbyte_code_meter); + DEFSYM (Qbyte_code_meter, "byte-code-meter"); { int i = 256; while (i--) diff --git a/src/callint.c b/src/callint.c index dc5e6a4c37a..1371b403e4b 100644 --- a/src/callint.c +++ b/src/callint.c @@ -105,9 +105,10 @@ Z -- Coding system, nil if no prefix arg. In addition, if the string begins with `*', an error is signaled if the buffer is read-only. -If the string begins with `@', Emacs searches the key sequence which - invoked the command for its first mouse click (or any other event - which specifies a window). +If `@' appears at the beginning of the string, and if the key sequence + used to invoke the command includes any mouse events, then the window + associated with the first of those events is selected before the + command is run. If the string begins with `^' and `shift-select-mode' is non-nil, Emacs first calls the function `handle-shift-selection'. You may use `@', `*', and `^' together. They are processed in the @@ -896,41 +897,20 @@ syms_of_callint (void) pure_cons (intern_c_string ("point"), pure_cons (intern_c_string ("mark"), Qnil)))); - Qlist = intern_c_string ("list"); - staticpro (&Qlist); - Qlet = intern_c_string ("let"); - staticpro (&Qlet); - Qif = intern_c_string ("if"); - staticpro (&Qif); - Qwhen = intern_c_string ("when"); - staticpro (&Qwhen); - Qletx = intern_c_string ("let*"); - staticpro (&Qletx); - Qsave_excursion = intern_c_string ("save-excursion"); - staticpro (&Qsave_excursion); - Qprogn = intern_c_string ("progn"); - staticpro (&Qprogn); - - Qminus = intern_c_string ("-"); - staticpro (&Qminus); - - Qplus = intern_c_string ("+"); - staticpro (&Qplus); - - Qhandle_shift_selection = intern_c_string ("handle-shift-selection"); - staticpro (&Qhandle_shift_selection); - - Qcall_interactively = intern_c_string ("call-interactively"); - staticpro (&Qcall_interactively); - - Qcommand_debug_status = intern_c_string ("command-debug-status"); - staticpro (&Qcommand_debug_status); - - Qenable_recursive_minibuffers = intern_c_string ("enable-recursive-minibuffers"); - staticpro (&Qenable_recursive_minibuffers); - - Qmouse_leave_buffer_hook = intern_c_string ("mouse-leave-buffer-hook"); - staticpro (&Qmouse_leave_buffer_hook); + DEFSYM (Qlist, "list"); + DEFSYM (Qlet, "let"); + DEFSYM (Qif, "if"); + DEFSYM (Qwhen, "when"); + DEFSYM (Qletx, "let*"); + DEFSYM (Qsave_excursion, "save-excursion"); + DEFSYM (Qprogn, "progn"); + DEFSYM (Qminus, "-"); + DEFSYM (Qplus, "+"); + DEFSYM (Qhandle_shift_selection, "handle-shift-selection"); + DEFSYM (Qcall_interactively, "call-interactively"); + DEFSYM (Qcommand_debug_status, "command-debug-status"); + DEFSYM (Qenable_recursive_minibuffers, "enable-recursive-minibuffers"); + DEFSYM (Qmouse_leave_buffer_hook, "mouse-leave-buffer-hook"); DEFVAR_KBOARD ("prefix-arg", Vprefix_arg, doc: /* The value of the prefix argument for the next editing command. diff --git a/src/casefiddle.c b/src/casefiddle.c index 1a0a62f273c..50ad4eeda74 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -417,8 +417,7 @@ With negative argument, capitalize previous words but do not move. */) void syms_of_casefiddle (void) { - Qidentity = intern_c_string ("identity"); - staticpro (&Qidentity); + DEFSYM (Qidentity, "identity"); defsubr (&Supcase); defsubr (&Sdowncase); defsubr (&Scapitalize); diff --git a/src/casetab.c b/src/casetab.c index 29120dd08ce..3433b313c03 100644 --- a/src/casetab.c +++ b/src/casetab.c @@ -244,8 +244,7 @@ init_casetab_once (void) { register int i; Lisp_Object down, up; - Qcase_table = intern_c_string ("case-table"); - staticpro (&Qcase_table); + DEFSYM (Qcase_table, "case-table"); /* Intern this now in case it isn't already done. Setting this variable twice is harmless. @@ -288,8 +287,7 @@ init_casetab_once (void) void syms_of_casetab (void) { - Qcase_table_p = intern_c_string ("case-table-p"); - staticpro (&Qcase_table_p); + DEFSYM (Qcase_table_p, "case-table-p"); staticpro (&Vascii_canon_table); staticpro (&Vascii_downcase_table); diff --git a/src/category.c b/src/category.c index 23fd874c824..08eadb04730 100644 --- a/src/category.c +++ b/src/category.c @@ -453,8 +453,7 @@ void init_category_once (void) { /* This has to be done here, before we call Fmake_char_table. */ - Qcategory_table = intern_c_string ("category-table"); - staticpro (&Qcategory_table); + DEFSYM (Qcategory_table, "category-table"); /* Intern this now in case it isn't already done. Setting this variable twice is harmless. @@ -475,12 +474,9 @@ init_category_once (void) void syms_of_category (void) { - Qcategoryp = intern_c_string ("categoryp"); - staticpro (&Qcategoryp); - Qcategorysetp = intern_c_string ("categorysetp"); - staticpro (&Qcategorysetp); - Qcategory_table_p = intern_c_string ("category-table-p"); - staticpro (&Qcategory_table_p); + DEFSYM (Qcategoryp, "categoryp"); + DEFSYM (Qcategorysetp, "categorysetp"); + DEFSYM (Qcategory_table_p, "category-table-p"); DEFVAR_LISP ("word-combining-categories", Vword_combining_categories, doc: /* List of pair (cons) of categories to determine word boundary. diff --git a/src/ccl.c b/src/ccl.c index 30d151f00a0..9cfcbfe8703 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -2305,23 +2305,12 @@ syms_of_ccl (void) staticpro (&Vccl_program_table); Vccl_program_table = Fmake_vector (make_number (32), Qnil); - Qccl = intern_c_string ("ccl"); - staticpro (&Qccl); - - Qcclp = intern_c_string ("cclp"); - staticpro (&Qcclp); - - Qccl_program = intern_c_string ("ccl-program"); - staticpro (&Qccl_program); - - Qccl_program_idx = intern_c_string ("ccl-program-idx"); - staticpro (&Qccl_program_idx); - - Qcode_conversion_map = intern_c_string ("code-conversion-map"); - staticpro (&Qcode_conversion_map); - - Qcode_conversion_map_id = intern_c_string ("code-conversion-map-id"); - staticpro (&Qcode_conversion_map_id); + DEFSYM (Qccl, "ccl"); + DEFSYM (Qcclp, "cclp"); + DEFSYM (Qccl_program, "ccl-program"); + DEFSYM (Qccl_program_idx, "ccl-program-idx"); + DEFSYM (Qcode_conversion_map, "code-conversion-map"); + DEFSYM (Qcode_conversion_map_id, "code-conversion-map-id"); DEFVAR_LISP ("code-conversion-map-vector", Vcode_conversion_map_vector, doc: /* Vector of code conversion maps. */); diff --git a/src/character.h b/src/character.h index d8e77c50953..063b5147dc9 100644 --- a/src/character.h +++ b/src/character.h @@ -667,7 +667,4 @@ extern Lisp_Object string_escape_byte8 (Lisp_Object); #define GET_TRANSLATION_TABLE(id) \ (XCDR(XVECTOR(Vtranslation_table_vector)->contents[(id)])) -#define DEFSYM(sym, name) \ - do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (0) - #endif /* EMACS_CHARACTER_H */ diff --git a/src/cmds.c b/src/cmds.c index 5dc4d2bfe30..f49cfc221be 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -511,20 +511,11 @@ internal_self_insert (int c, EMACS_INT n) void syms_of_cmds (void) { - Qkill_backward_chars = intern_c_string ("kill-backward-chars"); - staticpro (&Qkill_backward_chars); - - Qkill_forward_chars = intern_c_string ("kill-forward-chars"); - staticpro (&Qkill_forward_chars); - - Qoverwrite_mode_binary = intern_c_string ("overwrite-mode-binary"); - staticpro (&Qoverwrite_mode_binary); - - Qexpand_abbrev = intern_c_string ("expand-abbrev"); - staticpro (&Qexpand_abbrev); - - Qpost_self_insert_hook = intern_c_string ("post-self-insert-hook"); - staticpro (&Qpost_self_insert_hook); + DEFSYM (Qkill_backward_chars, "kill-backward-chars"); + DEFSYM (Qkill_forward_chars, "kill-forward-chars"); + DEFSYM (Qoverwrite_mode_binary, "overwrite-mode-binary"); + DEFSYM (Qexpand_abbrev, "expand-abbrev"); + DEFSYM (Qpost_self_insert_hook, "post-self-insert-hook"); DEFVAR_LISP ("post-self-insert-hook", Vpost_self_insert_hook, doc: /* Hook run at the end of `self-insert-command'. diff --git a/src/coding.c b/src/coding.c index 9939774ea82..65c8a767c2b 100644 --- a/src/coding.c +++ b/src/coding.c @@ -9000,7 +9000,7 @@ not fully specified.) */) (Lisp_Object string, Lisp_Object coding_system, Lisp_Object nocopy, Lisp_Object buffer) { return code_convert_string (string, coding_system, buffer, - 1, ! NILP (nocopy), 1); + 1, ! NILP (nocopy), 0); } diff --git a/src/composite.c b/src/composite.c index 7123b505e68..577640f6fb7 100644 --- a/src/composite.c +++ b/src/composite.c @@ -1936,8 +1936,7 @@ syms_of_composite (void) { int i; - Qcomposition = intern_c_string ("composition"); - staticpro (&Qcomposition); + DEFSYM (Qcomposition, "composition"); /* Make a hash table for static composition. */ { @@ -1996,11 +1995,8 @@ valid. The default value is the function `compose-chars-after'. */); Vcompose_chars_after_function = intern_c_string ("compose-chars-after"); - Qauto_composed = intern_c_string ("auto-composed"); - staticpro (&Qauto_composed); - - Qauto_composition_function = intern_c_string ("auto-composition-function"); - staticpro (&Qauto_composition_function); + DEFSYM (Qauto_composed, "auto-composed"); + DEFSYM (Qauto_composition_function, "auto-composition-function"); DEFVAR_LISP ("auto-composition-mode", Vauto_composition_mode, doc: /* Non-nil if Auto-Composition mode is enabled. diff --git a/src/dbusbind.c b/src/dbusbind.c index 302b93146fd..4828f4e968d 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -2189,142 +2189,76 @@ void syms_of_dbusbind (void) { - Qdbus_init_bus = intern_c_string ("dbus-init-bus"); - staticpro (&Qdbus_init_bus); + DEFSYM (Qdbus_init_bus, "dbus-init-bus"); defsubr (&Sdbus_init_bus); - Qdbus_close_bus = intern_c_string ("dbus-close-bus"); - staticpro (&Qdbus_close_bus); + DEFSYM (Qdbus_close_bus, "dbus-close-bus"); defsubr (&Sdbus_close_bus); - Qdbus_get_unique_name = intern_c_string ("dbus-get-unique-name"); - staticpro (&Qdbus_get_unique_name); + DEFSYM (Qdbus_get_unique_name, "dbus-get-unique-name"); defsubr (&Sdbus_get_unique_name); - Qdbus_call_method = intern_c_string ("dbus-call-method"); - staticpro (&Qdbus_call_method); + DEFSYM (Qdbus_call_method, "dbus-call-method"); defsubr (&Sdbus_call_method); - Qdbus_call_method_asynchronously - = intern_c_string ("dbus-call-method-asynchronously"); - staticpro (&Qdbus_call_method_asynchronously); + DEFSYM (Qdbus_call_method_asynchronously, "dbus-call-method-asynchronously"); defsubr (&Sdbus_call_method_asynchronously); - Qdbus_method_return_internal - = intern_c_string ("dbus-method-return-internal"); - staticpro (&Qdbus_method_return_internal); + DEFSYM (Qdbus_method_return_internal, "dbus-method-return-internal"); defsubr (&Sdbus_method_return_internal); - Qdbus_method_error_internal = intern_c_string ("dbus-method-error-internal"); - staticpro (&Qdbus_method_error_internal); + DEFSYM (Qdbus_method_error_internal, "dbus-method-error-internal"); defsubr (&Sdbus_method_error_internal); - Qdbus_send_signal = intern_c_string ("dbus-send-signal"); - staticpro (&Qdbus_send_signal); + DEFSYM (Qdbus_send_signal, "dbus-send-signal"); defsubr (&Sdbus_send_signal); - Qdbus_register_service = intern_c_string ("dbus-register-service"); - staticpro (&Qdbus_register_service); + DEFSYM (Qdbus_register_service, "dbus-register-service"); defsubr (&Sdbus_register_service); - Qdbus_register_signal = intern_c_string ("dbus-register-signal"); - staticpro (&Qdbus_register_signal); + DEFSYM (Qdbus_register_signal, "dbus-register-signal"); defsubr (&Sdbus_register_signal); - Qdbus_register_method = intern_c_string ("dbus-register-method"); - staticpro (&Qdbus_register_method); + DEFSYM (Qdbus_register_method, "dbus-register-method"); defsubr (&Sdbus_register_method); - Qdbus_error = intern_c_string ("dbus-error"); - staticpro (&Qdbus_error); + DEFSYM (Qdbus_error, "dbus-error"); Fput (Qdbus_error, Qerror_conditions, list2 (Qdbus_error, Qerror)); Fput (Qdbus_error, Qerror_message, make_pure_c_string ("D-Bus error")); - QCdbus_system_bus = intern_c_string (":system"); - staticpro (&QCdbus_system_bus); - - QCdbus_session_bus = intern_c_string (":session"); - staticpro (&QCdbus_session_bus); - - QCdbus_request_name_allow_replacement - = intern_c_string (":allow-replacement"); - staticpro (&QCdbus_request_name_allow_replacement); - - QCdbus_request_name_replace_existing = intern_c_string (":replace-existing"); - staticpro (&QCdbus_request_name_replace_existing); - - QCdbus_request_name_do_not_queue = intern_c_string (":do-not-queue"); - staticpro (&QCdbus_request_name_do_not_queue); - - QCdbus_request_name_reply_primary_owner = intern_c_string (":primary-owner"); - staticpro (&QCdbus_request_name_reply_primary_owner); - - QCdbus_request_name_reply_exists = intern_c_string (":exists"); - staticpro (&QCdbus_request_name_reply_exists); - - QCdbus_request_name_reply_in_queue = intern_c_string (":in-queue"); - staticpro (&QCdbus_request_name_reply_in_queue); - - QCdbus_request_name_reply_already_owner = intern_c_string (":already-owner"); - staticpro (&QCdbus_request_name_reply_already_owner); - - QCdbus_timeout = intern_c_string (":timeout"); - staticpro (&QCdbus_timeout); - - QCdbus_type_byte = intern_c_string (":byte"); - staticpro (&QCdbus_type_byte); - - QCdbus_type_boolean = intern_c_string (":boolean"); - staticpro (&QCdbus_type_boolean); - - QCdbus_type_int16 = intern_c_string (":int16"); - staticpro (&QCdbus_type_int16); - - QCdbus_type_uint16 = intern_c_string (":uint16"); - staticpro (&QCdbus_type_uint16); - - QCdbus_type_int32 = intern_c_string (":int32"); - staticpro (&QCdbus_type_int32); - - QCdbus_type_uint32 = intern_c_string (":uint32"); - staticpro (&QCdbus_type_uint32); - - QCdbus_type_int64 = intern_c_string (":int64"); - staticpro (&QCdbus_type_int64); - - QCdbus_type_uint64 = intern_c_string (":uint64"); - staticpro (&QCdbus_type_uint64); - - QCdbus_type_double = intern_c_string (":double"); - staticpro (&QCdbus_type_double); - - QCdbus_type_string = intern_c_string (":string"); - staticpro (&QCdbus_type_string); - - QCdbus_type_object_path = intern_c_string (":object-path"); - staticpro (&QCdbus_type_object_path); - - QCdbus_type_signature = intern_c_string (":signature"); - staticpro (&QCdbus_type_signature); + DEFSYM (QCdbus_system_bus, ":system"); + DEFSYM (QCdbus_session_bus, ":session"); + DEFSYM (QCdbus_request_name_allow_replacement, ":allow-replacement"); + DEFSYM (QCdbus_request_name_replace_existing, ":replace-existing"); + DEFSYM (QCdbus_request_name_do_not_queue, ":do-not-queue"); + DEFSYM (QCdbus_request_name_reply_primary_owner, ":primary-owner"); + DEFSYM (QCdbus_request_name_reply_exists, ":exists"); + DEFSYM (QCdbus_request_name_reply_in_queue, ":in-queue"); + DEFSYM (QCdbus_request_name_reply_already_owner, ":already-owner"); + DEFSYM (QCdbus_timeout, ":timeout"); + DEFSYM (QCdbus_type_byte, ":byte"); + DEFSYM (QCdbus_type_boolean, ":boolean"); + DEFSYM (QCdbus_type_int16, ":int16"); + DEFSYM (QCdbus_type_uint16, ":uint16"); + DEFSYM (QCdbus_type_int32, ":int32"); + DEFSYM (QCdbus_type_uint32, ":uint32"); + DEFSYM (QCdbus_type_int64, ":int64"); + DEFSYM (QCdbus_type_uint64, ":uint64"); + DEFSYM (QCdbus_type_double, ":double"); + DEFSYM (QCdbus_type_string, ":string"); + DEFSYM (QCdbus_type_object_path, ":object-path"); + DEFSYM (QCdbus_type_signature, ":signature"); #ifdef DBUS_TYPE_UNIX_FD - QCdbus_type_unix_fd = intern_c_string (":unix-fd"); - staticpro (&QCdbus_type_unix_fd); + DEFSYM (QCdbus_type_unix_fd, ":unix-fd"); #endif - QCdbus_type_array = intern_c_string (":array"); - staticpro (&QCdbus_type_array); - - QCdbus_type_variant = intern_c_string (":variant"); - staticpro (&QCdbus_type_variant); - - QCdbus_type_struct = intern_c_string (":struct"); - staticpro (&QCdbus_type_struct); - - QCdbus_type_dict_entry = intern_c_string (":dict-entry"); - staticpro (&QCdbus_type_dict_entry); + DEFSYM (QCdbus_type_array, ":array"); + DEFSYM (QCdbus_type_variant, ":variant"); + DEFSYM (QCdbus_type_struct, ":struct"); + DEFSYM (QCdbus_type_dict_entry, ":dict-entry"); DEFVAR_LISP ("dbus-registered-buses", Vdbus_registered_buses, diff --git a/src/dired.c b/src/dired.c index 3ab1ba8a900..415f9ac5ae5 100644 --- a/src/dired.c +++ b/src/dired.c @@ -1017,21 +1017,13 @@ Comparison is in lexicographic order and case is significant. */) void syms_of_dired (void) { - Qdirectory_files = intern_c_string ("directory-files"); - Qdirectory_files_and_attributes = intern_c_string ("directory-files-and-attributes"); - Qfile_name_completion = intern_c_string ("file-name-completion"); - Qfile_name_all_completions = intern_c_string ("file-name-all-completions"); - Qfile_attributes = intern_c_string ("file-attributes"); - Qfile_attributes_lessp = intern_c_string ("file-attributes-lessp"); - Qdefault_directory = intern_c_string ("default-directory"); - - staticpro (&Qdirectory_files); - staticpro (&Qdirectory_files_and_attributes); - staticpro (&Qfile_name_completion); - staticpro (&Qfile_name_all_completions); - staticpro (&Qfile_attributes); - staticpro (&Qfile_attributes_lessp); - staticpro (&Qdefault_directory); + DEFSYM (Qdirectory_files, "directory-files"); + DEFSYM (Qdirectory_files_and_attributes, "directory-files-and-attributes"); + DEFSYM (Qfile_name_completion, "file-name-completion"); + DEFSYM (Qfile_name_all_completions, "file-name-all-completions"); + DEFSYM (Qfile_attributes, "file-attributes"); + DEFSYM (Qfile_attributes_lessp, "file-attributes-lessp"); + DEFSYM (Qdefault_directory, "default-directory"); defsubr (&Sdirectory_files); defsubr (&Sdirectory_files_and_attributes); diff --git a/src/dispnew.c b/src/dispnew.c index 21df105971b..8691c921853 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -4543,6 +4543,7 @@ scrolling_window (struct window *w, int header_line_p) /* Copy on the display. */ if (r->current_y != r->desired_y) { + rif->clear_window_mouse_face (w); rif->scroll_run_hook (w, r); /* Invalidate runs that copy from where we copied to. */ @@ -6438,10 +6439,8 @@ syms_of_display (void) frame_and_buffer_state = Fmake_vector (make_number (20), Qlambda); staticpro (&frame_and_buffer_state); - Qdisplay_table = intern_c_string ("display-table"); - staticpro (&Qdisplay_table); - Qredisplay_dont_pause = intern_c_string ("redisplay-dont-pause"); - staticpro (&Qredisplay_dont_pause); + DEFSYM (Qdisplay_table, "display-table"); + DEFSYM (Qredisplay_dont_pause, "redisplay-dont-pause"); DEFVAR_INT ("baud-rate", baud_rate, doc: /* *The output baud rate of the terminal. diff --git a/src/doc.c b/src/doc.c index 48e0936510b..69646f5af51 100644 --- a/src/doc.c +++ b/src/doc.c @@ -945,8 +945,7 @@ a new string, without any text properties, is returned. */) void syms_of_doc (void) { - Qfunction_documentation = intern_c_string ("function-documentation"); - staticpro (&Qfunction_documentation); + DEFSYM (Qfunction_documentation, "function-documentation"); DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name, doc: /* Name of file containing documentation strings of built-in symbols. */); diff --git a/src/editfns.c b/src/editfns.c index c0c0e530265..bb36d0dee71 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -1700,7 +1700,7 @@ For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z". */) (Lisp_Object format_string, Lisp_Object timeval, Lisp_Object universal) { time_t value; - int size; + ptrdiff_t size; int usec; int ns; struct tm *tm; @@ -1717,7 +1717,9 @@ For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z". */) Vlocale_coding_system, 1); /* This is probably enough. */ - size = SBYTES (format_string) * 6 + 50; + size = SBYTES (format_string); + if (size <= (STRING_BYTES_BOUND - 50) / 6) + size = size * 6 + 50; BLOCK_INPUT; tm = ut ? gmtime (&value) : localtime (&value); @@ -1730,7 +1732,7 @@ For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z". */) while (1) { char *buf = (char *) alloca (size + 1); - int result; + size_t result; buf[0] = '\1'; BLOCK_INPUT; @@ -1749,6 +1751,8 @@ For example, to produce full ISO 8601 format, use "%Y-%m-%dT%T%z". */) SBYTES (format_string), tm, ut, ns); UNBLOCK_INPUT; + if (STRING_BYTES_BOUND <= result) + string_overflow (); size = result + 1; } } @@ -3557,7 +3561,8 @@ The width specifier supplies a lower limit for the length of the printed representation. The padding, if any, normally goes on the left, but it goes on the right if the - flag is present. The padding character is normally a space, but it is 0 if the 0 flag is present. -The - flag takes precedence over the 0 flag. +The 0 flag is ignored if the - flag is present, or the format sequence +is something other than %d, %e, %f, and %g. For %e, %f, and %g sequences, the number after the "." in the precision specifier says how many decimal places to show; if zero, the @@ -4738,9 +4743,7 @@ syms_of_editfns (void) environbuf = 0; initial_tz = 0; - Qbuffer_access_fontify_functions - = intern_c_string ("buffer-access-fontify-functions"); - staticpro (&Qbuffer_access_fontify_functions); + DEFSYM (Qbuffer_access_fontify_functions, "buffer-access-fontify-functions"); DEFVAR_LISP ("inhibit-field-text-motion", Vinhibit_field_text_motion, doc: /* Non-nil means text motion commands don't notice fields. */); @@ -4802,10 +4805,8 @@ functions if all the text being accessed has this property. */); defsubr (&Sregion_beginning); defsubr (&Sregion_end); - staticpro (&Qfield); - Qfield = intern_c_string ("field"); - staticpro (&Qboundary); - Qboundary = intern_c_string ("boundary"); + DEFSYM (Qfield, "field"); + DEFSYM (Qboundary, "boundary"); defsubr (&Sfield_beginning); defsubr (&Sfield_end); defsubr (&Sfield_string); diff --git a/src/emacs.c b/src/emacs.c index c4b4caad9b5..e4b3a68a6c1 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -2375,10 +2375,8 @@ from the parent process and its tty file descriptors. */) void syms_of_emacs (void) { - Qfile_name_handler_alist = intern_c_string ("file-name-handler-alist"); - staticpro (&Qfile_name_handler_alist); - Qrisky_local_variable = intern_c_string ("risky-local-variable"); - staticpro (&Qrisky_local_variable); + DEFSYM (Qfile_name_handler_alist, "file-name-handler-alist"); + DEFSYM (Qrisky_local_variable, "risky-local-variable"); #ifndef CANNOT_DUMP defsubr (&Sdump_emacs); diff --git a/src/emacsgtkfixed.c b/src/emacsgtkfixed.c index fe3514bce93..0b57e2cdf36 100644 --- a/src/emacsgtkfixed.c +++ b/src/emacsgtkfixed.c @@ -1,4 +1,5 @@ /* A Gtk Widget that inherits GtkFixed, but can be shrinked. +This file is only use when compiling with Gtk+ 3. Copyright (C) 2011 Free Software Foundation, Inc. @@ -17,12 +18,19 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ -#include "emacsgtkfixed.h" +#include <config.h> +#include "emacsgtkfixed.h" +#include <signal.h> +#include <stdio.h> +#include <setjmp.h> +#include "lisp.h" +#include "frame.h" +#include "xterm.h" struct _EmacsFixedPrivate { - int minwidth, minheight; + struct frame *f; }; @@ -59,7 +67,7 @@ emacs_fixed_init (EmacsFixed *fixed) { fixed->priv = G_TYPE_INSTANCE_GET_PRIVATE (fixed, EMACS_TYPE_FIXED, EmacsFixedPrivate); - fixed->priv->minwidth = fixed->priv->minheight = 0; + fixed->priv->f = 0; } /** @@ -70,17 +78,12 @@ emacs_fixed_init (EmacsFixed *fixed) * Returns: a new #EmacsFixed. */ GtkWidget* -emacs_fixed_new (void) -{ - return g_object_new (EMACS_TYPE_FIXED, NULL); -} - -static GtkWidgetClass * -get_parent_class (EmacsFixed *fixed) +emacs_fixed_new (struct frame *f) { - EmacsFixedClass *klass = EMACS_FIXED_GET_CLASS (fixed); - GtkFixedClass *parent_class = g_type_class_peek_parent (klass); - return (GtkWidgetClass*) parent_class; + EmacsFixed *fixed = g_object_new (EMACS_TYPE_FIXED, NULL); + EmacsFixedPrivate *priv = fixed->priv; + priv->f = f; + return GTK_WIDGET (fixed); } static void @@ -90,9 +93,9 @@ emacs_fixed_get_preferred_width (GtkWidget *widget, { EmacsFixed *fixed = EMACS_FIXED (widget); EmacsFixedPrivate *priv = fixed->priv; - GtkWidgetClass *widget_class = get_parent_class (fixed); - widget_class->get_preferred_width (widget, minimum, natural); - if (minimum) *minimum = priv->minwidth; + int w = priv->f->output_data.x->size_hints.min_width; + if (minimum) *minimum = w; + if (natural) *natural = w; } static void @@ -102,22 +105,62 @@ emacs_fixed_get_preferred_height (GtkWidget *widget, { EmacsFixed *fixed = EMACS_FIXED (widget); EmacsFixedPrivate *priv = fixed->priv; - GtkWidgetClass *widget_class = get_parent_class (fixed); - widget_class->get_preferred_height (widget, minimum, natural); - if (minimum) *minimum = priv->minheight; + int h = priv->f->output_data.x->size_hints.min_height; + if (minimum) *minimum = h; + if (natural) *natural = h; } + +/* Override the X function so we can intercept Gtk+ 3 calls. + Use our values for min_width/height so that KDE don't freak out + (Bug#8919), and so users can resize our frames as they wish. */ + void -emacs_fixed_set_min_size (EmacsFixed *widget, int width, int height) +XSetWMSizeHints(Display* d, + Window w, + XSizeHints* hints, + Atom prop) { - EmacsFixedPrivate *priv = widget->priv; - GtkWidgetClass *widget_class = get_parent_class (widget); - int mw, nw, mh, nh; - - widget_class->get_preferred_height (GTK_WIDGET (widget), &mh, &nh); - widget_class->get_preferred_width (GTK_WIDGET (widget), &mw, &nw); + struct x_display_info *dpyinfo = x_display_info_for_display (d); + struct frame *f = x_top_window_to_frame (dpyinfo, w); + long data[18]; + data[0] = hints->flags; + data[1] = hints->x; + data[2] = hints->y; + data[3] = hints->width; + data[4] = hints->height; + data[5] = hints->min_width; + data[6] = hints->min_height; + data[7] = hints->max_width; + data[8] = hints->max_height; + data[9] = hints->width_inc; + data[10] = hints->height_inc; + data[11] = hints->min_aspect.x; + data[12] = hints->min_aspect.y; + data[13] = hints->max_aspect.x; + data[14] = hints->max_aspect.y; + data[15] = hints->base_width; + data[16] = hints->base_height; + data[17] = hints->win_gravity; + + if ((hints->flags & PMinSize) && f) + { + int w = f->output_data.x->size_hints.min_width; + int h = f->output_data.x->size_hints.min_height; + data[5] = w; + data[6] = h; + } + + XChangeProperty (d, w, prop, XA_WM_SIZE_HINTS, 32, PropModeReplace, + (unsigned char *) data, 18); +} - /* Gtk complains if min size is less than natural size. */ - if (width <= nw) priv->minwidth = width; - if (height <= nh) priv->minheight = height; +/* Override this X11 function. + This function is in the same X11 file as the one above. So we must + provide it also. */ + +void +XSetWMNormalHints (Display *d, Window w, XSizeHints *hints) +{ + XSetWMSizeHints (d, w, hints, XA_WM_NORMAL_HINTS); } diff --git a/src/emacsgtkfixed.h b/src/emacsgtkfixed.h index 405374373ec..dbac136bd7f 100644 --- a/src/emacsgtkfixed.h +++ b/src/emacsgtkfixed.h @@ -1,4 +1,5 @@ -/* A Gtk Widget that inherits GtkFixed, but can be shrinked. +/* A Gtk Widget that inherits GtkFixed, but can be shrinked. +This file is only use when compiling with Gtk+ 3. Copyright (C) 2011 Free Software Foundation, Inc. @@ -24,6 +25,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ G_BEGIN_DECLS +struct frame; + #define EMACS_TYPE_FIXED (emacs_fixed_get_type ()) #define EMACS_FIXED(obj) (G_TYPE_CHECK_INSTANCE_CAST ((obj), EMACS_TYPE_FIXED, EmacsFixed)) #define EMACS_FIXED_CLASS(klass) (G_TYPE_CHECK_CLASS_CAST ((klass), EMACS_TYPE_FIXED, EmacsFixedClass)) @@ -49,8 +52,7 @@ struct _EmacsFixedClass GtkFixedClass parent_class; }; -extern GtkWidget *emacs_fixed_new (void); -extern void emacs_fixed_set_min_size (EmacsFixed *widget, int width, int height); +extern GtkWidget *emacs_fixed_new (struct frame *f); extern GType emacs_fixed_get_type (void); G_END_DECLS diff --git a/src/eval.c b/src/eval.c index be582775fea..90d0df61858 100644 --- a/src/eval.c +++ b/src/eval.c @@ -32,25 +32,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "xterm.h" #endif -/* This definition is duplicated in alloc.c and keyboard.c. */ -/* Putting it in lisp.h makes cc bomb out! */ - struct backtrace { struct backtrace *next; Lisp_Object *function; Lisp_Object *args; /* Points to vector of args. */ -#define NARGS_BITS (BITS_PER_INT - 2) - /* Let's not use size_t because we want to allow negative values (for - UNEVALLED). Also let's steal 2 bits so we save a word (or more for - alignment). In any case I doubt Emacs would survive a function call with - more than 500M arguments. */ - int nargs : NARGS_BITS; /* Length of vector. - If nargs is UNEVALLED, args points - to slot holding list of unevalled args. */ - char evalargs : 1; + ptrdiff_t nargs; /* Length of vector. */ /* Nonzero means call value of debugger when done with this operation. */ - char debug_on_exit : 1; + unsigned int debug_on_exit : 1; }; static struct backtrace *backtrace_list; @@ -1651,8 +1640,7 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *), } -static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object, - Lisp_Object, Lisp_Object); +static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object); static int maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data); @@ -1728,8 +1716,7 @@ See also the function `condition-case'. */) for (h = handlerlist; h; h = h->next) { - clause = find_handler_clause (h->handler, conditions, - error_symbol, data); + clause = find_handler_clause (h->handler, conditions); if (!NILP (clause)) break; } @@ -1900,8 +1887,10 @@ skip_debugger (Lisp_Object conditions, Lisp_Object data) } /* Call the debugger if calling it is currently enabled for CONDITIONS. - SIG and DATA describe the signal, as in find_handler_clause. */ - + SIG and DATA describe the signal. There are two ways to pass them: + = SIG is the error symbol, and DATA is the rest of the data. + = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA). + This is for memory-full errors only. */ static int maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data) { @@ -1928,19 +1917,8 @@ maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data) return 0; } -/* Value of Qlambda means we have called debugger and user has continued. - There are two ways to pass SIG and DATA: - = SIG is the error symbol, and DATA is the rest of the data. - = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA). - This is for memory-full errors only. - - We need to increase max_specpdl_size temporarily around - anything we do that can push on the specpdl, so as not to get - a second error here in case we're handling specpdl overflow. */ - static Lisp_Object -find_handler_clause (Lisp_Object handlers, Lisp_Object conditions, - Lisp_Object sig, Lisp_Object data) +find_handler_clause (Lisp_Object handlers, Lisp_Object conditions) { register Lisp_Object h; @@ -2291,7 +2269,6 @@ eval_sub (Lisp_Object form) backtrace.function = &original_fun; /* This also protects them from gc. */ backtrace.args = &original_args; backtrace.nargs = UNEVALLED; - backtrace.evalargs = 1; backtrace.debug_on_exit = 0; if (debug_on_next_call) @@ -2325,10 +2302,7 @@ eval_sub (Lisp_Object form) xsignal2 (Qwrong_number_of_arguments, original_fun, numargs); else if (XSUBR (fun)->max_args == UNEVALLED) - { - backtrace.evalargs = 0; - val = (XSUBR (fun)->function.aUNEVALLED) (args_left); - } + val = (XSUBR (fun)->function.aUNEVALLED) (args_left); else if (XSUBR (fun)->max_args == MANY) { /* Pass a vector of evaluated arguments. */ @@ -2984,7 +2958,6 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) backtrace.function = &args[0]; backtrace.args = &args[1]; backtrace.nargs = nargs - 1; - backtrace.evalargs = 0; backtrace.debug_on_exit = 0; if (debug_on_next_call) @@ -3141,7 +3114,6 @@ apply_lambda (Lisp_Object fun, Lisp_Object args) backtrace_list->args = arg_vector; backtrace_list->nargs = i; - backtrace_list->evalargs = 0; tem = funcall_lambda (fun, numargs, arg_vector); /* Do the debug-on-exit now, while arg_vector still exists. */ @@ -3190,7 +3162,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, shouldn't bind any arguments, instead just call the byte-code interpreter directly; it will push arguments as necessary. - Byte-code objects with either a non-existant, or a nil value for + Byte-code objects with either a non-existent, or a nil value for the `push args' slot (the default), have dynamically-bound arguments, and use the argument-binding code below instead (as do all interpreted functions, even lexically bound ones). */ @@ -3694,46 +3666,23 @@ To prevent this happening, set `quit-flag' to nil before making `inhibit-quit' nil. */); Vinhibit_quit = Qnil; - Qinhibit_quit = intern_c_string ("inhibit-quit"); - staticpro (&Qinhibit_quit); - - Qautoload = intern_c_string ("autoload"); - staticpro (&Qautoload); - - Qdebug_on_error = intern_c_string ("debug-on-error"); - staticpro (&Qdebug_on_error); - - Qmacro = intern_c_string ("macro"); - staticpro (&Qmacro); - - Qdeclare = intern_c_string ("declare"); - staticpro (&Qdeclare); + DEFSYM (Qinhibit_quit, "inhibit-quit"); + DEFSYM (Qautoload, "autoload"); + DEFSYM (Qdebug_on_error, "debug-on-error"); + DEFSYM (Qmacro, "macro"); + DEFSYM (Qdeclare, "declare"); /* Note that the process handling also uses Qexit, but we don't want to staticpro it twice, so we just do it here. */ - Qexit = intern_c_string ("exit"); - staticpro (&Qexit); - - Qinteractive = intern_c_string ("interactive"); - staticpro (&Qinteractive); - - Qcommandp = intern_c_string ("commandp"); - staticpro (&Qcommandp); - - Qdefun = intern_c_string ("defun"); - staticpro (&Qdefun); - - Qand_rest = intern_c_string ("&rest"); - staticpro (&Qand_rest); - - Qand_optional = intern_c_string ("&optional"); - staticpro (&Qand_optional); - - Qclosure = intern_c_string ("closure"); - staticpro (&Qclosure); + DEFSYM (Qexit, "exit"); - Qdebug = intern_c_string ("debug"); - staticpro (&Qdebug); + DEFSYM (Qinteractive, "interactive"); + DEFSYM (Qcommandp, "commandp"); + DEFSYM (Qdefun, "defun"); + DEFSYM (Qand_rest, "&rest"); + DEFSYM (Qand_optional, "&optional"); + DEFSYM (Qclosure, "closure"); + DEFSYM (Qdebug, "debug"); DEFVAR_LISP ("debug-on-error", Vdebug_on_error, doc: /* *Non-nil means enter debugger if an error is signaled. @@ -3807,9 +3756,7 @@ The value the function returns is not used. */); Every element of this list can be either a cons (VAR . VAL) specifying a lexical binding, or a single symbol VAR indicating that this variable should use dynamic scoping. */ - Qinternal_interpreter_environment - = intern_c_string ("internal-interpreter-environment"); - staticpro (&Qinternal_interpreter_environment); + DEFSYM (Qinternal_interpreter_environment, "internal-interpreter-environment"); DEFVAR_LISP ("internal-interpreter-environment", Vinternal_interpreter_environment, doc: /* If non-nil, the current lexical environment of the lisp interpreter. @@ -3821,8 +3768,7 @@ alist of active lexical bindings. */); (Just imagine if someone makes it buffer-local). */ Funintern (Qinternal_interpreter_environment, Qnil); - Vrun_hooks = intern_c_string ("run-hooks"); - staticpro (&Vrun_hooks); + DEFSYM (Vrun_hooks, "run-hooks"); staticpro (&Vautoload_queue); Vautoload_queue = Qnil; diff --git a/src/fileio.c b/src/fileio.c index 824df8172e7..c6f8dfe4683 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -1755,6 +1755,10 @@ barf_or_query_if_file_exists (Lisp_Object absname, const char *querystring, regardless of what access permissions it has. */ if (lstat (SSDATA (encoded_filename), &statbuf) >= 0) { + if (S_ISDIR (statbuf.st_mode)) + xsignal2 (Qfile_error, + build_string ("File is a directory"), absname); + if (! interactive) xsignal2 (Qfile_already_exists, build_string ("File already exists"), absname); @@ -5425,92 +5429,50 @@ Fread_file_name (Lisp_Object prompt, Lisp_Object dir, Lisp_Object default_filena void syms_of_fileio (void) { - Qoperations = intern_c_string ("operations"); - Qexpand_file_name = intern_c_string ("expand-file-name"); - Qsubstitute_in_file_name = intern_c_string ("substitute-in-file-name"); - Qdirectory_file_name = intern_c_string ("directory-file-name"); - Qfile_name_directory = intern_c_string ("file-name-directory"); - Qfile_name_nondirectory = intern_c_string ("file-name-nondirectory"); - Qunhandled_file_name_directory = intern_c_string ("unhandled-file-name-directory"); - Qfile_name_as_directory = intern_c_string ("file-name-as-directory"); - Qcopy_file = intern_c_string ("copy-file"); - Qmake_directory_internal = intern_c_string ("make-directory-internal"); - Qmake_directory = intern_c_string ("make-directory"); - Qdelete_directory_internal = intern_c_string ("delete-directory-internal"); - Qdelete_file = intern_c_string ("delete-file"); - Qrename_file = intern_c_string ("rename-file"); - Qadd_name_to_file = intern_c_string ("add-name-to-file"); - Qmake_symbolic_link = intern_c_string ("make-symbolic-link"); - Qfile_exists_p = intern_c_string ("file-exists-p"); - Qfile_executable_p = intern_c_string ("file-executable-p"); - Qfile_readable_p = intern_c_string ("file-readable-p"); - Qfile_writable_p = intern_c_string ("file-writable-p"); - Qfile_symlink_p = intern_c_string ("file-symlink-p"); - Qaccess_file = intern_c_string ("access-file"); - Qfile_directory_p = intern_c_string ("file-directory-p"); - Qfile_regular_p = intern_c_string ("file-regular-p"); - Qfile_accessible_directory_p = intern_c_string ("file-accessible-directory-p"); - Qfile_modes = intern_c_string ("file-modes"); - Qset_file_modes = intern_c_string ("set-file-modes"); - Qset_file_times = intern_c_string ("set-file-times"); - Qfile_selinux_context = intern_c_string("file-selinux-context"); - Qset_file_selinux_context = intern_c_string("set-file-selinux-context"); - Qfile_newer_than_file_p = intern_c_string ("file-newer-than-file-p"); - Qinsert_file_contents = intern_c_string ("insert-file-contents"); - Qwrite_region = intern_c_string ("write-region"); - Qverify_visited_file_modtime = intern_c_string ("verify-visited-file-modtime"); - Qset_visited_file_modtime = intern_c_string ("set-visited-file-modtime"); - Qauto_save_coding = intern_c_string ("auto-save-coding"); - - staticpro (&Qoperations); - staticpro (&Qexpand_file_name); - staticpro (&Qsubstitute_in_file_name); - staticpro (&Qdirectory_file_name); - staticpro (&Qfile_name_directory); - staticpro (&Qfile_name_nondirectory); - staticpro (&Qunhandled_file_name_directory); - staticpro (&Qfile_name_as_directory); - staticpro (&Qcopy_file); - staticpro (&Qmake_directory_internal); - staticpro (&Qmake_directory); - staticpro (&Qdelete_directory_internal); - staticpro (&Qdelete_file); - staticpro (&Qrename_file); - staticpro (&Qadd_name_to_file); - staticpro (&Qmake_symbolic_link); - staticpro (&Qfile_exists_p); - staticpro (&Qfile_executable_p); - staticpro (&Qfile_readable_p); - staticpro (&Qfile_writable_p); - staticpro (&Qaccess_file); - staticpro (&Qfile_symlink_p); - staticpro (&Qfile_directory_p); - staticpro (&Qfile_regular_p); - staticpro (&Qfile_accessible_directory_p); - staticpro (&Qfile_modes); - staticpro (&Qset_file_modes); - staticpro (&Qset_file_times); - staticpro (&Qfile_selinux_context); - staticpro (&Qset_file_selinux_context); - staticpro (&Qfile_newer_than_file_p); - staticpro (&Qinsert_file_contents); - staticpro (&Qwrite_region); - staticpro (&Qverify_visited_file_modtime); - staticpro (&Qset_visited_file_modtime); - staticpro (&Qauto_save_coding); - - Qfile_name_history = intern_c_string ("file-name-history"); + DEFSYM (Qoperations, "operations"); + DEFSYM (Qexpand_file_name, "expand-file-name"); + DEFSYM (Qsubstitute_in_file_name, "substitute-in-file-name"); + DEFSYM (Qdirectory_file_name, "directory-file-name"); + DEFSYM (Qfile_name_directory, "file-name-directory"); + DEFSYM (Qfile_name_nondirectory, "file-name-nondirectory"); + DEFSYM (Qunhandled_file_name_directory, "unhandled-file-name-directory"); + DEFSYM (Qfile_name_as_directory, "file-name-as-directory"); + DEFSYM (Qcopy_file, "copy-file"); + DEFSYM (Qmake_directory_internal, "make-directory-internal"); + DEFSYM (Qmake_directory, "make-directory"); + DEFSYM (Qdelete_directory_internal, "delete-directory-internal"); + DEFSYM (Qdelete_file, "delete-file"); + DEFSYM (Qrename_file, "rename-file"); + DEFSYM (Qadd_name_to_file, "add-name-to-file"); + DEFSYM (Qmake_symbolic_link, "make-symbolic-link"); + DEFSYM (Qfile_exists_p, "file-exists-p"); + DEFSYM (Qfile_executable_p, "file-executable-p"); + DEFSYM (Qfile_readable_p, "file-readable-p"); + DEFSYM (Qfile_writable_p, "file-writable-p"); + DEFSYM (Qfile_symlink_p, "file-symlink-p"); + DEFSYM (Qaccess_file, "access-file"); + DEFSYM (Qfile_directory_p, "file-directory-p"); + DEFSYM (Qfile_regular_p, "file-regular-p"); + DEFSYM (Qfile_accessible_directory_p, "file-accessible-directory-p"); + DEFSYM (Qfile_modes, "file-modes"); + DEFSYM (Qset_file_modes, "set-file-modes"); + DEFSYM (Qset_file_times, "set-file-times"); + DEFSYM (Qfile_selinux_context, "file-selinux-context"); + DEFSYM (Qset_file_selinux_context, "set-file-selinux-context"); + DEFSYM (Qfile_newer_than_file_p, "file-newer-than-file-p"); + DEFSYM (Qinsert_file_contents, "insert-file-contents"); + DEFSYM (Qwrite_region, "write-region"); + DEFSYM (Qverify_visited_file_modtime, "verify-visited-file-modtime"); + DEFSYM (Qset_visited_file_modtime, "set-visited-file-modtime"); + DEFSYM (Qauto_save_coding, "auto-save-coding"); + + DEFSYM (Qfile_name_history, "file-name-history"); Fset (Qfile_name_history, Qnil); - staticpro (&Qfile_name_history); - Qfile_error = intern_c_string ("file-error"); - staticpro (&Qfile_error); - Qfile_already_exists = intern_c_string ("file-already-exists"); - staticpro (&Qfile_already_exists); - Qfile_date_error = intern_c_string ("file-date-error"); - staticpro (&Qfile_date_error); - Qexcl = intern_c_string ("excl"); - staticpro (&Qexcl); + DEFSYM (Qfile_error, "file-error"); + DEFSYM (Qfile_already_exists, "file-already-exists"); + DEFSYM (Qfile_date_error, "file-date-error"); + DEFSYM (Qexcl, "excl"); DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system, doc: /* *Coding system for encoding file names. @@ -5528,15 +5490,10 @@ instead use `file-name-coding-system' to get a constant encoding of file names regardless of the current language environment. */); Vdefault_file_name_coding_system = Qnil; - Qformat_decode = intern_c_string ("format-decode"); - staticpro (&Qformat_decode); - Qformat_annotate_function = intern_c_string ("format-annotate-function"); - staticpro (&Qformat_annotate_function); - Qafter_insert_file_set_coding = intern_c_string ("after-insert-file-set-coding"); - staticpro (&Qafter_insert_file_set_coding); - - Qcar_less_than_car = intern_c_string ("car-less-than-car"); - staticpro (&Qcar_less_than_car); + DEFSYM (Qformat_decode, "format-decode"); + DEFSYM (Qformat_annotate_function, "format-annotate-function"); + DEFSYM (Qafter_insert_file_set_coding, "after-insert-file-set-coding"); + DEFSYM (Qcar_less_than_car, "car-less-than-car"); Fput (Qfile_error, Qerror_conditions, Fpurecopy (list2 (Qfile_error, Qerror))); @@ -5615,9 +5572,7 @@ After `write-region' completes, Emacs calls the function stored in current when building the annotations (i.e., at least once), with that buffer current. */); Vwrite_region_annotate_functions = Qnil; - staticpro (&Qwrite_region_annotate_functions); - Qwrite_region_annotate_functions - = intern_c_string ("write-region-annotate-functions"); + DEFSYM (Qwrite_region_annotate_functions, "write-region-annotate-functions"); DEFVAR_LISP ("write-region-post-annotation-function", Vwrite_region_post_annotation_function, @@ -5681,12 +5636,10 @@ This includes interactive calls to `delete-file' and `delete-directory' and the Dired deletion commands. */); delete_by_moving_to_trash = 0; Qdelete_by_moving_to_trash = intern_c_string ("delete-by-moving-to-trash"); - Qmove_file_to_trash = intern_c_string ("move-file-to-trash"); - staticpro (&Qmove_file_to_trash); - Qcopy_directory = intern_c_string ("copy-directory"); - staticpro (&Qcopy_directory); - Qdelete_directory = intern_c_string ("delete-directory"); - staticpro (&Qdelete_directory); + + DEFSYM (Qmove_file_to_trash, "move-file-to-trash"); + DEFSYM (Qcopy_directory, "copy-directory"); + DEFSYM (Qdelete_directory, "delete-directory"); defsubr (&Sfind_file_name_handler); defsubr (&Sfile_name_directory); diff --git a/src/fns.c b/src/fns.c index 5bf274030a3..0ca731ed331 100644 --- a/src/fns.c +++ b/src/fns.c @@ -79,10 +79,14 @@ Other values of LIMIT are ignored. */) { EMACS_INT val; Lisp_Object lispy_val; - EMACS_UINT denominator; if (EQ (limit, Qt)) - seed_random (getpid () + time (NULL)); + { + EMACS_TIME t; + EMACS_GET_TIME (t); + seed_random (getpid () ^ EMACS_SECS (t) ^ EMACS_USECS (t)); + } + if (NATNUMP (limit) && XFASTINT (limit) != 0) { /* Try to take our random number from the higher bits of VAL, @@ -92,7 +96,7 @@ Other values of LIMIT are ignored. */) it's possible to get a quotient larger than n; discarding these values eliminates the bias that would otherwise appear when using a large n. */ - denominator = ((EMACS_UINT) 1 << VALBITS) / XFASTINT (limit); + EMACS_INT denominator = (INTMASK + 1) / XFASTINT (limit); do val = get_random () / denominator; while (val >= XFASTINT (limit)); @@ -2613,6 +2617,7 @@ is not loaded; so load the file FILENAME. If FILENAME is omitted, the printname of FEATURE is used as the file name, and `load' will try to load this name appended with the suffix `.elc' or `.el', in that order. The name without appended suffix will not be used. +See `get-load-suffixes' for the complete list of suffixes. If the optional third argument NOERROR is non-nil, then return nil if the file is not found instead of signaling an error. Normally the return value is FEATURE. @@ -4854,34 +4859,20 @@ syms_of_fns (void) DEFSYM (Qsha512, "sha512"); /* Hash table stuff. */ - Qhash_table_p = intern_c_string ("hash-table-p"); - staticpro (&Qhash_table_p); - Qeq = intern_c_string ("eq"); - staticpro (&Qeq); - Qeql = intern_c_string ("eql"); - staticpro (&Qeql); - Qequal = intern_c_string ("equal"); - staticpro (&Qequal); - QCtest = intern_c_string (":test"); - staticpro (&QCtest); - QCsize = intern_c_string (":size"); - staticpro (&QCsize); - QCrehash_size = intern_c_string (":rehash-size"); - staticpro (&QCrehash_size); - QCrehash_threshold = intern_c_string (":rehash-threshold"); - staticpro (&QCrehash_threshold); - QCweakness = intern_c_string (":weakness"); - staticpro (&QCweakness); - Qkey = intern_c_string ("key"); - staticpro (&Qkey); - Qvalue = intern_c_string ("value"); - staticpro (&Qvalue); - Qhash_table_test = intern_c_string ("hash-table-test"); - staticpro (&Qhash_table_test); - Qkey_or_value = intern_c_string ("key-or-value"); - staticpro (&Qkey_or_value); - Qkey_and_value = intern_c_string ("key-and-value"); - staticpro (&Qkey_and_value); + DEFSYM (Qhash_table_p, "hash-table-p"); + DEFSYM (Qeq, "eq"); + DEFSYM (Qeql, "eql"); + DEFSYM (Qequal, "equal"); + DEFSYM (QCtest, ":test"); + DEFSYM (QCsize, ":size"); + DEFSYM (QCrehash_size, ":rehash-size"); + DEFSYM (QCrehash_threshold, ":rehash-threshold"); + DEFSYM (QCweakness, ":weakness"); + DEFSYM (Qkey, "key"); + DEFSYM (Qvalue, "value"); + DEFSYM (Qhash_table_test, "hash-table-test"); + DEFSYM (Qkey_or_value, "key-or-value"); + DEFSYM (Qkey_and_value, "key-and-value"); defsubr (&Ssxhash); defsubr (&Smake_hash_table); @@ -4900,18 +4891,12 @@ syms_of_fns (void) defsubr (&Smaphash); defsubr (&Sdefine_hash_table_test); - Qstring_lessp = intern_c_string ("string-lessp"); - staticpro (&Qstring_lessp); - Qprovide = intern_c_string ("provide"); - staticpro (&Qprovide); - Qrequire = intern_c_string ("require"); - staticpro (&Qrequire); - Qyes_or_no_p_history = intern_c_string ("yes-or-no-p-history"); - staticpro (&Qyes_or_no_p_history); - Qcursor_in_echo_area = intern_c_string ("cursor-in-echo-area"); - staticpro (&Qcursor_in_echo_area); - Qwidget_type = intern_c_string ("widget-type"); - staticpro (&Qwidget_type); + DEFSYM (Qstring_lessp, "string-lessp"); + DEFSYM (Qprovide, "provide"); + DEFSYM (Qrequire, "require"); + DEFSYM (Qyes_or_no_p_history, "yes-or-no-p-history"); + DEFSYM (Qcursor_in_echo_area, "cursor-in-echo-area"); + DEFSYM (Qwidget_type, "widget-type"); staticpro (&string_char_byte_cache_string); string_char_byte_cache_string = Qnil; @@ -4925,18 +4910,13 @@ syms_of_fns (void) doc: /* A list of symbols which are the features of the executing Emacs. Used by `featurep' and `require', and altered by `provide'. */); Vfeatures = Fcons (intern_c_string ("emacs"), Qnil); - Qsubfeatures = intern_c_string ("subfeatures"); - staticpro (&Qsubfeatures); + DEFSYM (Qsubfeatures, "subfeatures"); #ifdef HAVE_LANGINFO_CODESET - Qcodeset = intern_c_string ("codeset"); - staticpro (&Qcodeset); - Qdays = intern_c_string ("days"); - staticpro (&Qdays); - Qmonths = intern_c_string ("months"); - staticpro (&Qmonths); - Qpaper = intern_c_string ("paper"); - staticpro (&Qpaper); + DEFSYM (Qcodeset, "codeset"); + DEFSYM (Qdays, "days"); + DEFSYM (Qmonths, "months"); + DEFSYM (Qpaper, "paper"); #endif /* HAVE_LANGINFO_CODESET */ DEFVAR_BOOL ("use-dialog-box", use_dialog_box, diff --git a/src/frame.c b/src/frame.c index 27a31fac3e7..635996ca424 100644 --- a/src/frame.c +++ b/src/frame.c @@ -4240,104 +4240,58 @@ selected frame. This is useful when `make-pointer-invisible' is set. */) void syms_of_frame (void) { - Qframep = intern_c_string ("framep"); - staticpro (&Qframep); - Qframe_live_p = intern_c_string ("frame-live-p"); - staticpro (&Qframe_live_p); - Qexplicit_name = intern_c_string ("explicit-name"); - staticpro (&Qexplicit_name); - Qheight = intern_c_string ("height"); - staticpro (&Qheight); - Qicon = intern_c_string ("icon"); - staticpro (&Qicon); - Qminibuffer = intern_c_string ("minibuffer"); - staticpro (&Qminibuffer); - Qmodeline = intern_c_string ("modeline"); - staticpro (&Qmodeline); - Qonly = intern_c_string ("only"); - staticpro (&Qonly); - Qwidth = intern_c_string ("width"); - staticpro (&Qwidth); - Qgeometry = intern_c_string ("geometry"); - staticpro (&Qgeometry); - Qicon_left = intern_c_string ("icon-left"); - staticpro (&Qicon_left); - Qicon_top = intern_c_string ("icon-top"); - staticpro (&Qicon_top); - Qtooltip = intern_c_string ("tooltip"); - staticpro (&Qtooltip); - Qleft = intern_c_string ("left"); - staticpro (&Qleft); - Qright = intern_c_string ("right"); - staticpro (&Qright); - Quser_position = intern_c_string ("user-position"); - staticpro (&Quser_position); - Quser_size = intern_c_string ("user-size"); - staticpro (&Quser_size); - Qwindow_id = intern_c_string ("window-id"); - staticpro (&Qwindow_id); + DEFSYM (Qframep, "framep"); + DEFSYM (Qframe_live_p, "frame-live-p"); + DEFSYM (Qexplicit_name, "explicit-name"); + DEFSYM (Qheight, "height"); + DEFSYM (Qicon, "icon"); + DEFSYM (Qminibuffer, "minibuffer"); + DEFSYM (Qmodeline, "modeline"); + DEFSYM (Qonly, "only"); + DEFSYM (Qwidth, "width"); + DEFSYM (Qgeometry, "geometry"); + DEFSYM (Qicon_left, "icon-left"); + DEFSYM (Qicon_top, "icon-top"); + DEFSYM (Qtooltip, "tooltip"); + DEFSYM (Qleft, "left"); + DEFSYM (Qright, "right"); + DEFSYM (Quser_position, "user-position"); + DEFSYM (Quser_size, "user-size"); + DEFSYM (Qwindow_id, "window-id"); #ifdef HAVE_X_WINDOWS - Qouter_window_id = intern_c_string ("outer-window-id"); - staticpro (&Qouter_window_id); + DEFSYM (Qouter_window_id, "outer-window-id"); #endif - Qparent_id = intern_c_string ("parent-id"); - staticpro (&Qparent_id); - Qx = intern_c_string ("x"); - staticpro (&Qx); - Qw32 = intern_c_string ("w32"); - staticpro (&Qw32); - Qpc = intern_c_string ("pc"); - staticpro (&Qpc); - Qmac = intern_c_string ("mac"); - staticpro (&Qmac); - Qns = intern_c_string ("ns"); - staticpro (&Qns); - Qvisible = intern_c_string ("visible"); - staticpro (&Qvisible); - Qbuffer_predicate = intern_c_string ("buffer-predicate"); - staticpro (&Qbuffer_predicate); - Qbuffer_list = intern_c_string ("buffer-list"); - staticpro (&Qbuffer_list); - Qburied_buffer_list = intern_c_string ("buried-buffer-list"); - staticpro (&Qburied_buffer_list); - Qdisplay_type = intern_c_string ("display-type"); - staticpro (&Qdisplay_type); - Qbackground_mode = intern_c_string ("background-mode"); - staticpro (&Qbackground_mode); - Qnoelisp = intern_c_string ("noelisp"); - staticpro (&Qnoelisp); - Qtty_color_mode = intern_c_string ("tty-color-mode"); - staticpro (&Qtty_color_mode); - Qtty = intern_c_string ("tty"); - staticpro (&Qtty); - Qtty_type = intern_c_string ("tty-type"); - staticpro (&Qtty_type); - - Qface_set_after_frame_default = intern_c_string ("face-set-after-frame-default"); - staticpro (&Qface_set_after_frame_default); - - Qfullwidth = intern_c_string ("fullwidth"); - staticpro (&Qfullwidth); - Qfullheight = intern_c_string ("fullheight"); - staticpro (&Qfullheight); - Qfullboth = intern_c_string ("fullboth"); - staticpro (&Qfullboth); - Qmaximized = intern_c_string ("maximized"); - staticpro (&Qmaximized); - Qx_resource_name = intern_c_string ("x-resource-name"); - staticpro (&Qx_resource_name); - - Qx_frame_parameter = intern_c_string ("x-frame-parameter"); - staticpro (&Qx_frame_parameter); - - Qterminal = intern_c_string ("terminal"); - staticpro (&Qterminal); - Qterminal_live_p = intern_c_string ("terminal-live-p"); - staticpro (&Qterminal_live_p); + DEFSYM (Qparent_id, "parent-id"); + DEFSYM (Qx, "x"); + DEFSYM (Qw32, "w32"); + DEFSYM (Qpc, "pc"); + DEFSYM (Qmac, "mac"); + DEFSYM (Qns, "ns"); + DEFSYM (Qvisible, "visible"); + DEFSYM (Qbuffer_predicate, "buffer-predicate"); + DEFSYM (Qbuffer_list, "buffer-list"); + DEFSYM (Qburied_buffer_list, "buried-buffer-list"); + DEFSYM (Qdisplay_type, "display-type"); + DEFSYM (Qbackground_mode, "background-mode"); + DEFSYM (Qnoelisp, "noelisp"); + DEFSYM (Qtty_color_mode, "tty-color-mode"); + DEFSYM (Qtty, "tty"); + DEFSYM (Qtty_type, "tty-type"); + + DEFSYM (Qface_set_after_frame_default, "face-set-after-frame-default"); + + DEFSYM (Qfullwidth, "fullwidth"); + DEFSYM (Qfullheight, "fullheight"); + DEFSYM (Qfullboth, "fullboth"); + DEFSYM (Qmaximized, "maximized"); + DEFSYM (Qx_resource_name, "x-resource-name"); + DEFSYM (Qx_frame_parameter, "x-frame-parameter"); + + DEFSYM (Qterminal, "terminal"); + DEFSYM (Qterminal_live_p, "terminal-live-p"); #ifdef HAVE_NS - Qns_parse_geometry = intern_c_string ("ns-parse-geometry"); - staticpro (&Qns_parse_geometry); + DEFSYM (Qns_parse_geometry, "ns-parse-geometry"); #endif { @@ -4451,8 +4405,7 @@ actually deleted, or some time later (or even both when an earlier function in `delete-frame-functions' (indirectly) calls `delete-frame' recursively). */); Vdelete_frame_functions = Qnil; - Qdelete_frame_functions = intern_c_string ("delete-frame-functions"); - staticpro (&Qdelete_frame_functions); + DEFSYM (Qdelete_frame_functions, "delete-frame-functions"); DEFVAR_LISP ("menu-bar-mode", Vmenu_bar_mode, doc: /* Non-nil if Menu-Bar mode is enabled. diff --git a/src/fringe.c b/src/fringe.c index d886ac48852..a4dc9433aff 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -1738,18 +1738,12 @@ Return nil if POS is not visible in WINDOW. */) void syms_of_fringe (void) { - Qtruncation = intern_c_string ("truncation"); - staticpro (&Qtruncation); - Qcontinuation = intern_c_string ("continuation"); - staticpro (&Qcontinuation); - Qoverlay_arrow = intern_c_string ("overlay-arrow"); - staticpro (&Qoverlay_arrow); - Qempty_line = intern_c_string ("empty-line"); - staticpro (&Qempty_line); - Qtop_bottom = intern_c_string ("top-bottom"); - staticpro (&Qtop_bottom); - Qhollow_small = intern_c_string ("hollow-small"); - staticpro (&Qhollow_small); + DEFSYM (Qtruncation, "truncation"); + DEFSYM (Qcontinuation, "continuation"); + DEFSYM (Qoverlay_arrow, "overlay-arrow"); + DEFSYM (Qempty_line, "empty-line"); + DEFSYM (Qtop_bottom, "top-bottom"); + DEFSYM (Qhollow_small, "hollow-small"); defsubr (&Sdestroy_fringe_bitmap); defsubr (&Sdefine_fringe_bitmap); diff --git a/src/gnutls.c b/src/gnutls.c index 9342ce7912e..76cfa5dcc98 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -51,7 +51,6 @@ static Lisp_Object Qgnutls_bootprop_callbacks; static Lisp_Object Qgnutls_bootprop_loglevel; static Lisp_Object Qgnutls_bootprop_hostname; static Lisp_Object Qgnutls_bootprop_verify_flags; -static Lisp_Object Qgnutls_bootprop_verify_error; static Lisp_Object Qgnutls_bootprop_verify_hostname_error; /* Callback keys for `gnutls-boot'. Unused currently. */ @@ -380,7 +379,7 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, EMACS_INT nbyte) /* non-fatal error */ return -1; else { - /* a fatal error occured */ + /* a fatal error occurred */ return 0; } } @@ -639,9 +638,6 @@ certificates for `gnutls-x509pki'. :verify-flags is a bitset as per GnuTLS' gnutls_certificate_set_verify_flags. -:verify-error, if non-nil, makes failure of the certificate validation -an error. Otherwise it will be just a series of warnings. - :verify-hostname-error, if non-nil, makes a hostname mismatch an error. Otherwise it will be just a warning. @@ -1101,72 +1097,35 @@ syms_of_gnutls (void) { gnutls_global_initialized = 0; - Qgnutls_dll = intern_c_string ("gnutls"); - staticpro (&Qgnutls_dll); - - Qgnutls_log_level = intern_c_string ("gnutls-log-level"); - staticpro (&Qgnutls_log_level); - - Qgnutls_code = intern_c_string ("gnutls-code"); - staticpro (&Qgnutls_code); - - Qgnutls_anon = intern_c_string ("gnutls-anon"); - staticpro (&Qgnutls_anon); - - Qgnutls_x509pki = intern_c_string ("gnutls-x509pki"); - staticpro (&Qgnutls_x509pki); - - Qgnutls_bootprop_hostname = intern_c_string (":hostname"); - staticpro (&Qgnutls_bootprop_hostname); - - Qgnutls_bootprop_priority = intern_c_string (":priority"); - staticpro (&Qgnutls_bootprop_priority); - - Qgnutls_bootprop_trustfiles = intern_c_string (":trustfiles"); - staticpro (&Qgnutls_bootprop_trustfiles); - - Qgnutls_bootprop_keylist = intern_c_string (":keylist"); - staticpro (&Qgnutls_bootprop_keylist); - - Qgnutls_bootprop_crlfiles = intern_c_string (":crlfiles"); - staticpro (&Qgnutls_bootprop_crlfiles); - - Qgnutls_bootprop_callbacks = intern_c_string (":callbacks"); - staticpro (&Qgnutls_bootprop_callbacks); - - Qgnutls_bootprop_callbacks_verify = intern_c_string ("verify"); - staticpro (&Qgnutls_bootprop_callbacks_verify); - - Qgnutls_bootprop_loglevel = intern_c_string (":loglevel"); - staticpro (&Qgnutls_bootprop_loglevel); - - Qgnutls_bootprop_verify_flags = intern_c_string (":verify-flags"); - staticpro (&Qgnutls_bootprop_verify_flags); - - Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-error"); - staticpro (&Qgnutls_bootprop_verify_error); - - Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-hostname-error"); - staticpro (&Qgnutls_bootprop_verify_hostname_error); - - Qgnutls_e_interrupted = intern_c_string ("gnutls-e-interrupted"); - staticpro (&Qgnutls_e_interrupted); + DEFSYM (Qgnutls_dll, "gnutls"); + DEFSYM (Qgnutls_log_level, "gnutls-log-level"); + DEFSYM (Qgnutls_code, "gnutls-code"); + DEFSYM (Qgnutls_anon, "gnutls-anon"); + DEFSYM (Qgnutls_x509pki, "gnutls-x509pki"); + DEFSYM (Qgnutls_bootprop_hostname, ":hostname"); + DEFSYM (Qgnutls_bootprop_priority, ":priority"); + DEFSYM (Qgnutls_bootprop_trustfiles, ":trustfiles"); + DEFSYM (Qgnutls_bootprop_keylist, ":keylist"); + DEFSYM (Qgnutls_bootprop_crlfiles, ":crlfiles"); + DEFSYM (Qgnutls_bootprop_callbacks, ":callbacks"); + DEFSYM (Qgnutls_bootprop_callbacks_verify, "verify"); + DEFSYM (Qgnutls_bootprop_loglevel, ":loglevel"); + DEFSYM (Qgnutls_bootprop_verify_flags, ":verify-flags"); + DEFSYM (Qgnutls_bootprop_verify_hostname_error, ":verify-hostname-error"); + + DEFSYM (Qgnutls_e_interrupted, "gnutls-e-interrupted"); Fput (Qgnutls_e_interrupted, Qgnutls_code, make_number (GNUTLS_E_INTERRUPTED)); - Qgnutls_e_again = intern_c_string ("gnutls-e-again"); - staticpro (&Qgnutls_e_again); + DEFSYM (Qgnutls_e_again, "gnutls-e-again"); Fput (Qgnutls_e_again, Qgnutls_code, make_number (GNUTLS_E_AGAIN)); - Qgnutls_e_invalid_session = intern_c_string ("gnutls-e-invalid-session"); - staticpro (&Qgnutls_e_invalid_session); + DEFSYM (Qgnutls_e_invalid_session, "gnutls-e-invalid-session"); Fput (Qgnutls_e_invalid_session, Qgnutls_code, make_number (GNUTLS_E_INVALID_SESSION)); - Qgnutls_e_not_ready_for_handshake = - intern_c_string ("gnutls-e-not-ready-for-handshake"); - staticpro (&Qgnutls_e_not_ready_for_handshake); + DEFSYM (Qgnutls_e_not_ready_for_handshake, "gnutls-e-not-ready-for-handshake"); Fput (Qgnutls_e_not_ready_for_handshake, Qgnutls_code, make_number (GNUTLS_E_APPLICATION_ERROR_MIN)); diff --git a/src/gtkutil.c b/src/gtkutil.c index 6c00058e7af..343fcfa083a 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -1086,7 +1086,7 @@ xg_create_frame_widgets (FRAME_PTR f) whbox = gtk_hbox_new (FALSE, 0); #ifdef HAVE_GTK3 - wfixed = emacs_fixed_new (); + wfixed = emacs_fixed_new (f); #else wfixed = gtk_fixed_new (); #endif @@ -1286,18 +1286,6 @@ x_wm_set_size_hint (FRAME_PTR f, long int flags, int user_position) size_hints.min_width = base_width + min_cols * size_hints.width_inc; size_hints.min_height = base_height + min_rows * size_hints.height_inc; -#ifdef HAVE_GTK3 - /* Gtk3 ignores min width/height and overwrites them with its own idea - of min width/height. Put out min values to the widget so Gtk - gets the same value we want it to be. Without this, a user can't - shrink an Emacs frame. - */ - if (FRAME_GTK_WIDGET (f)) - emacs_fixed_set_min_size (EMACS_FIXED (FRAME_GTK_WIDGET (f)), - size_hints.min_width, - size_hints.min_height); -#endif - /* These currently have a one to one mapping with the X values, but I don't think we should rely on that. */ hint_flags |= GDK_HINT_WIN_GRAVITY; @@ -1336,7 +1324,7 @@ x_wm_set_size_hint (FRAME_PTR f, long int flags, int user_position) { BLOCK_INPUT; gtk_window_set_geometry_hints (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), - NULL, &size_hints, hint_flags); + NULL, &size_hints, hint_flags); f->output_data.x->size_hints = size_hints; f->output_data.x->hint_flags = hint_flags; UNBLOCK_INPUT; diff --git a/src/image.c b/src/image.c index a9785e5d00f..6e8440fb431 100644 --- a/src/image.c +++ b/src/image.c @@ -1836,6 +1836,8 @@ cache_image (struct frame *f, struct image *img) /* 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); diff --git a/src/insdel.c b/src/insdel.c index c52785cd33d..0cae578925d 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -2219,8 +2219,7 @@ syms_of_insdel (void) This affects `before-change-functions' and `after-change-functions', as well as hooks attached to text properties and overlays. */); inhibit_modification_hooks = 0; - Qinhibit_modification_hooks = intern_c_string ("inhibit-modification-hooks"); - staticpro (&Qinhibit_modification_hooks); + DEFSYM (Qinhibit_modification_hooks, "inhibit-modification-hooks"); defsubr (&Scombine_after_change_execute); } diff --git a/src/keyboard.c b/src/keyboard.c index bffe2b035dc..16300e6154c 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1539,7 +1539,18 @@ command_loop_1 (void) message_with_string ("%s is undefined", keys, 0); KVAR (current_kboard, defining_kbd_macro) = Qnil; update_mode_lines = 1; - KVAR (current_kboard, Vprefix_arg) = Qnil; + /* If this is a down-mouse event, don't reset prefix-arg; + pass it to the command run by the up event. */ + if (EVENT_HAS_PARAMETERS (last_command_event)) + { + Lisp_Object breakdown + = parse_modifiers (EVENT_HEAD (last_command_event)); + int modifiers = XINT (XCAR (XCDR (breakdown))); + if (!(modifiers & down_modifier)) + KVAR (current_kboard, Vprefix_arg) = Qnil; + } + else + KVAR (current_kboard, Vprefix_arg) = Qnil; } else { @@ -7470,7 +7481,7 @@ menu_bar_items (Lisp_Object old) if (CONSP (def)) { menu_bar_one_keymap_changed_items = Qnil; - map_keymap (def, menu_bar_item, Qnil, NULL, 1); + map_keymap_canonical (def, menu_bar_item, Qnil, NULL); } } @@ -7811,7 +7822,7 @@ parse_menu_item (Lisp_Object item, int inmenubar) /* If we got no definition, this item is just unselectable text which is OK in a submenu but not in the menubar. */ if (NILP (def)) - return (inmenubar ? 0 : 1); + return (!inmenubar); /* See if this is a separate pane or a submenu. */ def = AREF (item_properties, ITEM_PROPERTY_DEF); diff --git a/src/keyboard.h b/src/keyboard.h index 20763c35f3a..91008a3ea24 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -123,7 +123,7 @@ struct kboard 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); diff --git a/src/keymap.c b/src/keymap.c index 6ef2a716b6d..be31f72eec6 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -16,6 +16,27 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ +/* Old BUGS: + - [M-C-a] != [?\M-\C-a] + - [M-f2] != [?\e f2]. + - (define-key map [menu-bar foo] <bla>) does not always place <bla> + at the head of the menu (if `foo' was already bound earlier and + then unbound, for example). + TODO: + - allow many more Meta -> ESC mappings (like Hyper -> C-e for Emacspeak) + - Think about the various defaulting that's currently hard-coded in + keyboard.c (uppercase->lowercase, char->charset, button-events, ...) + and make it more generic. Maybe we should allow mappings of the + form (PREDICATE . BINDING) as generalization of the default binding, + tho probably a cleaner way to attack this is to allow functional + keymaps (i.e. keymaps that are implemented as functions that implement + a few different methods like `lookup', `map', ...). + - Make [a] equivalent to [?a]. + BEWARE: + - map-keymap should work meaningfully even if entries are added/removed + to the keymap while iterating through it: + start - removed <= visited <= start + added + */ #include <config.h> #include <stdio.h> @@ -73,7 +94,6 @@ static Lisp_Object where_is_cache_keymaps; static Lisp_Object Flookup_key (Lisp_Object, Lisp_Object, Lisp_Object); static Lisp_Object store_in_keymap (Lisp_Object, Lisp_Object, Lisp_Object); -static void fix_submap_inheritance (Lisp_Object, Lisp_Object, Lisp_Object); static Lisp_Object define_as_prefix (Lisp_Object, Lisp_Object); static void describe_command (Lisp_Object, Lisp_Object); @@ -130,6 +150,17 @@ in case you use it as a menu with `x-popup-menu'. */) return Fcons (Qkeymap, Qnil); } +DEFUN ("make-composed-keymap", Fmake_composed_keymap, Smake_composed_keymap, + 0, MANY, 0, + doc: /* Construct and return a new keymap composed of KEYMAPS. +When looking up a key in the returned map, the key is looked in each +keymap in turn until a binding is found. +usage: (make-composed-keymap &rest KEYMAPS) */) + (ptrdiff_t nargs, Lisp_Object *args) +{ + return Fcons (Qkeymap, Flist (nargs, args)); +} + /* This function is used for installing the standard key bindings at initialization time. @@ -174,6 +205,12 @@ when reading a key-sequence to be looked-up in this keymap. */) Lisp_Object tem = XCAR (map); if (STRINGP (tem)) return tem; + else if (KEYMAPP (tem)) + { + tem = Fkeymap_prompt (tem); + if (!NILP (tem)) + return tem; + } map = XCDR (map); } return Qnil; @@ -300,23 +337,16 @@ Return PARENT. PARENT should be nil or another keymap. */) { Lisp_Object list, prev; struct gcpro gcpro1, gcpro2; - int i; - /* Force a keymap flush for the next call to where-is. - Since this can be called from within where-is, we don't set where_is_cache - directly but only where_is_cache_keymaps, since where_is_cache shouldn't - be changed during where-is, while where_is_cache_keymaps is only used at - the very beginning of where-is and can thus be changed here without any - adverse effect. - This is a very minor correctness (rather than safety) issue. */ - where_is_cache_keymaps = Qt; + /* Flush any reverse-map cache. */ + where_is_cache = Qnil; where_is_cache_keymaps = Qt; GCPRO2 (keymap, parent); keymap = get_keymap (keymap, 1, 1); if (!NILP (parent)) { - parent = get_keymap (parent, 1, 1); + parent = get_keymap (parent, 1, 0); /* Check for cycles. */ if (keymap_memberp (keymap, parent)) @@ -332,121 +362,35 @@ Return PARENT. PARENT should be nil or another keymap. */) If we came to the end, add the parent in PREV. */ if (!CONSP (list) || KEYMAPP (list)) { - /* If we already have the right parent, return now - so that we avoid the loops below. */ - if (EQ (XCDR (prev), parent)) - RETURN_UNGCPRO (parent); - CHECK_IMPURE (prev); XSETCDR (prev, parent); - break; + RETURN_UNGCPRO (parent); } prev = list; } - - /* Scan through for submaps, and set their parents too. */ - - for (list = XCDR (keymap); CONSP (list); list = XCDR (list)) - { - /* Stop the scan when we come to the parent. */ - if (EQ (XCAR (list), Qkeymap)) - break; - - /* If this element holds a prefix map, deal with it. */ - if (CONSP (XCAR (list)) - && CONSP (XCDR (XCAR (list)))) - fix_submap_inheritance (keymap, XCAR (XCAR (list)), - XCDR (XCAR (list))); - - if (VECTORP (XCAR (list))) - for (i = 0; i < ASIZE (XCAR (list)); i++) - if (CONSP (XVECTOR (XCAR (list))->contents[i])) - fix_submap_inheritance (keymap, make_number (i), - XVECTOR (XCAR (list))->contents[i]); - - if (CHAR_TABLE_P (XCAR (list))) - { - map_char_table (fix_submap_inheritance, Qnil, XCAR (list), keymap); - } - } - - RETURN_UNGCPRO (parent); -} - -/* EVENT is defined in MAP as a prefix, and SUBMAP is its definition. - if EVENT is also a prefix in MAP's parent, - make sure that SUBMAP inherits that definition as its own parent. */ - -static void -fix_submap_inheritance (Lisp_Object map, Lisp_Object event, Lisp_Object submap) -{ - Lisp_Object map_parent, parent_entry; - - /* SUBMAP is a cons that we found as a key binding. - Discard the other things found in a menu key binding. */ - - submap = get_keymap (get_keyelt (submap, 0), 0, 0); - - /* If it isn't a keymap now, there's no work to do. */ - if (!CONSP (submap)) - return; - - map_parent = keymap_parent (map, 0); - if (!NILP (map_parent)) - parent_entry = - get_keymap (access_keymap (map_parent, event, 0, 0, 0), 0, 0); - else - parent_entry = Qnil; - - /* If MAP's parent has something other than a keymap, - our own submap shadows it completely. */ - if (!CONSP (parent_entry)) - return; - - if (! EQ (parent_entry, submap)) - { - Lisp_Object submap_parent; - submap_parent = submap; - while (1) - { - Lisp_Object tem; - - tem = keymap_parent (submap_parent, 0); - - if (KEYMAPP (tem)) - { - if (keymap_memberp (tem, parent_entry)) - /* Fset_keymap_parent could create a cycle. */ - return; - submap_parent = tem; - } - else - break; - } - Fset_keymap_parent (submap_parent, parent_entry); - } } + /* Look up IDX in MAP. IDX may be any sort of event. Note that this does only one level of lookup; IDX must be a single event, not a sequence. + MAP must be a keymap or a list of keymaps. + If T_OK is non-zero, bindings for Qt are treated as default bindings; any key left unmentioned by other tables and bindings is given the binding of Qt. If T_OK is zero, bindings for Qt are not treated specially. - If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */ + If NOINHERIT, don't accept a subkeymap found in an inherited keymap. -Lisp_Object -access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int autoload) -{ - Lisp_Object val; - - /* Qunbound in VAL means we have found no binding yet. */ - val = Qunbound; + Returns Qunbound if no binding was found (and returns Qnil if a nil + binding was found). */ +static Lisp_Object +access_keymap_1 (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int autoload) +{ /* If idx is a list (some sort of mouse click, perhaps?), the index we want to use is the car of the list, which ought to be a symbol. */ @@ -461,21 +405,21 @@ access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int au with more than 24 bits of integer. */ XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1))); - /* Handle the special meta -> esc mapping. */ + /* Handle the special meta -> esc mapping. */ if (INTEGERP (idx) && XFASTINT (idx) & meta_modifier) { /* See if there is a meta-map. If there's none, there is no binding for IDX, unless a default binding exists in MAP. */ struct gcpro gcpro1; - Lisp_Object event_meta_map; + Lisp_Object event_meta_binding, event_meta_map; GCPRO1 (map); /* A strange value in which Meta is set would cause infinite recursion. Protect against that. */ if (XINT (meta_prefix_char) & CHAR_META) meta_prefix_char = make_number (27); - event_meta_map = get_keymap (access_keymap (map, meta_prefix_char, - t_ok, noinherit, autoload), - 0, autoload); + event_meta_binding = access_keymap_1 (map, meta_prefix_char, t_ok, + noinherit, autoload); + event_meta_map = get_keymap (event_meta_binding, 0, autoload); UNGCPRO; if (CONSP (event_meta_map)) { @@ -486,8 +430,8 @@ access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int au /* Set IDX to t, so that we only find a default binding. */ idx = Qt; else - /* We know there is no binding. */ - return Qnil; + /* An explicit nil binding, or no binding at all. */ + return NILP (event_meta_binding) ? Qnil : Qunbound; } /* t_binding is where we put a default binding that applies, @@ -495,25 +439,52 @@ access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int au for this key sequence. */ { Lisp_Object tail; - Lisp_Object t_binding = Qnil; + Lisp_Object t_binding = Qunbound; + Lisp_Object retval = Qunbound; + Lisp_Object retval_tail = Qnil; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - GCPRO4 (map, tail, idx, t_binding); + GCPRO4 (tail, idx, t_binding, retval); - for (tail = XCDR (map); + for (tail = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map; (CONSP (tail) || (tail = get_keymap (tail, 0, autoload), CONSP (tail))); tail = XCDR (tail)) { - Lisp_Object binding; + /* Qunbound in VAL means we have found no binding. */ + Lisp_Object val = Qunbound; + Lisp_Object binding = XCAR (tail); + Lisp_Object submap = get_keymap (binding, 0, autoload); - binding = XCAR (tail); - if (SYMBOLP (binding)) + if (EQ (binding, Qkeymap)) { - /* If NOINHERIT, stop finding prefix definitions - after we pass a second occurrence of the `keymap' symbol. */ - if (noinherit && EQ (binding, Qkeymap)) - RETURN_UNGCPRO (Qnil); + if (noinherit || NILP (retval)) + /* If NOINHERIT, stop here, the rest is inherited. */ + break; + else if (!EQ (retval, Qunbound)) + { + Lisp_Object parent_entry; + eassert (KEYMAPP (retval)); + parent_entry + = get_keymap (access_keymap_1 (tail, idx, + t_ok, 0, autoload), + 0, autoload); + if (KEYMAPP (parent_entry)) + { + if (CONSP (retval_tail)) + XSETCDR (retval_tail, parent_entry); + else + { + retval_tail = Fcons (retval, parent_entry); + retval = Fcons (Qkeymap, retval_tail); + } + } + break; + } + } + else if (CONSP (submap)) + { + val = access_keymap_1 (submap, idx, t_ok, noinherit, autoload); } else if (CONSP (binding)) { @@ -556,23 +527,47 @@ access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int au (i.e. it shadows any parent binding but not bindings in keymaps of lower precedence). */ val = Qnil; + val = get_keyelt (val, autoload); - if (KEYMAPP (val)) - fix_submap_inheritance (map, idx, val); - RETURN_UNGCPRO (val); + + if (!KEYMAPP (val)) + { + if (NILP (retval) || EQ (retval, Qunbound)) + retval = val; + if (!NILP (val)) + break; /* Shadows everything that follows. */ + } + else if (NILP (retval) || EQ (retval, Qunbound)) + retval = val; + else if (CONSP (retval_tail)) + { + XSETCDR (retval_tail, Fcons (val, Qnil)); + retval_tail = XCDR (retval_tail); + } + else + { + retval_tail = Fcons (val, Qnil); + retval = Fcons (Qkeymap, Fcons (retval, retval_tail)); + } } QUIT; } UNGCPRO; - return get_keyelt (t_binding, autoload); + return EQ (Qunbound, retval) ? get_keyelt (t_binding, autoload) : retval; } } +Lisp_Object +access_keymap (Lisp_Object map, Lisp_Object idx, + int t_ok, int noinherit, int autoload) +{ + Lisp_Object val = access_keymap_1 (map, idx, t_ok, noinherit, autoload); + return EQ (val, Qunbound) ? Qnil : val; +} + static void map_keymap_item (map_keymap_function_t fun, Lisp_Object args, Lisp_Object key, Lisp_Object val, void *data) { - /* We should maybe try to detect bindings shadowed by previous - ones and things like that. */ if (EQ (val, Qt)) val = Qnil; (*fun) (key, val, args, data); @@ -583,8 +578,8 @@ map_keymap_char_table_item (Lisp_Object args, Lisp_Object key, Lisp_Object val) { if (!NILP (val)) { - map_keymap_function_t fun = - (map_keymap_function_t) XSAVE_VALUE (XCAR (args))->pointer; + map_keymap_function_t fun + = (map_keymap_function_t) XSAVE_VALUE (XCAR (args))->pointer; args = XCDR (args); /* If the key is a range, make a copy since map_char_table modifies it in place. */ @@ -612,7 +607,9 @@ map_keymap_internal (Lisp_Object map, { Lisp_Object binding = XCAR (tail); - if (CONSP (binding)) + if (KEYMAPP (binding)) /* An embedded parent. */ + break; + else if (CONSP (binding)) map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data); else if (VECTORP (binding)) { @@ -644,7 +641,7 @@ map_keymap_call (Lisp_Object key, Lisp_Object val, Lisp_Object fun, void *dummy) call2 (fun, key, val); } -/* Same as map_keymap_internal, but doesn't traverses parent keymaps as well. +/* Same as map_keymap_internal, but traverses parent keymaps as well. A non-zero AUTOLOAD indicates that autoloaded keymaps should be loaded. */ void map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, void *data, int autoload) @@ -654,8 +651,15 @@ map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, void * map = get_keymap (map, 1, autoload); while (CONSP (map)) { - map = map_keymap_internal (map, fun, args, data); - map = get_keymap (map, 0, autoload); + if (KEYMAPP (XCAR (map))) + { + map_keymap (XCAR (map), fun, args, data, autoload); + map = XCDR (map); + } + else + map = map_keymap_internal (map, fun, args, data); + if (!CONSP (map)) + map = get_keymap (map, 0, autoload); } UNGCPRO; } @@ -791,16 +795,10 @@ get_keyelt (Lisp_Object object, int autoload) } /* If the contents are (KEYMAP . ELEMENT), go indirect. */ + else if (KEYMAPP (XCAR (object))) + error ("Wow, indirect keymap entry!!"); else - { - struct gcpro gcpro1; - Lisp_Object map; - GCPRO1 (object); - map = get_keymap (Fcar_safe (object), 0, autoload); - UNGCPRO; - return (!CONSP (map) ? object /* Invalid keymap */ - : access_keymap (map, Fcdr (object), 0, 0, autoload)); - } + return object; } } @@ -811,6 +809,9 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) where_is_cache = Qnil; where_is_cache_keymaps = Qt; + if (EQ (idx, Qkeymap)) + error ("`keymap' is reserved for embedded parent maps"); + /* If we are preparing to dump, and DEF is a menu element with a menu item indicator, copy it to ensure it is not pure. */ if (CONSP (def) && PURE_P (def) @@ -903,7 +904,16 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) } else if (CONSP (elt)) { - if (EQ (idx, XCAR (elt))) + if (EQ (Qkeymap, XCAR (elt))) + { /* A sub keymap. This might be due to a lookup that found + two matching bindings (maybe because of a sub keymap). + It almost never happens (since the second binding normally + only happens in the inherited part of the keymap), but + if it does, we want to update the sub-keymap since the + main one might be temporary (built by access_keymap). */ + tail = insertion_point = elt; + } + else if (EQ (idx, XCAR (elt))) { CHECK_IMPURE (elt); XSETCDR (elt, def); @@ -1068,7 +1078,13 @@ is not copied. */) ASET (elt, i, copy_keymap_item (AREF (elt, i))); } else if (CONSP (elt)) - elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt))); + { + if (EQ (XCAR (elt), Qkeymap)) + /* This is a sub keymap. */ + elt = Fcopy_keymap (elt); + else + elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt))); + } XSETCDR (tail, Fcons (elt, Qnil)); tail = XCDR (tail); keymap = XCDR (keymap); @@ -1234,23 +1250,15 @@ remapping in all currently active keymaps. */) ASET (command_remapping_vector, 1, command); if (NILP (keymaps)) - return Fkey_binding (command_remapping_vector, Qnil, Qt, position); + command = Fkey_binding (command_remapping_vector, Qnil, Qt, position); else - { - Lisp_Object maps, binding; - - for (maps = keymaps; CONSP (maps); maps = XCDR (maps)) - { - binding = Flookup_key (XCAR (maps), command_remapping_vector, Qnil); - if (!NILP (binding) && !INTEGERP (binding)) - return binding; - } - return Qnil; - } + command = Flookup_key (Fcons (Qkeymap, keymaps), + command_remapping_vector, Qnil); + return INTEGERP (command) ? Qnil : command; } /* Value is number if KEY is too long; nil if valid but has no definition. */ -/* GC is possible in this function if it autoloads a keymap. */ +/* GC is possible in this function. */ DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0, doc: /* In keymap KEYMAP, look up key sequence KEY. Return the definition. @@ -1325,10 +1333,6 @@ define_as_prefix (Lisp_Object keymap, Lisp_Object c) Lisp_Object cmd; cmd = Fmake_sparse_keymap (Qnil); - /* If this key is defined as a prefix in an inherited keymap, - make it a prefix in this map, and make its definition - inherit the other prefix definition. */ - cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0)); store_in_keymap (keymap, c, cmd); return cmd; @@ -1530,7 +1534,7 @@ like in the respective argument of `key-binding'. */) { int count = SPECPDL_INDEX (); - Lisp_Object keymaps; + Lisp_Object keymaps = Fcons (current_global_map, Qnil); /* If a mouse click position is given, our variables are based on the buffer clicked on, not the current buffer. So we may have to @@ -1560,12 +1564,11 @@ like in the respective argument of `key-binding'. */) } } - keymaps = Fcons (current_global_map, Qnil); - if (!NILP (olp)) { if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) - keymaps = Fcons (KVAR (current_kboard, Voverriding_terminal_local_map), keymaps); + keymaps = Fcons (KVAR (current_kboard, Voverriding_terminal_local_map), + keymaps); /* The doc said that overriding-terminal-local-map should override overriding-local-map. The code used them both, but it seems clearer to use just one. rms, jan 2005. */ @@ -1576,23 +1579,19 @@ like in the respective argument of `key-binding'. */) { Lisp_Object *maps; int nmaps, i; - - Lisp_Object keymap, local_map; - EMACS_INT pt; - - pt = INTEGERP (position) ? XINT (position) + EMACS_INT pt + = INTEGERP (position) ? XINT (position) : MARKERP (position) ? marker_position (position) : PT; - - /* Get the buffer local maps, possibly overriden by text or - overlay properties */ - - local_map = get_local_map (pt, current_buffer, Qlocal_map); - keymap = get_local_map (pt, current_buffer, Qkeymap); + /* This usually returns the buffer's local map, + but that can be overridden by a `local-map' property. */ + Lisp_Object local_map = get_local_map (pt, current_buffer, Qlocal_map); + /* This returns nil unless there is a `keymap' property. */ + Lisp_Object keymap = get_local_map (pt, current_buffer, Qkeymap); if (CONSP (position)) { - Lisp_Object string; + Lisp_Object string = POSN_STRING (position); /* For a mouse click, get the local text-property keymap of the place clicked on, rather than point. */ @@ -1619,8 +1618,7 @@ like in the respective argument of `key-binding'. */) consider `local-map' and `keymap' properties of that string. */ - if (string = POSN_STRING (position), - (CONSP (string) && STRINGP (XCAR (string)))) + if (CONSP (string) && STRINGP (XCAR (string))) { Lisp_Object pos, map; @@ -1691,12 +1689,7 @@ specified buffer position instead of point are used. */) (Lisp_Object key, Lisp_Object accept_default, Lisp_Object no_remap, Lisp_Object position) { - Lisp_Object *maps, value; - int nmaps, i; - struct gcpro gcpro1, gcpro2; - int count = SPECPDL_INDEX (); - - GCPRO2 (key, position); + Lisp_Object value; if (NILP (position) && VECTORP (key)) { @@ -1715,145 +1708,9 @@ specified buffer position instead of point are used. } } - /* Key sequences beginning with mouse clicks - are read using the keymaps of the buffer clicked on, not - the current buffer. So we may have to switch the buffer - here. */ - - if (CONSP (position)) - { - Lisp_Object window; - - window = POSN_WINDOW (position); - - if (WINDOWP (window) - && BUFFERP (XWINDOW (window)->buffer) - && XBUFFER (XWINDOW (window)->buffer) != current_buffer) - { - /* Arrange to go back to the original buffer once we're done - processing the key sequence. We don't use - save_excursion_{save,restore} here, in analogy to - `read-key-sequence' to avoid saving point. Maybe this - would not be a problem here, but it is easier to keep - things the same. - */ - - record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); - - set_buffer_internal (XBUFFER (XWINDOW (window)->buffer)); - } - } - - if (! NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) - { - value = Flookup_key (KVAR (current_kboard, Voverriding_terminal_local_map), - key, accept_default); - if (! NILP (value) && !INTEGERP (value)) - goto done; - } - else if (! NILP (Voverriding_local_map)) - { - value = Flookup_key (Voverriding_local_map, key, accept_default); - if (! NILP (value) && !INTEGERP (value)) - goto done; - } - else - { - Lisp_Object keymap, local_map; - EMACS_INT pt; - - pt = INTEGERP (position) ? XINT (position) - : MARKERP (position) ? marker_position (position) - : PT; - - local_map = get_local_map (pt, current_buffer, Qlocal_map); - keymap = get_local_map (pt, current_buffer, Qkeymap); - - if (CONSP (position)) - { - Lisp_Object string; - - /* For a mouse click, get the local text-property keymap - of the place clicked on, rather than point. */ + value = Flookup_key (Fcons (Qkeymap, Fcurrent_active_maps (Qt, position)), + key, accept_default); - if (POSN_INBUFFER_P (position)) - { - Lisp_Object pos; - - pos = POSN_BUFFER_POSN (position); - if (INTEGERP (pos) - && XINT (pos) >= BEG && XINT (pos) <= Z) - { - local_map = get_local_map (XINT (pos), - current_buffer, Qlocal_map); - - keymap = get_local_map (XINT (pos), - current_buffer, Qkeymap); - } - } - - /* If on a mode line string with a local keymap, - or for a click on a string, i.e. overlay string or a - string displayed via the `display' property, - consider `local-map' and `keymap' properties of - that string. */ - - if (string = POSN_STRING (position), - (CONSP (string) && STRINGP (XCAR (string)))) - { - Lisp_Object pos, map; - - pos = XCDR (string); - string = XCAR (string); - if (INTEGERP (pos) - && XINT (pos) >= 0 - && XINT (pos) < SCHARS (string)) - { - map = Fget_text_property (pos, Qlocal_map, string); - if (!NILP (map)) - local_map = map; - - map = Fget_text_property (pos, Qkeymap, string); - if (!NILP (map)) - keymap = map; - } - } - - } - - if (! NILP (keymap)) - { - value = Flookup_key (keymap, key, accept_default); - if (! NILP (value) && !INTEGERP (value)) - goto done; - } - - nmaps = current_minor_maps (0, &maps); - /* Note that all these maps are GCPRO'd - in the places where we found them. */ - - for (i = 0; i < nmaps; i++) - if (! NILP (maps[i])) - { - value = Flookup_key (maps[i], key, accept_default); - if (! NILP (value) && !INTEGERP (value)) - goto done; - } - - if (! NILP (local_map)) - { - value = Flookup_key (local_map, key, accept_default); - if (! NILP (value) && !INTEGERP (value)) - goto done; - } - } - - value = Flookup_key (current_global_map, key, accept_default); - - done: - unbind_to (count, Qnil); - - UNGCPRO; if (NILP (value) || INTEGERP (value)) return Qnil; @@ -3774,15 +3631,13 @@ Return list of symbols found. */) void syms_of_keymap (void) { - Qkeymap = intern_c_string ("keymap"); - staticpro (&Qkeymap); + DEFSYM (Qkeymap, "keymap"); staticpro (&apropos_predicate); staticpro (&apropos_accumulate); apropos_predicate = Qnil; apropos_accumulate = Qnil; - Qkeymap_canonicalize = intern_c_string ("keymap-canonicalize"); - staticpro (&Qkeymap_canonicalize); + DEFSYM (Qkeymap_canonicalize, "keymap-canonicalize"); /* Now we are ready to set up this property, so we can create char tables. */ @@ -3831,31 +3686,6 @@ don't alter it yourself. */); Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil); Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map); - DEFVAR_LISP ("minibuffer-local-completion-map", Vminibuffer_local_completion_map, - doc: /* Local keymap for minibuffer input with completion. */); - Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil); - Fset_keymap_parent (Vminibuffer_local_completion_map, Vminibuffer_local_map); - - DEFVAR_LISP ("minibuffer-local-filename-completion-map", - Vminibuffer_local_filename_completion_map, - doc: /* Local keymap for minibuffer input with completion for filenames. */); - Vminibuffer_local_filename_completion_map = Fmake_sparse_keymap (Qnil); - Fset_keymap_parent (Vminibuffer_local_filename_completion_map, - Vminibuffer_local_completion_map); - - - DEFVAR_LISP ("minibuffer-local-must-match-map", Vminibuffer_local_must_match_map, - doc: /* Local keymap for minibuffer input with completion, for exact match. */); - Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil); - Fset_keymap_parent (Vminibuffer_local_must_match_map, - Vminibuffer_local_completion_map); - - DEFVAR_LISP ("minibuffer-local-filename-must-match-map", - Vminibuffer_local_filename_must_match_map, - doc: /* Local keymap for minibuffer input with completion for filenames with exact match. */); - Vminibuffer_local_filename_must_match_map = Fmake_sparse_keymap (Qnil); - Fset_keymap_parent (Vminibuffer_local_filename_must_match_map, - Vminibuffer_local_must_match_map); DEFVAR_LISP ("minor-mode-map-alist", Vminor_mode_map_alist, doc: /* Alist of keymaps to use for minor modes. @@ -3902,27 +3732,13 @@ preferred. */); pure_cons (intern_c_string ("mouse-5"), Qnil))))))))); - - Qsingle_key_description = intern_c_string ("single-key-description"); - staticpro (&Qsingle_key_description); - - Qkey_description = intern_c_string ("key-description"); - staticpro (&Qkey_description); - - Qkeymapp = intern_c_string ("keymapp"); - staticpro (&Qkeymapp); - - Qnon_ascii = intern_c_string ("non-ascii"); - staticpro (&Qnon_ascii); - - Qmenu_item = intern_c_string ("menu-item"); - staticpro (&Qmenu_item); - - Qremap = intern_c_string ("remap"); - staticpro (&Qremap); - - QCadvertised_binding = intern_c_string (":advertised-binding"); - staticpro (&QCadvertised_binding); + DEFSYM (Qsingle_key_description, "single-key-description"); + DEFSYM (Qkey_description, "key-description"); + DEFSYM (Qkeymapp, "keymapp"); + DEFSYM (Qnon_ascii, "non-ascii"); + DEFSYM (Qmenu_item, "menu-item"); + DEFSYM (Qremap, "remap"); + DEFSYM (QCadvertised_binding, ":advertised-binding"); command_remapping_vector = Fmake_vector (make_number (2), Qremap); staticpro (&command_remapping_vector); @@ -3938,6 +3754,7 @@ preferred. */); defsubr (&Sset_keymap_parent); defsubr (&Smake_keymap); defsubr (&Smake_sparse_keymap); + defsubr (&Smake_composed_keymap); defsubr (&Smap_keymap_internal); defsubr (&Smap_keymap); defsubr (&Scopy_keymap); diff --git a/src/lisp.h b/src/lisp.h index 4c9543bdfe8..762d34abb9c 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1162,6 +1162,9 @@ struct Lisp_Symbol #define SYMBOL_CONSTANT_P(sym) XSYMBOL (sym)->constant +#define DEFSYM(sym, name) \ + do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (0) + /*********************************************************************** Hash Tables @@ -1980,10 +1983,7 @@ extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int); #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) diff --git a/src/lread.c b/src/lread.c index e75d61ae985..a9b69a1977b 100644 --- a/src/lread.c +++ b/src/lread.c @@ -120,9 +120,9 @@ static EMACS_INT readchar_count; /* 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 @@ static file_offset saved_doc_string_position; 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 @@ Return t if the file exists and loads successfully. */) /* 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 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto 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 @@ read0 (Lisp_Object readcharfun) 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 @@ read_escape (Lisp_Object readcharfun, int stringp) 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 @@ read_escape (Lisp_Object readcharfun, int stringp) 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 @@ digit_to_number (int character, int base) 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 @@ read_integer (Lisp_Object readcharfun, int radix) if (! valid) { - sprintf (buf, "integer, radix %d", radix); + sprintf (buf, "integer, radix %"pI"d", radix); invalid_syntax (buf); } @@ -2471,7 +2472,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) 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 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) 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 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) 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 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) 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 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) 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 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) /* 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)) + + if (n <= MOST_POSITIVE_FIXNUM) { - /* Make a placeholder for #n# to use temporarily */ - Lisp_Object placeholder; - Lisp_Object cell; + if (c == 'r' || c == 'R') + return read_integer (readcharfun, n); - placeholder = Fcons (Qnil, Qnil); - cell = Fcons (make_number (n), placeholder); - read_objects = Fcons (cell, read_objects); + 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; - /* Read the object itself. */ - tem = read0 (readcharfun); + placeholder = Fcons (Qnil, Qnil); + cell = Fcons (make_number (n), placeholder); + read_objects = Fcons (cell, read_objects); - /* Now put it everywhere the placeholder was... */ - substitute_object_in_subtree (tem, placeholder); + /* Read the object itself. */ + tem = read0 (readcharfun); - /* ...and #n# will use the real value from now on. */ - Fsetcdr (cell, tem); + /* Now put it everywhere the placeholder was... */ + substitute_object_in_subtree (tem, placeholder); - 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); + /* ...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 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) 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 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) { 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 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) 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 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj { 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 @@ string_to_number (char const *string, int base, int ignore_trailing) 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 @@ read_list (int flag, register Lisp_Object readcharfun) 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 @@ read_list (int flag, register Lisp_Object readcharfun) && 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 @@ hash_string (const char *ptr, size_t len) 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--) @@ -3962,8 +3983,7 @@ init_obarray (void) /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */ Vpurify_flag = Qt; - Qvariable_documentation = intern_c_string ("variable-documentation"); - staticpro (&Qvariable_documentation); + DEFSYM (Qvariable_documentation, "variable-documentation"); read_buffer_size = 100 + MAX_MULTIBYTE_LENGTH; read_buffer = (char *) xmalloc (read_buffer_size); @@ -3991,7 +4011,7 @@ defalias (sname, string) #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, @@ -4371,8 +4391,7 @@ customize `jka-compr-load-suffixes' rather than the present variable. */); DEFVAR_BOOL ("load-in-progress", load_in_progress, doc: /* Non-nil if inside of `load'. */); - Qload_in_progress = intern_c_string ("load-in-progress"); - staticpro (&Qload_in_progress); + DEFSYM (Qload_in_progress, "load-in-progress"); DEFVAR_LISP ("after-load-alist", Vafter_load_alist, doc: /* An alist of expressions to be evalled when particular files are loaded. @@ -4401,9 +4420,11 @@ The remaining ENTRIES in the alist element describe the functions and variables defined in that file, the features provided, and the features required. Each entry has the form `(provide . FEATURE)', `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)', -`(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t -. SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that -SYMBOL was an autoload before this file redefined it as a function. +`(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)' +may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an +autoload before this file redefined it as a function. In addition, +entries may also be single symbols, which means that SYMBOL was +defined by `defvar' or `defconst'. During preloading, the file name recorded is relative to the main Lisp directory. These file names are converted to absolute at startup. */); @@ -4503,67 +4524,34 @@ This variable is automatically set from the file variables of an interpreted DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes, doc: /* Set to non-nil when `read' encounters an old-style backquote. */); Vold_style_backquotes = Qnil; - Qold_style_backquotes = intern_c_string ("old-style-backquotes"); - staticpro (&Qold_style_backquotes); + DEFSYM (Qold_style_backquotes, "old-style-backquotes"); /* Vsource_directory was initialized in init_lread. */ load_descriptor_list = Qnil; staticpro (&load_descriptor_list); - Qcurrent_load_list = intern_c_string ("current-load-list"); - staticpro (&Qcurrent_load_list); - - Qstandard_input = intern_c_string ("standard-input"); - staticpro (&Qstandard_input); - - Qread_char = intern_c_string ("read-char"); - staticpro (&Qread_char); - - Qget_file_char = intern_c_string ("get-file-char"); - staticpro (&Qget_file_char); - - Qget_emacs_mule_file_char = intern_c_string ("get-emacs-mule-file-char"); - staticpro (&Qget_emacs_mule_file_char); - - Qload_force_doc_strings = intern_c_string ("load-force-doc-strings"); - staticpro (&Qload_force_doc_strings); - - Qbackquote = intern_c_string ("`"); - staticpro (&Qbackquote); - Qcomma = intern_c_string (","); - staticpro (&Qcomma); - Qcomma_at = intern_c_string (",@"); - staticpro (&Qcomma_at); - Qcomma_dot = intern_c_string (",."); - staticpro (&Qcomma_dot); - - Qinhibit_file_name_operation = intern_c_string ("inhibit-file-name-operation"); - staticpro (&Qinhibit_file_name_operation); - - Qascii_character = intern_c_string ("ascii-character"); - staticpro (&Qascii_character); - - Qfunction = intern_c_string ("function"); - staticpro (&Qfunction); - - Qload = intern_c_string ("load"); - staticpro (&Qload); - - Qload_file_name = intern_c_string ("load-file-name"); - staticpro (&Qload_file_name); - - Qeval_buffer_list = intern_c_string ("eval-buffer-list"); - staticpro (&Qeval_buffer_list); - - Qfile_truename = intern_c_string ("file-truename"); - staticpro (&Qfile_truename) ; - - Qdir_ok = intern_c_string ("dir-ok"); - staticpro (&Qdir_ok); - - Qdo_after_load_evaluation = intern_c_string ("do-after-load-evaluation"); - staticpro (&Qdo_after_load_evaluation) ; + DEFSYM (Qcurrent_load_list, "current-load-list"); + DEFSYM (Qstandard_input, "standard-input"); + DEFSYM (Qread_char, "read-char"); + DEFSYM (Qget_file_char, "get-file-char"); + DEFSYM (Qget_emacs_mule_file_char, "get-emacs-mule-file-char"); + DEFSYM (Qload_force_doc_strings, "load-force-doc-strings"); + + DEFSYM (Qbackquote, "`"); + DEFSYM (Qcomma, ","); + DEFSYM (Qcomma_at, ",@"); + DEFSYM (Qcomma_dot, ",."); + + DEFSYM (Qinhibit_file_name_operation, "inhibit-file-name-operation"); + DEFSYM (Qascii_character, "ascii-character"); + DEFSYM (Qfunction, "function"); + DEFSYM (Qload, "load"); + DEFSYM (Qload_file_name, "load-file-name"); + DEFSYM (Qeval_buffer_list, "eval-buffer-list"); + DEFSYM (Qfile_truename, "file-truename"); + DEFSYM (Qdir_ok, "dir-ok"); + DEFSYM (Qdo_after_load_evaluation, "do-after-load-evaluation"); staticpro (&dump_path); @@ -4575,18 +4563,11 @@ This variable is automatically set from the file variables of an interpreted Vloads_in_progress = Qnil; staticpro (&Vloads_in_progress); - Qhash_table = intern_c_string ("hash-table"); - staticpro (&Qhash_table); - Qdata = intern_c_string ("data"); - staticpro (&Qdata); - Qtest = intern_c_string ("test"); - staticpro (&Qtest); - Qsize = intern_c_string ("size"); - staticpro (&Qsize); - Qweakness = intern_c_string ("weakness"); - staticpro (&Qweakness); - Qrehash_size = intern_c_string ("rehash-size"); - staticpro (&Qrehash_size); - Qrehash_threshold = intern_c_string ("rehash-threshold"); - staticpro (&Qrehash_threshold); + DEFSYM (Qhash_table, "hash-table"); + DEFSYM (Qdata, "data"); + DEFSYM (Qtest, "test"); + DEFSYM (Qsize, "size"); + DEFSYM (Qweakness, "weakness"); + DEFSYM (Qrehash_size, "rehash-size"); + DEFSYM (Qrehash_threshold, "rehash-threshold"); } diff --git a/src/macros.c b/src/macros.c index 3523e513d6a..60f30c3fbbe 100644 --- a/src/macros.c +++ b/src/macros.c @@ -71,10 +71,10 @@ macro before appending to it. */) { if (current_kboard->kbd_macro_bufsize > 200) { - 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_bufsize = 30; } current_kboard->kbd_macro_ptr = current_kboard->kbd_macro_buffer; current_kboard->kbd_macro_end = current_kboard->kbd_macro_buffer; @@ -82,7 +82,8 @@ macro before appending to it. */) } 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 @@ macro before appending to it. */) has put another macro there. */ if (current_kboard->kbd_macro_bufsize < len + 30) { - 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; } /* Must convert meta modifier when copying string to vector. */ @@ -191,14 +195,17 @@ store_kbd_macro_char (Lisp_Object c) { 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; } @@ -360,15 +367,13 @@ init_macros (void) void syms_of_macros (void) { - Qexecute_kbd_macro = intern_c_string ("execute-kbd-macro"); - staticpro (&Qexecute_kbd_macro); + DEFSYM (Qexecute_kbd_macro, "execute-kbd-macro"); DEFVAR_LISP ("kbd-macro-termination-hook", Vkbd_macro_termination_hook, doc: /* Normal hook run whenever a keyboard macro terminates. This is run whether the macro ends normally or prematurely due to an error. */); Vkbd_macro_termination_hook = Qnil; - Qkbd_macro_termination_hook = intern_c_string ("kbd-macro-termination-hook"); - staticpro (&Qkbd_macro_termination_hook); + DEFSYM (Qkbd_macro_termination_hook, "kbd-macro-termination-hook"); defsubr (&Sstart_kbd_macro); defsubr (&Send_kbd_macro); diff --git a/src/makefile.w32-in b/src/makefile.w32-in index 173fc673955..88b53554925 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -382,471 +382,452 @@ full-tags: TAGS TAGS-LISP ../nt/TAGS ### DEPENDENCIES ### EMACS_ROOT = .. -CONFIG_H = $(EMACS_ROOT)/src/s/ms-w32.h \ - $(EMACS_ROOT)/src/m/intel386.h \ - $(EMACS_ROOT)/src/config.h \ - $(EMACS_ROOT)/nt/inc/sys/stat.h -LISP_H = $(SRC)/lisp.h \ - $(SRC)/globals.h \ - $(EMACS_ROOT)/lib/intprops.h \ - $(EMACS_ROOT)/nt/inc/inttypes.h \ - $(EMACS_ROOT)/nt/inc/stdint.h -PROCESS_H = $(SRC)/process.h \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(SRC)/gnutls.h +GNU_LIB = $(EMACS_ROOT)/lib +NT_INC = $(EMACS_ROOT)/nt/inc + +SYSTIME_H = $(SRC)/systime.h \ + $(NT_INC)/sys/time.h +ATIMER_H = $(SRC)/atimer.h \ + $(SYSTIME_H) +BLOCKINPUT_H = $(SRC)/blockinput.h \ + $(ATIMER_H) +CAREADLINKAT_H = $(GNU_LIB)/careadlinkat.h \ + $(NT_INC)/unistd.h +CHARACTER_H = $(SRC)/character.h \ + $(GNU_LIB)/verify.h +CHARSET_H = $(SRC)/charset.h \ + $(GNU_LIB)/verify.h +CODING_H = $(SRC)/coding.h \ + $(SRC)/composite.h +MS_W32_H = $(SRC)/s/ms-w32.h \ + $(NT_INC)/sys/stat.h +CONFIG_H = $(SRC)/config.h \ + $(SRC)/m/intel386.h \ + $(MS_W32_H) +DIR_H = $(NT_INC)/sys/dir.h \ + $(SRC)/ndir.h +W32GUI_H = $(SRC)/w32gui.h \ + $(SYSTIME_H) +DISPEXTERN_H = $(SRC)/dispextern.h \ + $(W32GUI_H) +FILEMODE_H = $(GNU_LIB)/filemode.h \ + $(NT_INC)/sys/stat.h +FONT_H = $(SRC)/font.h \ + $(SRC)/ccl.h +FRAME_H = $(SRC)/frame.h \ + $(DISPEXTERN_H) +FTOASTR_H = $(GNU_LIB)/ftoastr.h \ + $(GNU_LIB)/intprops.h +GRP_H = $(NT_INC)/grp.h \ + $(NT_INC)/pwd.h +INTERVALS_H = $(SRC)/intervals.h \ + $(SRC)/composite.h \ + $(DISPEXTERN_H) +INTTYPES_H = $(NT_INC)/inttypes.h \ + $(NT_INC)/stdint.h +KEYBOARD_H = $(SRC)/keyboard.h \ + $(CODING_H) \ + $(SYSTIME_H) +LANGINFO_H = $(NT_INC)/langinfo.h \ + $(NT_INC)/nl_types.h +LISP_H = $(SRC)/lisp.h \ + $(SRC)/globals.h \ + $(GNU_LIB)/intprops.h \ + $(INTTYPES_H) +MD5_H = $(GNU_LIB)/md5.h \ + $(NT_INC)/stdint.h +MENU_H = $(SRC)/menu.h \ + $(SYSTIME_H) +PROCESS_H = $(SRC)/process.h \ + $(SRC)/gnutls.h \ + $(NT_INC)/unistd.h +SHA1_H = $(GNU_LIB)/sha1.h \ + $(NT_INC)/stdint.h +SHA256_H = $(GNU_LIB)/sha256.h \ + $(NT_INC)/stdint.h +U64_H = $(GNU_LIB)/u64.h \ + $(NT_INC)/stdint.h +SHA512_H = $(GNU_LIB)/sha512.h \ + $(U64_H) +SOCKET_H = $(NT_INC)/sys/socket.h \ + $(SRC)/w32.h +SYSTTY_H = $(SRC)/systty.h \ + $(NT_INC)/sys/ioctl.h \ + $(NT_INC)/unistd.h +TERMHOOKS_H = $(SRC)/termhooks.h \ + $(SYSTIME_H) +W32TERM_H = $(SRC)/w32term.h \ + $(W32GUI_H) +WINDOW_H = $(SRC)/window.h \ + $(DISPEXTERN_H) $(BLD)/alloc.$(O) : \ $(SRC)/alloc.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(PROCESS_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ $(SRC)/buffer.h \ - $(SRC)/character.h \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/frame.h \ - $(SRC)/intervals.h \ - $(SRC)/keyboard.h \ $(SRC)/puresize.h \ $(SRC)/syssignal.h \ - $(SRC)/systime.h \ - $(SRC)/termhooks.h \ $(SRC)/w32.h \ - $(SRC)/w32gui.h \ - $(SRC)/window.h + $(NT_INC)/unistd.h \ + $(BLOCKINPUT_H) \ + $(CHARACTER_H) \ + $(CONFIG_H) \ + $(FRAME_H) \ + $(INTERVALS_H) \ + $(KEYBOARD_H) \ + $(LISP_H) \ + $(PROCESS_H) \ + $(TERMHOOKS_H) \ + $(WINDOW_H) $(BLD)/atimer.$(O) : \ $(SRC)/atimer.c \ + $(SRC)/syssignal.h \ + $(NT_INC)/sys/time.h \ + $(NT_INC)/unistd.h \ + $(ATIMER_H) \ + $(BLOCKINPUT_H) \ $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ - $(SRC)/syssignal.h \ - $(SRC)/systime.h + $(SYSTIME_H) $(BLD)/bidi.$(O) : \ $(SRC)/bidi.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ $(SRC)/bidimirror.h \ $(SRC)/biditype.h \ $(SRC)/buffer.h \ - $(SRC)/character.h \ - $(SRC)/dispextern.h \ - $(SRC)/systime.h \ - $(SRC)/w32gui.h + $(CHARACTER_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(LISP_H) $(BLD)/buffer.$(O) : \ $(SRC)/buffer.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/param.h \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ $(SRC)/buffer.h \ - $(SRC)/character.h \ - $(SRC)/coding.h \ $(SRC)/commands.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/frame.h \ $(SRC)/indent.h \ - $(SRC)/intervals.h \ - $(SRC)/keyboard.h \ $(SRC)/keymap.h \ $(SRC)/region-cache.h \ - $(SRC)/systime.h \ - $(SRC)/w32gui.h \ - $(SRC)/window.h + $(NT_INC)/sys/param.h \ + $(NT_INC)/sys/stat.h \ + $(NT_INC)/unistd.h \ + $(GNU_LIB)/verify.h \ + $(BLOCKINPUT_H) \ + $(CHARACTER_H) \ + $(CONFIG_H) \ + $(FRAME_H) \ + $(INTERVALS_H) \ + $(KEYBOARD_H) \ + $(LISP_H) \ + $(WINDOW_H) $(BLD)/bytecode.$(O) : \ $(SRC)/bytecode.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ $(SRC)/buffer.h \ - $(SRC)/character.h \ - $(SRC)/dispextern.h \ $(SRC)/syntax.h \ - $(SRC)/systime.h \ - $(SRC)/w32gui.h \ - $(SRC)/window.h + $(CHARACTER_H) \ + $(CONFIG_H) \ + $(LISP_H) \ + $(WINDOW_H) $(BLD)/callint.$(O) : \ $(SRC)/callint.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ $(SRC)/buffer.h \ - $(SRC)/character.h \ - $(SRC)/coding.h \ $(SRC)/commands.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/keyboard.h \ $(SRC)/keymap.h \ - $(SRC)/systime.h \ - $(SRC)/w32gui.h \ - $(SRC)/window.h + $(CHARACTER_H) \ + $(CONFIG_H) \ + $(KEYBOARD_H) \ + $(LISP_H) \ + $(WINDOW_H) $(BLD)/callproc.$(O) : \ $(SRC)/callproc.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/file.h \ - $(EMACS_ROOT)/nt/inc/sys/ioctl.h \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(PROCESS_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ $(SRC)/buffer.h \ $(SRC)/ccl.h \ - $(SRC)/character.h \ - $(SRC)/coding.h \ $(SRC)/commands.h \ $(SRC)/composite.h \ - $(SRC)/dispextern.h \ $(SRC)/epaths.h \ - $(SRC)/frame.h \ $(SRC)/syssignal.h \ - $(SRC)/systime.h \ - $(SRC)/systty.h \ - $(SRC)/termhooks.h \ $(SRC)/w32.h \ - $(SRC)/w32gui.h + $(NT_INC)/sys/file.h \ + $(NT_INC)/unistd.h \ + $(BLOCKINPUT_H) \ + $(CHARACTER_H) \ + $(CODING_H) \ + $(CONFIG_H) \ + $(FRAME_H) \ + $(LISP_H) \ + $(PROCESS_H) \ + $(SYSTTY_H) \ + $(TERMHOOKS_H) $(BLD)/casefiddle.$(O) : \ $(SRC)/casefiddle.c \ - $(CONFIG_H) \ - $(LISP_H) \ $(SRC)/buffer.h \ - $(SRC)/character.h \ $(SRC)/commands.h \ $(SRC)/composite.h \ $(SRC)/keymap.h \ - $(SRC)/syntax.h + $(SRC)/syntax.h \ + $(CHARACTER_H) \ + $(CONFIG_H) \ + $(LISP_H) $(BLD)/casetab.$(O) : \ $(SRC)/casetab.c \ - $(CONFIG_H) \ - $(LISP_H) \ $(SRC)/buffer.h \ - $(SRC)/character.h + $(CHARACTER_H) \ + $(CONFIG_H) \ + $(LISP_H) $(BLD)/category.$(O) : \ $(SRC)/category.c \ - $(CONFIG_H) \ - $(LISP_H) \ $(SRC)/buffer.h \ $(SRC)/category.h \ - $(SRC)/character.h \ - $(SRC)/charset.h \ - $(SRC)/keymap.h + $(SRC)/keymap.h \ + $(CHARACTER_H) \ + $(CHARSET_H) \ + $(CONFIG_H) \ + $(LISP_H) $(BLD)/ccl.$(O) : \ $(SRC)/ccl.c \ - $(CONFIG_H) \ - $(LISP_H) \ $(SRC)/ccl.h \ - $(SRC)/character.h \ - $(SRC)/charset.h \ - $(SRC)/coding.h \ - $(SRC)/composite.h + $(CHARACTER_H) \ + $(CHARSET_H) \ + $(CODING_H) \ + $(CONFIG_H) \ + $(LISP_H) $(BLD)/character.$(O) : \ $(SRC)/character.c \ - $(CONFIG_H) \ - $(LISP_H) \ $(SRC)/buffer.h \ - $(SRC)/character.h \ - $(SRC)/charset.h \ $(SRC)/composite.h \ - $(SRC)/disptab.h + $(SRC)/disptab.h \ + $(GNU_LIB)/intprops.h \ + $(CHARACTER_H) \ + $(CHARSET_H) \ + $(CONFIG_H) \ + $(LISP_H) $(BLD)/charset.$(O) : \ $(SRC)/charset.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(LISP_H) \ $(SRC)/buffer.h \ - $(SRC)/character.h \ - $(SRC)/charset.h \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/disptab.h + $(SRC)/disptab.h \ + $(NT_INC)/unistd.h \ + $(CHARACTER_H) \ + $(CHARSET_H) \ + $(CODING_H) \ + $(CONFIG_H) \ + $(LISP_H) $(BLD)/chartab.$(O) : \ $(SRC)/chartab.c \ - $(CONFIG_H) \ - $(LISP_H) \ $(SRC)/ccl.h \ - $(SRC)/character.h \ - $(SRC)/charset.h + $(CHARACTER_H) \ + $(CHARSET_H) \ + $(CONFIG_H) \ + $(LISP_H) $(BLD)/cmds.$(O) : \ $(SRC)/cmds.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ $(SRC)/buffer.h \ - $(SRC)/character.h \ - $(SRC)/coding.h \ $(SRC)/commands.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/frame.h \ - $(SRC)/keyboard.h \ $(SRC)/keymap.h \ $(SRC)/syntax.h \ - $(SRC)/systime.h \ - $(SRC)/w32gui.h \ - $(SRC)/window.h + $(CHARACTER_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(FRAME_H) \ + $(KEYBOARD_H) \ + $(LISP_H) \ + $(WINDOW_H) $(BLD)/coding.$(O) : \ $(SRC)/coding.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ $(SRC)/buffer.h \ $(SRC)/ccl.h \ - $(SRC)/character.h \ - $(SRC)/charset.h \ - $(SRC)/coding.h \ $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/frame.h \ - $(SRC)/systime.h \ - $(SRC)/termhooks.h \ - $(SRC)/w32gui.h \ - $(SRC)/window.h + $(CHARACTER_H) \ + $(CHARSET_H) \ + $(CODING_H) \ + $(CONFIG_H) \ + $(FRAME_H) \ + $(LISP_H) \ + $(TERMHOOKS_H) \ + $(WINDOW_H) $(BLD)/composite.$(O) : \ $(SRC)/composite.c \ + $(SRC)/buffer.h \ + $(CHARACTER_H) \ + $(CODING_H) \ $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ + $(DISPEXTERN_H) \ + $(FONT_H) \ + $(FRAME_H) \ + $(INTERVALS_H) \ $(LISP_H) \ - $(SRC)/buffer.h \ - $(SRC)/ccl.h \ - $(SRC)/character.h \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/font.h \ - $(SRC)/frame.h \ - $(SRC)/intervals.h \ - $(SRC)/systime.h \ - $(SRC)/termhooks.h \ - $(SRC)/w32gui.h \ - $(SRC)/window.h + $(TERMHOOKS_H) \ + $(WINDOW_H) $(BLD)/data.$(O) : \ $(SRC)/data.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ $(SRC)/buffer.h \ - $(SRC)/ccl.h \ - $(SRC)/character.h \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/font.h \ - $(SRC)/frame.h \ - $(SRC)/keyboard.h \ $(SRC)/puresize.h \ $(SRC)/syssignal.h \ - $(SRC)/systime.h \ - $(SRC)/termhooks.h \ - $(SRC)/w32gui.h + $(GNU_LIB)/intprops.h \ + $(CHARACTER_H) \ + $(CONFIG_H) \ + $(FONT_H) \ + $(FRAME_H) \ + $(KEYBOARD_H) \ + $(LISP_H) \ + $(TERMHOOKS_H) $(BLD)/dired.$(O) : \ $(SRC)/dired.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/grp.h \ - $(EMACS_ROOT)/nt/inc/pwd.h \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/dir.h \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(EMACS_ROOT)/lib/filemode.h \ - $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ $(SRC)/buffer.h \ - $(SRC)/character.h \ - $(SRC)/charset.h \ - $(SRC)/coding.h \ $(SRC)/commands.h \ - $(SRC)/composite.h \ - $(SRC)/ndir.h \ $(SRC)/regex.h \ - $(SRC)/systime.h + $(NT_INC)/pwd.h \ + $(NT_INC)/sys/stat.h \ + $(NT_INC)/unistd.h \ + $(BLOCKINPUT_H) \ + $(CHARACTER_H) \ + $(CHARSET_H) \ + $(CODING_H) \ + $(CONFIG_H) \ + $(DIR_H) \ + $(FILEMODE_H) \ + $(GRP_H) \ + $(LISP_H) \ + $(SYSTIME_H) $(BLD)/dispnew.$(O) : \ $(SRC)/dispnew.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(PROCESS_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ $(SRC)/buffer.h \ - $(SRC)/character.h \ $(SRC)/cm.h \ - $(SRC)/coding.h \ $(SRC)/commands.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ $(SRC)/disptab.h \ - $(SRC)/frame.h \ $(SRC)/indent.h \ - $(SRC)/intervals.h \ - $(SRC)/keyboard.h \ $(SRC)/syssignal.h \ - $(SRC)/systime.h \ $(SRC)/termchar.h \ - $(SRC)/termhooks.h \ $(SRC)/termopts.h \ - $(SRC)/w32gui.h \ - $(SRC)/w32term.h \ - $(SRC)/window.h + $(NT_INC)/unistd.h \ + $(BLOCKINPUT_H) \ + $(CHARACTER_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(FRAME_H) \ + $(INTERVALS_H) \ + $(KEYBOARD_H) \ + $(LISP_H) \ + $(PROCESS_H) \ + $(SYSTIME_H) \ + $(TERMHOOKS_H) \ + $(W32TERM_H) \ + $(WINDOW_H) $(BLD)/doc.$(O) : \ $(SRC)/doc.c \ - $(CONFIG_H) \ - buildobj.h \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/file.h \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ $(SRC)/buffer.h \ - $(SRC)/character.h \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/keyboard.h \ + $(SRC)/buildobj.h \ $(SRC)/keymap.h \ - $(SRC)/systime.h + $(NT_INC)/sys/file.h \ + $(NT_INC)/unistd.h \ + $(CHARACTER_H) \ + $(CONFIG_H) \ + $(KEYBOARD_H) \ + $(LISP_H) $(BLD)/doprnt.$(O) : \ $(SRC)/doprnt.c \ + $(NT_INC)/unistd.h \ + $(CHARACTER_H) \ $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(LISP_H) \ - $(SRC)/character.h + $(LISP_H) $(BLD)/editfns.$(O) : \ $(SRC)/editfns.c \ + $(SRC)/buffer.h \ + $(NT_INC)/pwd.h \ + $(NT_INC)/unistd.h \ + $(GNU_LIB)/intprops.h \ + $(GNU_LIB)/strftime.h \ + $(GNU_LIB)/verify.h \ + $(BLOCKINPUT_H) \ + $(CHARACTER_H) \ + $(CODING_H) \ $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/pwd.h \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(EMACS_ROOT)/lib/strftime.h \ - $(EMACS_ROOT)/lib/verify.h \ + $(FRAME_H) \ + $(INTERVALS_H) \ $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ - $(SRC)/buffer.h \ - $(SRC)/character.h \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/frame.h \ - $(SRC)/intervals.h \ - $(SRC)/systime.h \ - $(SRC)/w32gui.h \ - $(SRC)/window.h + $(SYSTIME_H) \ + $(WINDOW_H) $(BLD)/emacs.$(O) : \ $(SRC)/emacs.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/file.h \ - $(EMACS_ROOT)/nt/inc/sys/ioctl.h \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(PROCESS_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ $(SRC)/buffer.h \ - $(SRC)/coding.h \ $(SRC)/commands.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/frame.h \ - $(SRC)/intervals.h \ - $(SRC)/keyboard.h \ + $(SRC)/gnutls.h \ $(SRC)/keymap.h \ $(SRC)/syssignal.h \ - $(SRC)/systime.h \ - $(SRC)/systty.h \ - $(SRC)/termhooks.h \ $(SRC)/unexec.h \ $(SRC)/w32.h \ - $(SRC)/w32gui.h \ $(SRC)/w32heap.h \ - $(SRC)/window.h + $(NT_INC)/sys/file.h \ + $(NT_INC)/unistd.h \ + $(BLOCKINPUT_H) \ + $(CONFIG_H) \ + $(FRAME_H) \ + $(INTERVALS_H) \ + $(KEYBOARD_H) \ + $(LISP_H) \ + $(PROCESS_H) \ + $(SYSTTY_H) \ + $(TERMHOOKS_H) \ + $(WINDOW_H) $(BLD)/eval.$(O) : \ $(SRC)/eval.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ - $(SRC)/coding.h \ $(SRC)/commands.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/frame.h \ - $(SRC)/keyboard.h \ - $(SRC)/systime.h \ - $(SRC)/w32gui.h + $(BLOCKINPUT_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(FRAME_H) \ + $(KEYBOARD_H) \ + $(LISP_H) $(BLD)/fileio.$(O) : \ $(SRC)/fileio.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/pwd.h \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ $(SRC)/buffer.h \ - $(SRC)/character.h \ - $(SRC)/coding.h \ $(SRC)/commands.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/frame.h \ - $(SRC)/intervals.h \ - $(SRC)/systime.h \ - $(SRC)/w32gui.h \ - $(SRC)/window.h + $(NT_INC)/pwd.h \ + $(NT_INC)/sys/stat.h \ + $(NT_INC)/unistd.h \ + $(BLOCKINPUT_H) \ + $(CHARACTER_H) \ + $(CODING_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(FRAME_H) \ + $(INTERVALS_H) \ + $(LISP_H) \ + $(SYSTIME_H) \ + $(WINDOW_H) $(BLD)/filelock.$(O) : \ $(SRC)/filelock.c \ + $(SRC)/buffer.h \ + $(NT_INC)/pwd.h \ + $(NT_INC)/sys/file.h \ + $(NT_INC)/sys/stat.h \ + $(NT_INC)/unistd.h \ + $(CHARACTER_H) \ + $(CODING_H) \ $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/pwd.h \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/file.h \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ $(LISP_H) \ - $(SRC)/buffer.h \ - $(SRC)/character.h \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/systime.h + $(SYSTIME_H) $(BLD)/firstfile.$(O) : \ $(SRC)/firstfile.c \ @@ -854,271 +835,213 @@ $(BLD)/firstfile.$(O) : \ $(BLD)/floatfns.$(O) : \ $(SRC)/floatfns.c \ + $(SRC)/syssignal.h \ $(CONFIG_H) \ - $(LISP_H) \ - $(SRC)/syssignal.h + $(LISP_H) $(BLD)/fns.$(O) : \ $(SRC)/fns.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/langinfo.h \ - $(EMACS_ROOT)/nt/inc/nl_types.h \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(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 \ $(SRC)/buffer.h \ - $(SRC)/character.h \ - $(SRC)/coding.h \ $(SRC)/commands.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/frame.h \ - $(SRC)/intervals.h \ - $(SRC)/keyboard.h \ $(SRC)/keymap.h \ - $(SRC)/systime.h \ - $(SRC)/w32gui.h \ - $(SRC)/window.h + $(NT_INC)/unistd.h \ + $(GNU_LIB)/intprops.h \ + $(BLOCKINPUT_H) \ + $(CHARACTER_H) \ + $(CODING_H) \ + $(CONFIG_H) \ + $(FRAME_H) \ + $(INTERVALS_H) \ + $(KEYBOARD_H) \ + $(LANGINFO_H) \ + $(LISP_H) \ + $(MD5_H) \ + $(SHA1_H) \ + $(SHA256_H) \ + $(SHA512_H) \ + $(WINDOW_H) $(BLD)/font.$(O) : \ $(SRC)/font.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ $(SRC)/buffer.h \ - $(SRC)/ccl.h \ - $(SRC)/character.h \ - $(SRC)/charset.h \ $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/font.h \ $(SRC)/fontset.h \ - $(SRC)/frame.h \ - $(SRC)/systime.h \ - $(SRC)/w32gui.h \ - $(SRC)/w32term.h \ - $(SRC)/window.h + $(CHARACTER_H) \ + $(CHARSET_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(FONT_H) \ + $(FRAME_H) \ + $(LISP_H) \ + $(W32TERM_H) \ + $(WINDOW_H) $(BLD)/fontset.$(O) : \ $(SRC)/fontset.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ $(SRC)/buffer.h \ $(SRC)/ccl.h \ - $(SRC)/character.h \ - $(SRC)/charset.h \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/font.h \ $(SRC)/fontset.h \ - $(SRC)/frame.h \ - $(SRC)/intervals.h \ - $(SRC)/keyboard.h \ - $(SRC)/systime.h \ - $(SRC)/termhooks.h \ - $(SRC)/w32gui.h \ - $(SRC)/w32term.h \ - $(SRC)/window.h + $(BLOCKINPUT_H) \ + $(CHARACTER_H) \ + $(CHARSET_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(FONT_H) \ + $(FRAME_H) \ + $(INTERVALS_H) \ + $(KEYBOARD_H) \ + $(LISP_H) \ + $(TERMHOOKS_H) \ + $(W32TERM_H) \ + $(WINDOW_H) $(BLD)/frame.$(O) : \ $(SRC)/frame.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ $(SRC)/buffer.h \ - $(SRC)/ccl.h \ - $(SRC)/character.h \ - $(SRC)/coding.h \ $(SRC)/commands.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/font.h \ $(SRC)/fontset.h \ - $(SRC)/frame.h \ - $(SRC)/keyboard.h \ - $(SRC)/systime.h \ $(SRC)/termchar.h \ - $(SRC)/termhooks.h \ - $(SRC)/w32gui.h \ - $(SRC)/w32term.h \ - $(SRC)/window.h + $(BLOCKINPUT_H) \ + $(CHARACTER_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(FONT_H) \ + $(FRAME_H) \ + $(KEYBOARD_H) \ + $(LISP_H) \ + $(TERMHOOKS_H) \ + $(W32TERM_H) \ + $(WINDOW_H) $(BLD)/fringe.$(O) : \ $(SRC)/fringe.c \ + $(SRC)/buffer.h \ + $(BLOCKINPUT_H) \ $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ + $(DISPEXTERN_H) \ + $(FRAME_H) \ $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ - $(SRC)/buffer.h \ - $(SRC)/dispextern.h \ - $(SRC)/frame.h \ - $(SRC)/systime.h \ - $(SRC)/termhooks.h \ - $(SRC)/w32gui.h \ - $(SRC)/window.h + $(TERMHOOKS_H) \ + $(WINDOW_H) $(BLD)/gmalloc.$(O) : \ $(SRC)/gmalloc.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(SRC)/getpagesize.h + $(SRC)/getpagesize.h \ + $(NT_INC)/unistd.h \ + $(CONFIG_H) $(BLD)/gnutls.$(O) : \ $(SRC)/gnutls.c \ + $(SRC)/w32.h \ $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/unistd.h \ $(LISP_H) \ - $(PROCESS_H) \ - $(SRC)/w32.h + $(PROCESS_H) $(BLD)/image.$(O) : \ $(SRC)/image.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ - $(SRC)/ccl.h \ - $(SRC)/character.h \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ $(SRC)/epaths.h \ - $(SRC)/font.h \ - $(SRC)/frame.h \ - $(SRC)/systime.h \ - $(SRC)/termhooks.h \ $(SRC)/w32.h \ - $(SRC)/w32gui.h \ - $(SRC)/w32term.h \ - $(SRC)/window.h + $(NT_INC)/unistd.h \ + $(BLOCKINPUT_H) \ + $(CHARACTER_H) \ + $(CODING_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(FONT_H) \ + $(FRAME_H) \ + $(LISP_H) \ + $(SYSTIME_H) \ + $(TERMHOOKS_H) \ + $(W32TERM_H) \ + $(WINDOW_H) $(BLD)/indent.$(O) : \ $(SRC)/indent.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ $(SRC)/buffer.h \ $(SRC)/category.h \ - $(SRC)/character.h \ - $(SRC)/coding.h \ $(SRC)/composite.h \ - $(SRC)/dispextern.h \ $(SRC)/disptab.h \ - $(SRC)/frame.h \ $(SRC)/indent.h \ - $(SRC)/intervals.h \ - $(SRC)/keyboard.h \ $(SRC)/region-cache.h \ - $(SRC)/systime.h \ $(SRC)/termchar.h \ $(SRC)/termopts.h \ - $(SRC)/w32gui.h \ - $(SRC)/window.h + $(CHARACTER_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(FRAME_H) \ + $(INTERVALS_H) \ + $(KEYBOARD_H) \ + $(LISP_H) \ + $(WINDOW_H) $(BLD)/insdel.$(O) : \ $(SRC)/insdel.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ $(SRC)/buffer.h \ - $(SRC)/character.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/intervals.h \ $(SRC)/region-cache.h \ - $(SRC)/systime.h \ - $(SRC)/w32gui.h \ - $(SRC)/window.h + $(GNU_LIB)/intprops.h \ + $(BLOCKINPUT_H) \ + $(CHARACTER_H) \ + $(CONFIG_H) \ + $(INTERVALS_H) \ + $(LISP_H) \ + $(WINDOW_H) $(BLD)/intervals.$(O) : \ $(SRC)/intervals.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ $(SRC)/buffer.h \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/intervals.h \ - $(SRC)/keyboard.h \ $(SRC)/keymap.h \ $(SRC)/puresize.h \ - $(SRC)/systime.h \ - $(SRC)/w32gui.h + $(GNU_LIB)/intprops.h \ + $(CONFIG_H) \ + $(INTERVALS_H) \ + $(KEYBOARD_H) \ + $(LISP_H) $(BLD)/keyboard.$(O) : \ $(SRC)/keyboard.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/ioctl.h \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(PROCESS_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ $(SRC)/buffer.h \ - $(SRC)/character.h \ - $(SRC)/coding.h \ $(SRC)/commands.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ $(SRC)/disptab.h \ - $(SRC)/frame.h \ - $(SRC)/intervals.h \ - $(SRC)/keyboard.h \ $(SRC)/keymap.h \ $(SRC)/macros.h \ $(SRC)/puresize.h \ $(SRC)/syntax.h \ $(SRC)/syssignal.h \ - $(SRC)/systime.h \ $(SRC)/termchar.h \ - $(SRC)/termhooks.h \ $(SRC)/termopts.h \ - $(SRC)/w32gui.h \ - $(SRC)/w32term.h \ - $(SRC)/window.h + $(NT_INC)/sys/ioctl.h \ + $(NT_INC)/unistd.h \ + $(ATIMER_H) \ + $(BLOCKINPUT_H) \ + $(CHARACTER_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(FRAME_H) \ + $(INTERVALS_H) \ + $(KEYBOARD_H) \ + $(LISP_H) \ + $(PROCESS_H) \ + $(SYSTIME_H) \ + $(TERMHOOKS_H) \ + $(W32TERM_H) \ + $(WINDOW_H) $(BLD)/keymap.$(O) : \ $(SRC)/keymap.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ $(SRC)/buffer.h \ - $(SRC)/character.h \ - $(SRC)/charset.h \ - $(SRC)/coding.h \ $(SRC)/commands.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/frame.h \ - $(SRC)/intervals.h \ - $(SRC)/keyboard.h \ $(SRC)/keymap.h \ $(SRC)/puresize.h \ - $(SRC)/systime.h \ - $(SRC)/termhooks.h \ - $(SRC)/w32gui.h \ - $(SRC)/window.h + $(BLOCKINPUT_H) \ + $(CHARACTER_H) \ + $(CHARSET_H) \ + $(CONFIG_H) \ + $(FRAME_H) \ + $(INTERVALS_H) \ + $(KEYBOARD_H) \ + $(LISP_H) \ + $(TERMHOOKS_H) \ + $(WINDOW_H) $(BLD)/lastfile.$(O) : \ $(SRC)/lastfile.c \ @@ -1126,714 +1049,560 @@ $(BLD)/lastfile.$(O) : \ $(BLD)/lread.$(O) : \ $(SRC)/lread.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/file.h \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ $(SRC)/buffer.h \ - $(SRC)/character.h \ - $(SRC)/charset.h \ - $(SRC)/coding.h \ $(SRC)/commands.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ $(SRC)/epaths.h \ - $(SRC)/frame.h \ - $(SRC)/intervals.h \ - $(SRC)/keyboard.h \ - $(SRC)/systime.h \ - $(SRC)/termhooks.h \ - $(SRC)/w32gui.h + $(NT_INC)/sys/file.h \ + $(NT_INC)/sys/stat.h \ + $(NT_INC)/unistd.h \ + $(BLOCKINPUT_H) \ + $(CHARACTER_H) \ + $(CHARSET_H) \ + $(CODING_H) \ + $(CONFIG_H) \ + $(FRAME_H) \ + $(INTERVALS_H) \ + $(KEYBOARD_H) \ + $(LISP_H) \ + $(TERMHOOKS_H) $(BLD)/macros.$(O) : \ $(SRC)/macros.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ $(SRC)/buffer.h \ - $(SRC)/coding.h \ $(SRC)/commands.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/keyboard.h \ $(SRC)/macros.h \ - $(SRC)/systime.h \ - $(SRC)/w32gui.h \ - $(SRC)/window.h + $(CONFIG_H) \ + $(KEYBOARD_H) \ + $(LISP_H) \ + $(WINDOW_H) $(BLD)/marker.$(O) : \ $(SRC)/marker.c \ - $(CONFIG_H) \ - $(LISP_H) \ $(SRC)/buffer.h \ - $(SRC)/character.h + $(CHARACTER_H) \ + $(CONFIG_H) \ + $(LISP_H) $(BLD)/menu.$(O) : \ $(SRC)/menu.c \ + $(SRC)/keymap.h \ + $(BLOCKINPUT_H) \ $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ + $(DISPEXTERN_H) \ + $(FRAME_H) \ + $(KEYBOARD_H) \ $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/frame.h \ - $(SRC)/keyboard.h \ - $(SRC)/keymap.h \ - $(SRC)/menu.h \ - $(SRC)/systime.h \ - $(SRC)/termhooks.h \ - $(SRC)/w32gui.h \ - $(SRC)/w32term.h \ - $(SRC)/window.h + $(MENU_H) \ + $(TERMHOOKS_H) \ + $(W32TERM_H) \ + $(WINDOW_H) $(BLD)/minibuf.$(O) : \ $(SRC)/minibuf.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ $(SRC)/buffer.h \ - $(SRC)/character.h \ - $(SRC)/coding.h \ $(SRC)/commands.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/frame.h \ - $(SRC)/intervals.h \ - $(SRC)/keyboard.h \ $(SRC)/keymap.h \ $(SRC)/syntax.h \ - $(SRC)/systime.h \ - $(SRC)/termhooks.h \ - $(SRC)/w32gui.h \ - $(SRC)/window.h + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(FRAME_H) \ + $(INTERVALS_H) \ + $(KEYBOARD_H) \ + $(LISP_H) \ + $(TERMHOOKS_H) \ + $(WINDOW_H) $(BLD)/w32.$(O) : \ $(SRC)/w32.c \ + $(SRC)/ndir.h \ + $(SRC)/w32.h \ + $(SRC)/w32heap.h \ + $(NT_INC)/pwd.h \ + $(NT_INC)/sys/file.h \ + $(NT_INC)/sys/time.h \ + $(GNU_LIB)/allocator.h \ + $(CAREADLINKAT_H) \ + $(CODING_H) \ $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/grp.h \ - $(EMACS_ROOT)/nt/inc/pwd.h \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/file.h \ - $(EMACS_ROOT)/nt/inc/sys/socket.h \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(EMACS_ROOT)/lib/allocator.h \ - $(EMACS_ROOT)/lib/careadlinkat.h \ + $(DISPEXTERN_H) \ + $(GRP_H) \ $(LISP_H) \ $(PROCESS_H) \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/ndir.h \ - $(SRC)/systime.h \ - $(SRC)/w32.h \ - $(SRC)/w32gui.h \ - $(SRC)/w32heap.h + $(SOCKET_H) \ + $(SYSTIME_H) $(BLD)/w32heap.$(O) : \ $(SRC)/w32heap.c \ + $(SRC)/w32heap.h \ $(CONFIG_H) \ - $(LISP_H) \ - $(SRC)/w32heap.h + $(LISP_H) $(BLD)/w32inevt.$(O) : \ $(SRC)/w32inevt.c \ + $(SRC)/w32heap.h \ + $(BLOCKINPUT_H) \ $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ + $(DISPEXTERN_H) \ + $(FRAME_H) \ + $(KEYBOARD_H) \ $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/frame.h \ - $(SRC)/keyboard.h \ - $(SRC)/systime.h \ - $(SRC)/termhooks.h \ - $(SRC)/w32gui.h \ - $(SRC)/w32heap.h \ - $(SRC)/w32term.h + $(TERMHOOKS_H) \ + $(W32TERM_H) $(BLD)/w32proc.$(O) : \ $(SRC)/w32proc.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/langinfo.h \ - $(EMACS_ROOT)/nt/inc/nl_types.h \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/file.h \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(PROCESS_H) \ - $(SRC)/character.h \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ $(SRC)/syssignal.h \ - $(SRC)/systime.h \ $(SRC)/syswait.h \ $(SRC)/w32.h \ - $(SRC)/w32gui.h \ $(SRC)/w32heap.h \ - $(SRC)/w32term.h + $(NT_INC)/nl_types.h \ + $(NT_INC)/sys/file.h \ + $(CODING_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(LANGINFO_H) \ + $(LISP_H) \ + $(PROCESS_H) \ + $(SYSTIME_H) \ + $(W32TERM_H) $(BLD)/w32console.$(O) : \ $(SRC)/w32console.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(SRC)/character.h \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ $(SRC)/disptab.h \ - $(SRC)/frame.h \ - $(SRC)/systime.h \ $(SRC)/termchar.h \ - $(SRC)/termhooks.h \ - $(SRC)/w32gui.h \ - $(SRC)/w32inevt.h + $(SRC)/w32inevt.h \ + $(CHARACTER_H) \ + $(CODING_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(FRAME_H) \ + $(LISP_H) \ + $(TERMHOOKS_H) $(BLD)/print.$(O) : \ $(SRC)/print.c \ + $(SRC)/buffer.h \ + $(SRC)/termchar.h \ + $(BLOCKINPUT_H) \ + $(CHARACTER_H) \ + $(CHARSET_H) \ $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(EMACS_ROOT)/lib/ftoastr.h \ + $(DISPEXTERN_H) \ + $(FONT_H) \ + $(FRAME_H) \ + $(FTOASTR_H) \ + $(INTERVALS_H) \ + $(KEYBOARD_H) \ $(LISP_H) \ $(PROCESS_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ - $(SRC)/buffer.h \ - $(SRC)/ccl.h \ - $(SRC)/character.h \ - $(SRC)/charset.h \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/font.h \ - $(SRC)/frame.h \ - $(SRC)/intervals.h \ - $(SRC)/keyboard.h \ - $(SRC)/systime.h \ - $(SRC)/termchar.h \ - $(SRC)/termhooks.h \ - $(SRC)/w32gui.h \ - $(SRC)/window.h + $(TERMHOOKS_H) \ + $(WINDOW_H) $(BLD)/process.$(O) : \ $(SRC)/process.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/netdb.h \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/arpa/inet.h \ - $(EMACS_ROOT)/nt/inc/netinet/in.h \ - $(EMACS_ROOT)/nt/inc/sys/file.h \ - $(EMACS_ROOT)/nt/inc/sys/ioctl.h \ - $(EMACS_ROOT)/nt/inc/sys/socket.h \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(PROCESS_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ $(SRC)/buffer.h \ - $(SRC)/character.h \ - $(SRC)/coding.h \ $(SRC)/commands.h \ $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/frame.h \ - $(SRC)/keyboard.h \ + $(SRC)/gnutls.h \ $(SRC)/sysselect.h \ $(SRC)/syssignal.h \ - $(SRC)/systime.h \ - $(SRC)/systty.h \ $(SRC)/syswait.h \ - $(SRC)/termhooks.h \ $(SRC)/termopts.h \ - $(SRC)/w32.h \ - $(SRC)/w32gui.h \ - $(SRC)/window.h + $(NT_INC)/arpa/inet.h \ + $(NT_INC)/netdb.h \ + $(NT_INC)/netinet/in.h \ + $(NT_INC)/sys/file.h \ + $(NT_INC)/sys/ioctl.h \ + $(NT_INC)/sys/stat.h \ + $(NT_INC)/unistd.h \ + $(ATIMER_H) \ + $(BLOCKINPUT_H) \ + $(CHARACTER_H) \ + $(CODING_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(FRAME_H) \ + $(KEYBOARD_H) \ + $(LISP_H) \ + $(PROCESS_H) \ + $(SOCKET_H) \ + $(SYSTIME_H) \ + $(SYSTTY_H) \ + $(TERMHOOKS_H) \ + $(WINDOW_H) $(BLD)/ralloc.$(O) : \ $(SRC)/ralloc.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ $(SRC)/getpagesize.h \ - $(SRC)/systime.h + $(NT_INC)/unistd.h \ + $(BLOCKINPUT_H) \ + $(CONFIG_H) \ + $(LISP_H) $(BLD)/regex.$(O) : \ $(SRC)/regex.c \ - $(CONFIG_H) \ - $(LISP_H) \ $(SRC)/buffer.h \ $(SRC)/category.h \ - $(SRC)/character.h \ $(SRC)/regex.h \ - $(SRC)/syntax.h + $(SRC)/syntax.h \ + $(NT_INC)/unistd.h \ + $(CHARACTER_H) \ + $(CONFIG_H) \ + $(LISP_H) $(BLD)/region-cache.$(O) : \ $(SRC)/region-cache.c \ - $(CONFIG_H) \ - $(LISP_H) \ $(SRC)/buffer.h \ - $(SRC)/region-cache.h + $(SRC)/region-cache.h \ + $(CONFIG_H) \ + $(LISP_H) $(BLD)/scroll.$(O) : \ $(SRC)/scroll.c \ + $(SRC)/termchar.h \ $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ + $(DISPEXTERN_H) \ + $(FRAME_H) \ + $(KEYBOARD_H) \ $(LISP_H) \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/frame.h \ - $(SRC)/keyboard.h \ - $(SRC)/systime.h \ - $(SRC)/termchar.h \ - $(SRC)/termhooks.h \ - $(SRC)/w32gui.h \ - $(SRC)/window.h + $(TERMHOOKS_H) \ + $(WINDOW_H) $(BLD)/search.$(O) : \ $(SRC)/search.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ $(SRC)/buffer.h \ $(SRC)/category.h \ - $(SRC)/character.h \ - $(SRC)/charset.h \ $(SRC)/commands.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/intervals.h \ $(SRC)/regex.h \ $(SRC)/region-cache.h \ $(SRC)/syntax.h \ - $(SRC)/systime.h \ - $(SRC)/w32gui.h + $(BLOCKINPUT_H) \ + $(CHARACTER_H) \ + $(CHARSET_H) \ + $(CONFIG_H) \ + $(INTERVALS_H) \ + $(LISP_H) $(BLD)/sound.$(O) : \ $(SRC)/sound.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/dispextern.h \ $(SRC)/syssignal.h \ - $(SRC)/systime.h \ - $(SRC)/w32gui.h + $(NT_INC)/unistd.h \ + $(ATIMER_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(LISP_H) $(BLD)/syntax.$(O) : \ $(SRC)/syntax.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ $(SRC)/buffer.h \ $(SRC)/category.h \ - $(SRC)/character.h \ $(SRC)/commands.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/intervals.h \ $(SRC)/keymap.h \ $(SRC)/regex.h \ $(SRC)/syntax.h \ - $(SRC)/systime.h \ - $(SRC)/w32gui.h + $(CHARACTER_H) \ + $(CONFIG_H) \ + $(INTERVALS_H) \ + $(LISP_H) $(BLD)/sysdep.$(O) : \ $(SRC)/sysdep.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/grp.h \ - $(EMACS_ROOT)/nt/inc/netdb.h \ - $(EMACS_ROOT)/nt/inc/pwd.h \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/file.h \ - $(EMACS_ROOT)/nt/inc/sys/ioctl.h \ - $(EMACS_ROOT)/nt/inc/sys/socket.h \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(EMACS_ROOT)/lib/allocator.h \ - $(EMACS_ROOT)/lib/careadlinkat.h \ - $(EMACS_ROOT)/lib/ignore-value.h \ - $(LISP_H) \ - $(PROCESS_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ $(SRC)/cm.h \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/frame.h \ - $(SRC)/keyboard.h \ $(SRC)/sysselect.h \ $(SRC)/syssignal.h \ - $(SRC)/systime.h \ - $(SRC)/systty.h \ $(SRC)/syswait.h \ $(SRC)/termchar.h \ - $(SRC)/termhooks.h \ $(SRC)/termopts.h \ - $(SRC)/w32.h \ - $(SRC)/w32gui.h \ - $(SRC)/window.h + $(NT_INC)/netdb.h \ + $(NT_INC)/pwd.h \ + $(NT_INC)/sys/file.h \ + $(NT_INC)/sys/stat.h \ + $(NT_INC)/unistd.h \ + $(GNU_LIB)/allocator.h \ + $(GNU_LIB)/ignore-value.h \ + $(BLOCKINPUT_H) \ + $(CAREADLINKAT_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(FRAME_H) \ + $(GRP_H) \ + $(KEYBOARD_H) \ + $(LISP_H) \ + $(PROCESS_H) \ + $(SOCKET_H) \ + $(SYSTIME_H) \ + $(SYSTTY_H) \ + $(TERMHOOKS_H) \ + $(WINDOW_H) $(BLD)/term.$(O) : \ $(SRC)/term.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/file.h \ - $(EMACS_ROOT)/nt/inc/sys/ioctl.h \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ $(SRC)/buffer.h \ - $(SRC)/character.h \ - $(SRC)/charset.h \ $(SRC)/cm.h \ - $(SRC)/coding.h \ $(SRC)/composite.h \ - $(SRC)/dispextern.h \ $(SRC)/disptab.h \ - $(SRC)/frame.h \ - $(SRC)/intervals.h \ - $(SRC)/keyboard.h \ $(SRC)/keymap.h \ $(SRC)/syssignal.h \ - $(SRC)/systime.h \ - $(SRC)/systty.h \ $(SRC)/termchar.h \ - $(SRC)/termhooks.h \ $(SRC)/termopts.h \ $(SRC)/tparam.h \ - $(SRC)/w32gui.h \ - $(SRC)/window.h + $(NT_INC)/sys/file.h \ + $(NT_INC)/unistd.h \ + $(BLOCKINPUT_H) \ + $(CHARACTER_H) \ + $(CHARSET_H) \ + $(CODING_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(FRAME_H) \ + $(INTERVALS_H) \ + $(KEYBOARD_H) \ + $(LISP_H) \ + $(SYSTTY_H) \ + $(TERMHOOKS_H) \ + $(WINDOW_H) $(BLD)/terminal.$(O) : \ $(SRC)/terminal.c \ + $(SRC)/termchar.h \ + $(CHARSET_H) \ + $(CODING_H) \ $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ + $(FRAME_H) \ + $(KEYBOARD_H) \ $(LISP_H) \ - $(SRC)/charset.h \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/frame.h \ - $(SRC)/keyboard.h \ - $(SRC)/systime.h \ - $(SRC)/termchar.h \ - $(SRC)/termhooks.h \ - $(SRC)/w32gui.h + $(TERMHOOKS_H) $(BLD)/textprop.$(O) : \ $(SRC)/textprop.c \ + $(SRC)/buffer.h \ $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ + $(INTERVALS_H) \ $(LISP_H) \ - $(SRC)/buffer.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/intervals.h \ - $(SRC)/systime.h \ - $(SRC)/w32gui.h \ - $(SRC)/window.h + $(WINDOW_H) $(BLD)/tparam.$(O) : \ $(SRC)/tparam.c \ + $(SRC)/tparam.h \ $(CONFIG_H) \ - $(LISP_H) \ - $(SRC)/tparam.h + $(LISP_H) $(BLD)/undo.$(O) : \ $(SRC)/undo.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ $(SRC)/buffer.h \ $(SRC)/commands.h \ - $(SRC)/dispextern.h \ - $(SRC)/systime.h \ - $(SRC)/w32gui.h \ - $(SRC)/window.h + $(CONFIG_H) \ + $(LISP_H) \ + $(WINDOW_H) $(BLD)/unexw32.$(O) : \ $(SRC)/unexw32.c \ - $(CONFIG_H) \ $(SRC)/unexec.h \ - $(SRC)/w32heap.h + $(SRC)/w32heap.h \ + $(CONFIG_H) $(BLD)/vm-limit.$(O) : \ $(SRC)/vm-limit.c \ + $(SRC)/mem-limits.h \ $(CONFIG_H) \ - $(LISP_H) \ - $(SRC)/mem-limits.h + $(LISP_H) $(BLD)/window.$(O) : \ $(SRC)/window.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ $(SRC)/buffer.h \ - $(SRC)/coding.h \ $(SRC)/commands.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ $(SRC)/disptab.h \ - $(SRC)/frame.h \ $(SRC)/indent.h \ - $(SRC)/intervals.h \ - $(SRC)/keyboard.h \ $(SRC)/keymap.h \ - $(SRC)/systime.h \ $(SRC)/termchar.h \ - $(SRC)/termhooks.h \ - $(SRC)/w32gui.h \ - $(SRC)/w32term.h \ - $(SRC)/window.h + $(BLOCKINPUT_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(FRAME_H) \ + $(INTERVALS_H) \ + $(KEYBOARD_H) \ + $(LISP_H) \ + $(TERMHOOKS_H) \ + $(W32TERM_H) \ + $(WINDOW_H) $(BLD)/xdisp.$(O) : \ $(SRC)/xdisp.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(PROCESS_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ $(SRC)/buffer.h \ - $(SRC)/ccl.h \ - $(SRC)/character.h \ - $(SRC)/charset.h \ - $(SRC)/coding.h \ $(SRC)/commands.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ $(SRC)/disptab.h \ - $(SRC)/font.h \ $(SRC)/fontset.h \ - $(SRC)/frame.h \ $(SRC)/indent.h \ - $(SRC)/intervals.h \ - $(SRC)/keyboard.h \ $(SRC)/keymap.h \ $(SRC)/macros.h \ $(SRC)/region-cache.h \ - $(SRC)/systime.h \ $(SRC)/termchar.h \ - $(SRC)/termhooks.h \ $(SRC)/termopts.h \ - $(SRC)/w32gui.h \ - $(SRC)/w32term.h \ - $(SRC)/window.h + $(BLOCKINPUT_H) \ + $(CHARACTER_H) \ + $(CHARSET_H) \ + $(CODING_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(FONT_H) \ + $(FRAME_H) \ + $(INTERVALS_H) \ + $(KEYBOARD_H) \ + $(LISP_H) \ + $(PROCESS_H) \ + $(TERMHOOKS_H) \ + $(W32TERM_H) \ + $(WINDOW_H) $(BLD)/xfaces.$(O) : \ $(SRC)/xfaces.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ $(SRC)/buffer.h \ - $(SRC)/ccl.h \ - $(SRC)/character.h \ - $(SRC)/charset.h \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/font.h \ $(SRC)/fontset.h \ - $(SRC)/frame.h \ - $(SRC)/intervals.h \ - $(SRC)/keyboard.h \ - $(SRC)/systime.h \ $(SRC)/termchar.h \ - $(SRC)/termhooks.h \ - $(SRC)/w32gui.h \ - $(SRC)/w32term.h \ - $(SRC)/window.h + $(NT_INC)/sys/stat.h \ + $(BLOCKINPUT_H) \ + $(CHARACTER_H) \ + $(CHARSET_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(FONT_H) \ + $(FRAME_H) \ + $(INTERVALS_H) \ + $(KEYBOARD_H) \ + $(LISP_H) \ + $(TERMHOOKS_H) \ + $(W32TERM_H) \ + $(WINDOW_H) $(BLD)/w32fns.$(O) : \ $(SRC)/w32fns.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ $(SRC)/buffer.h \ $(SRC)/ccl.h \ - $(SRC)/character.h \ - $(SRC)/charset.h \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ $(SRC)/epaths.h \ - $(SRC)/font.h \ $(SRC)/fontset.h \ - $(SRC)/frame.h \ - $(SRC)/intervals.h \ - $(SRC)/keyboard.h \ - $(SRC)/systime.h \ - $(SRC)/termhooks.h \ $(SRC)/w32.h \ $(SRC)/w32font.h \ - $(SRC)/w32gui.h \ $(SRC)/w32heap.h \ - $(SRC)/w32term.h \ - $(SRC)/window.h + $(BLOCKINPUT_H) \ + $(CHARACTER_H) \ + $(CHARSET_H) \ + $(CODING_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(FONT_H) \ + $(FRAME_H) \ + $(INTERVALS_H) \ + $(KEYBOARD_H) \ + $(LISP_H) \ + $(SYSTIME_H) \ + $(TERMHOOKS_H) \ + $(W32TERM_H) \ + $(WINDOW_H) $(BLD)/w32menu.$(O) : \ $(SRC)/w32menu.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ $(SRC)/buffer.h \ - $(SRC)/character.h \ - $(SRC)/charset.h \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/frame.h \ - $(SRC)/keyboard.h \ $(SRC)/keymap.h \ - $(SRC)/menu.h \ - $(SRC)/systime.h \ - $(SRC)/termhooks.h \ - $(SRC)/w32gui.h \ - $(SRC)/w32term.h \ - $(SRC)/window.h + $(BLOCKINPUT_H) \ + $(CHARSET_H) \ + $(CODING_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(FRAME_H) \ + $(KEYBOARD_H) \ + $(LISP_H) \ + $(MENU_H) \ + $(TERMHOOKS_H) \ + $(W32TERM_H) \ + $(WINDOW_H) $(BLD)/w32term.$(O) : \ $(SRC)/w32term.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/ioctl.h \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(PROCESS_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ $(SRC)/buffer.h \ $(SRC)/ccl.h \ - $(SRC)/character.h \ - $(SRC)/charset.h \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ $(SRC)/disptab.h \ - $(SRC)/font.h \ $(SRC)/fontset.h \ - $(SRC)/frame.h \ - $(SRC)/intervals.h \ - $(SRC)/keyboard.h \ $(SRC)/keymap.h \ - $(SRC)/systime.h \ - $(SRC)/systty.h \ $(SRC)/termchar.h \ - $(SRC)/termhooks.h \ $(SRC)/termopts.h \ $(SRC)/w32font.h \ - $(SRC)/w32gui.h \ $(SRC)/w32heap.h \ - $(SRC)/w32term.h \ - $(SRC)/window.h + $(NT_INC)/sys/stat.h \ + $(ATIMER_H) \ + $(BLOCKINPUT_H) \ + $(CHARACTER_H) \ + $(CHARSET_H) \ + $(CODING_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(FONT_H) \ + $(FRAME_H) \ + $(INTERVALS_H) \ + $(KEYBOARD_H) \ + $(LISP_H) \ + $(PROCESS_H) \ + $(SYSTIME_H) \ + $(SYSTTY_H) \ + $(TERMHOOKS_H) \ + $(W32TERM_H) \ + $(WINDOW_H) $(BLD)/w32select.$(O) : \ $(SRC)/w32select.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ - $(SRC)/character.h \ - $(SRC)/charset.h \ - $(SRC)/coding.h \ $(SRC)/composite.h \ - $(SRC)/systime.h \ - $(SRC)/w32gui.h \ $(SRC)/w32heap.h \ - $(SRC)/w32term.h + $(BLOCKINPUT_H) \ + $(CHARSET_H) \ + $(CODING_H) \ + $(CONFIG_H) \ + $(LISP_H) \ + $(W32TERM_H) $(BLD)/w32reg.$(O) : \ $(SRC)/w32reg.c \ + $(BLOCKINPUT_H) \ $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ - $(SRC)/systime.h \ - $(SRC)/w32gui.h \ - $(SRC)/w32term.h + $(W32TERM_H) $(BLD)/w32xfns.$(O) : \ $(SRC)/w32xfns.c \ + $(SRC)/fontset.h \ + $(BLOCKINPUT_H) \ + $(CHARSET_H) \ $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ + $(FRAME_H) \ + $(KEYBOARD_H) \ $(LISP_H) \ - $(SRC)/atimer.h \ - $(SRC)/blockinput.h \ - $(SRC)/charset.h \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/fontset.h \ - $(SRC)/frame.h \ - $(SRC)/keyboard.h \ - $(SRC)/systime.h \ - $(SRC)/w32gui.h \ - $(SRC)/w32term.h + $(W32TERM_H) $(BLD)/w32font.$(O) : \ $(SRC)/w32font.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(SRC)/ccl.h \ - $(SRC)/character.h \ - $(SRC)/charset.h \ - $(SRC)/coding.h \ - $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/font.h \ $(SRC)/fontset.h \ - $(SRC)/frame.h \ - $(SRC)/systime.h \ $(SRC)/w32font.h \ - $(SRC)/w32gui.h \ - $(SRC)/w32term.h + $(CHARACTER_H) \ + $(CHARSET_H) \ + $(CODING_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(FONT_H) \ + $(FRAME_H) \ + $(LISP_H) \ + $(W32TERM_H) $(BLD)/w32uniscribe.$(O) : \ $(SRC)/w32uniscribe.c \ - $(CONFIG_H) \ - $(EMACS_ROOT)/nt/inc/sys/time.h \ - $(LISP_H) \ - $(SRC)/ccl.h \ - $(SRC)/character.h \ - $(SRC)/charset.h \ $(SRC)/composite.h \ - $(SRC)/dispextern.h \ - $(SRC)/font.h \ $(SRC)/fontset.h \ - $(SRC)/frame.h \ - $(SRC)/systime.h \ $(SRC)/w32font.h \ - $(SRC)/w32gui.h \ - $(SRC)/w32term.h + $(CHARACTER_H) \ + $(CHARSET_H) \ + $(CONFIG_H) \ + $(DISPEXTERN_H) \ + $(FONT_H) \ + $(FRAME_H) \ + $(LISP_H) \ + $(W32TERM_H) # Each object file depends on stamp_BLD, because in parallel builds we must # make sure $(BLD) exists before starting compilations. diff --git a/src/minibuf.c b/src/minibuf.c index ca2f22df9ed..cf37c337be4 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -25,7 +25,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "lisp.h" #include "commands.h" #include "buffer.h" -#include "character.h" #include "dispextern.h" #include "keyboard.h" #include "frame.h" @@ -72,7 +71,6 @@ Lisp_Object Qcompletion_ignore_case; 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; @@ -237,7 +235,7 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial, Lisp_Object defalt, int allow_props, int inherit_input_method) { - size_t size, len; + ptrdiff_t size, len; char *line, *s; Lisp_Object val; @@ -247,12 +245,12 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial, 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); @@ -260,11 +258,9 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial, 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); } @@ -1694,7 +1690,7 @@ See also `completing-read-function'. */) (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 +1701,6 @@ See also `completing-read-function'. */) 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 +1939,6 @@ syms_of_minibuf (void) 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 +2057,6 @@ If the value is `confirm-after-completion', the user may exit with an 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 +2133,4 @@ properties. */); defsubr (&Stest_completion); defsubr (&Sassoc_string); defsubr (&Scompleting_read); - defsubr (&Scompleting_read_default); } diff --git a/src/msdos.c b/src/msdos.c index 73804df55cc..3f12bc85cbe 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -4267,8 +4267,7 @@ syms_of_msdos (void) #ifndef HAVE_X_WINDOWS /* The following two are from xfns.c: */ - Qreverse = intern_c_string ("reverse"); - staticpro (&Qreverse); + DEFSYM (Qreverse, "reverse"); DEFVAR_LISP ("dos-unsupported-char-glyph", Vdos_unsupported_char_glyph, doc: /* *Glyph to display instead of chars not supported by current codepage. diff --git a/src/print.c b/src/print.c index d07f89702cc..14b4326bb6f 100644 --- a/src/print.c +++ b/src/print.c @@ -159,8 +159,9 @@ int print_output_debug_flag EXTERNALLY_VISIBLE = 1; } \ 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 @@ printchar (unsigned int ch, Lisp_Object fun) 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 @@ strout (const char *ptr, EMACS_INT size, EMACS_INT size_byte, 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; @@ -2059,8 +2069,7 @@ print_interval (INTERVAL interval, Lisp_Object printcharfun) void syms_of_print (void) { - Qtemp_buffer_setup_hook = intern_c_string ("temp-buffer-setup-hook"); - staticpro (&Qtemp_buffer_setup_hook); + DEFSYM (Qtemp_buffer_setup_hook, "temp-buffer-setup-hook"); DEFVAR_LISP ("standard-output", Vstandard_output, doc: /* Output stream `print' uses by default for outputting a character. @@ -2069,8 +2078,7 @@ It may also be a buffer (output is inserted before point) or a marker (output is inserted and the marker is advanced) or the symbol t (output appears in the echo area). */); Vstandard_output = Qt; - Qstandard_output = intern_c_string ("standard-output"); - staticpro (&Qstandard_output); + DEFSYM (Qstandard_output, "standard-output"); DEFVAR_LISP ("float-output-format", Vfloat_output_format, doc: /* The format descriptor string used to print floats. @@ -2089,8 +2097,7 @@ decimal point. 0 is not allowed with `e' or `g'. A value of nil means to use the shortest notation that represents the number without losing information. */); Vfloat_output_format = Qnil; - Qfloat_output_format = intern_c_string ("float-output-format"); - staticpro (&Qfloat_output_format); + DEFSYM (Qfloat_output_format, "float-output-format"); DEFVAR_LISP ("print-length", Vprint_length, doc: /* Maximum length of list to print before abbreviating. @@ -2195,17 +2202,10 @@ priorities. */); defsubr (&Sredirect_debugging_output); #endif - Qexternal_debugging_output = intern_c_string ("external-debugging-output"); - staticpro (&Qexternal_debugging_output); - - Qprint_escape_newlines = intern_c_string ("print-escape-newlines"); - staticpro (&Qprint_escape_newlines); - - Qprint_escape_multibyte = intern_c_string ("print-escape-multibyte"); - staticpro (&Qprint_escape_multibyte); - - Qprint_escape_nonascii = intern_c_string ("print-escape-nonascii"); - staticpro (&Qprint_escape_nonascii); + DEFSYM (Qexternal_debugging_output, "external-debugging-output"); + DEFSYM (Qprint_escape_newlines, "print-escape-newlines"); + DEFSYM (Qprint_escape_multibyte, "print-escape-multibyte"); + DEFSYM (Qprint_escape_nonascii, "print-escape-nonascii"); print_prune_charset_plist = Qnil; staticpro (&print_prune_charset_plist); diff --git a/src/process.c b/src/process.c index 0040d14a0f6..6bd168d8840 100644 --- a/src/process.c +++ b/src/process.c @@ -102,9 +102,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "gnutls.h" #endif -#if defined (USE_GTK) || defined (HAVE_GCONF) +#if defined (USE_GTK) || defined (HAVE_GCONF) || defined (HAVE_GSETTINGS) #include "xgselect.h" -#endif /* defined (USE_GTK) || defined (HAVE_GCONF) */ +#endif #ifdef HAVE_NS #include "nsterm.h" #endif @@ -4479,13 +4479,19 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd, set_waiting_for_input (&timeout); } + /* Skip the `select' call if input is available and we're + waiting for keyboard input or a cell change (which can be + triggered by processing X events). In the latter case, set + nfds to 1 to avoid breaking the loop. */ no_avail = 0; - if (read_kbd && detect_input_pending ()) + if ((read_kbd || !NILP (wait_for_cell)) + && detect_input_pending ()) { - nfds = 0; + nfds = read_kbd ? 0 : 1; no_avail = 1; } - else + + if (!no_avail) { #ifdef ADAPTIVE_READ_BUFFERING @@ -4521,7 +4527,7 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd, process_output_skip = 0; } #endif -#if defined (USE_GTK) || defined (HAVE_GCONF) +#if defined (USE_GTK) || defined (HAVE_GCONF) || defined (HAVE_GSETTINGS) nfds = xg_select #elif defined (HAVE_NS) nfds = ns_select @@ -7236,14 +7242,10 @@ syms_of_process (void) { #ifdef subprocesses - Qprocessp = intern_c_string ("processp"); - staticpro (&Qprocessp); - Qrun = intern_c_string ("run"); - staticpro (&Qrun); - Qstop = intern_c_string ("stop"); - staticpro (&Qstop); - Qsignal = intern_c_string ("signal"); - staticpro (&Qsignal); + DEFSYM (Qprocessp, "processp"); + DEFSYM (Qrun, "run"); + DEFSYM (Qstop, "stop"); + DEFSYM (Qsignal, "signal"); /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it here again. @@ -7251,92 +7253,52 @@ syms_of_process (void) Qexit = intern_c_string ("exit"); staticpro (&Qexit); */ - Qopen = intern_c_string ("open"); - staticpro (&Qopen); - Qclosed = intern_c_string ("closed"); - staticpro (&Qclosed); - Qconnect = intern_c_string ("connect"); - staticpro (&Qconnect); - Qfailed = intern_c_string ("failed"); - staticpro (&Qfailed); - Qlisten = intern_c_string ("listen"); - staticpro (&Qlisten); - Qlocal = intern_c_string ("local"); - staticpro (&Qlocal); - Qipv4 = intern_c_string ("ipv4"); - staticpro (&Qipv4); + DEFSYM (Qopen, "open"); + DEFSYM (Qclosed, "closed"); + DEFSYM (Qconnect, "connect"); + DEFSYM (Qfailed, "failed"); + DEFSYM (Qlisten, "listen"); + DEFSYM (Qlocal, "local"); + DEFSYM (Qipv4, "ipv4"); #ifdef AF_INET6 - Qipv6 = intern_c_string ("ipv6"); - staticpro (&Qipv6); -#endif - Qdatagram = intern_c_string ("datagram"); - staticpro (&Qdatagram); - Qseqpacket = intern_c_string ("seqpacket"); - staticpro (&Qseqpacket); - - QCport = intern_c_string (":port"); - staticpro (&QCport); - QCspeed = intern_c_string (":speed"); - staticpro (&QCspeed); - QCprocess = intern_c_string (":process"); - staticpro (&QCprocess); - - QCbytesize = intern_c_string (":bytesize"); - staticpro (&QCbytesize); - QCstopbits = intern_c_string (":stopbits"); - staticpro (&QCstopbits); - QCparity = intern_c_string (":parity"); - staticpro (&QCparity); - Qodd = intern_c_string ("odd"); - staticpro (&Qodd); - Qeven = intern_c_string ("even"); - staticpro (&Qeven); - QCflowcontrol = intern_c_string (":flowcontrol"); - staticpro (&QCflowcontrol); - Qhw = intern_c_string ("hw"); - staticpro (&Qhw); - Qsw = intern_c_string ("sw"); - staticpro (&Qsw); - QCsummary = intern_c_string (":summary"); - staticpro (&QCsummary); - - Qreal = intern_c_string ("real"); - staticpro (&Qreal); - Qnetwork = intern_c_string ("network"); - staticpro (&Qnetwork); - Qserial = intern_c_string ("serial"); - staticpro (&Qserial); - QCbuffer = intern_c_string (":buffer"); - staticpro (&QCbuffer); - QChost = intern_c_string (":host"); - staticpro (&QChost); - QCservice = intern_c_string (":service"); - staticpro (&QCservice); - QClocal = intern_c_string (":local"); - staticpro (&QClocal); - QCremote = intern_c_string (":remote"); - staticpro (&QCremote); - QCcoding = intern_c_string (":coding"); - staticpro (&QCcoding); - QCserver = intern_c_string (":server"); - staticpro (&QCserver); - QCnowait = intern_c_string (":nowait"); - staticpro (&QCnowait); - QCsentinel = intern_c_string (":sentinel"); - staticpro (&QCsentinel); - QClog = intern_c_string (":log"); - staticpro (&QClog); - QCnoquery = intern_c_string (":noquery"); - staticpro (&QCnoquery); - QCstop = intern_c_string (":stop"); - staticpro (&QCstop); - QCoptions = intern_c_string (":options"); - staticpro (&QCoptions); - QCplist = intern_c_string (":plist"); - staticpro (&QCplist); - - Qlast_nonmenu_event = intern_c_string ("last-nonmenu-event"); - staticpro (&Qlast_nonmenu_event); + DEFSYM (Qipv6, "ipv6"); +#endif + DEFSYM (Qdatagram, "datagram"); + DEFSYM (Qseqpacket, "seqpacket"); + + DEFSYM (QCport, ":port"); + DEFSYM (QCspeed, ":speed"); + DEFSYM (QCprocess, ":process"); + + DEFSYM (QCbytesize, ":bytesize"); + DEFSYM (QCstopbits, ":stopbits"); + DEFSYM (QCparity, ":parity"); + DEFSYM (Qodd, "odd"); + DEFSYM (Qeven, "even"); + DEFSYM (QCflowcontrol, ":flowcontrol"); + DEFSYM (Qhw, "hw"); + DEFSYM (Qsw, "sw"); + DEFSYM (QCsummary, ":summary"); + + DEFSYM (Qreal, "real"); + DEFSYM (Qnetwork, "network"); + DEFSYM (Qserial, "serial"); + DEFSYM (QCbuffer, ":buffer"); + DEFSYM (QChost, ":host"); + DEFSYM (QCservice, ":service"); + DEFSYM (QClocal, ":local"); + DEFSYM (QCremote, ":remote"); + DEFSYM (QCcoding, ":coding"); + DEFSYM (QCserver, ":server"); + DEFSYM (QCnowait, ":nowait"); + DEFSYM (QCsentinel, ":sentinel"); + DEFSYM (QClog, ":log"); + DEFSYM (QCnoquery, ":noquery"); + DEFSYM (QCstop, ":stop"); + DEFSYM (QCoptions, ":options"); + DEFSYM (QCplist, ":plist"); + + DEFSYM (Qlast_nonmenu_event, "last-nonmenu-event"); staticpro (&Vprocess_alist); #ifdef SIGCHLD @@ -7345,73 +7307,40 @@ syms_of_process (void) #endif /* subprocesses */ - QCname = intern_c_string (":name"); - staticpro (&QCname); - QCtype = intern_c_string (":type"); - staticpro (&QCtype); - - Qeuid = intern_c_string ("euid"); - staticpro (&Qeuid); - Qegid = intern_c_string ("egid"); - staticpro (&Qegid); - Quser = intern_c_string ("user"); - staticpro (&Quser); - Qgroup = intern_c_string ("group"); - staticpro (&Qgroup); - Qcomm = intern_c_string ("comm"); - staticpro (&Qcomm); - Qstate = intern_c_string ("state"); - staticpro (&Qstate); - Qppid = intern_c_string ("ppid"); - staticpro (&Qppid); - Qpgrp = intern_c_string ("pgrp"); - staticpro (&Qpgrp); - Qsess = intern_c_string ("sess"); - staticpro (&Qsess); - Qttname = intern_c_string ("ttname"); - staticpro (&Qttname); - Qtpgid = intern_c_string ("tpgid"); - staticpro (&Qtpgid); - Qminflt = intern_c_string ("minflt"); - staticpro (&Qminflt); - Qmajflt = intern_c_string ("majflt"); - staticpro (&Qmajflt); - Qcminflt = intern_c_string ("cminflt"); - staticpro (&Qcminflt); - Qcmajflt = intern_c_string ("cmajflt"); - staticpro (&Qcmajflt); - Qutime = intern_c_string ("utime"); - staticpro (&Qutime); - Qstime = intern_c_string ("stime"); - staticpro (&Qstime); - Qtime = intern_c_string ("time"); - staticpro (&Qtime); - Qcutime = intern_c_string ("cutime"); - staticpro (&Qcutime); - Qcstime = intern_c_string ("cstime"); - staticpro (&Qcstime); - Qctime = intern_c_string ("ctime"); - staticpro (&Qctime); - Qpri = intern_c_string ("pri"); - staticpro (&Qpri); - Qnice = intern_c_string ("nice"); - staticpro (&Qnice); - Qthcount = intern_c_string ("thcount"); - staticpro (&Qthcount); - Qstart = intern_c_string ("start"); - staticpro (&Qstart); - Qvsize = intern_c_string ("vsize"); - staticpro (&Qvsize); - Qrss = intern_c_string ("rss"); - staticpro (&Qrss); - Qetime = intern_c_string ("etime"); - staticpro (&Qetime); - Qpcpu = intern_c_string ("pcpu"); - staticpro (&Qpcpu); - Qpmem = intern_c_string ("pmem"); - staticpro (&Qpmem); - Qargs = intern_c_string ("args"); - staticpro (&Qargs); + DEFSYM (QCname, ":name"); + DEFSYM (QCtype, ":type"); + + DEFSYM (Qeuid, "euid"); + DEFSYM (Qegid, "egid"); + DEFSYM (Quser, "user"); + DEFSYM (Qgroup, "group"); + DEFSYM (Qcomm, "comm"); + DEFSYM (Qstate, "state"); + DEFSYM (Qppid, "ppid"); + DEFSYM (Qpgrp, "pgrp"); + DEFSYM (Qsess, "sess"); + DEFSYM (Qttname, "ttname"); + DEFSYM (Qtpgid, "tpgid"); + DEFSYM (Qminflt, "minflt"); + DEFSYM (Qmajflt, "majflt"); + DEFSYM (Qcminflt, "cminflt"); + DEFSYM (Qcmajflt, "cmajflt"); + DEFSYM (Qutime, "utime"); + DEFSYM (Qstime, "stime"); + DEFSYM (Qtime, "time"); + DEFSYM (Qcutime, "cutime"); + DEFSYM (Qcstime, "cstime"); + DEFSYM (Qctime, "ctime"); + DEFSYM (Qpri, "pri"); + DEFSYM (Qnice, "nice"); + DEFSYM (Qthcount, "thcount"); + DEFSYM (Qstart, "start"); + DEFSYM (Qvsize, "vsize"); + DEFSYM (Qrss, "rss"); + DEFSYM (Qetime, "etime"); + DEFSYM (Qpcpu, "pcpu"); + DEFSYM (Qpmem, "pmem"); + DEFSYM (Qargs, "args"); DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes, doc: /* *Non-nil means delete processes immediately when they exit. diff --git a/src/search.c b/src/search.c index 6c835f2cc64..d29a51c695b 100644 --- a/src/search.c +++ b/src/search.c @@ -3181,10 +3181,8 @@ syms_of_search (void) } searchbuf_head = &searchbufs[0]; - Qsearch_failed = intern_c_string ("search-failed"); - staticpro (&Qsearch_failed); - Qinvalid_regexp = intern_c_string ("invalid-regexp"); - staticpro (&Qinvalid_regexp); + DEFSYM (Qsearch_failed, "search-failed"); + DEFSYM (Qinvalid_regexp, "invalid-regexp"); Fput (Qsearch_failed, Qerror_conditions, pure_cons (Qsearch_failed, pure_cons (Qerror, Qnil))); diff --git a/src/sound.c b/src/sound.c index 0e71e66352e..07c7dab0ada 100644 --- a/src/sound.c +++ b/src/sound.c @@ -1477,14 +1477,10 @@ Internal use only, use `play-sound' instead. */) void syms_of_sound (void) { - QCdevice = intern_c_string(":device"); - staticpro (&QCdevice); - QCvolume = intern_c_string (":volume"); - staticpro (&QCvolume); - Qsound = intern_c_string ("sound"); - staticpro (&Qsound); - Qplay_sound_functions = intern_c_string ("play-sound-functions"); - staticpro (&Qplay_sound_functions); + DEFSYM (QCdevice, ":device"); + DEFSYM (QCvolume, ":volume"); + DEFSYM (Qsound, "sound"); + DEFSYM (Qplay_sound_functions, "play-sound-functions"); defsubr (&Splay_sound_internal); } diff --git a/src/syntax.c b/src/syntax.c index 82103cfa3d4..8c2d5ded21f 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -3362,8 +3362,7 @@ init_syntax_once (void) Lisp_Object temp; /* This has to be done here, before we call Fmake_char_table. */ - Qsyntax_table = intern_c_string ("syntax-table"); - staticpro (&Qsyntax_table); + DEFSYM (Qsyntax_table, "syntax-table"); /* Intern_C_String this now in case it isn't already done. Setting this variable twice is harmless. @@ -3448,8 +3447,7 @@ init_syntax_once (void) void syms_of_syntax (void) { - Qsyntax_table_p = intern_c_string ("syntax-table-p"); - staticpro (&Qsyntax_table_p); + DEFSYM (Qsyntax_table_p, "syntax-table-p"); staticpro (&Vsyntax_code_object); @@ -3461,8 +3459,7 @@ syms_of_syntax (void) /* Defined in regex.c */ staticpro (&re_match_object); - Qscan_error = intern_c_string ("scan-error"); - staticpro (&Qscan_error); + DEFSYM (Qscan_error, "scan-error"); Fput (Qscan_error, Qerror_conditions, pure_cons (Qscan_error, pure_cons (Qerror, Qnil))); Fput (Qscan_error, Qerror_message, diff --git a/src/sysdep.c b/src/sysdep.c index 5ad3389dd8f..8b6939b91fe 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -1783,7 +1783,8 @@ seed_random (long int arg) } /* - * Build a full Emacs-sized word out of whatever we've got. + * Return a nonnegative random integer out of whatever we've got. + * It contains enough bits to make a random (signed) Emacs fixnum. * This suffices even for a 64-bit architecture with a 15-bit rand. */ EMACS_INT @@ -1791,9 +1792,11 @@ get_random (void) { EMACS_UINT val = 0; int i; - for (i = 0; i < (VALBITS + RAND_BITS - 1) / RAND_BITS; i++) - val = (val << RAND_BITS) ^ random (); - return val & (((EMACS_INT) 1 << VALBITS) - 1); + for (i = 0; i < (FIXNUM_BITS + RAND_BITS - 1) / RAND_BITS; i++) + val = (random () ^ (val << RAND_BITS) + ^ (val >> (BITS_PER_EMACS_INT - RAND_BITS))); + val ^= val >> (BITS_PER_EMACS_INT - FIXNUM_BITS); + return val & INTMASK; } #ifndef HAVE_STRERROR @@ -2012,37 +2015,6 @@ perror (void) } #endif /* HPUX and not HAVE_PERROR */ -#ifndef HAVE_DUP2 - -/* - * Emulate BSD dup2. First close newd if it already exists. - * Then, attempt to dup oldd. If not successful, call dup2 recursively - * until we are, then close the unsuccessful ones. - */ - -int -dup2 (int oldd, int newd) -{ - register int fd, ret; - - emacs_close (newd); - -#ifdef F_DUPFD - return fcntl (oldd, F_DUPFD, newd); -#else - fd = dup (old); - if (fd == -1) - return -1; - if (fd == new) - return new; - ret = dup2 (old,new); - emacs_close (fd); - return ret; -#endif -} - -#endif /* not HAVE_DUP2 */ - /* * Gettimeofday. Simulate as much as possible. Only accurate * to nearest second. Emacs doesn't use tzp so ignore it for now. diff --git a/src/terminal.c b/src/terminal.c index c135c0f93ef..67577adf3b4 100644 --- a/src/terminal.c +++ b/src/terminal.c @@ -555,10 +555,8 @@ Each function is called with argument, the terminal. This may be called just before actually deleting the terminal, or some time later. */); Vdelete_terminal_functions = Qnil; - Qdelete_terminal_functions = intern_c_string ("delete-terminal-functions"); - staticpro (&Qdelete_terminal_functions); - Qrun_hook_with_args = intern_c_string ("run-hook-with-args"); - staticpro (&Qrun_hook_with_args); + DEFSYM (Qdelete_terminal_functions, "delete-terminal-functions"); + DEFSYM (Qrun_hook_with_args, "run-hook-with-args"); defsubr (&Sdelete_terminal); defsubr (&Sframe_terminal); diff --git a/src/textprop.c b/src/textprop.c index dd8695f7af8..29425f7a550 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -1707,10 +1707,14 @@ text_property_stickiness (Lisp_Object prop, Lisp_Object pos, Lisp_Object buffer) { Lisp_Object prev_pos, front_sticky; int is_rear_sticky = 1, is_front_sticky = 0; /* defaults */ + Lisp_Object defalt = Fassq (prop, Vtext_property_default_nonsticky); if (NILP (buffer)) XSETBUFFER (buffer, current_buffer); + if (CONSP (defalt) && !NILP (XCDR (defalt))) + is_rear_sticky = 0; + if (XINT (pos) > BUF_BEGV (XBUFFER (buffer))) /* Consider previous character. */ { @@ -2230,9 +2234,11 @@ If a character in a buffer has PROPERTY, new text inserted adjacent to the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil, inherits it if NONSTICKINESS is nil. The `front-sticky' and `rear-nonsticky' properties of the character override NONSTICKINESS. */); - /* Text property `syntax-table' should be nonsticky by default. */ + /* Text properties `syntax-table'and `display' should be nonsticky + by default. */ Vtext_property_default_nonsticky - = Fcons (Fcons (intern_c_string ("syntax-table"), Qt), Qnil); + = Fcons (Fcons (intern_c_string ("syntax-table"), Qt), + Fcons (Fcons (intern_c_string ("display"), Qt), Qnil)); staticpro (&interval_insert_behind_hooks); staticpro (&interval_insert_in_front_hooks); @@ -2242,45 +2248,27 @@ inherits it if NONSTICKINESS is nil. The `front-sticky' and /* Common attributes one might give text */ - staticpro (&Qforeground); - Qforeground = intern_c_string ("foreground"); - staticpro (&Qbackground); - Qbackground = intern_c_string ("background"); - staticpro (&Qfont); - Qfont = intern_c_string ("font"); - staticpro (&Qstipple); - Qstipple = intern_c_string ("stipple"); - staticpro (&Qunderline); - Qunderline = intern_c_string ("underline"); - staticpro (&Qread_only); - Qread_only = intern_c_string ("read-only"); - staticpro (&Qinvisible); - Qinvisible = intern_c_string ("invisible"); - staticpro (&Qintangible); - Qintangible = intern_c_string ("intangible"); - staticpro (&Qcategory); - Qcategory = intern_c_string ("category"); - staticpro (&Qlocal_map); - Qlocal_map = intern_c_string ("local-map"); - staticpro (&Qfront_sticky); - Qfront_sticky = intern_c_string ("front-sticky"); - staticpro (&Qrear_nonsticky); - Qrear_nonsticky = intern_c_string ("rear-nonsticky"); - staticpro (&Qmouse_face); - Qmouse_face = intern_c_string ("mouse-face"); - staticpro (&Qminibuffer_prompt); - Qminibuffer_prompt = intern_c_string ("minibuffer-prompt"); + DEFSYM (Qforeground, "foreground"); + DEFSYM (Qbackground, "background"); + DEFSYM (Qfont, "font"); + DEFSYM (Qstipple, "stipple"); + DEFSYM (Qunderline, "underline"); + DEFSYM (Qread_only, "read-only"); + DEFSYM (Qinvisible, "invisible"); + DEFSYM (Qintangible, "intangible"); + DEFSYM (Qcategory, "category"); + DEFSYM (Qlocal_map, "local-map"); + DEFSYM (Qfront_sticky, "front-sticky"); + DEFSYM (Qrear_nonsticky, "rear-nonsticky"); + DEFSYM (Qmouse_face, "mouse-face"); + DEFSYM (Qminibuffer_prompt, "minibuffer-prompt"); /* Properties that text might use to specify certain actions */ - staticpro (&Qmouse_left); - Qmouse_left = intern_c_string ("mouse-left"); - staticpro (&Qmouse_entered); - Qmouse_entered = intern_c_string ("mouse-entered"); - staticpro (&Qpoint_left); - Qpoint_left = intern_c_string ("point-left"); - staticpro (&Qpoint_entered); - Qpoint_entered = intern_c_string ("point-entered"); + DEFSYM (Qmouse_left, "mouse-left"); + DEFSYM (Qmouse_entered, "mouse-entered"); + DEFSYM (Qpoint_left, "point-left"); + DEFSYM (Qpoint_entered, "point-entered"); defsubr (&Stext_properties_at); defsubr (&Sget_text_property); diff --git a/src/undo.c b/src/undo.c index e7e9ae5632e..7e121e8b27d 100644 --- a/src/undo.c +++ b/src/undo.c @@ -637,11 +637,8 @@ Return what remains of the list. */) void syms_of_undo (void) { - Qinhibit_read_only = intern_c_string ("inhibit-read-only"); - staticpro (&Qinhibit_read_only); - - Qapply = intern_c_string ("apply"); - staticpro (&Qapply); + DEFSYM (Qinhibit_read_only, "inhibit-read-only"); + DEFSYM (Qapply, "apply"); pending_boundary = Qnil; staticpro (&pending_boundary); diff --git a/src/w32.c b/src/w32.c index d81fdf3305d..53bf2e811e2 100644 --- a/src/w32.c +++ b/src/w32.c @@ -5960,8 +5960,7 @@ globals_of_w32 (void) get_process_times_fn = (GetProcessTimes_Proc) GetProcAddress (kernel32, "GetProcessTimes"); - QCloaded_from = intern_c_string (":loaded-from"); - staticpro (&QCloaded_from); + DEFSYM (QCloaded_from, ":loaded-from"); Vlibrary_cache = Qnil; staticpro (&Vlibrary_cache); diff --git a/src/w32fns.c b/src/w32fns.c index e4b11b70441..cba0b91e685 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -6805,10 +6805,6 @@ syms_of_w32fns (void) DEFSYM (Qfont_param, "font-parameter"); /* This is the end of symbol initialization. */ - /* Text property `display' should be nonsticky by default. */ - Vtext_property_default_nonsticky - = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky); - Fput (Qundefined_color, Qerror_conditions, pure_cons (Qundefined_color, pure_cons (Qerror, Qnil))); diff --git a/src/w32menu.c b/src/w32menu.c index e2f6de7f0c8..c31a8c1fd96 100644 --- a/src/w32menu.c +++ b/src/w32menu.c @@ -33,7 +33,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "blockinput.h" #include "buffer.h" #include "charset.h" -#include "character.h" #include "coding.h" #include "menu.h" diff --git a/src/w32proc.c b/src/w32proc.c index e94d9aa3254..47cbf57d9ea 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -51,7 +51,6 @@ extern BOOL WINAPI IsValidLocale (LCID, DWORD); #endif #include "lisp.h" -#include "character.h" #include "w32.h" #include "w32heap.h" #include "systime.h" diff --git a/src/w32select.c b/src/w32select.c index ef0cb3adc24..e3225c3f996 100644 --- a/src/w32select.c +++ b/src/w32select.c @@ -80,7 +80,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "blockinput.h" #include "charset.h" #include "coding.h" -#include "character.h" #include "composite.h" diff --git a/src/window.c b/src/window.c index 65df9f26e64..154efe4a222 100644 --- a/src/window.c +++ b/src/window.c @@ -54,7 +54,7 @@ Lisp_Object Qwindowp, Qwindow_live_p; static Lisp_Object Qwindow_configuration_p, Qrecord_window_buffer; static Lisp_Object Qwindow_deletable_p, Qdelete_window, Qdisplay_buffer; static Lisp_Object Qreplace_buffer_in_windows, Qget_mru_window; -static Lisp_Object Qresize_root_window, Qresize_root_window_vertically; +static Lisp_Object Qwindow_resize_root_window, Qwindow_resize_root_window_vertically; static Lisp_Object Qscroll_up, Qscroll_down, Qscroll_command; static Lisp_Object Qsafe, Qabove, Qbelow; static Lisp_Object Qauto_buffer_name; @@ -82,8 +82,8 @@ static int foreach_window_1 (struct window *, int (* fn) (struct window *, void *), void *); static Lisp_Object window_list_1 (Lisp_Object, Lisp_Object, Lisp_Object); -static int resize_window_check (struct window *, int); -static void resize_window_apply (struct window *, int); +static int window_resize_check (struct window *, int); +static void window_resize_apply (struct window *, int); static Lisp_Object select_window (Lisp_Object, Lisp_Object, int); /* This is the window in which the terminal's cursor should @@ -408,14 +408,6 @@ buffer of the selected window before each command. */) return select_window (window, norecord, 0); } -DEFUN ("window-clone-number", Fwindow_clone_number, Swindow_clone_number, 0, 1, 0, - doc: /* Return WINDOW's clone number. -WINDOW can be any window and defaults to the selected one. */) - (Lisp_Object window) -{ - return decode_any_window (window)->clone_number; -} - DEFUN ("window-buffer", Fwindow_buffer, Swindow_buffer, 0, 1, 0, doc: /* Return the buffer that WINDOW is displaying. WINDOW can be any window and defaults to the selected one. @@ -434,37 +426,37 @@ Return nil if WINDOW has no parent. */) return decode_any_window (window)->parent; } -DEFUN ("window-vchild", Fwindow_vchild, Swindow_vchild, 0, 1, 0, - doc: /* Return WINDOW's first vertical child window. +DEFUN ("window-top-child", Fwindow_top_child, Swindow_top_child, 0, 1, 0, + doc: /* Return WINDOW's topmost child window. WINDOW can be any window and defaults to the selected one. -Return nil if WINDOW has no vertical child. */) +Return nil if WINDOW is not a vertical combination. */) (Lisp_Object window) { return decode_any_window (window)->vchild; } -DEFUN ("window-hchild", Fwindow_hchild, Swindow_hchild, 0, 1, 0, - doc: /* Return WINDOW's first horizontal child window. +DEFUN ("window-left-child", Fwindow_left_child, Swindow_left_child, 0, 1, 0, + doc: /* Return WINDOW's leftmost child window. WINDOW can be any window and defaults to the selected one. -Return nil if WINDOW has no horizontal child. */) +Return nil if WINDOW is not a horizontal combination. */) (Lisp_Object window) { return decode_any_window (window)->hchild; } -DEFUN ("window-next", Fwindow_next, Swindow_next, 0, 1, 0, - doc: /* Return WINDOW's right sibling window. +DEFUN ("window-next-sibling", Fwindow_next_sibling, Swindow_next_sibling, 0, 1, 0, + doc: /* Return WINDOW's next sibling window. WINDOW can be any window and defaults to the selected one. -Return nil if WINDOW has no right sibling. */) +Return nil if WINDOW has no next sibling. */) (Lisp_Object window) { return decode_any_window (window)->next; } -DEFUN ("window-prev", Fwindow_prev, Swindow_prev, 0, 1, 0, - doc: /* Return WINDOW's left sibling window. +DEFUN ("window-prev-sibling", Fwindow_prev_sibling, Swindow_prev_sibling, 0, 1, 0, + doc: /* Return WINDOW's previous sibling window. WINDOW can be any window and defaults to the selected one. -Return nil if WINDOW has no left sibling. */) +Return nil if WINDOW has no previous sibling. */) (Lisp_Object window) { return decode_any_window (window)->prev; @@ -2576,7 +2568,7 @@ selected frame and no others. */) static Lisp_Object resize_root_window (Lisp_Object window, Lisp_Object delta, Lisp_Object horizontal, Lisp_Object ignore) { - return call4 (Qresize_root_window, window, delta, horizontal, ignore); + return call4 (Qwindow_resize_root_window, window, delta, horizontal, ignore); } @@ -2695,13 +2687,13 @@ window-start value is reasonable when this function is called. */) XSETINT (delta, XINT (r->total_lines) - XINT (w->total_lines)); w->top_line = r->top_line; resize_root_window (window, delta, Qnil, Qnil); - if (resize_window_check (w, 0)) - resize_window_apply (w, 0); + if (window_resize_check (w, 0)) + window_resize_apply (w, 0); else { resize_root_window (window, delta, Qnil, Qt); - if (resize_window_check (w, 0)) - resize_window_apply (w, 0); + if (window_resize_check (w, 0)) + window_resize_apply (w, 0); else resize_failed = 1; } @@ -2713,13 +2705,13 @@ window-start value is reasonable when this function is called. */) XSETINT (delta, XINT (r->total_cols) - XINT (w->total_cols)); w->left_col = r->left_col; resize_root_window (window, delta, Qt, Qnil); - if (resize_window_check (w, 1)) - resize_window_apply (w, 1); + if (window_resize_check (w, 1)) + window_resize_apply (w, 1); else { resize_root_window (window, delta, Qt, Qt); - if (resize_window_check (w, 1)) - resize_window_apply (w, 1); + if (window_resize_check (w, 1)) + window_resize_apply (w, 1); else resize_failed = 1; } @@ -3087,18 +3079,6 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, int run_hooks_p, int unbind_to (count, Qnil); } -DEFUN ("set-window-clone-number", Fset_window_clone_number, Sset_window_clone_number, 2, 2, 0, - doc: /* Set WINDOW's clone number to CLONE-NUMBER. -WINDOW can be any window and defaults to the selected one. */) - (Lisp_Object window, Lisp_Object clone_number) -{ - register struct window *w = decode_any_window (window); - - CHECK_NUMBER (clone_number); - w->clone_number = clone_number; - return w->clone_number; -} - DEFUN ("set-window-buffer", Fset_window_buffer, Sset_window_buffer, 2, 3, 0, doc: /* Make WINDOW display BUFFER-OR-NAME as its contents. WINDOW has to be a live window and defaults to the selected one. @@ -3289,7 +3269,6 @@ make_parent_window (Lisp_Object window, int horflag) ++sequence_number; XSETFASTINT (p->sequence_number, sequence_number); - XSETFASTINT (p->clone_number, sequence_number); replace_window (window, parent, 1); @@ -3335,7 +3314,6 @@ make_window (void) XSETFASTINT (w->use_time, 0); ++sequence_number; XSETFASTINT (w->sequence_number, sequence_number); - XSETFASTINT (w->clone_number, sequence_number); w->temslot = w->last_modified = w->last_overlay_modified = Qnil; XSETFASTINT (w->last_point, 0); w->last_had_star = w->vertical_scroll_bar = Qnil; @@ -3415,7 +3393,7 @@ Note: This function does not operate on any subwindows of WINDOW. */) `window-min-height' or `window-min-width'. It does check that window sizes do not drop below one line (two columns). */ static int -resize_window_check (struct window *w, int horflag) +window_resize_check (struct window *w, int horflag) { struct window *c; @@ -3429,7 +3407,7 @@ resize_window_check (struct window *w, int horflag) while (c) { if ((XINT (c->new_total) != XINT (w->new_total)) - || !resize_window_check (c, horflag)) + || !window_resize_check (c, horflag)) return 0; c = NILP (c->next) ? 0 : XWINDOW (c->next); } @@ -3442,7 +3420,7 @@ resize_window_check (struct window *w, int horflag) int sum_of_sizes = 0; while (c) { - if (!resize_window_check (c, horflag)) + if (!window_resize_check (c, horflag)) return 0; sum_of_sizes = sum_of_sizes + XINT (c->new_total); c = NILP (c->next) ? 0 : XWINDOW (c->next); @@ -3461,7 +3439,7 @@ resize_window_check (struct window *w, int horflag) int sum_of_sizes = 0; while (c) { - if (!resize_window_check (c, horflag)) + if (!window_resize_check (c, horflag)) return 0; sum_of_sizes = sum_of_sizes + XINT (c->new_total); c = NILP (c->next) ? 0 : XWINDOW (c->next); @@ -3474,7 +3452,7 @@ resize_window_check (struct window *w, int horflag) while (c) { if ((XINT (c->new_total) != XINT (w->new_total)) - || !resize_window_check (c, horflag)) + || !window_resize_check (c, horflag)) return 0; c = NILP (c->next) ? 0 : XWINDOW (c->next); } @@ -3494,9 +3472,9 @@ resize_window_check (struct window *w, int horflag) each of these windows. This function does not perform any error checks. Make sure you have - run resize_window_check on W before applying this function. */ + run window_resize_check on W before applying this function. */ static void -resize_window_apply (struct window *w, int horflag) +window_resize_apply (struct window *w, int horflag) { struct window *c; int pos; @@ -3530,7 +3508,7 @@ resize_window_apply (struct window *w, int horflag) XSETFASTINT (c->left_col, pos); else XSETFASTINT (c->top_line, pos); - resize_window_apply (c, horflag); + window_resize_apply (c, horflag); if (!horflag) pos = pos + XINT (c->total_lines); c = NILP (c->next) ? 0 : XWINDOW (c->next); @@ -3546,7 +3524,7 @@ resize_window_apply (struct window *w, int horflag) XSETFASTINT (c->left_col, pos); else XSETFASTINT (c->top_line, pos); - resize_window_apply (c, horflag); + window_resize_apply (c, horflag); if (horflag) pos = pos + XINT (c->total_cols); c = NILP (c->next) ? 0 : XWINDOW (c->next); @@ -3559,7 +3537,7 @@ resize_window_apply (struct window *w, int horflag) } -DEFUN ("resize-window-apply", Fresize_window_apply, Sresize_window_apply, 1, 2, 0, +DEFUN ("window-resize-apply", Fwindow_resize_apply, Swindow_resize_apply, 1, 2, 0, doc: /* Apply requested size values for window-tree of FRAME. Optional argument HORIZONTAL omitted or nil means apply requested height values. HORIZONTAL non-nil means apply requested width values. @@ -3584,12 +3562,12 @@ be applied on the Elisp level. */) f = XFRAME (frame); r = XWINDOW (FRAME_ROOT_WINDOW (f)); - if (!resize_window_check (r, horflag) + if (!window_resize_check (r, horflag) || ! EQ (r->new_total, (horflag ? r->total_cols : r->total_lines))) return Qnil; BLOCK_INPUT; - resize_window_apply (r, horflag); + window_resize_apply (r, horflag); windows_or_buffers_changed++; FRAME_WINDOW_SIZES_CHANGED (f) = 1; @@ -3641,22 +3619,22 @@ resize_frame_windows (struct frame *f, int size, int horflag) XSETINT (delta, new_size - old_size); /* Try a "normal" resize first. */ resize_root_window (root, delta, horflag ? Qt : Qnil, Qnil); - if (resize_window_check (r, horflag) && new_size == XINT (r->new_total)) - resize_window_apply (r, horflag); + if (window_resize_check (r, horflag) && new_size == XINT (r->new_total)) + window_resize_apply (r, horflag); else { /* Try with "reasonable" minimum sizes next. */ resize_root_window (root, delta, horflag ? Qt : Qnil, Qt); - if (resize_window_check (r, horflag) + if (window_resize_check (r, horflag) && new_size == XINT (r->new_total)) - resize_window_apply (r, horflag); + window_resize_apply (r, horflag); else { /* Finally, try with "safe" minimum sizes. */ resize_root_window (root, delta, horflag ? Qt : Qnil, Qsafe); - if (resize_window_check (r, horflag) + if (window_resize_check (r, horflag) && new_size == XINT (r->new_total)) - resize_window_apply (r, horflag); + window_resize_apply (r, horflag); else { /* We lost. Delete all windows but the frame's @@ -3765,7 +3743,7 @@ set correctly. See the code of `split-window' for how this is done. */) XSETINT (p->new_total, XINT (horflag ? p->total_cols : p->total_lines) - XINT (total_size)); - if (!resize_window_check (p, horflag)) + if (!window_resize_check (p, horflag)) error ("Window sizes don't fit"); else /* Undo the temporary pretension. */ @@ -3773,7 +3751,7 @@ set correctly. See the code of `split-window' for how this is done. */) } else { - if (!resize_window_check (o, horflag)) + if (!window_resize_check (o, horflag)) error ("Resizing old window failed"); else if (XINT (total_size) + XINT (o->new_total) != XINT (horflag ? o->total_cols : o->total_lines)) @@ -3861,13 +3839,13 @@ set correctly. See the code of `split-window' for how this is done. */) n->total_cols = o->total_cols; } - /* Iso-coordinates and sizes are assigned by resize_window_apply, + /* Iso-coordinates and sizes are assigned by window_resize_apply, get them ready here. */ n->new_total = total_size; n->new_normal = normal_size; BLOCK_INPUT; - resize_window_apply (p, horflag); + window_resize_apply (p, horflag); adjust_glyphs (f); /* Set buffer of NEW to buffer of reference window. Don't run any hooks. */ @@ -3945,13 +3923,13 @@ when WINDOW is the only window on its frame. */) XWINDOW (s->next)->prev = sibling; } - if (resize_window_check (r, horflag) + if (window_resize_check (r, horflag) && EQ (r->new_total, (horflag ? r->total_cols : r->total_lines))) /* We can delete WINDOW now. */ { /* Block input. */ BLOCK_INPUT; - resize_window_apply (p, horflag); + window_resize_apply (p, horflag); windows_or_buffers_changed++; Vwindow_list = Qnil; @@ -4073,11 +4051,12 @@ grow_mini_window (struct window *w, int delta) root = FRAME_ROOT_WINDOW (f); r = XWINDOW (root); - value = call2 (Qresize_root_window_vertically, root, make_number (- delta)); - if (INTEGERP (value) && resize_window_check (r, 0)) + value = call2 (Qwindow_resize_root_window_vertically, + root, make_number (- delta)); + if (INTEGERP (value) && window_resize_check (r, 0)) { BLOCK_INPUT; - resize_window_apply (r, 0); + window_resize_apply (r, 0); /* Grow the mini-window. */ XSETFASTINT (w->top_line, XFASTINT (r->top_line) + XFASTINT (r->total_lines)); @@ -4107,12 +4086,12 @@ shrink_mini_window (struct window *w) { root = FRAME_ROOT_WINDOW (f); r = XWINDOW (root); - value = call2 (Qresize_root_window_vertically, + value = call2 (Qwindow_resize_root_window_vertically, root, make_number (size - 1)); - if (INTEGERP (value) && resize_window_check (r, 0)) + if (INTEGERP (value) && window_resize_check (r, 0)) { BLOCK_INPUT; - resize_window_apply (r, 0); + window_resize_apply (r, 0); /* Shrink the mini-window. */ XSETFASTINT (w->top_line, XFASTINT (r->top_line) + XFASTINT (r->total_lines)); @@ -4150,12 +4129,12 @@ DEFUN ("resize-mini-window-internal", Fresize_mini_window_internal, Sresize_mini r = XWINDOW (FRAME_ROOT_WINDOW (f)); height = XINT (r->total_lines) + XINT (w->total_lines); - if (resize_window_check (r, 0) + if (window_resize_check (r, 0) && XINT (w->new_total) > 0 && height == XINT (r->new_total) + XINT (w->new_total)) { BLOCK_INPUT; - resize_window_apply (r, 0); + window_resize_apply (r, 0); w->total_lines = w->new_total; XSETFASTINT (w->top_line, XINT (r->top_line) + XINT (r->total_lines)); @@ -5347,8 +5326,7 @@ struct saved_window { struct vectorlike_header header; - Lisp_Object window, clone_number; - Lisp_Object buffer, start, pointm, mark; + Lisp_Object window, buffer, start, pointm, mark; Lisp_Object left_col, top_line, total_cols, total_lines; Lisp_Object normal_cols, normal_lines; Lisp_Object hscroll, min_hscroll; @@ -5567,7 +5545,6 @@ the return value is nil. Otherwise the value is t. */) } } - w->clone_number = p->clone_number; /* If we squirreled away the buffer in the window's height, restore it now. */ if (BUFFERP (w->total_lines)) @@ -5850,7 +5827,6 @@ save_window_save (Lisp_Object window, struct Lisp_Vector *vector, int i) XSETFASTINT (w->temslot, i); i++; p->window = window; - p->clone_number = w->clone_number; p->buffer = w->buffer; p->left_col = w->left_col; p->top_line = w->top_line; @@ -6441,69 +6417,30 @@ init_window (void) void syms_of_window (void) { - Qscroll_up = intern_c_string ("scroll-up"); - staticpro (&Qscroll_up); - - Qscroll_down = intern_c_string ("scroll-down"); - staticpro (&Qscroll_down); - - Qscroll_command = intern_c_string ("scroll-command"); - staticpro (&Qscroll_command); + DEFSYM (Qscroll_up, "scroll-up"); + DEFSYM (Qscroll_down, "scroll-down"); + DEFSYM (Qscroll_command, "scroll-command"); Fput (Qscroll_up, Qscroll_command, Qt); Fput (Qscroll_down, Qscroll_command, Qt); - staticpro (&Qwindow_configuration_change_hook); - Qwindow_configuration_change_hook - = intern_c_string ("window-configuration-change-hook"); - - Qwindowp = intern_c_string ("windowp"); - staticpro (&Qwindowp); - - Qwindow_configuration_p = intern_c_string ("window-configuration-p"); - staticpro (&Qwindow_configuration_p); - - Qwindow_live_p = intern_c_string ("window-live-p"); - staticpro (&Qwindow_live_p); - - Qwindow_deletable_p = intern_c_string ("window-deletable-p"); - staticpro (&Qwindow_deletable_p); - - Qdelete_window = intern_c_string ("delete-window"); - staticpro (&Qdelete_window); - - Qresize_root_window = intern_c_string ("resize-root-window"); - staticpro (&Qresize_root_window); - - Qresize_root_window_vertically = intern_c_string ("resize-root-window-vertically"); - staticpro (&Qresize_root_window_vertically); - - Qsafe = intern_c_string ("safe"); - staticpro (&Qsafe); - - Qdisplay_buffer = intern_c_string ("display-buffer"); - staticpro (&Qdisplay_buffer); - - Qreplace_buffer_in_windows = intern_c_string ("replace-buffer-in-windows"); - staticpro (&Qreplace_buffer_in_windows); - - Qrecord_window_buffer = intern_c_string ("record-window-buffer"); - staticpro (&Qrecord_window_buffer); - - Qget_mru_window = intern_c_string ("get-mru-window"); - staticpro (&Qget_mru_window); - - Qtemp_buffer_show_hook = intern_c_string ("temp-buffer-show-hook"); - staticpro (&Qtemp_buffer_show_hook); - - Qabove = intern_c_string ("above"); - staticpro (&Qabove); - - Qbelow = intern_c_string ("below"); - staticpro (&Qbelow); - - Qauto_buffer_name = intern_c_string ("auto-buffer-name"); - staticpro (&Qauto_buffer_name); + DEFSYM (Qwindow_configuration_change_hook, "window-configuration-change-hook"); + DEFSYM (Qwindowp, "windowp"); + DEFSYM (Qwindow_configuration_p, "window-configuration-p"); + DEFSYM (Qwindow_live_p, "window-live-p"); + DEFSYM (Qwindow_deletable_p, "window-deletable-p"); + DEFSYM (Qdelete_window, "delete-window"); + DEFSYM (Qwindow_resize_root_window, "window--resize-root-window"); + DEFSYM (Qwindow_resize_root_window_vertically, "window--resize-root-window-vertically"); + DEFSYM (Qsafe, "safe"); + DEFSYM (Qdisplay_buffer, "display-buffer"); + DEFSYM (Qreplace_buffer_in_windows, "replace-buffer-in-windows"); + DEFSYM (Qrecord_window_buffer, "record-window-buffer"); + DEFSYM (Qget_mru_window, "get-mru-window"); + DEFSYM (Qtemp_buffer_show_hook, "temp-buffer-show-hook"); + DEFSYM (Qabove, "above"); + DEFSYM (Qbelow, "below"); + DEFSYM (Qauto_buffer_name, "auto-buffer-name"); staticpro (&Vwindow_list); @@ -6634,13 +6571,12 @@ function `window-nest' and altered by the function `set-window-nest'. */); defsubr (&Sset_frame_selected_window); defsubr (&Spos_visible_in_window_p); defsubr (&Swindow_line_height); - defsubr (&Swindow_clone_number); defsubr (&Swindow_buffer); defsubr (&Swindow_parent); - defsubr (&Swindow_vchild); - defsubr (&Swindow_hchild); - defsubr (&Swindow_next); - defsubr (&Swindow_prev); + defsubr (&Swindow_top_child); + defsubr (&Swindow_left_child); + defsubr (&Swindow_next_sibling); + defsubr (&Swindow_prev_sibling); defsubr (&Swindow_splits); defsubr (&Sset_window_splits); defsubr (&Swindow_nest); @@ -6654,7 +6590,7 @@ function `window-nest' and altered by the function `set-window-nest'. */); defsubr (&Swindow_new_normal); defsubr (&Sset_window_new_total); defsubr (&Sset_window_new_normal); - defsubr (&Sresize_window_apply); + defsubr (&Swindow_resize_apply); defsubr (&Swindow_body_size); defsubr (&Swindow_hscroll); defsubr (&Sset_window_hscroll); @@ -6684,7 +6620,6 @@ function `window-nest' and altered by the function `set-window-nest'. */); defsubr (&Sdelete_window_internal); defsubr (&Sresize_mini_window_internal); defsubr (&Sset_window_buffer); - defsubr (&Sset_window_clone_number); defsubr (&Srun_window_configuration_change_hook); defsubr (&Sselect_window); defsubr (&Sforce_window_update); diff --git a/src/window.h b/src/window.h index c3f59e4b116..485734e907e 100644 --- a/src/window.h +++ b/src/window.h @@ -165,10 +165,6 @@ struct window /* Unique number of window assigned when it was created. */ Lisp_Object sequence_number; - /* Sequence number of window this window was cloned from. Identic - to sequence number if window was not cloned. */ - Lisp_Object clone_number; - /* No permanent meaning; used by save-window-excursion's bookkeeping. */ Lisp_Object temslot; diff --git a/src/xdisp.c b/src/xdisp.c index f0b219702f6..a99f06a4e45 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -26428,8 +26428,7 @@ syms_of_xdisp (void) Vmessage_stack = Qnil; staticpro (&Vmessage_stack); - Qinhibit_redisplay = intern_c_string ("inhibit-redisplay"); - staticpro (&Qinhibit_redisplay); + DEFSYM (Qinhibit_redisplay, "inhibit-redisplay"); message_dolog_marker1 = Fmake_marker (); staticpro (&message_dolog_marker1); @@ -26454,141 +26453,72 @@ syms_of_xdisp (void) defsubr (&Sinvisible_p); defsubr (&Scurrent_bidi_paragraph_direction); - staticpro (&Qmenu_bar_update_hook); - Qmenu_bar_update_hook = intern_c_string ("menu-bar-update-hook"); - - staticpro (&Qoverriding_terminal_local_map); - Qoverriding_terminal_local_map = intern_c_string ("overriding-terminal-local-map"); - - staticpro (&Qoverriding_local_map); - Qoverriding_local_map = intern_c_string ("overriding-local-map"); - - staticpro (&Qwindow_scroll_functions); - Qwindow_scroll_functions = intern_c_string ("window-scroll-functions"); - - staticpro (&Qwindow_text_change_functions); - Qwindow_text_change_functions = intern_c_string ("window-text-change-functions"); - - staticpro (&Qredisplay_end_trigger_functions); - Qredisplay_end_trigger_functions = intern_c_string ("redisplay-end-trigger-functions"); - - staticpro (&Qinhibit_point_motion_hooks); - Qinhibit_point_motion_hooks = intern_c_string ("inhibit-point-motion-hooks"); - - Qeval = intern_c_string ("eval"); - staticpro (&Qeval); - - QCdata = intern_c_string (":data"); - staticpro (&QCdata); - Qdisplay = intern_c_string ("display"); - staticpro (&Qdisplay); - Qspace_width = intern_c_string ("space-width"); - staticpro (&Qspace_width); - Qraise = intern_c_string ("raise"); - staticpro (&Qraise); - Qslice = intern_c_string ("slice"); - staticpro (&Qslice); - Qspace = intern_c_string ("space"); - staticpro (&Qspace); - Qmargin = intern_c_string ("margin"); - staticpro (&Qmargin); - Qpointer = intern_c_string ("pointer"); - staticpro (&Qpointer); - Qleft_margin = intern_c_string ("left-margin"); - staticpro (&Qleft_margin); - Qright_margin = intern_c_string ("right-margin"); - staticpro (&Qright_margin); - Qcenter = intern_c_string ("center"); - staticpro (&Qcenter); - Qline_height = intern_c_string ("line-height"); - staticpro (&Qline_height); - QCalign_to = intern_c_string (":align-to"); - staticpro (&QCalign_to); - QCrelative_width = intern_c_string (":relative-width"); - staticpro (&QCrelative_width); - QCrelative_height = intern_c_string (":relative-height"); - staticpro (&QCrelative_height); - QCeval = intern_c_string (":eval"); - staticpro (&QCeval); - QCpropertize = intern_c_string (":propertize"); - staticpro (&QCpropertize); - QCfile = intern_c_string (":file"); - staticpro (&QCfile); - Qfontified = intern_c_string ("fontified"); - staticpro (&Qfontified); - Qfontification_functions = intern_c_string ("fontification-functions"); - staticpro (&Qfontification_functions); - Qtrailing_whitespace = intern_c_string ("trailing-whitespace"); - staticpro (&Qtrailing_whitespace); - Qescape_glyph = intern_c_string ("escape-glyph"); - staticpro (&Qescape_glyph); - Qnobreak_space = intern_c_string ("nobreak-space"); - staticpro (&Qnobreak_space); - Qimage = intern_c_string ("image"); - staticpro (&Qimage); - Qtext = intern_c_string ("text"); - staticpro (&Qtext); - Qboth = intern_c_string ("both"); - staticpro (&Qboth); - Qboth_horiz = intern_c_string ("both-horiz"); - staticpro (&Qboth_horiz); - Qtext_image_horiz = intern_c_string ("text-image-horiz"); - staticpro (&Qtext_image_horiz); - QCmap = intern_c_string (":map"); - staticpro (&QCmap); - QCpointer = intern_c_string (":pointer"); - staticpro (&QCpointer); - Qrect = intern_c_string ("rect"); - staticpro (&Qrect); - Qcircle = intern_c_string ("circle"); - staticpro (&Qcircle); - Qpoly = intern_c_string ("poly"); - staticpro (&Qpoly); - Qmessage_truncate_lines = intern_c_string ("message-truncate-lines"); - staticpro (&Qmessage_truncate_lines); - Qgrow_only = intern_c_string ("grow-only"); - staticpro (&Qgrow_only); - Qinhibit_menubar_update = intern_c_string ("inhibit-menubar-update"); - staticpro (&Qinhibit_menubar_update); - Qinhibit_eval_during_redisplay = intern_c_string ("inhibit-eval-during-redisplay"); - staticpro (&Qinhibit_eval_during_redisplay); - Qposition = intern_c_string ("position"); - staticpro (&Qposition); - Qbuffer_position = intern_c_string ("buffer-position"); - staticpro (&Qbuffer_position); - Qobject = intern_c_string ("object"); - staticpro (&Qobject); - Qbar = intern_c_string ("bar"); - staticpro (&Qbar); - Qhbar = intern_c_string ("hbar"); - staticpro (&Qhbar); - Qbox = intern_c_string ("box"); - staticpro (&Qbox); - Qhollow = intern_c_string ("hollow"); - staticpro (&Qhollow); - Qhand = intern_c_string ("hand"); - staticpro (&Qhand); - Qarrow = intern_c_string ("arrow"); - staticpro (&Qarrow); - Qtext = intern_c_string ("text"); - staticpro (&Qtext); - Qinhibit_free_realized_faces = intern_c_string ("inhibit-free-realized-faces"); - staticpro (&Qinhibit_free_realized_faces); + DEFSYM (Qmenu_bar_update_hook, "menu-bar-update-hook"); + DEFSYM (Qoverriding_terminal_local_map, "overriding-terminal-local-map"); + DEFSYM (Qoverriding_local_map, "overriding-local-map"); + DEFSYM (Qwindow_scroll_functions, "window-scroll-functions"); + DEFSYM (Qwindow_text_change_functions, "window-text-change-functions"); + DEFSYM (Qredisplay_end_trigger_functions, "redisplay-end-trigger-functions"); + DEFSYM (Qinhibit_point_motion_hooks, "inhibit-point-motion-hooks"); + DEFSYM (Qeval, "eval"); + DEFSYM (QCdata, ":data"); + DEFSYM (Qdisplay, "display"); + DEFSYM (Qspace_width, "space-width"); + DEFSYM (Qraise, "raise"); + DEFSYM (Qslice, "slice"); + DEFSYM (Qspace, "space"); + DEFSYM (Qmargin, "margin"); + DEFSYM (Qpointer, "pointer"); + DEFSYM (Qleft_margin, "left-margin"); + DEFSYM (Qright_margin, "right-margin"); + DEFSYM (Qcenter, "center"); + DEFSYM (Qline_height, "line-height"); + DEFSYM (QCalign_to, ":align-to"); + DEFSYM (QCrelative_width, ":relative-width"); + DEFSYM (QCrelative_height, ":relative-height"); + DEFSYM (QCeval, ":eval"); + DEFSYM (QCpropertize, ":propertize"); + DEFSYM (QCfile, ":file"); + DEFSYM (Qfontified, "fontified"); + DEFSYM (Qfontification_functions, "fontification-functions"); + DEFSYM (Qtrailing_whitespace, "trailing-whitespace"); + DEFSYM (Qescape_glyph, "escape-glyph"); + DEFSYM (Qnobreak_space, "nobreak-space"); + DEFSYM (Qimage, "image"); + DEFSYM (Qtext, "text"); + DEFSYM (Qboth, "both"); + DEFSYM (Qboth_horiz, "both-horiz"); + DEFSYM (Qtext_image_horiz, "text-image-horiz"); + DEFSYM (QCmap, ":map"); + DEFSYM (QCpointer, ":pointer"); + DEFSYM (Qrect, "rect"); + DEFSYM (Qcircle, "circle"); + DEFSYM (Qpoly, "poly"); + DEFSYM (Qmessage_truncate_lines, "message-truncate-lines"); + DEFSYM (Qgrow_only, "grow-only"); + DEFSYM (Qinhibit_menubar_update, "inhibit-menubar-update"); + DEFSYM (Qinhibit_eval_during_redisplay, "inhibit-eval-during-redisplay"); + DEFSYM (Qposition, "position"); + DEFSYM (Qbuffer_position, "buffer-position"); + DEFSYM (Qobject, "object"); + DEFSYM (Qbar, "bar"); + DEFSYM (Qhbar, "hbar"); + DEFSYM (Qbox, "box"); + DEFSYM (Qhollow, "hollow"); + DEFSYM (Qhand, "hand"); + DEFSYM (Qarrow, "arrow"); + DEFSYM (Qtext, "text"); + DEFSYM (Qinhibit_free_realized_faces, "inhibit-free-realized-faces"); list_of_error = Fcons (Fcons (intern_c_string ("error"), Fcons (intern_c_string ("void-variable"), Qnil)), Qnil); staticpro (&list_of_error); - Qlast_arrow_position = intern_c_string ("last-arrow-position"); - staticpro (&Qlast_arrow_position); - Qlast_arrow_string = intern_c_string ("last-arrow-string"); - staticpro (&Qlast_arrow_string); - - Qoverlay_arrow_string = intern_c_string ("overlay-arrow-string"); - staticpro (&Qoverlay_arrow_string); - Qoverlay_arrow_bitmap = intern_c_string ("overlay-arrow-bitmap"); - staticpro (&Qoverlay_arrow_bitmap); + DEFSYM (Qlast_arrow_position, "last-arrow-position"); + DEFSYM (Qlast_arrow_string, "last-arrow-string"); + DEFSYM (Qoverlay_arrow_string, "overlay-arrow-string"); + DEFSYM (Qoverlay_arrow_bitmap, "overlay-arrow-bitmap"); echo_buffer[0] = echo_buffer[1] = Qnil; staticpro (&echo_buffer[0]); @@ -26622,10 +26552,8 @@ syms_of_xdisp (void) staticpro (&previous_help_echo_string); help_echo_pos = -1; - Qright_to_left = intern_c_string ("right-to-left"); - staticpro (&Qright_to_left); - Qleft_to_right = intern_c_string ("left-to-right"); - staticpro (&Qleft_to_right); + DEFSYM (Qright_to_left, "right-to-left"); + DEFSYM (Qleft_to_right, "left-to-right"); #ifdef HAVE_WINDOW_SYSTEM DEFVAR_BOOL ("x-stretch-cursor", x_stretch_cursor_p, @@ -26945,8 +26873,7 @@ the frame's other specifications determine how to blink the cursor off. */); If non-nil, windows are automatically scrolled horizontally to make point visible. */); automatic_hscrolling_p = 1; - Qauto_hscroll_mode = intern_c_string ("auto-hscroll-mode"); - staticpro (&Qauto_hscroll_mode); + DEFSYM (Qauto_hscroll_mode, "auto-hscroll-mode"); DEFVAR_INT ("hscroll-margin", hscroll_margin, doc: /* *How many columns away from the window edge point is allowed to get @@ -27002,8 +26929,7 @@ property. To add a prefix to non-continuation lines, use `line-prefix'. */); Vwrap_prefix = Qnil; - staticpro (&Qwrap_prefix); - Qwrap_prefix = intern_c_string ("wrap-prefix"); + DEFSYM (Qwrap_prefix, "wrap-prefix"); Fmake_variable_buffer_local (Qwrap_prefix); DEFVAR_LISP ("line-prefix", Vline_prefix, @@ -27016,8 +26942,7 @@ property. To add a prefix to continuation lines, use `wrap-prefix'. */); Vline_prefix = Qnil; - staticpro (&Qline_prefix); - Qline_prefix = intern_c_string ("line-prefix"); + DEFSYM (Qline_prefix, "line-prefix"); Fmake_variable_buffer_local (Qline_prefix); DEFVAR_BOOL ("inhibit-eval-during-redisplay", inhibit_eval_during_redisplay, diff --git a/src/xfaces.c b/src/xfaces.c index 5833633c2e7..91f4b133466 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -3813,6 +3813,18 @@ Default face attributes override any local face attributes. */) Fmodify_frame_parameters (frame, Fcons (Fcons (Qfont, name), Qnil)); } + + if (STRINGP (gvec[LFACE_FOREGROUND_INDEX])) + Fmodify_frame_parameters (frame, + Fcons (Fcons (Qforeground_color, + gvec[LFACE_FOREGROUND_INDEX]), + Qnil)); + + if (STRINGP (gvec[LFACE_BACKGROUND_INDEX])) + Fmodify_frame_parameters (frame, + Fcons (Fcons (Qbackground_color, + gvec[LFACE_BACKGROUND_INDEX]), + Qnil)); } } @@ -6393,153 +6405,82 @@ DEFUN ("show-face-resources", Fshow_face_resources, Sshow_face_resources, void syms_of_xfaces (void) { - Qface = intern_c_string ("face"); - staticpro (&Qface); - Qface_no_inherit = intern_c_string ("face-no-inherit"); - staticpro (&Qface_no_inherit); - Qbitmap_spec_p = intern_c_string ("bitmap-spec-p"); - staticpro (&Qbitmap_spec_p); - Qframe_set_background_mode = intern_c_string ("frame-set-background-mode"); - staticpro (&Qframe_set_background_mode); + DEFSYM (Qface, "face"); + DEFSYM (Qface_no_inherit, "face-no-inherit"); + DEFSYM (Qbitmap_spec_p, "bitmap-spec-p"); + DEFSYM (Qframe_set_background_mode, "frame-set-background-mode"); /* Lisp face attribute keywords. */ - QCfamily = intern_c_string (":family"); - staticpro (&QCfamily); - QCheight = intern_c_string (":height"); - staticpro (&QCheight); - QCweight = intern_c_string (":weight"); - staticpro (&QCweight); - QCslant = intern_c_string (":slant"); - staticpro (&QCslant); - QCunderline = intern_c_string (":underline"); - staticpro (&QCunderline); - QCinverse_video = intern_c_string (":inverse-video"); - staticpro (&QCinverse_video); - QCreverse_video = intern_c_string (":reverse-video"); - staticpro (&QCreverse_video); - QCforeground = intern_c_string (":foreground"); - staticpro (&QCforeground); - QCbackground = intern_c_string (":background"); - staticpro (&QCbackground); - QCstipple = intern_c_string (":stipple"); - staticpro (&QCstipple); - QCwidth = intern_c_string (":width"); - staticpro (&QCwidth); - QCfont = intern_c_string (":font"); - staticpro (&QCfont); - QCfontset = intern_c_string (":fontset"); - staticpro (&QCfontset); - QCbold = intern_c_string (":bold"); - staticpro (&QCbold); - QCitalic = intern_c_string (":italic"); - staticpro (&QCitalic); - QCoverline = intern_c_string (":overline"); - staticpro (&QCoverline); - QCstrike_through = intern_c_string (":strike-through"); - staticpro (&QCstrike_through); - QCbox = intern_c_string (":box"); - staticpro (&QCbox); - QCinherit = intern_c_string (":inherit"); - staticpro (&QCinherit); + DEFSYM (QCfamily, ":family"); + DEFSYM (QCheight, ":height"); + DEFSYM (QCweight, ":weight"); + DEFSYM (QCslant, ":slant"); + DEFSYM (QCunderline, ":underline"); + DEFSYM (QCinverse_video, ":inverse-video"); + DEFSYM (QCreverse_video, ":reverse-video"); + DEFSYM (QCforeground, ":foreground"); + DEFSYM (QCbackground, ":background"); + DEFSYM (QCstipple, ":stipple"); + DEFSYM (QCwidth, ":width"); + DEFSYM (QCfont, ":font"); + DEFSYM (QCfontset, ":fontset"); + DEFSYM (QCbold, ":bold"); + DEFSYM (QCitalic, ":italic"); + DEFSYM (QCoverline, ":overline"); + DEFSYM (QCstrike_through, ":strike-through"); + DEFSYM (QCbox, ":box"); + DEFSYM (QCinherit, ":inherit"); /* Symbols used for Lisp face attribute values. */ - QCcolor = intern_c_string (":color"); - staticpro (&QCcolor); - QCline_width = intern_c_string (":line-width"); - staticpro (&QCline_width); - QCstyle = intern_c_string (":style"); - staticpro (&QCstyle); - Qreleased_button = intern_c_string ("released-button"); - staticpro (&Qreleased_button); - Qpressed_button = intern_c_string ("pressed-button"); - staticpro (&Qpressed_button); - Qnormal = intern_c_string ("normal"); - staticpro (&Qnormal); - Qultra_light = intern_c_string ("ultra-light"); - staticpro (&Qultra_light); - Qextra_light = intern_c_string ("extra-light"); - staticpro (&Qextra_light); - Qlight = intern_c_string ("light"); - staticpro (&Qlight); - Qsemi_light = intern_c_string ("semi-light"); - staticpro (&Qsemi_light); - Qsemi_bold = intern_c_string ("semi-bold"); - staticpro (&Qsemi_bold); - Qbold = intern_c_string ("bold"); - staticpro (&Qbold); - Qextra_bold = intern_c_string ("extra-bold"); - staticpro (&Qextra_bold); - Qultra_bold = intern_c_string ("ultra-bold"); - staticpro (&Qultra_bold); - Qoblique = intern_c_string ("oblique"); - staticpro (&Qoblique); - Qitalic = intern_c_string ("italic"); - staticpro (&Qitalic); - Qreverse_oblique = intern_c_string ("reverse-oblique"); - staticpro (&Qreverse_oblique); - Qreverse_italic = intern_c_string ("reverse-italic"); - staticpro (&Qreverse_italic); - Qultra_condensed = intern_c_string ("ultra-condensed"); - staticpro (&Qultra_condensed); - Qextra_condensed = intern_c_string ("extra-condensed"); - staticpro (&Qextra_condensed); - Qcondensed = intern_c_string ("condensed"); - staticpro (&Qcondensed); - Qsemi_condensed = intern_c_string ("semi-condensed"); - staticpro (&Qsemi_condensed); - Qsemi_expanded = intern_c_string ("semi-expanded"); - staticpro (&Qsemi_expanded); - Qexpanded = intern_c_string ("expanded"); - staticpro (&Qexpanded); - Qextra_expanded = intern_c_string ("extra-expanded"); - staticpro (&Qextra_expanded); - Qultra_expanded = intern_c_string ("ultra-expanded"); - staticpro (&Qultra_expanded); - Qbackground_color = intern_c_string ("background-color"); - staticpro (&Qbackground_color); - Qforeground_color = intern_c_string ("foreground-color"); - staticpro (&Qforeground_color); - Qunspecified = intern_c_string ("unspecified"); - staticpro (&Qunspecified); - Qignore_defface = intern_c_string (":ignore-defface"); - staticpro (&Qignore_defface); - - Qface_alias = intern_c_string ("face-alias"); - staticpro (&Qface_alias); - Qdefault = intern_c_string ("default"); - staticpro (&Qdefault); - Qtool_bar = intern_c_string ("tool-bar"); - staticpro (&Qtool_bar); - Qregion = intern_c_string ("region"); - staticpro (&Qregion); - Qfringe = intern_c_string ("fringe"); - staticpro (&Qfringe); - Qheader_line = intern_c_string ("header-line"); - staticpro (&Qheader_line); - Qscroll_bar = intern_c_string ("scroll-bar"); - staticpro (&Qscroll_bar); - Qmenu = intern_c_string ("menu"); - staticpro (&Qmenu); - Qcursor = intern_c_string ("cursor"); - staticpro (&Qcursor); - Qborder = intern_c_string ("border"); - staticpro (&Qborder); - Qmouse = intern_c_string ("mouse"); - staticpro (&Qmouse); - Qmode_line_inactive = intern_c_string ("mode-line-inactive"); - staticpro (&Qmode_line_inactive); - Qvertical_border = intern_c_string ("vertical-border"); - staticpro (&Qvertical_border); - Qtty_color_desc = intern_c_string ("tty-color-desc"); - staticpro (&Qtty_color_desc); - Qtty_color_standard_values = intern_c_string ("tty-color-standard-values"); - staticpro (&Qtty_color_standard_values); - Qtty_color_by_index = intern_c_string ("tty-color-by-index"); - staticpro (&Qtty_color_by_index); - Qtty_color_alist = intern_c_string ("tty-color-alist"); - staticpro (&Qtty_color_alist); - Qscalable_fonts_allowed = intern_c_string ("scalable-fonts-allowed"); - staticpro (&Qscalable_fonts_allowed); + DEFSYM (QCcolor, ":color"); + DEFSYM (QCline_width, ":line-width"); + DEFSYM (QCstyle, ":style"); + DEFSYM (Qreleased_button, "released-button"); + DEFSYM (Qpressed_button, "pressed-button"); + DEFSYM (Qnormal, "normal"); + DEFSYM (Qultra_light, "ultra-light"); + DEFSYM (Qextra_light, "extra-light"); + DEFSYM (Qlight, "light"); + DEFSYM (Qsemi_light, "semi-light"); + DEFSYM (Qsemi_bold, "semi-bold"); + DEFSYM (Qbold, "bold"); + DEFSYM (Qextra_bold, "extra-bold"); + DEFSYM (Qultra_bold, "ultra-bold"); + DEFSYM (Qoblique, "oblique"); + DEFSYM (Qitalic, "italic"); + DEFSYM (Qreverse_oblique, "reverse-oblique"); + DEFSYM (Qreverse_italic, "reverse-italic"); + DEFSYM (Qultra_condensed, "ultra-condensed"); + DEFSYM (Qextra_condensed, "extra-condensed"); + DEFSYM (Qcondensed, "condensed"); + DEFSYM (Qsemi_condensed, "semi-condensed"); + DEFSYM (Qsemi_expanded, "semi-expanded"); + DEFSYM (Qexpanded, "expanded"); + DEFSYM (Qextra_expanded, "extra-expanded"); + DEFSYM (Qultra_expanded, "ultra-expanded"); + DEFSYM (Qbackground_color, "background-color"); + DEFSYM (Qforeground_color, "foreground-color"); + DEFSYM (Qunspecified, "unspecified"); + DEFSYM (Qignore_defface, ":ignore-defface"); + + DEFSYM (Qface_alias, "face-alias"); + DEFSYM (Qdefault, "default"); + DEFSYM (Qtool_bar, "tool-bar"); + DEFSYM (Qregion, "region"); + DEFSYM (Qfringe, "fringe"); + DEFSYM (Qheader_line, "header-line"); + DEFSYM (Qscroll_bar, "scroll-bar"); + DEFSYM (Qmenu, "menu"); + DEFSYM (Qcursor, "cursor"); + DEFSYM (Qborder, "border"); + DEFSYM (Qmouse, "mouse"); + DEFSYM (Qmode_line_inactive, "mode-line-inactive"); + DEFSYM (Qvertical_border, "vertical-border"); + DEFSYM (Qtty_color_desc, "tty-color-desc"); + DEFSYM (Qtty_color_standard_values, "tty-color-standard-values"); + DEFSYM (Qtty_color_by_index, "tty-color-by-index"); + DEFSYM (Qtty_color_alist, "tty-color-alist"); + DEFSYM (Qscalable_fonts_allowed, "scalable-fonts-allowed"); Vparam_value_alist = Fcons (Fcons (Qnil, Qnil), Qnil); staticpro (&Vparam_value_alist); diff --git a/src/xfns.c b/src/xfns.c index 2b2ecf93739..c70f4bb9a82 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -5797,25 +5797,14 @@ syms_of_xfns (void) /* The section below is built by the lisp expression at the top of the file, just above where these variables are declared. */ /*&&& init symbols here &&&*/ - Qnone = intern_c_string ("none"); - staticpro (&Qnone); - Qsuppress_icon = intern_c_string ("suppress-icon"); - staticpro (&Qsuppress_icon); - Qundefined_color = intern_c_string ("undefined-color"); - staticpro (&Qundefined_color); - Qcompound_text = intern_c_string ("compound-text"); - staticpro (&Qcompound_text); - Qcancel_timer = intern_c_string ("cancel-timer"); - staticpro (&Qcancel_timer); - Qfont_param = intern_c_string ("font-parameter"); - staticpro (&Qfont_param); + DEFSYM (Qnone, "none"); + DEFSYM (Qsuppress_icon, "suppress-icon"); + DEFSYM (Qundefined_color, "undefined-color"); + DEFSYM (Qcompound_text, "compound-text"); + DEFSYM (Qcancel_timer, "cancel-timer"); + DEFSYM (Qfont_param, "font-parameter"); /* This is the end of symbol initialization. */ - /* Text property `display' should be nonsticky by default. */ - Vtext_property_default_nonsticky - = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky); - - Fput (Qundefined_color, Qerror_conditions, pure_cons (Qundefined_color, pure_cons (Qerror, Qnil))); Fput (Qundefined_color, Qerror_message, diff --git a/src/xgselect.c b/src/xgselect.c index 0d154f6496a..9ccdd37489f 100644 --- a/src/xgselect.c +++ b/src/xgselect.c @@ -15,14 +15,14 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ +along with GNU Emacs. If not, see <http§://www.gnu.org/licenses/>. */ #include <config.h> #include <setjmp.h> #include "xgselect.h" -#if defined (USE_GTK) || defined (HAVE_GCONF) +#if defined (USE_GTK) || defined (HAVE_GCONF) || defined (HAVE_GSETTINGS) #include <glib.h> #include <errno.h> @@ -149,13 +149,13 @@ xg_select (int max_fds, SELECT_TYPE *rfds, SELECT_TYPE *wfds, SELECT_TYPE *efds, return retval; } -#endif /* defined (USE_GTK) || defined (HAVE_GCONF) */ +#endif /* USE_GTK || HAVE_GCONF || HAVE_GSETTINGS */ void xgselect_initialize (void) { -#if defined (USE_GTK) || defined (HAVE_GCONF) +#if defined (USE_GTK) || defined (HAVE_GCONF) || defined (HAVE_GSETTINGS) gfds_size = 128; gfds = xmalloc (sizeof (*gfds)*gfds_size); -#endif /* defined (USE_GTK) || defined (HAVE_GCONF) */ +#endif } diff --git a/src/xmenu.c b/src/xmenu.c index 1cb71187c0c..fc629b35104 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -2559,8 +2559,7 @@ DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_ void syms_of_xmenu (void) { - Qdebug_on_next_call = intern_c_string ("debug-on-next-call"); - staticpro (&Qdebug_on_next_call); + DEFSYM (Qdebug_on_next_call, "debug-on-next-call"); #ifdef USE_X_TOOLKIT widget_id_tick = (1<<16); diff --git a/src/xsettings.c b/src/xsettings.c index e2575650df9..06718df5a3c 100644 --- a/src/xsettings.c +++ b/src/xsettings.c @@ -34,9 +34,15 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <X11/Xproto.h> +#ifdef HAVE_GSETTINGS +#include <glib-object.h> +#include <gio/gio.h> +#endif + #ifdef HAVE_GCONF #include <gconf/gconf-client.h> #endif + #ifdef HAVE_XFT #include <X11/Xft/Xft.h> #endif @@ -48,10 +54,7 @@ static Lisp_Object Qmonospace_font_name, Qfont_name, Qfont_render, Qtool_bar_style; static Lisp_Object current_tool_bar_style; -#ifdef HAVE_GCONF -static GConfClient *gconf_client; -#endif - +/* Store an config changed event in to the event queue. */ static void store_config_changed_event (Lisp_Object arg, Lisp_Object display_name) @@ -64,6 +67,97 @@ store_config_changed_event (Lisp_Object arg, Lisp_Object display_name) kbd_buffer_store_event (&event); } +/* Return non-zero if DPYINFO is still valid. */ +static int +dpyinfo_valid (struct x_display_info *dpyinfo) +{ + int found = 0; + if (dpyinfo != NULL) + { + struct x_display_info *d; + for (d = x_display_list; !found && d; d = d->next) + found = d == dpyinfo && d->display == dpyinfo->display; + } + return found; +} + +/* Store a monospace font change event if the monospaced font changed. */ + +#ifdef HAVE_XFT +static void +store_monospaced_changed (const char *newfont) +{ + if (current_mono_font != NULL && strcmp (newfont, current_mono_font) == 0) + return; /* No change. */ + + xfree (current_mono_font); + current_mono_font = xstrdup (newfont); + + if (dpyinfo_valid (first_dpyinfo) && use_system_font) + { + store_config_changed_event (Qmonospace_font_name, + XCAR (first_dpyinfo->name_list_element)); + } +} + +/* Store a font name change event if the font name changed. */ + +static void +store_font_name_changed (const char *newfont) +{ + if (current_font != NULL && strcmp (newfont, current_font) == 0) + return; /* No change. */ + + xfree (current_font); + current_font = xstrdup (newfont); + + if (dpyinfo_valid (first_dpyinfo)) + { + store_config_changed_event (Qfont_name, + XCAR (first_dpyinfo->name_list_element)); + } +} +#endif /* HAVE_XFT */ + +/* Map TOOL_BAR_STYLE from a string to its correspinding Lisp value. + Return Qnil if TOOL_BAR_STYLE is not known. */ + +static Lisp_Object +map_tool_bar_style (const char *tool_bar_style) +{ + Lisp_Object style = Qnil; + if (tool_bar_style) + { + if (strcmp (tool_bar_style, "both") == 0) + style = Qboth; + else if (strcmp (tool_bar_style, "both-horiz") == 0) + style = Qboth_horiz; + else if (strcmp (tool_bar_style, "icons") == 0) + style = Qimage; + else if (strcmp (tool_bar_style, "text") == 0) + style = Qtext; + } + + return style; +} + +/* Store a tool bar style change event if the tool bar style changed. */ + +static void +store_tool_bar_style_changed (const char *newstyle, + struct x_display_info *dpyinfo) +{ + Lisp_Object style = map_tool_bar_style (newstyle); + if (EQ (current_tool_bar_style, style)) + return; /* No change. */ + + current_tool_bar_style = style; + if (dpyinfo_valid (dpyinfo)) + store_config_changed_event (Qtool_bar_style, + XCAR (dpyinfo->name_list_element)); +} + + #define XSETTINGS_FONT_NAME "Gtk/FontName" #define XSETTINGS_TOOL_BAR_STYLE "Gtk/ToolbarStyle" @@ -83,55 +177,128 @@ struct xsettings FcBool aa, hinting; int rgba, lcdfilter, hintstyle; double dpi; -#endif char *font; +#endif + char *tb_style; unsigned seen; }; +#ifdef HAVE_GSETTINGS +#define GSETTINGS_SCHEMA "org.gnome.desktop.interface" +#define GSETTINGS_TOOL_BAR_STYLE "toolbar-style" + +#ifdef HAVE_XFT +#define GSETTINGS_MONO_FONT "monospace-font-name" +#define GSETTINGS_FONT_NAME "font-name" +#endif + + +/* The single GSettings instance, or NULL if not connected to GSettings. */ + +static GSettings *gsettings_client; + +/* Callback called when something changed in GSettings. */ + +static void +something_changed_gsettingsCB (GSettings *settings, + gchar *key, + gpointer user_data) +{ + GVariant *val; + + if (strcmp (key, GSETTINGS_TOOL_BAR_STYLE) == 0) + { + val = g_settings_get_value (settings, GSETTINGS_TOOL_BAR_STYLE); + if (val) + { + g_variant_ref_sink (val); + if (g_variant_is_of_type (val, G_VARIANT_TYPE_STRING)) + { + const gchar *newstyle = g_variant_get_string (val, NULL); + store_tool_bar_style_changed (newstyle, first_dpyinfo); + } + g_variant_unref (val); + } + } +#ifdef HAVE_XFT + else if (strcmp (key, GSETTINGS_MONO_FONT) == 0) + { + val = g_settings_get_value (settings, GSETTINGS_MONO_FONT); + if (val) + { + g_variant_ref_sink (val); + if (g_variant_is_of_type (val, G_VARIANT_TYPE_STRING)) + { + const gchar *newfont = g_variant_get_string (val, NULL); + store_monospaced_changed (newfont); + } + g_variant_unref (val); + } + } + else if (strcmp (key, GSETTINGS_FONT_NAME) == 0) + { + val = g_settings_get_value (settings, GSETTINGS_FONT_NAME); + if (val) + { + g_variant_ref_sink (val); + if (g_variant_is_of_type (val, G_VARIANT_TYPE_STRING)) + { + const gchar *newfont = g_variant_get_string (val, NULL); + store_font_name_changed (newfont); + } + g_variant_unref (val); + } + } +#endif /* HAVE_XFT */ +} + +#endif /* HAVE_GSETTINGS */ + #ifdef HAVE_GCONF +#define GCONF_TOOL_BAR_STYLE "/desktop/gnome/interface/toolbar_style" +#ifdef HAVE_XFT +#define GCONF_MONO_FONT "/desktop/gnome/interface/monospace_font_name" +#define GCONF_FONT_NAME "/desktop/gnome/interface/font_name" +#endif -#define SYSTEM_MONO_FONT "/desktop/gnome/interface/monospace_font_name" -#define SYSTEM_FONT "/desktop/gnome/interface/font_name" +/* The single GConf instance, or NULL if not connected to GConf. */ -/* Callback called when something changed in GConf that we care about, - that is SYSTEM_MONO_FONT. */ +static GConfClient *gconf_client; + +/* Callback called when something changed in GConf that we care about. */ static void -something_changedCB (GConfClient *client, - guint cnxn_id, - GConfEntry *entry, - gpointer user_data) +something_changed_gconfCB (GConfClient *client, + guint cnxn_id, + GConfEntry *entry, + gpointer user_data) { GConfValue *v = gconf_entry_get_value (entry); + const char *key = gconf_entry_get_key (entry); - if (!v) return; - if (v->type == GCONF_VALUE_STRING) + if (!v || v->type != GCONF_VALUE_STRING || ! key) return; + if (strcmp (key, GCONF_TOOL_BAR_STYLE) == 0) { const char *value = gconf_value_get_string (v); - if (current_mono_font != NULL && strcmp (value, current_mono_font) == 0) - return; /* No change. */ - - xfree (current_mono_font); - current_mono_font = xstrdup (value); + store_tool_bar_style_changed (value, first_dpyinfo); } - - - if (first_dpyinfo != NULL) +#ifdef HAVE_XFT + else if (strcmp (key, GCONF_MONO_FONT) == 0) + { + const char *value = gconf_value_get_string (v); + store_monospaced_changed (value); + } + else if (strcmp (key, GCONF_FONT_NAME) == 0) { - /* Check if display still open */ - struct x_display_info *dpyinfo; - int found = 0; - for (dpyinfo = x_display_list; !found && dpyinfo; dpyinfo = dpyinfo->next) - found = dpyinfo == first_dpyinfo; - - if (found && use_system_font) - store_config_changed_event (Qmonospace_font_name, - XCAR (first_dpyinfo->name_list_element)); + const char *value = gconf_value_get_string (v); + store_font_name_changed (value); } +#endif /* HAVE_XFT */ } + #endif /* HAVE_GCONF */ #ifdef HAVE_XFT @@ -274,14 +441,14 @@ parse_settings (unsigned char *prop, bytes_parsed += 4; /* Skip serial for this value */ if (bytes_parsed > bytes) return BadLength; - want_this = + want_this = #ifdef HAVE_XFT (nlen > 6 && strncmp (name, "Xft/", 4) == 0) + || strcmp (XSETTINGS_FONT_NAME, name) == 0 || #endif - (strcmp (XSETTINGS_FONT_NAME, name) == 0) - || (strcmp (XSETTINGS_TOOL_BAR_STYLE, name) == 0); - + strcmp (XSETTINGS_TOOL_BAR_STYLE, name) == 0; + switch (type) { case 0: /* Integer */ @@ -322,17 +489,17 @@ parse_settings (unsigned char *prop, if (want_this) { ++settings_seen; - if (strcmp (name, XSETTINGS_FONT_NAME) == 0) - { - settings->font = xstrdup (sval); - settings->seen |= SEEN_FONT; - } - else if (strcmp (name, XSETTINGS_TOOL_BAR_STYLE) == 0) + if (strcmp (name, XSETTINGS_TOOL_BAR_STYLE) == 0) { settings->tb_style = xstrdup (sval); settings->seen |= SEEN_TB_STYLE; } #ifdef HAVE_XFT + else if (strcmp (name, XSETTINGS_FONT_NAME) == 0) + { + settings->font = xstrdup (sval); + settings->seen |= SEEN_FONT; + } else if (strcmp (name, "Xft/Antialias") == 0) { settings->seen |= SEEN_AA; @@ -397,6 +564,10 @@ parse_settings (unsigned char *prop, return settings_seen; } +/* Read settings from the XSettings property window on display for DPYINFO. + Store settings read in SETTINGS. + Return non-zero if successful, zero if not. */ + static int read_settings (struct x_display_info *dpyinfo, struct xsettings *settings) { @@ -426,6 +597,8 @@ read_settings (struct x_display_info *dpyinfo, struct xsettings *settings) return rc != 0; } +/* Apply Xft settings in SETTINGS to the Xft library. + If SEND_EVENT_P is non-zero store a Lisp event that Xft settings changed. */ static void apply_xft_settings (struct x_display_info *dpyinfo, @@ -444,9 +617,9 @@ apply_xft_settings (struct x_display_info *dpyinfo, pat); FcPatternGetBool (pat, FC_ANTIALIAS, 0, &oldsettings.aa); FcPatternGetBool (pat, FC_HINTING, 0, &oldsettings.hinting); -# ifdef FC_HINT_STYLE +#ifdef FC_HINT_STYLE FcPatternGetInteger (pat, FC_HINT_STYLE, 0, &oldsettings.hintstyle); -# endif +#endif FcPatternGetInteger (pat, FC_LCD_FILTER, 0, &oldsettings.lcdfilter); FcPatternGetInteger (pat, FC_RGBA, 0, &oldsettings.rgba); FcPatternGetDouble (pat, FC_DPI, 0, &oldsettings.dpi); @@ -485,7 +658,7 @@ apply_xft_settings (struct x_display_info *dpyinfo, oldsettings.lcdfilter = settings->lcdfilter; } -# ifdef FC_HINT_STYLE +#ifdef FC_HINT_STYLE if ((settings->seen & SEEN_HINTSTYLE) != 0 && oldsettings.hintstyle != settings->hintstyle) { @@ -494,7 +667,7 @@ apply_xft_settings (struct x_display_info *dpyinfo, ++changed; oldsettings.hintstyle = settings->hintstyle; } -# endif +#endif if ((settings->seen & SEEN_DPI) != 0 && oldsettings.dpi != settings->dpi && settings->dpi > 0) @@ -545,11 +718,13 @@ apply_xft_settings (struct x_display_info *dpyinfo, #endif /* HAVE_XFT */ } +/* Read XSettings from the display for DPYINFO. + If SEND_EVENT_P is non-zero store a Lisp event settings that changed. */ + static void read_and_apply_settings (struct x_display_info *dpyinfo, int send_event_p) { struct xsettings settings; - Lisp_Object dpyname = XCAR (dpyinfo->name_list_element); if (!read_settings (dpyinfo, &settings)) return; @@ -557,38 +732,29 @@ read_and_apply_settings (struct x_display_info *dpyinfo, int send_event_p) apply_xft_settings (dpyinfo, True, &settings); if (settings.seen & SEEN_TB_STYLE) { - Lisp_Object style = Qnil; - if (strcmp (settings.tb_style, "both") == 0) - style = Qboth; - else if (strcmp (settings.tb_style, "both-horiz") == 0) - style = Qboth_horiz; - else if (strcmp (settings.tb_style, "icons") == 0) - style = Qimage; - else if (strcmp (settings.tb_style, "text") == 0) - style = Qtext; - if (!NILP (style) && !EQ (style, current_tool_bar_style)) - { - current_tool_bar_style = style; - if (send_event_p) - store_config_changed_event (Qtool_bar_style, dpyname); - } + if (send_event_p) + store_tool_bar_style_changed (settings.tb_style, dpyinfo); + else + current_tool_bar_style = map_tool_bar_style (settings.tb_style); xfree (settings.tb_style); } - +#ifdef HAVE_XFT if (settings.seen & SEEN_FONT) { - if (!current_font || strcmp (current_font, settings.font) != 0) + if (send_event_p) + store_font_name_changed (settings.font); + else { xfree (current_font); - current_font = settings.font; - if (send_event_p) - store_config_changed_event (Qfont_name, dpyname); + current_font = xstrdup (settings.font); } - else - xfree (settings.font); + xfree (settings.font); } +#endif } +/* Check if EVENT for the display in DPYINFO is XSettings related. */ + void xft_settings_event (struct x_display_info *dpyinfo, XEvent *event) { @@ -630,41 +796,130 @@ xft_settings_event (struct x_display_info *dpyinfo, XEvent *event) read_and_apply_settings (dpyinfo, True); } +/* Initialize GSettings and read startup values. */ + +static void +init_gsettings (void) +{ +#ifdef HAVE_GSETTINGS + GVariant *val; + const gchar *const *schemas; + int schema_found = 0; + +#ifdef HAVE_G_TYPE_INIT + g_type_init (); +#endif + + schemas = g_settings_list_schemas(); + if (schemas == NULL) return; + while (! schema_found && *schemas != NULL) + schema_found = strcmp (*schemas++, GSETTINGS_SCHEMA) == 0; + if (!schema_found) return; + + gsettings_client = g_settings_new (GSETTINGS_SCHEMA); + if (!gsettings_client) return; + g_object_ref_sink (G_OBJECT (gsettings_client)); + g_signal_connect (G_OBJECT (gsettings_client), "changed", + G_CALLBACK (something_changed_gsettingsCB), NULL); + + val = g_settings_get_value (gsettings_client, GSETTINGS_TOOL_BAR_STYLE); + if (val) + { + g_variant_ref_sink (val); + if (g_variant_is_of_type (val, G_VARIANT_TYPE_STRING)) + current_tool_bar_style + = map_tool_bar_style (g_variant_get_string (val, NULL)); + g_variant_unref (val); + } + +#ifdef HAVE_XFT + val = g_settings_get_value (gsettings_client, GSETTINGS_MONO_FONT); + if (val) + { + g_variant_ref_sink (val); + if (g_variant_is_of_type (val, G_VARIANT_TYPE_STRING)) + current_mono_font = xstrdup (g_variant_get_string (val, NULL)); + g_variant_unref (val); + } + + val = g_settings_get_value (gsettings_client, GSETTINGS_FONT_NAME); + if (val) + { + g_variant_ref_sink (val); + if (g_variant_is_of_type (val, G_VARIANT_TYPE_STRING)) + current_font = xstrdup (g_variant_get_string (val, NULL)); + g_variant_unref (val); + } +#endif /* HAVE_XFT */ + +#endif /* HAVE_GSETTINGS */ +} + +/* Init GConf and read startup values. */ static void init_gconf (void) { -#if defined (HAVE_GCONF) && defined (HAVE_XFT) +#if defined (HAVE_GCONF) char *s; #ifdef HAVE_G_TYPE_INIT g_type_init (); #endif + gconf_client = gconf_client_get_default (); - s = gconf_client_get_string (gconf_client, SYSTEM_MONO_FONT, NULL); + gconf_client_set_error_handling (gconf_client, GCONF_CLIENT_HANDLE_NONE); + gconf_client_add_dir (gconf_client, + GCONF_TOOL_BAR_STYLE, + GCONF_CLIENT_PRELOAD_ONELEVEL, + NULL); + gconf_client_notify_add (gconf_client, + GCONF_TOOL_BAR_STYLE, + something_changed_gconfCB, + NULL, NULL, NULL); + + s = gconf_client_get_string (gconf_client, GCONF_TOOL_BAR_STYLE, NULL); + if (s) + { + current_tool_bar_style = map_tool_bar_style (s); + g_free (s); + } + +#ifdef HAVE_XFT + s = gconf_client_get_string (gconf_client, GCONF_MONO_FONT, NULL); if (s) { current_mono_font = xstrdup (s); g_free (s); } - s = gconf_client_get_string (gconf_client, SYSTEM_FONT, NULL); + s = gconf_client_get_string (gconf_client, GCONF_FONT_NAME, NULL); if (s) { current_font = xstrdup (s); g_free (s); } - gconf_client_set_error_handling (gconf_client, GCONF_CLIENT_HANDLE_NONE); gconf_client_add_dir (gconf_client, - SYSTEM_MONO_FONT, + GCONF_MONO_FONT, + GCONF_CLIENT_PRELOAD_ONELEVEL, + NULL); + gconf_client_notify_add (gconf_client, + GCONF_MONO_FONT, + something_changed_gconfCB, + NULL, NULL, NULL); + gconf_client_add_dir (gconf_client, + GCONF_FONT_NAME, GCONF_CLIENT_PRELOAD_ONELEVEL, NULL); gconf_client_notify_add (gconf_client, - SYSTEM_MONO_FONT, - something_changedCB, + GCONF_FONT_NAME, + something_changed_gconfCB, NULL, NULL, NULL); -#endif /* HAVE_GCONF && HAVE_XFT */ +#endif /* HAVE_XFT */ +#endif /* HAVE_GCONF */ } +/* Init Xsettings and read startup values. */ + static void init_xsettings (struct x_display_info *dpyinfo) { @@ -689,8 +944,12 @@ xsettings_initialize (struct x_display_info *dpyinfo) if (first_dpyinfo == NULL) first_dpyinfo = dpyinfo; init_gconf (); init_xsettings (dpyinfo); + init_gsettings (); } +/* Return the system monospaced font. + May be NULL if not known. */ + const char * xsettings_get_system_font (void) { @@ -698,6 +957,9 @@ xsettings_get_system_font (void) } #ifdef USE_LUCID +/* Return the system font. + May be NULL if not known. */ + const char * xsettings_get_system_normal_font (void) { @@ -746,16 +1008,16 @@ syms_of_xsettings (void) current_mono_font = NULL; current_font = NULL; first_dpyinfo = NULL; +#ifdef HAVE_GSETTINGS + gsettings_client = NULL; +#endif #ifdef HAVE_GCONF gconf_client = NULL; #endif - Qmonospace_font_name = intern_c_string ("monospace-font-name"); - staticpro (&Qmonospace_font_name); - Qfont_name = intern_c_string ("font-name"); - staticpro (&Qfont_name); - Qfont_render = intern_c_string ("font-render"); - staticpro (&Qfont_render); + DEFSYM (Qmonospace_font_name, "monospace-font-name"); + DEFSYM (Qfont_name, "font-name"); + DEFSYM (Qfont_render, "font-render"); defsubr (&Sfont_get_system_font); defsubr (&Sfont_get_system_normal_font); @@ -772,14 +1034,13 @@ If this variable is nil, Emacs ignores system font changes. */); #ifdef HAVE_XFT Fprovide (intern_c_string ("font-render-setting"), Qnil); -#ifdef HAVE_GCONF +#if defined (HAVE_GCONF) || defined (HAVE_GSETTINGS) Fprovide (intern_c_string ("system-font-setting"), Qnil); #endif #endif current_tool_bar_style = Qnil; - Qtool_bar_style = intern_c_string ("tool-bar-style"); - staticpro (&Qtool_bar_style); + DEFSYM (Qtool_bar_style, "tool-bar-style"); defsubr (&Stool_bar_get_system_style); Fprovide (intern_c_string ("dynamic-setting"), Qnil); diff --git a/src/xterm.c b/src/xterm.c index bc7592795c4..20516ee9d6f 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10698,11 +10698,8 @@ syms_of_xterm (void) staticpro (&last_mouse_scroll_bar); last_mouse_scroll_bar = Qnil; - staticpro (&Qvendor_specific_keysyms); - Qvendor_specific_keysyms = intern_c_string ("vendor-specific-keysyms"); - - staticpro (&Qlatin_1); - Qlatin_1 = intern_c_string ("latin-1"); + DEFSYM (Qvendor_specific_keysyms, "vendor-specific-keysyms"); + DEFSYM (Qlatin_1, "latin-1"); staticpro (&last_mouse_press_frame); last_mouse_press_frame = Qnil; @@ -10711,8 +10708,7 @@ syms_of_xterm (void) xg_default_icon_file = make_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg"); staticpro (&xg_default_icon_file); - Qx_gtk_map_stock = intern_c_string ("x-gtk-map-stock"); - staticpro (&Qx_gtk_map_stock); + DEFSYM (Qx_gtk_map_stock, "x-gtk-map-stock"); #endif DEFVAR_BOOL ("x-use-underline-position-properties", |