diff --git a/.dir-locals.el b/.dir-locals.el index 471f74da12a..5bee88267c8 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -2,6 +2,7 @@ (sentence-end-double-space . t) (fill-column . 70))) (c-mode . ((c-file-style . "GNU"))) + (objc-mode . ((c-file-style . "GNU"))) ;; You must set bugtracker_debbugs_url in your bazaar.conf for this to work. ;; See admin/notes/bugtracker. (log-edit-mode . ((log-edit-rewrite-fixes diff --git a/ChangeLog b/ChangeLog index f089df625a9..03f4291a634 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,363 @@ +2012-07-17 Dmitry Antipov + + Fix toolkit configuration report. + * configure.ac (USE_X_TOOLKIT): Report toolkit as GTK3 if + --with-x-toolkit=gtk3 is used. + +2012-07-17 Paul Eggert + + Fix regression with pthread_sigmask on FreeBSD (Bug#11884). + * configure.ac: Configure gnulib at the end, not before running + pkg-config. This restores the behavior before 2012-06-22, when + higher-resolution time stamps were added, and fixes a bug whereby + LIB_PTHREAD was not used and gnulib's part of 'configure' + therefore incorrectly assumed that pthread_sigmask wasn't working. + Fix the problem with -lrt and clock_gettime a different way. + This should complete the fix for Bug#11884. + (pre_PKG_CONFIG_CFLAGS, pre_PKG_CONFIG_LIBS): New shell vars. + +2012-07-15 Paul Eggert + + Merge from gnulib, incorporating: + 2012-07-15 pthread_sigmask: fix bug on FreeBSD 9 (Bug#11884) + 2012-07-11 gettext: do not assume '#define ... defined ...' behavior + +2012-07-14 Glenn Morris + + * configure.ac (GC_SETJMP_WORKS, GC_MARK_STACK): Move here from src/s. + (AH_BOTTOM): Move GC_SETJMP_WORKS GCC fallback to main body. + +2012-07-13 Glenn Morris + + * configure.ac (opsysfile): Set to empty on gnu, cygwin. + + * configure.ac (BSD4_2, BSD_SYSTEM, USG, USG5, _AIX, CYGWIN) + (DARWIN_OS, GNU_LINUX, HPUX, IRIX6_5, SOLARIS2): + Move "system type" macros here from src/s. + (BSD_SYSTEM_AHB): New hack macro. + (AH_BOTTOM): Set BSD_SYSTEM, using BSD_SYSTEM_AHB. + + * configure.ac (NSIG_MINIMUM, ULIMIT_BREAK_VALUE, SETUP_SLAVE_PTY) + (GC_MARK_SECONDARY_STACK): Move here from src/s. + +2012-07-12 Glenn Morris + + * configure.ac (AH_BOTTOM) [DARWIN_OS]: Move SYSTEM_PURESIZE_EXTRA + setting here from src/s/darwin.h. + + * configure.ac (NO_MATHERR): Unconditionally define for Darwin; + as src/s/darwin.h used to. + + * configure.ac (NARROWPROTO, NO_ABORT, BROKEN_GET_CURRENT_DIR_NAME) + (BROKEN_FIONREAD, BROKEN_PTY_READ_AFTER_EAGAIN, BROKEN_SIGAIO) + (BROKEN_SIGPOLL, BROKEN_SIGPTY, FIRST_PTY_LETTER, NO_EDITRES) + (G_SLICE_ALWAYS_MALLOC, PREFER_VSUSP, PTY_ITERATION, PTY_OPEN) + (PTY_NAME_SPRINTF, PTY_TTY_NAME_SPRINTF, RUN_TIME_REMAP) + (SETPGRP_RELEASES_CTTY, TAB3, TABDLY, RUN_TIME_REMAP, UNIX98_PTYS) + (XOS_NEEDS_TIME_H): Move here from src/s. + +2012-07-11 Glenn Morris + + * configure.ac (INTERRUPT_INPUT): Move here from src/s. + (HAVE_PTYS, HAVE_SOCKETS): Define unconditionally. + +2012-07-11 Paul Eggert + + * configure.ac (tzset): Remove check that's redundant with gnulib. + +2012-07-11 Glenn Morris + + * configure.ac (CLASH_DETECTION): Define unconditionally. + + * configure.ac (opsysfile): Use bsd-common on gnu systems. + + * configure.ac (GNU_LIBRARY_PENDING_OUTPUT_COUNT): + (SIGNALS_VIA_CHARACTERS): Move here from src/s. + +2012-07-11 Paul Eggert + + Assume mkdir, rename, rmdir, strerror. + * configure.ac (mkdir, rename, rmdir, strerror): Remove check. + +2012-07-11 Glenn Morris + + * configure.ac (DONT_REOPEN_PTY): Move here from src/s. + + * configure.ac (DEFAULT_SOUND_DEVICE): New definition. + +2012-07-10 Paul Eggert + + Remove "#define unix" that is no longer needed (Bug#11905). + Merge from gnulib to make "#define unix" unnecessary, incorporating: + 2012-07-10 getloadavg: clean out old Emacs and Autoconf cruft + 2012-07-09 getopt: Simplify after Emacs changed. + +2012-07-10 Glenn Morris + + * configure.ac (DATA_START, DATA_SEG_BITS, PENDING_OUTPUT_COUNT): + Move here from src/s. + +2012-07-09 Andreas Schwab + + * configure.ac (PNG_DEPSTRUCT): Define this instead of + PNG_DEPRECATED. + +2012-07-09 Paul Eggert + + Add GCC-style 'const' attribute to functions that can use it. + * configure.ac (WARN_CFLAGS): Add -Wsuggest-attribute=const. + (ATTRIBUTE_CONST): New macro, in config.h. + +2012-07-09 Juanma Barranquero + + * lib/makefile.w32-in: Rework dependencies. + (GNU_LIB, NT_INC, C_CTYPE_H, MS_W32_H, CONFIG_H, FILEMODE_H) + (FTOASTR_H, FTOASTR_C, GETOPT_INT_H, MD5_H, SHA1_H, SHA256_H) + (U64_H, SHA512_H): New macros. + (SRC): Redefine to point to src/, not current directory. + ($(BLD)/c-ctype.$(O), $(BLD)/c-strcasecmp.$(O)) + ($(BLD)/c-strncasecmp.$(O), $(BLD)/dtoastr.$(O)) + ($(BLD)/dtotimespec.$(O), $(BLD)/getopt.$(O), $(BLD)/getopt1.$(O)) + ($(BLD)/gettime.$(O), $(BLD)/strftime.$(O), $(BLD)/time_r.$(O)) + ($(BLD)/timespec-add.$(O), $(BLD)/timespec-sub.$(O), $(BLD)/md5.$(O)) + ($(BLD)/sha1.$(O), $(BLD)/sha256.$(O), $(BLD)/sha512.$(O)) + ($(BLD)/filemode.$(O)): Update dependencies. + +2012-07-09 Paul Eggert + + Merge from gnulib, incorporating: + 2012-07-09 timespec: mark functions with const attributes + + Rename configure.in to configure.ac (Bug#11603). + The name 'configure.in' has been obsolescent for quite some time, + and the next release of Autoconf will generate warnings for it. + See commit 'v2.69-4-g560f16b' of 2012-05-06, "general: deprecate + 'configure.in' as autoconf input" in the Autoconf git repository. + * configure.ac: Rename from configure.in. + * INSTALL, INSTALL.BZR, README, make-dist: + * Makefile.in (AUTOCONF_INPUTS): + * autogen.sh (autoconf_min): + * autogen/update_autogen (sources): + Adjust to reflect new name. + +2012-07-08 Paul Eggert + + Restore deprecation warnings, except for older libpng. + * configure.in (WARN_CFLAGS): Remove -Wno-deprecated-declarations. + (HAVE_LIBPNG_PNG_H): Don't bother checking for this if we have png.h. + (PNG_DEPRECATED): Define when compiling with older PNG versions. + +2012-07-07 Andreas Schwab + + * configure.in (WARN_CFLAGS): Add -Wno-deprecated-declarations. + +2012-07-07 Paul Eggert + + Improve static checking when configured --with-ns. + See Samuel Bronson's remarks in + . + * configure.in (WARN_CFLAGS): Omit -Wunreachable-code, as it's + a no-op with recent GCC and harmful in earlier ones. + Omit -Wsync-nand, as it's irrelevant to Emacs and provokes a + warning when compiling with ObjC. Always omit + -Wunsafe-loop-optimizations, as we don't mind when optimization is + being done correctly. + +2012-07-07 Glenn Morris + + * configure.in (BROKEN_SA_RESTART): Doc fix. + + * configure.in: Rather than checking for things then undef'ing + them on some platforms, simply don't check for them. + (getwd): Don't check for it on unixware. + (random, rint): Don't check for these on hpux. + (res_init, libresolv): Don't check for these on darwin. + +2012-07-07 Juanma Barranquero + + * lib/makefile.w32-in (GNULIBOBJS): Add $(BLD)/c-ctype.$(O), + $(BLD)/c-strcasecmp.$(O) and $(BLD)/c-strncasecmp.$(O). + ($(BLD)/c-ctype.$(O), $(BLD)/c-strcasecmp.$(O)) + ($(BLD)/c-strncasecmp.$(O)): New dependencies. + +2012-07-06 Paul Eggert + + * configure.in: Document --enable-gcc-warnings better. + + Use c_strcasecmp for ASCII case-insensitive comparison (Bug#11786). + This is safer than strcasecmp, which has unspecified behavior + outside the POSIX locale and in practice sometimes does not work + in multibyte locales. Similarly for c_strncasecmp and strncasecmp. + * configure.in (strcasecmp, strncasecmp): Remove checks. + + * lib/c-ctype.c, lib/c-ctype.h, lib/c-strcase.h, lib/c-strcasecmp.c: + * lib/c-strncasecmp.c: New files, taken from gnulib. + * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. + + Merge from gnulib, incorporating: + 2012-07-06 timespec-sub: avoid duplicate include + Reported by Juanma Barranquero. + +2012-07-06 Glenn Morris + + * make-dist [update]: Let autoreconf figure out what needs updating. + Use `make info-real'. leim/leim-list.el should always exist. + Check cd return value. + +2012-07-06 Paul Eggert + + Merge from gnulib. This is for OpenBSD 5.1 amd64. + * m4/sys_time_h.m4: New version from gnulib, incorporating: + 2012-07-05 sys_time: allow too-wide tv_sec + +2012-07-04 Paul Eggert + + Merge from gnulib. + * lib/alloca.in.h: New version from gnulib, incorporating: + 2012-07-03 alloca: add support for HP NonStop TNS/E native + +2012-07-04 Dmitry Antipov + + * configure.in: If --enable-gcc-warnings, disable + -Wunsafe-loop-optimizations for -O1 optimization level. + +2012-06-30 Glenn Morris + + * configure.in (standardlisppath): New output variable. + (lisppath): Use standardlisppath. + * Makefile.in (standardlisppath): New, set by configure. + (epaths-force): Use standardlisppath and locallisppath rather than + lisppath. + +2012-06-28 Dmitry Antipov + + * configure.in: Fix previous change. Remove --enable-asserts. + (CPPFLAGS): Remove conditional -DXASSERTS=1. + Add --enable-link-time-optimization. + * INSTALL: Mention this. + +2012-06-28 Dmitry Antipov + + * configure.in: Add glyphs category to --enable-checking option. + (GLYPH_DEBUG): Define if glyphs debugging is enabled. + +2012-06-28 Dmitry Antipov + + * configure.in (ENABLE_CHECKING): Update comment. + +2012-06-28 Paul Eggert + + * configure.in: Don't check for sys/select.h, sys/time.h, utime.h. + Emacs proper no longer uses these headers, and can rely on Gnulib + for these checks. + + Merge from gnulib. + * m4/getopt.m4: Copy new version from gnulib, incorporating: + getopt-posix: No longer guarantee that option processing is resettable. + +2012-06-27 Glenn Morris + + * configure.in: Only check for paxctl on gnu-linux. (Bug#11398#26) + + * INSTALL: Remove references to paths.el. + +2012-06-26 Eli Zaretskii + + * lib/makefile.w32-in ($(GNULIBOBJS)): Depend on stamp_BLD. This + replaces separate dependency for each object file, which required + the same object file to be mentioned twice, causing failures in + parallel builds. + +2012-06-26 Paul Eggert + + Clean out last vestiges of the old HAVE_CONFIG_H stuff. + * lib/makefile.w32-in (LOCAL_FLAGS): Remove -DHAVE_CONFIG_H. + +2012-06-25 Dmitry Antipov + + * configure.in (AC_CHECK_FUNCS): Detect library functions + strcasecmp and strncasecmp. + +2012-06-24 Paul Eggert + + Switch from NO_RETURN to C11's _Noreturn (Bug#11750). + We might as well use the spelling standardized by C11, + as in the long run that should simplify maintenance. + * configure.in (NO_RETURN): Remove. All uses replaced by _Noreturn. + +2012-06-24 Eli Zaretskii + + * lib/makefile.w32-in ($(BLD)/dtotimespec.$(O)): + ($(BLD)/timespec-add.$(O)): + ($(BLD)/timespec-sub.$(O)): Don't depend on + $(EMACS_ROOT)/nt/inc/sys/time.h. + + * lib/stat-time.h: + * lib/timespec.h: + * lib/utimens.h: Revert last change. + +2012-06-23 Paul Eggert + + Merge from gnulib. + * m4/getopt.m4: Copy new version from gnulib, incorporating: + getopt-gnu: Handle suboptimal getopt_long's abbreviation handling. + +2012-06-23 Eli Zaretskii + + Fix the MS-Windows build broken by 2012-06-22T21:17:42Z!eggert@cs.ucla.edu. + * lib/makefile.w32-in (GNULIBOBJS): Add $(BLD)/dtotimespec.$(O), + $(BLD)/gettime.$(O), $(BLD)/timespec-add.$(O), and + $(BLD)/timespec-sub.$(O). + ($(BLD)/dtotimespec.$(O)): + ($(BLD)/gettime.$(O)): + ($(BLD)/timespec-add.$(O)): + ($(BLD)/timespec-sub.$(O)): New dependencies. + + * lib/stat-time.h: + * lib/timespec.h: + * lib/utimens.h: Include sys/time.h. + +2012-06-23 Andreas Schwab + + * configure.in: Don't use AC_CHECK_FUNCS_ONCE, which doesn't use + the correct CFLAGS and LIBS. + +2012-06-22 Paul Eggert + + Support higher-resolution time stamps (Bug#9000). + * configure.in (gl_ASSERT_NO_GNULIB_POSIXCHECK) + (gl_ASSERT_NO_GNULIB_TESTS, gl_INIT): Move these up earlier, so + that the new clock stuff doesn't clash with RSVG_LIBS. + (AC_CHECK_HEADERS): Don't check for sys/select.h, sys/time.h, utime.h, + as gnulib does that for us now. + (emacs_cv_struct_utimbuf, HAVE_STRUCT_UTIMBUF, HAVE_TIMEVAL) + (GETTIMEOFDAY_ONE_ARGUMENT): Remove; gnulib does these now. + (AC_CHECK_FUNCS): Remove utimes; no longer needed. + * lib/dtotimespec.c, lib/gettime.c, lib/gettimeofday.c, lib/pselect.c: + * lib/stat-time.h, lib/sys_select.in.h, lib/sys_time.in.h: + * lib/timespec-add.c, lib/timespec-sub.c, lib/timespec.h: + * lib/utimens.c, lib/utimens.h, m4/clock_time.m4, m4/gettime.m4: + * m4/gettimeofday.m4, m4/pselect.m4, m4/stat-time.m4: + * m4/sys_select_h.m4, m4/sys_socket_h.m4, m4/sys_time_h.m4: + * m4/timespec.m4, m4/utimbuf.m4, m4/utimens.m4, m4/utimes.m4: + New files, copied automatically from gnulib. + * lib/gnulib.mk, m4/gnulib-comp.m4: Merge from gnulib. + +2012-06-22 Paul Eggert + + Merge from gnulib. + * lib/filemode.h, lib/signal.in.h, lib/stat.c, lib/stdint.in.h: + * lib/stdlib.in.h, lib/unistd.in.h, m4/extensions.m4, m4/getloadavg.m4: + * m4/getopt.m4, m4/gnulib-common.m4, m4/largefile.m4, m4/mktime.m4: + * m4/multiarch.m4, m4/nocrash.m4, m4/stdio_h.m4, m4/time_r.m4: + Copy new versions from gnulib, incorporating the following changes: + 2012-06-22 time_r: fix typo that always overrode localtime_r decl + 2012-06-22 Write "Mac OS X" instead of "MacOS X". + 2012-06-21 mktime: fix integer overflow in 'configure'-time test + 2012-06-21 nonblocking: Avoid compilation error on mingw64. + 2012-06-19 stat, fstat: Avoid warnings on mingw64. + 2012-06-19 getopt-gnu: Fix exit code overflow in autoconf test. + 2012-06-13 Andreas Schwab * configure.in: Rename --enable-use-lisp-union-type to @@ -610,7 +970,7 @@ 2011-12-17 Paul Eggert Port HAVE_PTHREAD configuration to MirBSD 10 (Bug#10201). - * configure.in (HAVE_PTHREAD): Check for pthread_atfork if linking + * configure.in (HAVE_PTHREAD): Check for pthread_atfork if linking to gmalloc.c. This should prevent a MirBSD 10 build failure reported by Nelson H. F. Beebe in . @@ -4690,7 +5050,7 @@ 2005-06-08 Steven Tamm - * configure.in: Support Darwin/MacOSX on Intel + * configure.in: Support Darwin/MacOSX on Intel. 2005-06-06 Jan Djärv @@ -4820,7 +5180,7 @@ 2004-10-08 Steven Tamm - * configure.in (HAVE_MALLOC_MALLOC_H): Test for malloc/malloc.h + * configure.in (HAVE_MALLOC_MALLOC_H): Test for malloc/malloc.h. 2004-10-06 Jan Djärv @@ -5175,7 +5535,7 @@ 2003-01-19 Jan Djärv - * configure.in: Add --with-gtk, --with-x-toolkit=gtk + * configure.in: Add --with-gtk, --with-x-toolkit=gtk. * INSTALL (DETAILED BUILDING AND INSTALLATION): Add text about GTK. @@ -5188,7 +5548,7 @@ * configure.in: New option, --enable-carbon-app, to specify that the application should be installed * Makefile.in (install-arch-dep): On Mac OS X, install the - Emacs.app application if carbon-app is enabled + Emacs.app application if carbon-app is enabled. 2003-01-06 Dave Love @@ -7667,7 +8027,7 @@ 1995-09-30 Richard Stallman - * configure.in (powerpc-*-solaris2): New alternative.x + * configure.in (powerpc-*-solaris2): New alternative. 1995-09-12 Karl Heuer @@ -8181,11 +8541,11 @@ 1994-09-21 Richard Stallman - * configure.in (i[345]86-sequent-ptx*): Handle + * configure.in (i[345]86-sequent-ptx*): Handle. 1994-09-20 Richard Stallman - * Makefile.in (paths-force): Depend on src/paths.h + * Makefile.in (paths-force): Depend on src/paths.h. 1994-09-19 Karl Heuer @@ -8193,7 +8553,7 @@ 1994-09-18 Karl Heuer - * Makefile.in (install-arch-indep): Copy DOC-*, not DOC* + * Makefile.in (install-arch-indep): Copy DOC-*, not DOC*. * configure.in: Add AC_AIX. Add checks to set HAVE_STRUCT_UTIMBUF, HAVE_TIMEVAL, HAVE_SELECT. @@ -9026,7 +9386,7 @@ 1993-09-12 Roland McGrath (roland@sugar-bombs.gnu.ai.mit.edu) - * make-dist: Dist vpath.sed + * make-dist: Dist vpath.sed. * Makefile.in (lib-src/Makefile, src/Makefile, oldXMenu/Makefile): Depend on vpath.sed. diff --git a/INSTALL b/INSTALL index 1acf50f521f..2eab03975f9 100644 --- a/INSTALL +++ b/INSTALL @@ -323,6 +323,13 @@ and is useful with GNU-compatible compilers. On a recent GNU system there should be no warnings; on older and on non-GNU systems the generated warnings may still be useful. +Use --enable-link-time-optimization to enable link-time optimizer, which +is available in GNU compiler since version 4.5.0. If your compiler is not +GNU or older than version 4.5.0, this option does nothing. If `configure' +can determine number of online CPUS on your system, final link-time +optimization and code generation is executed in parallel using one job +per each available online CPU. + The `--prefix=PREFIXDIR' option specifies where the installation process should put emacs and its data files. This defaults to `/usr/local'. - Emacs (and the other utilities users run) go in PREFIXDIR/bin @@ -429,11 +436,19 @@ that supports the `VPATH' variable, such as GNU `make'. to the real source directory--there is no need, and installation will fail.) -4) Look at `./lisp/paths.el'; if some of those values are not right -for your system, set up the file `./lisp/site-init.el' with Emacs -Lisp code to override them; it is not a good idea to edit paths.el -itself. YOU MUST USE THE LISP FUNCTION `setq' TO ASSIGN VALUES, -rather than `defvar', as used by `./lisp/paths.el'. For example, +4) Put into `./lisp/site-init.el' or `./lisp/site-load.el' any Emacs +Lisp code you want Emacs to load before it is dumped out. Use +site-load.el for additional libraries if you arrange for their +documentation strings to be in the etc/DOC file (see +src/Makefile.in if you wish to figure out how to do that). For all +else, use site-init.el. Do not load byte-compiled code which +was built with a non-nil value of `byte-compile-dynamic'. + +It is not a good idea to edit the normal .el files that come with Emacs. +Instead, use a file like site-init.el to change settings. + +To change the value of a variable that is already defined in Emacs, +you should use the Lisp function `setq', not `defvar'. For example, (setq news-inews-program "/usr/bin/inews") @@ -445,14 +460,6 @@ variable gets by default! Make sure you know what kind of value the variable should have. If you don't pay attention to what you are doing, you'll make a mistake. -5) Put into `./lisp/site-init.el' or `./lisp/site-load.el' any Emacs -Lisp code you want Emacs to load before it is dumped out. Use -site-load.el for additional libraries if you arrange for their -documentation strings to be in the etc/DOC file (see -src/Makefile.in if you wish to figure out how to do that). For all -else, use site-init.el. Do not load byte-compiled code which -was built with a non-nil value of `byte-compile-dynamic'. - If you set load-path to a different value in site-init.el or site-load.el, Emacs will use *precisely* that value when it starts up again. If you do this, you are on your own! @@ -460,10 +467,10 @@ again. If you do this, you are on your own! The `site-*.el' files are nonexistent in the distribution. You do not need to create them if you have nothing to put in them. -6) Refer to the file `./etc/TERMS' for information on fields you may +5) Refer to the file `./etc/TERMS' for information on fields you may wish to add to various termcap entries. (This is unlikely to be necessary.) -7) Run `make' in the top directory of the Emacs distribution to finish +6) Run `make' in the top directory of the Emacs distribution to finish building Emacs in the standard way. The final executable file is named `src/emacs'. You can execute this file "in place" without copying it, if you wish; then it automatically uses the sibling @@ -534,15 +541,15 @@ for its Lisp files by giving values for `make' variables as part of the command. See the section below called `MAKE VARIABLES' for more information on this. -8) Check the file `dir' in your site's info directory (usually +7) Check the file `dir' in your site's info directory (usually /usr/local/share/info) to make sure that it has a menu entry for the Emacs info files. -9) If your system uses lock files to interlock access to mailer inbox files, +8) If your system uses lock files to interlock access to mailer inbox files, then you might need to make the movemail program setuid or setgid to enable it to write the lock files. We believe this is safe. -10) You are done! You can remove executables and object files from +9) You are done! You can remove executables and object files from the build directory by typing `make clean'. To also remove the files that `configure' created (so you can compile Emacs for a different configuration), type `make distclean'. If you don't need some, or all @@ -676,9 +683,9 @@ changing the s/*.h and m/*.h files. corresponding `Makefile.in' files. This isn't so hard, just a matter of editing in appropriate substitutions for the @...@ constructs. -The `configure' script is built from `configure.in' by the `autoconf' +The `configure' script is built from `configure.ac' by the `autoconf' program. You need at least the version of autoconf specified in the -AC_PREREQ(...) command to rebuild `configure' from `configure.in'. +AC_PREREQ(...) command to rebuild `configure' from `configure.ac'. BUILDING GNU EMACS BY HAND @@ -727,7 +734,7 @@ Strictly speaking, not all of the executables in `./lib-src' need be copied. used in building Emacs, and are not needed any more. 2) Copy the files in `./info' to the place specified in -`./lisp/site-init.el' or `./lisp/paths.el'. Note that if the +`./lisp/site-init.el' or `./lisp/info.el'. Note that if the destination directory already contains a file named `dir', you probably don't want to replace it with the `dir' file in the Emacs distribution. Instead, you should make sure that the existing `dir' diff --git a/INSTALL.BZR b/INSTALL.BZR index 675eaaf12df..e98d742fb33 100644 --- a/INSTALL.BZR +++ b/INSTALL.BZR @@ -8,7 +8,7 @@ Building Emacs from Bazaar requires some tools that are not needed when building from a release. You will need: autoconf - at least the version specified near the start of - configure.in (in the AC_PREREQ command). + configure.ac (in the AC_PREREQ command). automake - we recommend at least version 1.11. makeinfo - not strictly necessary, but highly recommended, so that you can build the manuals. diff --git a/Makefile.in b/Makefile.in index fb2530d13df..95b0931087f 100644 --- a/Makefile.in +++ b/Makefile.in @@ -186,16 +186,20 @@ iconsrcdir=$(srcdir)/etc/images/icons lispdir=@lispdir@ leimdir=@leimdir@ -# Directories Emacs should search for lisp files specific -# to this site (i.e. customizations), before consulting -# ${lispdir}. This should be a colon-separated list of -# directories. +# Directories Emacs should search for standard lisp files. +# The default is ${lispdir}:${leimdir}. +standardlisppath=@standardlisppath@ + +# Directories Emacs should search for lisp files specific to this +# site (i.e. customizations), before consulting ${standardlisppath}. +# This should be a colon-separated list of directories. locallisppath=@locallisppath@ # Where Emacs will search to find its lisp files. Before # changing this, check to see if your purpose wouldn't # better be served by changing locallisppath. This # should be a colon-separated list of directories. +# The default is ${locallisppath}:${standardlisppath}. lisppath=@lisppath@ # Where Emacs will search for its lisp files while @@ -277,16 +281,18 @@ all: ${SUBDIR} removenullpaths=sed -e 's/^://g' -e 's/:$$//g' -e 's/::/:/g' # Generate epaths.h from epaths.in. This target is invoked by `configure'. -# See comments in configure.in for why it is done this way, as opposed +# See comments in configure.ac for why it is done this way, as opposed # to just letting configure generate epaths.h from epaths.in in a # similar way to how Makefile is made from Makefile.in. epaths-force: FRC - @(lisppath=`echo ${lisppath} | ${removenullpaths}` ; \ + @(standardlisppath=`echo ${standardlisppath} | ${removenullpaths}` ; \ + locallisppath=`echo ${locallisppath} | ${removenullpaths}` ; \ buildlisppath=`echo ${buildlisppath} | ${removenullpaths}` ; \ x_default_search_path=`echo ${x_default_search_path}`; \ gamedir=`echo ${gamedir}`; \ sed < ${srcdir}/src/epaths.in > epaths.h.$$$$ \ - -e 's;\(#.*PATH_LOADSEARCH\).*$$;\1 "'"$${lisppath}"'";' \ + -e 's;\(#.*PATH_LOADSEARCH\).*$$;\1 "'"$${standardlisppath}"'";' \ + -e 's;\(#.*PATH_SITELOADSEARCH\).*$$;\1 "'"$${locallisppath}"'";' \ -e 's;\(#.*PATH_DUMPLOADSEARCH\).*$$;\1 "'"$${buildlisppath}"'";' \ -e 's;\(#.*PATH_EXEC\).*$$;\1 "${archlibdir}";' \ -e 's;\(#.*PATH_INFO\).*$$;\1 "${infodir}";' \ @@ -358,7 +364,7 @@ config.status: ${srcdir}/configure ${srcdir}/lisp/version.el ./configure $(CONFIGURE_FLAGS); \ fi -AUTOCONF_INPUTS = $(srcdir)/configure.in $(srcdir)/aclocal.m4 +AUTOCONF_INPUTS = $(srcdir)/configure.ac $(srcdir)/aclocal.m4 $(srcdir)/configure: $(AUTOCONF_INPUTS) cd ${srcdir} && autoconf diff --git a/README b/README index 4e1a4c4556f..de4ee24fc5e 100644 --- a/README +++ b/README @@ -37,12 +37,12 @@ oddities of your processor and operating system. It creates the file process of building and installing Emacs. See INSTALL for more detailed information. -The file `configure.in' is the input used by the autoconf program to +The file `configure.ac' is the input used by the autoconf program to construct the `configure' script. Since Emacs has some configuration requirements that autoconf can't meet directly, and for historical -reasons, `configure.in' uses an unholy marriage of custom-baked +reasons, `configure.ac' uses an unholy marriage of custom-baked configuration code and autoconf macros. If you want to rebuild -`configure' from `configure.in', you will need to install a recent +`configure' from `configure.ac', you will need to install a recent version of autoconf and GNU m4. The file `Makefile.in' is a template used by `configure' to create diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index e032ef87a40..9fc7ce3e33d 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -95,7 +95,6 @@ EMACS_CONFIGURATION EMACS_CONFIG_OPTIONS EMACS_INT EMACS_UINT -FILE_SYSTEM_CASE FLOAT_CHECK_DOMAIN GC_LISP_OBJECT_ALIGNMENT GC_MARK_SECONDARY_STACK @@ -131,17 +130,13 @@ HAVE_LOGB HAVE_LONG_FILE_NAMES HAVE_LRAND48 HAVE_MENUS -HAVE_MKDIR HAVE_MKTIME HAVE_MOUSE -HAVE_PERROR HAVE_PSTAT_GETDYNAMIC HAVE_PWD_H HAVE_RANDOM -HAVE_RENAME HAVE_RES_INIT HAVE_RINT -HAVE_RMDIR HAVE_SELECT HAVE_SETLOCALE HAVE_SETPGID @@ -151,7 +146,6 @@ HAVE_SHUTDOWN HAVE_SOCKETS HAVE_SOUND HAVE_STDLIB_H -HAVE_STRERROR HAVE_STRFTIME HAVE_STRING_H HAVE_STRUCT_UTIMBUF @@ -160,11 +154,9 @@ HAVE_SYS_SYSTEMINFO_H HAVE_SYS_TIMEB_H HAVE_SYS_TIME_H HAVE_TCATTR -HAVE_TIMEVAL HAVE_TM_ZONE HAVE_TZSET HAVE_UNISTD_H -HAVE_UTIMES HAVE_UTIME_H HAVE_WINDOW_SYSTEM HAVE_WORKING_VFORK @@ -175,7 +167,6 @@ IS_ANY_SEP IS_DIRECTORY_SEP LINKER LINUX_VERSION_CODE -LISP_FLOAT_TYPE LNOFLSH LOCALTIME_CACHE MAIL_USE_FLOCK @@ -200,7 +191,6 @@ O_RDONLY O_RDWR PAGESIZE PENDING_OUTPUT_COUNT -POSIX PREFER_VSUSP PTY_ITERATION PTY_NAME_SPRINTF @@ -314,7 +304,6 @@ sleep spawnve srandom strdup -strerror stricmp strnicmp strupr diff --git a/admin/ChangeLog b/admin/ChangeLog index e3b35906ace..b4c88c20ed1 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,8 +1,88 @@ +2012-07-20 Dmitry Antipov + + * coccinelle/unibyte_string.cocci: Semantic patch to convert from + make_unibyte_string to build_unibyte_string where appropriate. + +2012-07-17 Eli Zaretskii + + * CPP-DEFINES: Remove FILE_SYSTEM_CASE. + +2012-07-17 Chong Yidong + + * Version 24.1 released. + +2012-07-11 Paul Eggert + + Assume mkdir, perror, rename, rmdir, strerror. + * CPP-DEFINES (HAVE_MKDIR, HAVE_PERROR, HAVE_RENAME, HAVE_RMDIR) + (HAVE_STRERROR, strerror): + Remove. + +2012-07-10 Dmitry Antipov + + * coccinelle/list_loop.cocci: Semantic patch to convert from Fcdr + to XCDR and consistently use CONSP in the list iteration loops. + * coccinelle/vector_contents.cocci: Fix indentation. + +2012-07-10 Stefan Monnier + + * bzrmerge.el: Use cl-lib. + +2012-07-09 Paul Eggert + + Rename configure.in to configure.ac (Bug#11603). + * admin.el (set-version): + * quick-install-emacs (VERSION): + Get version number from configure.ac, not configure.in. + +2012-07-06 Paul Eggert + + Use c_strcasecmp for ASCII case-insensitive comparison (Bug#11786). + * merge-gnulib (GNULIB_MODULES): Add c-strcase. + +2012-07-05 Dmitry Antipov + + * coccinelle/xzalloc.cocci: Semantic patch to convert + calls to xmalloc with following memset to xzalloc. + +2012-07-04 Juanma Barranquero + + * CPP-DEFINES (LISP_FLOAT_TYPE): Remove, obsolete. + +2012-06-26 Dmitry Antipov + + * coccinelle/build_string.cocci: Semantic patch + to convert from make_string to build_string. + +2012-06-24 Dmitry Antipov + + First Coccinelle semantic patch. + * coccinelle: New subdirectory + * coccinelle/README: Documentation stub. + * coccinelle/vector_contents.cocci: Semantic patch to replace direct + access to `contents' member of Lisp_Vector objects with AREF and ASET + where appropriate. + +2012-06-22 Paul Eggert + + Support higher-resolution time stamps (Bug#9000). + * merge-gnulib (GNULIB_MODULES): Add dtotimespec, gettime, + gettimeofday, pselect, stat-time, sys_time, time, timespec-add, + timespec-sub, utimens. + (GNULIB_TOOL_FLAGS): Add --avoid=select --avoid=sigprocmask. + This trims down the gnulib import, from the very latest gnulib. + Emacs does its own implementation of 'select' and 'sigprocmask' + on Windows, and it assumes 'select' and 'sigprocmask' on non-Windows + hosts, so it doesn't need these modules. + Similarly, avoid errno, fcntl, fcntl-h, fstat, and sys_types, as + these gnulib modules are only for Windows porting and Emacs ports + to Windows in a different way. + 2012-06-13 Andreas Schwab - * make-emacs: Rename --union-type to --check-lisp-type. Define - CHECK_LISP_OBJECT_TYPE insted of USE_LISP_UNION_TYPE. - * CPP-DEFINES (DEBUG_LISP_OBJECT_TYPE): Renamed from + * make-emacs: Rename --union-type to --check-lisp-type. + Define CHECK_LISP_OBJECT_TYPE insted of USE_LISP_UNION_TYPE. + * CPP-DEFINES (DEBUG_LISP_OBJECT_TYPE): Rename from USE_LISP_UNION_TYPE. 2012-06-03 Glenn Morris @@ -173,11 +253,11 @@ * unidata/makefile.w32-in (all): Remove src/biditype.h and src/bidimirror.h. - (../../src/biditype.h, ../../src/bidimirror.h): Deleted. + (../../src/biditype.h, ../../src/bidimirror.h): Delete. * unidata/Makefile.in (all): Remove src/biditype.h and src/bidimirror.h. - (../../src/biditype.h, ../../src/bidimirror.h): Deleted. + (../../src/biditype.h, ../../src/bidimirror.h): Delete. 2011-07-07 Juanma Barranquero @@ -188,8 +268,8 @@ * unidata/unidata-gen.el (unidata-dir): New variable. (unidata-setup-list): Expand unidata-text-file in unidata-dir. - (unidata-prop-alist): INDEX element may be a function. New - optional element VAL-LIST (for general-category and bidi-class). + (unidata-prop-alist): INDEX element may be a function. + New optional element VAL-LIST (for general-category and bidi-class). New entry `mirroring'. (unidata-prop-default, unidata-prop-val-list): New subst. (unidata-get-character, unidata-put-character): Delete them. @@ -545,13 +625,13 @@ 2009-04-17 Kenichi Handa - * unidata/unidata-gen.el (unidata-get-decomposition): Adjust - Hangle decomposition rule to Unicode. + * unidata/unidata-gen.el (unidata-get-decomposition): + Adjust Hangle decomposition rule to Unicode. 2009-04-09 Kenichi Handa - * unidata/unidata-gen.el (unidata-describe-decomposition): Return - a string with a composition property to disable combining + * unidata/unidata-gen.el (unidata-describe-decomposition): + Return a string with a composition property to disable combining characters being composed. 2009-03-11 Miles Bader @@ -564,7 +644,7 @@ 2009-02-23 Jason Rumney - * nt/README-ftp-server: Update for 23.0.91 + * nt/README-ftp-server: Update for 23.0.91. * nt/README.W32: Remove ever expanding versions of Windows. Shorten FAQ URL. Remove mention of obsolete lock directory. @@ -1046,7 +1126,7 @@ 2005-10-17 Bill Wohler - * FOR-RELEASE (DOCUMENTATION): Removed lisp/toolbar from list + * FOR-RELEASE (DOCUMENTATION): Remove lisp/toolbar from list since it's gone. Also marked mh-e as done. 2005-10-11 Juanma Barranquero @@ -1093,7 +1173,7 @@ 2005-03-30 Marcelo Toledo - * FOR-RELEASE (Documentation): Added check the Emacs Tutorial. + * FOR-RELEASE (Documentation): Add check the Emacs Tutorial. The first line of every tutorial must begin with a sentence saying "Emacs Tutorial" in the respective language. This should be followed by "See end for copying conditions", likewise in the diff --git a/admin/admin.el b/admin/admin.el index 9fcc5795d21..6d729214bd0 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -62,7 +62,7 @@ Root must be the root of an Emacs source tree." (set-version-in-file root "README" version (rx (and "version" (1+ space) (submatch (1+ (in "0-9.")))))) - (set-version-in-file root "configure.in" version + (set-version-in-file root "configure.ac" version (rx (and "AC_INIT" (1+ (not (in ?,))) ?, (0+ space) (submatch (1+ (in "0-9.")))))) diff --git a/admin/bzrmerge.el b/admin/bzrmerge.el index 15238f44d9d..977e95860e2 100644 --- a/admin/bzrmerge.el +++ b/admin/bzrmerge.el @@ -24,8 +24,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) ; assert +(eval-when-compile (require 'cl-lib)) (defvar bzrmerge-skip-regexp "back[- ]?port\\|merge\\|sync\\|re-?generate\\|bump version\\|from trunk\\|\ @@ -139,17 +138,17 @@ Type `y' to skip this revision, `N' to include it and go on to the next revision, `n' to not skip, but continue to search this log entry for skip regexps, `q' to quit merging.")) - (case (save-excursion + (pcase (save-excursion (read-char-choice (format "%s: Skip (y/n/N/q/%s)? " str (key-description (vector help-char))) '(?y ?n ?N ?q))) - (?y (setq skip t)) - (?q (keyboard-quit)) + (`?y (setq skip t)) + (`?q (keyboard-quit)) ;; A single log entry can match skip-regexp multiple ;; times. If you are sure you don't want to skip it, ;; you don't want to be asked multiple times. - (?N (setq skip 'no)))))) + (`?N (setq skip 'no)))))) (if (eq skip t) (push revno skipped) (push revno revnos))))) @@ -256,17 +255,17 @@ Does not make other difference." ;; Do a "skip" (i.e. merge the meta-data only). (setq beg (1- (car skip))) (while (and skip (or (null merge) (< (car skip) (car merge)))) - (assert (> (car skip) (or end beg))) + (cl-assert (> (car skip) (or end beg))) (setq end (pop skip))) (message "Skipping %s..%s" beg end) (bzrmerge-add-metadata from end)) (t ;; Do a "normal" merge. - (assert (or (null skip) (< (car merge) (car skip)))) + (cl-assert (or (null skip) (< (car merge) (car skip)))) (setq beg (1- (car merge))) (while (and merge (or (null skip) (< (car merge) (car skip)))) - (assert (> (car merge) (or end beg))) + (cl-assert (> (car merge) (or end beg))) (setq end (pop merge))) (message "Merging %s..%s" beg end) (if (with-temp-buffer diff --git a/admin/coccinelle/README b/admin/coccinelle/README new file mode 100644 index 00000000000..48a88dbc8d8 --- /dev/null +++ b/admin/coccinelle/README @@ -0,0 +1,3 @@ +This directory contains semantic patches for Coccinelle, a program matching +and transformation tool for programs written in C. For more details, see +http://coccinelle.lip6.fr. diff --git a/admin/coccinelle/build_string.cocci b/admin/coccinelle/build_string.cocci new file mode 100644 index 00000000000..d47727018dd --- /dev/null +++ b/admin/coccinelle/build_string.cocci @@ -0,0 +1,6 @@ +// Convert simple cases to build_string. +@@ +identifier I; +@@ +- make_string (I, strlen (I)) ++ build_string (I) diff --git a/admin/coccinelle/list_loop.cocci b/admin/coccinelle/list_loop.cocci new file mode 100644 index 00000000000..89f0bfff7b3 --- /dev/null +++ b/admin/coccinelle/list_loop.cocci @@ -0,0 +1,19 @@ +// Omit redundant type check, consistently use CONSP. +@@ +identifier A; +expression X; +statement S; +@@ +( +for (A = X; +- !NILP (A); ++ CONSP (A); +- A = Fcdr (A)) ++ A = XCDR (A)) +S +| +for (A = X; CONSP (A); +- A = Fcdr (A)) ++ A = XCDR (A)) +S +) diff --git a/admin/coccinelle/unibyte_string.cocci b/admin/coccinelle/unibyte_string.cocci new file mode 100644 index 00000000000..0ff8cafa15d --- /dev/null +++ b/admin/coccinelle/unibyte_string.cocci @@ -0,0 +1,6 @@ +// make_unibyte_string (str, strlen (str)) -> build_unibyte_string (str) +@@ +identifier I; +@@ +- make_unibyte_string (I, strlen (I)) ++ build_unibyte_string (I) diff --git a/admin/coccinelle/vector_contents.cocci b/admin/coccinelle/vector_contents.cocci new file mode 100644 index 00000000000..3c696ffd237 --- /dev/null +++ b/admin/coccinelle/vector_contents.cocci @@ -0,0 +1,16 @@ +// Avoid direct access to `contents' member of +// Lisp_Vector, use AREF and ASET where possible. +@expression@ +identifier I1, I2; +expression E1, E2; +@@ +( +- XVECTOR (I1)->contents[I2++] = E1 ++ ASET (I1, I2, E1), I2++ +| +- XVECTOR (I1)->contents[E1] = E2 ++ ASET (I1, E1, E2) +| +- XVECTOR (I1)->contents[E1] ++ AREF (I1, E1) +) diff --git a/admin/coccinelle/xzalloc.cocci b/admin/coccinelle/xzalloc.cocci new file mode 100644 index 00000000000..5d3ba990266 --- /dev/null +++ b/admin/coccinelle/xzalloc.cocci @@ -0,0 +1,10 @@ +@@ +expression x; +expression E; +@@ + x = +- xmalloc ++ xzalloc + (E) + ... +- memset (x, 0, E); diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 7f91b788f40..727b701cfe0 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -26,18 +26,22 @@ GNULIB_URL=git://git.savannah.gnu.org/gnulib.git GNULIB_MODULES=' - alloca-opt + alloca-opt c-strcase careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 - dtoastr dup2 - filemode getloadavg getopt-gnu ignore-value intprops largefile lstat - manywarnings mktime pthread_sigmask readlink - socklen stdarg stdio strftime strtoimax strtoumax symlink sys_stat + dtoastr dtotimespec dup2 + filemode getloadavg getopt-gnu gettime gettimeofday + ignore-value intprops largefile lstat + manywarnings mktime pselect pthread_sigmask readlink + socklen stat-time stdarg stdio strftime strtoimax strtoumax symlink sys_stat + sys_time time timespec-add timespec-sub utimens warnings ' GNULIB_TOOL_FLAGS=' + --avoid=errno --avoid=fcntl --avoid=fcntl-h --avoid=fstat --avoid=msvc-inval --avoid=msvc-nothrow - --avoid=raise --avoid=threadlib + --avoid=raise --avoid=select --avoid=sigprocmask --avoid=sys_types + --avoid=threadlib --conditional-dependencies --import --no-changelog --no-vc-files --makefile-name=gnulib.mk ' diff --git a/admin/notes/bugtracker b/admin/notes/bugtracker index 3c24212ea10..7d5e85a3ae0 100644 --- a/admin/notes/bugtracker +++ b/admin/notes/bugtracker @@ -125,7 +125,7 @@ Resent-CC: maintainer email address, plus any X-Debbugs-CC: entries The "maintainer email address" is "bug-gnu-emacs@gnu.org" in most cases. -** To not get acknowledgement mail from the tracker, +** To not get acknowledgment mail from the tracker, add an "X-Debbugs-No-Ack:" header (with any value). If you use Gnus, you can add an element to gnus-posting-styles to do this automatically, eg: diff --git a/admin/notes/multi-tty b/admin/notes/multi-tty index 4146c8ffa58..5408b9a3d00 100644 --- a/admin/notes/multi-tty +++ b/admin/notes/multi-tty @@ -906,7 +906,7 @@ DIARY OF CHANGES read_avail_input. (Fixed. This was caused by unconditionally including stdin in - input_wait_mask in init_process. The select call in + input_wait_mask in init_process_emacs. The select call in wait_reading_process_input always returned immediately, indicating that there is pending input from stdin, which nobody read. diff --git a/admin/quick-install-emacs b/admin/quick-install-emacs index 7004e8f1b27..4abef102dc4 100755 --- a/admin/quick-install-emacs +++ b/admin/quick-install-emacs @@ -171,9 +171,9 @@ test x"$prefix" = x && { prefix="`get_config_var prefix`" || exit 4 ; } test x"$ARCH" = x && { ARCH="`get_config_var host`" || exit 4 ; } VERSION=` - sed -n 's/^AC_INIT(emacs,[ ]*\([^ )]*\).*/\1/p' <$SRC/configure.in + sed -n 's/^AC_INIT(emacs,[ ]*\([^ )]*\).*/\1/p' <$SRC/configure.ac ` || exit 4 -test -n "$VERSION" || { echo >&2 "$me: no version in configure.in"; exit 4; } +test -n "$VERSION" || { echo >&2 "$me: no version in configure.ac"; exit 4; } DST_SHARE="$prefix/share/emacs/$VERSION" DST_BIN="$prefix/bin" diff --git a/autogen.sh b/autogen.sh index fb5917fbbf7..0c92047e469 100755 --- a/autogen.sh +++ b/autogen.sh @@ -34,7 +34,7 @@ progs="autoconf automake" ## Minimum versions we need: -autoconf_min=`sed -n 's/^ *AC_PREREQ(\([0-9\.]*\)).*/\1/p' configure.in` +autoconf_min=`sed -n 's/^ *AC_PREREQ(\([0-9\.]*\)).*/\1/p' configure.ac` ## FIXME how to determine this from the sources? automake_min=1.11 diff --git a/autogen/Makefile.in b/autogen/Makefile.in index b450729ac0d..4808d7aa179 100644 --- a/autogen/Makefile.in +++ b/autogen/Makefile.in @@ -36,7 +36,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=build-aux --avoid=msvc-inval --avoid=msvc-nothrow --avoid=raise --avoid=threadlib --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 largefile lstat manywarnings mktime pthread_sigmask readlink socklen stdarg stdio strftime strtoimax strtoumax symlink sys_stat warnings +# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=errno --avoid=fcntl --avoid=fcntl-h --avoid=fstat --avoid=msvc-inval --avoid=msvc-nothrow --avoid=raise --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt c-strcase careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 filemode getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings mktime pselect pthread_sigmask readlink socklen stat-time stdarg stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timespec-add timespec-sub utimens warnings VPATH = @srcdir@ pkgdatadir = $(datadir)/@PACKAGE@ @@ -64,9 +64,11 @@ subdir = lib ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 am__aclocal_m4_deps = $(top_srcdir)/m4/00gnulib.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/gnulib-common.m4 \ + $(top_srcdir)/m4/clock_time.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/gettime.m4 $(top_srcdir)/m4/gettimeofday.m4 \ + $(top_srcdir)/m4/gnulib-common.m4 \ $(top_srcdir)/m4/gnulib-comp.m4 \ $(top_srcdir)/m4/include_next.m4 $(top_srcdir)/m4/inttypes.m4 \ $(top_srcdir)/m4/largefile.m4 $(top_srcdir)/m4/longlong.m4 \ @@ -74,24 +76,28 @@ am__aclocal_m4_deps = $(top_srcdir)/m4/00gnulib.m4 \ $(top_srcdir)/m4/md5.m4 $(top_srcdir)/m4/mktime.m4 \ $(top_srcdir)/m4/multiarch.m4 $(top_srcdir)/m4/nocrash.m4 \ $(top_srcdir)/m4/off_t.m4 $(top_srcdir)/m4/pathmax.m4 \ + $(top_srcdir)/m4/pselect.m4 \ $(top_srcdir)/m4/pthread_sigmask.m4 \ $(top_srcdir)/m4/readlink.m4 $(top_srcdir)/m4/sha1.m4 \ $(top_srcdir)/m4/sha256.m4 $(top_srcdir)/m4/sha512.m4 \ - $(top_srcdir)/m4/signal_h.m4 \ - $(top_srcdir)/m4/signalblocking.m4 $(top_srcdir)/m4/socklen.m4 \ + $(top_srcdir)/m4/signal_h.m4 $(top_srcdir)/m4/socklen.m4 \ $(top_srcdir)/m4/ssize_t.m4 $(top_srcdir)/m4/st_dm_mode.m4 \ - $(top_srcdir)/m4/stat.m4 $(top_srcdir)/m4/stdalign.m4 \ - $(top_srcdir)/m4/stdarg.m4 $(top_srcdir)/m4/stdbool.m4 \ - $(top_srcdir)/m4/stddef_h.m4 $(top_srcdir)/m4/stdint.m4 \ - $(top_srcdir)/m4/stdio_h.m4 $(top_srcdir)/m4/stdlib_h.m4 \ - $(top_srcdir)/m4/strftime.m4 $(top_srcdir)/m4/strtoimax.m4 \ - $(top_srcdir)/m4/strtoll.m4 $(top_srcdir)/m4/strtoull.m4 \ - $(top_srcdir)/m4/strtoumax.m4 $(top_srcdir)/m4/symlink.m4 \ - $(top_srcdir)/m4/sys_stat_h.m4 $(top_srcdir)/m4/sys_types_h.m4 \ + $(top_srcdir)/m4/stat-time.m4 $(top_srcdir)/m4/stat.m4 \ + $(top_srcdir)/m4/stdalign.m4 $(top_srcdir)/m4/stdarg.m4 \ + $(top_srcdir)/m4/stdbool.m4 $(top_srcdir)/m4/stddef_h.m4 \ + $(top_srcdir)/m4/stdint.m4 $(top_srcdir)/m4/stdio_h.m4 \ + $(top_srcdir)/m4/stdlib_h.m4 $(top_srcdir)/m4/strftime.m4 \ + $(top_srcdir)/m4/strtoimax.m4 $(top_srcdir)/m4/strtoll.m4 \ + $(top_srcdir)/m4/strtoull.m4 $(top_srcdir)/m4/strtoumax.m4 \ + $(top_srcdir)/m4/symlink.m4 $(top_srcdir)/m4/sys_select_h.m4 \ + $(top_srcdir)/m4/sys_socket_h.m4 \ + $(top_srcdir)/m4/sys_stat_h.m4 $(top_srcdir)/m4/sys_time_h.m4 \ $(top_srcdir)/m4/time_h.m4 $(top_srcdir)/m4/time_r.m4 \ - $(top_srcdir)/m4/tm_gmtoff.m4 $(top_srcdir)/m4/unistd_h.m4 \ + $(top_srcdir)/m4/timespec.m4 $(top_srcdir)/m4/tm_gmtoff.m4 \ + $(top_srcdir)/m4/unistd_h.m4 $(top_srcdir)/m4/utimbuf.m4 \ + $(top_srcdir)/m4/utimens.m4 $(top_srcdir)/m4/utimes.m4 \ $(top_srcdir)/m4/warnings.m4 $(top_srcdir)/m4/wchar_t.m4 \ - $(top_srcdir)/configure.in + $(top_srcdir)/configure.ac am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ $(ACLOCAL_M4) mkinstalldirs = $(install_sh) -d @@ -101,13 +107,19 @@ CONFIG_CLEAN_VPATH_FILES = LIBRARIES = $(noinst_LIBRARIES) libgnu_a_AR = $(AR) $(ARFLAGS) am__DEPENDENCIES_1 = -am__libgnu_a_SOURCES_DIST = allocator.c careadlinkat.c md5.c sha1.c \ - sha256.c sha512.c dtoastr.c filemode.c gettext.h strftime.c +am__libgnu_a_SOURCES_DIST = allocator.c c-ctype.h c-ctype.c \ + c-strcase.h c-strcasecmp.c c-strncasecmp.c careadlinkat.c \ + md5.c sha1.c sha256.c sha512.c dtoastr.c dtotimespec.c \ + filemode.c gettext.h gettime.c strftime.c timespec-add.c \ + timespec-sub.c utimens.c am__objects_1 = -am_libgnu_a_OBJECTS = allocator.$(OBJEXT) careadlinkat.$(OBJEXT) \ - md5.$(OBJEXT) sha1.$(OBJEXT) sha256.$(OBJEXT) sha512.$(OBJEXT) \ - dtoastr.$(OBJEXT) filemode.$(OBJEXT) $(am__objects_1) \ - strftime.$(OBJEXT) +am_libgnu_a_OBJECTS = allocator.$(OBJEXT) c-ctype.$(OBJEXT) \ + c-strcasecmp.$(OBJEXT) c-strncasecmp.$(OBJEXT) \ + careadlinkat.$(OBJEXT) md5.$(OBJEXT) sha1.$(OBJEXT) \ + sha256.$(OBJEXT) sha512.$(OBJEXT) dtoastr.$(OBJEXT) \ + dtotimespec.$(OBJEXT) filemode.$(OBJEXT) $(am__objects_1) \ + gettime.$(OBJEXT) strftime.$(OBJEXT) timespec-add.$(OBJEXT) \ + timespec-sub.$(OBJEXT) utimens.$(OBJEXT) libgnu_a_OBJECTS = $(am_libgnu_a_OBJECTS) depcomp = $(SHELL) $(top_srcdir)/build-aux/depcomp am__depfiles_maybe = depfiles @@ -232,6 +244,7 @@ GNULIB_GETLOGIN = @GNULIB_GETLOGIN@ GNULIB_GETLOGIN_R = @GNULIB_GETLOGIN_R@ GNULIB_GETPAGESIZE = @GNULIB_GETPAGESIZE@ GNULIB_GETSUBOPT = @GNULIB_GETSUBOPT@ +GNULIB_GETTIMEOFDAY = @GNULIB_GETTIMEOFDAY@ GNULIB_GETUSERSHELL = @GNULIB_GETUSERSHELL@ GNULIB_GL_UNISTD_H_GETOPT = @GNULIB_GL_UNISTD_H_GETOPT@ GNULIB_GRANTPT = @GNULIB_GRANTPT@ @@ -270,6 +283,7 @@ GNULIB_POSIX_OPENPT = @GNULIB_POSIX_OPENPT@ GNULIB_PREAD = @GNULIB_PREAD@ GNULIB_PRINTF = @GNULIB_PRINTF@ GNULIB_PRINTF_POSIX = @GNULIB_PRINTF_POSIX@ +GNULIB_PSELECT = @GNULIB_PSELECT@ GNULIB_PTHREAD_SIGMASK = @GNULIB_PTHREAD_SIGMASK@ GNULIB_PTSNAME = @GNULIB_PTSNAME@ GNULIB_PTSNAME_R = @GNULIB_PTSNAME_R@ @@ -292,6 +306,7 @@ GNULIB_RENAMEAT = @GNULIB_RENAMEAT@ GNULIB_RMDIR = @GNULIB_RMDIR@ GNULIB_RPMATCH = @GNULIB_RPMATCH@ GNULIB_SCANF = @GNULIB_SCANF@ +GNULIB_SELECT = @GNULIB_SELECT@ GNULIB_SETENV = @GNULIB_SETENV@ GNULIB_SETHOSTNAME = @GNULIB_SETHOSTNAME@ GNULIB_SIGACTION = @GNULIB_SIGACTION@ @@ -398,6 +413,7 @@ HAVE_GETLOGIN = @HAVE_GETLOGIN@ HAVE_GETOPT_H = @HAVE_GETOPT_H@ HAVE_GETPAGESIZE = @HAVE_GETPAGESIZE@ HAVE_GETSUBOPT = @HAVE_GETSUBOPT@ +HAVE_GETTIMEOFDAY = @HAVE_GETTIMEOFDAY@ HAVE_GRANTPT = @HAVE_GRANTPT@ HAVE_GROUP_MEMBER = @HAVE_GROUP_MEMBER@ HAVE_INTTYPES_H = @HAVE_INTTYPES_H@ @@ -427,6 +443,7 @@ HAVE_POPEN = @HAVE_POPEN@ HAVE_POSIX_OPENPT = @HAVE_POSIX_OPENPT@ HAVE_POSIX_SIGNALBLOCKING = @HAVE_POSIX_SIGNALBLOCKING@ HAVE_PREAD = @HAVE_PREAD@ +HAVE_PSELECT = @HAVE_PSELECT@ HAVE_PTHREAD_SIGMASK = @HAVE_PTHREAD_SIGMASK@ HAVE_PTSNAME = @HAVE_PTSNAME@ HAVE_PTSNAME_R = @HAVE_PTSNAME_R@ @@ -457,12 +474,15 @@ HAVE_STRTOLL = @HAVE_STRTOLL@ HAVE_STRTOULL = @HAVE_STRTOULL@ HAVE_STRUCT_RANDOM_DATA = @HAVE_STRUCT_RANDOM_DATA@ HAVE_STRUCT_SIGACTION_SA_SIGACTION = @HAVE_STRUCT_SIGACTION_SA_SIGACTION@ +HAVE_STRUCT_TIMEVAL = @HAVE_STRUCT_TIMEVAL@ HAVE_SYMLINK = @HAVE_SYMLINK@ HAVE_SYMLINKAT = @HAVE_SYMLINKAT@ HAVE_SYS_BITYPES_H = @HAVE_SYS_BITYPES_H@ HAVE_SYS_INTTYPES_H = @HAVE_SYS_INTTYPES_H@ HAVE_SYS_LOADAVG_H = @HAVE_SYS_LOADAVG_H@ HAVE_SYS_PARAM_H = @HAVE_SYS_PARAM_H@ +HAVE_SYS_SELECT_H = @HAVE_SYS_SELECT_H@ +HAVE_SYS_TIME_H = @HAVE_SYS_TIME_H@ HAVE_SYS_TYPES_H = @HAVE_SYS_TYPES_H@ HAVE_TIMEGM = @HAVE_TIMEGM@ HAVE_TYPE_VOLATILE_SIG_ATOMIC_T = @HAVE_TYPE_VOLATILE_SIG_ATOMIC_T@ @@ -476,6 +496,7 @@ HAVE_VASPRINTF = @HAVE_VASPRINTF@ HAVE_VDPRINTF = @HAVE_VDPRINTF@ HAVE_WCHAR_H = @HAVE_WCHAR_H@ HAVE_WCHAR_T = @HAVE_WCHAR_T@ +HAVE_WINSOCK2_H = @HAVE_WINSOCK2_H@ HAVE_XSERVER = @HAVE_XSERVER@ HAVE__BOOL = @HAVE__BOOL@ HAVE__EXIT = @HAVE__EXIT@ @@ -532,6 +553,7 @@ LIBXSM = @LIBXSM@ LIBXTR6 = @LIBXTR6@ LIBXT_OTHER = @LIBXT_OTHER@ LIBX_OTHER = @LIBX_OTHER@ +LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@ LIB_GCC = @LIB_GCC@ LIB_MATH = @LIB_MATH@ LIB_PTHREAD = @LIB_PTHREAD@ @@ -552,8 +574,9 @@ NEXT_AS_FIRST_DIRECTIVE_STDDEF_H = @NEXT_AS_FIRST_DIRECTIVE_STDDEF_H@ NEXT_AS_FIRST_DIRECTIVE_STDINT_H = @NEXT_AS_FIRST_DIRECTIVE_STDINT_H@ NEXT_AS_FIRST_DIRECTIVE_STDIO_H = @NEXT_AS_FIRST_DIRECTIVE_STDIO_H@ NEXT_AS_FIRST_DIRECTIVE_STDLIB_H = @NEXT_AS_FIRST_DIRECTIVE_STDLIB_H@ +NEXT_AS_FIRST_DIRECTIVE_SYS_SELECT_H = @NEXT_AS_FIRST_DIRECTIVE_SYS_SELECT_H@ NEXT_AS_FIRST_DIRECTIVE_SYS_STAT_H = @NEXT_AS_FIRST_DIRECTIVE_SYS_STAT_H@ -NEXT_AS_FIRST_DIRECTIVE_SYS_TYPES_H = @NEXT_AS_FIRST_DIRECTIVE_SYS_TYPES_H@ +NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_H = @NEXT_AS_FIRST_DIRECTIVE_SYS_TIME_H@ NEXT_AS_FIRST_DIRECTIVE_TIME_H = @NEXT_AS_FIRST_DIRECTIVE_TIME_H@ NEXT_AS_FIRST_DIRECTIVE_UNISTD_H = @NEXT_AS_FIRST_DIRECTIVE_UNISTD_H@ NEXT_GETOPT_H = @NEXT_GETOPT_H@ @@ -564,8 +587,9 @@ NEXT_STDDEF_H = @NEXT_STDDEF_H@ NEXT_STDINT_H = @NEXT_STDINT_H@ NEXT_STDIO_H = @NEXT_STDIO_H@ NEXT_STDLIB_H = @NEXT_STDLIB_H@ +NEXT_SYS_SELECT_H = @NEXT_SYS_SELECT_H@ NEXT_SYS_STAT_H = @NEXT_SYS_STAT_H@ -NEXT_SYS_TYPES_H = @NEXT_SYS_TYPES_H@ +NEXT_SYS_TIME_H = @NEXT_SYS_TIME_H@ NEXT_TIME_H = @NEXT_TIME_H@ NEXT_UNISTD_H = @NEXT_UNISTD_H@ NS_OBJ = @NS_OBJ@ @@ -626,6 +650,7 @@ REPLACE_GETGROUPS = @REPLACE_GETGROUPS@ REPLACE_GETLINE = @REPLACE_GETLINE@ REPLACE_GETLOGIN_R = @REPLACE_GETLOGIN_R@ REPLACE_GETPAGESIZE = @REPLACE_GETPAGESIZE@ +REPLACE_GETTIMEOFDAY = @REPLACE_GETTIMEOFDAY@ REPLACE_ISATTY = @REPLACE_ISATTY@ REPLACE_LCHOWN = @REPLACE_LCHOWN@ REPLACE_LINK = @REPLACE_LINK@ @@ -647,6 +672,7 @@ REPLACE_PERROR = @REPLACE_PERROR@ REPLACE_POPEN = @REPLACE_POPEN@ REPLACE_PREAD = @REPLACE_PREAD@ REPLACE_PRINTF = @REPLACE_PRINTF@ +REPLACE_PSELECT = @REPLACE_PSELECT@ REPLACE_PTHREAD_SIGMASK = @REPLACE_PTHREAD_SIGMASK@ REPLACE_PTSNAME_R = @REPLACE_PTSNAME_R@ REPLACE_PUTENV = @REPLACE_PUTENV@ @@ -661,6 +687,7 @@ REPLACE_REMOVE = @REPLACE_REMOVE@ REPLACE_RENAME = @REPLACE_RENAME@ REPLACE_RENAMEAT = @REPLACE_RENAMEAT@ REPLACE_RMDIR = @REPLACE_RMDIR@ +REPLACE_SELECT = @REPLACE_SELECT@ REPLACE_SETENV = @REPLACE_SETENV@ REPLACE_SLEEP = @REPLACE_SLEEP@ REPLACE_SNPRINTF = @REPLACE_SNPRINTF@ @@ -670,6 +697,7 @@ REPLACE_STDIO_READ_FUNCS = @REPLACE_STDIO_READ_FUNCS@ REPLACE_STDIO_WRITE_FUNCS = @REPLACE_STDIO_WRITE_FUNCS@ REPLACE_STRTOD = @REPLACE_STRTOD@ REPLACE_STRTOIMAX = @REPLACE_STRTOIMAX@ +REPLACE_STRUCT_TIMEVAL = @REPLACE_STRUCT_TIMEVAL@ REPLACE_SYMLINK = @REPLACE_SYMLINK@ REPLACE_TIMEGM = @REPLACE_TIMEGM@ REPLACE_TMPFILE = @REPLACE_TMPFILE@ @@ -797,6 +825,7 @@ psdir = @psdir@ sbindir = @sbindir@ sharedstatedir = @sharedstatedir@ srcdir = @srcdir@ +standardlisppath = @standardlisppath@ sysconfdir = @sysconfdir@ target_alias = @target_alias@ top_build_prefix = @top_build_prefix@ @@ -817,43 +846,47 @@ x_default_search_path = @x_default_search_path@ BUILT_SOURCES = $(ALLOCA_H) $(GETOPT_H) inttypes.h signal.h \ arg-nonnull.h c++defs.h warn-on-use.h $(STDALIGN_H) \ $(STDARG_H) $(STDBOOL_H) $(STDDEF_H) $(STDINT_H) stdio.h \ - stdlib.h sys/stat.h sys/types.h time.h unistd.h + stdlib.h sys/select.h sys/stat.h sys/time.h time.h unistd.h EXTRA_DIST = alloca.in.h allocator.h careadlinkat.h md5.h sha1.h \ sha256.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 pathmax.h pthread_sigmask.c \ - readlink.c signal.in.h sigprocmask.c \ + getopt_int.h gettimeofday.c ignore-value.h intprops.h \ + inttypes.in.h lstat.c mktime-internal.h mktime.c pathmax.h \ + pselect.c pthread_sigmask.c readlink.c signal.in.h \ $(top_srcdir)/build-aux/snippet/_Noreturn.h \ $(top_srcdir)/build-aux/snippet/arg-nonnull.h \ $(top_srcdir)/build-aux/snippet/c++defs.h \ $(top_srcdir)/build-aux/snippet/warn-on-use.h stat.c \ - stdalign.in.h stdarg.in.h stdbool.in.h stddef.in.h stdint.in.h \ - stdio.in.h stdlib.in.h strftime.h strtoimax.c strtol.c \ - strtoll.c strtol.c strtoul.c strtoull.c strtoimax.c \ - strtoumax.c symlink.c sys_stat.in.h sys_types.in.h time.in.h \ - time_r.c u64.h unistd.in.h verify.h -MOSTLYCLEANDIRS = sys + stat-time.h stdalign.in.h stdarg.in.h stdbool.in.h stddef.in.h \ + stdint.in.h stdio.in.h stdlib.in.h strftime.h strtoimax.c \ + strtol.c strtoll.c strtol.c strtoul.c strtoull.c strtoimax.c \ + strtoumax.c symlink.c sys_select.in.h sys_stat.in.h \ + sys_time.in.h time.in.h time_r.c timespec.h u64.h unistd.in.h \ + utimens.h verify.h +MOSTLYCLEANDIRS = sys sys MOSTLYCLEANFILES = core *.stackdump alloca.h alloca.h-t getopt.h \ getopt.h-t inttypes.h inttypes.h-t signal.h signal.h-t \ arg-nonnull.h arg-nonnull.h-t c++defs.h c++defs.h-t \ warn-on-use.h warn-on-use.h-t stdalign.h stdalign.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 sys/types.h sys/types.h-t time.h time.h-t \ - unistd.h unistd.h-t + stdint.h-t stdio.h stdio.h-t stdlib.h stdlib.h-t sys/select.h \ + sys/select.h-t sys/stat.h sys/stat.h-t sys/time.h sys/time.h-t \ + time.h time.h-t unistd.h unistd.h-t noinst_LIBRARIES = libgnu.a AM_CFLAGS = $(GNULIB_WARN_CFLAGS) $(WERROR_CFLAGS) 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_SOURCES = allocator.c c-ctype.h c-ctype.c c-strcase.h \ + c-strcasecmp.c c-strncasecmp.c careadlinkat.c md5.c sha1.c \ + sha256.c sha512.c dtoastr.c dtotimespec.c filemode.c \ + $(am__append_1) gettime.c strftime.c timespec-add.c \ + timespec-sub.c utimens.c libgnu_a_LIBADD = $(gl_LIBOBJS) libgnu_a_DEPENDENCIES = $(gl_LIBOBJS) EXTRA_libgnu_a_SOURCES = ftoastr.c dup2.c getloadavg.c getopt.c \ - getopt1.c lstat.c mktime.c pthread_sigmask.c readlink.c \ - sigprocmask.c stat.c strtoimax.c strtol.c strtoll.c strtol.c \ - strtoul.c strtoull.c strtoimax.c strtoumax.c symlink.c \ - time_r.c + getopt1.c gettimeofday.c lstat.c mktime.c pselect.c \ + pthread_sigmask.c readlink.c stat.c strtoimax.c strtol.c \ + strtoll.c strtol.c strtoul.c strtoull.c strtoimax.c \ + strtoumax.c symlink.c time_r.c # Because this Makefile snippet defines a variable used by other # gnulib Makefile snippets, it must be present in all Makefile.am that @@ -912,23 +945,29 @@ distclean-compile: -rm -f *.tab.c @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/allocator.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c-ctype.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c-strcasecmp.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c-strncasecmp.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)/dtotimespec.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@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getopt.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getopt1.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gettime.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gettimeofday.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/lstat.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/md5.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mktime.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pselect.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pthread_sigmask.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/readlink.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sha1.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sha256.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sha512.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sigprocmask.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/stat.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strftime.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strtoimax.Po@am__quote@ @@ -939,6 +978,9 @@ distclean-compile: @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strtoumax.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/symlink.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/time_r.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/timespec-add.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/timespec-sub.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/utimens.Po@am__quote@ .c.o: @am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< @@ -1580,6 +1622,30 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \ } > $@-t && \ mv $@-t $@ +# We need the following in order to create when the system +# doesn't have one that works with the given compiler. +sys/select.h: sys_select.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(WARN_ON_USE_H) + $(AM_V_at)$(MKDIR_P) sys + $(AM_V_GEN)rm -f $@-t $@ && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ + -e 's|@''NEXT_SYS_SELECT_H''@|$(NEXT_SYS_SELECT_H)|g' \ + -e 's|@''HAVE_SYS_SELECT_H''@|$(HAVE_SYS_SELECT_H)|g' \ + -e 's/@''GNULIB_PSELECT''@/$(GNULIB_PSELECT)/g' \ + -e 's/@''GNULIB_SELECT''@/$(GNULIB_SELECT)/g' \ + -e 's|@''HAVE_WINSOCK2_H''@|$(HAVE_WINSOCK2_H)|g' \ + -e 's|@''HAVE_PSELECT''@|$(HAVE_PSELECT)|g' \ + -e 's|@''REPLACE_PSELECT''@|$(REPLACE_PSELECT)|g' \ + -e 's|@''REPLACE_SELECT''@|$(REPLACE_SELECT)|g' \ + -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \ + -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \ + < $(srcdir)/sys_select.in.h; \ + } > $@-t && \ + mv $@-t $@ + # We need the following in order to create when the system # has one that is incomplete. sys/stat.h: sys_stat.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) @@ -1632,19 +1698,28 @@ sys/stat.h: sys_stat.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNU } > $@-t && \ mv $@-t $@ -# We need the following in order to create when the system +# We need the following in order to create when the system # doesn't have one that works with the given compiler. -sys/types.h: sys_types.in.h $(top_builddir)/config.status +sys/time.h: sys_time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) $(AM_V_at)$(MKDIR_P) sys $(AM_V_GEN)rm -f $@-t $@ && \ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's/@''HAVE_SYS_TIME_H''@/$(HAVE_SYS_TIME_H)/g' \ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ - -e 's|@''NEXT_SYS_TYPES_H''@|$(NEXT_SYS_TYPES_H)|g' \ - -e 's|@''WINDOWS_64_BIT_OFF_T''@|$(WINDOWS_64_BIT_OFF_T)|g' \ - < $(srcdir)/sys_types.in.h; \ + -e 's|@''NEXT_SYS_TIME_H''@|$(NEXT_SYS_TIME_H)|g' \ + -e 's/@''GNULIB_GETTIMEOFDAY''@/$(GNULIB_GETTIMEOFDAY)/g' \ + -e 's|@''HAVE_WINSOCK2_H''@|$(HAVE_WINSOCK2_H)|g' \ + -e 's/@''HAVE_GETTIMEOFDAY''@/$(HAVE_GETTIMEOFDAY)/g' \ + -e 's/@''HAVE_STRUCT_TIMEVAL''@/$(HAVE_STRUCT_TIMEVAL)/g' \ + -e 's/@''REPLACE_GETTIMEOFDAY''@/$(REPLACE_GETTIMEOFDAY)/g' \ + -e 's/@''REPLACE_STRUCT_TIMEVAL''@/$(REPLACE_STRUCT_TIMEVAL)/g' \ + -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \ + -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \ + -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \ + < $(srcdir)/sys_time.in.h; \ } > $@-t && \ mv $@-t $@ diff --git a/autogen/aclocal.m4 b/autogen/aclocal.m4 index 8ce488aa6c8..cc09901d05a 100644 --- a/autogen/aclocal.m4 +++ b/autogen/aclocal.m4 @@ -987,11 +987,14 @@ AC_SUBST([am__untar]) m4_include([m4/00gnulib.m4]) m4_include([m4/alloca.m4]) m4_include([m4/c-strtod.m4]) +m4_include([m4/clock_time.m4]) m4_include([m4/dup2.m4]) m4_include([m4/extensions.m4]) m4_include([m4/filemode.m4]) m4_include([m4/getloadavg.m4]) m4_include([m4/getopt.m4]) +m4_include([m4/gettime.m4]) +m4_include([m4/gettimeofday.m4]) m4_include([m4/gnulib-common.m4]) m4_include([m4/gnulib-comp.m4]) m4_include([m4/include_next.m4]) @@ -1006,16 +1009,17 @@ m4_include([m4/multiarch.m4]) m4_include([m4/nocrash.m4]) m4_include([m4/off_t.m4]) m4_include([m4/pathmax.m4]) +m4_include([m4/pselect.m4]) m4_include([m4/pthread_sigmask.m4]) m4_include([m4/readlink.m4]) m4_include([m4/sha1.m4]) m4_include([m4/sha256.m4]) m4_include([m4/sha512.m4]) m4_include([m4/signal_h.m4]) -m4_include([m4/signalblocking.m4]) m4_include([m4/socklen.m4]) m4_include([m4/ssize_t.m4]) m4_include([m4/st_dm_mode.m4]) +m4_include([m4/stat-time.m4]) m4_include([m4/stat.m4]) m4_include([m4/stdalign.m4]) m4_include([m4/stdarg.m4]) @@ -1030,11 +1034,17 @@ m4_include([m4/strtoll.m4]) m4_include([m4/strtoull.m4]) m4_include([m4/strtoumax.m4]) m4_include([m4/symlink.m4]) +m4_include([m4/sys_select_h.m4]) +m4_include([m4/sys_socket_h.m4]) m4_include([m4/sys_stat_h.m4]) -m4_include([m4/sys_types_h.m4]) +m4_include([m4/sys_time_h.m4]) m4_include([m4/time_h.m4]) m4_include([m4/time_r.m4]) +m4_include([m4/timespec.m4]) m4_include([m4/tm_gmtoff.m4]) m4_include([m4/unistd_h.m4]) +m4_include([m4/utimbuf.m4]) +m4_include([m4/utimens.m4]) +m4_include([m4/utimes.m4]) m4_include([m4/warnings.m4]) m4_include([m4/wchar_t.m4]) diff --git a/autogen/config.in b/autogen/config.in index 02d359653f4..5f5052c5205 100644 --- a/autogen/config.in +++ b/autogen/config.in @@ -1,4 +1,4 @@ -/* src/config.in. Generated from configure.in by autoheader. */ +/* src/config.in. Generated from configure.ac by autoheader. */ /* GNU Emacs site configuration template file. @@ -46,29 +46,81 @@ along with GNU Emacs. If not, see . */ /* Define to the number of bits in type 'wint_t'. */ #undef BITSIZEOF_WINT_T -/* Define if SA_RESTART should not be used. */ +/* Define if FIONREAD should not be used. */ +#undef BROKEN_FIONREAD + +/* Define if get_current_dir_name should not be used. */ +#undef BROKEN_GET_CURRENT_DIR_NAME + +/* Define on FreeBSD to work around an issue when reading from a PTY. */ +#undef BROKEN_PTY_READ_AFTER_EAGAIN + +/* Define if SA_RESTART should only be used in batch mode. */ #undef BROKEN_SA_RESTART +/* Define if SIGAIO should not be used. */ +#undef BROKEN_SIGAIO + /* Define if SIGIO should not be used. */ #undef BROKEN_SIGIO +/* Define if SIGPOLL should not be used. */ +#undef BROKEN_SIGPOLL + +/* Define if SIGPTY should not be used. */ +#undef BROKEN_SIGPTY + +/* Define if the system is compatible with BSD 4.2. */ +#undef BSD4_2 + +/* Define if the system is compatible with BSD 4.2. */ +#undef BSD_SYSTEM + +/* Define if AH_BOTTOM should change BSD_SYSTEM. */ +#undef BSD_SYSTEM_AHB + /* Define if Emacs cannot be dumped on your system. */ #undef CANNOT_DUMP /* Define this to enable compile time checks for the Lisp_Object data type. */ #undef CHECK_LISP_OBJECT_TYPE +/* Define if you want lock files to be written, so that Emacs can tell + instantly when you try to modify a file that someone else has modified in + his/her Emacs. */ +#undef CLASH_DETECTION + /* 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. */ #undef CRAY_STACKSEG_END +/* Define if the system is Cygwin. */ +#undef CYGWIN + /* Define to 1 if using 'alloca.c'. */ #undef C_ALLOCA +/* Define if the system is Darwin. */ +#undef DARWIN_OS + +/* Extra bits to be or'd in with any pointers stored in a Lisp_Object. */ +#undef DATA_SEG_BITS + +/* Address of the start of the data segment. */ +#undef DATA_START + +/* Name of the default sound device. */ +#undef DEFAULT_SOUND_DEVICE + /* Define to 1 for DGUX with . */ #undef DGUX +/* Define if process.c does not need to close a pty to make it a controlling + terminal (it is already a controlling terminal of the subprocess, because + we did ioctl TIOCSCTTY). */ +#undef DONT_REOPEN_PTY + /* Define to 1 if you are using the GNU C Library. */ #undef DOUG_LEA_MALLOC @@ -78,9 +130,17 @@ along with GNU Emacs. If not, see . */ /* Define to the options passed to configure. */ #undef EMACS_CONFIG_OPTIONS -/* Enable expensive run-time checking of data types? */ +/* Define to 1 if expensive run-time data type and consistency checks are + enabled. */ #undef ENABLE_CHECKING +/* Letter to use in finding device name of first PTY, if PTYs are supported. + */ +#undef FIRST_PTY_LETTER + +/* Define to 1 if futimesat mishandles a NULL file name. */ +#undef FUTIMESAT_NULL_BUG + /* Define this to check for errors in cons list. */ #undef GC_CHECK_CONS_LIST @@ -95,18 +155,54 @@ along with GNU Emacs. If not, see . */ /* Define this to check for short string overrun. */ #undef GC_CHECK_STRING_OVERRUN +/* Mark a secondary stack, like the register stack on the ia64. */ +#undef GC_MARK_SECONDARY_STACK + +/* Define to GC_USE_GCPROS_AS_BEFORE if conservative garbage collection is not + known to work. */ +#undef GC_MARK_STACK + +/* Define if setjmp is known to save all registers relevant for conservative + garbage collection in the jmp_buf. */ +#undef GC_SETJMP_WORKS + /* Define to 1 if the `getpgrp' function requires zero arguments. */ #undef GETPGRP_VOID -/* Define to 1 if gettimeofday accepts only one argument. */ -#undef GETTIMEOFDAY_ONE_ARGUMENT +/* Define if gettimeofday clobbers the localtime buffer. */ +#undef GETTIMEOFDAY_CLOBBERS_LOCALTIME + +/* Define this to 'void' or 'struct timezone' to match the system's + declaration of the second argument to gettimeofday. */ +#undef GETTIMEOFDAY_TIMEZONE + +/* Define this to enable glyphs debugging code. */ +#undef GLYPH_DEBUG + +/* Define to a C preprocessor expression that evaluates to 1 or 0, depending + whether the gnulib module fscanf shall be considered present. */ +#undef GNULIB_FSCANF /* enable some gnulib portability checks */ #undef GNULIB_PORTCHECK +/* Define to a C preprocessor expression that evaluates to 1 or 0, depending + whether the gnulib module scanf shall be considered present. */ +#undef GNULIB_SCANF + +/* Value of PENDING_OUTPUT_COUNT if using the GNU C library. */ +#undef GNU_LIBRARY_PENDING_OUTPUT_COUNT + +/* Define if ths system is compatible with GNU/Linux. */ +#undef GNU_LINUX + /* Define to 1 if you want to use the GNU memory allocator. */ #undef GNU_MALLOC +/* Define to set the G_SLICE environment variable to "always-malloc" at + startup, if using GTK. */ +#undef G_SLICE_ALWAYS_MALLOC + /* Define to 1 if the file /usr/lpp/X11/bin/smt.exp exists. */ #undef HAVE_AIX_SMT_EXP @@ -139,6 +235,12 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the `cfsetspeed' function. */ #undef HAVE_CFSETSPEED +/* Define to 1 if you have the `clock_gettime' function. */ +#undef HAVE_CLOCK_GETTIME + +/* Define to 1 if you have the `clock_settime' function. */ +#undef HAVE_CLOCK_SETTIME + /* Define to 1 if you have the `closedir' function. */ #undef HAVE_CLOSEDIR @@ -263,6 +365,15 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the `fsync' function. */ #undef HAVE_FSYNC +/* Define to 1 if you have the `futimens' function. */ +#undef HAVE_FUTIMENS + +/* Define to 1 if you have the `futimes' function. */ +#undef HAVE_FUTIMES + +/* Define to 1 if you have the `futimesat' function. */ +#undef HAVE_FUTIMESAT + /* Define to 1 if you have the `gai_strerror' function. */ #undef HAVE_GAI_STRERROR @@ -522,6 +633,9 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the `lstat' function. */ #undef HAVE_LSTAT +/* Define to 1 if you have the `lutimes' function. */ +#undef HAVE_LUTIMES + /* Define to 1 if using libm17n-flt. */ #undef HAVE_M17N_FLT @@ -554,9 +668,6 @@ along with GNU Emacs. If not, see . */ systems that support xmenu.c. */ #undef HAVE_MENUS -/* Define to 1 if you have the `mkdir' function. */ -#undef HAVE_MKDIR - /* Define to 1 if you have the `mkstemp' function. */ #undef HAVE_MKSTEMP @@ -566,6 +677,9 @@ along with GNU Emacs. If not, see . */ /* Define if you have mouse support. */ #undef HAVE_MOUSE +/* Define to 1 if you have the `nanotime' function. */ +#undef HAVE_NANOTIME + /* Define to 1 if you have the header file. */ #undef HAVE_NET_IF_DL_H @@ -597,6 +711,9 @@ along with GNU Emacs. If not, see . */ /* Define if you have the /proc filesystem. */ #undef HAVE_PROCFS +/* Define to 1 if you have the `pselect' function. */ +#undef HAVE_PSELECT + /* Define to 1 if you have the `pstat_getdynamic' function. */ #undef HAVE_PSTAT_GETDYNAMIC @@ -609,6 +726,9 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if the pthread_sigmask function can be used (despite bugs). */ #undef HAVE_PTHREAD_SIGMASK +/* Define if the system supports pty devices. */ +#undef HAVE_PTYS + /* Define to 1 if you have the header file. */ #undef HAVE_PTY_H @@ -627,18 +747,12 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the `recvfrom' function. */ #undef HAVE_RECVFROM -/* Define to 1 if you have the `rename' function. */ -#undef HAVE_RENAME - /* Define to 1 if res_init is available. */ #undef HAVE_RES_INIT /* Define to 1 if you have the `rint' function. */ #undef HAVE_RINT -/* Define to 1 if you have the `rmdir' function. */ -#undef HAVE_RMDIR - /* Define to 1 if using librsvg. */ #undef HAVE_RSVG @@ -681,6 +795,9 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the `snprintf' function. */ #undef HAVE_SNPRINTF +/* Define if the system supports 4.2-compatible sockets. */ +#undef HAVE_SOCKETS + /* Define to 1 if you have sound support. */ #undef HAVE_SOUND @@ -699,9 +816,6 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the header file. */ #undef HAVE_STDLIB_H -/* Define to 1 if you have the `strerror' function. */ -#undef HAVE_STRERROR - /* Define to 1 if you have the header file. */ #undef HAVE_STRINGS_H @@ -744,10 +858,32 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if `n_un.n_name' is a member of `struct nlist'. */ #undef HAVE_STRUCT_NLIST_N_UN_N_NAME +/* Define to 1 if `st_atimensec' is a member of `struct stat'. */ +#undef HAVE_STRUCT_STAT_ST_ATIMENSEC + +/* Define to 1 if `st_atimespec.tv_nsec' is a member of `struct stat'. */ +#undef HAVE_STRUCT_STAT_ST_ATIMESPEC_TV_NSEC + +/* Define to 1 if `st_atim.st__tim.tv_nsec' is a member of `struct stat'. */ +#undef HAVE_STRUCT_STAT_ST_ATIM_ST__TIM_TV_NSEC + +/* Define to 1 if `st_atim.tv_nsec' is a member of `struct stat'. */ +#undef HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC + +/* Define to 1 if `st_birthtimensec' is a member of `struct stat'. */ +#undef HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC + +/* Define to 1 if `st_birthtimespec.tv_nsec' is a member of `struct stat'. */ +#undef HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC + +/* Define to 1 if `st_birthtim.tv_nsec' is a member of `struct stat'. */ +#undef HAVE_STRUCT_STAT_ST_BIRTHTIM_TV_NSEC + /* Define to 1 if `tm_zone' is a member of `struct tm'. */ #undef HAVE_STRUCT_TM_TM_ZONE -/* Define to 1 if `struct utimbuf' is declared by . */ +/* Define if struct utimbuf is declared -- usually in . Some systems + have utime.h but don't declare the struct anywhere. */ #undef HAVE_STRUCT_UTIMBUF /* Define if struct stat has an st_dm_mode member. */ @@ -789,6 +925,9 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the header file. */ #undef HAVE_SYS_SYSTEMINFO_H +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_TIMEB_H + /* Define to 1 if you have the header file. */ #undef HAVE_SYS_TIME_H @@ -813,9 +952,6 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the tiff library (-ltiff). */ #undef HAVE_TIFF -/* Define to 1 if `struct timeval' is declared by . */ -#undef HAVE_TIMEVAL - /* Define if struct tm has the tm_gmtoff member. */ #undef HAVE_TM_GMTOFF @@ -842,6 +978,9 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the header file. */ #undef HAVE_UTIL_H +/* Define to 1 if you have the `utimensat' function. */ +#undef HAVE_UTIMENSAT + /* Define to 1 if you have the `utimes' function. */ #undef HAVE_UTIMES @@ -866,9 +1005,15 @@ along with GNU Emacs. If not, see . */ /* Define if you have a window system. */ #undef HAVE_WINDOW_SYSTEM +/* Define to 1 if you have the header file. */ +#undef HAVE_WINSOCK2_H + /* Define to 1 if `fork' works. */ #undef HAVE_WORKING_FORK +/* Define if utimes works properly. */ +#undef HAVE_WORKING_UTIMES + /* Define to 1 if `vfork' works. */ #undef HAVE_WORKING_VFORK @@ -924,6 +1069,9 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if the system has the type `_Bool'. */ #undef HAVE__BOOL +/* Define to 1 if you have the `_ftime' function. */ +#undef HAVE__FTIME + /* Define to 1 if you have the `__builtin_unwind_init' function. */ #undef HAVE___BUILTIN_UNWIND_INIT @@ -936,6 +1084,15 @@ along with GNU Emacs. If not, see . */ /* Define to support using a Hesiod database to find the POP server. */ #undef HESIOD +/* Define if the system is HPUX. */ +#undef HPUX + +/* Define to read input using SIGIO. */ +#undef INTERRUPT_INPUT + +/* Define if the system is IRIX. */ +#undef IRIX6_5 + /* Define to support Kerberos-authenticated POP mail retrieval. */ #undef KERBEROS @@ -967,6 +1124,16 @@ along with GNU Emacs. If not, see . */ /* Define to support POP mail retrieval. */ #undef MAIL_USE_POP +/* Define if system's imake configuration file defines `NeedWidePrototypes' as + `NO'. */ +#undef NARROWPROTO + +/* Do not define abort in emacs.c. */ +#undef NO_ABORT + +/* Define if XEditRes should not be used. */ +#undef NO_EDITRES + /* Define to 1 if you don't have struct exception in math.h. */ #undef NO_MATHERR @@ -976,6 +1143,9 @@ along with GNU Emacs. If not, see . */ /* Define if termio.h should not be included. */ #undef NO_TERMIO +/* Minimum value of NSIG. */ +#undef NSIG_MINIMUM + /* Define to 1 if `NSInteger' is defined. */ #undef NS_HAVE_NSINTEGER @@ -1012,6 +1182,17 @@ along with GNU Emacs. If not, see . */ /* Define to the version of this package. */ #undef PACKAGE_VERSION +/* Number of chars of output in the buffer of a stdio stream. */ +#undef PENDING_OUTPUT_COUNT + +/* Define to empty to suppress deprecation warnings when building with + --enable-gcc-warnings and with libpng versions before 1.5, which lack + png_longjmp. */ +#undef PNG_DEPSTRUCT + +/* Define if process_send_signal should use VSUSP instead of VSWTCH. */ +#undef PREFER_VSUSP + /* Define to 1 if pthread_sigmask(), when it fails, returns -1 and sets errno. */ #undef PTHREAD_SIGMASK_FAILS_WITH_ERRNO @@ -1026,6 +1207,18 @@ along with GNU Emacs. If not, see . */ 'ptrdiff_t'. */ #undef PTRDIFF_T_SUFFIX +/* How to iterate over PTYs. */ +#undef PTY_ITERATION + +/* How to get the device name of the control end of a PTY, if non-standard. */ +#undef PTY_NAME_SPRINTF + +/* How to open a PTY, if non-standard. */ +#undef PTY_OPEN + +/* How to get device name of the tty end of a PTY, if non-standard. */ +#undef PTY_TTY_NAME_SPRINTF + /* Define to 1 if readlink fails to recognize a trailing slash. */ #undef READLINK_TRAILING_SLASH_BUG @@ -1041,6 +1234,18 @@ along with GNU Emacs. If not, see . */ slash */ #undef REPLACE_FUNC_STAT_FILE +/* Define if emacs.c needs to call run_time_remap; for HPUX. */ +#undef RUN_TIME_REMAP + +/* Define if process.c:child_setup should not call setpgrp. */ +#undef SETPGRP_RELEASES_CTTY + +/* How to set up a slave PTY, if needed. */ +#undef SETUP_SLAVE_PTY + +/* Make process_send_signal work by "typing" a signal character on the pty. */ +#undef SIGNALS_VIA_CHARACTERS + /* Define to l, ll, u, ul, ull, etc., as suitable for constants of type 'sig_atomic_t'. */ #undef SIG_ATOMIC_T_SUFFIX @@ -1049,6 +1254,9 @@ along with GNU Emacs. If not, see . */ 'size_t'. */ #undef SIZE_T_SUFFIX +/* Define if the system is Solaris. */ +#undef SOLARIS2 + /* 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. @@ -1075,6 +1283,12 @@ along with GNU Emacs. If not, see . */ /* The type of system you are compiling for; sets `system-type'. */ #undef SYSTEM_TYPE +/* Undocumented. */ +#undef TAB3 + +/* Undocumented. */ +#undef TABDLY + /* Define to 1 if you use terminfo instead of termcap. */ #undef TERMINFO @@ -1084,6 +1298,13 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if your declares `struct tm'. */ #undef TM_IN_SYS_TIME +/* Define to 1 if the type of the st_atim member of a struct stat is struct + timespec. */ +#undef TYPEOF_STRUCT_STAT_ST_ATIM_IS_STRUCT_TIMESPEC + +/* Undocumented. */ +#undef ULIMIT_BREAK_VALUE + /* Define to 1 for Encore UMAX. */ #undef UMAX @@ -1091,6 +1312,9 @@ along with GNU Emacs. If not, see . */ . */ #undef UMAX4_3 +/* Define if the system has Unix98 PTYs. */ +#undef UNIX98_PTYS + /* Define to 1 if using GTK. */ #undef USE_GTK @@ -1112,6 +1336,12 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if using an X toolkit. */ #undef USE_X_TOOLKIT +/* Define if the system is compatible with System III. */ +#undef USG + +/* Define if the system is compatible with System V. */ +#undef USG5 + /* Define for USG systems where it works to open a pty's tty in the parent process, then close and reopen it in the child. */ #undef USG_SUBTTY_WORKS @@ -1145,10 +1375,16 @@ along with GNU Emacs. If not, see . */ /* Define this to check for malloc buffer overrun. */ #undef XMALLOC_OVERRUN_CHECK +/* Compensate for a bug in Xos.h on some systems, where it requires time.h. */ +#undef XOS_NEEDS_TIME_H + /* Define to the type of the 6th arg of XRegisterIMInstantiateCallback, either XPointer or XPointer*. */ #undef XRegisterIMInstantiateCallback_arg6 +/* Define if the system is AIX. */ +#undef _AIX + /* Enable large inode numbers on Mac OS X. */ #ifndef _DARWIN_USE_64_BIT_INODE # define _DARWIN_USE_64_BIT_INODE 1 @@ -1207,7 +1443,7 @@ along with GNU Emacs. If not, see . */ #ifndef _ALL_SOURCE # undef _ALL_SOURCE #endif -/* Enable general extensions on MacOS X. */ +/* Enable general extensions on Mac OS X. */ #ifndef _DARWIN_C_SOURCE # undef _DARWIN_C_SOURCE #endif @@ -1243,6 +1479,9 @@ along with GNU Emacs. If not, see . */ /* A replacement for va_copy, if needed. */ #define gl_va_copy(a,b) ((a) = (b)) +/* Define to rpl_gmtime if the replacement function should be used. */ +#undef gmtime + /* Define to `__inline__' or `__inline' if that's what the C compiler calls it, or to nothing if 'inline' is not supported under any name. */ #ifndef __cplusplus @@ -1252,7 +1491,7 @@ along with GNU Emacs. If not, see . */ /* Work around a bug in Apple GCC 4.0.1 build 5465: In C99 mode, it supports the ISO C 99 semantics of 'extern inline' (unlike the GNU C semantics of earlier versions), but does not display it by setting __GNUC_STDC_INLINE__. - __APPLE__ && __MACH__ test for MacOS X. + __APPLE__ && __MACH__ test for Mac OS X. __APPLE_CC__ tests for the Apple compiler and its version. __STDC_VERSION__ tests for the C99 mode. */ #if defined __APPLE__ && defined __MACH__ && __APPLE_CC__ >= 5465 && !defined __cplusplus && __STDC_VERSION__ >= 199901L && !defined __GNUC_STDC_INLINE__ @@ -1262,6 +1501,9 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if the compiler is checking for lint. */ #undef lint +/* Define to rpl_localtime if the replacement function should be used. */ +#undef localtime + /* Define to a type if does not define. */ #undef mbstate_t @@ -1340,6 +1582,19 @@ along with GNU Emacs. If not, see . */ # error "alloca not available on this machine" #endif +/* This silences a few compilation warnings on FreeBSD. */ +#ifdef BSD_SYSTEM_AHB +#undef BSD_SYSTEM_AHB +#undef BSD_SYSTEM +#if __FreeBSD__ == 1 +#define BSD_SYSTEM 199103 +#elif __FreeBSD__ == 2 +#define BSD_SYSTEM 199306 +#elif __FreeBSD__ >= 3 +#define BSD_SYSTEM 199506 +#endif +#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. */ @@ -1358,13 +1613,14 @@ along with GNU Emacs. If not, see . */ # include config_opsysfile #endif -/* GNUstep needs a bit more pure memory. Of the existing knobs, - SYSTEM_PURESIZE_EXTRA seems like the least likely to cause problems. - (There is probably a better place to do this, but right now the - Cocoa side does this in s/darwin.h and we cannot parallel this - exactly since GNUstep is multi-OS. */ -#if defined HAVE_NS && defined NS_IMPL_GNUSTEP +/* Mac OS X / GNUstep need a bit more pure memory. Of the existing knobs, + SYSTEM_PURESIZE_EXTRA seems like the least likely to cause problems. */ +#ifdef HAVE_NS +#if defined NS_IMPL_GNUSTEP # define SYSTEM_PURESIZE_EXTRA 30000 +#elif defined DARWIN_OS +# define SYSTEM_PURESIZE_EXTRA 200000 +#endif #endif #ifdef emacs /* Don't do this for lib-src. */ @@ -1383,13 +1639,6 @@ along with GNU Emacs. If not, see . */ #include #include -#if defined __GNUC__ && (__GNUC__ > 2 \ - || (__GNUC__ == 2 && __GNUC_MINOR__ >= 5)) -#define NO_RETURN __attribute__ ((__noreturn__)) -#else -#define NO_RETURN /* nothing */ -#endif - #if __GNUC__ >= 3 /* On GCC 3.0 we might get a warning. */ #define NO_INLINE __attribute__((noinline)) #else @@ -1416,20 +1665,13 @@ along with GNU Emacs. If not, see . */ ATTRIBUTE_FORMAT ((__printf__, formatstring_parameter, first_argument)) #endif +#define ATTRIBUTE_CONST _GL_ATTRIBUTE_CONST + /* Some versions of GNU/Linux define noinline in their headers. */ #ifdef noinline #undef noinline #endif -/* These won't be used automatically yet. We also need to know, at least, - that the stack is continuous. */ -#ifdef __GNUC__ -# ifndef GC_SETJMP_WORKS - /* GC_SETJMP_WORKS is nearly always appropriate for GCC. */ -# define GC_SETJMP_WORKS 1 -# endif -#endif - #endif /* EMACS_CONFIG_H */ /* diff --git a/autogen/copy_autogen b/autogen/copy_autogen index c9f04ad6253..b6af9b6eb35 100755 --- a/autogen/copy_autogen +++ b/autogen/copy_autogen @@ -3,7 +3,7 @@ ## Helper script for those building Emacs from bzr without autoconf etc. ## This installs some pre-generated versions of the automatically ## generated files. It is highly recommended to install the necessary -## tools instead of using this. Note that if eg configure.in +## tools instead of using this. Note that if eg configure.ac ## is updated, the next time you run make it will attempt to ## regenerate configure and will fail if you do not have the required ## tools. You will have to run this script again. diff --git a/autogen/update_autogen b/autogen/update_autogen index 58e3838f8c1..14a4119087e 100755 --- a/autogen/update_autogen +++ b/autogen/update_autogen @@ -79,7 +79,7 @@ lboot_flag= ## Parameters. ldefs_in=lisp/loaddefs.el ldefs_out=lisp/ldefs-boot.el -sources="configure.in lib/Makefile.am" +sources="configure.ac lib/Makefile.am" genfiles=" configure aclocal.m4 src/config.in lib/Makefile.in build-aux/compile build-aux/config.guess build-aux/config.sub diff --git a/configure.in b/configure.ac similarity index 80% rename from configure.in rename to configure.ac index c929b757bdd..2b47decb177 100644 --- a/configure.in +++ b/configure.ac @@ -38,9 +38,10 @@ dnl (autoconf) Installation Directory Variables dnl See also epaths.h below. lispdir='${datadir}/emacs/${version}/lisp' leimdir='${datadir}/emacs/${version}/leim' +standardlisppath='${lispdir}:${leimdir}' locallisppath='${datadir}/emacs/${version}/site-lisp:'\ '${datadir}/emacs/site-lisp' -lisppath='${locallisppath}:${lispdir}:${datadir}/emacs/${version}/leim' +lisppath='${locallisppath}:${standardlisppath}' etcdir='${datadir}/emacs/${version}/etc' archlibdir='${libexecdir}/emacs/${version}/${configuration}' docdir='${datadir}/emacs/${version}/etc' @@ -232,11 +233,6 @@ AC_ARG_ENABLE(ns-self-contained, EN_NS_SELF_CONTAINED=$enableval, EN_NS_SELF_CONTAINED=yes) -AC_ARG_ENABLE(asserts, -[AS_HELP_STRING([--enable-asserts], [compile code with asserts enabled])], - USE_XASSERTS=$enableval, - USE_XASSERTS=no) - AC_ARG_ENABLE(locallisppath, [AS_HELP_STRING([--enable-locallisppath=PATH], [directories Emacs should search for lisp files specific @@ -253,7 +249,7 @@ AC_ARG_ENABLE(checking, enable only specific categories of checks. Categories are: all,yes,no. Flags are: stringbytes, stringoverrun, stringfreelist, - xmallocoverrun, conslist])], + xmallocoverrun, conslist, glyphs])], [ac_checking_flags="${enableval}"],[]) IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS="$IFS," for check in $ac_checking_flags @@ -266,19 +262,22 @@ do ac_gc_check_string_overrun= ; ac_gc_check_string_free_list= ; ac_xmalloc_overrun= ; - ac_gc_check_cons_list= ;; + ac_gc_check_cons_list= ; + ac_glyphs_debug= ;; all) ac_enable_checking=1 ; ac_gc_check_stringbytes=1 ; ac_gc_check_string_overrun=1 ; ac_gc_check_string_free_list=1 ; ac_xmalloc_overrun=1 ; - ac_gc_check_cons_list=1 ;; + ac_gc_check_cons_list=1 ; + ac_glyphs_debug=1 ;; # these enable particular checks stringbytes) ac_gc_check_stringbytes=1 ;; stringoverrun) ac_gc_check_string_overrun=1 ;; stringfreelist) ac_gc_check_string_free_list=1 ;; xmallocoverrun) ac_xmalloc_overrun=1 ;; conslist) ac_gc_check_cons_list=1 ;; + glyphs) ac_glyphs_debug=1 ;; *) AC_MSG_ERROR(unknown check category $check) ;; esac done @@ -286,7 +285,7 @@ IFS="$ac_save_IFS" if test x$ac_enable_checking != x ; then AC_DEFINE(ENABLE_CHECKING, 1, -[Enable expensive run-time checking of data types?]) +[Define to 1 if expensive run-time data type and consistency checks are enabled.]) fi if test x$ac_gc_check_stringbytes != x ; then AC_DEFINE(GC_CHECK_STRING_BYTES, 1, @@ -310,6 +309,10 @@ if test x$ac_gc_check_cons_list != x ; then AC_DEFINE(GC_CHECK_CONS_LIST, 1, [Define this to check for errors in cons list.]) fi +if test x$ac_glyphs_debug != x ; then + AC_DEFINE(GLYPH_DEBUG, 1, +[Define this to enable glyphs debugging code.]) +fi AC_ARG_ENABLE(check-lisp-object-type, [AS_HELP_STRING([--enable-check-lisp-object-type], @@ -574,7 +577,9 @@ gl_EARLY AC_ARG_ENABLE([gcc-warnings], [AS_HELP_STRING([--enable-gcc-warnings], - [turn on lots of GCC warnings (for developers)])], + [turn on lots of GCC warnings. This is intended for + developers, and may generate false alarms when used + with older or non-GNU development tools.])], [case $enableval in yes|no) ;; *) AC_MSG_ERROR([bad value $enableval for gcc-warnings option]) ;; @@ -583,6 +588,32 @@ AC_ARG_ENABLE([gcc-warnings], [gl_gcc_warnings=no] ) +AC_ARG_ENABLE(link-time-optimization, +[AS_HELP_STRING([--enable-link-time-optimization], + [build emacs with link-time optimization. + This is supported only for GCC since 4.5.0.])], +if test "${enableval}" != "no"; then + AC_MSG_CHECKING([whether link-time optimization is supported]) + ac_lto_supported=no + if test x$GCC = xyes; then + CPUS=`getconf _NPROCESSORS_ONLN 2>/dev/null` + if test x$CPUS != x; then + LTO="-flto=$CPUS" + else + LTO="-flto" + fi + old_CFLAGS=$CFLAGS + CFLAGS="$CFLAGS $LTO" + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[]])], + [ac_lto_supported=yes], [ac_lto_supported=no]) + CFLAGS="$old_CFLAGS" + fi + AC_MSG_RESULT([$ac_lto_supported]) + if test "$ac_lto_supported" = "yes"; then + CFLAGS="$CFLAGS $LTO" + fi +fi) + # gl_GCC_VERSION_IFELSE([major], [minor], [run-if-found], [run-if-not-found]) # ------------------------------------------------ # If $CPP is gcc-MAJOR.MINOR or newer, then run RUN-IF-FOUND. @@ -633,16 +664,19 @@ else nw="$nw -Wsign-conversion" # Too many warnings for now nw="$nw -Woverlength-strings" # Not a problem these days nw="$nw -Wtraditional-conversion" # Too many warnings for now + nw="$nw -Wunreachable-code" # so buggy that it's now silently ignored nw="$nw -Wpadded" # Our structs are not padded - nw="$nw -Wredundant-decls" # We regularly (re)declare getenv etc. + nw="$nw -Wredundant-decls" # we regularly (re)declare functions nw="$nw -Wlogical-op" # any use of fwrite provokes this - nw="$nw -Wformat-nonliteral" # Emacs does this a lot + nw="$nw -Wformat-nonliteral" # we do this a lot nw="$nw -Wvla" # warnings in gettext.h nw="$nw -Wnested-externs" # use of XARGMATCH/verify_function__ nw="$nw -Wswitch-enum" # Too many warnings for now nw="$nw -Wswitch-default" # Too many warnings for now - nw="$nw -Wfloat-equal" # e.g., ftoastr.c - nw="$nw -Winline" # e.g., dispnew.c's inlining of row_equal_p + nw="$nw -Wfloat-equal" # warns about high-quality code + nw="$nw -Winline" # OK to ignore 'inline' + nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning + nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations # Emacs doesn't care about shadowing; see # . @@ -651,7 +685,6 @@ else # The following lines should be removable at some point. nw="$nw -Wstack-protector" nw="$nw -Wstrict-overflow" - nw="$nw -Wsuggest-attribute=const" nw="$nw -Wsuggest-attribute=pure" gl_MANYWARN_ALL_GCC([ws]) @@ -701,9 +734,11 @@ AC_PATH_PROG(INSTALL_INFO, install-info, :, $PATH$PATH_SEPARATOR/usr/sbin$PATH_SEPARATOR/sbin) dnl Don't use GZIP, which is used by gzip for additional parameters. AC_PATH_PROG(GZIP_PROG, gzip) -AC_PATH_PROG(PAXCTL, paxctl,, - [$PATH$PATH_SEPARATOR/sbin$PATH_SEPARATOR/usr/sbin]) +if test $opsys = gnu-linux; then + AC_PATH_PROG(PAXCTL, paxctl,, + [$PATH$PATH_SEPARATOR/sbin$PATH_SEPARATOR/usr/sbin]) +fi ## Need makeinfo >= 4.7 (?) to build the manuals. AC_PATH_PROG(MAKEINFO, makeinfo, no) @@ -1071,6 +1106,9 @@ case $opsys in esac +pre_PKG_CONFIG_CFLAGS=$CFLAGS +pre_PKG_CONFIG_LIBS=$LIBS + AC_PATH_PROG(PKG_CONFIG, pkg-config, no) dnl This function definition taken from Gnome 2.0 @@ -1181,7 +1219,6 @@ fi dnl checks for header files AC_CHECK_HEADERS_ONCE( - sys/select.h sys/time.h utime.h linux/version.h sys/systeminfo.h stdio_ext.h fcntl.h coff.h pty.h sys/vlimit.h sys/resource.h @@ -1213,26 +1250,6 @@ if test $ac_cv_have_decl_sys_siglist != yes; then fi AC_HEADER_SYS_WAIT -dnl Some systems have utime.h but don't declare the struct anyplace. -AC_CACHE_CHECK(for struct utimbuf, emacs_cv_struct_utimbuf, -AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#ifdef TIME_WITH_SYS_TIME -#include -#include -#else -#ifdef HAVE_SYS_TIME_H -#include -#else -#include -#endif -#endif -#ifdef HAVE_UTIME_H -#include -#endif]], [[static struct utimbuf x; x.actime = x.modtime;]])], - emacs_cv_struct_utimbuf=yes, emacs_cv_struct_utimbuf=no)) -if test $emacs_cv_struct_utimbuf = yes; then - AC_DEFINE(HAVE_STRUCT_UTIMBUF, 1, [Define to 1 if `struct utimbuf' is declared by .]) -fi - dnl Check for speed_t typedef. AC_CACHE_CHECK(for speed_t, emacs_cv_speed_t, [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], [[speed_t x = 1;]])], @@ -1242,29 +1259,14 @@ if test $emacs_cv_speed_t = yes; then [Define to 1 if `speed_t' is declared by .]) fi -AC_CACHE_CHECK(for struct timeval, emacs_cv_struct_timeval, -AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#ifdef TIME_WITH_SYS_TIME -#include -#include -#else -#ifdef HAVE_SYS_TIME_H -#include -#else -#include -#endif -#endif]], [[static struct timeval x; x.tv_sec = x.tv_usec;]])], - emacs_cv_struct_timeval=yes, emacs_cv_struct_timeval=no)) -HAVE_TIMEVAL=$emacs_cv_struct_timeval -if test $emacs_cv_struct_timeval = yes; then - AC_DEFINE(HAVE_TIMEVAL, 1, [Define to 1 if `struct timeval' is declared by .]) -fi - AC_CACHE_CHECK(for struct exception, emacs_cv_struct_exception, AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], [[static struct exception x; x.arg1 = x.arg2 = x.retval; x.name = ""; x.type = 1;]])], emacs_cv_struct_exception=yes, emacs_cv_struct_exception=no)) HAVE_EXCEPTION=$emacs_cv_struct_exception -if test $emacs_cv_struct_exception != yes; then +dnl Define on Darwin so emacs symbols will not conflict with those +dnl in the System framework. Otherwise -prebind will not work. +if test $emacs_cv_struct_exception != yes || test $opsys = darwin; then AC_DEFINE(NO_MATHERR, 1, [Define to 1 if you don't have struct exception in math.h.]) fi @@ -2192,6 +2194,7 @@ dnl tranle@intellicorp.com says libXmu.a can need XtMalloc in libXt.a to link. fi AC_CHECK_LIB(Xmu, XmuConvertStandardSelection) test $ac_cv_lib_Xmu_XmuConvertStandardSelection = no && LIBS="$OLDLIBS" + dnl ac_cv_lib_Xmu_XmuConvertStandardSelection is also referenced below. fi AC_SUBST(LIBXTR6) @@ -2506,7 +2509,7 @@ if test "${HAVE_X11}" = "yes"; then if test "${with_png}" != "no"; then # Debian unstable as of July 2003 has multiple libpngs, and puts png.h # in /usr/include/libpng. - AC_CHECK_HEADERS(png.h libpng/png.h) + AC_CHECK_HEADERS(png.h libpng/png.h, break) if test "$ac_cv_header_png_h" = yes || test "$ac_cv_header_libpng_png_h" = yes ; then AC_CHECK_LIB(png, png_get_channels, HAVE_PNG=yes, , -lz -lm) fi @@ -2515,6 +2518,19 @@ if test "${HAVE_X11}" = "yes"; then if test "${HAVE_PNG}" = "yes"; then AC_DEFINE(HAVE_PNG, 1, [Define to 1 if you have the png library (-lpng).]) LIBPNG="-lpng -lz -lm" + + AC_CHECK_DECL(png_longjmp, + [], + [AC_DEFINE(PNG_DEPSTRUCT, [], + [Define to empty to suppress deprecation warnings when building + with --enable-gcc-warnings and with libpng versions before 1.5, + which lack png_longjmp.])], + [[#ifdef HAVE_LIBPNG_PNG_H + # include + #else + # include + #endif + ]]) fi fi AC_SUBST(LIBPNG) @@ -2751,11 +2767,11 @@ esac AC_SUBST(BLESSMAIL_TARGET) -AC_CHECK_FUNCS_ONCE(gethostname \ -rename closedir mkdir rmdir getrusage get_current_dir_name \ -random lrand48 logb frexp fmod rint cbrt setsid \ -strerror fpathconf select euidaccess getpagesize setlocale \ -utimes getrlimit setrlimit setpgid getcwd getwd shutdown getaddrinfo \ +AC_CHECK_FUNCS(gethostname \ +closedir getrusage get_current_dir_name \ +lrand48 logb frexp fmod cbrt setsid \ +fpathconf select euidaccess getpagesize setlocale \ +utimes getrlimit setrlimit setpgid getcwd shutdown getaddrinfo \ __fpending strsignal setitimer \ sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \ gai_strerror mkstemp getline getdelim fsync sync \ @@ -2764,6 +2780,25 @@ getpwent endpwent getgrent endgrent \ touchlock \ cfmakeraw cfsetspeed copysign __executable_start) +dnl FIXME Fragile: something else may test for getwd as a dependency. +dnl Change to defining BROKEN_xxx ? +dnl getwd appears to be buggy on SVR4.2, so we don't use it. +if test $opsys != unixware; then + AC_CHECK_FUNCS(getwd) +fi + +dnl FIXME Fragile: see above. +## Eric Backus says, HP-UX 9.x on HP 700 machines +## has a broken `rint' in some library versions including math library +## version number A.09.05. +## You can fix the math library by installing patch number PHSS_4630. +## But we can fix it more reliably for Emacs by just not using rint. +## We also skip HAVE_RANDOM - see comments in src/s/hpux10-20.h. +case $opsys in + hpux*) : ;; + *) AC_CHECK_FUNCS(random rint) ;; +esac + dnl Cannot use AC_CHECK_FUNCS AC_CACHE_CHECK([for __builtin_unwind_init], emacs_cv_func___builtin_unwind_init, @@ -2782,10 +2817,10 @@ AC_FUNC_FSEEKO AC_FUNC_GETPGRP # UNIX98 PTYs. -AC_CHECK_FUNCS_ONCE(grantpt) +AC_CHECK_FUNCS(grantpt) # PTY-related GNU extensions. -AC_CHECK_FUNCS_ONCE(getpt) +AC_CHECK_FUNCS(getpt) # Check this now, so that we will NOT find the above functions in ncurses. # That is because we have not set up to link ncurses in lib-src. @@ -2900,33 +2935,40 @@ AC_SUBST(TERMCAP_OBJ) # Do we have res_init, for detecting changes in /etc/resolv.conf? +# On Darwin, res_init appears not to be useful: see bug#562 and +# http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01467.html resolv=no -AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include -#include -#include ]], - [[return res_init();]])], - have_res_init=yes, have_res_init=no) -if test "$have_res_init" = no; then - OLIBS="$LIBS" - LIBS="$LIBS -lresolv" - AC_MSG_CHECKING(for res_init with -lresolv) + +if test $opsys != darwin; then + AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include #include #include ]], [[return res_init();]])], have_res_init=yes, have_res_init=no) - AC_MSG_RESULT($have_res_init) - if test "$have_res_init" = yes ; then - resolv=yes + if test "$have_res_init" = no; then + OLIBS="$LIBS" + LIBS="$LIBS -lresolv" + AC_MSG_CHECKING(for res_init with -lresolv) + AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include +#include +#include ]], + [[return res_init();]])], + have_res_init=yes, have_res_init=no) + AC_MSG_RESULT($have_res_init) + if test "$have_res_init" = yes ; then + resolv=yes + fi + LIBS="$OLIBS" fi - LIBS="$OLIBS" -fi -if test "$have_res_init" = yes; then - AC_DEFINE(HAVE_RES_INIT, 1, [Define to 1 if res_init is available.]) -fi + if test "$have_res_init" = yes; then + AC_DEFINE(HAVE_RES_INIT, 1, [Define to 1 if res_init is available.]) + fi +fi dnl !darwin # Do we need the Hesiod library to provide the support routines? +dnl FIXME? Should we be skipping this on Darwin too? LIBHESIOD= if test "$with_hesiod" != no ; then # Don't set $LIBS here -- see comments above. FIXME which comments? @@ -2950,7 +2992,7 @@ fi AC_SUBST(LIBHESIOD) # Do we need libresolv (due to res_init or Hesiod)? -if test "$resolv" = yes ; then +if test "$resolv" = yes && test $opsys != darwin; then AC_DEFINE(HAVE_LIBRESOLV, 1, [Define to 1 if you have the resolv library (-lresolv).]) LIBRESOLV=-lresolv @@ -3080,33 +3122,6 @@ if test $emacs_cv_localtime_cache = yes; then [Define to 1 if localtime caches TZ.]) fi -if test "x$HAVE_TIMEVAL" = xyes; then - AC_CHECK_FUNCS(gettimeofday) - if test $ac_cv_func_gettimeofday = yes; then - AC_CACHE_CHECK(whether gettimeofday can accept two arguments, - emacs_cv_gettimeofday_two_arguments, - [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ -#ifdef TIME_WITH_SYS_TIME -#include -#include -#else -#ifdef HAVE_SYS_TIME_H -#include -#else -#include -#endif -#endif]], - [[struct timeval time; - gettimeofday (&time, 0);]])], - emacs_cv_gettimeofday_two_arguments=yes, - emacs_cv_gettimeofday_two_arguments=no)]) - if test $emacs_cv_gettimeofday_two_arguments = no; then - AC_DEFINE(GETTIMEOFDAY_ONE_ARGUMENT, 1, - [Define to 1 if gettimeofday accepts only one argument.]) - fi - fi -fi - ok_so_far=yes AC_CHECK_FUNC(socket, , ok_so_far=no) if test $ok_so_far = yes; then @@ -3136,7 +3151,7 @@ fi AC_FUNC_FORK -AC_CHECK_FUNCS_ONCE(snprintf) +AC_CHECK_FUNCS(snprintf) dnl Adapted from Haible's version. AC_CACHE_CHECK([for nl_langinfo and CODESET], emacs_cv_langinfo_codeset, @@ -3172,18 +3187,125 @@ dnl and macros for terminal control.]) dnl AC_DEFINE(HAVE_TCATTR, 1, [Define to 1 if you have tcgetattr and tcsetattr.]) dnl fi +dnl Every platform that uses configure (ie every non-MS platform) +dnl supports this. There is a create-lockfiles option you can +dnl customize if you do not want the lock files to be written. +dnl So it is not clear that this #define still needs to exist. +AC_DEFINE(CLASH_DETECTION, 1, [Define if you want lock files to be written, + so that Emacs can tell instantly when you try to modify a file that + someone else has modified in his/her Emacs.]) + +dnl Everybody supports this, except MS. +dnl Seems like the kind of thing we should be testing for, though. +## Note: PTYs are broken on darwin <6. Use at your own risk. +AC_DEFINE(HAVE_PTYS, 1, [Define if the system supports pty devices.]) + +dnl Everybody supports this, except MS-DOS. +dnl Seems like the kind of thing we should be testing for, though. +dnl Compare with HAVE_INET_SOCKETS (which is unused...) above. +AC_DEFINE(HAVE_SOCKETS, 1, [Define if the system supports + 4.2-compatible sockets.]) + + +AH_TEMPLATE(NO_EDITRES, [Define if XEditRes should not be used.]) + +case $opsys in + aix4-2) + dnl Unfortunately without libXmu we cannot support EditRes. + if test x$ac_cv_lib_Xmu_XmuConvertStandardSelection != xyes; then + AC_DEFINE(NO_EDITRES, 1) + fi + ;; + + hpux*) + dnl Assar Westerlund says this is necessary for + dnl HP-UX 10.20, and that it works for HP-UX 0 as well. + AC_DEFINE(NO_EDITRES, 1) + ;; +esac + + case $opsys in darwin | gnu | hpux* | *bsd ) AC_DEFINE(NO_TERMIO, 1, [Define if termio.h should not be included.]) - ;; + ;; + + irix6-5 | sol2* | unixware ) + dnl Some SVr4s don't define NSIG in sys/signal.h for ANSI environments; + dnl instead, there's a system variable _sys_nsig. Unfortunately, we + dnl need the constant to dimension an array. So wire in the appropriate + dnl value here. + AC_DEFINE(NSIG_MINIMUM, 32, [Minimum value of NSIG.]) + ;; esac -dnl SIGIO exists, but the feature doesn't work in the way Emacs needs. -dnl See eg . + case $opsys in + dnl SIGIO exists, but the feature doesn't work in the way Emacs needs. + dnl See eg . hpux* | irix6-5 | openbsd | sol2* | unixware ) AC_DEFINE(BROKEN_SIGIO, 1, [Define if SIGIO should not be used.]) - ;; + ;; + + aix4-2) + dnl BUILD 9008 - FIONREAD problem still exists in X-Windows. + AC_DEFINE(BROKEN_FIONREAD, 1, [Define if FIONREAD should not be used.]) + dnl As we define BROKEN_FIONREAD, SIGIO will be undefined in systty.h. + dnl But, on AIX, SIGAIO, SIGPTY, and SIGPOLL are defined as SIGIO, + dnl which causes compilation error at init_signals in sysdep.c. + dnl So, we define these macros so that syssignal.h detects them + dnl and undefine SIGAIO, SIGPTY and SIGPOLL. + AC_DEFINE(BROKEN_SIGAIO, 1, [Define if SIGAIO should not be used.]) + AC_DEFINE(BROKEN_SIGPOLL,1, [Define if SIGPOLL should not be used.]) + AC_DEFINE(BROKEN_SIGPTY, 1, [Define if SIGPTY should not be used.]) + + dnl On AIX Emacs uses the gmalloc.c malloc implementation. But given + dnl the way this system works, libc functions that return malloced + dnl memory use the libc malloc implementation. Calling xfree or + dnl xrealloc on the results of such functions results in a crash. + dnl + dnl One solution for this could be to define SYSTEM_MALLOC in configure, + dnl but that does not currently work on this system. + dnl + dnl It is possible to completely override the malloc implementation on + dnl AIX, but that involves putting the malloc functions in a shared + dnl library and setting the MALLOCTYPE environment variable to point to + dnl that shared library. + dnl + dnl Emacs currently calls xrealloc on the results of get_current_dir name, + dnl to avoid a crash just use the Emacs implementation for that function. + dnl + dnl FIXME We could change the AC_CHECK_FUNCS call near the start + dnl of this file, so that we do not check for get_current_dir_name + dnl on AIX. But that might be fragile if something else ends + dnl up testing for get_current_dir_name as a dependency. + AC_DEFINE(BROKEN_GET_CURRENT_DIR_NAME, 1, [Define if + get_current_dir_name should not be used.]) + ;; + + freebsd) + dnl Circumvent a bug in FreeBSD. In the following sequence of + dnl writes/reads on a PTY, read(2) returns bogus data: + dnl + dnl write(2) 1022 bytes + dnl write(2) 954 bytes, get EAGAIN + dnl read(2) 1024 bytes in process_read_output + dnl read(2) 11 bytes in process_read_output + dnl + dnl That is, read(2) returns more bytes than have ever been written + dnl successfully. The 1033 bytes read are the 1022 bytes written + dnl successfully after processing (for example with CRs added if the + dnl terminal is set up that way which it is here). The same bytes will + dnl be seen again in a later read(2), without the CRs. + AC_DEFINE(BROKEN_PTY_READ_AFTER_EAGAIN, 1, [Define on FreeBSD to + work around an issue when reading from a PTY.]) + ;; + + dnl Define the following so emacs symbols will not conflict with those + dnl in the System framework. Otherwise -prebind will not work. + darwin) + AC_DEFINE(NO_ABORT, 1, [Do not define abort in emacs.c.]) + ;; esac case $opsys in @@ -3194,28 +3316,531 @@ case $opsys in esac case $opsys in - gnu-kfreebsd) opsysfile="s/gnu-linux.h" ;; + darwin | freebsd | netbsd | openbsd ) + AC_DEFINE(DONT_REOPEN_PTY, 1, [Define if process.c does not need to + close a pty to make it a controlling terminal (it is already a + controlling terminal of the subprocess, because we did ioctl TIOCSCTTY).]) + ;; +esac - hpux11) - dnl SA_RESTART resets the timeout of `select', so don't use it. - AC_DEFINE(BROKEN_SA_RESTART, 1, [Define if SA_RESTART should not - be used.]) - dnl It works to open the pty's tty in the parent (Emacs), then - dnl close and reopen it in the child. - AC_DEFINE(USG_SUBTTY_WORKS, 1, [Define for USG systems where it - works to open a pty's tty in the parent process, then close and - reopen it in the child.]) +dnl FIXME Surely we can test for this rather than hard-code it. +case $opsys in + netbsd | openbsd) sound_device="/dev/audio" ;; + *) sound_device="/dev/dsp" ;; +esac - opsysfile="s/hpux10-20.h" - ;; +dnl Used in sound.c +AC_DEFINE_UNQUOTED(DEFAULT_SOUND_DEVICE, "$sound_device", + [Name of the default sound device.]) - openbsd) opsysfile="s/netbsd.h" ;; - sol2-10) - AC_DEFINE(_STRUCTURED_PROC, 1, [Needed for system_process_attributes - on Solaris.]) - opsysfile="s/sol2-6.h" - ;; +dnl Emacs can read input using SIGIO and buffering characters itself, +dnl or using CBREAK mode and making C-g cause SIGINT. +dnl The choice is controlled by the variable interrupt_input. +dnl +dnl Define INTERRUPT_INPUT to make interrupt_input = 1 the default (use SIGIO) +dnl +dnl Emacs uses the presence or absence of the SIGIO and BROKEN_SIGIO macros +dnl to indicate whether or not signal-driven I/O is possible. It uses +dnl INTERRUPT_INPUT to decide whether to use it by default. +dnl +dnl SIGIO can be used only on systems that implement it (4.2 and 4.3). +dnl CBREAK mode has two disadvantages +dnl 1) At least in 4.2, it is impossible to handle the Meta key properly. +dnl I hear that in system V this problem does not exist. +dnl 2) Control-G causes output to be discarded. +dnl I do not know whether this can be fixed in system V. +dnl +dnl Another method of doing input is planned but not implemented. +dnl It would have Emacs fork off a separate process +dnl to read the input and send it to the true Emacs process +dnl through a pipe. +case $opsys in + darwin | gnu-linux | gnu-kfreebsd ) + AC_DEFINE(INTERRUPT_INPUT, 1, [Define to read input using SIGIO.]) + ;; +esac + + +dnl If the system's imake configuration file defines `NeedWidePrototypes' +dnl as `NO', we must define NARROWPROTO manually. Such a define is +dnl generated in the Makefile generated by `xmkmf'. If we don't define +dnl NARROWPROTO, we will see the wrong function prototypes for X functions +dnl taking float or double parameters. +case $opsys in + cygwin|gnu|gnu-linux|gnu-kfreebsd|irix6-5|freebsd|netbsd|openbsd) + AC_DEFINE(NARROWPROTO, 1, [Define if system's imake configuration + file defines `NeedWidePrototypes' as `NO'.]) + ;; +esac + + +dnl Used in process.c, this must be a loop, even if it only runs once. +dnl (Except on SGI; see below. Take that, clarity and consistency!) +AH_TEMPLATE(PTY_ITERATION, [How to iterate over PTYs.]) +dnl Only used if !PTY_ITERATION. Iterate from FIRST_PTY_LETTER to z, +dnl trying suffixes 0-16. +AH_TEMPLATE(FIRST_PTY_LETTER, [Letter to use in finding device name of + first PTY, if PTYs are supported.]) +AH_TEMPLATE(PTY_OPEN, [How to open a PTY, if non-standard.]) +AH_TEMPLATE(PTY_NAME_SPRINTF, [How to get the device name of the control + end of a PTY, if non-standard.]) +AH_TEMPLATE(PTY_TTY_NAME_SPRINTF, [How to get device name of the tty + end of a PTY, if non-standard.]) + +case $opsys in + aix4-2 ) + AC_DEFINE(PTY_ITERATION, [int c; for (c = 0; !c ; c++)] ) + dnl You allocate a pty by opening /dev/ptc to get the master side. + dnl To get the name of the slave side, you just ttyname() the master side. + AC_DEFINE(PTY_NAME_SPRINTF, [strcpy (pty_name, "/dev/ptc");] ) + AC_DEFINE(PTY_TTY_NAME_SPRINTF, [strcpy (pty_name, ttyname (fd));] ) + ;; + + cygwin ) + AC_DEFINE(PTY_ITERATION, [int i; for (i = 0; i < 1; i++)] ) + dnl multi-line AC_DEFINEs are hard. :( + AC_DEFINE(PTY_OPEN, [ do { int dummy; SIGMASKTYPE mask; mask = sigblock (sigmask (SIGCHLD)); if (-1 == openpty (&fd, &dummy, pty_name, 0, 0)) fd = -1; sigsetmask (mask); if (fd >= 0) emacs_close (dummy); } while (0)] ) + AC_DEFINE(PTY_NAME_SPRINTF, [] ) + AC_DEFINE(PTY_TTY_NAME_SPRINTF, [] ) + ;; + + darwin ) + AC_DEFINE(PTY_ITERATION, [int i; for (i = 0; i < 1; i++)] ) + dnl Not used, because PTY_ITERATION is defined. + AC_DEFINE(FIRST_PTY_LETTER, ['p']) + dnl Note that openpty may fork via grantpt on Mac OS X 10.4/Darwin 8. + dnl But we don't have to block SIGCHLD because it is blocked in the + dnl implementation of grantpt. + AC_DEFINE(PTY_OPEN, [ do { int slave; if (openpty (&fd, &slave, pty_name, NULL, NULL) == -1) fd = -1; else emacs_close (slave); } while (0)] ) + AC_DEFINE(PTY_NAME_SPRINTF, [] ) + AC_DEFINE(PTY_TTY_NAME_SPRINTF, [] ) + ;; + + gnu | freebsd | netbsd | openbsd ) + AC_DEFINE(FIRST_PTY_LETTER, ['p']) + ;; + + gnu-linux | gnu-kfreebsd ) + dnl if HAVE_GRANTPT + if test "x$ac_cv_func_grantpt" = xyes; then + AC_DEFINE(UNIX98_PTYS, 1, [Define if the system has Unix98 PTYs.]) + AC_DEFINE(PTY_ITERATION, [int i; for (i = 0; i < 1; i++)] ) + dnl Note that grantpt and unlockpt may fork. We must block SIGCHLD + dnl to prevent sigchld_handler from intercepting the child's death. + AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptyname; sigblock (sigmask (SIGCHLD)); if (grantpt (fd) == -1 || unlockpt (fd) == -1 || !(ptyname = ptsname(fd))) { sigunblock (sigmask (SIGCHLD)); close (fd); return -1; } snprintf (pty_name, sizeof pty_name, "%s", ptyname); sigunblock (sigmask (SIGCHLD)); }] ) + dnl if HAVE_GETPT + if test "x$ac_cv_func_getpt" = xyes; then + AC_DEFINE(PTY_OPEN, [fd = getpt ()]) + AC_DEFINE(PTY_NAME_SPRINTF, [] ) + else + AC_DEFINE(PTY_NAME_SPRINTF, [strcpy (pty_name, "/dev/ptmx");] ) + fi + else + AC_DEFINE(FIRST_PTY_LETTER, ['p']) + fi + ;; + + hpux*) + AC_DEFINE(FIRST_PTY_LETTER, ['p']) + AC_DEFINE(PTY_NAME_SPRINTF, [sprintf (pty_name, "/dev/ptym/pty%c%x", c, i);] ) + AC_DEFINE(PTY_TTY_NAME_SPRINTF, [sprintf (pty_name, "/dev/pty/tty%c%x", c, i);] ) + ;; + + irix6-5 ) + dnl It looks like this cannot be right, because it is not a loop. + dnl However, process.c actually does this: + dnl # ifndef __sgi + dnl continue; + dnl # else + dnl return -1; + dnl # endif + dnl which presumably makes it OK, since irix == sgi (?). + dnl FIXME it seems like this special treatment is unnecessary? + dnl Why can't irix use a single-trip loop like eg cygwin? + AC_DEFINE(PTY_ITERATION, []) + dnl Not used, because PTY_ITERATION is defined. + AC_DEFINE(FIRST_PTY_LETTER, ['q']) + AC_DEFINE(PTY_OPEN, [ { struct sigaction ocstat, cstat; struct stat stb; char * name; sigemptyset(&cstat.sa_mask); cstat.sa_handler = SIG_DFL; cstat.sa_flags = 0; sigaction(SIGCLD, &cstat, &ocstat); name = _getpty (&fd, O_RDWR | O_NDELAY, 0600, 0); sigaction(SIGCLD, &ocstat, (struct sigaction *)0); if (name == 0) return -1; if (fd < 0) return -1; if (fstat (fd, &stb) < 0) return -1; strcpy (pty_name, name); }] ) + dnl No need to get the pty name at all. + AC_DEFINE(PTY_NAME_SPRINTF, [] ) + dnl No need to use sprintf to get the tty name--we get that from _getpty. + AC_DEFINE(PTY_TTY_NAME_SPRINTF, [] ) + ;; + + sol2* ) + dnl Uses sigblock/sigunblock rather than sighold/sigrelse, + dnl which appear to be BSD4.1 specific. It may also be appropriate + dnl for SVR4.x (x<2) but I'm not sure. fnf@cygnus.com + dnl On SysVr4, grantpt(3) forks a subprocess, so keep sigchld_handler() + dnl from intercepting that death. If any child but grantpt's should die + dnl within, it should be caught after sigrelse(2). + AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; sigblock (sigmask (SIGCLD)); if (grantpt (fd) == -1) { emacs_close (fd); return -1; } sigunblock (sigmask (SIGCLD)); if (unlockpt (fd) == -1) { emacs_close (fd); return -1; } if (!(ptyname = ptsname (fd))) { emacs_close (fd); return -1; } snprintf (pty_name, sizeof pty_name, "%s", ptyname); }] ) + ;; + + unixware ) + dnl Comments are as per sol2*. + AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; sigblock(sigmask(SIGCLD)); if (grantpt(fd) == -1) fatal("could not grant slave pty"); sigunblock(sigmask(SIGCLD)); if (unlockpt(fd) == -1) fatal("could not unlock slave pty"); if (!(ptyname = ptsname(fd))) fatal ("could not enable slave pty"); snprintf (pty_name, sizeof pty_name, "%s", ptyname); }] ) + ;; +esac + + +case $opsys in + sol2* | unixware ) + dnl This change means that we don't loop through allocate_pty too + dnl many times in the (rare) event of a failure. + AC_DEFINE(FIRST_PTY_LETTER, ['z']) + AC_DEFINE(PTY_NAME_SPRINTF, [strcpy (pty_name, "/dev/ptmx");] ) + dnl Push various streams modules onto a PTY channel. Used in process.c. + AC_DEFINE(SETUP_SLAVE_PTY, [if (ioctl (xforkin, I_PUSH, "ptem") == -1) fatal ("ioctl I_PUSH ptem"); if (ioctl (xforkin, I_PUSH, "ldterm") == -1) fatal ("ioctl I_PUSH ldterm"); if (ioctl (xforkin, I_PUSH, "ttcompat") == -1) fatal ("ioctl I_PUSH ttcompat");], [How to set up a slave PTY, if needed.]) + ;; +esac + + +AH_TEMPLATE(SIGNALS_VIA_CHARACTERS, [Make process_send_signal work by +"typing" a signal character on the pty.]) + +case $opsys in + dnl Perry Smith says this is correct for AIX. + dnl thomas@mathematik.uni-bremen.de says this is needed for IRIX. + aix4-2 | cygwin | gnu | irix6-5 | freebsd | netbsd | openbsd ) + AC_DEFINE(SIGNALS_VIA_CHARACTERS, 1) + ;; + + dnl 21 Jun 06: Eric Hanchrow says this works. + dnl FIXME Does gnu-kfreebsd have linux/version.h? It seems unlikely... + gnu-linux | gnu-kfreebsd ) + + AC_MSG_CHECKING([for signals via characters]) + AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[ +#include +#if LINUX_VERSION_CODE < 0x20400 +# error "Linux version too old" +#endif + ]], [[]])], emacs_signals_via_chars=yes, emacs_signals_via_chars=no) + + AC_MSG_RESULT([$emacs_signals_via_chars]) + test $emacs_signals_via_chars = yes && AC_DEFINE(SIGNALS_VIA_CHARACTERS, 1) + ;; +esac + + +dnl Used in dispnew.c +AH_TEMPLATE(PENDING_OUTPUT_COUNT, [Number of chars of output in the +buffer of a stdio stream.]) + +dnl FIXME just PENDING_OUTPUT_COUNT should suffice. +AH_TEMPLATE(GNU_LIBRARY_PENDING_OUTPUT_COUNT, [Value of +PENDING_OUTPUT_COUNT if using the GNU C library.]) + +case $opsys in + cygwin | darwin | freebsd | netbsd | openbsd ) + AC_DEFINE(PENDING_OUTPUT_COUNT(FILE), [((FILE)->_p - (FILE)->_bf._base)]) + ;; + + unixware) + AC_DEFINE(PENDING_OUTPUT_COUNT(FILE), [((FILE)->__ptr - (FILE)->__base)]) + ;; + + gnu | gnu-linux | gnu-kfreebsd ) + AC_MSG_CHECKING([for style of pending output formalism]) + dnl In autoconf 2.67 and later, we could use a single test + dnl since the preprocessed output is accessible in "conftest.i". + AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[ +#include +#if !defined (_IO_STDIO_H) && !defined (_STDIO_USES_IOSTREAM) +# error "stdio definitions not found" +#endif + ]], [[]])], emacs_pending_output=new, emacs_pending_output=unknown) + + if test $emacs_pending_output = unknown; then + case $opsys in + gnu-linux | gnu-kfreebsd) + AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[ +#include +#ifndef __UCLIBC__ +# error "not using uclibc" +#endif + ]], [[]])], emacs_pending_output=uclibc, emacs_pending_output=old) + ;; + esac + fi + + AC_MSG_RESULT([$emacs_pending_output]) + + case $emacs_pending_output in + new) + dnl New C libio names. + AC_DEFINE(GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE), + [((FILE)->_IO_write_ptr - (FILE)->_IO_write_base)]) + ;; + uclibc) + dnl Using the uClibc library. + AC_DEFINE(GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE), + [((FILE)->__bufpos - (FILE)->__bufstart)]) + ;; + old) + dnl Old C++ iostream names. + AC_DEFINE(GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE), + [((FILE)->_pptr - (FILE)->_pbase)]) + ;; + esac + ;; +esac + + +dnl Used in vm-limit.c +AH_TEMPLATE(DATA_START, [Address of the start of the data segment.]) +dnl Used in lisp.h, emacs.c, mem-limits.h +dnl NEWS.18 describes this as "a number which contains +dnl the high bits to be inclusive or'ed with pointers that are unpacked." +AH_TEMPLATE(DATA_SEG_BITS, [Extra bits to be or'd in with any pointers +stored in a Lisp_Object.]) +dnl if Emacs uses fewer than 32 bits for the value field of a LISP_OBJECT. + +case $opsys in + gnu) + dnl libc defines data_start. + AC_DEFINE(DATA_START, [({ extern int data_start; (char *) &data_start; })]) + ;; + + hpux*) + dnl The data segment on this machine always starts at address 0x40000000. + AC_DEFINE(DATA_START, [0x40000000]) + AC_DEFINE(DATA_SEG_BITS, [0x40000000]) + ;; + irix6-5) + AC_DEFINE(DATA_START, [0x10000000]) + AC_DEFINE(DATA_SEG_BITS, [0x10000000]) + ;; +esac + + +AH_TEMPLATE(ULIMIT_BREAK_VALUE, [Undocumented.]) +AH_TEMPLATE(TAB3, [Undocumented.]) + +case $opsys in + darwin) AC_DEFINE(TAB3, OXTABS) ;; + + gnu | freebsd | netbsd | openbsd ) + AC_DEFINE(TABDLY, OXTABS, [Undocumented.] ) + AC_DEFINE(TAB3, OXTABS) + ;; + + gnu-linux | gnu-kfreebsd ) + dnl libc-linux/sysdeps/linux/i386/ulimit.c says that due to shared + dnl library, we cannot get the maximum address for brk. + AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[ +#ifndef __i386__ +# error "not i386" +#endif + ]], [[]])], AC_DEFINE(ULIMIT_BREAK_VALUE, [(32*1024*1024)]), []) + + AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[ +#ifndef __ia64__ +# error "not ia64" +#endif + ]], [[]])], AC_DEFINE(GC_MARK_SECONDARY_STACK(), + [do { extern void *__libc_ia64_register_backing_store_base; __builtin_ia64_flushrs (); mark_memory (__libc_ia64_register_backing_store_base, __builtin_ia64_bsp ());} while (0)], + [Mark a secondary stack, like the register stack on the ia64.]), []) + ;; + + hpux*) + AC_DEFINE(RUN_TIME_REMAP, 1, [Define if emacs.c needs to call + run_time_remap; for HPUX.]) + ;; + + irix6-5) + dnl Ulimit(UL_GMEMLIM) is busted... + AC_DEFINE(ULIMIT_BREAK_VALUE, [0x14000000]) + ;; +esac + + +dnl These won't be used automatically yet. We also need to know, at least, +dnl that the stack is continuous. +AH_TEMPLATE(GC_SETJMP_WORKS, [Define if setjmp is known to save all + registers relevant for conservative garbage collection in the jmp_buf.]) + +AH_TEMPLATE(GC_MARK_STACK, [Define to GC_USE_GCPROS_AS_BEFORE if + conservative garbage collection is not known to work.]) + + +case $opsys in + aix4-2 | hpux* | unixware) + dnl Conservative garbage collection has not been tested, so for now + dnl play it safe and stick with the old-fashioned way of marking. + AC_DEFINE(GC_MARK_STACK, [GC_USE_GCPROS_AS_BEFORE]) + ;; + + dnl Not all the architectures are tested, but there are Debian packages + dnl for SCM and/or Guile on them, so the technique must work. See also + dnl comments in alloc.c concerning setjmp and gcc. + dnl Fixme: it's probably safe to just use the GCC conditional below. + gnu-linux | gnu-kfreebsd ) + AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[ +#if defined __i386__ || defined __sparc__ || defined __mc68000__ \ + || defined __alpha__ || defined __mips__ || defined __s390__ \ + || defined __arm__ || defined __powerpc__ || defined __amd64__ \ + || defined __ia64__ || defined __sh__ +/* ok */ +#else +# error "setjmp not known to work on this arch" +#endif + ]], [[]])], AC_DEFINE(GC_SETJMP_WORKS, 1), + AC_DEFINE(GC_MARK_STACK, [GC_USE_GCPROS_AS_BEFORE]) ) + ;; +esac + + +if test x$GCC = xyes; then + dnl GC_SETJMP_WORKS is nearly always appropriate for GCC. + AC_DEFINE(GC_SETJMP_WORKS, 1) +else + case $opsys in + dnl irix: Tested on Irix 6.5. SCM worked on earlier versions. + freebsd | netbsd | openbsd | irix6-5 | sol2* ) + AC_DEFINE(GC_SETJMP_WORKS, 1) + ;; + esac +fi dnl GCC? + + +dnl Used in xfaces.c. +case $opsys in + hpux* | sol2* ) + AC_DEFINE(XOS_NEEDS_TIME_H, 1, [Compensate for a bug in Xos.h on + some systems, where it requires time.h.]) + ;; +esac + + +dnl Define symbols to identify the version of Unix this is. +dnl Define all the symbols that apply correctly. +AH_TEMPLATE(BSD4_2, [Define if the system is compatible with BSD 4.2.]) +AH_TEMPLATE(BSD_SYSTEM, [Define if the system is compatible with BSD 4.2.]) +AH_TEMPLATE(USG, [Define if the system is compatible with System III.]) +AH_TEMPLATE(USG5, [Define if the system is compatible with System V.]) + +case $opsys in + aix4-2) + AC_DEFINE(USG, []) + AC_DEFINE(USG5, []) + dnl This symbol should be defined on AIX Version 3 ??????? + AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[ +#ifndef _AIX +# error "_AIX not defined" +#endif + ]], [[]])], [], AC_DEFINE(_AIX, [], [Define if the system is AIX.])) + ;; + + cygwin) + opsysfile= + AC_DEFINE(CYGWIN, 1, [Define if the system is Cygwin.]) + ;; + + darwin) + dnl BSD4_3 and BSD4_4 are already defined in sys/param.h. + AC_DEFINE(BSD4_2, []) + AC_DEFINE(BSD_SYSTEM, []) + dnl More specific than the above two. We cannot use __APPLE__ as this + dnl may not be defined on non-OSX Darwin, and we cannot define DARWIN + dnl here because Panther and lower CoreFoundation.h uses DARWIN to + dnl distinguish OS X from pure Darwin. + AC_DEFINE(DARWIN_OS, [], [Define if the system is Darwin.]) + ;; + + freebsd) + AC_DEFINE(BSD4_2, []) + dnl Hack to avoid calling AC_PREPROC_IFELSE multiple times. + dnl Would not be needed with autoconf >= 2.67, where the + dnl preprocessed output is accessible in "conftest.i". + AC_DEFINE(BSD_SYSTEM_AHB, 1, [Define if AH_BOTTOM should change BSD_SYSTEM.]) + ;; + + gnu | netbsd | openbsd ) + AC_DEFINE(BSD4_2, []) + AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[ +#ifndef BSD_SYSTEM +# error "BSD_SYSTEM not defined" +#endif + ]], [[]])], [], AC_DEFINE(BSD_SYSTEM, 43) ) + ;; + + gnu-linux | gnu-kfreebsd ) + AC_DEFINE(USG, []) + AC_DEFINE(GNU_LINUX, [], [Define if ths system is compatible with GNU/Linux.]) + ;; + + hpux*) + AC_DEFINE(USG, []) + AC_DEFINE(USG5, []) + AC_DEFINE(HPUX, [], [Define if the system is HPUX.]) + ;; + + irix6-5) + AC_DEFINE(USG, []) + AC_DEFINE(USG5, []) + AC_DEFINE(IRIX6_5, [], [Define if the system is IRIX.]) + ;; + + sol2*) + AC_DEFINE(USG, []) + AC_DEFINE(USG5, []) + AC_DEFINE(SOLARIS2, [], [Define if the system is Solaris.]) + ;; + + unixware) + AC_DEFINE(USG, []) + AC_DEFINE(USG5, []) + ;; +esac + + +case $opsys in + dnl Emacs supplies its own malloc, but glib (part of Gtk+) calls + dnl memalign and on Cygwin, that becomes the Cygwin-supplied memalign. + dnl As malloc is not the Cygwin malloc, the Cygwin memalign always + dnl returns ENOSYS. A workaround is to set G_SLICE=always-malloc. */ + cygwin) + AC_DEFINE(G_SLICE_ALWAYS_MALLOC, 1, [Define to set the + G_SLICE environment variable to "always-malloc" at startup, if + using GTK.]) + ;; + + gnu) opsysfile= ;; + + gnu-kfreebsd) opsysfile="s/gnu-linux.h" ;; + + hpux11) + dnl See comments in sysdep.c:sys_signal. + dnl SA_RESTART resets the timeout of `select' on hpux11. + dnl Defining BROKEN_SA_RESTART is not the same as undef'ing SA_RESTART. + AC_DEFINE(BROKEN_SA_RESTART, 1, [Define if SA_RESTART should only + be used in batch mode.]) + dnl It works to open the pty's tty in the parent (Emacs), then + dnl close and reopen it in the child. + AC_DEFINE(USG_SUBTTY_WORKS, 1, [Define for USG systems where it + works to open a pty's tty in the parent process, then close and + reopen it in the child.]) + + opsysfile="s/hpux10-20.h" + ;; + + irix6-5) + AC_DEFINE(PREFER_VSUSP, 1, [Define if process_send_signal should + use VSUSP instead of VSWTCH.]) + AC_DEFINE(SETPGRP_RELEASES_CTTY, 1, [Define if process.c:child_setup + should not call setpgrp.]) + ;; + + openbsd) opsysfile="s/netbsd.h" ;; + + sol2-10) + AC_DEFINE(_STRUCTURED_PROC, 1, [Needed for system_process_attributes + on Solaris.]) + opsysfile="s/sol2-6.h" + ;; esac # Set up the CFLAGS for real compilation, so we can substitute it. @@ -3249,6 +3874,7 @@ AC_SUBST(mandir) AC_SUBST(infodir) AC_SUBST(lispdir) AC_SUBST(leimdir) +AC_SUBST(standardlisppath) AC_SUBST(locallisppath) AC_SUBST(lisppath) AC_SUBST(x_default_search_path) @@ -3437,10 +4063,23 @@ AC_SUBST(CYGWIN_OBJ) AC_SUBST(PRE_ALLOC_OBJ) AC_SUBST(POST_ALLOC_OBJ) -# Configure gnulib here, now that we know LIBS. +# Configure gnulib. Although this does not affect CFLAGS or LIBS permanently. +# it temporarily reverts them to their pre-pkg-config values, +# because gnulib needs to work with both src (which uses the +# pkg-config stuff) and lib-src (which does not). For example, gnulib +# may need to determine whether LIB_CLOCK_GETTIME should contain -lrt, +# and it therefore needs to run in an environment where LIBS does not +# already contain -lrt merely because 'pkg-config --libs' printed '-lrt' +# for some package unrelated to lib-src. +SAVE_CFLAGS=$CFLAGS +SAVE_LIBS=$LIBS +CFLAGS=$pre_PKG_CONFIG_CFLAGS +LIBS="$LIB_PTHREAD $pre_PKG_CONFIG_LIBS" gl_ASSERT_NO_GNULIB_POSIXCHECK gl_ASSERT_NO_GNULIB_TESTS gl_INIT +CFLAGS=$SAVE_CFLAGS +LIBS=$SAVE_LIBS case "$opsys" in aix4-2) LD_SWITCH_SYSTEM_TEMACS="-Wl,-bnodelcsect" ;; @@ -3616,6 +4255,19 @@ AH_BOTTOM([ # error "alloca not available on this machine" #endif +/* This silences a few compilation warnings on FreeBSD. */ +#ifdef BSD_SYSTEM_AHB +#undef BSD_SYSTEM_AHB +#undef BSD_SYSTEM +#if __FreeBSD__ == 1 +#define BSD_SYSTEM 199103 +#elif __FreeBSD__ == 2 +#define BSD_SYSTEM 199306 +#elif __FreeBSD__ >= 3 +#define BSD_SYSTEM 199506 +#endif +#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. */ @@ -3634,13 +4286,14 @@ AH_BOTTOM([ # include config_opsysfile #endif -/* GNUstep needs a bit more pure memory. Of the existing knobs, - SYSTEM_PURESIZE_EXTRA seems like the least likely to cause problems. - (There is probably a better place to do this, but right now the - Cocoa side does this in s/darwin.h and we cannot parallel this - exactly since GNUstep is multi-OS. */ -#if defined HAVE_NS && defined NS_IMPL_GNUSTEP +/* Mac OS X / GNUstep need a bit more pure memory. Of the existing knobs, + SYSTEM_PURESIZE_EXTRA seems like the least likely to cause problems. */ +#ifdef HAVE_NS +#if defined NS_IMPL_GNUSTEP # define SYSTEM_PURESIZE_EXTRA 30000 +#elif defined DARWIN_OS +# define SYSTEM_PURESIZE_EXTRA 200000 +#endif #endif #ifdef emacs /* Don't do this for lib-src. */ @@ -3659,13 +4312,6 @@ AH_BOTTOM([ #include #include -#if defined __GNUC__ && (__GNUC__ > 2 \ - || (__GNUC__ == 2 && __GNUC_MINOR__ >= 5)) -#define NO_RETURN __attribute__ ((__noreturn__)) -#else -#define NO_RETURN /* nothing */ -#endif - #if __GNUC__ >= 3 /* On GCC 3.0 we might get a warning. */ #define NO_INLINE __attribute__((noinline)) #else @@ -3692,20 +4338,13 @@ AH_BOTTOM([ ATTRIBUTE_FORMAT ((__printf__, formatstring_parameter, first_argument)) #endif +#define ATTRIBUTE_CONST _GL_ATTRIBUTE_CONST + /* Some versions of GNU/Linux define noinline in their headers. */ #ifdef noinline #undef noinline #endif -/* These won't be used automatically yet. We also need to know, at least, - that the stack is continuous. */ -#ifdef __GNUC__ -# ifndef GC_SETJMP_WORKS - /* GC_SETJMP_WORKS is nearly always appropriate for GCC. */ -# define GC_SETJMP_WORKS 1 -# endif -#endif - #endif /* EMACS_CONFIG_H */ /* @@ -3720,7 +4359,11 @@ End: #### It makes printing result more understandable as using GTK sets #### toolkit_scroll_bars to yes by default. if test "${HAVE_GTK}" = "yes"; then - USE_X_TOOLKIT=GTK + if test "${with_gtk3}" = "yes"; then + USE_X_TOOLKIT=GTK3 + else + USE_X_TOOLKIT=GTK + fi fi echo " @@ -3784,11 +4427,6 @@ if test -n "${EMACSDOC}"; then echo " Environment variable EMACSDOC set to: $EMACSDOC" fi -if test $USE_XASSERTS = yes; then - echo " Compiling with asserts turned on." - CPPFLAGS="$CPPFLAGS -DXASSERTS=1" -fi - echo if test "$HAVE_NS" = "yes"; then @@ -3887,5 +4525,3 @@ fi ]) AC_OUTPUT - -dnl configure.in ends here diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index 7460d0f4aad..7a9a6bc818c 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,3 +1,52 @@ +2012-07-19 Chong Yidong + + * emacs.texi: Update ISBN. + +2012-07-17 Chong Yidong + + * basic.texi (Inserting Text): Replace ucs-insert with + insert-char. Provide more details of input. + + * mule.texi (International Chars, Input Methods): Likewise. + +2012-07-13 Chong Yidong + + * custom.texi (Examining): Update C-h v message. + + * buffers.texi (Misc Buffer): Document view-read-only. + +2012-07-07 Chong Yidong + + * custom.texi (Init File): Index site-lisp (Bug#11435). + +2012-07-06 Chong Yidong + + * emacs.texi: Re-order top-level menu to correspond to logical + order, to avoid makeinfo warnings. + + * ack.texi (Acknowledgments): Note new python.el. + +2012-06-29 Chong Yidong + + * maintaining.texi (Basic VC Editing, VC Pull, Merging): + * basic.texi (Erasing, Basic Undo): Fix markup. + +2012-06-29 Glenn Morris + + * fixit.texi (Undo): Grammar fixes. (Bug#11779) + +2012-06-29 Michael Witten (tiny change) + + * fixit.texi (Undo): Fix typo. (Bug#11775) + +2012-06-27 Glenn Morris + + * ack.texi (Acknowledgments): Tiny update. + +2012-06-21 Glenn Morris + + * Makefile.in: Rename infodir to buildinfodir throughout. (Bug#11737) + 2012-06-17 Chong Yidong * emacs.texi: Remove urlcolor setting. Update ISBN and edition number. @@ -1270,7 +1319,6 @@ * custom.texi (Mouse Buttons): * rmail.texi (Rmail Scrolling): * search.texi (Isearch Scroll): - * display.texi (Scrolling): Replace scroll-up/down with scroll-up/down-command. Fix scroll-preserve-screen-position description. Document scroll-error-top-bottom. @@ -3089,9 +3137,9 @@ * ack.texi (Acknowledgments): General update based on AUTHORS, including removal of some stuff no longer distributed. -2008-12-19 Agustin Martin +2008-12-19 Agustín Martín - * fixit.texi: Mention hunspell + * fixit.texi: Mention hunspell. 2008-12-19 Glenn Morris diff --git a/doc/emacs/Makefile.in b/doc/emacs/Makefile.in index 7ffbf52e94f..8f2078192b2 100644 --- a/doc/emacs/Makefile.in +++ b/doc/emacs/Makefile.in @@ -31,7 +31,7 @@ version=@version@ ## This is a bit funny. Because the info files are in the ## distribution tarfiles, they are always made in $scrdir/../../info, ## even for out-of-tree builds. -infodir = $(srcdir)/../../info +buildinfodir = $(srcdir)/../../info # Directory with the (customized) texinfo.tex file. texinfodir = $(srcdir)/../misc @@ -121,11 +121,11 @@ EMACSSOURCES= \ ## This seems pointless. The info/ directory exists in both the ## repository and the release tarfiles. -mkinfodir = @${MKDIR_P} ${infodir} +mkinfodir = @${MKDIR_P} ${buildinfodir} .PHONY: info dvi html pdf ps -info: $(infodir)/emacs$(INFO_EXT) +info: $(buildinfodir)/emacs$(INFO_EXT) dvi: emacs.dvi html: emacs.html pdf: emacs.pdf @@ -135,7 +135,7 @@ ps: emacs.ps # There is no provision for Info files to exist in the build directory. # In a distribution of Emacs, the Info files should be up to date. # Note: "<" is not portable in ordinary make rules. -$(infodir)/emacs$(INFO_EXT): ${EMACSSOURCES} +$(buildinfodir)/emacs$(INFO_EXT): ${EMACSSOURCES} $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/emacs.texi @@ -178,7 +178,7 @@ distclean: clean ## In the standalone tarfile, the clean rule runs this. infoclean: - -cd $(infodir) && rm -f emacs$(INFO_EXT) emacs$(INFO_EXT)-[1-9] emacs$(INFO_EXT)-[1-9][0-9] + -cd $(buildinfodir) && rm -f emacs$(INFO_EXT) emacs$(INFO_EXT)-[1-9] emacs$(INFO_EXT)-[1-9][0-9] maintainer-clean: distclean infoclean @@ -192,7 +192,8 @@ dist: cp ${srcdir}/*.texi ${texinfodir}/texinfo.tex \ ${srcdir}/ChangeLog* emacs-manual-${version}/ sed -e 's/@sr[c]dir@/./' -e 's/^\(texinfodir *=\).*/\1 ./' \ - -e 's/^\(infodir *=\).*/\1 ./' -e 's/^\(clean:.*\)/\1 infoclean/' \ + -e 's/^\(buildinfodir *=\).*/\1 ./' \ + -e 's/^\(clean:.*\)/\1 infoclean/' \ -e "s/@ver[s]ion@/${version}/" \ ${srcdir}/Makefile.in > emacs-manual-${version}/Makefile tar -cf emacs-manual-${version}.tar emacs-manual-${version} diff --git a/doc/emacs/ack.texi b/doc/emacs/ack.texi index 515039d6c0b..2c4ed1fbcc8 100644 --- a/doc/emacs/ack.texi +++ b/doc/emacs/ack.texi @@ -363,6 +363,10 @@ Kevin Gallagher rewrote and enhanced the EDT emulation, and wrote @file{flow-ctrl.el}, a package for coping with unsuppressible XON/XOFF flow control. +@item +Fabin E. Gallina rewrote @file{python.el}, the major mode for the +Python programming language used in Emacs 24.2 onwards. + @item Kevin Gallo added multiple-frame support for Windows NT and wrote @file{w32-win.el}, support functions for the MS-Windows window system. @@ -710,13 +714,13 @@ headers; @file{hl-line.el}, a minor mode for highlighting the line in the current window on which point is; @file{cap-words.el}, a minor mode for motion in ``CapitalizedWordIdentifiers''; @file{latin1-disp.el}, a package that lets you display ISO 8859 characters on Latin-1 terminals -by setting up appropriate display tables; @file{python.el}, a major mode -for the Python programming language; @file{smiley.el}, a facility for -displaying smiley faces; @file{sym-comp.el}, a library for performing -mode-dependent symbol completion; @file{benchmark.el} for timing code -execution; and @file{tool-bar.el}, a mode to control the display of -the Emacs tool bar. With Riccardo Murri he wrote @file{vc-bzr.el}, -support for the Bazaar version control system. +by setting up appropriate display tables; the version of +@file{python.el} used prior to Emacs 24.2; @file{smiley.el}, a +facility for displaying smiley faces; @file{sym-comp.el}, a library +for performing mode-dependent symbol completion; @file{benchmark.el} +for timing code execution; and @file{tool-bar.el}, a mode to control +the display of the Emacs tool bar. With Riccardo Murri he wrote +@file{vc-bzr.el}, support for the Bazaar version control system. @item Eric Ludlam wrote the Speedbar package; @file{checkdoc.el}, for checking @@ -831,7 +835,9 @@ diffs; @file{css-mode.el} for Cascading Style Sheets; @file{bibtex-style.el} for Bib@TeX{} Style files; @file{mpc.el}, a client for the ``Music Player Daemon''; @file{smie.el}, a generic indentation engine; and @file{pcase.el}, implementing ML-style pattern -matching. He integrated the lexical binding code in Emacs 24. +matching. In Emacs 24, he integrated the lexical binding code, +and cleaned up the CL namespace (making it acceptable to use CL +functions at runtime). @item Morioka Tomohiko wrote several packages for MIME support in Gnus and diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index bbcd1d62a8b..16ccdba0866 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -97,28 +97,29 @@ To use decimal or hexadecimal instead of octal, set the variable the letters @kbd{a} to @kbd{f} serve as part of a character code, just like digits. Case is ignored. -@findex ucs-insert +@findex insert-char @kindex C-x 8 RET @cindex Unicode characters, inserting @cindex insert Unicode character @cindex characters, inserting by name or code-point - Instead of @kbd{C-q}, you can use the command @kbd{C-x 8 @key{RET}} -(@code{ucs-insert}). This prompts for the Unicode name or code-point + Alternatively, you can use the command @kbd{C-x 8 @key{RET}} +(@code{insert-char}). This prompts for the Unicode name or code-point of a character, using the minibuffer. If you enter a name, the command provides completion (@pxref{Completion}). If you enter a -code-point, it should be a hexadecimal number (which is the convention -for Unicode). The command then inserts the corresponding character -into the buffer. For example, both of the following insert the -infinity sign (Unicode code-point @code{U+221E}): +code-point, it should be as a hexadecimal number (the convention for +Unicode), or a number with a specified radix, e.g.@: @code{#o23072} +(octal); @xref{Integer Basics,,, elisp, The Emacs Lisp Reference +Manual}. The command then inserts the corresponding character into +the buffer. For example, both of the following insert the infinity +sign (Unicode code-point @code{U+221E}): @example @kbd{C-x 8 @key{RET} infinity @key{RET}} @kbd{C-x 8 @key{RET} 221e @key{RET}} @end example - A numeric argument to either @kbd{C-q} or @kbd{C-x 8 @key{RET}} -specifies how many copies of the character to insert -(@pxref{Arguments}). + A numeric argument to @kbd{C-q} or @kbd{C-x 8 @key{RET}} specifies +how many copies of the character to insert (@pxref{Arguments}). @node Moving Point @section Changing the Location of Point @@ -345,7 +346,7 @@ moves down into it. Delete the character before point, or the region if it is active (@code{delete-backward-char}). -@itemx @key{Delete} +@item @key{Delete} Delete the character after point, or the region if it is active (@code{delete-forward-char}). @@ -403,7 +404,8 @@ commands. @item C-/ Undo one entry of the undo records---usually, one command worth (@code{undo}). -@itemx C-x u + +@item C-x u @itemx C-_ The same. @end table diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi index 159bf894834..24bb0e83778 100644 --- a/doc/emacs/buffers.texi +++ b/doc/emacs/buffers.texi @@ -232,11 +232,14 @@ have special commands to operate on the text; also by visiting a file whose access control says you cannot write it. @findex toggle-read-only +@vindex view-read-only The command @kbd{C-x C-q} (@code{toggle-read-only}) makes a read-only buffer writable, and makes a writable buffer read-only. This works by setting the variable @code{buffer-read-only}, which has a local value in each buffer and makes the buffer read-only if its value is -non-@code{nil}. +non-@code{nil}. If you change the option @code{view-read-only} to a +non-@code{nil} value, making the buffer read-only with @kbd{C-x C-q} +also enables View mode in the buffer (@pxref{View Mode}). @findex rename-buffer @kbd{M-x rename-buffer} changes the name of the current buffer. You diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index e46ffe4a186..2da70227c29 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -766,7 +766,7 @@ displays something like this: fill-column is a variable defined in `C source code'. fill-column's value is 70 -Automatically becomes buffer-local when set in any fashion. +Automatically becomes buffer-local when set. This variable is safe as a file local variable if its value satisfies the predicate `integerp'. @@ -2103,11 +2103,12 @@ loading of this library, use the option @samp{--no-site-file}. better to put them in @file{default.el}, so that users can more easily override them. +@cindex site-lisp directories You can place @file{default.el} and @file{site-start.el} in any of the directories which Emacs searches for Lisp libraries. The variable @code{load-path} (@pxref{Lisp Libraries}) specifies these directories. -Many sites put these files in the @file{site-lisp} subdirectory of the -Emacs installation directory, typically +Many sites put these files in a subdirectory named @file{site-lisp} in +the Emacs installation directory, such as @file{/usr/local/share/emacs/site-lisp}. Byte-compiling your init file is not recommended (@pxref{Byte diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index 73c4adf0977..1b457e01943 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -94,7 +94,7 @@ developing GNU and promoting software freedom.'' Published by the Free Software Foundation @* 51 Franklin Street, Fifth Floor @* Boston, MA 02110-1301 USA @* -ISBN 978-0-9831592-2-3 +ISBN 978-0-9831592-3-0 @sp 2 Cover art by Etienne Suvasa; cover design by Matt Lee. @@ -131,17 +131,6 @@ Emacs Lisp Reference Manual}. @menu * Distrib:: How to get the latest Emacs distribution. * Intro:: An introduction to Emacs concepts. -@c Note that in the printed manual, the glossary and indices come last. -* Glossary:: Terms used in this manual. - -Indexes (each index contains a large menu) -* Key Index:: An item for each standard Emacs key sequence. -* Option Index:: An item for every command-line option. -* Command Index:: An item for each command name. -* Variable Index:: An item for each documented variable. -* Concept Index:: An item for each concept. - -* Acknowledgments:: Major contributors to GNU Emacs. Important General Concepts * Screen:: How to interpret what you see on the screen. @@ -224,6 +213,18 @@ Appendices * Microsoft Windows:: Using Emacs on Microsoft Windows and MS-DOS. * Manifesto:: What's GNU? Gnu's Not Unix! +* Glossary:: Terms used in this manual. +@ifnottex +* Acknowledgments:: Major contributors to GNU Emacs. +@end ifnottex + +Indexes (each index contains a large menu) +* Key Index:: An item for each standard Emacs key sequence. +* Option Index:: An item for every command-line option. +* Command Index:: An item for each command name. +* Variable Index:: An item for each documented variable. +* Concept Index:: An item for each concept. + @c Do NOT modify the following 3 lines! They must have this form to @c be correctly identified by `texinfo-multiple-files-update'. In @c particular, the detailed menu header line MUST be identical to the diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi index 8f75c5e151c..b9199eba553 100644 --- a/doc/emacs/fixit.texi +++ b/doc/emacs/fixit.texi @@ -35,7 +35,7 @@ These were described earlier in this manual. @xref{Erasing}. The @dfn{undo} command reverses recent changes in the buffer's text. Each buffer records changes individually, and the undo command always applies to the current buffer. You can undo all the changes in a -buffer for as far as back its records go. Usually, each editing +buffer for as far back as the buffer's records go. Usually, each editing command makes a separate entry in the undo records, but some commands such as @code{query-replace} divide their changes into multiple entries for flexibility in undoing. Consecutive character insertion @@ -109,9 +109,9 @@ Emacs to hold text that users don't normally look at or edit. @vindex undo-strong-limit @vindex undo-outer-limit @cindex undo limit - When the undo records for a buffer becomes too large, Emacs discards -the oldest undo records from time to time (during @dfn{garbage -collection}). You can specify how much undo records to keep by + When the undo information for a buffer becomes too large, Emacs discards +the oldest records from time to time (during @dfn{garbage +collection}). You can specify how much undo information to keep by setting the variables @code{undo-limit}, @code{undo-strong-limit}, and @code{undo-outer-limit}. Their values are expressed in bytes. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index da378187873..c719c483ec8 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -426,7 +426,7 @@ VC fileset is handled individually; for example, a commit generates one revision for each changed file. @table @kbd -@itemx C-x v v +@item C-x v v Perform the next appropriate version control operation on the current VC fileset. @end table @@ -1326,7 +1326,7 @@ commit will be committed to that specific branch. @subsubsection Pulling Changes into a Branch @table @kbd -@itemx C-x v + +@item C-x v + On a decentralized version control system, update the current branch by ``pulling in'' changes from another location. @@ -1366,7 +1366,7 @@ updates the current VC fileset from the repository. @cindex merging changes @table @kbd -@itemx C-x v m +@item C-x v m On a decentralized version control system, merge changes from another branch into the current one. diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi index 59e945eee96..1dfae79c788 100644 --- a/doc/emacs/mule.texi +++ b/doc/emacs/mule.texi @@ -146,7 +146,7 @@ displayed on your terminal, they appear as @samp{?} or as hollow boxes used, generally don't have keys for all the characters in them. You can insert characters that your keyboard does not support, using @kbd{C-q} (@code{quoted-insert}) or @kbd{C-x 8 @key{RET}} -(@code{ucs-insert}). @xref{Inserting Text}. Emacs also supports +(@code{insert-char}). @xref{Inserting Text}. Emacs also supports various @dfn{input methods}, typically one for each script or language, which make it easier to type characters in the script. @xref{Input Methods}. @@ -548,7 +548,7 @@ possible characters to type next is displayed in the echo area (but not when you are in the minibuffer). Another facility for typing characters not on your keyboard is by -using @kbd{C-x 8 @key{RET}} (@code{ucs-insert}) to insert a single +using @kbd{C-x 8 @key{RET}} (@code{insert-char}) to insert a single character based on its Unicode name or code-point; see @ref{Inserting Text}. diff --git a/doc/lispintro/ChangeLog b/doc/lispintro/ChangeLog index af84726af81..11eacf25c96 100644 --- a/doc/lispintro/ChangeLog +++ b/doc/lispintro/ChangeLog @@ -1,3 +1,7 @@ +2012-06-21 Glenn Morris + + * Makefile.in: Rename infodir to buildinfodir throughout. (Bug#11737) + 2012-05-29 Glenn Morris * emacs-lisp-intro.texi: Nuke hand-written node pointers. @@ -385,7 +389,7 @@ `named' to `selected'. (lengths-list-file): Remove extraneous parenthesis from reference. (lengths-list-many-files): Explain `expand-file-name' better. - (Files List): Rephrase sentence regarding Lisp sources directory + (Files List): Rephrase sentence regarding Lisp sources directory. 2006-11-04 Robert J. Chassell diff --git a/doc/lispintro/Makefile.in b/doc/lispintro/Makefile.in index bf10e5c73b7..3f2fe1f9526 100644 --- a/doc/lispintro/Makefile.in +++ b/doc/lispintro/Makefile.in @@ -22,7 +22,7 @@ SHELL = /bin/sh srcdir = @srcdir@ version=@version@ -infodir = $(srcdir)/../../info +buildinfodir = $(srcdir)/../../info # Directory with the (customized) texinfo.tex file. texinfodir = $(srcdir)/../misc @@ -41,11 +41,11 @@ DVIPS = dvips ENVADD = TEXINPUTS="$(srcdir):$(texinfodir):$(TEXINPUTS)" \ MAKEINFO="$(MAKEINFO) $(MAKEINFO_OPTS)" -mkinfodir = @${MKDIR_P} ${infodir} +mkinfodir = @${MKDIR_P} ${buildinfodir} .PHONY: info dvi html pdf ps -info: ${infodir}/eintr$(INFO_EXT) +info: ${buildinfodir}/eintr$(INFO_EXT) dvi: emacs-lisp-intro.dvi html: emacs-lisp-intro.html @@ -55,7 +55,7 @@ ps: emacs-lisp-intro.ps # The file name eintr must fit within 5 characters, to allow for # -NN extensions to fit into DOS 8+3 limits without clashing. # Note: "<" is not portable in ordinary make rules. -${infodir}/eintr$(INFO_EXT): ${srcdir}/emacs-lisp-intro.texi +${buildinfodir}/eintr$(INFO_EXT): ${srcdir}/emacs-lisp-intro.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/emacs-lisp-intro.texi @@ -85,7 +85,7 @@ clean: mostlyclean distclean: clean infoclean: - -cd $(infodir) && rm -f eintr$(INFO_EXT) eintr$(INFO_EXT)-[1-9] + -cd $(buildinfodir) && rm -f eintr$(INFO_EXT) eintr$(INFO_EXT)-[1-9] maintainer-clean: distclean infoclean @@ -98,7 +98,8 @@ dist: ${texinfodir}/texinfo.tex \ ${srcdir}/ChangeLog* ${srcdir}/README emacs-lispintro-${version}/ sed -e 's/@sr[c]dir@/./' -e 's/^\(texinfodir *=\).*/\1 ./' \ - -e 's/^\(infodir *=\).*/\1 ./' -e 's/^\(clean:.*\)/\1 infoclean/' \ + -e 's/^\(buildinfodir *=\).*/\1 ./' \ + -e 's/^\(clean:.*\)/\1 infoclean/' \ -e "s/@ver[s]ion@/${version}/" \ ${srcdir}/Makefile.in > emacs-lispintro-${version}/Makefile tar -cf emacs-lispintro-${version}.tar emacs-lispintro-${version} diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 89efb5c6255..1ab3aa6ee1c 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,82 @@ +2012-07-25 Paul Eggert + + Prefer typical American spelling for "acknowledgment". + * intro.texi (Acknowledgments): Rename from Acknowledgements. + +2012-07-21 Eli Zaretskii + + * commands.texi (Special Events): Mention language-change event. + (Input Events, Interactive Codes): + * keymaps.texi (Key Sequences): Mention events that are + non-keyboard but also non-mouse events. + +2012-07-17 Chong Yidong + + * text.texi (Insertion): Document insert-char changes. + +2012-07-15 Leo Liu + + * display.texi (Fringe Bitmaps): Add exclamation-mark. + +2012-07-13 Chong Yidong + + * buffers.texi (Read Only Buffers): Document toggle-read-only + changes. Reword to account for the fact that read-only is + currently not supported in overlay properties. + +2012-07-07 Chong Yidong + + * loading.texi (Library Search): Index site-lisp directories. + +2012-07-06 Chong Yidong + + * intro.texi (A Sample Function Description): Fix incorrect + markup, undoing previous change. + (A Sample Variable Description): Minor clarifications and markup + improvements. + + * elisp.texi (Top): + * text.texi (Text): Fix menu order. + +2012-07-06 Richard Stallman + + * intro.texi (Evaluation Notation, A Sample Function Description): + (A Sample Variable Description): Improve/undo previous changes. + +2012-07-05 Glenn Morris + + * intro.texi (A Sample Function Description): Fix cross-refs. + +2012-07-05 Michael Witten (tiny change) + + * intro.texi (Evaluation Notation, A Sample Function Description) + (A Sample Variable Description, Version Info): Copy edits (bug#11862). + +2012-06-27 Chong Yidong + + * processes.texi (Asynchronous Processes, Input to Processes): + * internals.texi (Process Internals): Don't capitalize "pty". + +2012-06-24 Thien-Thi Nguyen + + * processes.texi (Asynchronous Processes): Make the pty vs pipe + discussion more prominent. + +2012-06-23 Eli Zaretskii + + * commands.texi (Misc Events): Document the language-change event. + +2012-06-22 Paul Eggert + + Support higher-resolution time stamps (Bug#9000). + * os.texi (Time of Day, Time Parsing, Processor Run Time, Idle Timers): + * processes.texi (System Processes): + Time stamp resolution is now picosecond, not microsecond. + +2012-06-21 Glenn Morris + + * Makefile.in: Rename infodir to buildinfodir throughout. (Bug#11737) + 2012-06-18 Stefan Monnier * functions.texi (Defining Functions): @@ -10857,8 +10936,8 @@ (Recording Input): Document that clear-this-command-keys clears the vector to be returned by recent-keys. - * keymaps.texi (Scanning Keymaps) : The - argument keymap can be a list. + * keymaps.texi (Scanning Keymaps) : + The argument keymap can be a list. * nonascii.texi (User-Chosen Coding Systems) : Document the new argument @@ -11103,7 +11182,7 @@ * Makefile (dist): Don't bother excluding autosave files; they'll never make it into the temp directory anyway, and the hash marks in the name are problematic for make and the Bourne shell. - (srcs): + (srcs): ??? 1993-02-12 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) diff --git a/doc/lispref/Makefile.in b/doc/lispref/Makefile.in index dd820d85133..32a241e2a2d 100644 --- a/doc/lispref/Makefile.in +++ b/doc/lispref/Makefile.in @@ -24,7 +24,7 @@ srcdir = @srcdir@ version=@version@ -infodir = $(srcdir)/../../info +buildinfodir = $(srcdir)/../../info # Directory with the (customized) texinfo.tex file. texinfodir = $(srcdir)/../misc # Directory with emacsver.texi. @@ -101,18 +101,18 @@ srcs = \ $(srcdir)/gpl.texi \ $(srcdir)/doclicense.texi -mkinfodir = @${MKDIR_P} ${infodir} +mkinfodir = @${MKDIR_P} ${buildinfodir} .PHONY: info dvi pdf ps -info: $(infodir)/elisp$(INFO_EXT) +info: $(buildinfodir)/elisp$(INFO_EXT) dvi: elisp.dvi html: elisp.html pdf: elisp.pdf ps: elisp.ps ## Note: "<" is not portable in ordinary make rules. -$(infodir)/elisp$(INFO_EXT): $(srcs) +$(buildinfodir)/elisp$(INFO_EXT): $(srcs) $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ $(srcdir)/elisp.texi @@ -145,7 +145,7 @@ clean: mostlyclean distclean: clean infoclean: - -cd $(infodir) && rm -f elisp$(INFO_EXT) elisp$(INFO_EXT)-[1-9] elisp$(INFO_EXT)-[1-9][0-9] + -cd $(buildinfodir) && rm -f elisp$(INFO_EXT) elisp$(INFO_EXT)-[1-9] elisp$(INFO_EXT)-[1-9][0-9] maintainer-clean: distclean infoclean @@ -160,7 +160,8 @@ dist: ${srcdir}/README emacs-lispref-${version}/ sed -e 's/@sr[c]dir@/./' -e 's/^\(texinfodir *=\).*/\1 ./' \ -e 's/^\(emacsdir *=\).*/\1 ./' \ - -e 's/^\(infodir *=\).*/\1 ./' -e 's/^\(clean:.*\)/\1 infoclean/' \ + -e 's/^\(buildinfodir *=\).*/\1 ./' \ + -e 's/^\(clean:.*\)/\1 infoclean/' \ -e "s/@ver[s]ion@/${version}/" \ ${srcdir}/Makefile.in > emacs-lispref-${version}/Makefile tar -cf emacs-lispref-${version}.tar emacs-lispref-${version} diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 072ffeb4321..6ad329f3a30 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -730,11 +730,9 @@ The buffer is read-only if this variable is non-@code{nil}. @defvar inhibit-read-only If this variable is non-@code{nil}, then read-only buffers and, depending on the actual value, some or all read-only characters may be -modified. Read-only characters in a buffer are those that have -non-@code{nil} @code{read-only} properties (either text properties or -overlay properties). @xref{Special Properties}, for more information -about text properties. @xref{Overlays}, for more information about -overlays and their properties. +modified. Read-only characters in a buffer are those that have a +non-@code{nil} @code{read-only} text property. @xref{Special +Properties}, for more information about text properties. If @code{inhibit-read-only} is @code{t}, all @code{read-only} character properties have no effect. If @code{inhibit-read-only} is a list, then @@ -742,18 +740,31 @@ properties have no effect. If @code{inhibit-read-only} is a list, then of the list (comparison is done with @code{eq}). @end defvar -@deffn Command toggle-read-only &optional arg -This command toggles whether the current buffer is read-only. It is -intended for interactive use; do not use it in programs (it may have -side-effects, such as enabling View mode, and does not affect -read-only text properties). To change the read-only state of a buffer in -a program, explicitly set @code{buffer-read-only} to the proper value. -To temporarily ignore a read-only state, bind @code{inhibit-read-only}. +@deffn Command toggle-read-only &optional arg message +This command toggles whether the current buffer is read-only, by +setting the variable @code{buffer-read-only}. If @var{arg} is +non-@code{nil}, it should be a raw prefix argument; the command then +makes the buffer read-only if the numeric value of that prefix +argument is positive, and makes the buffer writable otherwise. +@xref{Prefix Command Arguments}. -If @var{arg} is non-@code{nil}, it should be a raw prefix argument. -@code{toggle-read-only} sets @code{buffer-read-only} to @code{t} if -the numeric value of that prefix argument is positive and to -@code{nil} otherwise. @xref{Prefix Command Arguments}. +If called interactively, or if called from Lisp with @var{message} is +non-@code{nil}, the command prints a message reporting the buffer's +new read-only status. + +When making the buffer read-only, this command also enables View mode +if the option @code{view-read-only} is non-@code{nil}. @xref{Misc +Buffer,,Miscellaneous Buffer Operations, emacs, The GNU Emacs Manual}. +When making the buffer writable, it disables View mode if View mode +was enabled. + +Lisp programs should only call @code{toggle-read-only} if they really +intend to do the same thing as the user command, including possibly +enabling or disabling View mode. Note also that this command works by +setting @code{buffer-read-only}, so even if you make the buffer +writable, characters with non-@code{nil} @code{read-only} text +properties will remain read-only. To temporarily ignore all read-only +states, bind @code{inhibit-read-only}, as described above. @end deffn @defun barf-if-buffer-read-only diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 59ad2927411..7e24de94fbe 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -379,9 +379,14 @@ current buffer, @code{default-directory} (@pxref{File Name Expansion}). Existing, Completion, Default, Prompt. @item e -The first or next mouse event in the key sequence that invoked the command. -More precisely, @samp{e} gets events that are lists, so you can look at -the data in the lists. @xref{Input Events}. No I/O. +The first or next non-keyboard event in the key sequence that invoked +the command. More precisely, @samp{e} gets events that are lists, so +you can look at the data in the lists. @xref{Input Events}. No I/O. + +You use @samp{e} for mouse events and for special system events +(@pxref{Misc Events}). The event list that the command receives +depends on the event. @xref{Input Events}, which describes the forms +of the list for each event in the corresponding subsections. You can use @samp{e} more than once in a single command's interactive specification. If the key sequence that invoked the command has @@ -972,9 +977,10 @@ moving point out of these sequences is completely turned off. @cindex input events The Emacs command loop reads a sequence of @dfn{input events} that -represent keyboard or mouse activity. The events for keyboard activity -are characters or symbols; mouse events are always lists. This section -describes the representation and meaning of input events in detail. +represent keyboard or mouse activity, or system events sent to Emacs. +The events for keyboard activity are characters or symbols; other +events are always lists. This section describes the representation +and meaning of input events in detail. @defun eventp object This function returns non-@code{nil} if @var{object} is an input event @@ -1716,6 +1722,38 @@ To test the signal handler, you can make Emacs send a signal to itself: @smallexample (signal-process (emacs-pid) 'sigusr1) @end smallexample + +@cindex @code{language-change} event +@item language-change +This kind of event is generated on MS-Windows when the input language +has changed. This typically means that the keyboard keys will send to +Emacs characters from a different language. The generated event has +this form: + +@smallexample +(language-change @var{frame} @var{codepage} @var{language-id}) +@end smallexample + +@noindent +Here @var{frame} is the frame which was current when the input +language changed; @var{codepage} is the new codepage number; and +@var{language-id} is the numerical ID of the new input language. The +coding-system (@pxref{Coding Systems}) that corresponds to +@var{codepage} is @code{cp@var{codepage}} or +@code{windows-@var{codepage}}. To convert @var{language-id} to a +string (e.g., to use it for various language-dependent features, such +as @code{set-language-environment}), use the +@code{w32-get-locale-info} function, like this: + +@smallexample +;; Get the abbreviated language name, such as "ENU" for English +(w32-get-locale-info language-id) +;; Get the full English name of the language, +;; such as "English (United States)" +(w32-get-locale-info language-id 4097) +;; Get the full localized name of the language +(w32-get-locale-info language-id t) +@end smallexample @end table If one of these events arrives in the middle of a key sequence---that @@ -2808,11 +2846,11 @@ immediately after they are read, and this is the way for the event's definition to find the actual event. The events types @code{iconify-frame}, @code{make-frame-visible}, -@code{delete-frame}, @code{drag-n-drop}, and user signals like -@code{sigusr1} are normally handled in this way. The keymap which -defines how to handle special events---and which events are -special---is in the variable @code{special-event-map} (@pxref{Active -Keymaps}). +@code{delete-frame}, @code{drag-n-drop}, @code{language-change}, and +user signals like @code{sigusr1} are normally handled in this way. +The keymap which defines how to handle special events---and which +events are special---is in the variable @code{special-event-map} +(@pxref{Active Keymaps}). @node Waiting @section Waiting for Elapsed Time or Input diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 53c3ebe8b97..01d177feb87 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -3550,7 +3550,7 @@ Used to indicate buffer boundaries. @itemx @code{vertical-bar}, @code{horizontal-bar} Used for different types of fringe cursors. -@item @code{empty-line}, @code{question-mark} +@item @code{empty-line}, @code{question-mark}, @code{exclamation-mark} Unused. @end table diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 824934a5ceb..a8b325c7150 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -254,7 +254,7 @@ Introduction * Lisp History:: Emacs Lisp is descended from Maclisp. * Conventions:: How the manual is formatted. * Version Info:: Which Emacs version is running? -* Acknowledgements:: The authors, editors, and sponsors of this manual. +* Acknowledgments:: The authors, editors, and sponsors of this manual. Conventions @@ -1123,9 +1123,9 @@ Text * Case Changes:: Case conversion of parts of the buffer. * Text Properties:: Assigning Lisp property lists to text characters. * Substitution:: Replacing a given character wherever it appears. -* Transposition:: Swapping two portions of a buffer. * Registers:: How registers are implemented. Accessing the text or position stored in a register. +* Transposition:: Swapping two portions of a buffer. * Base 64:: Conversion to or from base 64 encoding. * Checksum/Hash:: Computing cryptographic hashes. * Parsing HTML/XML:: Parsing HTML and XML. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 618569c3559..56971bf0ff0 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -1846,6 +1846,17 @@ Note that the @samp{.~3~} in the two last examples is the backup part, not an extension. @end defun +@defun file-name-base &optional filename +This function is the composition of @code{file-name-sans-extension} +and @code{file-name-nondirectory}. For example, + +@example +(file-name-base "/my/home/foo.c") + @result{} "foo" +@end example + +The @var{filename} argument defaults to @code{buffer-file-name}. +@end defun @node Relative File Names @subsection Absolute and Relative File Names diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 80012512062..1459f52d979 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -1380,7 +1380,7 @@ needs to be reported, either by running the sentinel or by inserting a message in the process buffer. @item pty_flag -Non-@code{nil} if communication with the subprocess uses a @acronym{PTY}; +Non-@code{nil} if communication with the subprocess uses a pty; @code{nil} if it uses a pipe. @item infd diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi index 841cfacb8c8..ce103a84a74 100644 --- a/doc/lispref/intro.texi +++ b/doc/lispref/intro.texi @@ -44,7 +44,7 @@ corresponding to Emacs version @value{EMACSVER}. * Lisp History:: Emacs Lisp is descended from Maclisp. * Conventions:: How the manual is formatted. * Version Info:: Which Emacs version is running? -* Acknowledgements:: The authors, editors, and sponsors of this manual. +* Acknowledgments:: The authors, editors, and sponsors of this manual. @end menu @node Caveats @@ -235,7 +235,7 @@ evaluation of the expanded form. @result{} c @end example - Sometimes to help describe one form we show another form that + To help describe one form, we sometimes show another form that produces identical results. The exact equivalence of two forms is indicated with @samp{@equiv{}}. @@ -351,7 +351,7 @@ you call the function. The keyword @code{&rest} (which must be followed by a single argument name) indicates that any number of arguments can follow. The -single argument name following @code{&rest} will receive, as its +single argument name following @code{&rest} receives, as its value, a list of all the remaining arguments passed to the function. Do not write @code{&rest} when you call the function. @@ -379,24 +379,25 @@ More generally, @end example @end defun - Any argument whose name contains the name of a type (e.g., -@var{integer}, @var{integer1} or @var{buffer}) is expected to be of that -type. A plural of a type (such as @var{buffers}) often means a list of -objects of that type. Arguments named @var{object} may be of any type. -(@xref{Lisp Data Types}, for a list of Emacs object types.) Arguments -with other sorts of names (e.g., @var{new-file}) are discussed -specifically in the description of the function. In some sections, -features common to the arguments of several functions are described at -the beginning. + By convention, any argument whose name contains the name of a type +(e.g.@: @var{integer}, @var{integer1} or @var{buffer}) is expected to +be of that type. A plural of a type (such as @var{buffers}) often +means a list of objects of that type. An argument named @var{object} +may be of any type. (For a list of Emacs object types, @pxref{Lisp +Data Types}.) An argument with any other sort of name +(e.g.@: @var{new-file}) is specific to the function; if the function +has a documentation string, the type of the argument should be +described there (@pxref{Documentation}). - @xref{Lambda Expressions}, for a more complete description of optional -and rest arguments. + @xref{Lambda Expressions}, for a more complete description of +arguments modified by @code{&optional} and @code{&rest}. Command, macro, and special form descriptions have the same format, -but the word `Function' is replaced by `Command', `Macro', or `Special -Form', respectively. Commands are simply functions that may be called -interactively; macros process their arguments differently from functions -(the arguments are not evaluated), but are presented the same way. +but the word @samp{Function} is replaced by @samp{Command}, +@samp{Macro}, or @samp{Special Form}, respectively. Commands are +simply functions that may be called interactively; macros process +their arguments differently from functions (the arguments are not +evaluated), but are presented the same way. The descriptions of macros and special forms use a more complex notation to specify optional and repeated arguments, because they can @@ -445,11 +446,14 @@ from @var{body}, which includes all remaining elements of the form. @cindex variable descriptions @cindex option descriptions - A @dfn{variable} is a name that can hold a value. Although nearly -all variables can be set by the user, certain variables exist -specifically so that users can change them; these are called @dfn{user -options}. Ordinary variables and user options are described using a -format like that for functions except that there are no arguments. + A @dfn{variable} is a name that can be @dfn{bound} (or @dfn{set}) to +an object. The object to which a variable is bound is called a +@dfn{value}; we say also that variable holds that value. +Although nearly all variables can be set by the user, certain +variables exist specifically so that users can change them; these are +called @dfn{user options}. Ordinary variables and user options are +described using a format like that for functions, except that there +are no arguments. Here is a description of the imaginary @code{electric-future-map} variable.@refill @@ -460,8 +464,8 @@ Future mode. The functions in this map allow you to edit commands you have not yet thought about executing. @end defvar - User option descriptions have the same format, but `Variable' is -replaced by `User Option'. + User option descriptions have the same format, but @samp{Variable} +is replaced by @samp{User Option}. @node Version Info @section Version Information @@ -504,7 +508,7 @@ emacs-build-time The value of this variable is the version of Emacs being run. It is a string such as @code{"23.1.1"}. The last number in this string is not really part of the Emacs release version number; it is incremented -each time you build Emacs in any given directory. A value with four +each time Emacs is built in any given directory. A value with four numeric components, such as @code{"22.0.91.1"}, indicates an unreleased test version. @end defvar @@ -519,8 +523,8 @@ The minor version number of Emacs, as an integer. For Emacs version 23.1, the value is 1. @end defvar -@node Acknowledgements -@section Acknowledgements +@node Acknowledgments +@section Acknowledgments This manual was originally written by Robert Krawitz, Bil Lewis, Dan LaLiberte, Richard@tie{}M. Stallman and Chris Welty, the volunteers of diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index ac3d9e47580..ad7092a9ed7 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -45,7 +45,8 @@ is found. The whole process is called @dfn{key lookup}. A @dfn{key sequence}, or @dfn{key} for short, is a sequence of one or more input events that form a unit. Input events include -characters, function keys, and mouse actions (@pxref{Input Events}). +characters, function keys, mouse actions, or system events external to +Emacs, such as @code{iconify-frame} (@pxref{Input Events}). The Emacs Lisp representation for a key sequence is a string or vector. Unless otherwise stated, any Emacs Lisp function that accepts a key sequence as an argument can handle both representations. @@ -62,9 +63,10 @@ sequence is the concatenation of the string representations of the constituent events; thus, @code{"\C-xl"} represents the key sequence @kbd{C-x l}. - Key sequences containing function keys, mouse button events, or -non-@acronym{ASCII} characters such as @kbd{C-=} or @kbd{H-a} cannot be -represented as strings; they have to be represented as vectors. + Key sequences containing function keys, mouse button events, system +events, or non-@acronym{ASCII} characters such as @kbd{C-=} or +@kbd{H-a} cannot be represented as strings; they have to be +represented as vectors. In the vector representation, each element of the vector represents an input event, in its Lisp form. @xref{Input Events}. For example, diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index 0d3acf3a968..3c9bee96639 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -262,6 +262,7 @@ Here is how to set it from @code{csh}: setenv EMACSLOADPATH /home/foo/.emacs.d/lisp:/opt/emacs/lisp @end example +@cindex site-lisp directories If @env{EMACSLOADPATH} is not set (which is usually the case), Emacs initializes @code{load-path} with the following two directories: diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index e604d92e690..6431ac8bead 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1166,7 +1166,9 @@ The value may be a floating point number. zone. @cindex epoch - Most of these functions represent time as a list of either three + Most of these functions represent time as a list of either four +integers, @code{(@var{sec-high} @var{sec-low} @var{microsec} +@var{picosec})}, or of three integers, @code{(@var{sec-high} @var{sec-low} @var{microsec})}, or of two integers, @code{(@var{sec-high} @var{sec-low})}. The integers @var{sec-high} and @var{sec-low} give the high and low bits of an @@ -1181,12 +1183,15 @@ is the number of seconds from the @dfn{epoch} (0:00 January 1, 1970 UTC) to the specified time. The third list element @var{microsec}, if present, gives the number of microseconds from the start of that second to the specified time. +Similarly, the fourth list element @var{picosec}, if present, gives +the number of picoseconds from the start of that microsecond to the +specified time. The return value of @code{current-time} represents time using three -integers, while the timestamps in the return value of -@code{file-attributes} use two integers (@pxref{Definition of +integers, as do the timestamps in the return value of +@code{file-attributes} (@pxref{Definition of file-attributes}). In function arguments, e.g.@: the @var{time-value} -argument to @code{current-time-string}, both two- and three-integer +argument to @code{current-time-string}, two-, three-, and four-integer lists are accepted. You can convert times from the list representation into standard human-readable strings using @code{current-time}, or to other forms using the @code{decode-time} @@ -1216,9 +1221,12 @@ The argument @var{time-value}, if given, specifies a time to format @end defun @defun current-time -This function returns the current time, represented as a list of three -integers @code{(@var{sec-high} @var{sec-low} @var{microsec})}. On -systems with only one-second time resolutions, @var{microsec} is 0. +This function returns the current time, represented as a list of four +integers @code{(@var{sec-high} @var{sec-low} @var{microsec} @var{picosec})}. +These integers have trailing zeros on systems that return time with +lower resolutions. On all current machines @var{picosec} is a +multiple of 1000, but this may change as higher-resolution clocks +become available. @end defun @defun float-time &optional time-value @@ -1259,7 +1267,7 @@ time zone. @node Time Conversion @section Time Conversion - These functions convert time values (lists of two or three integers, + These functions convert time values (lists of two to four integers, as explained in the previous section) into calendrical information and vice versa. @@ -1410,8 +1418,6 @@ This stands for a newline. This stands for the nanoseconds (000000000-999999999). To ask for fewer digits, use @samp{%3N} for milliseconds, @samp{%6N} for microseconds, etc. Any excess digits are discarded, without rounding. -Currently Emacs time stamps are at best microsecond resolution so the -last three digits generated by plain @samp{%N} are always zero. @item %p This stands for @samp{AM} or @samp{PM}, as appropriate. @item %r @@ -1563,18 +1569,9 @@ When called interactively, it prints the uptime in the echo area. @defun get-internal-run-time This function returns the processor run time used by Emacs as a list -of three integers: @code{(@var{high} @var{low} @var{microsec})}. The -integers @var{high} and @var{low} combine to give the number of -seconds, which is -@ifnottex -@var{high} * 2**16 + @var{low}. -@end ifnottex -@tex -$high*2^{16}+low$. -@end tex - -The third element, @var{microsec}, gives the microseconds (or 0 for -systems that return time with the resolution of only one second). +of four integers: @code{(@var{high} @var{low} @var{microsec} +@var{picosec})}, using the same format as @code{current-time} +(@pxref{Time of Day}). Note that the time returned by this function excludes the time Emacs was not using the processor, and if the Emacs process has several @@ -1817,10 +1814,9 @@ set up to repeat will subsequently run another time, one by one. @defun current-idle-time If Emacs is idle, this function returns the length of time Emacs has -been idle, as a list of three integers: @code{(@var{sec-high} -@var{sec-low} @var{microsec})}, where @var{high} and @var{low} are the -high and low bits for the number of seconds and @var{microsec} is the -additional number of microseconds (@pxref{Time of Day}). +been idle, as a list of four integers: @code{(@var{sec-high} +@var{sec-low} @var{microsec} @var{picosec})}, using the same format as +@code{current-time} (@pxref{Time of Day}). When Emacs is not idle, @code{current-idle-time} returns @code{nil}. This is a convenient way to test whether Emacs is idle. diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 34b62a48329..217f9f9eaee 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -541,16 +541,29 @@ is decoded in the same way as for @code{call-process}. @section Creating an Asynchronous Process @cindex asynchronous subprocess - After an @dfn{asynchronous process} is created, Emacs and the subprocess -both continue running immediately. The process thereafter runs -in parallel with Emacs, and the two can communicate with each other -using the functions described in the following sections. However, + In this section, we describe how to create an @dfn{asynchronous +process}. After an asynchronous process is created, it runs in +parallel with Emacs, and Emacs can communicate with it using the +functions described in the following sections (@pxref{Input to +Processes}, and @pxref{Output from Processes}). Note that process communication is only partially asynchronous: Emacs sends data to the process only when certain functions are called, and Emacs accepts data -from the process only when Emacs is waiting for input or for a time -delay. +from the process only while waiting for input or for a time delay. - Here we describe how to create an asynchronous process. +@cindex pty +@cindex pipe + An asynchronous process is controlled either via a @dfn{pty} +(pseudo-terminal) or a @dfn{pipe}. The choice of pty or pipe is made +when creating the process, based on the value of the variable +@code{process-connection-type} (see below). Ptys are usually +preferable for processes visible to the user, as in Shell mode, +because they allow for job control (@kbd{C-c}, @kbd{C-z}, etc.) +between the process and its children, whereas pipes do not. For +subprocesses used for internal purposes by programs, it is often +better to use a pipe, because they are more efficient, and because +they are immune to stray character injections that ptys introduce for +large (around 500 byte) messages. Also, the total number of ptys is +limited on many systems and it is good not to waste them. @defun start-process name buffer-or-name program &rest args This function creates a new asynchronous subprocess and starts the @@ -652,20 +665,10 @@ can also be executed on remote hosts, depending on @code{default-directory}. @end defun @defvar process-connection-type -@cindex pipes -@cindex @acronym{PTY}s This variable controls the type of device used to communicate with -asynchronous subprocesses. If it is non-@code{nil}, then @acronym{PTY}s are +asynchronous subprocesses. If it is non-@code{nil}, then ptys are used, when available. Otherwise, pipes are used. -@acronym{PTY}s are usually preferable for processes visible to the user, as -in Shell mode, because they allow job control (@kbd{C-c}, @kbd{C-z}, -etc.) to work between the process and its children, whereas pipes do -not. For subprocesses used for internal purposes by programs, it is -often better to use a pipe, because they are more efficient. In -addition, the total number of @acronym{PTY}s is limited on many systems and -it is good not to waste them. - The value of @code{process-connection-type} takes effect when @code{start-process} is called. So you can specify how to communicate with one subprocess by binding the variable around the call to @@ -678,8 +681,8 @@ with one subprocess by binding the variable around the call to @end group @end smallexample -To determine whether a given subprocess actually got a pipe or a -@acronym{PTY}, use the function @code{process-tty-name} (@pxref{Process +To determine whether a given subprocess actually got a pipe or a pty, +use the function @code{process-tty-name} (@pxref{Process Information}). @end defvar @@ -957,9 +960,9 @@ data appears on the ``standard input'' of the subprocess. @c FIXME which? Some operating systems have limited space for buffered input in a -@acronym{PTY}. On these systems, Emacs sends an @acronym{EOF} -periodically amidst the other characters, to force them through. For -most programs, these @acronym{EOF}s do no harm. +pty. On these systems, Emacs sends an @acronym{EOF} periodically +amidst the other characters, to force them through. For most +programs, these @acronym{EOF}s do no harm. Subprocess input is normally encoded using a coding system before the subprocess receives it, much like text written into a file. You can use @@ -1770,7 +1773,7 @@ faults for all the child processes of the given process. @item utime Time spent by the process in the user context, for running the application's code. The corresponding @var{value} is in the -@w{@code{(@var{high} @var{low} @var{microsec})}} format, the same +@w{@code{(@var{high} @var{low} @var{microsec} @var{picosec})}} format, the same format used by functions @code{current-time} (@pxref{Time of Day, current-time}) and @code{file-attributes} (@pxref{File Attributes}). @@ -1801,12 +1804,12 @@ The number of threads in the process. @item start The time when the process was started, in the same -@w{@code{(@var{high} @var{low} @var{microsec})}} format used by +@w{@code{(@var{high} @var{low} @var{microsec} @var{picosec})}} format used by @code{current-time} and by @code{file-attributes}. @item etime The time elapsed since the process started, in the @w{@code{(@var{high} -@var{low} @var{microsec})}} format. +@var{low} @var{microsec} @var{picosec})}} format. @item vsize The virtual memory size of the process, measured in kilobytes. diff --git a/doc/lispref/spellfile b/doc/lispref/spellfile index 18fb633acfd..590d356d2d4 100644 --- a/doc/lispref/spellfile +++ b/doc/lispref/spellfile @@ -1,6 +1,5 @@ ARPA Abbrev -Acknowledgements Alan Arnold Autoloading diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index d670a85a464..d115322f84f 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -51,9 +51,9 @@ the character after point. * Case Changes:: Case conversion of parts of the buffer. * Text Properties:: Assigning Lisp property lists to text characters. * Substitution:: Replacing a given character wherever it appears. -* Transposition:: Swapping two portions of a buffer. * Registers:: How registers are implemented. Accessing the text or position stored in a register. +* Transposition:: Swapping two portions of a buffer. * Base 64:: Conversion to or from base 64 encoding. * Checksum/Hash:: Computing cryptographic hashes. * Parsing HTML/XML:: Parsing HTML and XML. @@ -401,19 +401,23 @@ ends at the insertion point, the inserted text falls inside that overlay. @end defun -@defun insert-char character count &optional inherit -This function inserts @var{count} instances of @var{character} into the -current buffer before point. The argument @var{count} should be an -integer, and @var{character} must be a character. The value is @code{nil}. +@deffn Command insert-char character &optional count inherit +This command inserts @var{count} instances of @var{character} into the +current buffer before point. The argument @var{count} must be an +integer, and @var{character} must be a character. + +If called interactively, this command prompts for @var{character} +using its Unicode name or its code point. @xref{Inserting Text,,, +emacs, The GNU Emacs Manual}. This function does not convert unibyte character codes 128 through 255 to multibyte characters, not even if the current buffer is a multibyte buffer. @xref{Converting Representations}. -If @var{inherit} is non-@code{nil}, then the inserted characters inherit +If @var{inherit} is non-@code{nil}, the inserted characters inherit sticky text properties from the two characters before and after the insertion point. @xref{Sticky Properties}. -@end defun +@end deffn @defun insert-buffer-substring from-buffer-or-name &optional start end This function inserts a portion of buffer @var{from-buffer-or-name} diff --git a/doc/man/emacs.1 b/doc/man/emacs.1 index ff673245680..d3d8a0095b8 100644 --- a/doc/man/emacs.1 +++ b/doc/man/emacs.1 @@ -634,7 +634,7 @@ Everyone will be free to use, copy, study and change the GNU system. .SH AUTHORS .I Emacs was written by Richard Stallman and the Free Software Foundation. -For detailed credits and acknowledgements, see the GNU Emacs manual. +For detailed credits and acknowledgments, see the GNU Emacs manual. . . . diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 1026215a46b..58bce13ba9d 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,76 @@ +2012-07-25 Paul Eggert + + Prefer typical American spelling for "acknowledgment". + * calc.texi (History and Acknowledgments): Rename from + History and Acknowledgements. + * idlwave.texi (Acknowledgments): + * ses.texi (Acknowledgments): + * woman.texi (Acknowledgments): Rename from Acknowledgements. + +2012-07-09 Paul Eggert + + Rename configure.in to configure.ac (Bug#11603). + * ede.texi (Compiler and Linker objects, ede-proj-project) + (ede-step-project): Prefer the name configure.ac to configure.in. + +2012-07-06 Michael Albinus + + * tramp.texi (Multi-hops): Introduce + `tramp-restricted-shell-hosts-alist'. + +2012-06-26 Lars Magne Ingebrigtsen + + * gnus.texi (POP before SMTP): POP-before-SMTP works with all sending + methods, so don't mention smtpmail here. + +2012-06-26 Wolfgang Jenkner + + * gnus.texi (Picons): Document gnus-picon-properties. + +2012-06-26 Lars Magne Ingebrigtsen + + * gnus.texi: Remove mention of compilation, as that's no longer + supported. + +2012-06-26 Christopher Schmidt + + * gnus.texi (Archived Messages): Mention + gnus-gcc-pre-body-encode-hook and gnus-gcc-post-body-encode-hook. + +2012-06-26 Lars Ingebrigtsen + + * gnus.texi (Various Summary Stuff): + Remove mention of `gnus-propagate-marks'. + +2012-06-26 Lars Ingebrigtsen + + * gnus.texi: Remove mentions of nnml/nnfolder/nntp backend marks, + which no longer exist. + +2012-06-26 Katsumi Yamaoka + + * gnus.texi (Archived Messages): + Document gnus-gcc-self-resent-messages. + +2012-06-26 Lars Ingebrigtsen + + * message.texi (Mail Variables): + Mention the optional user parameter for X-Message-SMTP-Method. + +2012-06-26 Lars Ingebrigtsen + + * gnus.texi (Posting Styles): Mention X-Message-SMTP-Method. + + * message.texi (Mail Variables): Document X-Message-SMTP-Method. + +2012-06-26 Lars Ingebrigtsen + + * gnus.texi (Key Index): Change encoding to utf-8. + +2012-06-21 Glenn Morris + + * Makefile.in: Rename infodir to buildinfodir throughout. (Bug#11737) + 2012-06-11 Lars Magne Ingebrigtsen * gnus.texi (Group Timestamp): Mention where to find documentation for @@ -768,7 +841,7 @@ 2011-08-15 Eric Schulte * org.texi (Structure of code blocks): Explicitly state that the - behavior of multiple blocks of the same name is undefined + behavior of multiple blocks of the same name is undefined. 2011-08-15 Christian Egli @@ -1135,7 +1208,7 @@ 2011-03-19 Antoine Levitt - * gnus.texi (Listing Groups): Document gnus-group-list-ticked + * gnus.texi (Listing Groups): Document gnus-group-list-ticked. 2011-03-17 Jay Belanger @@ -3060,7 +3133,7 @@ 2009-07-29 Jay Belanger * calc.texi (Stack Manipulation Commands): Add documentation for - `calc-transpose-lines' + `calc-transpose-lines'. 2009-07-27 Michael Albinus diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in index c275a16a9a6..c42a10b88bc 100644 --- a/doc/misc/Makefile.in +++ b/doc/misc/Makefile.in @@ -25,7 +25,7 @@ SHELL = /bin/sh srcdir=@srcdir@ ## Where the output files go. -infodir = $(srcdir)/../../info +buildinfodir = $(srcdir)/../../info ## Directory with emacsver.texi. ## Currently only used by efaq and calc. emacsdir = $(srcdir)/../emacs @@ -162,7 +162,7 @@ TEXI2PDF = texi2pdf ENVADD = TEXINPUTS="$(srcdir):$(emacsdir):$(TEXINPUTS)" \ MAKEINFO="$(MAKEINFO) $(MAKEINFO_OPTS)" -mkinfodir = @${MKDIR_P} ${infodir} +mkinfodir = @${MKDIR_P} ${buildinfodir} .PHONY: info dvi pdf echo-info ## Prevent implicit rule triggering for foo.info. @@ -191,8 +191,8 @@ pdf: $(PDF_TARGETS) # Note: "<" is not portable in ordinary make rules. -ada-mode : $(infodir)/ada-mode$(INFO_EXT) -$(infodir)/ada-mode$(INFO_EXT): ${srcdir}/ada-mode.texi +ada-mode : $(buildinfodir)/ada-mode$(INFO_EXT) +$(buildinfodir)/ada-mode$(INFO_EXT): ${srcdir}/ada-mode.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ada-mode.texi ada-mode.dvi: ${srcdir}/ada-mode.texi @@ -200,8 +200,8 @@ ada-mode.dvi: ${srcdir}/ada-mode.texi ada-mode.pdf: ${srcdir}/ada-mode.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/ada-mode.texi -auth : $(infodir)/auth$(INFO_EXT) -$(infodir)/auth$(INFO_EXT): ${srcdir}/auth.texi +auth : $(buildinfodir)/auth$(INFO_EXT) +$(buildinfodir)/auth$(INFO_EXT): ${srcdir}/auth.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/auth.texi auth.dvi: ${srcdir}/auth.texi @@ -209,8 +209,8 @@ auth.dvi: ${srcdir}/auth.texi auth.pdf: ${srcdir}/auth.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/auth.texi -autotype : $(infodir)/autotype$(INFO_EXT) -$(infodir)/autotype$(INFO_EXT): ${srcdir}/autotype.texi +autotype : $(buildinfodir)/autotype$(INFO_EXT) +$(buildinfodir)/autotype$(INFO_EXT): ${srcdir}/autotype.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/autotype.texi autotype.dvi: ${srcdir}/autotype.texi @@ -218,8 +218,8 @@ autotype.dvi: ${srcdir}/autotype.texi autotype.pdf: ${srcdir}/autotype.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/autotype.texi -calc : $(infodir)/calc$(INFO_EXT) -$(infodir)/calc$(INFO_EXT): ${srcdir}/calc.texi $(emacsdir)/emacsver.texi +calc : $(buildinfodir)/calc$(INFO_EXT) +$(buildinfodir)/calc$(INFO_EXT): ${srcdir}/calc.texi $(emacsdir)/emacsver.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/calc.texi calc.dvi: ${srcdir}/calc.texi $(emacsdir)/emacsver.texi @@ -227,8 +227,8 @@ calc.dvi: ${srcdir}/calc.texi $(emacsdir)/emacsver.texi calc.pdf: ${srcdir}/calc.texi $(emacsdir)/emacsver.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/calc.texi -ccmode : $(infodir)/ccmode$(INFO_EXT) -$(infodir)/ccmode$(INFO_EXT): ${srcdir}/cc-mode.texi +ccmode : $(buildinfodir)/ccmode$(INFO_EXT) +$(buildinfodir)/ccmode$(INFO_EXT): ${srcdir}/cc-mode.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/cc-mode.texi cc-mode.dvi: ${srcdir}/cc-mode.texi @@ -236,8 +236,8 @@ cc-mode.dvi: ${srcdir}/cc-mode.texi cc-mode.pdf: ${srcdir}/cc-mode.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/cc-mode.texi -cl : $(infodir)/cl$(INFO_EXT) -$(infodir)/cl$(INFO_EXT): ${srcdir}/cl.texi +cl : $(buildinfodir)/cl$(INFO_EXT) +$(buildinfodir)/cl$(INFO_EXT): ${srcdir}/cl.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/cl.texi cl.dvi: ${srcdir}/cl.texi @@ -245,8 +245,8 @@ cl.dvi: ${srcdir}/cl.texi cl.pdf: ${srcdir}/cl.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/cl.texi -dbus : $(infodir)/dbus$(INFO_EXT) -$(infodir)/dbus$(INFO_EXT): ${srcdir}/dbus.texi +dbus : $(buildinfodir)/dbus$(INFO_EXT) +$(buildinfodir)/dbus$(INFO_EXT): ${srcdir}/dbus.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/dbus.texi dbus.dvi: ${srcdir}/dbus.texi @@ -254,8 +254,8 @@ dbus.dvi: ${srcdir}/dbus.texi dbus.pdf: ${srcdir}/dbus.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/dbus.texi -dired-x : $(infodir)/dired-x$(INFO_EXT) -$(infodir)/dired-x$(INFO_EXT): ${srcdir}/dired-x.texi $(emacsdir)/emacsver.texi +dired-x : $(buildinfodir)/dired-x$(INFO_EXT) +$(buildinfodir)/dired-x$(INFO_EXT): ${srcdir}/dired-x.texi $(emacsdir)/emacsver.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/dired-x.texi dired-x.dvi: ${srcdir}/dired-x.texi $(emacsdir)/emacsver.texi @@ -263,8 +263,8 @@ dired-x.dvi: ${srcdir}/dired-x.texi $(emacsdir)/emacsver.texi dired-x.pdf: ${srcdir}/dired-x.texi $(emacsdir)/emacsver.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/dired-x.texi -ebrowse : $(infodir)/ebrowse$(INFO_EXT) -$(infodir)/ebrowse$(INFO_EXT): ${srcdir}/ebrowse.texi +ebrowse : $(buildinfodir)/ebrowse$(INFO_EXT) +$(buildinfodir)/ebrowse$(INFO_EXT): ${srcdir}/ebrowse.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ebrowse.texi ebrowse.dvi: ${srcdir}/ebrowse.texi @@ -272,8 +272,8 @@ ebrowse.dvi: ${srcdir}/ebrowse.texi ebrowse.pdf: ${srcdir}/ebrowse.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/ebrowse.texi -ede : $(infodir)/ede$(INFO_EXT) -$(infodir)/ede$(INFO_EXT): ${srcdir}/ede.texi +ede : $(buildinfodir)/ede$(INFO_EXT) +$(buildinfodir)/ede$(INFO_EXT): ${srcdir}/ede.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ede.texi ede.dvi: ${srcdir}/ede.texi @@ -281,8 +281,8 @@ ede.dvi: ${srcdir}/ede.texi ede.pdf: ${srcdir}/ede.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/ede.texi -ediff : $(infodir)/ediff$(INFO_EXT) -$(infodir)/ediff$(INFO_EXT): ${srcdir}/ediff.texi +ediff : $(buildinfodir)/ediff$(INFO_EXT) +$(buildinfodir)/ediff$(INFO_EXT): ${srcdir}/ediff.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ediff.texi ediff.dvi: ${srcdir}/ediff.texi @@ -290,8 +290,8 @@ ediff.dvi: ${srcdir}/ediff.texi ediff.pdf: ${srcdir}/ediff.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/ediff.texi -edt : $(infodir)/edt$(INFO_EXT) -$(infodir)/edt$(INFO_EXT): ${srcdir}/edt.texi +edt : $(buildinfodir)/edt$(INFO_EXT) +$(buildinfodir)/edt$(INFO_EXT): ${srcdir}/edt.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/edt.texi edt.dvi: ${srcdir}/edt.texi @@ -299,8 +299,8 @@ edt.dvi: ${srcdir}/edt.texi edt.pdf: ${srcdir}/edt.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/edt.texi -eieio : $(infodir)/eieio$(INFO_EXT) -$(infodir)/eieio$(INFO_EXT): ${srcdir}/eieio.texi +eieio : $(buildinfodir)/eieio$(INFO_EXT) +$(buildinfodir)/eieio$(INFO_EXT): ${srcdir}/eieio.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/eieio.texi eieio.dvi: ${srcdir}/eieio.texi @@ -308,8 +308,8 @@ eieio.dvi: ${srcdir}/eieio.texi eieio.pdf: ${srcdir}/eieio.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/eieio.texi -emacs-gnutls : $(infodir)/emacs-gnutls$(INFO_EXT) -$(infodir)/emacs-gnutls$(INFO_EXT): ${srcdir}/emacs-gnutls.texi +emacs-gnutls : $(buildinfodir)/emacs-gnutls$(INFO_EXT) +$(buildinfodir)/emacs-gnutls$(INFO_EXT): ${srcdir}/emacs-gnutls.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/emacs-gnutls.texi emacs-gnutls.dvi: ${srcdir}/emacs-gnutls.texi @@ -317,8 +317,8 @@ emacs-gnutls.dvi: ${srcdir}/emacs-gnutls.texi emacs-gnutls.pdf: ${srcdir}/emacs-gnutls.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/emacs-gnutls.texi -emacs-mime : $(infodir)/emacs-mime$(INFO_EXT) -$(infodir)/emacs-mime$(INFO_EXT): ${srcdir}/emacs-mime.texi +emacs-mime : $(buildinfodir)/emacs-mime$(INFO_EXT) +$(buildinfodir)/emacs-mime$(INFO_EXT): ${srcdir}/emacs-mime.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) --enable-encoding -o $@ ${srcdir}/emacs-mime.texi emacs-mime.dvi: ${srcdir}/emacs-mime.texi @@ -326,8 +326,8 @@ emacs-mime.dvi: ${srcdir}/emacs-mime.texi emacs-mime.pdf: ${srcdir}/emacs-mime.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/emacs-mime.texi -epa : $(infodir)/epa$(INFO_EXT) -$(infodir)/epa$(INFO_EXT): ${srcdir}/epa.texi +epa : $(buildinfodir)/epa$(INFO_EXT) +$(buildinfodir)/epa$(INFO_EXT): ${srcdir}/epa.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/epa.texi epa.dvi: ${srcdir}/epa.texi @@ -335,8 +335,8 @@ epa.dvi: ${srcdir}/epa.texi epa.pdf: ${srcdir}/epa.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/epa.texi -erc : $(infodir)/erc$(INFO_EXT) -$(infodir)/erc$(INFO_EXT): ${srcdir}/erc.texi +erc : $(buildinfodir)/erc$(INFO_EXT) +$(buildinfodir)/erc$(INFO_EXT): ${srcdir}/erc.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/erc.texi erc.dvi: ${srcdir}/erc.texi @@ -344,8 +344,8 @@ erc.dvi: ${srcdir}/erc.texi erc.pdf: ${srcdir}/erc.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/erc.texi -ert : $(infodir)/ert$(INFO_EXT) -$(infodir)/ert$(INFO_EXT): ${srcdir}/ert.texi +ert : $(buildinfodir)/ert$(INFO_EXT) +$(buildinfodir)/ert$(INFO_EXT): ${srcdir}/ert.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ert.texi ert.dvi: ${srcdir}/ert.texi @@ -353,8 +353,8 @@ ert.dvi: ${srcdir}/ert.texi ert.pdf: ${srcdir}/ert.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/ert.texi -eshell : $(infodir)/eshell$(INFO_EXT) -$(infodir)/eshell$(INFO_EXT): ${srcdir}/eshell.texi +eshell : $(buildinfodir)/eshell$(INFO_EXT) +$(buildinfodir)/eshell$(INFO_EXT): ${srcdir}/eshell.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/eshell.texi eshell.dvi: ${srcdir}/eshell.texi @@ -362,8 +362,8 @@ eshell.dvi: ${srcdir}/eshell.texi eshell.pdf: ${srcdir}/eshell.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/eshell.texi -eudc : $(infodir)/eudc$(INFO_EXT) -$(infodir)/eudc$(INFO_EXT): ${srcdir}/eudc.texi +eudc : $(buildinfodir)/eudc$(INFO_EXT) +$(buildinfodir)/eudc$(INFO_EXT): ${srcdir}/eudc.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/eudc.texi eudc.dvi: ${srcdir}/eudc.texi @@ -371,8 +371,8 @@ eudc.dvi: ${srcdir}/eudc.texi eudc.pdf: ${srcdir}/eudc.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/eudc.texi -efaq : $(infodir)/efaq$(INFO_EXT) -$(infodir)/efaq$(INFO_EXT): ${srcdir}/faq.texi $(emacsdir)/emacsver.texi +efaq : $(buildinfodir)/efaq$(INFO_EXT) +$(buildinfodir)/efaq$(INFO_EXT): ${srcdir}/faq.texi $(emacsdir)/emacsver.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/faq.texi faq.dvi: ${srcdir}/faq.texi $(emacsdir)/emacsver.texi @@ -389,8 +389,8 @@ emacs-faq.html: ${srcdir}/faq.texi $(emacsdir)/emacsver.texi emacs-faq.text: ${srcdir}/faq.texi $(emacsdir)/emacsver.texi $(MAKEINFO) $(MAKEINFO_OPTS) --plaintext -o $@ ${srcdir}/faq.texi -flymake : $(infodir)/flymake$(INFO_EXT) -$(infodir)/flymake$(INFO_EXT): ${srcdir}/flymake.texi +flymake : $(buildinfodir)/flymake$(INFO_EXT) +$(buildinfodir)/flymake$(INFO_EXT): ${srcdir}/flymake.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/flymake.texi flymake.dvi: ${srcdir}/flymake.texi @@ -398,8 +398,8 @@ flymake.dvi: ${srcdir}/flymake.texi flymake.pdf: ${srcdir}/flymake.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/flymake.texi -forms : $(infodir)/forms$(INFO_EXT) -$(infodir)/forms$(INFO_EXT): ${srcdir}/forms.texi +forms : $(buildinfodir)/forms$(INFO_EXT) +$(buildinfodir)/forms$(INFO_EXT): ${srcdir}/forms.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/forms.texi forms.dvi: ${srcdir}/forms.texi @@ -408,8 +408,8 @@ forms.pdf: ${srcdir}/forms.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/forms.texi # gnus/message/emacs-mime/sieve/pgg are part of Gnus: -gnus : $(infodir)/gnus$(INFO_EXT) -$(infodir)/gnus$(INFO_EXT): ${srcdir}/gnus.texi ${srcdir}/gnus-faq.texi +gnus : $(buildinfodir)/gnus$(INFO_EXT) +$(buildinfodir)/gnus$(INFO_EXT): ${srcdir}/gnus.texi ${srcdir}/gnus-faq.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/gnus.texi gnus.dvi: ${srcdir}/gnus.texi ${srcdir}/gnus-faq.texi @@ -424,8 +424,8 @@ gnus.pdf: ${srcdir}/gnus.texi ${srcdir}/gnus-faq.texi rm gnustmp.* # NB this one needs --no-split even without a .info extension. -idlwave : $(infodir)/idlwave$(INFO_EXT) -$(infodir)/idlwave$(INFO_EXT): ${srcdir}/idlwave.texi +idlwave : $(buildinfodir)/idlwave$(INFO_EXT) +$(buildinfodir)/idlwave$(INFO_EXT): ${srcdir}/idlwave.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/idlwave.texi idlwave.dvi: ${srcdir}/idlwave.texi @@ -435,8 +435,8 @@ idlwave.pdf: ${srcdir}/idlwave.texi # NB this one needs --no-split even without a .info extension. # Avoid name clash with overall "info" target. -info.info : $(infodir)/info$(INFO_EXT) -$(infodir)/info$(INFO_EXT): ${srcdir}/info.texi +info.info : $(buildinfodir)/info$(INFO_EXT) +$(buildinfodir)/info$(INFO_EXT): ${srcdir}/info.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/info.texi info.dvi: ${srcdir}/info.texi @@ -444,8 +444,8 @@ info.dvi: ${srcdir}/info.texi info.pdf: ${srcdir}/info.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/info.texi -mairix-el : $(infodir)/mairix-el$(INFO_EXT) -$(infodir)/mairix-el$(INFO_EXT): ${srcdir}/mairix-el.texi +mairix-el : $(buildinfodir)/mairix-el$(INFO_EXT) +$(buildinfodir)/mairix-el$(INFO_EXT): ${srcdir}/mairix-el.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/mairix-el.texi mairix-el.dvi: ${srcdir}/mairix-el.texi @@ -453,8 +453,8 @@ mairix-el.dvi: ${srcdir}/mairix-el.texi mairix-el.pdf: ${srcdir}/mairix-el.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/mairix-el.texi -message : $(infodir)/message$(INFO_EXT) -$(infodir)/message$(INFO_EXT): ${srcdir}/message.texi +message : $(buildinfodir)/message$(INFO_EXT) +$(buildinfodir)/message$(INFO_EXT): ${srcdir}/message.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/message.texi message.dvi: ${srcdir}/message.texi @@ -462,8 +462,8 @@ message.dvi: ${srcdir}/message.texi message.pdf: ${srcdir}/message.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/message.texi -mh-e : $(infodir)/mh-e$(INFO_EXT) -$(infodir)/mh-e$(INFO_EXT): ${srcdir}/mh-e.texi +mh-e : $(buildinfodir)/mh-e$(INFO_EXT) +$(buildinfodir)/mh-e$(INFO_EXT): ${srcdir}/mh-e.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/mh-e.texi mh-e.dvi: ${srcdir}/mh-e.texi @@ -471,8 +471,8 @@ mh-e.dvi: ${srcdir}/mh-e.texi mh-e.pdf: ${srcdir}/mh-e.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/mh-e.texi -newsticker : $(infodir)/newsticker$(INFO_EXT) -$(infodir)/newsticker$(INFO_EXT): ${srcdir}/newsticker.texi +newsticker : $(buildinfodir)/newsticker$(INFO_EXT) +$(buildinfodir)/newsticker$(INFO_EXT): ${srcdir}/newsticker.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/newsticker.texi newsticker.dvi: ${srcdir}/newsticker.texi @@ -480,8 +480,8 @@ newsticker.dvi: ${srcdir}/newsticker.texi newsticker.pdf: ${srcdir}/newsticker.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/newsticker.texi -nxml-mode : $(infodir)/nxml-mode$(INFO_EXT) -$(infodir)/nxml-mode$(INFO_EXT): ${srcdir}/nxml-mode.texi +nxml-mode : $(buildinfodir)/nxml-mode$(INFO_EXT) +$(buildinfodir)/nxml-mode$(INFO_EXT): ${srcdir}/nxml-mode.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/nxml-mode.texi nxml-mode.dvi: ${srcdir}/nxml-mode.texi @@ -489,8 +489,8 @@ nxml-mode.dvi: ${srcdir}/nxml-mode.texi nxml-mode.pdf: ${srcdir}/nxml-mode.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/nxml-mode.texi -org : $(infodir)/org$(INFO_EXT) -$(infodir)/org$(INFO_EXT): ${srcdir}/org.texi +org : $(buildinfodir)/org$(INFO_EXT) +$(buildinfodir)/org$(INFO_EXT): ${srcdir}/org.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/org.texi org.dvi: ${srcdir}/org.texi @@ -498,8 +498,8 @@ org.dvi: ${srcdir}/org.texi org.pdf: ${srcdir}/org.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/org.texi -pcl-cvs : $(infodir)/pcl-cvs$(INFO_EXT) -$(infodir)/pcl-cvs$(INFO_EXT): ${srcdir}/pcl-cvs.texi +pcl-cvs : $(buildinfodir)/pcl-cvs$(INFO_EXT) +$(buildinfodir)/pcl-cvs$(INFO_EXT): ${srcdir}/pcl-cvs.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/pcl-cvs.texi pcl-cvs.dvi: ${srcdir}/pcl-cvs.texi @@ -507,8 +507,8 @@ pcl-cvs.dvi: ${srcdir}/pcl-cvs.texi pcl-cvs.pdf: ${srcdir}/pcl-cvs.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/pcl-cvs.texi -pgg : $(infodir)/pgg$(INFO_EXT) -$(infodir)/pgg$(INFO_EXT): ${srcdir}/pgg.texi +pgg : $(buildinfodir)/pgg$(INFO_EXT) +$(buildinfodir)/pgg$(INFO_EXT): ${srcdir}/pgg.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/pgg.texi pgg.dvi: ${srcdir}/pgg.texi @@ -516,8 +516,8 @@ pgg.dvi: ${srcdir}/pgg.texi pgg.pdf: ${srcdir}/pgg.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/pgg.texi -rcirc : $(infodir)/rcirc$(INFO_EXT) -$(infodir)/rcirc$(INFO_EXT): ${srcdir}/rcirc.texi +rcirc : $(buildinfodir)/rcirc$(INFO_EXT) +$(buildinfodir)/rcirc$(INFO_EXT): ${srcdir}/rcirc.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/rcirc.texi rcirc.dvi: ${srcdir}/rcirc.texi @@ -525,8 +525,8 @@ rcirc.dvi: ${srcdir}/rcirc.texi rcirc.pdf: ${srcdir}/rcirc.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/rcirc.texi -reftex : $(infodir)/reftex$(INFO_EXT) -$(infodir)/reftex$(INFO_EXT): ${srcdir}/reftex.texi +reftex : $(buildinfodir)/reftex$(INFO_EXT) +$(buildinfodir)/reftex$(INFO_EXT): ${srcdir}/reftex.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/reftex.texi reftex.dvi: ${srcdir}/reftex.texi @@ -534,8 +534,8 @@ reftex.dvi: ${srcdir}/reftex.texi reftex.pdf: ${srcdir}/reftex.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/reftex.texi -remember : $(infodir)/remember$(INFO_EXT) -$(infodir)/remember$(INFO_EXT): ${srcdir}/remember.texi +remember : $(buildinfodir)/remember$(INFO_EXT) +$(buildinfodir)/remember$(INFO_EXT): ${srcdir}/remember.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/remember.texi remember.dvi: ${srcdir}/remember.texi @@ -543,8 +543,8 @@ remember.dvi: ${srcdir}/remember.texi remember.pdf: ${srcdir}/remember.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/remember.texi -sasl : $(infodir)/sasl$(INFO_EXT) -$(infodir)/sasl$(INFO_EXT): ${srcdir}/sasl.texi +sasl : $(buildinfodir)/sasl$(INFO_EXT) +$(buildinfodir)/sasl$(INFO_EXT): ${srcdir}/sasl.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/sasl.texi sasl.dvi: ${srcdir}/sasl.texi @@ -552,8 +552,8 @@ sasl.dvi: ${srcdir}/sasl.texi sasl.pdf: ${srcdir}/sasl.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/sasl.texi -sc : $(infodir)/sc$(INFO_EXT) -$(infodir)/sc$(INFO_EXT): ${srcdir}/sc.texi +sc : $(buildinfodir)/sc$(INFO_EXT) +$(buildinfodir)/sc$(INFO_EXT): ${srcdir}/sc.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/sc.texi sc.dvi: ${srcdir}/sc.texi @@ -561,8 +561,8 @@ sc.dvi: ${srcdir}/sc.texi sc.pdf: ${srcdir}/sc.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/sc.texi -semantic : $(infodir)/semantic$(INFO_EXT) -$(infodir)/semantic$(INFO_EXT): ${srcdir}/semantic.texi ${srcdir}/sem-user.texi +semantic : $(buildinfodir)/semantic$(INFO_EXT) +$(buildinfodir)/semantic$(INFO_EXT): ${srcdir}/semantic.texi ${srcdir}/sem-user.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/semantic.texi semantic.dvi: ${srcdir}/semantic.texi ${srcdir}/sem-user.texi @@ -570,8 +570,8 @@ semantic.dvi: ${srcdir}/semantic.texi ${srcdir}/sem-user.texi semantic.pdf: ${srcdir}/semantic.texi ${srcdir}/sem-user.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/semantic.texi -ses : $(infodir)/ses$(INFO_EXT) -$(infodir)/ses$(INFO_EXT): ${srcdir}/ses.texi +ses : $(buildinfodir)/ses$(INFO_EXT) +$(buildinfodir)/ses$(INFO_EXT): ${srcdir}/ses.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ses.texi ses.dvi: ${srcdir}/ses.texi @@ -579,8 +579,8 @@ ses.dvi: ${srcdir}/ses.texi ses.pdf: ${srcdir}/ses.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/ses.texi -sieve : $(infodir)/sieve$(INFO_EXT) -$(infodir)/sieve$(INFO_EXT): ${srcdir}/sieve.texi +sieve : $(buildinfodir)/sieve$(INFO_EXT) +$(buildinfodir)/sieve$(INFO_EXT): ${srcdir}/sieve.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/sieve.texi sieve.dvi: ${srcdir}/sieve.texi @@ -588,8 +588,8 @@ sieve.dvi: ${srcdir}/sieve.texi sieve.pdf: ${srcdir}/sieve.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/sieve.texi -smtpmail : $(infodir)/smtpmail$(INFO_EXT) -$(infodir)/smtpmail$(INFO_EXT): ${srcdir}/smtpmail.texi +smtpmail : $(buildinfodir)/smtpmail$(INFO_EXT) +$(buildinfodir)/smtpmail$(INFO_EXT): ${srcdir}/smtpmail.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/smtpmail.texi smtpmail.dvi: ${srcdir}/smtpmail.texi @@ -597,8 +597,8 @@ smtpmail.dvi: ${srcdir}/smtpmail.texi smtpmail.pdf: ${srcdir}/smtpmail.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/smtpmail.texi -speedbar : $(infodir)/speedbar$(INFO_EXT) -$(infodir)/speedbar$(INFO_EXT): ${srcdir}/speedbar.texi +speedbar : $(buildinfodir)/speedbar$(INFO_EXT) +$(buildinfodir)/speedbar$(INFO_EXT): ${srcdir}/speedbar.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/speedbar.texi speedbar.dvi: ${srcdir}/speedbar.texi @@ -606,8 +606,8 @@ speedbar.dvi: ${srcdir}/speedbar.texi speedbar.pdf: ${srcdir}/speedbar.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/speedbar.texi -tramp : $(infodir)/tramp$(INFO_EXT) -$(infodir)/tramp$(INFO_EXT): ${srcdir}/tramp.texi ${srcdir}/trampver.texi +tramp : $(buildinfodir)/tramp$(INFO_EXT) +$(buildinfodir)/tramp$(INFO_EXT): ${srcdir}/tramp.texi ${srcdir}/trampver.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ -D emacs ${srcdir}/tramp.texi tramp.dvi: ${srcdir}/tramp.texi ${srcdir}/trampver.texi @@ -615,8 +615,8 @@ tramp.dvi: ${srcdir}/tramp.texi ${srcdir}/trampver.texi tramp.pdf: ${srcdir}/tramp.texi ${srcdir}/trampver.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/tramp.texi -url : $(infodir)/url$(INFO_EXT) -$(infodir)/url$(INFO_EXT): ${srcdir}/url.texi +url : $(buildinfodir)/url$(INFO_EXT) +$(buildinfodir)/url$(INFO_EXT): ${srcdir}/url.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/url.texi url.dvi: ${srcdir}/url.texi @@ -624,8 +624,8 @@ url.dvi: ${srcdir}/url.texi url.pdf: ${srcdir}/url.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/url.texi -vip : $(infodir)/vip$(INFO_EXT) -$(infodir)/vip$(INFO_EXT): ${srcdir}/vip.texi +vip : $(buildinfodir)/vip$(INFO_EXT) +$(buildinfodir)/vip$(INFO_EXT): ${srcdir}/vip.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/vip.texi vip.dvi: ${srcdir}/vip.texi @@ -633,8 +633,8 @@ vip.dvi: ${srcdir}/vip.texi vip.pdf: ${srcdir}/vip.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/vip.texi -viper : $(infodir)/viper$(INFO_EXT) -$(infodir)/viper$(INFO_EXT): ${srcdir}/viper.texi +viper : $(buildinfodir)/viper$(INFO_EXT) +$(buildinfodir)/viper$(INFO_EXT): ${srcdir}/viper.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/viper.texi viper.dvi: ${srcdir}/viper.texi @@ -642,8 +642,8 @@ viper.dvi: ${srcdir}/viper.texi viper.pdf: ${srcdir}/viper.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/viper.texi -widget : $(infodir)/widget$(INFO_EXT) -$(infodir)/widget$(INFO_EXT): ${srcdir}/widget.texi +widget : $(buildinfodir)/widget$(INFO_EXT) +$(buildinfodir)/widget$(INFO_EXT): ${srcdir}/widget.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/widget.texi widget.dvi: ${srcdir}/widget.texi @@ -651,8 +651,8 @@ widget.dvi: ${srcdir}/widget.texi widget.pdf: ${srcdir}/widget.texi $(ENVADD) $(TEXI2PDF) ${srcdir}/widget.texi -woman : $(infodir)/woman$(INFO_EXT) -$(infodir)/woman$(INFO_EXT): ${srcdir}/woman.texi +woman : $(buildinfodir)/woman$(INFO_EXT) +$(buildinfodir)/woman$(INFO_EXT): ${srcdir}/woman.texi $(mkinfodir) $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/woman.texi woman.dvi: ${srcdir}/woman.texi @@ -675,9 +675,9 @@ clean: mostlyclean distclean: clean # rm -f Makefile -## infodir is relative to srcdir. +## buildinfodir is relative to srcdir. maintainer-clean: distclean - cd $(infodir); for file in $(INFO_TARGETS); do \ + cd $(buildinfodir); for file in $(INFO_TARGETS); do \ file=`echo $${file} | sed 's/\.info$$//'`${INFO_EXT}; \ rm -f $${file} $${file}-[1-9] $${file}-[1-9][0-9]; \ done diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index 61ca34b8d2f..fe11cedce5d 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -218,7 +218,7 @@ and what are the various ways that it can be used. * Notations Used in This Manual:: * Demonstration of Calc:: * Using Calc:: -* History and Acknowledgements:: +* History and Acknowledgments:: @end menu @node What is Calc, About This Manual, Getting Started, Getting Started @@ -582,7 +582,7 @@ about the @w{@kbd{t N}} command, @kbd{h f sqrt @key{RET}} to read about the Press @key{DEL} repeatedly to remove any leftover results from the stack. To exit from Calc, press @kbd{q} or @kbd{C-x * c} again. -@node Using Calc, History and Acknowledgements, Demonstration of Calc, Getting Started +@node Using Calc, History and Acknowledgments, Demonstration of Calc, Getting Started @section Using Calc @noindent @@ -1148,8 +1148,8 @@ and record them as the current keyboard macro. its initial state: Empty stack, and initial mode settings. @end table -@node History and Acknowledgements, , Using Calc, Getting Started -@section History and Acknowledgements +@node History and Acknowledgments, , Using Calc, Getting Started +@section History and Acknowledgments @noindent Calc was originally started as a two-week project to occupy a lull @@ -27779,7 +27779,7 @@ acres per meter-second.) Remainder units are expressed in terms of input units. If you want to disallow using inconsistent units, you can set the customizable variable -@code{calc-ensure-consistent-units} to @code{t} (@pxref{Customizing Calc}). In this case, +@code{calc-ensure-consistent-units} to @code{t} (@pxref{Customizing Calc}). In this case, if you request units which are inconsistent with the original units, you will be warned about it and no conversion will occur. @@ -35597,15 +35597,15 @@ of @code{calc-multiplication-has-precedence} is @code{t}. @end defvar @defvar calc-ensure-consistent-units -When converting units, the variable @code{calc-ensure-consistent-units} -determines whether or not the target units need to be consistent with the +When converting units, the variable @code{calc-ensure-consistent-units} +determines whether or not the target units need to be consistent with the original units. If @code{calc-ensure-consistent-units} is @code{nil}, then -the target units don't need to have the same dimensions as the original units; -for example, converting @samp{100 ft/s} to @samp{m} will produce @samp{30.48 m/s}. -If @code{calc-ensure-consistent-units} is non-@code{nil}, then the target units -need to have the same dimensions as the original units; for example, converting -@samp{100 ft/s} to @samp{m} will result in an error, since @samp{ft/s} and @samp{m} -have different dimensions. The default value of @code{calc-ensure-consistent-units} +the target units don't need to have the same dimensions as the original units; +for example, converting @samp{100 ft/s} to @samp{m} will produce @samp{30.48 m/s}. +If @code{calc-ensure-consistent-units} is non-@code{nil}, then the target units +need to have the same dimensions as the original units; for example, converting +@samp{100 ft/s} to @samp{m} will result in an error, since @samp{ft/s} and @samp{m} +have different dimensions. The default value of @code{calc-ensure-consistent-units} is @code{nil}. @end defvar diff --git a/doc/misc/ede.texi b/doc/misc/ede.texi index f7e39b6c65c..655d11b5d17 100644 --- a/doc/misc/ede.texi +++ b/doc/misc/ede.texi @@ -790,7 +790,7 @@ compilers that will be inserted into the Makefile. Compiler instantiations must also insert variables specifying the compiler it plans to use, in addition to creating Automake settings for -@file{configure.in} when appropriate. +@file{configure.ac} when appropriate. Compiler objects are stored in the target objects as a list of symbols, where the symbols value is the object. This enables the @@ -1557,7 +1557,7 @@ For project @var{THIS}, test that the file @var{FILE} exists, or create it. @deffn Method ede-proj-setup-buildenvironment :AFTER this &optional force Setup the build environment for project @var{THIS}. -Handles the Makefile, or a Makefile.am configure.in combination. +Handles the Makefile, or a Makefile.am configure.ac combination. Optional argument @var{FORCE} will force items to be regenerated. @end deffn @@ -1567,7 +1567,7 @@ These are removed with make clean. @end deffn @deffn Method ede-proj-configure-synchronize :AFTER this -Synchronize what we know about project @var{THIS} into configure.in. +Synchronize what we know about project @var{THIS} into configure.ac. @end deffn @deffn Method ede-proj-makefile-insert-variables-new :AFTER this @@ -1603,7 +1603,7 @@ Return the name of the Makefile with the DIST target in it for @var{THIS}. @end deffn @deffn Method ede-proj-configure-file :AFTER this -The configure.in script used by project @var{THIS}. +The configure.ac script used by project @var{THIS}. @end deffn @deffn Method ede-commit-project :AFTER proj @@ -1767,7 +1767,7 @@ Create a Makefile for all Makefile targets in @var{THIS} if needed. @deffn Method ede-proj-setup-buildenvironment :AFTER this &optional force Setup the build environment for project @var{THIS}. -Handles the Makefile, or a Makefile.am configure.in combination. +Handles the Makefile, or a Makefile.am configure.ac combination. Optional argument @var{FORCE} will force items to be regenerated. @end deffn diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 71a06d4461a..df4493789b6 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -8,7 +8,7 @@ @syncodeindex vr cp @syncodeindex pg cp -@documentencoding ISO-8859-1 +@documentencoding UTF-8 @copying Copyright @copyright{} 1995-2012 Free Software Foundation, Inc. @@ -663,7 +663,6 @@ Getting News * Direct Functions:: Connecting directly to the server. * Indirect Functions:: Connecting indirectly to the server. * Common Variables:: Understood by several connection functions. -* NNTP marks:: Storing marks for @acronym{NNTP} servers. Getting Mail @@ -816,7 +815,6 @@ Various * Formatting Variables:: You can specify what buffers should look like. * Window Layout:: Configuring the Gnus buffer windows. * Faces and Fonts:: How to change how faces look. -* Compilation:: How to speed Gnus up. * Mode Lines:: Displaying information in the mode lines. * Highlighting and Menus:: Making buffers look all nice and cozy. * Daemons:: Gnus can do things behind your back. @@ -907,7 +905,8 @@ New Features * Quassia Gnus:: Two times two is four, or Gnus 5.6/5.7. * Pterodactyl Gnus:: Pentad also starts with P, AKA Gnus 5.8/5.9. * Oort Gnus:: It's big. It's far out. Gnus 5.10/5.11. -* No Gnus:: Very punny. +* No Gnus:: Very punny. Gnus 5.12/5.13 +* Ma Gnus:: Celebrating 25 years of Gnus. Customization @@ -1066,10 +1065,6 @@ you would typically set this variable to (setq gnus-secondary-select-methods '((nnmbox ""))) @end lisp -Note: the @acronym{NNTP} back end stores marks in marks files -(@pxref{NNTP marks}). This feature makes it easy to share marks between -several Gnus installations, but may slow down things a bit when fetching -new articles. @xref{NNTP marks}, for more information. @node The Server is Down @@ -2884,7 +2879,7 @@ composed messages will be @code{Gcc}'d to the current group. If generated, if @code{(gcc-self . "string")} is present, this string will be inserted literally as a @code{gcc} header. This parameter takes precedence over any default @code{Gcc} rules as described later -(@pxref{Archived Messages}). +(@pxref{Archived Messages}), with the exception for messages to resend. @strong{Caveat}: Adding @code{(gcc-self . t)} to the parameter list of @code{nntp} groups (or the like) isn't valid. An @code{nntp} server @@ -3027,6 +3022,7 @@ like this in the group parameters: @example (posting-style (name "Funky Name") + ("X-Message-SMTP-Method" "smtp smtp.example.org 587") ("X-My-Header" "Funky Value") (signature "Funky Signature")) @end example @@ -4293,12 +4289,11 @@ default is @code{nil} in Emacs, or is the aliasee of the coding system named @code{file-name} (a certain coding system of which an alias is @code{file-name}) in XEmacs. -The @code{nnml} back end, the @code{nnrss} back end, the @acronym{NNTP} -marks feature (@pxref{NNTP marks}), the agent, and the cache use -non-@acronym{ASCII} group names in those files and directories. This -variable overrides the value of @code{file-name-coding-system} which -specifies the coding system used when encoding and decoding those file -names and directory names. +The @code{nnml} back end, the @code{nnrss} back end, the agent, and +the cache use non-@acronym{ASCII} group names in those files and +directories. This variable overrides the value of +@code{file-name-coding-system} which specifies the coding system used +when encoding and decoding those file names and directory names. In XEmacs (with the @code{mule} feature), @code{file-name-coding-system} is the only means to specify the coding system used to encode and decode @@ -8986,7 +8981,7 @@ Translate many non-@acronym{ASCII} characters into their @acronym{ASCII} equivalents (@code{gnus-article-treat-non-ascii}). This is mostly useful if you're on a terminal that has a limited font and doesn't show accented characters, ``advanced'' punctuation, and the -like. For instance, @samp{} is translated into @samp{>>}, and so on. +like. For instance, @samp{»} is translated into @samp{>>}, and so on. @item W Y f @kindex W Y f (Summary) @@ -10819,12 +10814,6 @@ buffers. For example: Also @pxref{Group Parameters}. -@vindex gnus-propagate-marks -@item gnus-propagate-marks -If non-@code{nil}, propagate marks to the backends for possible -storing. @xref{NNTP marks}, and friends, for a more fine-grained -sieve. - @end table @@ -12404,32 +12393,25 @@ value suitable for your system. @xref{Mail Variables, ,Mail Variables,message,Message manual}, for more information. + @node POP before SMTP @section POP before SMTP @cindex pop before smtp -@findex message-smtpmail-send-it @findex mail-source-touch-pop -Does your @acronym{ISP} require the @acronym{POP}-before-@acronym{SMTP} -authentication? It is whether you need to connect to the @acronym{POP} -mail server within a certain time before sending mails. If so, there is -a convenient way. To do that, put the following lines in your -@file{~/.gnus.el} file: +Does your @acronym{ISP} use @acronym{POP}-before-@acronym{SMTP} +authentication? This authentication method simply requires you to +contact the @acronym{POP} server before sending email. To do that, +put the following lines in your @file{~/.gnus.el} file: @lisp -(setq message-send-mail-function 'message-smtpmail-send-it) (add-hook 'message-send-mail-hook 'mail-source-touch-pop) @end lisp @noindent -It means to let Gnus connect to the @acronym{POP} mail server in advance -whenever you send a mail. The @code{mail-source-touch-pop} function -does only a @acronym{POP} authentication according to the value of -@code{mail-sources} without fetching mails, just before sending a mail. -Note that you have to use @code{message-smtpmail-send-it} which runs -@code{message-send-mail-hook} rather than @code{smtpmail-send-it} and -set the value of @code{mail-sources} for a @acronym{POP} connection -correctly. @xref{Mail Sources}. +The @code{mail-source-touch-pop} function does @acronym{POP} +authentication according to the value of @code{mail-sources} without +fetching mails, just before sending a mail. @xref{Mail Sources}. If you have two or more @acronym{POP} mail servers set in @code{mail-sources}, you may want to specify one of them to @@ -12457,6 +12439,7 @@ Otherwise, bind it dynamically only when performing the (mail-source-touch-pop)))) @end lisp + @node Mail and Post @section Mail and Post @@ -12674,6 +12657,35 @@ and matches the Gcc group name, attach files as external parts; if it is non-@code{nil}, the behavior is the same as @code{all}, but it may be changed in the future. +@item gnus-gcc-self-resent-messages +@vindex gnus-gcc-self-resent-messages +Like the @code{gcc-self} group parameter, applied only for unmodified +messages that @code{gnus-summary-resend-message} (@pxref{Summary Mail +Commands}) resends. Non-@code{nil} value of this variable takes +precedence over any existing @code{Gcc} header. + +If this is @code{none}, no @code{Gcc} copy will be made. If this is +@code{t}, messages resent will be @code{Gcc} copied to the current +group. If this is a string, it specifies a group to which resent +messages will be @code{Gcc} copied. If this is @code{nil}, @code{Gcc} +will be done according to existing @code{Gcc} header(s), if any. If +this is @code{no-gcc-self}, that is the default, resent messages will be +@code{Gcc} copied to groups that existing @code{Gcc} header specifies, +except for the current group. + +@item gnus-gcc-pre-body-encode-hook +@vindex gnus-gcc-pre-body-encode-hook +@itemx gnus-gcc-post-body-encode-hook +@vindex gnus-gcc-post-body-encode-hook + +These hooks are run before/after encoding the message body of the Gcc +copy of a sent message. The current buffer (when the hook is run) +contains the message including the message header. Changes made to +the message will only affect the Gcc copy, but not the original +message. You can use these hooks to edit the copy (and influence +subsequent transformations), e.g. remove MML secure tags +(@pxref{Signing and encrypting}). + @end table @@ -12805,6 +12817,7 @@ So here's a new example: (signature-file "~/.work-signature") (address "user@@bar.foo") (body "You are fired.\n\nSincerely, your boss.") + ("X-Message-SMTP-Method" "smtp smtp.example.org 587") (organization "Important Work, Inc")) ("nnml:.*" (From (with-current-buffer gnus-article-buffer @@ -12819,6 +12832,13 @@ if you fill many roles. You may also use @code{message-alternative-emails} instead. @xref{Message Headers, ,Message Headers, message, Message Manual}. +Of particular interest in the ``work-mail'' style is the +@samp{X-Message-SMTP-Method} header. It specifies how to send the +outgoing email. You may want to sent certain emails through certain +@acronym{SMTP} servers due to company policies, for instance. +@xref{Mail Variables, ,Message Variables, message, Message Manual}. + + @node Drafts @section Drafts @cindex drafts @@ -13744,7 +13764,6 @@ don't update their active files often, this can help. * Direct Functions:: Connecting directly to the server. * Indirect Functions:: Connecting indirectly to the server. * Common Variables:: Understood by several connection functions. -* NNTP marks:: Storing marks for @acronym{NNTP} servers. @end menu @@ -14015,53 +14034,6 @@ is @samp{()}. @end table -@node NNTP marks -@subsubsection NNTP marks -@cindex storing NNTP marks - -Gnus stores marks (@pxref{Marking Articles}) for @acronym{NNTP} -servers in marks files. A marks file records what marks you have set -in a group and each file is specific to the corresponding server. -Marks files are stored in @file{~/News/marks} -(@code{nntp-marks-directory}) under a classic hierarchy resembling -that of a news server, for example marks for the group -@samp{gmane.discuss} on the news.gmane.org server will be stored in -the file @file{~/News/marks/news.gmane.org/gmane/discuss/.marks}. - -Marks files are useful because you can copy the @file{~/News/marks} -directory (using rsync, scp or whatever) to another Gnus installation, -and it will realize what articles you have read and marked. The data -in @file{~/News/marks} has priority over the same data in -@file{~/.newsrc.eld}. - -Note that marks files are very much server-specific: Gnus remembers -the article numbers so if you don't use the same servers on both -installations things are most likely to break (most @acronym{NNTP} -servers do not use the same article numbers as any other server). -However, if you use servers A, B, C on one installation and servers A, -D, E on the other, you can sync the marks files for A and then you'll -get synchronization for that server between the two installations. - -Using @acronym{NNTP} marks can possibly incur a performance penalty so -if Gnus feels sluggish, try setting the @code{nntp-marks-is-evil} -variable to @code{t}. Marks will then be stored in @file{~/.newsrc.eld}. - -Related variables: - -@table @code - -@item nntp-marks-is-evil -@vindex nntp-marks-is-evil -If non-@code{nil}, this back end will ignore any marks files. The -default is @code{nil}. - -@item nntp-marks-directory -@vindex nntp-marks-directory -The directory where marks for nntp groups will be stored. - -@end table - - @node News Spool @subsection News Spool @cindex nnspool @@ -16152,22 +16124,6 @@ splitting. It has to create lots of files, and it also generates @acronym{NOV} databases for the incoming mails. This makes it possibly the fastest back end when it comes to reading mail. -@cindex self contained nnml servers -@cindex marks -When the marks file is used (which it is by default), @code{nnml} -servers have the property that you may backup them using @code{tar} or -similar, and later be able to restore them into Gnus (by adding the -proper @code{nnml} server) and have all your marks be preserved. Marks -for a group are usually stored in the @code{.marks} file (but see -@code{nnml-marks-file-name}) within each @code{nnml} group's directory. -Individual @code{nnml} groups are also possible to backup, use @kbd{G m} -to restore the group (after restoring the backup into the nnml -directory). - -If for some reason you believe your @file{.marks} files are screwed -up, you can just delete them all. Gnus will then correctly regenerate -them next time it starts. - Virtual server settings: @table @code @@ -16205,15 +16161,6 @@ The name of the @acronym{NOV} files. The default is @file{.overview}. @vindex nnml-prepare-save-mail-hook Hook run narrowed to an article before saving. -@item nnml-marks-is-evil -@vindex nnml-marks-is-evil -If non-@code{nil}, this back end will ignore any @sc{marks} files. The -default is @code{nil}. - -@item nnml-marks-file-name -@vindex nnml-marks-file-name -The name of the @dfn{marks} files. The default is @file{.marks}. - @item nnml-use-compressed-files @vindex nnml-use-compressed-files If non-@code{nil}, @code{nnml} will allow using compressed message @@ -16554,19 +16501,6 @@ separate file. Each file is in the standard Un*x mbox format. @code{nnfolder} will add extra headers to keep track of article numbers and arrival dates. -@cindex self contained nnfolder servers -@cindex marks -When the marks file is used (which it is by default), @code{nnfolder} -servers have the property that you may backup them using @code{tar} or -similar, and later be able to restore them into Gnus (by adding the -proper @code{nnfolder} server) and have all your marks be preserved. -Marks for a group are usually stored in a file named as the mbox file -with @code{.mrk} concatenated to it (but see -@code{nnfolder-marks-file-suffix}) within the @code{nnfolder} -directory. Individual @code{nnfolder} groups are also possible to -backup, use @kbd{G m} to restore the group (after restoring the backup -into the @code{nnfolder} directory). - Virtual server settings: @table @code @@ -16625,20 +16559,6 @@ The extension for @acronym{NOV} files. The default is @file{.nov}. The directory where the @acronym{NOV} files should be stored. If @code{nil}, @code{nnfolder-directory} is used. -@item nnfolder-marks-is-evil -@vindex nnfolder-marks-is-evil -If non-@code{nil}, this back end will ignore any @sc{marks} files. The -default is @code{nil}. - -@item nnfolder-marks-file-suffix -@vindex nnfolder-marks-file-suffix -The extension for @sc{marks} files. The default is @file{.mrk}. - -@item nnfolder-marks-directory -@vindex nnfolder-marks-directory -The directory where the @sc{marks} files should be stored. If -@code{nil}, @code{nnfolder-directory} is used. - @end table @@ -16799,9 +16719,7 @@ undergo treatment such as duplicate checking. @code{nnmaildir} stores article marks for a given group in the corresponding maildir, in a way designed so that it's easy to manipulate them from outside Gnus. You can tar up a maildir, unpack it somewhere -else, and still have your marks. @code{nnml} also stores marks, but -it's not as easy to work with them from outside Gnus as with -@code{nnmaildir}. +else, and still have your marks. @code{nnmaildir} uses a significant amount of memory to speed things up. (It keeps in memory some of the things that @code{nnml} stores in files @@ -16893,16 +16811,6 @@ adding a server definition pointing to that directory in Gnus. The might interfere with overwriting data, so you may want to shut down Gnus before you restore the data. -It is also possible to archive individual @code{nnml}, -@code{nnfolder}, or @code{nnmaildir} groups, while preserving marks. -For @code{nnml} or @code{nnmaildir}, you copy all files in the group's -directory. For @code{nnfolder} you need to copy both the base folder -file itself (@file{FOO}, say), and the marks file (@file{FOO.mrk} in -this example). Restoring the group is done with @kbd{G m} from the Group -buffer. The last step makes Gnus notice the new directory. -@code{nnmaildir} notices the new directory automatically, so @kbd{G m} -is unnecessary in that case. - @node Web Searches @subsection Web Searches @cindex nnweb @@ -20875,7 +20783,7 @@ then this operator will return @code{false}. @item ! @itemx not -@itemx +@itemx ¬ This logical operator only takes a single argument. It returns the logical negation of the value of its argument. @@ -22168,7 +22076,6 @@ to you, using @kbd{G b u} and updating the group will usually fix this. * Formatting Variables:: You can specify what buffers should look like. * Window Layout:: Configuring the Gnus buffer windows. * Faces and Fonts:: How to change how faces look. -* Compilation:: How to speed Gnus up. * Mode Lines:: Displaying information in the mode lines. * Highlighting and Menus:: Making buffers look all nice and cozy. * Daemons:: Gnus can do things behind your back. @@ -22465,11 +22372,6 @@ than 6 characters to make it look nice in columns.) Ignoring is done first; then cutting; then maxing; and then as the very last operation, padding. -If you use lots of these advanced thingies, you'll find that Gnus gets -quite slow. This can be helped enormously by running @kbd{M-x -gnus-compile} when you are satisfied with the look of your lines. -@xref{Compilation}. - @node User-Defined Specs @subsection User-Defined Specs @@ -22515,7 +22417,7 @@ and so on. Create as many faces as you wish. The same goes for the @samp{hello} mouse-highlighted with @code{gnus-mouse-face-3}. @cindex %<<, %>>, guillemets -@c @cindex %<<, %>>, %, %, guillemets +@c @cindex %<<, %>>, %«, %», guillemets @vindex gnus-balloon-face-0 Text inside the @samp{%<<} and @samp{%>>} specifiers will get the special @code{balloon-help} property set to @@ -22978,30 +22880,6 @@ the face you want to alter, and alter it via the standard Customize interface. -@node Compilation -@section Compilation -@cindex compilation -@cindex byte-compilation - -@findex gnus-compile - -Remember all those line format specification variables? -@code{gnus-summary-line-format}, @code{gnus-group-line-format}, and so -on. Now, Gnus will of course heed whatever these variables are, but, -unfortunately, changing them will mean a quite significant slow-down. -(The default values of these variables have byte-compiled functions -associated with them, while the user-generated versions do not, of -course.) - -To help with this, you can run @kbd{M-x gnus-compile} after you've -fiddled around with the variables and feel that you're (kind of) -satisfied. This will result in the new specs being byte-compiled, and -you'll get top speed again. Gnus will save these compiled specs in the -@file{.newsrc.eld} file. (User-defined functions aren't compiled by -this function, though---you should compile them yourself by sticking -them into the @file{~/.gnus.el} file and byte-compiling that file.) - - @node Mode Lines @section Mode Lines @cindex mode lines @@ -23656,6 +23534,10 @@ The variable @code{gnus-picon-style} controls how picons are displayed. If @code{inline}, the textual representation is replaced. If @code{right}, picons are added right to the textual representation. +@vindex gnus-picon-properties +The value of the variable @code{gnus-picon-properties} is a list of +properties applied to picons. + The following variables offer control over where things are located. @table @code @@ -26409,6 +26291,7 @@ renamed it back again to ``Gnus''. But in mixed case. ``Gnus'' vs. @cindex Pterodactyl Gnus @cindex Oort Gnus @cindex No Gnus +@cindex Ma Gnus @cindex Gnus versions The first ``proper'' release of Gnus 5 was done in November 1995 when it @@ -26437,12 +26320,15 @@ On April 19, 2010 Gnus development was moved to Git. See http://git.gnus.org for details (http://www.gnus.org will be updated with the information when possible). +On the January 31th 2012, Ma Gnus was begun. + If you happen upon a version of Gnus that has a prefixed name -- ``(ding) Gnus'', ``September Gnus'', ``Red Gnus'', ``Quassia Gnus'', -``Pterodactyl Gnus'', ``Oort Gnus'', ``No Gnus'' -- don't panic. -Don't let it know that you're frightened. Back away. Slowly. Whatever -you do, don't run. Walk away, calmly, until you're out of its reach. -Find a proper released version of Gnus and snuggle up to that instead. +``Pterodactyl Gnus'', ``Oort Gnus'', ``No Gnus'', ``Ma Gnus'' -- don't +panic. Don't let it know that you're frightened. Back away. Slowly. +Whatever you do, don't run. Walk away, calmly, until you're out of +its reach. Find a proper released version of Gnus and snuggle up to +that instead. @node Why? @@ -27045,7 +26931,8 @@ actually are people who are using Gnus. Who'd'a thunk it! * Quassia Gnus:: Two times two is four, or Gnus 5.6/5.7. * Pterodactyl Gnus:: Pentad also starts with P, AKA Gnus 5.8/5.9. * Oort Gnus:: It's big. It's far out. Gnus 5.10/5.11. -* No Gnus:: Very punny. +* No Gnus:: Very punny. Gnus 5.12/5.13. +* Ma Gnus:: Celebrating 25 years of Gnus. @end menu These lists are, of course, just @emph{short} overviews of the @@ -28420,6 +28307,32 @@ New features in No Gnus: @include gnus-news.texi +@node Ma Gnus +@subsubsection Ma Gnus +@cindex Ma Gnus + +I'm sure there will be lots of text here. It's really spelled 真 +Gnus. + +New features in Ma Gnus: + +@itemize @bullet + +@item Changes in Message mode and related Gnus features +@c **************************************************** + +@itemize @bullet + +@item +The new hooks @code{gnus-gcc-pre-body-encode-hook} and +@code{gnus-gcc-post-body-encode-hook} are run before/after encoding +the message body of the Gcc copy of a sent message. See +@xref{Archived Messages}. + +@end itemize + +@end itemize + @iftex @page @@ -30642,5 +30555,5 @@ former). The manual is unambiguous, but it can be confusing. @c Local Variables: @c mode: texinfo -@c coding: iso-8859-1 +@c coding: utf-8 @c End: diff --git a/doc/misc/idlwave.texi b/doc/misc/idlwave.texi index 736c6ce7f91..030653bbe6d 100644 --- a/doc/misc/idlwave.texi +++ b/doc/misc/idlwave.texi @@ -71,7 +71,7 @@ Interactive Data Language (IDL), and running IDL as an inferior shell. * Getting Started:: Tutorial * The IDLWAVE Major Mode:: The mode for editing IDL programs * The IDLWAVE Shell:: The mode for running IDL as an inferior program -* Acknowledgements:: Who did what +* Acknowledgments:: Who did what * Sources of Routine Info:: How does IDLWAVE know about routine XYZ * HTML Help Browser Tips:: * Configuration Examples:: The user is king @@ -2361,7 +2361,7 @@ Normal hook. Executed when a buffer is put into @code{idlwave-mode}. Normal hook. Executed when @file{idlwave.el} is loaded. @end defopt -@node The IDLWAVE Shell, Acknowledgements, The IDLWAVE Major Mode, Top +@node The IDLWAVE Shell, Acknowledgments, The IDLWAVE Major Mode, Top @chapter The IDLWAVE Shell @cindex IDLWAVE shell @cindex Major mode, @code{idlwave-shell-mode} @@ -3273,9 +3273,9 @@ examine command strings to send, after all instances of @code{___} (three underscores) are replaced by the indicated expression. @end defopt -@node Acknowledgements, Sources of Routine Info, The IDLWAVE Shell, Top -@chapter Acknowledgements -@cindex Acknowledgements +@node Acknowledgments, Sources of Routine Info, The IDLWAVE Shell, Top +@chapter Acknowledgments +@cindex Acknowledgments @cindex Maintainer, of IDLWAVE @cindex Authors, of IDLWAVE @cindex Contributors, to IDLWAVE @@ -3352,7 +3352,7 @@ scripts and documentation to interface with the IDL Assistant. @noindent Thanks to everyone! -@node Sources of Routine Info, HTML Help Browser Tips, Acknowledgements, Top +@node Sources of Routine Info, HTML Help Browser Tips, Acknowledgments, Top @appendix Sources of Routine Info @cindex Sources of routine information diff --git a/doc/misc/message.texi b/doc/misc/message.texi index ac5811a0ce8..ef752a96fdc 100644 --- a/doc/misc/message.texi +++ b/doc/misc/message.texi @@ -1637,6 +1637,40 @@ To the thing similar to this, there is requires the @acronym{POP}-before-@acronym{SMTP} authentication. @xref{POP before SMTP, , POP before SMTP, gnus, The Gnus Manual}. +@cindex X-Message-SMTP-Method +If you have a complex @acronym{SMTP} setup, and want some messages to +go via one mail server, and other messages to go through another, you +can use the @samp{X-Message-SMTP-Method} header. These are the +supported values: + +@table @samp +@item smtpmail + +@example +X-Message-SMTP-Method: smtp smtp.fsf.org 587 +@end example + +This will send the message via @samp{smtp.fsf.org}, using port 587. + +@example +X-Message-SMTP-Method: smtp smtp.fsf.org 587 other-user +@end example + +This is the same as the above, but uses @samp{other-user} as the user +name when authenticating. This is handy if you have several +@acronym{SMTP} accounts on the same server. + +@item sendmail + +@example +X-Message-SMTP-Method: sendmail +@end example + +This will send the message via the locally installed sendmail/exim/etc +installation. + +@end table + @item message-mh-deletable-headers @vindex message-mh-deletable-headers Most versions of MH doesn't like being fed messages that contain the diff --git a/doc/misc/sc.texi b/doc/misc/sc.texi index 6be385aeba9..a2fe0f68a74 100644 --- a/doc/misc/sc.texi +++ b/doc/misc/sc.texi @@ -221,7 +221,7 @@ for more details.@refill @cindex nested citations @cindex citation -A @dfn{citation} is the acknowledgement of the original author of a mail +A @dfn{citation} is the acknowledgment of the original author of a mail message in the body of the reply. There are two basic citation styles which Supercite supports. The first, called @dfn{nested citations} is an anonymous form of citation; in other words, an indication is made diff --git a/doc/misc/ses.texi b/doc/misc/ses.texi index 8cd2ee813ec..a70bb9c407e 100644 --- a/doc/misc/ses.texi +++ b/doc/misc/ses.texi @@ -71,7 +71,7 @@ To report bugs, send email to @email{jyavner@@member.fsf.org}. * Advanced Features:: Want to know more? * For Gurus:: Want to know @emph{even more}? * Index:: Concept, Function and Variable Index -* Acknowledgements:: Acknowledgements +* Acknowledgments:: Acknowledgments * GNU Free Documentation License:: The license for this documentation. @end menu @@ -927,15 +927,15 @@ cell. @end table @c =================================================================== -@node Index, Acknowledgements, For Gurus, Top +@node Index, Acknowledgments, For Gurus, Top @unnumbered Index @printindex cp @c =================================================================== -@node Acknowledgements, GNU Free Documentation License, Index, Top -@chapter Acknowledgements +@node Acknowledgments, GNU Free Documentation License, Index, Top +@chapter Acknowledgments Coding by: @quotation @@ -976,7 +976,7 @@ Jean-Philippe Theberge @email{jphil@@acs.pagesjaunes.fr} @c =================================================================== -@node GNU Free Documentation License, , Acknowledgements, Top +@node GNU Free Documentation License, , Acknowledgments, Top @appendix GNU Free Documentation License @include doclicense.texi diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index a5a7b2beac7..2b646dd671c 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3,7 +3,7 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2012-06-05.14} +\def\texinfoversion{2012-07-03.16} % % Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, % 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, @@ -4206,7 +4206,7 @@ } \def\ifsetfail{\doignore{ifset}} -% @ifclear VAR ... @end ifclear reads the `...' iff VAR has never been +% @ifclear VAR ... @end executes the `...' iff VAR has never been % defined with @set, or has been undefined with @clear. % % The `\else' inside the `\doifset' parameter is a trick to reuse the @@ -4217,6 +4217,35 @@ \def\ifclear{\parsearg{\doifset{\else \let\next=\ifclearfail}}} \def\ifclearfail{\doignore{ifclear}} +% @ifcommandisdefined CMD ... @end executes the `...' if CMD (written +% without the @) is in fact defined. We can only feasibly check at the +% TeX level, so something like `mathcode' is going to considered +% defined even though it is not a Texinfo command. +% +\makecond{ifcommanddefined} +\def\ifcommanddefined{\parsearg{\doifcmddefined{\let\next=\ifcmddefinedfail}}} +% +\def\doifcmddefined#1#2{{% + \makevalueexpandable + \let\next=\empty + \expandafter\ifx\csname #2\endcsname\relax + #1% If not defined, \let\next as above. + \fi + \expandafter + }\next +} +\def\ifcmddefinedfail{\doignore{ifcommanddefined}} + +% @ifcommandnotdefined CMD ... handlded similar to @ifclear above. +\makecond{ifcommandnotdefined} +\def\ifcommandnotdefined{% + \parsearg{\doifcmddefined{\else \let\next=\ifcmdnotdefinedfail}}} +\def\ifcmdnotdefinedfail{\doignore{ifcommandnotdefined}} + +% Set the `txicommandconditionals' variable, so documents have a way to +% test if the @ifcommand...defined conditionals are available. +\set txicommandconditionals + % @dircategory CATEGORY -- specify a category of the dir file % which this file should belong to. Ignore this in TeX. \let\dircategory=\comment diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 69f0c6d8880..87ad2bc5009 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1327,19 +1327,21 @@ because @samp{/:} is the prefix for quoted file names. @cindex multi-hop @cindex proxy hosts -Sometimes, the methods described before are not sufficient. Sometimes, -it is not possible to connect to a remote host using a simple command. -For example, if you are in a secured network, you might have to log in -to a `bastion host' first before you can connect to the outside world. -Of course, the target host may also require a bastion host. +Sometimes, the methods described before are not sufficient. +Sometimes, it is not possible to connect to a remote host using a +simple command. For example, if you are in a secured network, you +might have to log in to a bastion host first before you can connect to +the outside world. Of course, the target host may also require a +bastion host. @vindex tramp-default-proxies-alist -In order to specify such multiple hops, it is possible to define a proxy +@defopt tramp-default-proxies-alist +In order to specify multiple hops, it is possible to define a proxy host to pass through, via the variable @code{tramp-default-proxies-alist}. This variable keeps a list of triples (@var{host} @var{user} @var{proxy}). - The first matching item specifies the proxy host to be passed for a +The first matching item specifies the proxy host to be passed for a file name located on a remote target matching @var{user}@@@var{host}. @var{host} and @var{user} are regular expressions or @code{nil}, which is interpreted as a regular expression which always matches. @@ -1442,6 +1444,26 @@ following rule: Gateway methods can be declared as first hop only in a multiple hop chain. @end ifset +@end defopt + +Hops to be passed tend to be restricted firewalls and alike. +Sometimes they offer limited features only, like running @command{rbash} +(restricted bash). This must be told to @value{tramp}. + +@vindex tramp-restricted-shell-hosts-alist +@defopt tramp-restricted-shell-hosts-alist +This variable keeps a list of regular expressions, which denote hosts +running a registered shell like "rbash". Those hosts can be used as +proxies only. + +If the bastion host from the example above runs a restricted shell, +you shall apply + +@lisp +(add-to-list 'tramp-restricted-shell-hosts-alist + "\\`bastion\\.your\\.domain\\'") +@end lisp +@end defopt @node Customizing Methods diff --git a/doc/misc/woman.texi b/doc/misc/woman.texi index b8b15a13c76..7f72b5faafb 100644 --- a/doc/misc/woman.texi +++ b/doc/misc/woman.texi @@ -94,7 +94,7 @@ Mile End Road, London E1 4NS, UK * Log:: The *WoMan-Log* Buffer * Technical:: Technical Details * Bugs:: Reporting Bugs -* Acknowledgements:: Acknowledgements +* Acknowledgments:: Acknowledgments * GNU Free Documentation License:: The license for this documentation. * Command Index:: Command Index * Variable Index:: Variable Index @@ -1306,7 +1306,7 @@ is output. @c =================================================================== -@node Bugs, Acknowledgements, Technical, Top +@node Bugs, Acknowledgments, Technical, Top @comment node-name, next, previous, up @chapter Reporting Bugs @cindex reporting bugs @@ -1331,10 +1331,10 @@ man source file from, but do not send it unless asked to send it. @c =================================================================== -@node Acknowledgements, GNU Free Documentation License, Bugs, Top +@node Acknowledgments, GNU Free Documentation License, Bugs, Top @comment node-name, next, previous, up -@chapter Acknowledgements -@cindex acknowledgements +@chapter Acknowledgments +@cindex acknowledgments For Heather, Kathryn and Madelyn, the women in my life (although they will probably never use it)! @@ -1388,7 +1388,7 @@ Eli Zaretskii, @email{eliz@@is.elta.co.il} @page -@node GNU Free Documentation License, Command Index, Acknowledgements, Top +@node GNU Free Documentation License, Command Index, Acknowledgments, Top @appendix GNU Free Documentation License @include doclicense.texi diff --git a/etc/ChangeLog b/etc/ChangeLog index 3fd2d6bd92a..1d7438b6506 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,43 @@ +2012-07-26 Paul Eggert + + Simplify export of symbols to GDB. + * emacs-buffer.gdb ($tagmask, $valmask): Remove. + (ygetptr): Adjust to recent changes in lisp.h and emacs.c, + by using VALMASK instead of $valmask, CHECK_LISP_OBJECT_TYPE + instead of gdb_use_union, and DATA_SEG_BITS instead of + gdb_data_seg_bits. Also, use $ptr.i rather than $ptr.u.val. + +2012-07-20 Eli Zaretskii + + * tutorials/TUTORIAL.he: Make the first sentence display correctly + in a left-to-right paragraph, such as what is shown on the fancy + splash screen. + +2012-07-15 Leo Liu + + * NEWS: Mention exclamation-mark and flymake. + +2012-07-08 Juanma Barranquero + + * tutorials/TUTORIAL.es: Sync with changes in 2012-07-07T10:34:37Z!cyd@gnu.org. + +2012-07-07 Michael Witten (tiny change) + + * tutorials/TUTORIAL: Copyedits (Bug#11689). + +2012-06-28 Glenn Morris + + * emacs.py, emacs2.py, emacs3.py: Remove files, no longer used. + +2012-06-24 Lawrence Mitchell + + * NEWS: Move and improve the defun/defalias changes (bug#11686). + +2012-06-22 Paul Eggert + + Support higher-resolution time stamps (Bug#9000). + * NEWS: Mention addition of picoseconds to time stamp format. + 2012-06-13 Deniz Dogan * tutorials/TUTORIAL.sv: Fix grammar and a couple of typos. @@ -43,8 +83,8 @@ 2012-04-27 Jambunathan K - * org/OrgOdtStyles.xml (OrgDescriptionList): Modify style. With - this change, in a description list, if the description paragraph + * org/OrgOdtStyles.xml (OrgDescriptionList): Modify style. + With this change, in a description list, if the description paragraph spawns multiple lines then it will correctly indented. 2012-04-20 Glenn Morris @@ -66,8 +106,8 @@ * org/OrgOdtContentTemplate.xml (OrgIndentedSection-Level-*): New section styles. These sections are indented to the same level as the corresponding list entries. These sections hold - tables that occur within a list. (OrgTable): Increased - relative width from 90% to 96% for aesthetic reasons. + tables that occur within a list. (OrgTable): + Increased relative width from 90% to 96% for aesthetic reasons. 2012-03-16 Glenn Morris @@ -125,8 +165,8 @@ 2012-01-10 Chong Yidong * tutorials/TUTORIAL: Don't give instructions for old-style X - scrollbars. Use DEL terminology instead of DelBack. Improve - description of graphical continuation lines and mode-line. + scrollbars. Use DEL terminology instead of DelBack. + Improve description of graphical continuation lines and mode-line. Promote use of C-/ and C-SPC. Remove discussion of flow control. 2012-01-05 Glenn Morris @@ -499,11 +539,11 @@ POSIX does not allow "-" in Makefile variable names. Reported by Bruno Haible in . - * refcards/Makefile (DIRED_REFCARDS_PDF): Renamed from + * refcards/Makefile (DIRED_REFCARDS_PDF): Rename from DIRED-REFCARDS_PDF. - (MISC_REFCARDS_PDF): Renamed from MISC-REFCARDS_PDF. - (SURVIVAL_CARDS_PDF): Renamed from SURVIVAL-CARDS_PDF. - (VIPER_CARDS_PDF): Renamed from VIPER-CARDS_PDF. + (MISC_REFCARDS_PDF): Rename from MISC-REFCARDS_PDF. + (SURVIVAL_CARDS_PDF): Rename from SURVIVAL-CARDS_PDF. + (VIPER_CARDS_PDF): Rename from VIPER-CARDS_PDF. 2011-01-18 Glenn Morris @@ -972,7 +1012,7 @@ 2009-09-27 Teodor Zlatanov - * NEWS: Mention new library imap-hash.el + * NEWS: Mention new library imap-hash.el. 2009-09-22 Juanma Barranquero @@ -1016,7 +1056,7 @@ 2009-08-08 Dmitry Dzhus * images/gud/all.xpm, images/gud/thread.xpm: New icons for - gdb-mi.el + gdb-mi.el. 2009-08-07 Dan Nicolaescu @@ -1967,7 +2007,7 @@ * refcards/refcard.tex: Updates for printing. (\versionyear): Update to 2007. - (\copyrightnotice): Modified or unmodified ok. + (\copyrightnotice): Modify or unmodified ok. (Simple Customization): Don't use goto-line, since now it's bound. Also, use now-preferred (kbd ...) syntax. @@ -2052,7 +2092,7 @@ 2007-07-02 Carsten Dominik - * orgcard.tex: Version 5.01 + * orgcard.tex: Version 5.01. 2007-06-27 Michael Albinus @@ -2620,7 +2660,7 @@ 2006-09-15 Richard Stallman * THE-GNU-PROJECT: Update with the latest footnotes - from www.gnu.org/gnu/the-gnu-project.html + from www.gnu.org/gnu/the-gnu-project.html. 2006-09-15 David Kastrup @@ -2641,7 +2681,7 @@ 2006-09-03 Diane Murray - * erc.texi (Getting Started, Connecting): Changed erc-select to erc. + * erc.texi (Getting Started, Connecting): Change erc-select to erc. 2006-09-02 Juri Linkov @@ -2758,8 +2798,8 @@ 2006-07-05 Kenichi Handa - * HELLO: Add a paragraph for non-ASCII examples at the head. Add - Bulgarian and Hungarian. Add more "hello"s to Danish and Swedish. + * HELLO: Add a paragraph for non-ASCII examples at the head. + Add Bulgarian and Hungarian. Add more "hello"s to Danish and Swedish. 2006-07-03 Bill Wohler @@ -2905,7 +2945,7 @@ 2006-05-24 Carsten Dominik - * orgcard.tex (section{Motion}): Added the item navigation commands. + * orgcard.tex (section{Motion}): Add the item navigation commands. (section{Publishing}): New section. (section{Links}): Documented elisp and shell links. @@ -3041,8 +3081,8 @@ New bitmaps for new images. * images/refresh.xpm, images/sort-ascending.xpm, - * images/sort-descending.xpm: Update with GTK 2.x images. Note - that the default GTK icons are not overridden by the GNOME theme + * images/sort-descending.xpm: Update with GTK 2.x images. + Note that the default GTK icons are not overridden by the GNOME theme due to a bug which was fixed in GNOME 2.15. Once GNOME 2.16 is in wide circulation, then the GTK icons should be replaced with the equivalent GNOME icons. Until then, we should be consistent with @@ -3246,7 +3286,7 @@ 2005-11-18 Carsten Dominik - * orgcard.tex: Version 3.20 + * orgcard.tex: Version 3.20. 2005-11-16 Nick Roberts @@ -4312,8 +4352,8 @@ 2001-11-22 Colin Walters - * PROBLEMS: Remove already applied calc info patches. Clarify - that there is no such thing as Debian GNU/Linux 2.4.3. ftpd is + * PROBLEMS: Remove already applied calc info patches. + Clarify that there is no such thing as Debian GNU/Linux 2.4.3. ftpd is not handled by alternatives in Debian, the reporter surely meant just "--config ftp". @@ -4430,8 +4470,8 @@ * ps-prin1.ps: Footer implementation. Doc fix. (doLineNumber): Code fix for line number color. - (BeginPage, BeginSheet, HeaderFramePath, HeaderFrame, HeaderText): Code - fix for footer implementation. + (BeginPage, BeginSheet, HeaderFramePath, HeaderFrame, HeaderText): + Code fix for footer implementation. (TextStart, SetFooterLines, FooterFrameStart, doFramePath) (FooterFramePath, doFrame, FooterFrame, FooterStart) (HeaderOrFooterTextLines, HeaderOrFooterText, FooterText): New funs. @@ -4619,8 +4659,8 @@ * ps-prin0.ps: Insert a version number comment (5.2.2). Indentation fix. - * ps-prin1.ps: Insert a version number comment (5.2.2). Can - select page size with/without giving an error if PostScript + * ps-prin1.ps: Insert a version number comment (5.2.2). + Can select page size with/without giving an error if PostScript printer doesn't have this kind of page size. Zebra Stripe continues or restarts on next page. Indentation fix. (BeginSheet): If necessary, rescale n-up to fit on the sheet of @@ -4831,8 +4871,8 @@ * termcap.dat, termcap.ucb: Deleted and replaced. * termcap: New termcap file from the ncurses project; bigger, - better, brighter, does away with waxy yellow buildup. Email - me at terminfo@ccil.org if you have any trouble with this. + better, brighter, does away with waxy yellow buildup. + Email me at terminfo@ccil.org if you have any trouble with this. * README: Changed to track above change. @@ -4842,7 +4882,7 @@ 1995-04-26 Karl Heuer - * Makefile (maintainer-clean): Renamed from realclean. + * Makefile (maintainer-clean): Rename from realclean. 1995-04-09 Richard Stallman @@ -4997,7 +5037,7 @@ 1993-03-19 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) - * sex.6: Added 900-line support + * sex.6: Added 900-line support. * NEWS: Added news about the package finder. @@ -5039,8 +5079,8 @@ * DISTRIB: The actual domestic order form is now ORDERS.USA. The DISTRIB text now mentions 19. - * ORDERS.USA: Created. This is just the order form. DISTRIB - has a pointer to it at the beginning. + * ORDERS.USA: Created. This is just the order form. + DISTRIB has a pointer to it at the beginning. * EUROPE: Renamed to ORDERS.EUROPE. DISTRIB now has a pointer to it at the beginning. @@ -5121,7 +5161,7 @@ 1992-04-06 Jim Blandy (jimb@pogo.cs.oberlin.edu) - * etags.c (C_entries): Removed comment saying that \" in a string + * etags.c (C_entries): Remove comment saying that \" in a string isn't recognized as magic, because it is correctly handled. * getopt.c, getopt.h: New files, from GNU C library. @@ -5131,8 +5171,8 @@ optind. (main): Argument processing loop rewritten to call getopt to get next option. Options which take parameters (-o and -i) rewritten - to get parameter from optarg instead of argv[1]. Filename - preprocessing loop and update command changed similarly. + to get parameter from optarg instead of argv[1]. + Filename preprocessing loop and update command changed similarly. * Makefile (etags, ctags): Depend on and link with getopt.h, getopt.o, and getopt1.o. (getopt.o, getopt1.o): New targets for the GNU getopt routines. @@ -5273,8 +5313,8 @@ 1991-01-25 Jim Blandy (jimb@churchy.ai.mit.edu) * make-docfile: Find the arguments to a C function correctly, - by not ignoring the character that read_c_string returns. Don't - even try to find argument names for functions that take MANY + by not ignoring the character that read_c_string returns. + Don't even try to find argument names for functions that take MANY or UNEVALLED arguments, since they're a figment of the docstring's imagination. @@ -5536,7 +5576,7 @@ 1988-12-31 Richard Mlynarik (mly@rice-chex.ai.mit.edu) * env.c: Add decl for my-index. - * etags.c (file-entries): .oak => scheme + * etags.c (file-entries): .oak => scheme. 1988-12-30 Richard Stallman (rms@sugar-bombs.ai.mit.edu) diff --git a/etc/GNUS-NEWS b/etc/GNUS-NEWS index 086e44f2bba..c5fca9de929 100644 --- a/etc/GNUS-NEWS +++ b/etc/GNUS-NEWS @@ -7,257 +7,35 @@ Please send Gnus bug reports to bugs@gnus.org. For older news, see Gnus info node "New Features". -* Installation changes +* New features -** Upgrading from previous (stable) version if you have used No Gnus. +** If you have the "tnef" program installed, Gnus will display ms-tnef + files, aka "winmail.dat". -If you have tried No Gnus (the unstable Gnus branch leading to this -release) but went back to a stable version, be careful when upgrading to -this version. In particular, you will probably want to remove the -`~/News/marks' directory (perhaps selectively), so that flags are read -from your `~/.newsrc.eld' instead of from the stale marks file, where -this release will store flags for nntp. See a later entry for more -information about nntp marks. Note that downgrading isn't safe in -general. +** Archives (like tar and zip files) will be automatically unpacked, + and the files inside the packages will be displayed as MIME parts. -** Incompatibility when switching from Emacs 23 to Emacs 22 In Emacs 23, -Gnus uses Emacs' new internal coding system `utf-8-emacs' for saving -articles drafts and `~/.newsrc.eld'. These files may not be read -correctly in Emacs 22 and below. If you want to use Gnus across -different Emacs versions, you may set `mm-auto-save-coding-system' to -`emacs-mule'. +** shr has a new command `z' that cycles through image sizes. -** Lisp files are now installed in `.../site-lisp/gnus/' by default. It -defaulted to `.../site-lisp/' formerly. In addition to this, the new -installer issues a warning if other Gnus installations which will shadow -the latest one are detected. You can then remove those shadows manually -or remove them using `make remove-installed-shadows'. +** `backtab' in the summary buffer now selects the previous link in + the article buffer. -** The installation directory name is allowed to have spaces and/or tabs. +** Using the "X-Message-SMTP-Method" header in Message buffers now + allows specifying how messages are to be sent. For example: - -* New packages and libraries within Gnus + X-Message-SMTP-Method: smtp smtp.fsf.org 587 -** Gnus includes the Emacs Lisp SASL library. +** Gnus keeps track of non-existent articles for nnimap groups, so + that sparse IMAP folders now list a correct number of messages in + them. -This provides a clean API to SASL mechanisms from within Emacs. The -user visible aspects of this, compared to the earlier situation, include -support for DIGEST-MD5 and NTLM. *Note Emacs SASL: (sasl)Top. +** Gnus will guess the real type of MIME parts of type + application/octet-stream based on the file suffix. So an + application/octet-stream with a name of "rms.jpg" will be displayed + as an image/jpeg type by default, for instance. -** ManageSieve connections uses the SASL library by default. - -The primary change this brings is support for DIGEST-MD5 and NTLM, when -the server supports it. - -** Gnus includes a password cache mechanism in password-cache.el. - -It is enabled by default (see `password-cache'), with a short timeout of -16 seconds (see `password-cache-expiry'). If PGG is used as the PGP -back end, the PGP passphrase is managed by this mechanism. Passwords -for ManageSieve connections are managed by this mechanism, after -querying the user about whether to do so. - -** Using EasyPG with Gnus When EasyPG, is available, Gnus will use it -instead of PGG. EasyPG is an Emacs user interface to GNU Privacy Guard. - *Note EasyPG Assistant user's manual: (epa)Top. EasyPG is included in -Emacs 23 and available separately as well. - - -* Changes in group mode - -** Old intermediate incoming mail files (`Incoming*') are deleted after a -couple of days, not immediately. *Note Mail Source Customization::. -(New in Gnus 5.10.10 / Emacs 22.2) - - - -* Changes in summary and article mode - -** Gnus now supports sticky article buffers. Those are article buffers -that are not reused when you select another article. *Note Sticky -Articles::. - -** Gnus can selectively display `text/html' articles with a WWW browser -with `K H'. *Note MIME Commands::. - -** International host names (IDNA) can now be decoded inside article bodies -using `W i' (`gnus-summary-idna-message'). This requires that GNU Libidn -(`http://www.gnu.org/software/libidn/') has been installed. - -** The non-ASCII group names handling has been much improved. The back -ends that fully support non-ASCII group names are now `nntp', `nnml', -and `nnrss'. Also the agent, the cache, and the marks features work -with those back ends. *Note Non-ASCII Group Names::. - -** Gnus now displays DNS master files sent as text/dns using dns-mode. - -** Gnus supports new limiting commands in the Summary buffer: `/ r' -(`gnus-summary-limit-to-replied') and `/ R' -(`gnus-summary-limit-to-recipient'). *Note Limiting::. - -** You can now fetch all ticked articles from the server using `Y t' -(`gnus-summary-insert-ticked-articles'). *Note Summary Generation -Commands::. - -** Gnus supports a new sort command in the Summary buffer: `C-c C-s C-t' -(`gnus-summary-sort-by-recipient'). *Note Summary Sorting::. - -** S/MIME now features LDAP user certificate searches. You need to -configure the server in `smime-ldap-host-list'. - -** URLs inside OpenPGP headers are retrieved and imported to your PGP key -ring when you click on them. - -** Picons can be displayed right from the textual address, see -`gnus-picon-style'. *Note Picons::. - -** ANSI SGR control sequences can be transformed using `W A'. - -ANSI sequences are used in some Chinese hierarchies for highlighting -articles (`gnus-article-treat-ansi-sequences'). - -** Gnus now MIME decodes articles even when they lack "MIME-Version" header. -This changes the default of `gnus-article-loose-mime'. - -** `gnus-decay-scores' can be a regexp matching score files. For example, -set it to `\\.ADAPT\\'' and only adaptive score files will be decayed. - *Note Score Decays::. - -** Strings prefixing to the `To' and `Newsgroup' headers in summary lines -when using `gnus-ignored-from-addresses' can be customized with -`gnus-summary-to-prefix' and `gnus-summary-newsgroup-prefix'. *Note To -From Newsgroups::. - -** You can replace MIME parts with external bodies. See -`gnus-mime-replace-part' and `gnus-article-replace-part'. *Note MIME -Commands::, *note Using MIME::. - -** The option `mm-fill-flowed' can be used to disable treatment of -format=flowed messages. Also, flowed text is disabled when sending -inline PGP signed messages. *Note Flowed text: (emacs-mime)Flowed text. -(New in Gnus 5.10.7) - -** Now the new command `S W' (`gnus-article-wide-reply-with-original') for -a wide reply in the article buffer yanks a text that is in the active -region, if it is set, as well as the `R' -(`gnus-article-reply-with-original') command. Note that the `R' command -in the article buffer no longer accepts a prefix argument, which was -used to make it do a wide reply. *Note Article Keymap::. - -** The new command `C-h b' (`gnus-article-describe-bindings') used in the -article buffer now shows not only the article commands but also the real -summary commands that are accessible from the article buffer. - - - -* Changes in Message mode - -** Gnus now supports the "hashcash" client puzzle anti-spam mechanism. Use -`(setq message-generate-hashcash t)' to enable. *Note Hashcash::. - -** You can now drag and drop attachments to the Message buffer. See -`mml-dnd-protocol-alist' and `mml-dnd-attach-options'. *Note MIME: -(message)MIME. - -** The option `message-yank-empty-prefix' now controls how empty lines are -prefixed in cited text. *Note Insertion Variables: (message)Insertion -Variables. - -** Gnus uses narrowing to hide headers in Message buffers. The -`References' header is hidden by default. To make all headers visible, -use `(setq message-hidden-headers nil)'. *Note Message Headers: -(message)Message Headers. - -** You can highlight different levels of citations like in the article -buffer. See `gnus-message-highlight-citation'. - -** `auto-fill-mode' is enabled by default in Message mode. See -`message-fill-column'. *Note Message Headers: (message)Various Message -Variables. - -** You can now store signature files in a special directory named -`message-signature-directory'. - -** The option `message-citation-line-format' controls the format of the -"Whomever writes:" line. You need to set -`message-citation-line-function' to -`message-insert-formatted-citation-line' as well. - - -* Changes in back ends - -** The nntp back end stores article marks in `~/News/marks'. - -The directory can be changed using the (customizable) variable -`nntp-marks-directory', and marks can be disabled using the (back end) -variable `nntp-marks-is-evil'. The advantage of this is that you can -copy `~/News/marks' (using rsync, scp or whatever) to another Gnus -installation, and it will realize what articles you have read and -marked. The data in `~/News/marks' has priority over the same data in -`~/.newsrc.eld'. - -** You can import and export your RSS subscriptions from OPML files. *Note -RSS::. - -** IMAP identity (RFC 2971) is supported. - -By default, Gnus does not send any information about itself, but you can -customize it using the variable `nnimap-id'. - -** The `nnrss' back end now supports multilingual text. Non-ASCII group -names for the `nnrss' groups are also supported. *Note RSS::. - -** Retrieving mail with POP3 is supported over SSL/TLS and with StartTLS. - -** The nnml back end allows other compression programs beside `gzip' for -compressed message files. *Note Mail Spool::. - -** The nnml back end supports group compaction. - -This feature, accessible via the functions `gnus-group-compact-group' -(`G z' in the group buffer) and `gnus-server-compact-server' (`z' in the -server buffer) renumbers all articles in a group, starting from 1 and -removing gaps. As a consequence, you get a correct total article count -(until messages are deleted again). - - - -* Appearance - -** The tool bar has been updated to use GNOME icons. You can also -customize the tool bars: `M-x customize-apropos RET -tool-bar$' should -get you started. (Only for Emacs, not in XEmacs.) - -** The tool bar icons are now (de)activated correctly in the group buffer, -see the variable `gnus-group-update-tool-bar'. Its default value -depends on your Emacs version. - -** You can change the location of XEmacs' toolbars in Gnus buffers. See -`gnus-use-toolbar' and `message-use-toolbar'. - - - -* Miscellaneous changes - -** Having edited the select-method for the foreign server in the server -buffer is immediately reflected to the subscription of the groups which -use the server in question. For instance, if you change -`nntp-via-address' into `bar.example.com' from `foo.example.com', Gnus -will connect to the news host by way of the intermediate host -`bar.example.com' from next time. - -** The `all.SCORE' file can be edited from the group buffer using `W e'. - -** You can set `gnus-mark-copied-or-moved-articles-as-expirable' to a -non-`nil' value so that articles that have been read may be marked as -expirable automatically when copying or moving them to a group that has -auto-expire turned on. The default is `nil' and copying and moving of -articles behave as before; i.e., the expirable marks will be unchanged -except that the marks will be removed when copying or moving articles to -a group that has not turned auto-expire on. *Note Expiring Mail::. - - - +** `nnimap-inbox' can now be a list of mail box names. + * For older news, see Gnus info node "New Features". ---------------------------------------------------------------------- diff --git a/etc/NEWS b/etc/NEWS index a2f3b95fe41..ce44a530e26 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -61,9 +61,31 @@ check that this option enables. lisp/ directory. There should not be any there anyway. If you have been adding them there, put them somewhere else, eg site-lisp. +--- +** The `--no-site-lisp' command line option now works for Nextstep builds. + * Changes in Emacs 24.2 +** Help changes + +*** `C-h f' (describe-function) can now perform autoloading. +When this command is called for an autoloaded function whose docstring +contains a key substitution construct, that function's library is +automatically loaded, so that the documentation can be shown +correctly. To disable this, set `help-enable-auto-load' to nil. + +*** `C-h f' now reports previously-autoloaded functions as "autoloaded", +even after their associated libraries have been loaded (and the +autoloads have been redefined as functions). + +** The function `current-time' now returns extended-format time stamps +(HIGH LOW USEC PSEC) that use picosecond resolution; the PSEC +component is new. PSEC is typically a multiple of 1000 on current +machines. Other functions that use this format, such as +file-attributes and format-time-string, have been changed accordingly. +Old-format time stamps are still accepted. + ** New functions `system-users', `system-groups' return lists of the user name, group names known to the system (where possible). @@ -91,6 +113,8 @@ treated as images. ** Face underlining can now use a wave. See the "Face Attributes" section of the Elisp manual. +** New fringe bitmap exclamation-mark. + ** String values for `initial-buffer-choice' also apply to emacsclient frames, if emacsclient is only told to open a new frame without specifying any file to visit or expression to evaluate. @@ -116,6 +140,10 @@ invokes `set-buffer-file-coding-system'. ** Setting `enable-remote-dir-locals' to non-nil allows directory local variables on remote hosts. ++++ +** `insert-char' is now a command, and `ucs-insert' an obsolete alias +for it. + * Editing Changes in Emacs 24.2 @@ -131,16 +159,30 @@ prompts for a column number. ** `mouse-avoidance-banish-position' can now be used to customize `mouse-avoidance-mode' further. +** `M-=' is now bound to `count-words', not `count-words-region'. + ** `C-M-f' and `C-M-b' will now move to the path name separator character when doing minibuffer filename prompts. ** `goto-char' is now bound to `M-g c'. +** New command `C-x r M-w' (copy-rectangle-as-kill). +It copies the region-rectangle as the last rectangle kill. + ** New input method `vietnamese-vni'. * Changes in Specialized Modes and Packages in Emacs 24.2 +** Term changes + +The variables `term-default-fg-color' and `term-default-bg-color' are +now deprecated in favor of the `term-face' face, that you can +customize. Also, it is now possible to customize how are displayed the +ANSI terminal colors and styles by customizing the corresponding +`term-color-', `term-color-underline' and `term-color-bold' +faces. + ** CL's main entry is now (require 'cl-lib). `cl-lib' is like the old `cl' except that it uses the namespace cleanly, i.e. all its definitions have the "cl-" prefix. @@ -153,8 +195,14 @@ which have not been renamed to `cl-foo*' but just `cl-foo'. The old `cl' is now deprecated and is nothing more than a bunch of aliases that provide the old non-prefixed names. -** A new mode for Python. -This provides several new features, including: +** Desktop + +*** `desktop-path' no longer includes the "." directory. Desktop +files are now located in ~/.emacs.d by default. + +** Python mode + +A new version of python.el, which provides several new features, including: per-buffer shells, better indentation, Python 3 support, and improved shell-interaction compatible with iPython (and virtually any other text based shell). @@ -207,11 +255,15 @@ python-send-string | python-shell-send-string python-switch-to-python | python-shell-switch-to-shell python-describe-symbol | python-eldoc-at-point -** VHDL-mode -- Support for ghdl (free vhdl compiler). Now default. -- Add/update support for VHDL-AMS packages. -- Update to VHDL'02 standard. -- Accept \r and \f as whitespace. +** VHDL mode + +*** The free software compiler GHDL is supported (and now the default). + +*** Support for the VHDL-AMS packages has been added/updated. + +*** Updated to the 2002 revision of the VHDL standard. + +*** Accepts \r and \f as whitespace. ** Diff mode @@ -227,6 +279,10 @@ to highlight changes in context diffs. ** Ediff now uses the same color scheme as Diff mode on high color displays. +** Flymake uses fringe bitmaps to indicate errors and warnings. +See flymake-fringe-indicator-position, flymake-error-bitmap and +flymake-warning-bitmap. + ** `sh-script' *** Pairing of parens/quotes uses electric-pair-mode instead of skeleton-pair. *** `sh-electric-here-document-mode' now controls auto-insertion of here-docs. @@ -294,6 +350,12 @@ these commands now). ** erc will look up server/channel names via auth-source and use the channel keys found, if any. +** Dired + +*** `dired-do-async-shell-command' executes each file sequentially +if the command ends in `;' (when operating on multiple files). +Otherwise, it executes the command on each file in parallel. + ** FFAP *** The option `ffap-url-unwrap-remote' can now be a list of strings, @@ -413,6 +475,12 @@ Only variables defined using `defcustom' are considered user options. The function `user-variable-p' is now an obsolete alias for `custom-variable-p'. ++++ +** The return values of `defalias', `defun' and `defmacro' have changed, +and are now undefined. For backwards compatibility, defun and +defmacro currently return the name of the newly defined function/macro +but this should not be relied upon. + ** `face-spec-set' no longer sets frame-specific attributes when the third argument is a frame (that usage was obsolete since Emacs 22.2). @@ -425,11 +493,20 @@ still be supported for Emacs 24.x. *** `facemenu-unlisted-faces' *** `rmail-decode-mime-charset' +*** `last-input-char' and `last-command-char' * Lisp changes in Emacs 24.2 -** The return value of `defalias' has changed and is now undefined. +** New functions `autoloadp' and `autoload-do-load'. + +** `function-get' fetches the property of a function, following aliases. + +** `toggle-read-only' accepts a second argument specifying whether to +print a message, if called from Lisp. + +** CL-style generalized variables are now in core Elisp. +`setf' is autoloaded and `push' and `pop' accept generalized variables. ** `defun' also accepts a (declare DECLS) form, like `defmacro'. The interpretation of the DECLS is determined by `defun-declarations-alist'. @@ -459,6 +536,10 @@ table, but with a different prefix. must be in the range 1000..9999. It now works with any year supported by the underlying C implementation. +** New function file-name-base. + +** New function `tty-top-frame' returns the topmost frame of a text terminal. + ** `automount-dir-prefix' is obsolete. ** `buffer-has-markers-at' is obsolete. @@ -473,8 +554,6 @@ is detected. Emacs now supports mouse highlight, help-echo (in the echo area), and mouse-autoselect-window. -** New function `tty-top-frame' returns the topmost frame of a text terminal. - * Installation Changes in Emacs 24.1 diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 078352d78f4..58f2bb9bcf2 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -255,6 +255,36 @@ result in an endless loop. If you need Emacs to be able to recover from closing displays, compile it with the Lucid toolkit instead of GTK. +** Emacs crashes when you try to view a file with complex characters. +For example, the etc/HELLO file (as shown by C-h h). +The message "symbol lookup error: /usr/bin/emacs: undefined symbol: OTF_open" +is shown in the terminal from which you launched Emacs. +This problem only happens when you use a graphical display (ie not +with -nw) and compiled Emacs with the "libotf" library for complex +text handling. + +This problem occurs because unfortunately there are two libraries +called "libotf". One is the library for handling OpenType fonts, +http://www.m17n.org/libotf/, which is the one that Emacs expects. +The other is a library for Open Trace Format, and is used by some +versions of the MPI message passing interface for parallel +programming. + +For example, on RHEL6 GNU/Linux, the OpenMPI rpm provides a version +of "libotf.so" in /usr/lib/openmpi/lib. This directory is not +normally in the ld search path, but if you want to use OpenMPI, +you must issue the command "module load openmpi". This adds +/usr/lib/openmpi/lib to LD_LIBRARY_PATH. If you then start Emacs from +the same shell, you will encounter this crash. +Ref: + +There is no good solution to this problem if you need to use both +OpenMPI and Emacs with libotf support. The best you can do is use a +wrapper shell script (or function) "emacs" that removes the offending +element from LD_LIBRARY_PATH before starting emacs proper. +Or you could recompile Emacs with an -Wl,-rpath option that +gives the location of the correct libotf. + * General runtime problems ** Lisp problems @@ -1854,8 +1884,8 @@ Emacs uses symbolic links to implement file locks. In a directory with +t bit, the directory owner becomes the owner of the symbolic link, so that it cannot be removed by anyone else. -If you don't like those useless links, you can let Emacs not to using -file lock by adding #undef CLASH_DETECTION to config.h. +If you don't like those useless links, you can customize +the option `create-lockfiles'. *** FreeBSD: Getting a Meta key on the console. diff --git a/etc/TODO b/etc/TODO index 22c9d7782d8..e4c0092c7e5 100644 --- a/etc/TODO +++ b/etc/TODO @@ -1211,6 +1211,8 @@ systems for HTML/XML files automatically." this.] ** Rewrite make-docfile to be clean and maintainable. + It might be better to replace it with Lisp, using the byte compiler. + http://lists.gnu.org/archive/html/emacs-devel/2012-06/msg00037.html ** Add an inferior-comint-minor-mode to capture the common set of operations offered by major modes that offer an associated inferior @@ -1230,6 +1232,15 @@ systems for HTML/XML files automatically." button classes inherit from it. Set the default face of the "link" button class to the standard "link" face. +* Wishlist items: + +** Maybe replace etags.c with a Lisp implementation. +http://lists.gnu.org/archive/html/emacs-devel/2012-06/msg00354.html + +** Maybe replace lib-src/rcs2log with a Lisp implementation. +It wouldn't have to be a complete replacement, just enough +for vc-rcs-update-changelog. + * Other known bugs: ** `make-frame' forgets unhandled parameters, at least for X11 frames. diff --git a/etc/emacs-buffer.gdb b/etc/emacs-buffer.gdb index 80f69c585dc..f2584a2f504 100644 --- a/etc/emacs-buffer.gdb +++ b/etc/emacs-buffer.gdb @@ -70,21 +70,16 @@ # Code: -# Force loading of symbols, enough to give us gdb_valbits etc. +# Force loading of symbols, enough to give us VALMASK etc. set main # When nonzero, display some extra diagnostics in various commands set $yverbose = 1 set $yfile_buffers_only = 0 -set $tagmask = (((long)1 << gdb_gctypebits) - 1) -# The consing_since_gc business widens the 1 to EMACS_INT, -# a symbol not directly visible to GDB. -set $valmask = gdb_use_lsb ? ~($tagmask) : ((consing_since_gc - consing_since_gc + 1) << gdb_valbits) - 1 - define ygetptr set $ptr = $arg0 - set $ptr = (gdb_use_union ? $ptr.u.val : $ptr & $valmask) | gdb_data_seg_bits + set $ptr = ((CHECK_LISP_OBJECT_TYPE ? $ptr.i : $ptr) & VALMASK) | DATA_SEG_BITS end define ybuffer-list diff --git a/etc/emacs.py b/etc/emacs.py deleted file mode 100644 index 24004b321fe..00000000000 --- a/etc/emacs.py +++ /dev/null @@ -1,10 +0,0 @@ -"""Wrapper for version-specific implementations of python.el helper -functions """ - -import sys - -if sys.version_info[0] == 3: - from emacs3 import * -else: - from emacs2 import * - diff --git a/etc/emacs2.py b/etc/emacs2.py deleted file mode 100644 index ed99a3a1409..00000000000 --- a/etc/emacs2.py +++ /dev/null @@ -1,236 +0,0 @@ -"""Definitions used by commands sent to inferior Python in python.el.""" - -# Copyright (C) 2004-2012 Free Software Foundation, Inc. -# Author: Dave Love - -# 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 . - -import os, sys, traceback, inspect, __main__ - -try: - set -except: - from sets import Set as set - -__all__ = ["eexecfile", "eargs", "complete", "ehelp", "eimport", "modpath"] - -def format_exception (filename, should_remove_self): - type, value, tb = sys.exc_info () - sys.last_type = type - sys.last_value = value - sys.last_traceback = tb - if type is SyntaxError: - try: # parse the error message - msg, (dummy_filename, lineno, offset, line) = value - except: - pass # Not the format we expect; leave it alone - else: - # Stuff in the right filename - value = SyntaxError(msg, (filename, lineno, offset, line)) - sys.last_value = value - res = traceback.format_exception_only (type, value) - # There are some compilation errors which do not provide traceback so we - # should not massage it. - if should_remove_self: - tblist = traceback.extract_tb (tb) - del tblist[:1] - res = traceback.format_list (tblist) - if res: - res.insert(0, "Traceback (most recent call last):\n") - res[len(res):] = traceback.format_exception_only (type, value) - # traceback.print_exception(type, value, tb) - for line in res: print line, - -def eexecfile (file): - """Execute FILE and then remove it. - Execute the file within the __main__ namespace. - If we get an exception, print a traceback with the top frame - (ourselves) excluded.""" - # We cannot use real execfile since it has a bug where the file stays - # locked forever (under w32) if SyntaxError occurs. - # --- code based on code.py and PyShell.py. - try: - try: - source = open (file, "r").read() - code = compile (source, file, "exec") - # Other exceptions (shouldn't be any...) will (correctly) fall - # through to "final". - except (OverflowError, SyntaxError, ValueError): - # FIXME: When can compile() raise anything else than - # SyntaxError ???? - format_exception (file, False) - return - try: - exec code in __main__.__dict__ - except: - format_exception (file, True) - finally: - os.remove (file) - -def eargs (name, imports): - "Get arglist of NAME for Eldoc &c." - try: - if imports: exec imports - parts = name.split ('.') - if len (parts) > 1: - exec 'import ' + parts[0] # might fail - func = eval (name) - if inspect.isbuiltin (func) or type(func) is type: - doc = func.__doc__ - if doc.find (' ->') != -1: - print '_emacs_out', doc.split (' ->')[0] - else: - print '_emacs_out', doc.split ('\n')[0] - return - if inspect.ismethod (func): - func = func.im_func - if not inspect.isfunction (func): - print '_emacs_out ' - return - (args, varargs, varkw, defaults) = inspect.getargspec (func) - # No space between name and arglist for consistency with builtins. - print '_emacs_out', \ - func.__name__ + inspect.formatargspec (args, varargs, varkw, - defaults) - except: - print "_emacs_out " - -def all_names (object): - """Return (an approximation to) a list of all possible attribute - names reachable via the attributes of OBJECT, i.e. roughly the - leaves of the dictionary tree under it.""" - - def do_object (object, names): - if inspect.ismodule (object): - do_module (object, names) - elif inspect.isclass (object): - do_class (object, names) - # Might have an object without its class in scope. - elif hasattr (object, '__class__'): - names.add ('__class__') - do_class (object.__class__, names) - # Probably not a good idea to try to enumerate arbitrary - # dictionaries... - return names - - def do_module (module, names): - if hasattr (module, '__all__'): # limited export list - names.update(module.__all__) - for i in module.__all__: - do_object (getattr (module, i), names) - else: # use all names - names.update(dir (module)) - for i in dir (module): - do_object (getattr (module, i), names) - return names - - def do_class (object, names): - ns = dir (object) - names.update(ns) - if hasattr (object, '__bases__'): # superclasses - for i in object.__bases__: do_object (i, names) - return names - - return do_object (object, set([])) - -def complete (name, imports): - """Complete TEXT in NAMESPACE and print a Lisp list of completions. - Exec IMPORTS first.""" - import __main__, keyword - - def class_members(object): - names = dir (object) - if hasattr (object, '__bases__'): - for super in object.__bases__: - names = class_members (super) - return names - - names = set([]) - base = None - try: - dict = __main__.__dict__.copy() - if imports: exec imports in dict - l = len (name) - if not "." in name: - for src in [dir (__builtins__), keyword.kwlist, dict.keys()]: - for elt in src: - if elt[:l] == name: names.add(elt) - else: - base = name[:name.rfind ('.')] - name = name[name.rfind('.')+1:] - try: - object = eval (base, dict) - names = set(dir (object)) - if hasattr (object, '__class__'): - names.add('__class__') - names.update(class_members (object)) - except: names = all_names (dict) - except: - print sys.exc_info() - names = [] - - l = len(name) - print '_emacs_out (', - for n in names: - if name == n[:l]: - if base: print '"%s.%s"' % (base, n), - else: print '"%s"' % n, - print ')' - -def ehelp (name, imports): - """Get help on string NAME. - First try to eval name for, e.g. user definitions where we need - the object. Otherwise try the string form.""" - locls = {} - if imports: - try: exec imports in locls - except: pass - try: help (eval (name, globals(), locls)) - except: help (name) - -def eimport (mod, dir): - """Import module MOD with directory DIR at the head of the search path. - NB doesn't load from DIR if MOD shadows a system module.""" - from __main__ import __dict__ - - path0 = sys.path[0] - sys.path[0] = dir - try: - try: - if __dict__.has_key(mod) and inspect.ismodule (__dict__[mod]): - reload (__dict__[mod]) - else: - __dict__[mod] = __import__ (mod) - except: - (type, value, tb) = sys.exc_info () - print "Traceback (most recent call last):" - traceback.print_exception (type, value, tb.tb_next) - finally: - sys.path[0] = path0 - -def modpath (module): - """Return the source file for the given MODULE (or None). -Assumes that MODULE.py and MODULE.pyc are in the same directory.""" - try: - path = __import__ (module).__file__ - if path[-4:] == '.pyc' and os.path.exists (path[0:-1]): - path = path[:-1] - print "_emacs_out", path - except: - print "_emacs_out ()" - -# print '_emacs_ok' # ready for input and can call continuation - diff --git a/etc/emacs3.py b/etc/emacs3.py deleted file mode 100644 index f0e4659bb6b..00000000000 --- a/etc/emacs3.py +++ /dev/null @@ -1,234 +0,0 @@ -# Copyright (C) 2004-2012 Free Software Foundation, Inc. -# Author: Dave Love - -# 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 . - -import os, sys, traceback, inspect, imp, __main__ - -try: - set -except: - from sets import Set as set - -__all__ = ["eexecfile", "eargs", "complete", "ehelp", "eimport", "modpath"] - -def format_exception (filename, should_remove_self): - type, value, tb = sys.exc_info () - sys.last_type = type - sys.last_value = value - sys.last_traceback = tb - if type is SyntaxError: - try: # parse the error message - msg, (dummy_filename, lineno, offset, line) = value - except: - pass # Not the format we expect; leave it alone - else: - # Stuff in the right filename - value = SyntaxError(msg, (filename, lineno, offset, line)) - sys.last_value = value - res = traceback.format_exception_only (type, value) - # There are some compilation errors which do not provide traceback so we - # should not massage it. - if should_remove_self: - tblist = traceback.extract_tb (tb) - del tblist[:1] - res = traceback.format_list (tblist) - if res: - res.insert(0, "Traceback (most recent call last):\n") - res[len(res):] = traceback.format_exception_only (type, value) - # traceback.print_exception(type, value, tb) - for line in res: print(line, end=' ') - -def eexecfile (file): - """Execute FILE and then remove it. - Execute the file within the __main__ namespace. - If we get an exception, print a traceback with the top frame - (ourselves) excluded.""" - # We cannot use real execfile since it has a bug where the file stays - # locked forever (under w32) if SyntaxError occurs. - # --- code based on code.py and PyShell.py. - try: - try: - source = open (file, "r").read() - code = compile (source, file, "exec") - # Other exceptions (shouldn't be any...) will (correctly) fall - # through to "final". - except (OverflowError, SyntaxError, ValueError): - # FIXME: When can compile() raise anything else than - # SyntaxError ???? - format_exception (file, False) - return - try: - exec(code, __main__.__dict__) - except: - format_exception (file, True) - finally: - os.remove (file) - -def eargs (name, imports): - "Get arglist of NAME for Eldoc &c." - try: - if imports: exec(imports) - parts = name.split ('.') - if len (parts) > 1: - exec('import ' + parts[0]) # might fail - func = eval (name) - if inspect.isbuiltin (func) or type(func) is type: - doc = func.__doc__ - if doc.find (' ->') != -1: - print('_emacs_out', doc.split (' ->')[0]) - else: - print('_emacs_out', doc.split ('\n')[0]) - return - if inspect.ismethod (func): - func = func.im_func - if not inspect.isfunction (func): - print('_emacs_out ') - return - (args, varargs, varkw, defaults) = inspect.getargspec (func) - # No space between name and arglist for consistency with builtins. - print('_emacs_out', \ - func.__name__ + inspect.formatargspec (args, varargs, varkw, - defaults)) - except: - print("_emacs_out ") - -def all_names (object): - """Return (an approximation to) a list of all possible attribute - names reachable via the attributes of OBJECT, i.e. roughly the - leaves of the dictionary tree under it.""" - - def do_object (object, names): - if inspect.ismodule (object): - do_module (object, names) - elif inspect.isclass (object): - do_class (object, names) - # Might have an object without its class in scope. - elif hasattr (object, '__class__'): - names.add ('__class__') - do_class (object.__class__, names) - # Probably not a good idea to try to enumerate arbitrary - # dictionaries... - return names - - def do_module (module, names): - if hasattr (module, '__all__'): # limited export list - names.update(module.__all__) - for i in module.__all__: - do_object (getattr (module, i), names) - else: # use all names - names.update(dir (module)) - for i in dir (module): - do_object (getattr (module, i), names) - return names - - def do_class (object, names): - ns = dir (object) - names.update(ns) - if hasattr (object, '__bases__'): # superclasses - for i in object.__bases__: do_object (i, names) - return names - - return do_object (object, set([])) - -def complete (name, imports): - """Complete TEXT in NAMESPACE and print a Lisp list of completions. - Exec IMPORTS first.""" - import __main__, keyword - - def class_members(object): - names = dir (object) - if hasattr (object, '__bases__'): - for super in object.__bases__: - names = class_members (super) - return names - - names = set([]) - base = None - try: - dict = __main__.__dict__.copy() - if imports: exec(imports, dict) - l = len (name) - if not "." in name: - for src in [dir (__builtins__), keyword.kwlist, list(dict.keys())]: - for elt in src: - if elt[:l] == name: names.add(elt) - else: - base = name[:name.rfind ('.')] - name = name[name.rfind('.')+1:] - try: - object = eval (base, dict) - names = set(dir (object)) - if hasattr (object, '__class__'): - names.add('__class__') - names.update(class_members (object)) - except: names = all_names (dict) - except: - print(sys.exc_info()) - names = [] - - l = len(name) - print('_emacs_out (', end=' ') - for n in names: - if name == n[:l]: - if base: print('"%s.%s"' % (base, n), end=' ') - else: print('"%s"' % n, end=' ') - print(')') - -def ehelp (name, imports): - """Get help on string NAME. - First try to eval name for, e.g. user definitions where we need - the object. Otherwise try the string form.""" - locls = {} - if imports: - try: exec(imports, locls) - except: pass - try: help (eval (name, globals(), locls)) - except: help (name) - -def eimport (mod, dir): - """Import module MOD with directory DIR at the head of the search path. - NB doesn't load from DIR if MOD shadows a system module.""" - from __main__ import __dict__ - - path0 = sys.path[0] - sys.path[0] = dir - try: - try: - if mod in __dict__ and inspect.ismodule (__dict__[mod]): - imp.reload (__dict__[mod]) - else: - __dict__[mod] = __import__ (mod) - except: - (type, value, tb) = sys.exc_info () - print("Traceback (most recent call last):") - traceback.print_exception (type, value, tb.tb_next) - finally: - sys.path[0] = path0 - -def modpath (module): - """Return the source file for the given MODULE (or None). -Assumes that MODULE.py and MODULE.pyc are in the same directory.""" - try: - path = __import__ (module).__file__ - if path[-4:] == '.pyc' and os.path.exists (path[0:-1]): - path = path[:-1] - print("_emacs_out", path) - except: - print("_emacs_out ()") - -# print '_emacs_ok' # ready for input and can call continuation - diff --git a/etc/future-bug b/etc/future-bug index fb6262dfe55..c18dd995d66 100644 --- a/etc/future-bug +++ b/etc/future-bug @@ -30,7 +30,7 @@ comments when you write it (sometime in 2198 as I recall). P.S. You'll be pleased to know that since (time-forward N) still works - for N >= 0, we've used it to pre-emptively update configure.in. + for N >= 0, we've used it to pre-emptively update configure.ac. Emacs now configures and builds on every platform that will ever be made. It wasn't easy, but at least that's one problem out of the way for good. If you'd like the patch, just ask. diff --git a/etc/tutorials/TUTORIAL b/etc/tutorials/TUTORIAL index ccd438ad629..b74d1421ee6 100644 --- a/etc/tutorials/TUTORIAL +++ b/etc/tutorials/TUTORIAL @@ -16,7 +16,7 @@ The characters ">>" at the left margin indicate directions for you to try using a command. For instance: <> [Middle of page left blank for didactic purposes. Text continues below] ->> Now type C-v (View next screen) to move to the next screen. +>> Now type C-v (View next screen) to move to the next screen. (go ahead, do it by holding down the CONTROL key while typing v). From now on, you should do this again whenever you finish reading the screen. @@ -30,7 +30,7 @@ to place in the text. You already know how to move forward one screen, with C-v. To move backwards one screen, type M-v (hold down the META key and type v, or type v if you do not have a META, EDIT, or ALT key). ->> Try typing M-v and then C-v, a few times. +>> Try typing M-v and then C-v, a few times. * SUMMARY @@ -209,12 +209,12 @@ prefix argument, regardless of its value, makes the command do something different. C-v and M-v are another kind of exception. When given an argument, -they scroll the screen up or down by that many lines, rather than by a -screenful. For example, C-u 8 C-v scrolls the screen by 8 lines. +they scroll the text up or down by that many lines, rather than by a +screenful. For example, C-u 8 C-v scrolls by 8 lines. >> Try typing C-u 8 C-v now. -This should have scrolled the screen up by 8 lines. If you would like +This should have scrolled the text up by 8 lines. If you would like to scroll it down again, you can give an argument to M-v. If you are using a graphical display, such as X or MS-Windows, there @@ -281,8 +281,6 @@ other windows. >> Type C-x 1 and see the documentation listing window disappear. -This command is unlike the other commands you have learned in that it -consists of two characters. It starts with the character CONTROL-x. There is a whole series of commands that start with CONTROL-x; many of them have to do with windows, files, buffers, and related things. These commands are two, three or four characters long. @@ -337,7 +335,7 @@ Remember that most Emacs commands can be given a repeat count; this includes text characters. Repeating a text character inserts it several times. ->> Try that now -- type C-u 8 * to insert ********. +>> Try that now -- type C-u 8 * to insert ********. You've now learned the most basic way of typing something in Emacs and correcting errors. You can delete by words or lines @@ -522,11 +520,8 @@ command This copies the text within Emacs into the file. The first time you do this, Emacs renames the original file to a new name so that it is not lost. The new name is made by adding "~" to the end of the -original file's name. - -When saving is finished, Emacs displays the name of the file written. -You should save fairly often, so that you will not lose very much -work if the system should crash (see the section "Auto Save" below). +original file's name. When saving is finished, Emacs displays the +name of the file written. >> Type C-x C-s TUTORIAL . This should save this tutorial to a file named TUTORIAL, and show @@ -534,11 +529,11 @@ work if the system should crash (see the section "Auto Save" below). You can find an existing file, to view it or edit it. You can also find a file which does not already exist. This is the way to create a -file with Emacs: find the file, which will start out empty, and then -begin inserting the text for the file. When you ask to "save" the -file, Emacs will really create the file with the text that you have -inserted. From then on, you can consider yourself to be editing an -already existing file. +file with Emacs: find the file, which starts out empty, and then begin +inserting the text for the file. When you ask to "save" the file, +Emacs actually creates the file with the text that you have inserted. +From then on, you can consider yourself to be editing an already +existing file. * BUFFERS @@ -595,8 +590,8 @@ this does not save the first file. Its changes remain inside Emacs, in that file's buffer. The creation or editing of the second file's buffer has no effect on the first file's buffer. This is very useful, but it also means that you need a convenient way to save the first -file's buffer. It would be a nuisance to have to switch back to -it with C-x C-f in order to save it with C-x C-s. So we have +file's buffer. Having to switch back to that buffer, in order to save +it with C-x C-s, would be a nuisance. So we have C-x s Save some buffers @@ -631,7 +626,7 @@ If you are using a graphical display, you don't need any special command to move from Emacs to another application. You can do this with the mouse or with window manager commands. However, if you're using a text terminal which can only show one application at a time, -you need to "suspend" Emacs to move to any other program. +you need to "suspend" Emacs to move to any other application. C-z is the command to exit Emacs *temporarily*--so that you can go back to the same Emacs session afterward. When Emacs is running on a @@ -640,8 +635,8 @@ but does not destroy the Emacs job. In the most common shells, you can resume Emacs with the `fg' command or with `%emacs'. The time to use C-x C-c is when you are about to log out. It's also -the right thing to use to exit an Emacs invoked under mail handling -programs and other miscellaneous utilities. +the right thing to use to exit an Emacs invoked for a quick edit, such +as by a mail handling utility. There are many C-x commands. Here is a list of the ones you have learned: @@ -656,8 +651,8 @@ There are many C-x commands. Here is a list of the ones you have learned: Named eXtended commands are commands which are used even less frequently, or commands which are used only in certain modes. An -example is the command replace-string, which globally replaces one -string with another. When you type M-x, Emacs prompts you at the +example is the command replace-string, which replaces one string with +another in the buffer. When you type M-x, Emacs prompts you at the bottom of the screen with M-x and you should type the name of the command; in this case, "replace-string". Just type "repl s" and Emacs will complete the name. ( is the Tab key, usually found @@ -671,9 +666,9 @@ argument with . >> Move the cursor to the blank line two lines below this one. Then type M-x repl schangedaltered. - Notice how this line has changed: you've replaced - the word c-h-a-n-g-e-d with "altered" wherever it occurred, - after the initial position of the cursor. + Notice how this line has changed: you've replaced the word + "changed" with "altered" wherever it occurred, after the + initial position of the cursor. * AUTO SAVE @@ -762,6 +757,7 @@ differently. To view documentation on your current major mode, type C-h m. +>> Move the cursor to the line following this line. >> Type C-l C-l to bring this line to the top of screen. >> Type C-h m, to see how Text mode differs from Fundamental mode. >> Type C-x 1 to remove the documentation from the screen. @@ -893,7 +889,8 @@ display, those cursors are drawn as unblinking hollow boxes. The command C-M-v is very useful when you are editing text in one window and using the other window just for reference. Without leaving -the selected window, you can scroll the other window with C-M-v. +the selected window, you can scroll the text in the other window with +C-M-v. C-M-v is an example of a CONTROL-META character. If you have a META (or Alt) key, you can type C-M-v by holding down both CONTROL and META @@ -1041,8 +1038,8 @@ You need to type in the name of the variable when Emacs prompts for it. >> Type C-h a file . This displays in another window a list of all M-x commands with "file" -in their names. You will see character-commands like C-x C-f listed -beside the corresponding command names such as find-file. +in their names. You will see character-commands listed beside the +corresponding command names (such as C-x C-f beside find-file). >> Type C-M-v to scroll the help window. Do this a few times. diff --git a/etc/tutorials/TUTORIAL.es b/etc/tutorials/TUTORIAL.es index fe8c223551a..b48f0aa79fb 100644 --- a/etc/tutorials/TUTORIAL.es +++ b/etc/tutorials/TUTORIAL.es @@ -222,13 +222,13 @@ bandera: la presencia de un argumento prefijo, sin tener en cuenta su valor, hace que el comando acte de forma diferente. C-v y M-v son otro tipo de excepcin. Cuando se les da un argumento, -desplazan la pantalla arriba o abajo esa cantidad de lneas, en vez de +desplazan el texto arriba o abajo esa cantidad de lneas, en vez de una pantalla completa. Por ejemplo, C-u 8 C-v desplaza la pantalla 8 lneas. >> Pruebe tecleando C-u 8 C-v ahora. -Esto debi haber desplazado la pantalla hacia arriba 8 lneas. Si +Esto debera haber desplazado el texto hacia arriba 8 lneas. Si quisiera desplazarla hacia abajo de nuevo, puede dar un argumento a M-v. @@ -299,9 +299,7 @@ dem >> Escriba C-x 1 y vea que la ventana de listado de documentacin desaparece. -Este comando es diferente a los otros que ha aprendido en que ste -consiste de dos caracteres. Comienza con el carcter CONTROL-x. Hay -toda una serie de comandos que comienzan con CONTROL-x; muchos de +Hay toda una serie de comandos que comienzan con CONTROL-x; muchos de ellos tienen que ver con ventanas, archivos, buffers y cosas relacionadas. Estos comandos son de una longitud de dos, tres o cuatro caracteres. @@ -554,12 +552,8 @@ comando Esto copia el texto dentro de Emacs al archivo. La primera vez que haga esto, Emacs renombrar el archivo original con un nuevo nombre para que ste no se pierda. El nuevo nombre se hace agregando "~" al -final del nombre del archivo original. - -Cuando guardar haya terminado, Emacs mostrar el nombre del archivo -escrito. Deber guardar frecuentemente, para que no pierda mucho -trabajo si el sistema falla (vea la seccin "AUTO GUARDADO", ms -adelante). +final del nombre del archivo original. Cuando guardar haya terminado, +Emacs mostrar el nombre del archivo escrito. >> Teclee C-x C-s TUTORIAL.es Esto guardar el tutorial en un archivo llamado TUTORIAL.es, y @@ -567,10 +561,10 @@ adelante). Puede encontrar un archivo existente, para verlo o editarlo. Tambin puede hacerlo con un archivo que no exista. sta es la forma de crear -un archivo en Emacs: encuentre el archivo, que comenzar vaco, luego -comience a insertar el texto para ese archivo. Cuando invoque +un archivo en Emacs: encuentre el archivo, que est inicialmente vaco, +luego comience a insertar el texto para ese archivo. Cuando invoque "guardar" el archivo, Emacs crear realmente el archivo con el texto -que ha insertado. De ah en adelante, puede considerarse estar +que ha insertado. De ah en adelante, puede considerar que est editando un archivo existente. @@ -631,8 +625,8 @@ archivo, esto no guarda el primer archivo. Sus cambios permanecer dentro de Emacs en ese buffer del archivo. La creacin o edicin del segundo buffer de archivo no afecta al primero. Esto es muy til, pero tambin significa que necesita una forma conveniente para guardar -el archivo del primer buffer. Sera una molestia tener que volver a -ste con C-x C-f para guardarlo con C-x C-s. As tenemos +el archivo del primer buffer. Tener que volver a l para guardarlo +con C-x C-s sera una molestia. Por tanto, tenemos C-x s Guardar algunos buffers @@ -667,7 +661,7 @@ Si est especial para cambiar de Emacs a otra aplicacin. Puede hacerlo con el ratn, o mediante el gestor de ventanas. Sin embargo, si est usando una terminal que solo puede mostrar una aplicacin a la vez, -tendr que "suspender" Emacs para poder acceder a otros programas. +tendr que "suspender" Emacs para poder acceder a otras aplicaciones. C-z es el comando para salir de Emacs *temporalmente*: para que pueda regresar a la misma sesin de Emacs despus. Cuando Emacs est @@ -677,8 +671,9 @@ int comando `fg' o con `%emacs'. El momento para usar C-x C-c es cuando est listo para salir del -sistema. Es adems el paso correcto para salir de un Emacs llamado -bajo programas de gestin de correo y otras utilidades diversas. +sistema. Es adems el paso correcto para salir de un Emacs invocado +para editar algo rpidamente, como por ejemplo desde un programa de +gestin de correo. Existen muchos comandos C-x. He aqu la lista de los que ya ha aprendido: @@ -694,14 +689,14 @@ aprendido: Los comandos eXtendidos por nombre son comandos que se utilizan an con menos frecuencia, o nicamente en ciertos modos. Un ejemplo es el -comando replace-string, el cual substituye globalmente una cadena de -caracteres por otra. Cuando teclea M-x, Emacs le pregunta al final de -la pantalla con M-x y debe escribir el nombre del comando; en este -caso "replace-string". Solo teclee "repl s" y Emacs completar -el nombre. ( es la tecla del tabulador, que habitualment est -situada sobre la tecla de bloquear maysculas o la de shift, en el -lado izquierdo del teclado.) Para aceptar el comando y ejecutarlo, -pulse . +comando replace-string, el cual substituye una cadena de caracteres +por otra en todo el buffer. Cuando teclea M-x, Emacs le pregunta al +final de la pantalla con M-x y debe escribir el nombre del comando; en +este caso "replace-string". Solo teclee "repl s" y Emacs +completar el nombre. ( es la tecla del tabulador, que +habitualment est situada sobre la tecla de bloquear maysculas o la +de shift, en el lado izquierdo del teclado.) Para aceptar el comando +y ejecutarlo, pulse . El comando replace-string requiere dos argumentos: la cadena de caracteres a reemplazar, y la cadena de caracteres para reemplazarla. @@ -711,8 +706,8 @@ Debe terminar cada argumento con . A continuacin escriba M-x repl scambiadoalterado. - Note cmo esta lnea ha cambiado: ha substituido la palabra - c-a-m-b-i-a-d-o por "alterado" en cada ocurrencia, despus de la + Note cmo ha cambiado la lnea: ha substituido la palabra + "cambiado" por "alterado" en cada ocurrencia, despus de la posicin inicial del cursor. @@ -804,7 +799,9 @@ pero funcionan de forma un poco diferente. Para ver la documentacin del modo mayor actual, teclee C-h m. ->> Use C-l C-l para traer esta lnea en la parte superior de la +>> Mueva el cursor a la lnea siguiente a la actual. + +>> Use C-l C-l para traer esta lnea a la parte superior de la pantalla. >> Teclee C-h m, para ver como el modo de Texto difiere del modo @@ -1102,9 +1099,9 @@ pregunte por ella. >> Teclee C-h a file . Esto muestra en otra ventana una lista de todos los comandos M-x con -la palabra "file" en sus nombres. Ver comandos de caracteres como -C-x C-f listados adems de los nombres de los comandos -correspondientes tales como find-file. +la palabra "file" en sus nombres. Ver los comandos de caracteres +listados junto a los nombres de los comandos correspondientes (por +ejemplo, C-x C-f junto a find-file). >> Teclee C-M-v para desplazar la ventana de ayuda. Haga esto unas cuantas veces. diff --git a/etc/tutorials/TUTORIAL.fr b/etc/tutorials/TUTORIAL.fr index 89ec7c16f8b..7b829ccee73 100644 --- a/etc/tutorials/TUTORIAL.fr +++ b/etc/tutorials/TUTORIAL.fr @@ -18,10 +18,10 @@ tapez C-g. Dans ce didacticiel, les caract indiquent les directions suivre pour essayer une commande. Ainsi : <> [Centre de page delibrment vide. Le texte continue ci-dessous.] ->> Tapez C-v (Voir l'cran suivant) pour passer l'cran suivant - (faites-le, pressez la touche CTRL tout en pressant la touche v). - partir de maintenant, vous devrez le faire chaque fois que - vous avez fini de lire l'cran. +>> Tapez C-v (Voir l'cran suivant) pour passer l'cran suivant + (faites-le, pressez la touche CTRL tout en pressant la touche v). + partir de maintenant, vous devrez le faire chaque fois que + vous avez fini de lire l'cran. Vous remarquerez qu'il y a un recouvrement de deux lignes lorsque l'on passe d'un cran un autre : cela permet une certaine continuit dans @@ -33,7 +33,7 @@ C-v. Pour revenir un META tout en appuyant sur v ou faites v si vous n'avez pas de touche META, EDIT ou ALT). ->> Faites M-v, puis C-v plusieurs fois. +>> Faites M-v, puis C-v plusieurs fois. * RSUM @@ -228,13 +228,13 @@ d'un param agir diffremment. C-v et M-v constituent un autre type d'exception. Lorsqu'on leur donne -un paramtre, elles font dfiler l'cran vers le haut ou vers le bas +un paramtre, elles font dfiler le texte vers le haut ou vers le bas du nombre de lignes indiqu au lieu de passer d'un cran complet -l'autre. C-u 8 C-v, par exemple, fait dfiler l'cran de 8 lignes. +l'autre. C-u 8 C-v, par exemple, fait dfiler le texte de 8 lignes. >> Faites C-u 8 C-v. -Cela a d dplacer l'cran de 8 lignes vers le haut. Si vous voulez +Cela a d dplacer le texte de 8 lignes vers le haut. Si vous voulez redescendre de 8 lignes, il suffit de passer ce nombre comme paramtre de M-v. @@ -307,11 +307,10 @@ supprime toutes les autres fen >> Faites C-x 1 et la fentre de documentation disparat. -Cette commande est diffrente de celles que nous avons dj vues car -elle est forme de deux caractres. Elle commence par le caractre -CONTROLE-x, comme le font de nombreuses commandes de manipulation de -fentres, fichiers, tampons et autres entits associes. Ces commandes -font deux, trois ou quatre caractres. +Il y a toute une srie de commandes qui commencent par CONTROL-x; +nombre d'entre elles ont voir avec la manipulation de fentres, +fichiers, tampons et autres entits associes. Ces commandes font +deux, trois ou quatre caractres de long. * INSERTION ET SUPPRESSION @@ -370,7 +369,7 @@ Rappelez-vous que la plupart des commandes Emacs peuvent utiliser un nombre de rptitions ; les caractres de texte font de mme. La rptition d'un caractre de texte l'insre plusieurs fois. ->> Faites C-u 8 * pour insrer ********. +>> Faites C-u 8 * pour insrer ********. Vous connaissez maintenant la mthode la plus simple pour taper du texte dans Emacs et pour corriger les erreurs. Vous pouvez galement @@ -572,11 +571,8 @@ deviennent permanentes, faites : Cette commande copie dans le fichier le texte qui est dans Emacs. La premire fois, Emacs renomme le fichier original afin qu'il ne soit pas perdu. Le nom de cette sauvegarde est construit en ajoutant ~ - la fin du nom initial. - -Lorsque la sauvegarde est finie, Emacs affiche le nom du fichier -crit. Sauvegardez intervalles rguliers afin de perdre le moins -possible de travail au cas o votre systme se planterait. + la fin du nom initial. Lorsque la sauvegarde est finie, Emacs +affiche le nom du fichier crit. >> Faites C-x C-s pour sauvegarder votre copie du didacticiel. Cela devrait crire "Wrote ...TUTORIAL.fr" en bas de l'cran. @@ -694,7 +690,7 @@ commande sp Vous pouvez le faire l'aide de la souris ou avec les commandes du gestionnaire de fentres. Cependant, si vous utilisez un terminal texte ne pouvant afficher qu'une application la fois, vous devez - suspendre Emacs pour passer n'importe quel autre programme. + suspendre Emacs pour passer n'importe quelle autre application. C-z est la commande permettant de quitter *temporairement* Emacs -- afin de pouvoir revenir la mme session plus tard. Sur les systmes @@ -704,7 +700,8 @@ vous pouvez revenir Le moment idal pour utiliser C-x C-c est lorsque l'on se dconnecte. C'est aussi la commande adapte pour sortir d'un Emacs -invoqu par un programme de courrier ou tout autre utilitaire. +invoqu pour une modification rapide, par exemple par un programme de +courrier ou tout autre utilitaire. Il existe de nombreuses commandes C-x. Voici une liste de celles que vous avez apprises : @@ -719,7 +716,7 @@ vous avez apprises : Les eXtensions de commandes nommes sont des commandes utilises encore moins souvent, ou des commandes qui ne servent que dans certains modes. Un exemple est la commande replace-string, qui -remplace globalement une chane par une autre. Lorsque vous faites +remplace une chane par une autre dans un tampon. Lorsque vous faites M-x, Emacs affiche M-x en bas de l'cran et vous demande de taper le nom de la commande, replace-string ici. Contentez-vous de faire repl s et Emacs compltera le nom ( reprsente la touche @@ -735,7 +732,7 @@ param Puis, faites M-x repl schangemodifie. Notez comment cette ligne a t change : vous avez remplac le mot - c-h-a-n-g--e par modifie chaque fois qu'il apparaissait aprs + change par modifie chaque fois qu'il apparaissait aprs la position initiale du curseur. @@ -949,7 +946,7 @@ manuel d'Emacs contient un Glossaire des termes d'Emacs.) fentres. Toutes les deux affichent ce didacticiel et le curseur reste dans celle du haut. ->> Faites C-M-v pour faire dfiler la fentre du bas +>> Faites C-M-v pour faire dfiler le texte de la fentre du bas (Si vous n'avez pas de touche Meta, faites C-v). >> Tapez C-x o ( o pour other ) afin de placer le curseur dans @@ -1123,9 +1120,9 @@ Voici d'autres options utiles de C-h : >> Faites C-h a file. Cela affiche dans une autre fentre une liste de toutes les commandes -M-x ayant file dans leurs noms. Vous verrez des commandes -caractres, comme C-x C-f, apparatre ct des noms de commandes qui -leur correspondent, comme find-file. +M-x ayant file dans leurs noms. Vous verrez liste des commandes +caractres ct des noms de commandes qui leur correspondent (comme +C-x C-f ct de find-file). >> Faites C-M-v pour faire dfiler la fentre d'aide. Faites-le plusieurs fois. diff --git a/etc/tutorials/TUTORIAL.he b/etc/tutorials/TUTORIAL.he index cb82f87f765..e0c85a379a9 100644 --- a/etc/tutorials/TUTORIAL.he +++ b/etc/tutorials/TUTORIAL.he @@ -1,4 +1,4 @@ -שיעור ראשון בשימוש ב־Emacs. זכויות שימוש ראה בסוף המסמך. +שיעור ראשון בשימוש ב־‫Emacs‬. זכויות שימוש ראה בסוף המסמך. פקודות רבות של Emacs משתמשות במקש CONTROL (לפעמים הוא מסומן ב־CTRL או CTL) או במקש META (לפעמים מסומן EDIT או ALT). במקום לציין את כל השמות האפשריים diff --git a/leim/ChangeLog b/leim/ChangeLog index 34523227f83..f3acaebec94 100644 --- a/leim/ChangeLog +++ b/leim/ChangeLog @@ -1,3 +1,9 @@ +2012-07-10 Stefan Monnier + + * quail/ipa.el: Use cl-lib. + + * quail/hangul.el: Don't require CL. + 2012-06-12 Nguyen Thai Ngoc Duy * quail/vnvi.el: New file (Bug#4747). diff --git a/leim/SKK-DIC/SKK-JISYO.L b/leim/SKK-DIC/SKK-JISYO.L index 177ba7ce731..5e2199cbfdc 100644 Binary files a/leim/SKK-DIC/SKK-JISYO.L and b/leim/SKK-DIC/SKK-JISYO.L differ diff --git a/leim/ja-dic/ja-dic.el b/leim/ja-dic/ja-dic.el index 19caea49629..c674ca99165 100644 --- a/leim/ja-dic/ja-dic.el +++ b/leim/ja-dic/ja-dic.el @@ -47,7 +47,7 @@ ;; the Free Software Foundation Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;; -;; ACKNOWLEDGEMENT +;; ACKNOWLEDGMENT ;; ;; μϡSKK Ԥκƣɧ 1 ǺΤ ;; ŵ̿꺴ƣ漼 () γãȤȤ scratch diff --git a/leim/quail/hangul.el b/leim/quail/hangul.el index 2ce55a57107..d30957ae7e6 100644 --- a/leim/quail/hangul.el +++ b/leim/quail/hangul.el @@ -30,7 +30,6 @@ ;;; Code: (require 'quail) -(eval-when-compile (require 'cl)) ; for setf (require 'hanja-util) ;; Hangul double Jamo table. diff --git a/leim/quail/ipa.el b/leim/quail/ipa.el index 72db819fa23..b29a6ffc113 100644 --- a/leim/quail/ipa.el +++ b/leim/quail/ipa.el @@ -29,7 +29,7 @@ ;;; Code: (require 'quail) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (quail-define-package "ipa" "IPA" "IPA" t @@ -277,13 +277,13 @@ string." (setq quail-keymap (list (string quail-keymap))) (if (stringp quail-keymap) (setq quail-keymap (list quail-keymap)) - (assert (vectorp quail-keymap) t) + (cl-assert (vectorp quail-keymap) t) (setq quail-keymap (append quail-keymap nil)))) (list (apply 'vector (mapcar #'(lambda (entry) - (assert (char-or-string-p entry) t) + (cl-assert (char-or-string-p entry) t) (format "%s%s" to-prepend (if (integerp entry) (string entry) entry))) quail-keymap)))) @@ -318,18 +318,18 @@ particular sequence of keys, and the result will be cached by Quail." (dolist (underscoring underscore-map) (cond ((null underscoring)) ((eq (length underscoring) 2) - (setq underscore-map-entry (second underscoring)) + (setq underscore-map-entry (cl-second underscoring)) (setcdr underscoring (ipa-x-sampa-prepend-to-keymap-entry pre-underscore-map underscore-map-entry))) ((eq (length underscoring) 3) - (setq underscore-map-entry (second (third underscoring))) - (setcdr (third underscoring) + (setq underscore-map-entry (cl-second (cl-third underscoring))) + (setcdr (cl-third underscoring) (ipa-x-sampa-prepend-to-keymap-entry pre-underscore-map underscore-map-entry))) (t - (assert (null t) t - "Can't handle subtrees of this level right now.")))) - (append underscore-map (list (list ?< (second x-sampa-submap-entry)))))) + (cl-assert (null t) t + "Can't handle subtrees of this level right now.")))) + (append underscore-map (list (list ?< (cl-second x-sampa-submap-entry)))))) (quail-define-package "ipa-x-sampa" "IPA" "IPA-X" t diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index 68a8c37c2fb..4f4d2b50a00 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,159 @@ +2012-07-12 Paul Eggert + + * movemail.c: Add missing 'defined'. + Suggested by Sven Joachim in + . + +2012-07-11 Paul Eggert + + Port 'movemail' again to Solaris and similar hosts. + See Susan Cragin's report in + . + * movemail.c (xmalloc): Also define if !DISABLE_DIRECT_ACCESS && + !MAIL_USE_MMDF && !MAIL_USE_SYSTEM_LOCK. Move up, so it doesn't + need a forward declaration. + (main): Rewrite to avoid no-longer-present function 'concat', if + !DISABLE_DIRECT_ACCESS && !MAIL_USE_MMDF && !MAIL_USE_SYSTEM_LOCK. + + Assume strerror. + * emacsclient.c, movemail.c, update-game-score.c (strerror) + [!HAVE_STRERROR]: Remove. + +2012-07-10 Paul Eggert + + EMACS_TIME simplification (Bug#11875). + * profile.c (TV2): Remove no-longer-needed static var. + + Simplify by avoiding confusing use of strncpy etc. + * etags.c (write_classname, C_entries): + Use sprintf rather than strncpy or strncat. + * etags.c (consider_token, C_entries, HTML_labels, Prolog_functions) + (Erlang_functions, substitute, readline_internal, savenstr): + * movemail.c (mail_spool_name): + Use memcpy rather than strncpy or strncat when either will do. + * make-docfile.c (write_c_args): + Use memcmp rather than strncmp when either will do. + * movemail.c (pop_retr): + * pop.c (pop_stat, pop_list, pop_multi_first, pop_last) + (socket_connection, pop_getline, sendline, getok): + Use snprintf rather than strncpy or strncat. + * movemail.c (concat): Remove; no longer needed. + (xmalloc): Define only if needed, now that concat has gone away. + Return void *. All uses changed. + +2012-07-09 Paul Eggert + + Add GCC-style 'const' attribute to functions that can use it. + * etags.c (number_len): Add ATTRIBUTE_CONST. + +2012-07-09 Juanma Barranquero + + * emacsclient.c (w32_execvp): Declare execvp to silence the compiler. + +2012-07-09 Juanma Barranquero + + * makefile.w32-in ($(BLD)/test-distrib.exe): Use LIB_SRC, not SRC. + (LIB_SRC, NT_INC, GNU_LIB, MS_W32_H, CONFIG_H, INTTYPES_H, NTLIB_H) + (SYSTIME_H): New macros. + (SRC): Redefine to point to src/, not current directory. + ($(BLD)/ctags.$(O), $(BLD)/ebrowse.$(O), $(BLD)/emacsclient.$(O)) + ($(BLD)/etags.$(O), $(BLD)/hexl.$(O), $(BLD)/make-docfile.$(O)) + ($(BLD)/movemail.$(O), $(BLD)/ntlib.$(O), $(BLD)/pop.$(O)) + ($(BLD)/profile.$(O), $(BLD)/test-distrib.$(O)): Update dependencies. + ($(BLD)/regex.$(O)): New dependency. + +2012-07-09 Juanma Barranquero + + * makefile.w32-in (ALL): Add profile.exe. + (PROFILEOBJS): New macro. + ($(BLD)/profile.exe): New target. + (install): Copy profile.exe. + ($(BLD)/alloca.$(O), $(BLD)/tcp.$(O)): Remove, obsolete. + +2012-07-07 Juanma Barranquero + + * makefile.w32-in ($(BLD)/ctags.$(O), $(BLD)/etags.$(O)): + Update dependencies. + +2012-07-06 Paul Eggert + + Use c_strcasecmp for ASCII case-insensitive comparison (Bug#11786). + * etags.c: Include c-strcase.h. + (etags_strcasecmp, etags_strncasecmp): Remove. + All uses replaced with c_strcasecmp and c_strncasecmp. + +2012-07-06 Andreas Schwab + + * make-docfile.c (write_globals): Warn about duplicate function + definitions with differing signatures. + +2012-07-03 Paul Eggert + + * make-docfile.c (scan_c_file): Suppress GCC warning. + +2012-06-29 Tom Tromey + + * make-docfile.c (enum global_type) : New constant. + (struct global) : New field. + (add_global): Add 'value' argument. + (compare_globals): Sort functions at the end. + (close_emacs_globals): New function. + (write_globals): Handle functions. + (scan_c_file): Call add_global for DEFUN. + +2012-06-30 Juanma Barranquero + + * makefile.w32-in (CTAGS_CFLAGS): Remove EMACS_NAME; + already defined in ETAGS_CFLAGS. + +2012-06-27 Glenn Morris + + * makefile.w32-in (lisp2): Remove paths.el. + +2012-06-26 Paul Eggert + + Clean out last vestiges of the old HAVE_CONFIG_H stuff. + * Makefile.in (BASE_CFLAGS): + * makefile.w32-in (LOCAL_FLAGS): Remove -DHAVE_CONFIG_H. + * etags.c, hexl.c, pop.c: Include unconditionally. + * etags.c (DOS_NT): + * pop.c (MAIL_USE_POP, h_errno): + Remove code that was conditioned on !HAVE_CONFIG_H. + +2012-06-25 Dmitry Antipov + + * etags.c (etags_strcasecmp, etags_strncasecmp): Define to + library functions strcasecmp and strncasecmp if available. + +2012-06-24 Paul Eggert + + Switch from NO_RETURN to C11's _Noreturn (Bug#11750). + * ebrowse.c (usage, version): + * emacsclient.c (print_help_and_exit, fail): + * etags.c (suggest_asking_for_help, fatal, pfatal): + * hexl.c (usage): + * make-docfile.c (fatal): + * movemail.c (fatal, pfatal_with_name, pfatal_and_delete): + * update-game-score.c (usage): + * ebrowse.c (usage, version): + * emacsclient.c (print_help_and_exit, fail): + Use _Noreturn rather than NO_RETURN. + No need for separate decl merely because of _Noreturn. + +2012-06-24 Samuel Bronson (tiny change) + + * emacsclient.c (set_local_socket): Fix compiler warning (Bug#7838). + +2012-06-22 Paul Eggert + + Support higher-resolution time stamps (Bug#9000). + * Makefile.in (LIB_CLOCK_GETTIME): New macro. + (profile${EXEEXT}): Use it. + * profile.c: Include inttypes.h, intprops.h. + (time_string): Size conservatively; do not guess size. + (get_time): Now prints nanoseconds. + (gettimeofday): Remove replacement function; gnulib now does this. + 2012-06-08 Andreas Schwab * make-docfile.c (search_lisp_doc_at_eol): Unget last read diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index 2df22d9f7d8..fe727c65730 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -159,6 +159,8 @@ LIBHESIOD=@LIBHESIOD@ LIBRESOLV=@LIBRESOLV@ ## -llockfile if HAVE_LIBLOCKFILE or -lmail if HAVE_LIBMAIL LIBS_MAIL=@LIBS_MAIL@ +## empty or -lrt or -lposix4 if HAVE_CLOCK_GETTIME +LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@ ## Extra libraries to use when linking movemail. LIBS_MOVE = $(LIBS_MAIL) $(KRB4LIB) $(DESLIB) $(KRB5LIB) $(CRYPTOLIB) \ @@ -167,12 +169,9 @@ LIBS_MOVE = $(LIBS_MAIL) $(KRB4LIB) $(DESLIB) $(KRB5LIB) $(CRYPTOLIB) \ ## Some systems define this to request special libraries. LIBS_SYSTEM = @LIBS_SYSTEM@ -# Those files shared with other GNU utilities need HAVE_CONFIG_H -# defined before they know they can take advantage of the information -# in ../src/config.h. BASE_CFLAGS = $(C_SWITCH_SYSTEM) $(C_SWITCH_MACHINE) \ $(WARN_CFLAGS) $(WERROR_CFLAGS) \ - -DHAVE_CONFIG_H -I. -I../src -I../lib \ + -I. -I../src -I../lib \ -I${srcdir} -I${srcdir}/../src -I${srcdir}/../lib ALL_CFLAGS = ${BASE_CFLAGS} ${PROFILING_CFLAGS} ${LDFLAGS} ${CPPFLAGS} ${CFLAGS} @@ -309,7 +308,8 @@ ctags${EXEEXT}: etags${EXEEXT} regex.o $(LOADLIBES) -o ctags profile${EXEEXT}: ${srcdir}/profile.c ../src/config.h - $(CC) ${ALL_CFLAGS} ${srcdir}/profile.c $(LOADLIBES) -o profile + $(CC) ${ALL_CFLAGS} ${srcdir}/profile.c \ + $(LOADLIBES) $(LIB_CLOCK_GETTIME) -o profile make-docfile${EXEEXT}: ${srcdir}/make-docfile.c ../src/config.h $(CC) ${ALL_CFLAGS} ${srcdir}/make-docfile.c $(LOADLIBES) \ diff --git a/lib-src/ebrowse.c b/lib-src/ebrowse.c index a1fe10b863a..1c43bc6a4f1 100644 --- a/lib-src/ebrowse.c +++ b/lib-src/ebrowse.c @@ -463,10 +463,6 @@ static struct member *add_member (struct sym *, char *, int, int, unsigned); static void class_definition (struct sym *, int, int, int); static char *operator_name (int *); static void parse_qualified_param_ident_or_type (char **); -static void usage (int) NO_RETURN; -static void version (void) NO_RETURN; - - /*********************************************************************** Utilities @@ -3507,7 +3503,7 @@ Usage: ebrowse [options] {files}\n\ --version display version info\n\ " -static void +static _Noreturn void usage (int error) { puts (USAGE); @@ -3522,7 +3518,7 @@ usage (int error) # define VERSION "21" #endif -static void +static _Noreturn void version (void) { /* Makes it easier to update automatically. */ diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 29504445407..0ba6535b79d 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -21,7 +21,7 @@ along with GNU Emacs. If not, see . */ #ifdef WINDOWSNT -/* config.h defines these, which disables sockets altogether! */ +/* ms-w32.h defines these, which disables sockets altogether! */ # undef _WINSOCKAPI_ # undef _WINSOCK_H @@ -169,8 +169,7 @@ int emacs_pid = 0; 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; +static _Noreturn void print_help_and_exit (void); struct option longopts[] = @@ -452,19 +451,19 @@ w32_window_app (void) return window_app; } -/* - execvp wrapper for Windows. Quotes arguments with embedded spaces. +/* execvp wrapper for Windows. Quotes arguments with embedded spaces. This is necessary due to the broken implementation of exec* routines in the Microsoft libraries: they concatenate the arguments together without quoting special characters, and pass the result to CreateProcess, with predictably bad results. By contrast, POSIX execvp passes the arguments - directly into the argv array of the child process. -*/ + directly into the argv array of the child process. */ + int w32_execvp (const char *path, char **argv) { int i; + extern int execvp (const char*, char **); /* Required to allow a .BAT script as alternate editor. */ argv[0] = (char *) alternate_editor; @@ -670,7 +669,7 @@ an empty string"); } -static void +static _Noreturn void print_help_and_exit (void) { /* Spaces and tabs are significant in this message; they're chosen so the @@ -713,12 +712,11 @@ Report bugs with M-x report-emacs-bug.\n", progname); exit (EXIT_SUCCESS); } -/* - Try to run a different command, or --if no alternate editor is - defined-- exit with an errorcode. - Uses argv, but gets it from the global variable main_argv. -*/ -static void +/* Try to run a different command, or --if no alternate editor is + defined-- exit with an errorcode. + Uses argv, but gets it from the global variable main_argv. */ + +static _Noreturn void fail (void) { if (alternate_editor) @@ -751,16 +749,15 @@ main (int argc, char **argv) #define AUTH_KEY_LENGTH 64 #define SEND_BUFFER_SIZE 4096 -extern char *strerror (int); - /* Buffer to accumulate data to send in TCP connections. */ char send_buffer[SEND_BUFFER_SIZE + 1]; int sblen = 0; /* Fill pointer for the send buffer. */ /* Socket used to communicate with the Emacs server process. */ HSOCKET emacs_socket = 0; -/* On Windows, the socket library was historically separate from the standard - C library, so errors are handled differently. */ +/* On Windows, the socket library was historically separate from the + standard C library, so errors are handled differently. */ + static void sock_err_message (const char *function_name) { @@ -865,7 +862,7 @@ quote_argument (HSOCKET s, const char *str) /* The inverse of quote_argument. Removes quoting in string STR by - modifying the string in place. Returns STR. */ + modifying the string in place. Returns STR. */ static char * unquote_argument (char *str) @@ -948,10 +945,9 @@ initialize_sockets (void) #endif /* WINDOWSNT */ -/* - * Read the information needed to set up a TCP comm channel with - * the Emacs server: host, port, and authentication string. - */ +/* Read the information needed to set up a TCP comm channel with + the Emacs server: host, port, and authentication string. */ + static int get_server_config (const char *config_file, struct sockaddr_in *server, char *authentication) @@ -1032,18 +1028,14 @@ set_tcp_socket (const char *local_server_file) message (FALSE, "%s: connected to remote socket at %s\n", progname, inet_ntoa (server.sin_addr)); - /* - * Open up an AF_INET socket - */ + /* Open up an AF_INET socket. */ if ((s = socket (AF_INET, SOCK_STREAM, IPPROTO_TCP)) < 0) { sock_err_message ("socket"); return INVALID_SOCKET; } - /* - * Set up the socket - */ + /* Set up the socket. */ if (connect (s, (struct sockaddr *) &server, sizeof server) < 0) { sock_err_message ("connect"); @@ -1052,9 +1044,7 @@ set_tcp_socket (const char *local_server_file) setsockopt (s, SOL_SOCKET, SO_LINGER, (char *) &l_arg, sizeof l_arg); - /* - * Send the authentication - */ + /* Send the authentication. */ auth_string[AUTH_KEY_LENGTH] = '\0'; send_to_emacs (s, "-auth "); @@ -1188,7 +1178,7 @@ handle_sigcont (int signalnum) going to sleep. Normally the suspend is initiated by Emacs via server-handle-suspend-tty, but if the server gets out of sync with reality, we may get a SIGTSTP on C-z. Handling this signal and - notifying Emacs about it should get things under control again. */ + notifying Emacs about it should get things under control again. */ static void handle_sigtstp (int signalnum) @@ -1240,10 +1230,7 @@ set_local_socket (const char *local_socket_name) HSOCKET s; struct sockaddr_un server; - /* - * Open up an AF_UNIX socket in this person's home directory - */ - + /* Open up an AF_UNIX socket in this person's home directory. */ if ((s = socket (AF_UNIX, SOCK_STREAM, 0)) < 0) { message (TRUE, "%s: socket: %s\n", progname, strerror (errno)); @@ -1278,7 +1265,7 @@ set_local_socket (const char *local_socket_name) if (n > 0) { tmpdir = tmpdir_storage = xmalloc (n); - confstr (_CS_DARWIN_USER_TEMP_DIR, tmpdir, n); + confstr (_CS_DARWIN_USER_TEMP_DIR, tmpdir_storage, n); } else #endif @@ -1477,10 +1464,9 @@ w32_find_emacs_process (HWND hWnd, LPARAM lParam) return FALSE; } -/* - * Search for a window of class "Emacs" and owned by a process with - * process id = emacs_pid. If found, allow it to grab the focus. - */ +/* Search for a window of class "Emacs" and owned by a process with + process id = emacs_pid. If found, allow it to grab the focus. */ + void w32_give_focus (void) { @@ -1862,22 +1848,3 @@ main (int argc, char **argv) } #endif /* HAVE_SOCKETS && HAVE_INET_SOCKETS */ - - -#ifndef HAVE_STRERROR -char * -strerror (errnum) - int errnum; -{ - extern char *sys_errlist[]; - extern int sys_nerr; - - if (errnum >= 0 && errnum < sys_nerr) - return sys_errlist[errnum]; - return (char *) "Unknown error"; -} - -#endif /* ! HAVE_STRERROR */ - - -/* emacsclient.c ends here */ diff --git a/lib-src/etags.c b/lib-src/etags.c index 7d2a5a90999..69200b790fb 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -91,9 +91,7 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4"; # define NDEBUG /* disable assert */ #endif -#ifdef HAVE_CONFIG_H -# include -#endif /* !HAVE_CONFIG_H */ +#include #ifndef _GNU_SOURCE # define _GNU_SOURCE 1 /* enables some compiler checks on GNU */ @@ -113,10 +111,6 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4"; # include # include # include -# ifndef HAVE_CONFIG_H -# define DOS_NT -# include -# endif #else # define MSDOS FALSE #endif /* MSDOS */ @@ -150,6 +144,7 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4"; #include #include #include +#include #include #ifdef NDEBUG @@ -167,14 +162,6 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4"; # include #endif /* NO_LONG_OPTIONS */ -#ifndef HAVE_CONFIG_H /* this is a standalone compilation */ -# ifdef __CYGWIN__ /* compiling on Cygwin */ - !!! NOTICE !!! - the regex.h distributed with Cygwin is not compatible with etags, alas! -If you want regular expression support, you should delete this notice and - arrange to use the GNU regex.h and regex.c. -# endif -#endif #include /* Define CTAGS to make the program "ctags" compatible with the usual one. @@ -188,9 +175,9 @@ If you want regular expression support, you should delete this notice and #endif #define streq(s,t) (assert ((s)!=NULL || (t)!=NULL), !strcmp (s, t)) -#define strcaseeq(s,t) (assert ((s)!=NULL && (t)!=NULL), !etags_strcasecmp (s, t)) +#define strcaseeq(s,t) (assert ((s)!=NULL && (t)!=NULL), !c_strcasecmp (s, t)) #define strneq(s,t,n) (assert ((s)!=NULL || (t)!=NULL), !strncmp (s, t, n)) -#define strncaseeq(s,t,n) (assert ((s)!=NULL && (t)!=NULL), !etags_strncasecmp (s, t, n)) +#define strncaseeq(s,t,n) (assert ((s)!=NULL && (t)!=NULL), !c_strncasecmp (s, t, n)) #define CHARS 256 /* 2^sizeof(char) */ #define CHAR(x) ((unsigned int)(x) & (CHARS - 1)) @@ -366,9 +353,9 @@ static void analyse_regex (char *); static void free_regexps (void); static void regex_tag_multiline (void); static void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2); -static void suggest_asking_for_help (void) NO_RETURN; -void fatal (const char *, const char *) NO_RETURN; -static void pfatal (const char *) NO_RETURN; +static _Noreturn void suggest_asking_for_help (void); +_Noreturn void fatal (const char *, const char *); +static _Noreturn void pfatal (const char *); static void add_node (node *, node **); static void init (void); @@ -389,8 +376,6 @@ static char *savenstr (const char *, int); static char *savestr (const char *); static char *etags_strchr (const char *, int); static char *etags_strrchr (const char *, int); -static int etags_strcasecmp (const char *, const char *); -static int etags_strncasecmp (const char *, const char *, int); static char *etags_getcwd (void); static char *relative_filename (char *, char *); static char *absolute_filename (char *, char *); @@ -2138,7 +2123,7 @@ invalidate_nodes (fdesc *badfdp, node **npp) static int total_size_of_entries (node *); -static int number_len (long); +static int number_len (long) ATTRIBUTE_CONST; /* Length of a non-negative number's decimal representation. */ static int @@ -2657,17 +2642,11 @@ write_classname (linebuffer *cn, const char *qualifier) } for (i = 1; i < cstack.nl; i++) { - char *s; - int slen; - - s = cstack.cname[i]; + char *s = cstack.cname[i]; if (s == NULL) continue; - slen = strlen (s); - len += slen + qlen; - linebuffer_setlen (cn, len); - strncat (cn->buffer, qualifier, qlen); - strncat (cn->buffer, s, slen); + linebuffer_setlen (cn, len + qlen + strlen (s)); + len += sprintf (cn->buffer + len, "%s%s", qualifier, s); } } @@ -2882,7 +2861,7 @@ consider_token (register char *str, register int len, register int c, int *c_ext fvdef = fvnone; objdef = omethodtag; linebuffer_setlen (&token_name, len); - strncpy (token_name.buffer, str, len); + memcpy (token_name.buffer, str, len); token_name.buffer[len] = '\0'; return TRUE; } @@ -2894,10 +2873,11 @@ consider_token (register char *str, register int len, register int c, int *c_ext case omethodparm: if (parlev == 0) { + int oldlen = token_name.len; fvdef = fvnone; objdef = omethodtag; - linebuffer_setlen (&token_name, token_name.len + len); - strncat (token_name.buffer, str, len); + linebuffer_setlen (&token_name, oldlen + len); + memcpy (token_name.buffer + oldlen, str, len); return TRUE; } return FALSE; @@ -3326,12 +3306,12 @@ C_entries (int c_ext, FILE *inf) && nestlev > 0 && definedef == dnone) /* in struct body */ { + int len; write_classname (&token_name, qualifier); - linebuffer_setlen (&token_name, - token_name.len+qlen+toklen); - strcat (token_name.buffer, qualifier); - strncat (token_name.buffer, - newlb.buffer + tokoff, toklen); + len = token_name.len; + linebuffer_setlen (&token_name, len+qlen+toklen); + sprintf (token_name.buffer + len, "%s%.*s", + qualifier, toklen, newlb.buffer + tokoff); token.named = TRUE; } else if (objdef == ocatseen) @@ -3339,11 +3319,8 @@ C_entries (int c_ext, FILE *inf) { int len = strlen (objtag) + 2 + toklen; linebuffer_setlen (&token_name, len); - strcpy (token_name.buffer, objtag); - strcat (token_name.buffer, "("); - strncat (token_name.buffer, - newlb.buffer + tokoff, toklen); - strcat (token_name.buffer, ")"); + sprintf (token_name.buffer, "%s(%.*s)", + objtag, toklen, newlb.buffer + tokoff); token.named = TRUE; } else if (objdef == omethodtag @@ -3367,8 +3344,8 @@ C_entries (int c_ext, FILE *inf) len -= 1; } linebuffer_setlen (&token_name, len); - strncpy (token_name.buffer, - newlb.buffer + off, len); + memcpy (token_name.buffer, + newlb.buffer + off, len); token_name.buffer[len] = '\0'; if (defun) while (--len >= 0) @@ -3379,8 +3356,8 @@ C_entries (int c_ext, FILE *inf) else { linebuffer_setlen (&token_name, toklen); - strncpy (token_name.buffer, - newlb.buffer + tokoff, toklen); + memcpy (token_name.buffer, + newlb.buffer + tokoff, toklen); token_name.buffer[toklen] = '\0'; /* Name macros and members. */ token.named = (structdef == stagseen @@ -5176,7 +5153,7 @@ HTML_labels (FILE *inf) for (end = dbp; *end != '\0' && intoken (*end); end++) continue; linebuffer_setlen (&token_name, end - dbp); - strncpy (token_name.buffer, dbp, end - dbp); + memcpy (token_name.buffer, dbp, end - dbp); token_name.buffer[end - dbp] = '\0'; dbp = end; @@ -5276,7 +5253,7 @@ Prolog_functions (FILE *inf) else if (len + 1 > allocated) xrnew (last, len + 1, char); allocated = len + 1; - strncpy (last, cp, len); + memcpy (last, cp, len); last[len] = '\0'; } } @@ -5449,7 +5426,7 @@ Erlang_functions (FILE *inf) else if (len + 1 > allocated) xrnew (last, len + 1, char); allocated = len + 1; - strncpy (last, cp, len); + memcpy (last, cp, len); last[len] = '\0'; } } @@ -5832,7 +5809,7 @@ substitute (char *in, char *out, struct re_registers *regs) { dig = *out - '0'; diglen = regs->end[dig] - regs->start[dig]; - strncpy (t, in + regs->start[dig], diglen); + memcpy (t, in + regs->start[dig], diglen); t += diglen; } else @@ -6055,7 +6032,7 @@ readline_internal (linebuffer *lbp, register FILE *stream) filebuf.size *= 2; xrnew (filebuf.buffer, filebuf.size, char); } - strncpy (filebuf.buffer + filebuf.len, lbp->buffer, lbp->len); + memcpy (filebuf.buffer + filebuf.len, lbp->buffer, lbp->len); filebuf.len += lbp->len; filebuf.buffer[filebuf.len++] = '\n'; filebuf.buffer[filebuf.len] = '\0'; @@ -6278,7 +6255,7 @@ savenstr (const char *cp, int len) register char *dp; dp = xnew (len + 1, char); - strncpy (dp, cp, len); + memcpy (dp, cp, len); dp[len] = '\0'; return dp; } @@ -6320,48 +6297,6 @@ etags_strchr (register const char *sp, register int c) return NULL; } -/* - * Compare two strings, ignoring case for alphabetic characters. - * - * Same as BSD's strcasecmp, included for portability. - */ -static int -etags_strcasecmp (register const char *s1, register const char *s2) -{ - while (*s1 != '\0' - && (ISALPHA (*s1) && ISALPHA (*s2) - ? lowcase (*s1) == lowcase (*s2) - : *s1 == *s2)) - s1++, s2++; - - return (ISALPHA (*s1) && ISALPHA (*s2) - ? lowcase (*s1) - lowcase (*s2) - : *s1 - *s2); -} - -/* - * Compare two strings, ignoring case for alphabetic characters. - * Stop after a given number of characters - * - * Same as BSD's strncasecmp, included for portability. - */ -static int -etags_strncasecmp (register const char *s1, register const char *s2, register int n) -{ - while (*s1 != '\0' && n-- > 0 - && (ISALPHA (*s1) && ISALPHA (*s2) - ? lowcase (*s1) == lowcase (*s2) - : *s1 == *s2)) - s1++, s2++; - - if (n < 0) - return 0; - else - return (ISALPHA (*s1) && ISALPHA (*s2) - ? lowcase (*s1) - lowcase (*s2) - : *s1 - *s2); -} - /* Skip spaces (end of string is not space), return new pointer. */ static char * skip_spaces (char *cp) diff --git a/lib-src/hexl.c b/lib-src/hexl.c index f8fb11f8218..08da0075269 100644 --- a/lib-src/hexl.c +++ b/lib-src/hexl.c @@ -20,9 +20,7 @@ You should have received a copy of the GNU General Public License along with this program. If not, see . */ -#ifdef HAVE_CONFIG_H #include -#endif #include #include @@ -48,7 +46,7 @@ int base = DEFAULT_BASE, un_flag = FALSE, iso_flag = FALSE, endian = 1; int group_by = DEFAULT_GROUPING; char *progname; -void usage (void) NO_RETURN; +_Noreturn void usage (void); int main (int argc, char **argv) diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c index 4f68fdb78c9..bd87b5b6524 100644 --- a/lib-src/make-docfile.c +++ b/lib-src/make-docfile.c @@ -76,7 +76,6 @@ along with GNU Emacs. If not, see . */ static int scan_file (char *filename); static int scan_lisp_file (const char *filename, const char *mode); static int scan_c_file (char *filename, const char *mode); -static void fatal (const char *s1, const char *s2) NO_RETURN; static void start_globals (void); static void write_globals (void); @@ -111,7 +110,7 @@ error (const char *s1, const char *s2) /* Print error message and exit. */ /* VARARGS1 */ -static void +static _Noreturn void fatal (const char *s1, const char *s2) { error (s1, s2); @@ -542,7 +541,7 @@ write_c_args (FILE *out, char *func, char *buf, int minargs, int maxargs) /* In C code, `default' is a reserved word, so we spell it `defalt'; demangle that here. */ - if (ident_length == 6 && strncmp (ident_start, "defalt", 6) == 0) + if (ident_length == 6 && memcmp (ident_start, "defalt", 6) == 0) fprintf (out, "DEFAULT"); else while (ident_length-- > 0) @@ -565,6 +564,7 @@ write_c_args (FILE *out, char *func, char *buf, int minargs, int maxargs) /* The types of globals. */ enum global_type { + FUNCTION, EMACS_INTEGER, BOOLEAN, LISP_OBJECT, @@ -576,6 +576,7 @@ struct global { enum global_type type; char *name; + int value; }; /* All the variable names we saw while scanning C sources in `-g' @@ -585,7 +586,7 @@ int num_globals_allocated; struct global *globals; static void -add_global (enum global_type type, char *name) +add_global (enum global_type type, char *name, int value) { /* Ignore the one non-symbol that can occur. */ if (strcmp (name, "...")) @@ -606,6 +607,7 @@ add_global (enum global_type type, char *name) globals[num_globals - 1].type = type; globals[num_globals - 1].name = name; + globals[num_globals - 1].value = value; } } @@ -614,13 +616,29 @@ compare_globals (const void *a, const void *b) { const struct global *ga = a; const struct global *gb = b; + + if (ga->type == FUNCTION) + { + if (gb->type != FUNCTION) + return 1; + } + else if (gb->type == FUNCTION) + return -1; + return strcmp (ga->name, gb->name); } +static void +close_emacs_globals (void) +{ + fprintf (outfile, "};\n"); + fprintf (outfile, "extern struct emacs_globals globals;\n"); +} + static void write_globals (void) { - int i; + int i, seen_defun = 0; qsort (globals, num_globals, sizeof (struct global), compare_globals); for (i = 0; i < num_globals; ++i) { @@ -637,20 +655,55 @@ write_globals (void) case LISP_OBJECT: type = "Lisp_Object"; break; + case FUNCTION: + if (!seen_defun) + { + close_emacs_globals (); + fprintf (outfile, "\n"); + seen_defun = 1; + } + break; default: fatal ("not a recognized DEFVAR_", 0); } - fprintf (outfile, " %s f_%s;\n", type, globals[i].name); - fprintf (outfile, "#define %s globals.f_%s\n", - globals[i].name, globals[i].name); + if (globals[i].type != FUNCTION) + { + fprintf (outfile, " %s f_%s;\n", type, globals[i].name); + fprintf (outfile, "#define %s globals.f_%s\n", + globals[i].name, globals[i].name); + } + else + { + /* It would be nice to have a cleaner way to deal with these + special hacks. */ + if (strcmp (globals[i].name, "Fthrow") == 0 + || strcmp (globals[i].name, "Ftop_level") == 0 + || strcmp (globals[i].name, "Fkill_emacs") == 0) + fprintf (outfile, "_Noreturn "); + fprintf (outfile, "EXFUN (%s, ", globals[i].name); + if (globals[i].value == -1) + fprintf (outfile, "MANY"); + else if (globals[i].value == -2) + fprintf (outfile, "UNEVALLED"); + else + fprintf (outfile, "%d", globals[i].value); + fprintf (outfile, ");\n"); + } + while (i + 1 < num_globals && !strcmp (globals[i].name, globals[i + 1].name)) - ++i; + { + if (globals[i].type == FUNCTION + && globals[i].value != globals[i + 1].value) + error ("function '%s' defined twice with differing signatures", + globals[i].name); + ++i; + } } - fprintf (outfile, "};\n"); - fprintf (outfile, "extern struct emacs_globals globals;\n"); + if (!seen_defun) + close_emacs_globals (); } @@ -700,6 +753,7 @@ scan_c_file (char *filename, const char *mode) int defvarperbufferflag = 0; int defvarflag = 0; enum global_type type = INVALID; + char *name IF_LINT (= 0); if (c != '\n' && c != '\r') { @@ -765,8 +819,9 @@ scan_c_file (char *filename, const char *mode) } else continue; - if (generate_globals && (!defvarflag || defvarperbufferflag - || type == INVALID)) + if (generate_globals + && (!defvarflag || defvarperbufferflag || type == INVALID) + && !defunflag) continue; while (c != '(') @@ -785,7 +840,6 @@ scan_c_file (char *filename, const char *mode) if (generate_globals) { int i = 0; - char *name; /* Skip "," and whitespace. */ do @@ -806,8 +860,12 @@ scan_c_file (char *filename, const char *mode) name = xmalloc (i + 1); memcpy (name, input_buffer, i + 1); - add_global (type, name); - continue; + + if (!defunflag) + { + add_global (type, name, 0); + continue; + } } /* DEFVAR_LISP ("name", addr, "doc") @@ -815,7 +873,7 @@ scan_c_file (char *filename, const char *mode) DEFVAR_LISP ("name", addr, doc: /\* doc *\/) */ if (defunflag) - commas = 5; + commas = generate_globals ? 4 : 5; else if (defvarperbufferflag) commas = 3; else if (defvarflag) @@ -842,7 +900,12 @@ scan_c_file (char *filename, const char *mode) scanned = fscanf (infile, "%d", &minargs); else /* Pick up maxargs. */ if (c == 'M' || c == 'U') /* MANY || UNEVALLED */ - maxargs = -1; + { + if (generate_globals) + maxargs = (c == 'M') ? -1 : -2; + else + maxargs = -1; + } else scanned = fscanf (infile, "%d", &maxargs); if (scanned < 0) @@ -855,6 +918,12 @@ scan_c_file (char *filename, const char *mode) c = getc (infile); } + if (generate_globals) + { + add_global (FUNCTION, name, maxargs); + continue; + } + while (c == ' ' || c == '\n' || c == '\r' || c == '\t') c = getc (infile); diff --git a/lib-src/makefile.w32-in b/lib-src/makefile.w32-in index fea1d29592e..4b2b523ea34 100644 --- a/lib-src/makefile.w32-in +++ b/lib-src/makefile.w32-in @@ -19,12 +19,12 @@ ALL = $(BLD)/test-distrib.exe $(BLD)/make-docfile.exe $(BLD)/hexl.exe\ $(BLD)/ctags.exe $(BLD)/etags.exe $(BLD)/movemail.exe $(BLD)/ebrowse.exe\ - $(BLD)/emacsclient.exe $(BLD)/emacsclientw.exe + $(BLD)/emacsclient.exe $(BLD)/emacsclientw.exe $(BLD)/profile.exe .PHONY: make-docfile LOCAL_FLAGS = -DWINDOWSNT -DDOS_NT -DNO_LDAV=1 \ - -DNO_ARCHIVES=1 -DHAVE_CONFIG_H=1 -I../lib \ + -DNO_ARCHIVES=1 -I../lib \ -I../nt/inc -I../src $(EMACS_EXTRA_C_FLAGS) LIBS = $(BASE_LIBS) $(ADVAPI32) @@ -38,7 +38,7 @@ $(BLD)/hexl.exe: $(BLD)/hexl.$(O) $(LINK) $(LINK_OUT)$@ $(LINK_FLAGS) $(BLD)/hexl.$(O) $(LIBS) $(BLD)/test-distrib.exe: $(BLD)/test-distrib.$(O) $(LINK) $(LINK_OUT)$@ $(LINK_FLAGS) $(BLD)/test-distrib.$(O) $(LIBS) - "$(BLD)/test-distrib.exe" "$(SRC)/testfile" + "$(BLD)/test-distrib.exe" "$(LIB_SRC)/testfile" MOVEMAILOBJS = $(BLD)/movemail.$(O) \ $(BLD)/pop.$(O) \ @@ -106,10 +106,16 @@ ctags.c: etags.c - $(DEL) ctags.c $(CP) etags.c ctags.c -CTAGS_CFLAGS = -DCTAGS $(ETAGS_CFLAGS) -DEMACS_NAME="\"GNU Emacs\"" +CTAGS_CFLAGS = -DCTAGS $(ETAGS_CFLAGS) $(BLD)/ctags.$(O): ctags.c $(CC) $(CFLAGS) $(CTAGS_CFLAGS) $(CC_OUT)$@ ctags.c +PROFILEOBJS = $(BLD)/profile.$(O) \ + ../lib/$(BLD)/libgnu.$(A) \ + $(BLD)/ntlib.$(O) +$(BLD)/profile.exe: $(PROFILEOBJS) + $(LINK) $(LINK_OUT)$@ $(LINK_FLAGS) $(PROFILEOBJS) $(LIBS) + # # From ..\src\Makefile.in # It doesn't matter if the real name is *.obj for the files in this list, @@ -236,7 +242,6 @@ lisp2 = \ $(lispsource)language/georgian.el \ $(lispsource)language/khmer.el \ $(lispsource)language/burmese.el \ - $(lispsource)paths.el \ $(lispsource)register.elc \ $(lispsource)replace.elc \ $(lispsource)simple.elc \ @@ -307,6 +312,7 @@ install: $(INSTALL_FILES) $(CP) $(BLD)/movemail.exe $(INSTALL_DIR)/bin $(CP) $(BLD)/emacsclient.exe $(INSTALL_DIR)/bin $(CP) $(BLD)/emacsclientw.exe $(INSTALL_DIR)/bin + $(CP) $(BLD)/profile.exe $(INSTALL_DIR)/bin - mkdir "$(INSTALL_DIR)/etc" $(CP) $(DOC) $(INSTALL_DIR)/etc @@ -349,85 +355,108 @@ TAGS: $(BLD)/etags.exe *.c *.h ### DEPENDENCIES ### EMACS_ROOT = .. -SRC = . +LIB_SRC = . +SRC = $(EMACS_ROOT)/src +NT_INC = $(EMACS_ROOT)/nt/inc +GNU_LIB = $(EMACS_ROOT)/lib -$(BLD)/alloca.$(O) : \ - $(SRC)/alloca.c \ - $(EMACS_ROOT)/src/s/ms-w32.h \ - $(EMACS_ROOT)/src/config.h \ - $(EMACS_ROOT)/src/blockinput.h +MS_W32_H = $(SRC)/s/ms-w32.h \ + $(NT_INC)/sys/stat.h +CONFIG_H = $(SRC)/config.h \ + $(MS_W32_H) +INTTYPES_H = $(NT_INC)/inttypes.h \ + $(NT_INC)/stdint.h +NTLIB_H = $(LIB_SRC)/ntlib.h \ + $(NT_INC)/pwd.h +SYSTIME_H = $(SRC)/systime.h \ + $(NT_INC)/sys/time.h \ + $(GNU_LIB)/timespec.h $(BLD)/ctags.$(O) : \ - $(SRC)/ctags.c \ - $(EMACS_ROOT)/nt/inc/sys/param.h \ - $(EMACS_ROOT)/nt/inc/sys/stat.h \ - $(EMACS_ROOT)/src/s/ms-w32.h \ - $(EMACS_ROOT)/lib-src/../src/config.h \ - $(SRC)/ntlib.h \ - $(EMACS_ROOT)/lib/getopt.h + $(LIB_SRC)/ctags.c \ + $(SRC)/regex.h \ + $(NT_INC)/sys/stat.h \ + $(NT_INC)/unistd.h \ + $(GNU_LIB)/c-strcase.h \ + $(GNU_LIB)/getopt.h \ + $(CONFIG_H) $(BLD)/ebrowse.$(O) : \ - $(SRC)/ebrowse.c \ - $(EMACS_ROOT)/lib/min-max.h \ - $(EMACS_ROOT)/src/s/ms-w32.h \ - $(EMACS_ROOT)/lib-src/../src/config.h + $(LIB_SRC)/ebrowse.c \ + $(GNU_LIB)/getopt.h \ + $(GNU_LIB)/min-max.h \ + $(CONFIG_H) $(BLD)/emacsclient.$(O) : \ - $(SRC)/emacsclient.c \ - $(EMACS_ROOT)/nt/inc/sys/stat.h \ - $(EMACS_ROOT)/src/s/ms-w32.h \ - $(EMACS_ROOT)/lib-src/../src/config.h + $(LIB_SRC)/emacsclient.c \ + $(NT_INC)/pwd.h \ + $(NT_INC)/sys/stat.h \ + $(NT_INC)/unistd.h \ + $(GNU_LIB)/getopt.h \ + $(CONFIG_H) $(BLD)/etags.$(O) : \ - $(SRC)/etags.c \ - $(EMACS_ROOT)/nt/inc/sys/param.h \ - $(EMACS_ROOT)/nt/inc/sys/stat.h \ - $(EMACS_ROOT)/src/s/ms-w32.h \ - $(EMACS_ROOT)/lib-src/../src/config.h \ - $(SRC)/ntlib.h \ - $(EMACS_ROOT)/lib/getopt.h + $(LIB_SRC)/etags.c \ + $(SRC)/regex.h \ + $(NT_INC)/sys/stat.h \ + $(NT_INC)/unistd.h \ + $(GNU_LIB)/c-strcase.h \ + $(GNU_LIB)/getopt.h \ + $(CONFIG_H) $(BLD)/hexl.$(O) : \ - $(SRC)/hexl.c + $(LIB_SRC)/hexl.c \ + $(CONFIG_H) $(BLD)/make-docfile.$(O) : \ - $(SRC)/make-docfile.c \ - $(EMACS_ROOT)/src/config.h + $(LIB_SRC)/make-docfile.c \ + $(NT_INC)/unistd.h \ + $(CONFIG_H) $(BLD)/movemail.$(O) : \ - $(SRC)/movemail.c \ - $(EMACS_ROOT)/src/s/ms-w32.h \ - $(EMACS_ROOT)/lib-src/../src/config.h \ - $(EMACS_ROOT)/nt/inc/sys/file.h \ - $(EMACS_ROOT)/nt/inc/sys/stat.h \ - $(EMACS_ROOT)/lib-src/../src/syswait.h \ - $(EMACS_ROOT)/nt/inc/pwd.h \ - $(SRC)/ntlib.h - $(CC) $(CFLAGS) -DUSG $(CC_OUT)$@ movemail.c + $(LIB_SRC)/movemail.c \ + $(LIB_SRC)/pop.h \ + $(SRC)/syswait.h \ + $(NT_INC)/pwd.h \ + $(NT_INC)/sys/file.h \ + $(NT_INC)/sys/stat.h \ + $(NT_INC)/unistd.h \ + $(GNU_LIB)/getopt.h \ + $(CONFIG_H) \ + $(NTLIB_H) $(BLD)/ntlib.$(O) : \ - $(SRC)/ntlib.c \ - $(SRC)/ntlib.h \ - $(EMACS_ROOT)/nt/inc/sys/stat.h \ - $(EMACS_ROOT)/nt/inc/pwd.h + $(LIB_SRC)/ntlib.c \ + $(NT_INC)/sys/stat.h \ + $(NTLIB_H) $(BLD)/pop.$(O) : \ - $(SRC)/pop.c \ - $(SRC)/pop.h \ - $(EMACS_ROOT)/lib/min-max.h \ - $(SRC)/ntlib.h + $(LIB_SRC)/pop.c \ + $(LIB_SRC)/pop.h \ + $(NT_INC)/netdb.h \ + $(NT_INC)/pwd.h \ + $(NT_INC)/unistd.h \ + $(GNU_LIB)/min-max.h \ + $(CONFIG_H) \ + $(NTLIB_H) $(BLD)/profile.$(O) : \ - $(SRC)/profile.c \ - $(EMACS_ROOT)/src/s/ms-w32.h \ - $(EMACS_ROOT)/lib-src/../src/config.h \ - $(EMACS_ROOT)/lib-src/../src/systime.h + $(LIB_SRC)/profile.c \ + $(GNU_LIB)/intprops.h \ + $(CONFIG_H) \ + $(INTTYPES_H) \ + $(SYSTIME_H) -$(BLD)/tcp.$(O) : \ - $(SRC)/tcp.c +$(BLD)/regex.$(O) : \ + $(SRC)/regex.c \ + $(SRC)/regex.h \ + $(NT_INC)/unistd.h \ + $(CONFIG_H) $(BLD)/test-distrib.$(O) : \ - $(SRC)/test-distrib.c + $(LIB_SRC)/test-distrib.c \ + $(NT_INC)/unistd.h \ + $(CONFIG_H) # The following dependencies are for supporting parallel builds, where # we must make sure $(BLD) exists before any compilation starts. diff --git a/lib-src/movemail.c b/lib-src/movemail.c index 9d19df32814..d157aa8c0b9 100644 --- a/lib-src/movemail.c +++ b/lib-src/movemail.c @@ -133,16 +133,10 @@ static char *mail_spool_name (char *); #endif #endif -#ifndef HAVE_STRERROR -char *strerror (int); -#endif - -static void fatal (const char *s1, const char *s2, const char *s3) NO_RETURN; +static _Noreturn void fatal (const char *s1, const char *s2, const char *s3); static void error (const char *s1, const char *s2, const char *s3); -static void pfatal_with_name (char *name) NO_RETURN; -static void pfatal_and_delete (char *name) NO_RETURN; -static char *concat (const char *s1, const char *s2, const char *s3); -static long *xmalloc (unsigned int size); +static _Noreturn void pfatal_with_name (char *name); +static _Noreturn void pfatal_and_delete (char *name); #ifdef MAIL_USE_POP static int popmail (char *mailbox, char *outfile, int preserve, char *password, int reverse_order); static int pop_retr (popserver server, int msgno, FILE *arg); @@ -151,6 +145,21 @@ static int mbx_delimit_begin (FILE *mbf); static int mbx_delimit_end (FILE *mbf); #endif +#if (defined MAIL_USE_MAILLOCK \ + || (!defined DISABLE_DIRECT_ACCESS && !defined MAIL_USE_MMDF \ + && !defined MAIL_USE_SYSTEM_LOCK)) +/* Like malloc but get fatal error if memory is exhausted. */ + +static void * +xmalloc (size_t size) +{ + void *result = malloc (size); + if (!result) + fatal ("virtual memory exhausted", 0, 0); + return result; +} +#endif + /* Nonzero means this is name of a lock file to delete on fatal error. */ static char *delete_lockname; @@ -168,7 +177,7 @@ main (int argc, char **argv) int tem; char *lockname; char *tempname; - size_t inname_dirlen; + size_t inname_len, inname_dirlen; int desc; #endif /* not MAIL_USE_SYSTEM_LOCK */ @@ -296,12 +305,15 @@ main (int argc, char **argv) should define MAIL_USE_SYSTEM_LOCK but does not, send a bug report to bug-gnu-emacs@prep.ai.mit.edu so we can fix it. */ - lockname = concat (inname, ".lock", ""); - for (inname_dirlen = strlen (inname); + inname_len = strlen (inname); + lockname = xmalloc (inname_len + sizeof ".lock"); + strcpy (lockname, inname); + strcpy (lockname + inname_len, ".lock"); + for (inname_dirlen = inname_len; inname_dirlen && !IS_DIRECTORY_SEP (inname[inname_dirlen - 1]); inname_dirlen--) continue; - tempname = (char *) xmalloc (inname_dirlen + sizeof "EXXXXXX"); + tempname = xmalloc (inname_dirlen + sizeof "EXXXXXX"); while (1) { @@ -583,8 +595,8 @@ mail_spool_name (char *inname) if (stat (MAILDIR, &stat1) < 0) return NULL; - indir = (char *) xmalloc (fname - inname + 1); - strncpy (indir, inname, fname - inname); + indir = xmalloc (fname - inname + 1); + memcpy (indir, inname, fname - inname); indir[fname-inname] = '\0'; @@ -643,33 +655,6 @@ pfatal_and_delete (char *name) unlink (name); fatal ("%s for %s", s, name); } - -/* Return a newly-allocated string whose contents concatenate those of s1, s2, s3. */ - -static char * -concat (const char *s1, const char *s2, const char *s3) -{ - size_t len1 = strlen (s1), len2 = strlen (s2), len3 = strlen (s3); - char *result = (char *) xmalloc (len1 + len2 + len3 + 1); - - strcpy (result, s1); - strcpy (result + len1, s2); - strcpy (result + len1 + len2, s3); - *(result + len1 + len2 + len3) = 0; - - return result; -} - -/* Like malloc but get fatal error if memory is exhausted. */ - -static long * -xmalloc (unsigned int size) -{ - long *result = (long *) malloc (size); - if (!result) - fatal ("virtual memory exhausted", 0, 0); - return result; -} /* This is the guts of the interface to the Post Office Protocol. */ @@ -851,10 +836,7 @@ pop_retr (popserver server, int msgno, FILE *arg) if (pop_retrieve_first (server, msgno, &line)) { - char *msg = concat ("Error from POP server: ", pop_error, ""); - strncpy (Errmsg, msg, sizeof (Errmsg)); - Errmsg[sizeof (Errmsg)-1] = '\0'; - free (msg); + snprintf (Errmsg, sizeof Errmsg, "Error from POP server: %s", pop_error); return (NOTOK); } @@ -873,10 +855,7 @@ pop_retr (popserver server, int msgno, FILE *arg) if (ret) { - char *msg = concat ("Error from POP server: ", pop_error, ""); - strncpy (Errmsg, msg, sizeof (Errmsg)); - Errmsg[sizeof (Errmsg)-1] = '\0'; - free (msg); + snprintf (Errmsg, sizeof Errmsg, "Error from POP server: %s", pop_error); return (NOTOK); } @@ -939,21 +918,3 @@ mbx_delimit_end (FILE *mbf) } #endif /* MAIL_USE_POP */ - -#ifndef HAVE_STRERROR -char * -strerror (errnum) - int errnum; -{ - extern char *sys_errlist[]; - extern int sys_nerr; - - if (errnum >= 0 && errnum < sys_nerr) - return sys_errlist[errnum]; - return (char *) "Unknown error"; -} - -#endif /* ! HAVE_STRERROR */ - - -/* movemail.c ends here */ diff --git a/lib-src/pop.c b/lib-src/pop.c index c4c7f2b4e2f..74054e0e1b1 100644 --- a/lib-src/pop.c +++ b/lib-src/pop.c @@ -21,11 +21,7 @@ You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ -#ifdef HAVE_CONFIG_H #include -#else -#define MAIL_USE_POP -#endif #ifdef MAIL_USE_POP @@ -101,7 +97,7 @@ extern char *krb_realmofhost (/* char * */); #endif /* KERBEROS */ #ifndef WINDOWSNT -#if !defined (HAVE_H_ERRNO) || !defined (HAVE_CONFIG_H) +#ifndef HAVE_H_ERRNO extern int h_errno; #endif #endif @@ -344,10 +340,7 @@ pop_stat (popserver server, int *count, int *size) if (strncmp (fromserver, "+OK ", 4)) { if (0 == strncmp (fromserver, "-ERR", 4)) - { - strncpy (pop_error, fromserver, ERROR_MAX); - pop_error[ERROR_MAX-1] = '\0'; - } + snprintf (pop_error, ERROR_MAX, "%s", fromserver); else { strcpy (pop_error, @@ -448,10 +441,7 @@ pop_list (popserver server, int message, int **IDs, int **sizes) if (strncmp (fromserver, "+OK ", 4)) { if (! strncmp (fromserver, "-ERR", 4)) - { - strncpy (pop_error, fromserver, ERROR_MAX); - pop_error[ERROR_MAX-1] = '\0'; - } + snprintf (pop_error, ERROR_MAX, "%s", fromserver); else { strcpy (pop_error, @@ -690,8 +680,7 @@ pop_multi_first (popserver server, const char *command, char **response) if (0 == strncmp (*response, "-ERR", 4)) { - strncpy (pop_error, *response, ERROR_MAX); - pop_error[ERROR_MAX-1] = '\0'; + snprintf (pop_error, ERROR_MAX, "%s", *response); return (-1); } else if (0 == strncmp (*response, "+OK", 3)) @@ -864,8 +853,7 @@ pop_last (popserver server) if (! strncmp (fromserver, "-ERR", 4)) { - strncpy (pop_error, fromserver, ERROR_MAX); - pop_error[ERROR_MAX-1] = '\0'; + snprintf (pop_error, ERROR_MAX, "%s", fromserver); return (-1); } else if (strncmp (fromserver, "+OK ", 4)) @@ -1065,9 +1053,8 @@ socket_connection (char *host, int flags) sock = socket (PF_INET, SOCK_STREAM, 0); if (sock < 0) { - strcpy (pop_error, POP_SOCKET_ERROR); - strncat (pop_error, strerror (errno), - ERROR_MAX - sizeof (POP_SOCKET_ERROR)); + snprintf (pop_error, ERROR_MAX, "%s%s", + POP_SOCKET_ERROR, strerror (errno)); return (-1); } @@ -1143,9 +1130,7 @@ socket_connection (char *host, int flags) if (! connect_ok) { CLOSESOCKET (sock); - strcpy (pop_error, CONNECT_ERROR); - strncat (pop_error, strerror (errno), - ERROR_MAX - sizeof (CONNECT_ERROR)); + snprintf (pop_error, ERROR_MAX, "%s%s", CONNECT_ERROR, strerror (errno)); return (-1); } @@ -1163,9 +1148,8 @@ socket_connection (char *host, int flags) krb5_auth_con_free (kcontext, auth_context); if (kcontext) krb5_free_context (kcontext); - strcpy (pop_error, KRB_ERROR); - strncat (pop_error, error_message (rem), - ERROR_MAX - sizeof (KRB_ERROR)); + snprintf (pop_error, ERROR_MAX, "%s%s", + KRB_ERROR, error_message (rem)); CLOSESOCKET (sock); return (-1); } @@ -1203,30 +1187,19 @@ socket_connection (char *host, int flags) krb5_free_principal (kcontext, server); if (rem) { - strcpy (pop_error, KRB_ERROR); - strncat (pop_error, error_message (rem), - ERROR_MAX - sizeof (KRB_ERROR)); + int pop_error_len = snprintf (pop_error, ERROR_MAX, "%s%s", + KRB_ERROR, error_message (rem)); #if defined HAVE_KRB5_ERROR_TEXT if (err_ret && err_ret->text.length) { - strncat (pop_error, " [server says '", - ERROR_MAX - strlen (pop_error) - 1); - strncat (pop_error, err_ret->text.data, - min (ERROR_MAX - strlen (pop_error) - 1, - err_ret->text.length)); - strncat (pop_error, "']", - ERROR_MAX - strlen (pop_error) - 1); + int errlen = err_ret->text.length; + snprintf (pop_error + pop_error_len, ERROR_MAX - pop_error_len, + " [server says '.*%s']", errlen, err_ret->text.data); } #elif defined HAVE_KRB5_ERROR_E_TEXT - if (err_ret && err_ret->e_text && strlen (*err_ret->e_text)) - { - strncat (pop_error, " [server says '", - ERROR_MAX - strlen (pop_error) - 1); - strncat (pop_error, *err_ret->e_text, - ERROR_MAX - strlen (pop_error) - 1); - strncat (pop_error, "']", - ERROR_MAX - strlen (pop_error) - 1); - } + if (err_ret && err_ret->e_text && **err_ret->e_text) + snprintf (pop_error + pop_error_len, ERRMAX - pop_error_len, + " [server says '%s']", *err_ret->e_text); #endif if (err_ret) krb5_free_error (kcontext, err_ret); @@ -1247,9 +1220,7 @@ socket_connection (char *host, int flags) free ((char *) ticket); if (rem != KSUCCESS) { - strcpy (pop_error, KRB_ERROR); - strncat (pop_error, krb_err_txt[rem], - ERROR_MAX - sizeof (KRB_ERROR)); + snprintf (pop_error, ERROR_MAX, "%s%s", KRB_ERROR, krb_err_txt[rem]); CLOSESOCKET (sock); return (-1); } @@ -1354,9 +1325,8 @@ pop_getline (popserver server, char **line) server->buffer_size - server->data - 1, 0); if (ret < 0) { - strcpy (pop_error, GETLINE_ERROR); - strncat (pop_error, strerror (errno), - ERROR_MAX - sizeof (GETLINE_ERROR)); + snprintf (pop_error, ERROR_MAX, "%s%s", + GETLINE_ERROR, strerror (errno)); pop_trash (server); return (-1); } @@ -1440,9 +1410,7 @@ sendline (popserver server, const char *line) if (ret < 0) { pop_trash (server); - strcpy (pop_error, SENDLINE_ERROR); - strncat (pop_error, strerror (errno), - ERROR_MAX - sizeof (SENDLINE_ERROR)); + snprintf (pop_error, ERROR_MAX, "%s%s", SENDLINE_ERROR, strerror (errno)); return (ret); } @@ -1504,8 +1472,7 @@ getok (popserver server) return (0); else if (! strncmp (fromline, "-ERR", 4)) { - strncpy (pop_error, fromline, ERROR_MAX); - pop_error[ERROR_MAX-1] = '\0'; + snprintf (pop_error, ERROR_MAX, "%s", fromline); return (-1); } else diff --git a/lib-src/profile.c b/lib-src/profile.c index 8ed4f318974..d21f2c28e58 100644 --- a/lib-src/profile.c +++ b/lib-src/profile.c @@ -20,7 +20,7 @@ along with GNU Emacs. If not, see . */ /** - ** To be run as an emacs process. Input string that starts with: + ** To be run as an emacs subprocess. Input string that starts with: ** 'z' -- resets the watch (to zero). ** 'p' -- return time (on stdout) as string with format . ** 'q' -- exit. @@ -29,53 +29,42 @@ along with GNU Emacs. If not, see . */ ** operations: reset_watch, get_time */ #include + +#include #include + +#include #include -static EMACS_TIME TV1, TV2; +static EMACS_TIME TV1; static int watch_not_started = 1; /* flag */ -static char time_string[30]; +static char time_string[INT_STRLEN_BOUND (uintmax_t) + sizeof "." + + LOG10_EMACS_TIME_RESOLUTION]; /* Reset the stopwatch to zero. */ static void reset_watch (void) { - EMACS_GET_TIME (TV1); + TV1 = current_emacs_time (); watch_not_started = 0; } /* This call returns the time since the last reset_watch call. The time - is returned as a string with the format . + is returned as a string with the format . If reset_watch was not called yet, exit. */ static char * get_time (void) { + EMACS_TIME TV2 = sub_emacs_time (current_emacs_time (), TV1); + uintmax_t s = EMACS_SECS (TV2); + int ns = EMACS_NSECS (TV2); if (watch_not_started) exit (EXIT_FAILURE); /* call reset_watch first ! */ - EMACS_GET_TIME (TV2); - EMACS_SUB_TIME (TV2, TV2, TV1); - sprintf (time_string, "%lu.%06lu", (unsigned long)EMACS_SECS (TV2), (unsigned long)EMACS_USECS (TV2)); + sprintf (time_string, "%"PRIuMAX".%0*d", s, LOG10_EMACS_TIME_RESOLUTION, ns); return time_string; } - -#if ! defined (HAVE_GETTIMEOFDAY) && defined (HAVE_TIMEVAL) - -/* ARGSUSED */ -gettimeofday (tp, tzp) - struct timeval *tp; - struct timezone *tzp; -{ - extern long time (); - - tp->tv_sec = time ((long *)0); - tp->tv_usec = 0; - if (tzp != 0) - tzp->tz_minuteswest = -1; -} - -#endif int main (void) diff --git a/lib-src/update-game-score.c b/lib-src/update-game-score.c index e0c940510be..40397536fad 100644 --- a/lib-src/update-game-score.c +++ b/lib-src/update-game-score.c @@ -48,8 +48,6 @@ along with GNU Emacs. If not, see . */ #include #include -static int usage (int err) NO_RETURN; - #define MAX_ATTEMPTS 5 #define MAX_SCORES 200 #define MAX_DATA_LEN 1024 @@ -59,7 +57,7 @@ static int usage (int err) NO_RETURN; #define difftime(t1, t0) (double)((t1) - (t0)) #endif -static int +static _Noreturn void usage (int err) { fprintf (stdout, "Usage: update-game-score [-m MAX] [-r] [-d DIR] game/scorefile SCORE DATA\n"); @@ -89,34 +87,14 @@ static void sort_scores (struct score_entry *scores, int count, int reverse); static int write_scores (const char *filename, const struct score_entry *scores, int count); -static void lose (const char *msg) NO_RETURN; - -static void +static _Noreturn void lose (const char *msg) { fprintf (stderr, "%s\n", msg); exit (EXIT_FAILURE); } -static void lose_syserr (const char *msg) NO_RETURN; - -/* Taken from sysdep.c. */ -#ifndef HAVE_STRERROR -#ifndef WINDOWSNT -char * -strerror (int errnum) -{ - extern char *sys_errlist[]; - extern int sys_nerr; - - if (errnum >= 0 && errnum < sys_nerr) - return sys_errlist[errnum]; - return (char *) "Unknown error"; -} -#endif /* not WINDOWSNT */ -#endif /* ! HAVE_STRERROR */ - -static void +static _Noreturn void lose_syserr (const char *msg) { fprintf (stderr, "%s: %s\n", msg, strerror (errno)); diff --git a/lib/alloca.in.h b/lib/alloca.in.h index e94eb68c3c8..d20f4b8f1c3 100644 --- a/lib/alloca.in.h +++ b/lib/alloca.in.h @@ -44,6 +44,13 @@ # define alloca _alloca # elif defined __DECC && defined __VMS # define alloca __ALLOCA +# elif defined __TANDEM && defined _TNS_E_TARGET +# ifdef __cplusplus +extern "C" +# endif +void *_alloca (unsigned short); +# pragma intrinsic (_alloca) +# define alloca _alloca # else # include # ifdef __cplusplus diff --git a/lib/c-ctype.c b/lib/c-ctype.c new file mode 100644 index 00000000000..952d7a851f3 --- /dev/null +++ b/lib/c-ctype.c @@ -0,0 +1,395 @@ +/* Character handling in C locale. + + Copyright 2000-2003, 2006, 2009-2012 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 . */ + +#include + +/* Specification. */ +#define NO_C_CTYPE_MACROS +#include "c-ctype.h" + +/* The function isascii is not locale dependent. Its use in EBCDIC is + questionable. */ +bool +c_isascii (int c) +{ + return (c >= 0x00 && c <= 0x7f); +} + +bool +c_isalnum (int c) +{ +#if C_CTYPE_CONSECUTIVE_DIGITS \ + && C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE +#if C_CTYPE_ASCII + return ((c >= '0' && c <= '9') + || ((c & ~0x20) >= 'A' && (c & ~0x20) <= 'Z')); +#else + return ((c >= '0' && c <= '9') + || (c >= 'A' && c <= 'Z') + || (c >= 'a' && c <= 'z')); +#endif +#else + switch (c) + { + case '0': case '1': case '2': case '3': case '4': case '5': + case '6': case '7': case '8': case '9': + case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': + case 'G': case 'H': case 'I': case 'J': case 'K': case 'L': + case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R': + case 'S': case 'T': case 'U': case 'V': case 'W': case 'X': + case 'Y': case 'Z': + case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': + case 'g': case 'h': case 'i': case 'j': case 'k': case 'l': + case 'm': case 'n': case 'o': case 'p': case 'q': case 'r': + case 's': case 't': case 'u': case 'v': case 'w': case 'x': + case 'y': case 'z': + return 1; + default: + return 0; + } +#endif +} + +bool +c_isalpha (int c) +{ +#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE +#if C_CTYPE_ASCII + return ((c & ~0x20) >= 'A' && (c & ~0x20) <= 'Z'); +#else + return ((c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z')); +#endif +#else + switch (c) + { + case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': + case 'G': case 'H': case 'I': case 'J': case 'K': case 'L': + case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R': + case 'S': case 'T': case 'U': case 'V': case 'W': case 'X': + case 'Y': case 'Z': + case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': + case 'g': case 'h': case 'i': case 'j': case 'k': case 'l': + case 'm': case 'n': case 'o': case 'p': case 'q': case 'r': + case 's': case 't': case 'u': case 'v': case 'w': case 'x': + case 'y': case 'z': + return 1; + default: + return 0; + } +#endif +} + +bool +c_isblank (int c) +{ + return (c == ' ' || c == '\t'); +} + +bool +c_iscntrl (int c) +{ +#if C_CTYPE_ASCII + return ((c & ~0x1f) == 0 || c == 0x7f); +#else + switch (c) + { + case ' ': case '!': case '"': case '#': case '$': case '%': + case '&': case '\'': case '(': case ')': case '*': case '+': + case ',': case '-': case '.': case '/': + case '0': case '1': case '2': case '3': case '4': case '5': + case '6': case '7': case '8': case '9': + case ':': case ';': case '<': case '=': case '>': case '?': + case '@': + case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': + case 'G': case 'H': case 'I': case 'J': case 'K': case 'L': + case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R': + case 'S': case 'T': case 'U': case 'V': case 'W': case 'X': + case 'Y': case 'Z': + case '[': case '\\': case ']': case '^': case '_': case '`': + case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': + case 'g': case 'h': case 'i': case 'j': case 'k': case 'l': + case 'm': case 'n': case 'o': case 'p': case 'q': case 'r': + case 's': case 't': case 'u': case 'v': case 'w': case 'x': + case 'y': case 'z': + case '{': case '|': case '}': case '~': + return 0; + default: + return 1; + } +#endif +} + +bool +c_isdigit (int c) +{ +#if C_CTYPE_CONSECUTIVE_DIGITS + return (c >= '0' && c <= '9'); +#else + switch (c) + { + case '0': case '1': case '2': case '3': case '4': case '5': + case '6': case '7': case '8': case '9': + return 1; + default: + return 0; + } +#endif +} + +bool +c_islower (int c) +{ +#if C_CTYPE_CONSECUTIVE_LOWERCASE + return (c >= 'a' && c <= 'z'); +#else + switch (c) + { + case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': + case 'g': case 'h': case 'i': case 'j': case 'k': case 'l': + case 'm': case 'n': case 'o': case 'p': case 'q': case 'r': + case 's': case 't': case 'u': case 'v': case 'w': case 'x': + case 'y': case 'z': + return 1; + default: + return 0; + } +#endif +} + +bool +c_isgraph (int c) +{ +#if C_CTYPE_ASCII + return (c >= '!' && c <= '~'); +#else + switch (c) + { + case '!': case '"': case '#': case '$': case '%': case '&': + case '\'': case '(': case ')': case '*': case '+': case ',': + case '-': case '.': case '/': + case '0': case '1': case '2': case '3': case '4': case '5': + case '6': case '7': case '8': case '9': + case ':': case ';': case '<': case '=': case '>': case '?': + case '@': + case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': + case 'G': case 'H': case 'I': case 'J': case 'K': case 'L': + case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R': + case 'S': case 'T': case 'U': case 'V': case 'W': case 'X': + case 'Y': case 'Z': + case '[': case '\\': case ']': case '^': case '_': case '`': + case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': + case 'g': case 'h': case 'i': case 'j': case 'k': case 'l': + case 'm': case 'n': case 'o': case 'p': case 'q': case 'r': + case 's': case 't': case 'u': case 'v': case 'w': case 'x': + case 'y': case 'z': + case '{': case '|': case '}': case '~': + return 1; + default: + return 0; + } +#endif +} + +bool +c_isprint (int c) +{ +#if C_CTYPE_ASCII + return (c >= ' ' && c <= '~'); +#else + switch (c) + { + case ' ': case '!': case '"': case '#': case '$': case '%': + case '&': case '\'': case '(': case ')': case '*': case '+': + case ',': case '-': case '.': case '/': + case '0': case '1': case '2': case '3': case '4': case '5': + case '6': case '7': case '8': case '9': + case ':': case ';': case '<': case '=': case '>': case '?': + case '@': + case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': + case 'G': case 'H': case 'I': case 'J': case 'K': case 'L': + case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R': + case 'S': case 'T': case 'U': case 'V': case 'W': case 'X': + case 'Y': case 'Z': + case '[': case '\\': case ']': case '^': case '_': case '`': + case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': + case 'g': case 'h': case 'i': case 'j': case 'k': case 'l': + case 'm': case 'n': case 'o': case 'p': case 'q': case 'r': + case 's': case 't': case 'u': case 'v': case 'w': case 'x': + case 'y': case 'z': + case '{': case '|': case '}': case '~': + return 1; + default: + return 0; + } +#endif +} + +bool +c_ispunct (int c) +{ +#if C_CTYPE_ASCII + return ((c >= '!' && c <= '~') + && !((c >= '0' && c <= '9') + || ((c & ~0x20) >= 'A' && (c & ~0x20) <= 'Z'))); +#else + switch (c) + { + case '!': case '"': case '#': case '$': case '%': case '&': + case '\'': case '(': case ')': case '*': case '+': case ',': + case '-': case '.': case '/': + case ':': case ';': case '<': case '=': case '>': case '?': + case '@': + case '[': case '\\': case ']': case '^': case '_': case '`': + case '{': case '|': case '}': case '~': + return 1; + default: + return 0; + } +#endif +} + +bool +c_isspace (int c) +{ + return (c == ' ' || c == '\t' + || c == '\n' || c == '\v' || c == '\f' || c == '\r'); +} + +bool +c_isupper (int c) +{ +#if C_CTYPE_CONSECUTIVE_UPPERCASE + return (c >= 'A' && c <= 'Z'); +#else + switch (c) + { + case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': + case 'G': case 'H': case 'I': case 'J': case 'K': case 'L': + case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R': + case 'S': case 'T': case 'U': case 'V': case 'W': case 'X': + case 'Y': case 'Z': + return 1; + default: + return 0; + } +#endif +} + +bool +c_isxdigit (int c) +{ +#if C_CTYPE_CONSECUTIVE_DIGITS \ + && C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE +#if C_CTYPE_ASCII + return ((c >= '0' && c <= '9') + || ((c & ~0x20) >= 'A' && (c & ~0x20) <= 'F')); +#else + return ((c >= '0' && c <= '9') + || (c >= 'A' && c <= 'F') + || (c >= 'a' && c <= 'f')); +#endif +#else + switch (c) + { + case '0': case '1': case '2': case '3': case '4': case '5': + case '6': case '7': case '8': case '9': + case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': + case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': + return 1; + default: + return 0; + } +#endif +} + +int +c_tolower (int c) +{ +#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE + return (c >= 'A' && c <= 'Z' ? c - 'A' + 'a' : c); +#else + switch (c) + { + case 'A': return 'a'; + case 'B': return 'b'; + case 'C': return 'c'; + case 'D': return 'd'; + case 'E': return 'e'; + case 'F': return 'f'; + case 'G': return 'g'; + case 'H': return 'h'; + case 'I': return 'i'; + case 'J': return 'j'; + case 'K': return 'k'; + case 'L': return 'l'; + case 'M': return 'm'; + case 'N': return 'n'; + case 'O': return 'o'; + case 'P': return 'p'; + case 'Q': return 'q'; + case 'R': return 'r'; + case 'S': return 's'; + case 'T': return 't'; + case 'U': return 'u'; + case 'V': return 'v'; + case 'W': return 'w'; + case 'X': return 'x'; + case 'Y': return 'y'; + case 'Z': return 'z'; + default: return c; + } +#endif +} + +int +c_toupper (int c) +{ +#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE + return (c >= 'a' && c <= 'z' ? c - 'a' + 'A' : c); +#else + switch (c) + { + case 'a': return 'A'; + case 'b': return 'B'; + case 'c': return 'C'; + case 'd': return 'D'; + case 'e': return 'E'; + case 'f': return 'F'; + case 'g': return 'G'; + case 'h': return 'H'; + case 'i': return 'I'; + case 'j': return 'J'; + case 'k': return 'K'; + case 'l': return 'L'; + case 'm': return 'M'; + case 'n': return 'N'; + case 'o': return 'O'; + case 'p': return 'P'; + case 'q': return 'Q'; + case 'r': return 'R'; + case 's': return 'S'; + case 't': return 'T'; + case 'u': return 'U'; + case 'v': return 'V'; + case 'w': return 'W'; + case 'x': return 'X'; + case 'y': return 'Y'; + case 'z': return 'Z'; + default: return c; + } +#endif +} diff --git a/lib/c-ctype.h b/lib/c-ctype.h new file mode 100644 index 00000000000..0b31309e960 --- /dev/null +++ b/lib/c-ctype.h @@ -0,0 +1,294 @@ +/* Character handling in C locale. + + These functions work like the corresponding functions in , + except that they have the C (POSIX) locale hardwired, whereas the + functions' behaviour depends on the current locale set via + setlocale. + + Copyright (C) 2000-2003, 2006, 2008-2012 Free Software Foundation, Inc. + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, see . */ + +#ifndef C_CTYPE_H +#define C_CTYPE_H + +#include + + +#ifdef __cplusplus +extern "C" { +#endif + + +/* The functions defined in this file assume the "C" locale and a character + set without diacritics (ASCII-US or EBCDIC-US or something like that). + Even if the "C" locale on a particular system is an extension of the ASCII + character set (like on BeOS, where it is UTF-8, or on AmigaOS, where it + is ISO-8859-1), the functions in this file recognize only the ASCII + characters. */ + + +/* Check whether the ASCII optimizations apply. */ + +/* ANSI C89 (and ISO C99 5.2.1.3 too) already guarantees that + '0', '1', ..., '9' have consecutive integer values. */ +#define C_CTYPE_CONSECUTIVE_DIGITS 1 + +#if ('A' <= 'Z') \ + && ('A' + 1 == 'B') && ('B' + 1 == 'C') && ('C' + 1 == 'D') \ + && ('D' + 1 == 'E') && ('E' + 1 == 'F') && ('F' + 1 == 'G') \ + && ('G' + 1 == 'H') && ('H' + 1 == 'I') && ('I' + 1 == 'J') \ + && ('J' + 1 == 'K') && ('K' + 1 == 'L') && ('L' + 1 == 'M') \ + && ('M' + 1 == 'N') && ('N' + 1 == 'O') && ('O' + 1 == 'P') \ + && ('P' + 1 == 'Q') && ('Q' + 1 == 'R') && ('R' + 1 == 'S') \ + && ('S' + 1 == 'T') && ('T' + 1 == 'U') && ('U' + 1 == 'V') \ + && ('V' + 1 == 'W') && ('W' + 1 == 'X') && ('X' + 1 == 'Y') \ + && ('Y' + 1 == 'Z') +#define C_CTYPE_CONSECUTIVE_UPPERCASE 1 +#endif + +#if ('a' <= 'z') \ + && ('a' + 1 == 'b') && ('b' + 1 == 'c') && ('c' + 1 == 'd') \ + && ('d' + 1 == 'e') && ('e' + 1 == 'f') && ('f' + 1 == 'g') \ + && ('g' + 1 == 'h') && ('h' + 1 == 'i') && ('i' + 1 == 'j') \ + && ('j' + 1 == 'k') && ('k' + 1 == 'l') && ('l' + 1 == 'm') \ + && ('m' + 1 == 'n') && ('n' + 1 == 'o') && ('o' + 1 == 'p') \ + && ('p' + 1 == 'q') && ('q' + 1 == 'r') && ('r' + 1 == 's') \ + && ('s' + 1 == 't') && ('t' + 1 == 'u') && ('u' + 1 == 'v') \ + && ('v' + 1 == 'w') && ('w' + 1 == 'x') && ('x' + 1 == 'y') \ + && ('y' + 1 == 'z') +#define C_CTYPE_CONSECUTIVE_LOWERCASE 1 +#endif + +#if (' ' == 32) && ('!' == 33) && ('"' == 34) && ('#' == 35) \ + && ('%' == 37) && ('&' == 38) && ('\'' == 39) && ('(' == 40) \ + && (')' == 41) && ('*' == 42) && ('+' == 43) && (',' == 44) \ + && ('-' == 45) && ('.' == 46) && ('/' == 47) && ('0' == 48) \ + && ('1' == 49) && ('2' == 50) && ('3' == 51) && ('4' == 52) \ + && ('5' == 53) && ('6' == 54) && ('7' == 55) && ('8' == 56) \ + && ('9' == 57) && (':' == 58) && (';' == 59) && ('<' == 60) \ + && ('=' == 61) && ('>' == 62) && ('?' == 63) && ('A' == 65) \ + && ('B' == 66) && ('C' == 67) && ('D' == 68) && ('E' == 69) \ + && ('F' == 70) && ('G' == 71) && ('H' == 72) && ('I' == 73) \ + && ('J' == 74) && ('K' == 75) && ('L' == 76) && ('M' == 77) \ + && ('N' == 78) && ('O' == 79) && ('P' == 80) && ('Q' == 81) \ + && ('R' == 82) && ('S' == 83) && ('T' == 84) && ('U' == 85) \ + && ('V' == 86) && ('W' == 87) && ('X' == 88) && ('Y' == 89) \ + && ('Z' == 90) && ('[' == 91) && ('\\' == 92) && (']' == 93) \ + && ('^' == 94) && ('_' == 95) && ('a' == 97) && ('b' == 98) \ + && ('c' == 99) && ('d' == 100) && ('e' == 101) && ('f' == 102) \ + && ('g' == 103) && ('h' == 104) && ('i' == 105) && ('j' == 106) \ + && ('k' == 107) && ('l' == 108) && ('m' == 109) && ('n' == 110) \ + && ('o' == 111) && ('p' == 112) && ('q' == 113) && ('r' == 114) \ + && ('s' == 115) && ('t' == 116) && ('u' == 117) && ('v' == 118) \ + && ('w' == 119) && ('x' == 120) && ('y' == 121) && ('z' == 122) \ + && ('{' == 123) && ('|' == 124) && ('}' == 125) && ('~' == 126) +/* The character set is ASCII or one of its variants or extensions, not EBCDIC. + Testing the value of '\n' and '\r' is not relevant. */ +#define C_CTYPE_ASCII 1 +#endif + + +/* Function declarations. */ + +/* Unlike the functions in , which require an argument in the range + of the 'unsigned char' type, the functions here operate on values that are + in the 'unsigned char' range or in the 'char' range. In other words, + when you have a 'char' value, you need to cast it before using it as + argument to a function: + + const char *s = ...; + if (isalpha ((unsigned char) *s)) ... + + but you don't need to cast it for the functions defined in this file: + + const char *s = ...; + if (c_isalpha (*s)) ... + */ + +extern bool c_isascii (int c) _GL_ATTRIBUTE_CONST; /* not locale dependent */ + +extern bool c_isalnum (int c) _GL_ATTRIBUTE_CONST; +extern bool c_isalpha (int c) _GL_ATTRIBUTE_CONST; +extern bool c_isblank (int c) _GL_ATTRIBUTE_CONST; +extern bool c_iscntrl (int c) _GL_ATTRIBUTE_CONST; +extern bool c_isdigit (int c) _GL_ATTRIBUTE_CONST; +extern bool c_islower (int c) _GL_ATTRIBUTE_CONST; +extern bool c_isgraph (int c) _GL_ATTRIBUTE_CONST; +extern bool c_isprint (int c) _GL_ATTRIBUTE_CONST; +extern bool c_ispunct (int c) _GL_ATTRIBUTE_CONST; +extern bool c_isspace (int c) _GL_ATTRIBUTE_CONST; +extern bool c_isupper (int c) _GL_ATTRIBUTE_CONST; +extern bool c_isxdigit (int c) _GL_ATTRIBUTE_CONST; + +extern int c_tolower (int c) _GL_ATTRIBUTE_CONST; +extern int c_toupper (int c) _GL_ATTRIBUTE_CONST; + + +#if defined __GNUC__ && defined __OPTIMIZE__ && !defined __OPTIMIZE_SIZE__ && !defined NO_C_CTYPE_MACROS + +/* ASCII optimizations. */ + +#undef c_isascii +#define c_isascii(c) \ + ({ int __c = (c); \ + (__c >= 0x00 && __c <= 0x7f); \ + }) + +#if C_CTYPE_CONSECUTIVE_DIGITS \ + && C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE +#if C_CTYPE_ASCII +#undef c_isalnum +#define c_isalnum(c) \ + ({ int __c = (c); \ + ((__c >= '0' && __c <= '9') \ + || ((__c & ~0x20) >= 'A' && (__c & ~0x20) <= 'Z')); \ + }) +#else +#undef c_isalnum +#define c_isalnum(c) \ + ({ int __c = (c); \ + ((__c >= '0' && __c <= '9') \ + || (__c >= 'A' && __c <= 'Z') \ + || (__c >= 'a' && __c <= 'z')); \ + }) +#endif +#endif + +#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE +#if C_CTYPE_ASCII +#undef c_isalpha +#define c_isalpha(c) \ + ({ int __c = (c); \ + ((__c & ~0x20) >= 'A' && (__c & ~0x20) <= 'Z'); \ + }) +#else +#undef c_isalpha +#define c_isalpha(c) \ + ({ int __c = (c); \ + ((__c >= 'A' && __c <= 'Z') || (__c >= 'a' && __c <= 'z')); \ + }) +#endif +#endif + +#undef c_isblank +#define c_isblank(c) \ + ({ int __c = (c); \ + (__c == ' ' || __c == '\t'); \ + }) + +#if C_CTYPE_ASCII +#undef c_iscntrl +#define c_iscntrl(c) \ + ({ int __c = (c); \ + ((__c & ~0x1f) == 0 || __c == 0x7f); \ + }) +#endif + +#if C_CTYPE_CONSECUTIVE_DIGITS +#undef c_isdigit +#define c_isdigit(c) \ + ({ int __c = (c); \ + (__c >= '0' && __c <= '9'); \ + }) +#endif + +#if C_CTYPE_CONSECUTIVE_LOWERCASE +#undef c_islower +#define c_islower(c) \ + ({ int __c = (c); \ + (__c >= 'a' && __c <= 'z'); \ + }) +#endif + +#if C_CTYPE_ASCII +#undef c_isgraph +#define c_isgraph(c) \ + ({ int __c = (c); \ + (__c >= '!' && __c <= '~'); \ + }) +#endif + +#if C_CTYPE_ASCII +#undef c_isprint +#define c_isprint(c) \ + ({ int __c = (c); \ + (__c >= ' ' && __c <= '~'); \ + }) +#endif + +#if C_CTYPE_ASCII +#undef c_ispunct +#define c_ispunct(c) \ + ({ int _c = (c); \ + (c_isgraph (_c) && ! c_isalnum (_c)); \ + }) +#endif + +#undef c_isspace +#define c_isspace(c) \ + ({ int __c = (c); \ + (__c == ' ' || __c == '\t' \ + || __c == '\n' || __c == '\v' || __c == '\f' || __c == '\r'); \ + }) + +#if C_CTYPE_CONSECUTIVE_UPPERCASE +#undef c_isupper +#define c_isupper(c) \ + ({ int __c = (c); \ + (__c >= 'A' && __c <= 'Z'); \ + }) +#endif + +#if C_CTYPE_CONSECUTIVE_DIGITS \ + && C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE +#if C_CTYPE_ASCII +#undef c_isxdigit +#define c_isxdigit(c) \ + ({ int __c = (c); \ + ((__c >= '0' && __c <= '9') \ + || ((__c & ~0x20) >= 'A' && (__c & ~0x20) <= 'F')); \ + }) +#else +#undef c_isxdigit +#define c_isxdigit(c) \ + ({ int __c = (c); \ + ((__c >= '0' && __c <= '9') \ + || (__c >= 'A' && __c <= 'F') \ + || (__c >= 'a' && __c <= 'f')); \ + }) +#endif +#endif + +#if C_CTYPE_CONSECUTIVE_UPPERCASE && C_CTYPE_CONSECUTIVE_LOWERCASE +#undef c_tolower +#define c_tolower(c) \ + ({ int __c = (c); \ + (__c >= 'A' && __c <= 'Z' ? __c - 'A' + 'a' : __c); \ + }) +#undef c_toupper +#define c_toupper(c) \ + ({ int __c = (c); \ + (__c >= 'a' && __c <= 'z' ? __c - 'a' + 'A' : __c); \ + }) +#endif + +#endif /* optimizing for speed */ + + +#ifdef __cplusplus +} +#endif + +#endif /* C_CTYPE_H */ diff --git a/lib/c-strcase.h b/lib/c-strcase.h new file mode 100644 index 00000000000..fdef2385eaf --- /dev/null +++ b/lib/c-strcase.h @@ -0,0 +1,56 @@ +/* Case-insensitive string comparison functions in C locale. + Copyright (C) 1995-1996, 2001, 2003, 2005, 2009-2012 Free Software + Foundation, Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, see . */ + +#ifndef C_STRCASE_H +#define C_STRCASE_H + +#include + + +/* The functions defined in this file assume the "C" locale and a character + set without diacritics (ASCII-US or EBCDIC-US or something like that). + Even if the "C" locale on a particular system is an extension of the ASCII + character set (like on BeOS, where it is UTF-8, or on AmigaOS, where it + is ISO-8859-1), the functions in this file recognize only the ASCII + characters. More precisely, one of the string arguments must be an ASCII + string; the other one can also contain non-ASCII characters (but then + the comparison result will be nonzero). */ + + +#ifdef __cplusplus +extern "C" { +#endif + + +/* Compare strings S1 and S2, ignoring case, returning less than, equal to or + greater than zero if S1 is lexicographically less than, equal to or greater + than S2. */ +extern int c_strcasecmp (const char *s1, const char *s2) _GL_ATTRIBUTE_PURE; + +/* Compare no more than N characters of strings S1 and S2, ignoring case, + returning less than, equal to or greater than zero if S1 is + lexicographically less than, equal to or greater than S2. */ +extern int c_strncasecmp (const char *s1, const char *s2, size_t n) + _GL_ATTRIBUTE_PURE; + + +#ifdef __cplusplus +} +#endif + + +#endif /* C_STRCASE_H */ diff --git a/lib/c-strcasecmp.c b/lib/c-strcasecmp.c new file mode 100644 index 00000000000..d8332caf839 --- /dev/null +++ b/lib/c-strcasecmp.c @@ -0,0 +1,56 @@ +/* c-strcasecmp.c -- case insensitive string comparator in C locale + Copyright (C) 1998-1999, 2005-2006, 2009-2012 Free Software Foundation, Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, see . */ + +#include + +/* Specification. */ +#include "c-strcase.h" + +#include + +#include "c-ctype.h" + +int +c_strcasecmp (const char *s1, const char *s2) +{ + register const unsigned char *p1 = (const unsigned char *) s1; + register const unsigned char *p2 = (const unsigned char *) s2; + unsigned char c1, c2; + + if (p1 == p2) + return 0; + + do + { + c1 = c_tolower (*p1); + c2 = c_tolower (*p2); + + if (c1 == '\0') + break; + + ++p1; + ++p2; + } + while (c1 == c2); + + if (UCHAR_MAX <= INT_MAX) + return c1 - c2; + else + /* On machines where 'char' and 'int' are types of the same size, the + difference of two 'unsigned char' values - including the sign bit - + doesn't fit in an 'int'. */ + return (c1 > c2 ? 1 : c1 < c2 ? -1 : 0); +} diff --git a/lib/c-strncasecmp.c b/lib/c-strncasecmp.c new file mode 100644 index 00000000000..47fb5fdb678 --- /dev/null +++ b/lib/c-strncasecmp.c @@ -0,0 +1,56 @@ +/* c-strncasecmp.c -- case insensitive string comparator in C locale + Copyright (C) 1998-1999, 2005-2006, 2009-2012 Free Software Foundation, Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, see . */ + +#include + +/* Specification. */ +#include "c-strcase.h" + +#include + +#include "c-ctype.h" + +int +c_strncasecmp (const char *s1, const char *s2, size_t n) +{ + register const unsigned char *p1 = (const unsigned char *) s1; + register const unsigned char *p2 = (const unsigned char *) s2; + unsigned char c1, c2; + + if (p1 == p2 || n == 0) + return 0; + + do + { + c1 = c_tolower (*p1); + c2 = c_tolower (*p2); + + if (--n == 0 || c1 == '\0') + break; + + ++p1; + ++p2; + } + while (c1 == c2); + + if (UCHAR_MAX <= INT_MAX) + return c1 - c2; + else + /* On machines where 'char' and 'int' are types of the same size, the + difference of two 'unsigned char' values - including the sign bit - + doesn't fit in an 'int'. */ + return (c1 > c2 ? 1 : c1 < c2 ? -1 : 0); +} diff --git a/lib/dtotimespec.c b/lib/dtotimespec.c new file mode 100644 index 00000000000..f30fa075077 --- /dev/null +++ b/lib/dtotimespec.c @@ -0,0 +1,69 @@ +/* Convert double to timespec. + + Copyright (C) 2011-2012 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . */ + +/* written by Paul Eggert */ + +/* Convert the double value SEC to a struct timespec. Round toward + positive infinity. On overflow, return an extremal value. */ + +#include + +#include "timespec.h" + +#include "intprops.h" + +struct timespec +dtotimespec (double sec) +{ + enum { BILLION = 1000 * 1000 * 1000 }; + double min_representable = TYPE_MINIMUM (time_t); + double max_representable = + ((TYPE_MAXIMUM (time_t) * (double) BILLION + (BILLION - 1)) + / BILLION); + struct timespec r; + + if (! (min_representable < sec)) + { + r.tv_sec = TYPE_MINIMUM (time_t); + r.tv_nsec = 0; + } + else if (! (sec < max_representable)) + { + r.tv_sec = TYPE_MAXIMUM (time_t); + r.tv_nsec = BILLION - 1; + } + else + { + time_t s = sec; + double frac = BILLION * (sec - s); + long ns = frac; + ns += ns < frac; + s += ns / BILLION; + ns %= BILLION; + + if (ns < 0) + { + s--; + ns += BILLION; + } + + r.tv_sec = s; + r.tv_nsec = ns; + } + + return r; +} diff --git a/lib/filemode.h b/lib/filemode.h index 9ebef47806d..3ca19b85623 100644 --- a/lib/filemode.h +++ b/lib/filemode.h @@ -23,7 +23,7 @@ /* Get the declaration of strmode. */ # if HAVE_DECL_STRMODE -# include /* MacOS X, FreeBSD, OpenBSD */ +# include /* Mac OS X, FreeBSD, OpenBSD */ # include /* NetBSD */ # endif diff --git a/lib/getloadavg.c b/lib/getloadavg.c index d79ad136bc9..a8ffefee33f 100644 --- a/lib/getloadavg.c +++ b/lib/getloadavg.c @@ -28,7 +28,7 @@ macro that comes with autoconf 2.13 or newer. If that isn't an option, then just put AC_CHECK_FUNCS(pstat_getdynamic) in your - configure.in file. + configure.ac file. HAVE_LIBPERFSTAT Define this if your system has the perfstat_cpu_total function in libperfstat (AIX). FIXUP_KERNEL_SYMBOL_ADDR() Adjust address in returned struct nlist. @@ -80,45 +80,23 @@ We also #define LDAV_PRIVILEGED if a program will require special installation to be able to call getloadavg. */ -/* "configure" defines CONFIGURING_GETLOADAVG to sidestep problems - with partially-configured source directories. */ - -#ifndef CONFIGURING_GETLOADAVG -# include -# include -#endif +#include /* Specification. */ #include #include +#include #include # include -/* Both the Emacs and non-Emacs sections want this. Some - configuration files' definitions for the LOAD_AVE_CVT macro (like - sparc.h's) use macros like FSCALE, defined here. */ -# if defined (unix) || defined (__unix) +# if HAVE_SYS_PARAM_H # include # endif # include "intprops.h" -/* The existing Emacs configuration files define a macro called - LOAD_AVE_CVT, which accepts a value of type LOAD_AVE_TYPE, and - returns the load average multiplied by 100. What we actually want - is a macro called LDAV_CVT, which returns the load average as an - unmultiplied double. - - For backwards compatibility, we'll define LDAV_CVT in terms of - LOAD_AVE_CVT, but future machine config files should just define - LDAV_CVT directly. */ - -# if !defined (LDAV_CVT) && defined (LOAD_AVE_CVT) -# define LDAV_CVT(n) (LOAD_AVE_CVT (n) / 100.0) -# endif - # if !defined (BSD) && defined (ultrix) /* Ultrix behaves like BSD on Vaxen. */ # define BSD diff --git a/lib/gettext.h b/lib/gettext.h index 75875cdb0fb..65ca1e6762e 100644 --- a/lib/gettext.h +++ b/lib/gettext.h @@ -183,9 +183,12 @@ npgettext_aux (const char *domain, #include -#define _LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS \ - (((__GNUC__ >= 3 || __GNUG__ >= 2) && !defined __STRICT_ANSI__) \ - /* || __STDC_VERSION__ >= 199901L */ ) +#if (((__GNUC__ >= 3 || __GNUG__ >= 2) && !defined __STRICT_ANSI__) \ + /* || __STDC_VERSION__ >= 199901L */ ) +# define _LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS 1 +#else +# define _LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS 0 +#endif #if !_LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS #include diff --git a/lib/gettime.c b/lib/gettime.c new file mode 100644 index 00000000000..8075bfaf999 --- /dev/null +++ b/lib/gettime.c @@ -0,0 +1,48 @@ +/* gettime -- get the system clock + + Copyright (C) 2002, 2004-2007, 2009-2012 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . */ + +/* Written by Paul Eggert. */ + +#include + +#include "timespec.h" + +#include + +/* Get the system time into *TS. */ + +void +gettime (struct timespec *ts) +{ +#if HAVE_NANOTIME + nanotime (ts); +#else + +# if defined CLOCK_REALTIME && HAVE_CLOCK_GETTIME + if (clock_gettime (CLOCK_REALTIME, ts) == 0) + return; +# endif + + { + struct timeval tv; + gettimeofday (&tv, NULL); + ts->tv_sec = tv.tv_sec; + ts->tv_nsec = tv.tv_usec * 1000; + } + +#endif +} diff --git a/lib/gettimeofday.c b/lib/gettimeofday.c new file mode 100644 index 00000000000..5d35060950a --- /dev/null +++ b/lib/gettimeofday.c @@ -0,0 +1,154 @@ +/* Provide gettimeofday for systems that don't have it or for which it's broken. + + Copyright (C) 2001-2003, 2005-2007, 2009-2012 Free Software Foundation, Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, see . */ + +/* written by Jim Meyering */ + +#include + +/* Specification. */ +#include + +#include + +#if HAVE_SYS_TIMEB_H +# include +#endif + +#if GETTIMEOFDAY_CLOBBERS_LOCALTIME || TZSET_CLOBBERS_LOCALTIME + +/* Work around the bug in some systems whereby gettimeofday clobbers + the static buffer that localtime uses for its return value. The + gettimeofday function from Mac OS X 10.0.4 (i.e., Darwin 1.3.7) has + this problem. The tzset replacement is necessary for at least + Solaris 2.5, 2.5.1, and 2.6. */ + +static struct tm tm_zero_buffer; +static struct tm *localtime_buffer_addr = &tm_zero_buffer; + +# undef localtime +extern struct tm *localtime (time_t const *); + +# undef gmtime +extern struct tm *gmtime (time_t const *); + +/* This is a wrapper for localtime. It is used only on systems for which + gettimeofday clobbers the static buffer used for localtime's result. + + On the first call, record the address of the static buffer that + localtime uses for its result. */ + +struct tm * +rpl_localtime (time_t const *timep) +{ + struct tm *tm = localtime (timep); + + if (localtime_buffer_addr == &tm_zero_buffer) + localtime_buffer_addr = tm; + + return tm; +} + +/* Same as above, since gmtime and localtime use the same buffer. */ +struct tm * +rpl_gmtime (time_t const *timep) +{ + struct tm *tm = gmtime (timep); + + if (localtime_buffer_addr == &tm_zero_buffer) + localtime_buffer_addr = tm; + + return tm; +} + +#endif /* GETTIMEOFDAY_CLOBBERS_LOCALTIME || TZSET_CLOBBERS_LOCALTIME */ + +#if TZSET_CLOBBERS_LOCALTIME + +# undef tzset +extern void tzset (void); + +/* This is a wrapper for tzset, for systems on which tzset may clobber + the static buffer used for localtime's result. */ +void +rpl_tzset (void) +{ + /* Save and restore the contents of the buffer used for localtime's + result around the call to tzset. */ + struct tm save = *localtime_buffer_addr; + tzset (); + *localtime_buffer_addr = save; +} +#endif + +/* This is a wrapper for gettimeofday. It is used only on systems + that lack this function, or whose implementation of this function + causes problems. */ + +int +gettimeofday (struct timeval *restrict tv, void *restrict tz) +{ +#undef gettimeofday +#if HAVE_GETTIMEOFDAY +# if GETTIMEOFDAY_CLOBBERS_LOCALTIME + /* Save and restore the contents of the buffer used for localtime's + result around the call to gettimeofday. */ + struct tm save = *localtime_buffer_addr; +# endif + +# if defined timeval /* 'struct timeval' overridden by gnulib? */ +# undef timeval + struct timeval otv; + int result = gettimeofday (&otv, (struct timezone *) tz); + if (result == 0) + { + tv->tv_sec = otv.tv_sec; + tv->tv_usec = otv.tv_usec; + } +# else + int result = gettimeofday (tv, (struct timezone *) tz); +# endif + +# if GETTIMEOFDAY_CLOBBERS_LOCALTIME + *localtime_buffer_addr = save; +# endif + + return result; + +#else + +# if HAVE__FTIME + + struct _timeb timebuf; + _ftime (&timebuf); + tv->tv_sec = timebuf.time; + tv->tv_usec = timebuf.millitm * 1000; + +# else + +# if !defined OK_TO_USE_1S_CLOCK +# error "Only 1-second nominal clock resolution found. Is that intended?" \ + "If so, compile with the -DOK_TO_USE_1S_CLOCK option." +# endif + tv->tv_sec = time (NULL); + tv->tv_usec = 0; + +# endif + + return 0; + +#endif +} diff --git a/lib/gnulib.mk b/lib/gnulib.mk index 3572e5bc170..6e2bf89786c 100644 --- a/lib/gnulib.mk +++ b/lib/gnulib.mk @@ -21,7 +21,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=build-aux --avoid=msvc-inval --avoid=msvc-nothrow --avoid=raise --avoid=threadlib --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 largefile lstat manywarnings mktime pthread_sigmask readlink socklen stdarg stdio strftime strtoimax strtoumax symlink sys_stat warnings +# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=errno --avoid=fcntl --avoid=fcntl-h --avoid=fstat --avoid=msvc-inval --avoid=msvc-nothrow --avoid=raise --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt c-strcase careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 filemode getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings mktime pselect pthread_sigmask readlink socklen stat-time stdarg stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timespec-add timespec-sub utimens warnings MOSTLYCLEANFILES += core *.stackdump @@ -64,6 +64,18 @@ EXTRA_DIST += allocator.h ## end gnulib module allocator +## begin gnulib module c-ctype + +libgnu_a_SOURCES += c-ctype.h c-ctype.c + +## end gnulib module c-ctype + +## begin gnulib module c-strcase + +libgnu_a_SOURCES += c-strcase.h c-strcasecmp.c c-strncasecmp.c + +## end gnulib module c-strcase + ## begin gnulib module careadlinkat libgnu_a_SOURCES += careadlinkat.c @@ -123,6 +135,12 @@ EXTRA_libgnu_a_SOURCES += ftoastr.c ## end gnulib module dtoastr +## begin gnulib module dtotimespec + +libgnu_a_SOURCES += dtotimespec.c + +## end gnulib module dtotimespec + ## begin gnulib module dup2 @@ -184,6 +202,21 @@ libgnu_a_SOURCES += gettext.h endif ## end gnulib module gettext-h +## begin gnulib module gettime + +libgnu_a_SOURCES += gettime.c + +## end gnulib module gettime + +## begin gnulib module gettimeofday + + +EXTRA_DIST += gettimeofday.c + +EXTRA_libgnu_a_SOURCES += gettimeofday.c + +## end gnulib module gettimeofday + ## begin gnulib module ignore-value @@ -269,6 +302,15 @@ EXTRA_DIST += pathmax.h ## end gnulib module pathmax +## begin gnulib module pselect + + +EXTRA_DIST += pselect.c + +EXTRA_libgnu_a_SOURCES += pselect.c + +## end gnulib module pselect + ## begin gnulib module pthread_sigmask @@ -329,17 +371,6 @@ EXTRA_DIST += signal.in.h ## end gnulib module signal-h -## begin gnulib module sigprocmask - -if gl_GNULIB_ENABLED_sigprocmask - -endif -EXTRA_DIST += sigprocmask.c - -EXTRA_libgnu_a_SOURCES += sigprocmask.c - -## end gnulib module sigprocmask - ## begin gnulib module snippet/_Noreturn # Because this Makefile snippet defines a variable used by other @@ -432,6 +463,13 @@ EXTRA_libgnu_a_SOURCES += stat.c ## end gnulib module stat +## begin gnulib module stat-time + + +EXTRA_DIST += stat-time.h + +## end gnulib module stat-time + ## begin gnulib module stdalign BUILT_SOURCES += $(STDALIGN_H) @@ -871,6 +909,40 @@ EXTRA_libgnu_a_SOURCES += symlink.c ## end gnulib module symlink +## begin gnulib module sys_select + +BUILT_SOURCES += sys/select.h + +# We need the following in order to create when the system +# doesn't have one that works with the given compiler. +sys/select.h: sys_select.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(WARN_ON_USE_H) + $(AM_V_at)$(MKDIR_P) sys + $(AM_V_GEN)rm -f $@-t $@ && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ + sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ + -e 's|@''NEXT_SYS_SELECT_H''@|$(NEXT_SYS_SELECT_H)|g' \ + -e 's|@''HAVE_SYS_SELECT_H''@|$(HAVE_SYS_SELECT_H)|g' \ + -e 's/@''GNULIB_PSELECT''@/$(GNULIB_PSELECT)/g' \ + -e 's/@''GNULIB_SELECT''@/$(GNULIB_SELECT)/g' \ + -e 's|@''HAVE_WINSOCK2_H''@|$(HAVE_WINSOCK2_H)|g' \ + -e 's|@''HAVE_PSELECT''@|$(HAVE_PSELECT)|g' \ + -e 's|@''REPLACE_PSELECT''@|$(REPLACE_PSELECT)|g' \ + -e 's|@''REPLACE_SELECT''@|$(REPLACE_SELECT)|g' \ + -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \ + -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \ + < $(srcdir)/sys_select.in.h; \ + } > $@-t && \ + mv $@-t $@ +MOSTLYCLEANFILES += sys/select.h sys/select.h-t +MOSTLYCLEANDIRS += sys + +EXTRA_DIST += sys_select.in.h + +## end gnulib module sys_select + ## begin gnulib module sys_stat BUILT_SOURCES += sys/stat.h @@ -933,30 +1005,39 @@ EXTRA_DIST += sys_stat.in.h ## end gnulib module sys_stat -## begin gnulib module sys_types +## begin gnulib module sys_time -BUILT_SOURCES += sys/types.h +BUILT_SOURCES += sys/time.h -# We need the following in order to create when the system +# We need the following in order to create when the system # doesn't have one that works with the given compiler. -sys/types.h: sys_types.in.h $(top_builddir)/config.status +sys/time.h: sys_time.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) $(AM_V_at)$(MKDIR_P) sys $(AM_V_GEN)rm -f $@-t $@ && \ { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ sed -e 's|@''GUARD_PREFIX''@|GL|g' \ + -e 's/@''HAVE_SYS_TIME_H''@/$(HAVE_SYS_TIME_H)/g' \ -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ - -e 's|@''NEXT_SYS_TYPES_H''@|$(NEXT_SYS_TYPES_H)|g' \ - -e 's|@''WINDOWS_64_BIT_OFF_T''@|$(WINDOWS_64_BIT_OFF_T)|g' \ - < $(srcdir)/sys_types.in.h; \ + -e 's|@''NEXT_SYS_TIME_H''@|$(NEXT_SYS_TIME_H)|g' \ + -e 's/@''GNULIB_GETTIMEOFDAY''@/$(GNULIB_GETTIMEOFDAY)/g' \ + -e 's|@''HAVE_WINSOCK2_H''@|$(HAVE_WINSOCK2_H)|g' \ + -e 's/@''HAVE_GETTIMEOFDAY''@/$(HAVE_GETTIMEOFDAY)/g' \ + -e 's/@''HAVE_STRUCT_TIMEVAL''@/$(HAVE_STRUCT_TIMEVAL)/g' \ + -e 's/@''REPLACE_GETTIMEOFDAY''@/$(REPLACE_GETTIMEOFDAY)/g' \ + -e 's/@''REPLACE_STRUCT_TIMEVAL''@/$(REPLACE_STRUCT_TIMEVAL)/g' \ + -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \ + -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \ + -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \ + < $(srcdir)/sys_time.in.h; \ } > $@-t && \ mv $@-t $@ -MOSTLYCLEANFILES += sys/types.h sys/types.h-t +MOSTLYCLEANFILES += sys/time.h sys/time.h-t -EXTRA_DIST += sys_types.in.h +EXTRA_DIST += sys_time.in.h -## end gnulib module sys_types +## end gnulib module sys_time ## begin gnulib module time @@ -1009,6 +1090,25 @@ EXTRA_libgnu_a_SOURCES += time_r.c ## end gnulib module time_r +## begin gnulib module timespec + + +EXTRA_DIST += timespec.h + +## end gnulib module timespec + +## begin gnulib module timespec-add + +libgnu_a_SOURCES += timespec-add.c + +## end gnulib module timespec-add + +## begin gnulib module timespec-sub + +libgnu_a_SOURCES += timespec-sub.c + +## end gnulib module timespec-sub + ## begin gnulib module u64 @@ -1166,6 +1266,14 @@ EXTRA_DIST += unistd.in.h ## end gnulib module unistd +## begin gnulib module utimens + +libgnu_a_SOURCES += utimens.c + +EXTRA_DIST += utimens.h + +## end gnulib module utimens + ## begin gnulib module verify if gl_GNULIB_ENABLED_verify diff --git a/lib/makefile.w32-in b/lib/makefile.w32-in index 62808f73a74..b49195bcb84 100644 --- a/lib/makefile.w32-in +++ b/lib/makefile.w32-in @@ -20,14 +20,21 @@ ALL = gnulib .PHONY: $(ALL) -LOCAL_FLAGS = -DHAVE_CONFIG_H=1 -I. -I../nt/inc -I../src +LOCAL_FLAGS = -I. -I../nt/inc -I../src LIBS = -GNULIBOBJS = $(BLD)/dtoastr.$(O) \ +GNULIBOBJS = $(BLD)/c-ctype.$(O) \ + $(BLD)/c-strcasecmp.$(O) \ + $(BLD)/c-strncasecmp.$(O) \ + $(BLD)/dtoastr.$(O) \ + $(BLD)/dtotimespec.$(O) \ $(BLD)/getopt.$(O) \ $(BLD)/getopt1.$(O) \ + $(BLD)/gettime.$(O) \ $(BLD)/strftime.$(O) \ $(BLD)/time_r.$(O) \ + $(BLD)/timespec-add.$(O) \ + $(BLD)/timespec-sub.$(O) \ $(BLD)/md5.$(O) \ $(BLD)/sha1.$(O) \ $(BLD)/sha256.$(O) \ @@ -58,99 +65,144 @@ TAGS: FRC ### DEPENDENCIES ### EMACS_ROOT = .. -SRC = . +GNU_LIB = . +SRC = $(EMACS_ROOT)/src +NT_INC = $(EMACS_ROOT)/nt/inc + +C_CTYPE_H = $(GNU_LIB)/c-ctype.h \ + $(NT_INC)/stdbool.h +MS_W32_H = $(SRC)/s/ms-w32.h \ + $(NT_INC)/sys/stat.h +CONFIG_H = $(SRC)/config.h \ + $(MS_W32_H) +FILEMODE_H = $(GNU_LIB)/filemode.h \ + $(NT_INC)/sys/stat.h +FTOASTR_H = $(GNU_LIB)/ftoastr.h \ + $(GNU_LIB)/intprops.h +FTOASTR_C = $(GNU_LIB)/ftoastr.c \ + $(CONFIG_H) \ + $(FTOASTR_H) \ + $(GNU_LIB)/ftoastr.h +GETOPT_INT_H = $(GNU_LIB)/getopt_int.h \ + $(GNU_LIB)/getopt.h +MD5_H = $(GNU_LIB)/md5.h \ + $(NT_INC)/stdint.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) \ + $(GNU_LIB)/u64.h + +$(BLD)/c-ctype.$(O) : \ + $(GNU_LIB)/c-ctype.c \ + $(CONFIG_H) \ + $(C_CTYPE_H) + +$(BLD)/c-strcasecmp.$(O) : \ + $(GNU_LIB)/c-strcasecmp.c \ + $(GNU_LIB)/c-strcase.h \ + $(CONFIG_H) \ + $(C_CTYPE_H) + +$(BLD)/c-strncasecmp.$(O) : \ + $(GNU_LIB)/c-strncasecmp.c \ + $(GNU_LIB)/c-strcase.h \ + $(CONFIG_H) \ + $(C_CTYPE_H) $(BLD)/dtoastr.$(O) : \ - $(SRC)/dtoastr.c \ - $(SRC)/ftoastr.c \ - $(SRC)/ftoastr.h \ - $(SRC)/intprops.h \ - $(EMACS_ROOT)/nt/inc/sys/stat.h \ - $(EMACS_ROOT)/src/s/ms-w32.h \ - $(EMACS_ROOT)/src/config.h + $(GNU_LIB)/dtoastr.c \ + $(FTOASTR_C) + +$(BLD)/dtotimespec.$(O) : \ + $(GNU_LIB)/dtotimespec.c \ + $(GNU_LIB)/intprops.h \ + $(GNU_LIB)/timespec.h \ + $(CONFIG_H) $(BLD)/getopt.$(O) : \ - $(SRC)/getopt.c \ - $(SRC)/getopt.h \ - $(SRC)/getopt_int.h \ - $(SRC)/gettext.h \ - $(EMACS_ROOT)/nt/inc/unistd.h \ - $(EMACS_ROOT)/nt/inc/sys/stat.h \ - $(EMACS_ROOT)/src/s/ms-w32.h \ - $(EMACS_ROOT)/src/config.h + $(GNU_LIB)/getopt.c \ + $(GNU_LIB)/getopt.h \ + $(GNU_LIB)/gettext.h \ + $(NT_INC)/unistd.h \ + $(CONFIG_H) \ + $(GETOPT_INT_H) $(BLD)/getopt1.$(O) : \ - $(SRC)/getopt1.c \ - $(SRC)/getopt.h \ - $(SRC)/getopt_int.h \ - $(EMACS_ROOT)/nt/inc/sys/stat.h \ - $(EMACS_ROOT)/src/s/ms-w32.h \ - $(EMACS_ROOT)/src/config.h + $(GNU_LIB)/getopt1.c \ + $(GNU_LIB)/getopt.h \ + $(CONFIG_H) \ + $(GETOPT_INT_H) + +$(BLD)/gettime.$(O) : \ + $(GNU_LIB)/gettime.c \ + $(GNU_LIB)/timespec.h \ + $(NT_INC)/sys/time.h \ + $(CONFIG_H) $(BLD)/strftime.$(O) : \ - $(SRC)/strftime.c \ - $(SRC)/strftime.h \ - $(EMACS_ROOT)/nt/inc/stdbool.h \ - $(EMACS_ROOT)/nt/inc/sys/stat.h \ - $(EMACS_ROOT)/src/s/ms-w32.h \ - $(EMACS_ROOT)/src/config.h + $(GNU_LIB)/strftime.c \ + $(GNU_LIB)/strftime.h \ + $(NT_INC)/stdbool.h \ + $(CONFIG_H) $(BLD)/time_r.$(O) : \ - $(SRC)/time_r.c \ - $(EMACS_ROOT)/nt/inc/sys/stat.h \ - $(EMACS_ROOT)/src/s/ms-w32.h \ - $(EMACS_ROOT)/src/config.h + $(GNU_LIB)/time_r.c \ + $(CONFIG_H) + +$(BLD)/timespec-add.$(O) : \ + $(GNU_LIB)/timespec-add.c \ + $(GNU_LIB)/intprops.h \ + $(GNU_LIB)/timespec.h \ + $(CONFIG_H) + +$(BLD)/timespec-sub.$(O) : \ + $(GNU_LIB)/timespec-sub.c \ + $(GNU_LIB)/intprops.h \ + $(GNU_LIB)/timespec.h \ + $(CONFIG_H) $(BLD)/md5.$(O) : \ - $(SRC)/md5.c \ - $(SRC)/md5.h \ - $(EMACS_ROOT)/nt/inc/stdint.h \ - $(EMACS_ROOT)/nt/inc/stdalign.h \ - $(EMACS_ROOT)/nt/inc/sys/stat.h \ - $(EMACS_ROOT)/src/s/ms-w32.h \ - $(EMACS_ROOT)/src/config.h + $(GNU_LIB)/md5.c \ + $(NT_INC)/stdalign.h \ + $(NT_INC)/stdint.h \ + $(CONFIG_H) \ + $(MD5_H) $(BLD)/sha1.$(O) : \ - $(SRC)/sha1.c \ - $(SRC)/sha1.h \ - $(EMACS_ROOT)/nt/inc/stdint.h \ - $(EMACS_ROOT)/nt/inc/stdalign.h \ - $(EMACS_ROOT)/nt/inc/sys/stat.h \ - $(EMACS_ROOT)/src/s/ms-w32.h \ - $(EMACS_ROOT)/src/config.h + $(GNU_LIB)/sha1.c \ + $(NT_INC)/stdalign.h \ + $(NT_INC)/stdint.h \ + $(CONFIG_H) \ + $(SHA1_H) $(BLD)/sha256.$(O) : \ - $(SRC)/sha256.c \ - $(SRC)/sha256.h \ - $(EMACS_ROOT)/nt/inc/stdint.h \ - $(EMACS_ROOT)/nt/inc/stdalign.h \ - $(EMACS_ROOT)/nt/inc/sys/stat.h \ - $(EMACS_ROOT)/src/s/ms-w32.h \ - $(EMACS_ROOT)/src/config.h + $(GNU_LIB)/sha256.c \ + $(NT_INC)/stdalign.h \ + $(NT_INC)/stdint.h \ + $(CONFIG_H) \ + $(SHA256_H) $(BLD)/sha512.$(O) : \ - $(SRC)/sha512.c \ - $(SRC)/sha512.h \ - $(EMACS_ROOT)/nt/inc/stdint.h \ - $(EMACS_ROOT)/nt/inc/stdalign.h \ - $(EMACS_ROOT)/nt/inc/sys/stat.h \ - $(EMACS_ROOT)/src/s/ms-w32.h \ - $(EMACS_ROOT)/src/config.h + $(GNU_LIB)/sha512.c \ + $(NT_INC)/stdalign.h \ + $(NT_INC)/stdint.h \ + $(CONFIG_H) \ + $(SHA512_H) $(BLD)/filemode.$(O) : \ - $(SRC)/filemode.c \ - $(SRC)/filemode.h \ - $(EMACS_ROOT)/nt/inc/sys/stat.h \ - $(EMACS_ROOT)/src/s/ms-w32.h \ - $(EMACS_ROOT)/src/config.h + $(GNU_LIB)/filemode.c \ + $(CONFIG_H) \ + $(FILEMODE_H) # The following dependencies are for supporting parallel builds, where # we must make sure $(BLD) exists before any compilation starts. # -$(BLD)/dtoastr.$(O) $(BLD)/getopt.$(O) $(BLD)/getopt1.$(O): stamp_BLD -$(BLD)/strftime.$(O) $(BLD)/time_r.$(O) $(BLD)/md5.$(O): stamp_BLD -$(BLD)/sha1.$(O) $(BLD)/sha256.$(O) $(BLD)/sha512.$(O): stamp_BLD -$(BLD)/filemode.$(O): stamp_BLD +$(GNULIBOBJS): stamp_BLD # # Headers we would preprocess if we could. diff --git a/lib/pselect.c b/lib/pselect.c new file mode 100644 index 00000000000..d8ebc70f6c6 --- /dev/null +++ b/lib/pselect.c @@ -0,0 +1,76 @@ +/* pselect - synchronous I/O multiplexing + + Copyright 2011-2012 Free Software Foundation, Inc. + + This file is part of gnulib. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along + with this program; if not, see . */ + +/* written by Paul Eggert */ + +#include + +#include + +#include +#include + +/* Examine the size-NFDS file descriptor sets in RFDS, WFDS, and XFDS + to see whether some of their descriptors are ready for reading, + ready for writing, or have exceptions pending. Wait for at most + TIMEOUT seconds, and use signal mask SIGMASK while waiting. A null + pointer parameter stands for no descriptors, an infinite timeout, + or an unaffected signal mask. */ + +int +pselect (int nfds, fd_set *restrict rfds, + fd_set *restrict wfds, fd_set *restrict xfds, + struct timespec const *restrict timeout, + sigset_t const *restrict sigmask) +{ + int select_result; + sigset_t origmask; + struct timeval tv, *tvp; + + if (timeout) + { + if (! (0 <= timeout->tv_nsec && timeout->tv_nsec < 1000000000)) + { + errno = EINVAL; + return -1; + } + + tv.tv_sec = timeout->tv_sec; + tv.tv_usec = (timeout->tv_nsec + 999) / 1000; + tvp = &tv; + } + else + tvp = NULL; + + /* Signal mask munging should be atomic, but this is the best we can + do in this emulation. */ + if (sigmask) + pthread_sigmask (SIG_SETMASK, sigmask, &origmask); + + select_result = select (nfds, rfds, wfds, xfds, tvp); + + if (sigmask) + { + int select_errno = errno; + pthread_sigmask (SIG_SETMASK, &origmask, NULL); + errno = select_errno; + } + + return select_result; +} diff --git a/lib/pthread_sigmask.c b/lib/pthread_sigmask.c index 4a150e70e9f..80ab24bf0b1 100644 --- a/lib/pthread_sigmask.c +++ b/lib/pthread_sigmask.c @@ -22,6 +22,10 @@ #include #include +#if PTHREAD_SIGMASK_INEFFECTIVE +# include +#endif + #if PTHREAD_SIGMASK_UNBLOCK_BUG # include #endif @@ -31,7 +35,22 @@ pthread_sigmask (int how, const sigset_t *new_mask, sigset_t *old_mask) #undef pthread_sigmask { #if HAVE_PTHREAD_SIGMASK - int ret = pthread_sigmask (how, new_mask, old_mask); + int ret; + +# if PTHREAD_SIGMASK_INEFFECTIVE + sigset_t omask, omask_copy; + sigset_t *old_mask_ptr = &omask; + sigemptyset (&omask); + /* Add a signal unlikely to be blocked, so that OMASK_COPY + is unlikely to match the actual mask. */ + sigaddset (&omask, SIGILL); + memcpy (&omask_copy, &omask, sizeof omask); +# else + sigset_t *old_mask_ptr = old_mask; +# endif + + ret = pthread_sigmask (how, new_mask, old_mask_ptr); + # if PTHREAD_SIGMASK_INEFFECTIVE if (ret == 0) { @@ -39,12 +58,16 @@ pthread_sigmask (int how, const sigset_t *new_mask, sigset_t *old_mask) Don't cache the information: libpthread.so could be dynamically loaded after the program started and after pthread_sigmask was called for the first time. */ - if (pthread_sigmask (1729, NULL, NULL) == 0) + if (memcmp (&omask_copy, &omask, sizeof omask) == 0 + && pthread_sigmask (1729, &omask_copy, NULL) == 0) { /* pthread_sigmask is currently ineffective. The program is not linked to -lpthread. So use sigprocmask instead. */ return (sigprocmask (how, new_mask, old_mask) < 0 ? errno : 0); } + + if (old_mask) + memcpy (old_mask, &omask, sizeof omask); } # endif # if PTHREAD_SIGMASK_FAILS_WITH_ERRNO diff --git a/lib/signal.in.h b/lib/signal.in.h index e0f0554bdbd..8fb1ad119ad 100644 --- a/lib/signal.in.h +++ b/lib/signal.in.h @@ -55,7 +55,7 @@ #ifndef _@GUARD_PREFIX@_SIGNAL_H #define _@GUARD_PREFIX@_SIGNAL_H -/* MacOS X 10.3, FreeBSD 6.4, OpenBSD 3.8, OSF/1 4.0, Solaris 2.6 declare +/* Mac OS X 10.3, FreeBSD 6.4, OpenBSD 3.8, OSF/1 4.0, Solaris 2.6 declare pthread_sigmask in , not in . But avoid namespace pollution on glibc systems.*/ #if (@GNULIB_PTHREAD_SIGMASK@ || defined GNULIB_POSIXCHECK) \ @@ -197,7 +197,7 @@ typedef int verify_NSIG_constraint[NSIG <= 32 ? 1 : -1]; /* Test whether a given signal is contained in a signal set. */ # if @HAVE_POSIX_SIGNALBLOCKING@ -/* This function is defined as a macro on MacOS X. */ +/* This function is defined as a macro on Mac OS X. */ # if defined __cplusplus && defined GNULIB_NAMESPACE # undef sigismember # endif @@ -210,7 +210,7 @@ _GL_CXXALIASWARN (sigismember); /* Initialize a signal set to the empty set. */ # if @HAVE_POSIX_SIGNALBLOCKING@ -/* This function is defined as a macro on MacOS X. */ +/* This function is defined as a macro on Mac OS X. */ # if defined __cplusplus && defined GNULIB_NAMESPACE # undef sigemptyset # endif @@ -222,7 +222,7 @@ _GL_CXXALIASWARN (sigemptyset); /* Add a signal to a signal set. */ # if @HAVE_POSIX_SIGNALBLOCKING@ -/* This function is defined as a macro on MacOS X. */ +/* This function is defined as a macro on Mac OS X. */ # if defined __cplusplus && defined GNULIB_NAMESPACE # undef sigaddset # endif @@ -235,7 +235,7 @@ _GL_CXXALIASWARN (sigaddset); /* Remove a signal from a signal set. */ # if @HAVE_POSIX_SIGNALBLOCKING@ -/* This function is defined as a macro on MacOS X. */ +/* This function is defined as a macro on Mac OS X. */ # if defined __cplusplus && defined GNULIB_NAMESPACE # undef sigdelset # endif @@ -248,7 +248,7 @@ _GL_CXXALIASWARN (sigdelset); /* Fill a signal set with all possible signals. */ # if @HAVE_POSIX_SIGNALBLOCKING@ -/* This function is defined as a macro on MacOS X. */ +/* This function is defined as a macro on Mac OS X. */ # if defined __cplusplus && defined GNULIB_NAMESPACE # undef sigfillset # endif diff --git a/lib/stat-time.h b/lib/stat-time.h new file mode 100644 index 00000000000..30c2acdab63 --- /dev/null +++ b/lib/stat-time.h @@ -0,0 +1,189 @@ +/* stat-related time functions. + + Copyright (C) 2005, 2007, 2009-2012 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . */ + +/* Written by Paul Eggert. */ + +#ifndef STAT_TIME_H +#define STAT_TIME_H 1 + +#include +#include + +/* STAT_TIMESPEC (ST, ST_XTIM) is the ST_XTIM member for *ST of type + struct timespec, if available. If not, then STAT_TIMESPEC_NS (ST, + ST_XTIM) is the nanosecond component of the ST_XTIM member for *ST, + if available. ST_XTIM can be st_atim, st_ctim, st_mtim, or st_birthtim + for access, status change, data modification, or birth (creation) + time respectively. + + These macros are private to stat-time.h. */ +#if defined HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC +# ifdef TYPEOF_STRUCT_STAT_ST_ATIM_IS_STRUCT_TIMESPEC +# define STAT_TIMESPEC(st, st_xtim) ((st)->st_xtim) +# else +# define STAT_TIMESPEC_NS(st, st_xtim) ((st)->st_xtim.tv_nsec) +# endif +#elif defined HAVE_STRUCT_STAT_ST_ATIMESPEC_TV_NSEC +# define STAT_TIMESPEC(st, st_xtim) ((st)->st_xtim##espec) +#elif defined HAVE_STRUCT_STAT_ST_ATIMENSEC +# define STAT_TIMESPEC_NS(st, st_xtim) ((st)->st_xtim##ensec) +#elif defined HAVE_STRUCT_STAT_ST_ATIM_ST__TIM_TV_NSEC +# define STAT_TIMESPEC_NS(st, st_xtim) ((st)->st_xtim.st__tim.tv_nsec) +#endif + +/* Return the nanosecond component of *ST's access time. */ +static inline long int +get_stat_atime_ns (struct stat const *st) +{ +# if defined STAT_TIMESPEC + return STAT_TIMESPEC (st, st_atim).tv_nsec; +# elif defined STAT_TIMESPEC_NS + return STAT_TIMESPEC_NS (st, st_atim); +# else + return 0; +# endif +} + +/* Return the nanosecond component of *ST's status change time. */ +static inline long int +get_stat_ctime_ns (struct stat const *st) +{ +# if defined STAT_TIMESPEC + return STAT_TIMESPEC (st, st_ctim).tv_nsec; +# elif defined STAT_TIMESPEC_NS + return STAT_TIMESPEC_NS (st, st_ctim); +# else + return 0; +# endif +} + +/* Return the nanosecond component of *ST's data modification time. */ +static inline long int +get_stat_mtime_ns (struct stat const *st) +{ +# if defined STAT_TIMESPEC + return STAT_TIMESPEC (st, st_mtim).tv_nsec; +# elif defined STAT_TIMESPEC_NS + return STAT_TIMESPEC_NS (st, st_mtim); +# else + return 0; +# endif +} + +/* Return the nanosecond component of *ST's birth time. */ +static inline long int +get_stat_birthtime_ns (struct stat const *st) +{ +# if defined HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC + return STAT_TIMESPEC (st, st_birthtim).tv_nsec; +# elif defined HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC + return STAT_TIMESPEC_NS (st, st_birthtim); +# else + /* Avoid a "parameter unused" warning. */ + (void) st; + return 0; +# endif +} + +/* Return *ST's access time. */ +static inline struct timespec +get_stat_atime (struct stat const *st) +{ +#ifdef STAT_TIMESPEC + return STAT_TIMESPEC (st, st_atim); +#else + struct timespec t; + t.tv_sec = st->st_atime; + t.tv_nsec = get_stat_atime_ns (st); + return t; +#endif +} + +/* Return *ST's status change time. */ +static inline struct timespec +get_stat_ctime (struct stat const *st) +{ +#ifdef STAT_TIMESPEC + return STAT_TIMESPEC (st, st_ctim); +#else + struct timespec t; + t.tv_sec = st->st_ctime; + t.tv_nsec = get_stat_ctime_ns (st); + return t; +#endif +} + +/* Return *ST's data modification time. */ +static inline struct timespec +get_stat_mtime (struct stat const *st) +{ +#ifdef STAT_TIMESPEC + return STAT_TIMESPEC (st, st_mtim); +#else + struct timespec t; + t.tv_sec = st->st_mtime; + t.tv_nsec = get_stat_mtime_ns (st); + return t; +#endif +} + +/* Return *ST's birth time, if available; otherwise return a value + with tv_sec and tv_nsec both equal to -1. */ +static inline struct timespec +get_stat_birthtime (struct stat const *st) +{ + struct timespec t; + +#if (defined HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC \ + || defined HAVE_STRUCT_STAT_ST_BIRTHTIM_TV_NSEC) + t = STAT_TIMESPEC (st, st_birthtim); +#elif defined HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC + t.tv_sec = st->st_birthtime; + t.tv_nsec = st->st_birthtimensec; +#elif (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__ + /* Native Windows platforms (but not Cygwin) put the "file creation + time" in st_ctime (!). See + . */ + t.tv_sec = st->st_ctime; + t.tv_nsec = 0; +#else + /* Birth time is not supported. */ + t.tv_sec = -1; + t.tv_nsec = -1; + /* Avoid a "parameter unused" warning. */ + (void) st; +#endif + +#if (defined HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC \ + || defined HAVE_STRUCT_STAT_ST_BIRTHTIM_TV_NSEC \ + || defined HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC) + /* FreeBSD and NetBSD sometimes signal the absence of knowledge by + using zero. Attempt to work around this problem. Alas, this can + report failure even for valid time stamps. Also, NetBSD + sometimes returns junk in the birth time fields; work around this + bug if it is detected. */ + if (! (t.tv_sec && 0 <= t.tv_nsec && t.tv_nsec < 1000000000)) + { + t.tv_sec = -1; + t.tv_nsec = -1; + } +#endif + + return t; +} + +#endif diff --git a/lib/stat.c b/lib/stat.c index 1fc633eeef0..75995408906 100644 --- a/lib/stat.c +++ b/lib/stat.c @@ -29,6 +29,7 @@ #if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__ # if _GL_WINDOWS_64_BIT_ST_SIZE +# undef stat /* avoid warning on mingw64 with _FILE_OFFSET_BITS=64 */ # define stat _stati64 # define REPLACE_FUNC_STAT_DIR 1 # undef REPLACE_FUNC_STAT_FILE diff --git a/lib/stdint.in.h b/lib/stdint.in.h index 59c00d59c03..e2a0eb19ac0 100644 --- a/lib/stdint.in.h +++ b/lib/stdint.in.h @@ -83,7 +83,7 @@ /* defines some of the stdint.h types as well, on glibc, IRIX 6.5, and OpenBSD 3.8 (via ). AIX 5.2 isn't needed and causes troubles. - MacOS X 10.4.6 includes (which is us), but + Mac OS X 10.4.6 includes (which is us), but relies on the system definitions, so include after @NEXT_STDINT_H@. */ #if @HAVE_SYS_TYPES_H@ && ! defined _AIX diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h index b546133c3af..1d67ec64c66 100644 --- a/lib/stdlib.in.h +++ b/lib/stdlib.in.h @@ -87,8 +87,8 @@ struct random_data #endif #if (@GNULIB_MKSTEMP@ || @GNULIB_MKSTEMPS@ || @GNULIB_GETSUBOPT@ || defined GNULIB_POSIXCHECK) && ! defined __GLIBC__ && !((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__) -/* On MacOS X 10.3, only declares mkstemp. */ -/* On MacOS X 10.5, only declares mkstemps. */ +/* On Mac OS X 10.3, only declares mkstemp. */ +/* On Mac OS X 10.5, only declares mkstemps. */ /* On Cygwin 1.7.1, only declares getsubopt. */ /* But avoid namespace pollution on glibc systems and native Windows. */ # include diff --git a/lib/sys_select.in.h b/lib/sys_select.in.h new file mode 100644 index 00000000000..0aee2a16cbf --- /dev/null +++ b/lib/sys_select.in.h @@ -0,0 +1,298 @@ +/* Substitute for . + Copyright (C) 2007-2012 Free Software Foundation, Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, see . */ + +# if __GNUC__ >= 3 +@PRAGMA_SYSTEM_HEADER@ +# endif +@PRAGMA_COLUMNS@ + +/* On OSF/1, and include . + Simply delegate to the system's header in this case. */ +#if @HAVE_SYS_SELECT_H@ && defined __osf__ && (defined _SYS_TYPES_H_ && !defined _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TYPES_H) && defined _OSF_SOURCE + +# define _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TYPES_H +# @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@ + +#elif @HAVE_SYS_SELECT_H@ && defined __osf__ && (defined _SYS_TIME_H_ && !defined _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TIME_H) && defined _OSF_SOURCE + +# define _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_TIME_H +# @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@ + +/* On IRIX 6.5, includes , which includes + , which includes . At this point we cannot + include , because that includes , which + gives a syntax error because has not been completely + processed. Simply delegate to the system's header in this case. */ +#elif @HAVE_SYS_SELECT_H@ && defined __sgi && (defined _SYS_BSD_TYPES_H && !defined _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_BSD_TYPES_H) + +# define _GL_SYS_SELECT_H_REDIRECT_FROM_SYS_BSD_TYPES_H +# @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@ + +/* On OpenBSD 5.0, includes , which includes + . At this point we cannot include , because that + includes gnulib's pthread.h override, which gives a syntax error because + /usr/include/pthread.h has not been completely processed. Simply delegate + to the system's header in this case. */ +#elif @HAVE_SYS_SELECT_H@ && defined __OpenBSD__ && (defined _PTHREAD_H_ && !defined PTHREAD_MUTEX_INITIALIZER) + +# @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@ + +#else + +#ifndef _@GUARD_PREFIX@_SYS_SELECT_H + +/* On many platforms, assumes prior inclusion of + . Also, mingw defines sigset_t there, instead of + in where it belongs. */ +#include + +#if @HAVE_SYS_SELECT_H@ + +/* On OSF/1 4.0, provides only a forward declaration + of 'struct timeval', and no definition of this type. + Also, Mac OS X, AIX, HP-UX, IRIX, Solaris, Interix declare select() + in . + But avoid namespace pollution on glibc systems. */ +# ifndef __GLIBC__ +# include +# endif + +/* On AIX 7 and Solaris 10, provides an FD_ZERO implementation + that relies on memset(), but without including . + But in any case avoid namespace pollution on glibc systems. */ +# if (defined __OpenBSD__ || defined _AIX || defined __sun || defined __osf__ || defined __BEOS__) \ + && ! defined __GLIBC__ +# include +# endif + +/* The include_next requires a split double-inclusion guard. */ +# @INCLUDE_NEXT@ @NEXT_SYS_SELECT_H@ + +#endif + +/* Get definition of 'sigset_t'. + But avoid namespace pollution on glibc systems. + Do this after the include_next (for the sake of OpenBSD 5.0) but before + the split double-inclusion guard (for the sake of Solaris). */ +#if !(defined __GLIBC__ && !defined __UCLIBC__) +# include +#endif + +#ifndef _@GUARD_PREFIX@_SYS_SELECT_H +#define _@GUARD_PREFIX@_SYS_SELECT_H + +#if !@HAVE_SYS_SELECT_H@ +/* A platform that lacks . */ +/* Get the 'struct timeval' and 'fd_set' types and the FD_* macros + on most platforms. */ +# include +/* On HP-UX 11, provides an FD_ZERO implementation + that relies on memset(), but without including . */ +# if defined __hpux +# include +# endif +/* On native Windows platforms: + Get the 'fd_set' type. + Get the close() declaration before we override it. */ +# if @HAVE_WINSOCK2_H@ +# if !defined _GL_INCLUDING_WINSOCK2_H +# define _GL_INCLUDING_WINSOCK2_H +# include +# undef _GL_INCLUDING_WINSOCK2_H +# endif +# include +# endif +#endif + +/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */ + +/* The definition of _GL_WARN_ON_USE is copied here. */ + + +/* Fix some definitions from . */ + +#if @HAVE_WINSOCK2_H@ + +# if !GNULIB_defined_rpl_fd_isset + +/* Re-define FD_ISSET to avoid a WSA call while we are not using + network sockets. */ +static inline int +rpl_fd_isset (SOCKET fd, fd_set * set) +{ + u_int i; + if (set == NULL) + return 0; + + for (i = 0; i < set->fd_count; i++) + if (set->fd_array[i] == fd) + return 1; + + return 0; +} + +# define GNULIB_defined_rpl_fd_isset 1 +# endif + +# undef FD_ISSET +# define FD_ISSET(fd, set) rpl_fd_isset(fd, set) + +#endif + +/* Hide some function declarations from . */ + +#if @HAVE_WINSOCK2_H@ +# if !defined _@GUARD_PREFIX@_UNISTD_H +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef close +# define close close_used_without_including_unistd_h +# else + _GL_WARN_ON_USE (close, + "close() used without including "); +# endif +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef gethostname +# define gethostname gethostname_used_without_including_unistd_h +# else + _GL_WARN_ON_USE (gethostname, + "gethostname() used without including "); +# endif +# endif +# if !defined _@GUARD_PREFIX@_SYS_SOCKET_H +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef socket +# define socket socket_used_without_including_sys_socket_h +# undef connect +# define connect connect_used_without_including_sys_socket_h +# undef accept +# define accept accept_used_without_including_sys_socket_h +# undef bind +# define bind bind_used_without_including_sys_socket_h +# undef getpeername +# define getpeername getpeername_used_without_including_sys_socket_h +# undef getsockname +# define getsockname getsockname_used_without_including_sys_socket_h +# undef getsockopt +# define getsockopt getsockopt_used_without_including_sys_socket_h +# undef listen +# define listen listen_used_without_including_sys_socket_h +# undef recv +# define recv recv_used_without_including_sys_socket_h +# undef send +# define send send_used_without_including_sys_socket_h +# undef recvfrom +# define recvfrom recvfrom_used_without_including_sys_socket_h +# undef sendto +# define sendto sendto_used_without_including_sys_socket_h +# undef setsockopt +# define setsockopt setsockopt_used_without_including_sys_socket_h +# undef shutdown +# define shutdown shutdown_used_without_including_sys_socket_h +# else + _GL_WARN_ON_USE (socket, + "socket() used without including "); + _GL_WARN_ON_USE (connect, + "connect() used without including "); + _GL_WARN_ON_USE (accept, + "accept() used without including "); + _GL_WARN_ON_USE (bind, + "bind() used without including "); + _GL_WARN_ON_USE (getpeername, + "getpeername() used without including "); + _GL_WARN_ON_USE (getsockname, + "getsockname() used without including "); + _GL_WARN_ON_USE (getsockopt, + "getsockopt() used without including "); + _GL_WARN_ON_USE (listen, + "listen() used without including "); + _GL_WARN_ON_USE (recv, + "recv() used without including "); + _GL_WARN_ON_USE (send, + "send() used without including "); + _GL_WARN_ON_USE (recvfrom, + "recvfrom() used without including "); + _GL_WARN_ON_USE (sendto, + "sendto() used without including "); + _GL_WARN_ON_USE (setsockopt, + "setsockopt() used without including "); + _GL_WARN_ON_USE (shutdown, + "shutdown() used without including "); +# endif +# endif +#endif + + +#if @GNULIB_PSELECT@ +# if @REPLACE_PSELECT@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef pselect +# define pselect rpl_pselect +# endif +_GL_FUNCDECL_RPL (pselect, int, + (int, fd_set *restrict, fd_set *restrict, fd_set *restrict, + struct timespec const *restrict, const sigset_t *restrict)); +_GL_CXXALIAS_RPL (pselect, int, + (int, fd_set *restrict, fd_set *restrict, fd_set *restrict, + struct timespec const *restrict, const sigset_t *restrict)); +# else +# if !@HAVE_PSELECT@ +_GL_FUNCDECL_SYS (pselect, int, + (int, fd_set *restrict, fd_set *restrict, fd_set *restrict, + struct timespec const *restrict, const sigset_t *restrict)); +# endif +_GL_CXXALIAS_SYS (pselect, int, + (int, fd_set *restrict, fd_set *restrict, fd_set *restrict, + struct timespec const *restrict, const sigset_t *restrict)); +# endif +_GL_CXXALIASWARN (pselect); +#elif defined GNULIB_POSIXCHECK +# undef pselect +# if HAVE_RAW_DECL_PSELECT +_GL_WARN_ON_USE (pselect, "pselect is not portable - " + "use gnulib module pselect for portability"); +# endif +#endif + +#if @GNULIB_SELECT@ +# if @REPLACE_SELECT@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef select +# define select rpl_select +# endif +_GL_FUNCDECL_RPL (select, int, + (int, fd_set *, fd_set *, fd_set *, struct timeval *)); +_GL_CXXALIAS_RPL (select, int, + (int, fd_set *, fd_set *, fd_set *, struct timeval *)); +# else +_GL_CXXALIAS_SYS (select, int, + (int, fd_set *, fd_set *, fd_set *, struct timeval *)); +# endif +_GL_CXXALIASWARN (select); +#elif @HAVE_WINSOCK2_H@ +# undef select +# define select select_used_without_requesting_gnulib_module_select +#elif defined GNULIB_POSIXCHECK +# undef select +# if HAVE_RAW_DECL_SELECT +_GL_WARN_ON_USE (select, "select is not always POSIX compliant - " + "use gnulib module select for portability"); +# endif +#endif + + +#endif /* _@GUARD_PREFIX@_SYS_SELECT_H */ +#endif /* _@GUARD_PREFIX@_SYS_SELECT_H */ +#endif /* OSF/1 */ diff --git a/lib/sys_time.in.h b/lib/sys_time.in.h new file mode 100644 index 00000000000..d915cee467a --- /dev/null +++ b/lib/sys_time.in.h @@ -0,0 +1,205 @@ +/* Provide a more complete sys/time.h. + + Copyright (C) 2007-2012 Free Software Foundation, Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, see . */ + +/* Written by Paul Eggert. */ + +#if __GNUC__ >= 3 +@PRAGMA_SYSTEM_HEADER@ +#endif +@PRAGMA_COLUMNS@ + +#if defined _@GUARD_PREFIX@_SYS_TIME_H + +/* Simply delegate to the system's header, without adding anything. */ +# if @HAVE_SYS_TIME_H@ +# @INCLUDE_NEXT@ @NEXT_SYS_TIME_H@ +# endif + +#else + +# define _@GUARD_PREFIX@_SYS_TIME_H + +# if @HAVE_SYS_TIME_H@ +# @INCLUDE_NEXT@ @NEXT_SYS_TIME_H@ +# else +# include +# endif + +/* On native Windows with MSVC, get the 'struct timeval' type. + Also, on native Windows with a 64-bit time_t, where we are overriding the + 'struct timeval' type, get all declarations of system functions whose + signature contains 'struct timeval'. */ +# if (defined _MSC_VER || @REPLACE_STRUCT_TIMEVAL@) && @HAVE_WINSOCK2_H@ && !defined _GL_INCLUDING_WINSOCK2_H +# define _GL_INCLUDING_WINSOCK2_H +# include +# undef _GL_INCLUDING_WINSOCK2_H +# endif + +/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */ + +/* The definition of _GL_ARG_NONNULL is copied here. */ + +/* The definition of _GL_WARN_ON_USE is copied here. */ + +# ifdef __cplusplus +extern "C" { +# endif + +# if !@HAVE_STRUCT_TIMEVAL@ || @REPLACE_STRUCT_TIMEVAL@ + +# if @REPLACE_STRUCT_TIMEVAL@ +# define timeval rpl_timeval +# endif + +# if !GNULIB_defined_struct_timeval +struct timeval +{ + time_t tv_sec; + long int tv_usec; +}; +# define GNULIB_defined_struct_timeval 1 +# endif + +# endif + +# ifdef __cplusplus +} +# endif + +# if @GNULIB_GETTIMEOFDAY@ +# if @REPLACE_GETTIMEOFDAY@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef gettimeofday +# define gettimeofday rpl_gettimeofday +# endif +_GL_FUNCDECL_RPL (gettimeofday, int, + (struct timeval *restrict, void *restrict) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (gettimeofday, int, + (struct timeval *restrict, void *restrict)); +# else +# if !@HAVE_GETTIMEOFDAY@ +_GL_FUNCDECL_SYS (gettimeofday, int, + (struct timeval *restrict, void *restrict) + _GL_ARG_NONNULL ((1))); +# endif +/* Need to cast, because on glibc systems, by default, the second argument is + struct timezone *. */ +_GL_CXXALIAS_SYS_CAST (gettimeofday, int, + (struct timeval *restrict, void *restrict)); +# endif +_GL_CXXALIASWARN (gettimeofday); +# elif defined GNULIB_POSIXCHECK +# undef gettimeofday +# if HAVE_RAW_DECL_GETTIMEOFDAY +_GL_WARN_ON_USE (gettimeofday, "gettimeofday is unportable - " + "use gnulib module gettimeofday for portability"); +# endif +# endif + +/* Hide some function declarations from . */ + +# if defined _MSC_VER && @HAVE_WINSOCK2_H@ +# if !defined _@GUARD_PREFIX@_UNISTD_H +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef close +# define close close_used_without_including_unistd_h +# else + _GL_WARN_ON_USE (close, + "close() used without including "); +# endif +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef gethostname +# define gethostname gethostname_used_without_including_unistd_h +# else + _GL_WARN_ON_USE (gethostname, + "gethostname() used without including "); +# endif +# endif +# if !defined _@GUARD_PREFIX@_SYS_SOCKET_H +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef socket +# define socket socket_used_without_including_sys_socket_h +# undef connect +# define connect connect_used_without_including_sys_socket_h +# undef accept +# define accept accept_used_without_including_sys_socket_h +# undef bind +# define bind bind_used_without_including_sys_socket_h +# undef getpeername +# define getpeername getpeername_used_without_including_sys_socket_h +# undef getsockname +# define getsockname getsockname_used_without_including_sys_socket_h +# undef getsockopt +# define getsockopt getsockopt_used_without_including_sys_socket_h +# undef listen +# define listen listen_used_without_including_sys_socket_h +# undef recv +# define recv recv_used_without_including_sys_socket_h +# undef send +# define send send_used_without_including_sys_socket_h +# undef recvfrom +# define recvfrom recvfrom_used_without_including_sys_socket_h +# undef sendto +# define sendto sendto_used_without_including_sys_socket_h +# undef setsockopt +# define setsockopt setsockopt_used_without_including_sys_socket_h +# undef shutdown +# define shutdown shutdown_used_without_including_sys_socket_h +# else + _GL_WARN_ON_USE (socket, + "socket() used without including "); + _GL_WARN_ON_USE (connect, + "connect() used without including "); + _GL_WARN_ON_USE (accept, + "accept() used without including "); + _GL_WARN_ON_USE (bind, + "bind() used without including "); + _GL_WARN_ON_USE (getpeername, + "getpeername() used without including "); + _GL_WARN_ON_USE (getsockname, + "getsockname() used without including "); + _GL_WARN_ON_USE (getsockopt, + "getsockopt() used without including "); + _GL_WARN_ON_USE (listen, + "listen() used without including "); + _GL_WARN_ON_USE (recv, + "recv() used without including "); + _GL_WARN_ON_USE (send, + "send() used without including "); + _GL_WARN_ON_USE (recvfrom, + "recvfrom() used without including "); + _GL_WARN_ON_USE (sendto, + "sendto() used without including "); + _GL_WARN_ON_USE (setsockopt, + "setsockopt() used without including "); + _GL_WARN_ON_USE (shutdown, + "shutdown() used without including "); +# endif +# endif +# if !defined _@GUARD_PREFIX@_SYS_SELECT_H +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef select +# define select select_used_without_including_sys_select_h +# else + _GL_WARN_ON_USE (select, + "select() used without including "); +# endif +# endif +# endif + +#endif /* _@GUARD_PREFIX@_SYS_TIME_H */ diff --git a/lib/timespec-add.c b/lib/timespec-add.c new file mode 100644 index 00000000000..4e5c641ac12 --- /dev/null +++ b/lib/timespec-add.c @@ -0,0 +1,71 @@ +/* Add two struct timespec values. + + Copyright (C) 2011-2012 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . */ + +/* Written by Paul Eggert. */ + +/* Return the sum of two timespec values A and B. On overflow, return + an extremal value. This assumes 0 <= tv_nsec <= 999999999. */ + +#include +#include "timespec.h" + +#include "intprops.h" + +struct timespec +timespec_add (struct timespec a, struct timespec b) +{ + struct timespec r; + time_t rs = a.tv_sec; + time_t bs = b.tv_sec; + int ns = a.tv_nsec + b.tv_nsec; + int nsd = ns - 1000000000; + int rns = ns; + + if (0 <= nsd) + { + rns = nsd; + if (rs == TYPE_MAXIMUM (time_t)) + { + if (0 <= bs) + goto high_overflow; + bs++; + } + else + rs++; + } + + if (INT_ADD_OVERFLOW (rs, bs)) + { + if (rs < 0) + { + rs = TYPE_MINIMUM (time_t); + rns = 0; + } + else + { + high_overflow: + rs = TYPE_MAXIMUM (time_t); + rns = 999999999; + } + } + else + rs += bs; + + r.tv_sec = rs; + r.tv_nsec = rns; + return r; +} diff --git a/lib/timespec-sub.c b/lib/timespec-sub.c new file mode 100644 index 00000000000..7c4c781b7f6 --- /dev/null +++ b/lib/timespec-sub.c @@ -0,0 +1,71 @@ +/* Subtract two struct timespec values. + + Copyright (C) 2011-2012 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . */ + +/* Written by Paul Eggert. */ + +/* Return the difference between two timespec values A and B. On + overflow, return an extremal value. This assumes 0 <= tv_nsec <= + 999999999. */ + +#include +#include "timespec.h" + +#include "intprops.h" + +struct timespec +timespec_sub (struct timespec a, struct timespec b) +{ + struct timespec r; + time_t rs = a.tv_sec; + time_t bs = b.tv_sec; + int ns = a.tv_nsec - b.tv_nsec; + int rns = ns; + + if (ns < 0) + { + rns = ns + 1000000000; + if (rs == TYPE_MINIMUM (time_t)) + { + if (bs <= 0) + goto low_overflow; + bs--; + } + else + rs--; + } + + if (INT_SUBTRACT_OVERFLOW (rs, bs)) + { + if (rs < 0) + { + low_overflow: + rs = TYPE_MINIMUM (time_t); + rns = 0; + } + else + { + rs = TYPE_MAXIMUM (time_t); + rns = 999999999; + } + } + else + rs -= bs; + + r.tv_sec = rs; + r.tv_nsec = rns; + return r; +} diff --git a/lib/timespec.h b/lib/timespec.h new file mode 100644 index 00000000000..a58707947ce --- /dev/null +++ b/lib/timespec.h @@ -0,0 +1,85 @@ +/* timespec -- System time interface + + Copyright (C) 2000, 2002, 2004-2005, 2007, 2009-2012 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 . */ + +#if ! defined TIMESPEC_H +# define TIMESPEC_H + +# include + +/* Return negative, zero, positive if A < B, A == B, A > B, respectively. + + For each time stamp T, this code assumes that either: + + * T.tv_nsec is in the range 0..999999999; or + * T.tv_sec corresponds to a valid leap second on a host that supports + leap seconds, and T.tv_nsec is in the range 1000000000..1999999999; or + * T.tv_sec is the minimum time_t value and T.tv_nsec is -1; or + T.tv_sec is the maximum time_t value and T.tv_nsec is 2000000000. + This allows for special struct timespec values that are less or + greater than all possible valid time stamps. + + In all these cases, it is safe to subtract two tv_nsec values and + convert the result to integer without worrying about overflow on + any platform of interest to the GNU project, since all such + platforms have 32-bit int or wider. + + Replacing "(int) (a.tv_nsec - b.tv_nsec)" with something like + "a.tv_nsec < b.tv_nsec ? -1 : a.tv_nsec > b.tv_nsec" would cause + this function to work in some cases where the above assumption is + violated, but not in all cases (e.g., a.tv_sec==1, a.tv_nsec==-2, + b.tv_sec==0, b.tv_nsec==999999999) and is arguably not worth the + extra instructions. Using a subtraction has the advantage of + detecting some invalid cases on platforms that detect integer + overflow. + + The (int) cast avoids a gcc -Wconversion warning. */ + +static inline int +timespec_cmp (struct timespec a, struct timespec b) +{ + return (a.tv_sec < b.tv_sec ? -1 + : a.tv_sec > b.tv_sec ? 1 + : (int) (a.tv_nsec - b.tv_nsec)); +} + +/* Return -1, 0, 1, depending on the sign of A. A.tv_nsec must be + nonnegative. */ +static inline int +timespec_sign (struct timespec a) +{ + return a.tv_sec < 0 ? -1 : a.tv_sec || a.tv_nsec; +} + +struct timespec timespec_add (struct timespec, struct timespec) + _GL_ATTRIBUTE_CONST; +struct timespec timespec_sub (struct timespec, struct timespec) + _GL_ATTRIBUTE_CONST; +struct timespec dtotimespec (double) + _GL_ATTRIBUTE_CONST; + +/* Return an approximation to A, of type 'double'. */ +static inline double +timespectod (struct timespec a) +{ + return a.tv_sec + a.tv_nsec / 1e9; +} + +void gettime (struct timespec *); +int settime (struct timespec const *); + +#endif diff --git a/lib/unistd.in.h b/lib/unistd.in.h index 9115486cf37..e904e512ee8 100644 --- a/lib/unistd.in.h +++ b/lib/unistd.in.h @@ -1318,7 +1318,7 @@ _GL_WARN_ON_USE (rmdir, "rmdir is unportable - " _GL_FUNCDECL_SYS (sethostname, int, (const char *name, size_t len) _GL_ARG_NONNULL ((1))); # endif -/* Need to cast, because on Solaris 11 2011-10, MacOS X 10.5, IRIX 6.5 +/* Need to cast, because on Solaris 11 2011-10, Mac OS X 10.5, IRIX 6.5 and FreeBSD 6.4 the second parameter is int. On Solaris 11 2011-10, the first parameter is not const. */ _GL_CXXALIAS_SYS_CAST (sethostname, int, (const char *name, size_t len)); diff --git a/lib/utimens.c b/lib/utimens.c new file mode 100644 index 00000000000..c126b9551a6 --- /dev/null +++ b/lib/utimens.c @@ -0,0 +1,533 @@ +/* Set file access and modification times. + + Copyright (C) 2003-2012 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 any + later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . */ + +/* Written by Paul Eggert. */ + +/* derived from a function in touch.c */ + +#include + +#include "utimens.h" + +#include +#include +#include +#include +#include +#include +#include + +#include "stat-time.h" +#include "timespec.h" + +#if HAVE_UTIME_H +# include +#endif + +/* Some systems (even some that do have ) don't declare this + structure anywhere. */ +#ifndef HAVE_STRUCT_UTIMBUF +struct utimbuf +{ + long actime; + long modtime; +}; +#endif + +/* Avoid recursion with rpl_futimens or rpl_utimensat. */ +#undef futimens +#undef utimensat + +/* Solaris 9 mistakenly succeeds when given a non-directory with a + trailing slash. Force the use of rpl_stat for a fix. */ +#ifndef REPLACE_FUNC_STAT_FILE +# define REPLACE_FUNC_STAT_FILE 0 +#endif + +#if HAVE_UTIMENSAT || HAVE_FUTIMENS +/* Cache variables for whether the utimensat syscall works; used to + avoid calling the syscall if we know it will just fail with ENOSYS, + and to avoid unnecessary work in massaging timestamps if the + syscall will work. Multiple variables are needed, to distinguish + between the following scenarios on Linux: + utimensat doesn't exist, or is in glibc but kernel 2.6.18 fails with ENOSYS + kernel 2.6.22 and earlier rejects AT_SYMLINK_NOFOLLOW + kernel 2.6.25 and earlier reject UTIME_NOW/UTIME_OMIT with non-zero tv_sec + kernel 2.6.32 used with xfs or ntfs-3g fail to honor UTIME_OMIT + utimensat completely works + For each cache variable: 0 = unknown, 1 = yes, -1 = no. */ +static int utimensat_works_really; +static int lutimensat_works_really; +#endif /* HAVE_UTIMENSAT || HAVE_FUTIMENS */ + +/* Validate the requested timestamps. Return 0 if the resulting + timespec can be used for utimensat (after possibly modifying it to + work around bugs in utimensat). Return a positive value if the + timespec needs further adjustment based on stat results: 1 if any + adjustment is needed for utimes, and 2 if any adjustment is needed + for Linux utimensat. Return -1, with errno set to EINVAL, if + timespec is out of range. */ +static int +validate_timespec (struct timespec timespec[2]) +{ + int result = 0; + int utime_omit_count = 0; + assert (timespec); + if ((timespec[0].tv_nsec != UTIME_NOW + && timespec[0].tv_nsec != UTIME_OMIT + && (timespec[0].tv_nsec < 0 || 1000000000 <= timespec[0].tv_nsec)) + || (timespec[1].tv_nsec != UTIME_NOW + && timespec[1].tv_nsec != UTIME_OMIT + && (timespec[1].tv_nsec < 0 || 1000000000 <= timespec[1].tv_nsec))) + { + errno = EINVAL; + return -1; + } + /* Work around Linux kernel 2.6.25 bug, where utimensat fails with + EINVAL if tv_sec is not 0 when using the flag values of tv_nsec. + Flag a Linux kernel 2.6.32 bug, where an mtime of UTIME_OMIT + fails to bump ctime. */ + if (timespec[0].tv_nsec == UTIME_NOW + || timespec[0].tv_nsec == UTIME_OMIT) + { + timespec[0].tv_sec = 0; + result = 1; + if (timespec[0].tv_nsec == UTIME_OMIT) + utime_omit_count++; + } + if (timespec[1].tv_nsec == UTIME_NOW + || timespec[1].tv_nsec == UTIME_OMIT) + { + timespec[1].tv_sec = 0; + result = 1; + if (timespec[1].tv_nsec == UTIME_OMIT) + utime_omit_count++; + } + return result + (utime_omit_count == 1); +} + +/* Normalize any UTIME_NOW or UTIME_OMIT values in *TS, using stat + buffer STATBUF to obtain the current timestamps of the file. If + both times are UTIME_NOW, set *TS to NULL (as this can avoid some + permissions issues). If both times are UTIME_OMIT, return true + (nothing further beyond the prior collection of STATBUF is + necessary); otherwise return false. */ +static bool +update_timespec (struct stat const *statbuf, struct timespec *ts[2]) +{ + struct timespec *timespec = *ts; + if (timespec[0].tv_nsec == UTIME_OMIT + && timespec[1].tv_nsec == UTIME_OMIT) + return true; + if (timespec[0].tv_nsec == UTIME_NOW + && timespec[1].tv_nsec == UTIME_NOW) + { + *ts = NULL; + return false; + } + + if (timespec[0].tv_nsec == UTIME_OMIT) + timespec[0] = get_stat_atime (statbuf); + else if (timespec[0].tv_nsec == UTIME_NOW) + gettime (×pec[0]); + + if (timespec[1].tv_nsec == UTIME_OMIT) + timespec[1] = get_stat_mtime (statbuf); + else if (timespec[1].tv_nsec == UTIME_NOW) + gettime (×pec[1]); + + return false; +} + +/* Set the access and modification time stamps of FD (a.k.a. FILE) to be + TIMESPEC[0] and TIMESPEC[1], respectively. + FD must be either negative -- in which case it is ignored -- + or a file descriptor that is open on FILE. + If FD is nonnegative, then FILE can be NULL, which means + use just futimes (or equivalent) instead of utimes (or equivalent), + and fail if on an old system without futimes (or equivalent). + If TIMESPEC is null, set the time stamps to the current time. + Return 0 on success, -1 (setting errno) on failure. */ + +int +fdutimens (int fd, char const *file, struct timespec const timespec[2]) +{ + struct timespec adjusted_timespec[2]; + struct timespec *ts = timespec ? adjusted_timespec : NULL; + int adjustment_needed = 0; + struct stat st; + + if (ts) + { + adjusted_timespec[0] = timespec[0]; + adjusted_timespec[1] = timespec[1]; + adjustment_needed = validate_timespec (ts); + } + if (adjustment_needed < 0) + return -1; + + /* Require that at least one of FD or FILE are potentially valid, to avoid + a Linux bug where futimens (AT_FDCWD, NULL) changes "." rather + than failing. */ + if (fd < 0 && !file) + { + errno = EBADF; + return -1; + } + + /* Some Linux-based NFS clients are buggy, and mishandle time stamps + of files in NFS file systems in some cases. We have no + configure-time test for this, but please see + for references to + some of the problems with Linux 2.6.16. If this affects you, + compile with -DHAVE_BUGGY_NFS_TIME_STAMPS; this is reported to + help in some cases, albeit at a cost in performance. But you + really should upgrade your kernel to a fixed version, since the + problem affects many applications. */ + +#if HAVE_BUGGY_NFS_TIME_STAMPS + if (fd < 0) + sync (); + else + fsync (fd); +#endif + + /* POSIX 2008 added two interfaces to set file timestamps with + nanosecond resolution; newer Linux implements both functions via + a single syscall. We provide a fallback for ENOSYS (for example, + compiling against Linux 2.6.25 kernel headers and glibc 2.7, but + running on Linux 2.6.18 kernel). */ +#if HAVE_UTIMENSAT || HAVE_FUTIMENS + if (0 <= utimensat_works_really) + { + int result; +# if __linux__ + /* As recently as Linux kernel 2.6.32 (Dec 2009), several file + systems (xfs, ntfs-3g) have bugs with a single UTIME_OMIT, + but work if both times are either explicitly specified or + UTIME_NOW. Work around it with a preparatory [f]stat prior + to calling futimens/utimensat; fortunately, there is not much + timing impact due to the extra syscall even on file systems + where UTIME_OMIT would have worked. FIXME: Simplify this in + 2012, when file system bugs are no longer common. */ + if (adjustment_needed == 2) + { + if (fd < 0 ? stat (file, &st) : fstat (fd, &st)) + return -1; + if (ts[0].tv_nsec == UTIME_OMIT) + ts[0] = get_stat_atime (&st); + else if (ts[1].tv_nsec == UTIME_OMIT) + ts[1] = get_stat_mtime (&st); + /* Note that st is good, in case utimensat gives ENOSYS. */ + adjustment_needed++; + } +# endif /* __linux__ */ +# if HAVE_UTIMENSAT + if (fd < 0) + { + result = utimensat (AT_FDCWD, file, ts, 0); +# ifdef __linux__ + /* Work around a kernel bug: + http://bugzilla.redhat.com/442352 + http://bugzilla.redhat.com/449910 + It appears that utimensat can mistakenly return 280 rather + than -1 upon ENOSYS failure. + FIXME: remove in 2010 or whenever the offending kernels + are no longer in common use. */ + if (0 < result) + errno = ENOSYS; +# endif /* __linux__ */ + if (result == 0 || errno != ENOSYS) + { + utimensat_works_really = 1; + return result; + } + } +# endif /* HAVE_UTIMENSAT */ +# if HAVE_FUTIMENS + if (0 <= fd) + { + result = futimens (fd, ts); +# ifdef __linux__ + /* Work around the same bug as above. */ + if (0 < result) + errno = ENOSYS; +# endif /* __linux__ */ + if (result == 0 || errno != ENOSYS) + { + utimensat_works_really = 1; + return result; + } + } +# endif /* HAVE_FUTIMENS */ + } + utimensat_works_really = -1; + lutimensat_works_really = -1; +#endif /* HAVE_UTIMENSAT || HAVE_FUTIMENS */ + + /* The platform lacks an interface to set file timestamps with + nanosecond resolution, so do the best we can, discarding any + fractional part of the timestamp. */ + + if (adjustment_needed || (REPLACE_FUNC_STAT_FILE && fd < 0)) + { + if (adjustment_needed != 3 + && (fd < 0 ? stat (file, &st) : fstat (fd, &st))) + return -1; + if (ts && update_timespec (&st, &ts)) + return 0; + } + + { +#if HAVE_FUTIMESAT || HAVE_WORKING_UTIMES + struct timeval timeval[2]; + struct timeval *t; + if (ts) + { + timeval[0].tv_sec = ts[0].tv_sec; + timeval[0].tv_usec = ts[0].tv_nsec / 1000; + timeval[1].tv_sec = ts[1].tv_sec; + timeval[1].tv_usec = ts[1].tv_nsec / 1000; + t = timeval; + } + else + t = NULL; + + if (fd < 0) + { +# if HAVE_FUTIMESAT + return futimesat (AT_FDCWD, file, t); +# endif + } + else + { + /* If futimesat or futimes fails here, don't try to speed things + up by returning right away. glibc can incorrectly fail with + errno == ENOENT if /proc isn't mounted. Also, Mandrake 10.0 + in high security mode doesn't allow ordinary users to read + /proc/self, so glibc incorrectly fails with errno == EACCES. + If errno == EIO, EPERM, or EROFS, it's probably safe to fail + right away, but these cases are rare enough that they're not + worth optimizing, and who knows what other messed-up systems + are out there? So play it safe and fall back on the code + below. */ + +# if (HAVE_FUTIMESAT && !FUTIMESAT_NULL_BUG) || HAVE_FUTIMES +# if HAVE_FUTIMESAT && !FUTIMESAT_NULL_BUG +# undef futimes +# define futimes(fd, t) futimesat (fd, NULL, t) +# endif + if (futimes (fd, t) == 0) + { +# if __linux__ && __GLIBC__ + /* Work around a longstanding glibc bug, still present as + of 2010-12-27. On older Linux kernels that lack both + utimensat and utimes, glibc's futimes rounds instead of + truncating when falling back on utime. The same bug + occurs in futimesat with a null 2nd arg. */ + if (t) + { + bool abig = 500000 <= t[0].tv_usec; + bool mbig = 500000 <= t[1].tv_usec; + if ((abig | mbig) && fstat (fd, &st) == 0) + { + /* If these two subtractions overflow, they'll + track the overflows inside the buggy glibc. */ + time_t adiff = st.st_atime - t[0].tv_sec; + time_t mdiff = st.st_mtime - t[1].tv_sec; + + struct timeval *tt = NULL; + struct timeval truncated_timeval[2]; + truncated_timeval[0] = t[0]; + truncated_timeval[1] = t[1]; + if (abig && adiff == 1 && get_stat_atime_ns (&st) == 0) + { + tt = truncated_timeval; + tt[0].tv_usec = 0; + } + if (mbig && mdiff == 1 && get_stat_mtime_ns (&st) == 0) + { + tt = truncated_timeval; + tt[1].tv_usec = 0; + } + if (tt) + futimes (fd, tt); + } + } +# endif + + return 0; + } +# endif + } +#endif /* HAVE_FUTIMESAT || HAVE_WORKING_UTIMES */ + + if (!file) + { +#if ! ((HAVE_FUTIMESAT && !FUTIMESAT_NULL_BUG) \ + || (HAVE_WORKING_UTIMES && HAVE_FUTIMES)) + errno = ENOSYS; +#endif + return -1; + } + +#if HAVE_WORKING_UTIMES + return utimes (file, t); +#else + { + struct utimbuf utimbuf; + struct utimbuf *ut; + if (ts) + { + utimbuf.actime = ts[0].tv_sec; + utimbuf.modtime = ts[1].tv_sec; + ut = &utimbuf; + } + else + ut = NULL; + + return utime (file, ut); + } +#endif /* !HAVE_WORKING_UTIMES */ + } +} + +/* Set the access and modification time stamps of FILE to be + TIMESPEC[0] and TIMESPEC[1], respectively. */ +int +utimens (char const *file, struct timespec const timespec[2]) +{ + return fdutimens (-1, file, timespec); +} + +/* Set the access and modification time stamps of FILE to be + TIMESPEC[0] and TIMESPEC[1], respectively, without dereferencing + symlinks. Fail with ENOSYS if the platform does not support + changing symlink timestamps, but FILE was a symlink. */ +int +lutimens (char const *file, struct timespec const timespec[2]) +{ + struct timespec adjusted_timespec[2]; + struct timespec *ts = timespec ? adjusted_timespec : NULL; + int adjustment_needed = 0; + struct stat st; + + if (ts) + { + adjusted_timespec[0] = timespec[0]; + adjusted_timespec[1] = timespec[1]; + adjustment_needed = validate_timespec (ts); + } + if (adjustment_needed < 0) + return -1; + + /* The Linux kernel did not support symlink timestamps until + utimensat, in version 2.6.22, so we don't need to mimic + fdutimens' worry about buggy NFS clients. But we do have to + worry about bogus return values. */ + +#if HAVE_UTIMENSAT + if (0 <= lutimensat_works_really) + { + int result; +# if __linux__ + /* As recently as Linux kernel 2.6.32 (Dec 2009), several file + systems (xfs, ntfs-3g) have bugs with a single UTIME_OMIT, + but work if both times are either explicitly specified or + UTIME_NOW. Work around it with a preparatory lstat prior to + calling utimensat; fortunately, there is not much timing + impact due to the extra syscall even on file systems where + UTIME_OMIT would have worked. FIXME: Simplify this in 2012, + when file system bugs are no longer common. */ + if (adjustment_needed == 2) + { + if (lstat (file, &st)) + return -1; + if (ts[0].tv_nsec == UTIME_OMIT) + ts[0] = get_stat_atime (&st); + else if (ts[1].tv_nsec == UTIME_OMIT) + ts[1] = get_stat_mtime (&st); + /* Note that st is good, in case utimensat gives ENOSYS. */ + adjustment_needed++; + } +# endif /* __linux__ */ + result = utimensat (AT_FDCWD, file, ts, AT_SYMLINK_NOFOLLOW); +# ifdef __linux__ + /* Work around a kernel bug: + http://bugzilla.redhat.com/442352 + http://bugzilla.redhat.com/449910 + It appears that utimensat can mistakenly return 280 rather + than -1 upon ENOSYS failure. + FIXME: remove in 2010 or whenever the offending kernels + are no longer in common use. */ + if (0 < result) + errno = ENOSYS; +# endif + if (result == 0 || errno != ENOSYS) + { + utimensat_works_really = 1; + lutimensat_works_really = 1; + return result; + } + } + lutimensat_works_really = -1; +#endif /* HAVE_UTIMENSAT */ + + /* The platform lacks an interface to set file timestamps with + nanosecond resolution, so do the best we can, discarding any + fractional part of the timestamp. */ + + if (adjustment_needed || REPLACE_FUNC_STAT_FILE) + { + if (adjustment_needed != 3 && lstat (file, &st)) + return -1; + if (ts && update_timespec (&st, &ts)) + return 0; + } + + /* On Linux, lutimes is a thin wrapper around utimensat, so there is + no point trying lutimes if utimensat failed with ENOSYS. */ +#if HAVE_LUTIMES && !HAVE_UTIMENSAT + { + struct timeval timeval[2]; + struct timeval *t; + int result; + if (ts) + { + timeval[0].tv_sec = ts[0].tv_sec; + timeval[0].tv_usec = ts[0].tv_nsec / 1000; + timeval[1].tv_sec = ts[1].tv_sec; + timeval[1].tv_usec = ts[1].tv_nsec / 1000; + t = timeval; + } + else + t = NULL; + + result = lutimes (file, t); + if (result == 0 || errno != ENOSYS) + return result; + } +#endif /* HAVE_LUTIMES && !HAVE_UTIMENSAT */ + + /* Out of luck for symlinks, but we still handle regular files. */ + if (!(adjustment_needed || REPLACE_FUNC_STAT_FILE) && lstat (file, &st)) + return -1; + if (!S_ISLNK (st.st_mode)) + return fdutimens (-1, file, ts); + errno = ENOSYS; + return -1; +} diff --git a/lib/utimens.h b/lib/utimens.h new file mode 100644 index 00000000000..8c47cf93f88 --- /dev/null +++ b/lib/utimens.h @@ -0,0 +1,19 @@ +#include +int fdutimens (int, char const *, struct timespec const [2]); +int utimens (char const *, struct timespec const [2]); +int lutimens (char const *, struct timespec const [2]); + +#if GNULIB_FDUTIMENSAT +# include +# include + +int fdutimensat (int fd, int dir, char const *name, struct timespec const [2], + int atflag); + +/* Using this function makes application code slightly more readable. */ +static inline int +lutimensat (int dir, char const *file, struct timespec const times[2]) +{ + return utimensat (dir, file, times, AT_SYMLINK_NOFOLLOW); +} +#endif diff --git a/lib/verify.h b/lib/verify.h index cef14ad1571..0c320b19ad4 100644 --- a/lib/verify.h +++ b/lib/verify.h @@ -125,7 +125,7 @@ extern int (*dummy (void)) [sizeof (struct {...})]; * GCC warns about duplicate declarations of the dummy function if - -Wredundant_decls is used. GCC 4.3 and later have a builtin + -Wredundant-decls is used. GCC 4.3 and later have a builtin __COUNTER__ macro that can let us generate unique identifiers for each dummy function, to suppress this warning. @@ -133,6 +133,10 @@ which do not support _Static_assert, also do not warn about the last declaration mentioned above. + * GCC warns if -Wnested-externs is enabled and verify() is used + within a function body; but inside a function, you can always + arrange to use verify_expr() instead. + * In C++, any struct definition inside sizeof is invalid. Use a template type to work around the problem. */ diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5eac93fa444..5e848134cb2 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,1222 @@ +2012-07-26 Eli Zaretskii + + * makefile.w32-in ($(lisp)/calendar/cal-loaddefs.el) + ($(lisp)/calendar/diary-loaddefs.el) + ($(lisp)/calendar/hol-loaddefs.el, $(lisp)/mh-e/mh-loaddefs.el) + ($(lisp)/net/tramp-loaddefs.el): Depend on update-subdirs. Fixes + failures in parallel bootstrap because subdirs.el is being + rewritten while the autoload files are built at the same time, + which needs to load subdirs.el. + +2012-07-26 Martin Rudalics + + * mouse.el (popup-menu): Fix doc-string and re-indent code. + (mouse-drag-line): Don't exit tracking when a switch-frame or + switch-window event occurs (Bug#12006). + +2012-07-26 Stefan Monnier + + * mouse.el (popup-menu): Fix last change. + +2012-07-26 Stefan Monnier + + Autoload from Lisp with more care. Follow aliases when looking for + function properties. + * subr.el (autoloadp): New function. + (symbol-file): Use it. + (function-get): New function. + * emacs-lisp/macroexp.el (macroexp--expand-all): Use function-get and + autoload-do-load. + * emacs-lisp/lisp-mode.el (lisp-font-lock-syntactic-face-function) + (lisp-indent-function): + * emacs-lisp/gv.el (gv-get): + * emacs-lisp/edebug.el (get-edebug-spec, edebug-basic-spec): + * emacs-lisp/byte-opt.el (byte-optimize-form): + * emacs-lisp/bytecomp.el (byte-compile-arglist-warn): + * emacs-lisp/autoload.el (make-autoload, autoload-print-form): + Use function-get. + * emacs-lisp/cl.el: Don't propagate function properties any more. + + * speedbar.el (speedbar-add-localized-speedbar-support): + * emacs-lisp/disass.el (disassemble-internal): + * desktop.el (desktop-load-file): + * help-fns.el (help-function-arglist, find-lisp-object-file-name) + (describe-function-1): + * emacs-lisp/find-func.el (find-function-noselect): + * emacs-lisp/elp.el (elp-instrument-function): + * emacs-lisp/advice.el (ad-has-proper-definition): + * apropos.el (apropos-safe-documentation, apropos-macrop): + * emacs-lisp/debug.el (debug-on-entry): + * emacs-lisp/cl-macs.el (cl-compiler-macroexpand): + * emacs-lisp/byte-opt.el (byte-compile-inline-expand): + * calc/calc.el (name): Use autoloadp & autoload-do-load. + +2012-07-25 Alp Aker + + * international/mule-cmds.el (ucs-insert): Mark it as an obsolete + function, not an obsolete variable (Bug#12046). + +2012-07-25 Andreas Schwab + + * faces.el (face-spec-reset-face): Fix last change. (Bug#12042) + +2012-07-25 Christopher Schmidt + + * emacs-lisp/pp.el (pp-display-expression): Select old selected + window only if it is still live (Bug#12034). + +2012-07-25 Martin Rudalics + + * subr.el (redirect-frame-focus): Add advertised calling + convention (Bug#12030). + +2012-07-25 Paul Eggert + + Prefer typical American spelling for "acknowledgment". + * vc/add-log.el (change-log-acknowledgment): Rename from + change-log-acknowledgement, with an alias for the old name. + +2012-07-25 Jay Belanger + + * calc-alg.el (math-simplify-divide): Don't cross multiply + in an equation when the lhs is a variable. + +2012-07-24 Julien Danjou + + * net/netrc.el (netrc-find-service-number, netrc-store-data): + Remove, unused. + +2012-07-23 Eli Zaretskii + + * startup.el (command-line): Don't display an empty user name in + the error message about non-existent home directory, when + init-file-user was set to an empty string. See + http://lists.gnu.org/archive/html/bug-gnu-emacs/2012-07/msg00835.html + for the details and context. + +2012-07-22 Vincent Belaïche + + * ses.el (ses-cell-formula-aset): New macro. + (ses-cell-references-aset): New macro. + (ses-cell-p): New function. + (ses-rename-cell): Do no longer rely on complex operations like + ses-cell-set-formula or ses-set-cell to change the cell and handle + the undo at the same time, but rather use lower level new macros + `ses-cell-formula-aset' and `ses-cell-references-aset' and handle + the undo directly. Refresh the mode line. + +2012-07-21 Leo Liu + + * progmodes/cc-cmds.el (c-defun-name): + Use match-string-no-properties instead for consistency. + +2012-07-20 Leo Liu + + * progmodes/cc-cmds.el (c-defun-name): Handle objc selectors properly. + (Bug#7879) + + * progmodes/cc-langs.el (c-symbol-start): Include char _ (bug#11986). + +2012-07-20 Stefan Monnier + + * userlock.el, emacs-lisp/map-ynp.el: Declare part of `emacs' package. + * progmodes/bug-reference.el, misearch.el: Provide themselves + (bug#11915). + + * progmodes/cperl-mode.el (cperl-unwind-to-safe): Don't inf-loop at end + of narrowed buffer (bug#11966). + +2012-07-20 Vincent Belaïche + + * ses.el (ses-rename-cell): Set new name also in reference list of + cells of which the renamed cell depends. + +2012-07-20 Masatake YAMATO + + * term/x-win.el (x-menu-bar-open): Use `frame-parameter' + to check whether menu-bar is shown or not. If not shown, + show the menu-bar as a popup menu instead of using tmm. + * mouse.el (popup-menu): Accept `point' as `position' argument. + +2012-07-20 Dmitry Gutov + + * progmodes/ruby-mode.el (ruby-parse-partial): No error when end + up inside string symbol literal (bug#11923). + +2012-07-20 Eli Zaretskii + + * startup.el (fancy-startup-text): Read the whole tutorial, not + just its first 256 bytes. Prevents gibberish in display of the + tutorial title. + +2012-07-20 Dmitry Antipov + + Drop idle buffer compaction due to an absence of the + proved efficiency. + * compact.el: Remove. + +2012-07-19 Sam Steingold + + * vc/vc-dispatcher.el (vc-compilation-mode): Add, based on + vc-bzr-pull & vc-bzr-merge-branch. + * vc/vc-bzr.el (vc-bzr-pull, vc-bzr-merge-branch): Use it. + (vc-bzr-error-regexp-alist): Rename from vc-bzr-error-regex-alist + for consistency with compilation-error-regexp-alist. + * vc/vc-git.el (vc-git-error-regexp-alist): Add. + (vc-git-pull, vc-git-merge-branch): Call vc-compilation-mode. + * vc/vc-hg.el (vc-hg-error-regexp-alist): Add. + (vc-hg-pull, vc-hg-merge-branch): Call vc-compilation-mode. + +2012-07-19 Stefan Monnier + + * emacs-lisp/chart.el: Use lexical-binding. + (chart-emacs-storage): Don't hardcode the list of entries. + +2012-07-19 Dmitry Antipov + + Next round of tweaks caused by Fgarbage_collect changes. + * emacs-lisp/chart.el (chart-emacs-storage): Adjust again. + +2012-07-19 Dmitry Antipov + + Compact buffers when idle. + * compact.el: New file. + +2012-07-19 Stefan Monnier + + * subr.el (eventp): Presume that if it looks vaguely like an event, + it's an event (bug#10190). + +2012-07-19 Fabián Ezequiel Gallina + + Enhancements to ppss related code (thanks Stefan). + * progmodes/python.el (python-indent-context) + (python-indent-calculate-indentation, python-indent-dedent-line) + (python-indent-electric-colon, python-nav-forward-block) + (python-mode-abbrev-table) + (python-info-assignment-continuation-line-p): Simplify checks + for ppss context. + (python-info-continuation-line-p): Cleanup. + (python-info-ppss-context): Do not catch 'quote. + (python-info-ppss-context-type) + (python-info-ppss-comment-or-string-p): Simplify. + +2012-07-18 Fabián Ezequiel Gallina + + * progmodes/python.el: Enhancements to eldoc support. + (python-info-current-symbol): New function. + (python-eldoc-at-point): Use python-info-current-symbol. + (python-info-current-defun): Fix cornercase on first defun scan. + (python-eldoc--get-doc-at-point): Use python-info-current-symbol + and signal error when no inferior python process is available. + +2012-07-18 Dmitry Gutov + + * vc/vc-git.el (vc-git-state): Don't call `vc-git-registered', + assume it's always t. + (vc-git-registered): Remove caching, the function is only called + once. + (vc-git-branches): Use `vc-git--call' instead of `call-process'. + +2012-07-18 Chong Yidong + + * subr.el (last-input-char, last-command-char): Remove (Bug#9195). + + * simple.el (count-words): Report on narrowing (Bug#9959). + + * bindings.el: Bind M-= to count-words. + + * faces.el (face-spec-reset-face): Handle reverse video (Bug#4238). + +2012-07-18 Masatake YAMATO + + * progmodes/sh-script.el (sh-imenu-generic-expression): + Capture a function with `function' keyword and without parentheses + like "function FOO" (bug#11856). + +2012-07-18 Tassilo Horn + + * window.el (split-window-sensibly): Make WINDOW argument + optional. + +2012-07-18 Chong Yidong + + * subr.el (keyboard-translate): Doc fix (Bug#7261). + + * isearch.el (isearch-mode-map): Handle C-x 8 key translations, + and make C-x 8 RET exit isearch (Bug#11439). + + * international/iso-transl.el: Move isearch-mode-map key + definitions to isearch.el. + +2012-07-18 Stefan Monnier + + * emacs-lisp/eieio.el: Adapt further to gv.el (bug#11970). + (eieio-defclass): Use gv-define-setter when possible. + +2012-07-18 Dmitry Antipov + + Reflect recent changes in Fgarbage_collect. + * emacs-lisp/chart.el (chart-emacs-storage): Change to + reflect new format of data returned by Fgarbage_collect. + +2012-07-17 Fabián Ezequiel Gallina + + New utility functions + python-info-ppss-context fix (Bug#11910). + * progmodes/python.el (python-info-beginning-of-block-statement-p) + (python-info-ppss-comment-or-string-p): New functions. + (python-info-ppss-context): Small fix for string check. + +2012-07-17 Juri Linkov + + * dired-aux.el (dired-do-async-shell-command): Doc fix. + (dired-do-async-shell-command): Don't add `*' at the end of the + command (Bug#11815). + (dired-do-shell-command): Doc fix. + (dired-shell-stuff-it): Strip the trailing "&" and ";" if any. + Join the individual commands using either "&" or ";" as the + separator depending on the values of these trailing characters. + At the end re-add the trailing "&". (Bug#10598) + + * simple.el (async-shell-command): Sync the interactive spec with + `shell-command'. Doc fix. + (shell-command): Doc fix. + +2012-07-17 Juri Linkov + + * descr-text.el (describe-char): Fix format args. (Bug#10129) + +2012-07-17 Fabián Ezequiel Gallina + + Final renames and doc fixes for movement commands (bug#11899). + * progmodes/python.el (python-nav-beginning-of-statement): + Rename from python-nav-statement-start. + (python-nav-end-of-statement): Rename from + python-nav-statement-end. + (python-nav-beginning-of-block): Rename from + python-nav-block-start. + (python-nav-end-of-block): Rename from python-nav-block-end. + +2012-07-17 Fabián Ezequiel Gallina + + * progmodes/python.el (python-shell-send-string-no-output): + Allow accept-process-output to quit, keeping shell process ready for + future interactions (Bug#11868). + +2012-07-17 Stefan Monnier + + * emacs-lisp/cl-macs.el (cl-progv): Use a properly prefixed var name. + + * emacs-lisp/elint.el (elint-find-args-in-code): + Use help-function-arglist, so as to handle lexical byte-code. + + * progmodes/sh-script.el (sh-syntax-propertize-function): Fix last + change (bug#11826). + +2012-07-17 Stefan Monnier + + * progmodes/cc-engine.el (c-forward-sws, c-backward-sws): + Avoid spuriously marking the buffer as modified because of c-is-sws. + + * progmodes/sh-script.el (sh-syntax-propertize-function): Mark "${#VAR" + as not-a-comment (bug#11946). + + * emacs-lisp/macroexp.el (macroexp-let2): Use more informative names + for uninterned vars. + + * xt-mouse.el (xterm-mouse-translate-1, xterm-mouse-event-read): + Use read-event since we don't really want to read chars but bytes. + + * textmodes/tex-mode.el (tex-font-lock-keywords-1): Highlight not only + $$..$$ but also $..$ using regexps (bug#11953). + Use tex-verbatim for \url and \path. + (tex-font-lock-keywords): Define as defconst like the others. + (tex-common-initialization): Don't use font-lock-syntax-table any more. + +2012-07-16 René Kyllingstad (tiny change) + + * international/mule-cmds.el (ucs-insert): Make it an obsolete + alias for insert-char. + +2012-07-16 Fabián Ezequiel Gallina + + * progmodes/python.el: Simplified imenu implementation. + (python-nav-jump-to-defun): Remove command. + (python-mode-map): Use `imenu' instead. + (python-nav-list-defun-positions-cache) + (python-imenu-include-defun-type, python-imenu-make-tree) + (python-imenu-subtree-root-label, python-imenu-index-alist): + Remove vars. + (python-nav-list-defun-positions, python-nav-read-defun) + (python-imenu-tree-assoc, python-imenu-make-element-tree) + (python-imenu-make-tree, python-imenu-create-index): + Remove functions. + (python-mode): Update to interact with imenu by setting + `imenu-extract-index-name-function' only. + +2012-07-16 Fabián Ezequiel Gallina + + * progmodes/python.el: Enhancements to navigation commands. + (python-nav-backward-sentence) + (python-nav-forward-sentence): Remove. + (python-nav-backward-statement, python-nav-forward-statement) + (python-nav-statement-start, python-nav-statement-end) + (python-nav-backward-block, python-nav-forward-block) + (python-nav-block-start, python-nav-block-end) + (python-nav-forward-sexp-function) + (python-info-current-line-comment-p) + (python-info-current-line-empty-p): New functions. + (python-indent-context): Use `python-nav-statement-start'. + +2012-07-16 Michael Albinus + + * eshell/em-ls.el (eshell/ls): Use `apply'. + + * eshell/em-unix.el (eshell/su, eshell/sudo): Apply Tramp's ad-hoc + multi-hops, instead of Tramp internals. + + * vc/ediff.el (ediff-directories): Add trailing space to prompts. + + * vc/ediff-diff.el (ediff-same-file-contents): Handle the case, + when F1 and F2 are located on different hosts. + +2012-07-14 Chong Yidong + + * xt-mouse.el: Implement extended mouse coordinates (Bug#10642). + (xterm-mouse-translate): Move code into xterm-mouse-translate-1. + (xterm-mouse-translate-extended, xterm-mouse-translate-1) + (xterm-mouse--read-event-sequence-1000) + (xterm-mouse--read-event-sequence-1006): New functions. For old + mouse protocol, handle M-mouse-X events correctly. + (xterm-mouse-event): New arg specifying mouse protocol. + (turn-on-xterm-mouse-tracking-on-terminal) + (turn-off-xterm-mouse-tracking-on-terminal): Send DEC 1006 + sequence to toggle extended coordinates on newer XTerms. + This appears to be harmless on terminals which do not support this. + +2012-07-14 Leo Liu + + Add fringe bitmap indicators for flymake. (Bug#11253) + * progmodes/flymake.el (flymake-highlight-line): Use fringe bitmaps. + (flymake-make-overlay): New arg BITMAP. + (flymake-error-bitmap, flymake-warning-bitmap) + (flymake-fringe-indicator-position): New user variables. + + * fringe.el: New bitmap exclamation-mark. + +2012-07-14 Jan Djärv + + * progmodes/cc-cmds.el (c-defun-name): Recognize Objective-C methods + also (Bug#7879). + +2012-07-14 Chong Yidong + + * electric.el (electric-pair-post-self-insert-function): Fix pair + insertion in empty-region case (Bug#11520). + +2012-07-14 Chong Yidong + + * bindings.el: Consolidate ctl-x-r-map bindings. + Bind copy-rectangle-as-kill to C-x r w. + + * rect.el, register.el: Move bindings to bindings.el. + +2012-07-14 Reuben Thomas + + * rect.el (copy-rectangle-as-kill): New command (Bug#739). + +2012-07-13 Andreas Schwab + + * emacs-lisp/cl.el (labels): Remove spurious quote. (Bug#11938) + +2012-07-13 Juanma Barranquero + + * bindings.el (top): Use `mapc' instead of `mapcar'. + + * loadup.el (top): Remove bogus `if' choice (brought by 2008-06-21T01:38:39Z!monnier@iro.umontreal.ca). + +2012-07-13 Michael Albinus + + * progmodes/sql.el (sql-comint): Suppress the check for program on + remote hosts. Reported by Francis Devereux . + (Bug#11908) + +2012-07-13 Chong Yidong + + * bindings.el: Assign a non-nil permanent-local property to + per-buffer variables which lack a default value (Bug#11930). + + * help-fns.el (describe-variable): In the "automatically becomes + local" notice, take note of permanent-local variables. + +2012-07-13 Chong Yidong + + * files.el (toggle-read-only): Doc fix and code cleanup. New arg + to allow printing the message when called from Lisp. + + * emacs-lisp/bytecomp.el (byte-compile-interactive-only-functions): + Remove toggle-read-only. + + * bs.el (bs-toggle-readonly): + * buff-menu.el (Buffer-menu-toggle-read-only): + Remove with-no-warnings around toggle-read-only. + + * ffap.el (ffap--toggle-read-only): Accept a list of buffers. + Remove with-no-warnings around toggle-read-only. + (ffap-read-only, ffap-read-only-other-window) + (ffap-read-only-other-frame): Callers changed. + + * help-mode.el: Don't require view package. + (help-mode-finish): Set buffer-read-only instead of calling + toggle-read-only. + + * bindings.el (mode-line-toggle-read-only): + * dired.el (dired-toggle-read-only): + * ibuffer.el (ibuffer-do-toggle-read-only): Call toggle-read-only + with non-nil second arg. + + * emacs-lisp/eieio-custom.el (eieio-customize-object): + * vc/ediff.el (ediff-set-read-only-in-buf-A): Set buffer-read-only + directly. + +2012-07-12 Eli Zaretskii + + * emacs-lisp/bytecomp.el (byte-recompile-directory): Use cl-incf, + not incf. + +2012-07-11 Stefan Monnier + + More CL cleanups and reduction of use of cl.el. + * woman.el, winner.el, vc/vc-rcs.el, vc/vc-hooks.el, vc/vc-hg.el: + * vc/vc-git.el, vc/vc-dir.el, vc/vc-bzr.el, vc/vc-annotate.el: + * textmodes/tex-mode.el, textmodes/sgml-mode.el, tar-mode.el: + * strokes.el, ses.el, server.el, progmodes/js.el, progmodes/gdb-mi.el: + * progmodes/flymake.el, progmodes/ebrowse.el, progmodes/compile.el: + * play/tetris.el, play/snake.el, play/pong.el, play/landmark.el: + * play/hanoi.el, play/decipher.el, play/5x5.el, nxml/nxml-mode.el: + * net/secrets.el, net/quickurl.el, midnight.el, mail/footnote.el: + * image-dired.el, ibuffer.el, ibuf-macs.el, ibuf-ext.el, hexl.el: + * eshell/eshell.el, eshell/esh-io.el, eshell/esh-ext.el: + * eshell/esh-cmd.el, eshell/em-ls.el, eshell/em-hist.el: + * eshell/em-cmpl.el, eshell/em-banner.el: + * calendar/parse-time.el: Use cl-lib. + * wid-browse.el, wdired.el, vc/vc.el, vc/vc-mtn.el, vc/vc-cvs.el: + * vc/vc-arch.el, tree-widget.el, textmodes/texinfo.el: + * textmodes/refill.el, textmodes/css-mode.el, term/tvi970.el: + * term/ns-win.el, term.el, shell.el, ps-samp.el: + * progmodes/perl-mode.el, progmodes/pascal.el, progmodes/gud.el: + * progmodes/glasses.el, progmodes/etags.el, progmodes/cwarn.el: + * play/gamegrid.el, play/bubbles.el, novice.el, notifications.el: + * net/zeroconf.el, net/xesam.el, net/snmp-mode.el, net/mairix.el: + * net/ldap.el, net/eudc.el, net/browse-url.el, man.el: + * mail/mailheader.el, mail/feedmail.el: Don't use CL. + * ibuf-ext.el (ibuffer-mark-old-buffers): Use float-time. + * eshell/esh-opt.el (eshell-eval-using-options): Quote code with + `lambda' rather than with `quote'. + (eshell-do-opt): Adjust accordingly. + (eshell-process-option): Simplify. + * eshell/esh-var.el: + * eshell/em-script.el: Require `esh-opt' for eshell-eval-using-options. + * emacs-lisp/pcase.el (pcase--dontcare-upats, pcase--let*) + (pcase--expand, pcase--u1): Rename pcase's internal `dontcare' pattern + to `pcase--dontcare'. + * emacs-lisp/cl.el (labels): Mark obsolete. + (cl--letf, letf): Move to cl-lib. + (cl--letf*, letf*): Remove. + * emacs-lisp/cl-lib.el (cl-nth-value): Use defalias. + * emacs-lisp/cl-macs.el (cl-dolist, cl-dotimes): Add indent rule. + (cl-progv): Rewrite. + (cl--letf, cl-letf): Move from cl.el. + (cl-letf*): New macro. + * emacs-lisp/cl-extra.el (cl--progv-before, cl--progv-after): Remove. + +2012-07-11 Michael Albinus + + * net/ange-ftp.el (ange-ftp-cf1): Update the files cache. + +2012-07-11 Chong Yidong + + * vc/log-edit.el (log-edit-vc-backend): New variable. + (log-edit): Doc fix. + + * vc/vc-dispatcher.el (vc-log-edit): New args. Use PARAMS + argument of log-edit to set up all local variables. + (vc-start-logentry): New optional arg specifying VC backend. + + * vc/vc.el (vc-checkin): Use it. + (vc-deduce-fileset): Handle Log Edit buffers. + (vc-diff): Make first argument optional too. + + * vc/log-view.el (log-view-vc-fileset, log-view-vc-backend): Doc fix. + +2012-07-10 Michael Albinus + + * eshell/esh-ext.el (eshell-remote-command): Remove remote part of + command, just in case. The function is not needed anymore. + (eshell-external-command): Do not call `eshell-remote-command'. + +2012-07-10 Stefan Monnier + + Reduce use of (require 'cl). + * vc/smerge-mode.el, vc/pcvs.el, vc/pcvs-util.el, vc/pcvs-info.el: + * vc/diff-mode.el, vc/cvs-status.el, uniquify.el, scroll-bar.el: + * register.el, progmodes/sh-script.el, net/gnutls.el, net/dbus.el: + * msb.el, mpc.el, minibuffer.el, international/ucs-normalize.el: + * international/quail.el, info-xref.el, imenu.el, image-mode.el: + * font-lock.el, filesets.el, edmacro.el, doc-view.el, bookmark.el: + * battery.el, avoid.el, abbrev.el: Use cl-lib. + * vc/pcvs-parse.el, vc/pcvs-defs.el, vc/log-view.el, vc/log-edit.el: + * vc/diff.el, simple.el, pcomplete.el, lpr.el, comint.el, loadhist.el: + * jit-lock.el, international/iso-ascii.el, info.el, frame.el, bs.el: + * emulation/crisp.el, electric.el, dired.el, cus-dep.el, composite.el: + * calculator.el, autorevert.el, apropos.el: Don't require CL. + * emacs-lisp/bytecomp.el (byte-recompile-directory, display-call-tree) + (byte-compile-unfold-bcf, byte-compile-check-variable): + * emacs-lisp/byte-opt.el (byte-compile-trueconstp) + (byte-compile-nilconstp): + * emacs-lisp/autoload.el (make-autoload): Use pcase. + * face-remap.el (text-scale-adjust): Simplify pcase patterns. + + * emacs-lisp/gv.el (cond): Make it a valid place. + (if): Simplify slightly. + + * emacs-lisp/pcase.el (pcase): Accept self-quoting exps as "upatterns". + (pcase--self-quoting-p): New function. + (pcase--u1): Use it. + +2012-07-10 Glenn Morris + + * emacs-lisp/authors.el (authors-fixed-entries): + (authors-renamed-files-alist): Update for configure.in -> configure.ac. + +2012-07-09 Paul Eggert + + Rename configure.in to configure.ac (Bug#11603). + * emacs-lisp/authors.el (authors-canonical-file-name): + * progmodes/autoconf.el (autoconf-mode): + Prefer configure.ac to configure.in. + +2012-07-08 Chong Yidong + + * mouse.el (mouse-drag-line): Rewrite the track-mouse loop. + Implement the mouse-1-click-follows-link handling properly. + + * info.el (Info-link-keymap): Use follow-link mechanism for + header-line links (Bug#374). + + * simple.el (deactivate-mark): Do not set the primary selection + if another program has acquired it (Bug#11772). + +2012-07-07 Kevin Ryde + + * woman.el (woman-strings): Fix double-quote handling (Bug#1151). + (woman-decode-region): Replace escaped-escapes without destroying + bold or underline (Bug#11552). + (woman2-process-escapes): Handle nofill regions (Bug#11591). + +2012-07-07 Chong Yidong + + * simple.el (yank-pop-change-selection): Doc fix (Bug#11361). + (interprogram-cut-function, interprogram-paste-function): + Mention that we typically mean the clipboard. + +2012-07-06 Glenn Morris + + * kmacro.el (kmacro-call-macro): Restore repeat message. (Bug#11817) + + * files.el (toggle-read-only): Restrict message to interactive use. + +2012-07-06 Michael Albinus + + * net/tramp.el (tramp-restricted-shell-hosts-alist): New defcustom. + + * net/tramp-sh.el (tramp-maybe-open-connection): Handle it. + +2012-07-06 Glenn Morris + + * Makefile.in (compile-one-process): Rename from "recompile". + + * Makefile.in (bzr-update): "compile" is the same as "recompile + autoloads", but parallelizable, so use that instead. + +2012-07-06 Dmitry Gutov + + * window.el (quit-window): Always restore window height when + it's saved in quit-restore parameter (Bug#11810). + +2012-07-06 Glenn Morris + + * simple.el (kill-whole-line): Doc tweak. + +2012-07-06 Eli Zaretskii + + * files.el (file-relative-name): Compare file names + case-insensitively if on MS-Windows or MS-DOS, or if + read-file-name-completion-ignore-case is non-nil. Don't use + case-fold-search for this purpose. (Bug#11827) + +2012-07-17 Andreas Schwab + + * calendar/cal-dst.el (calendar-current-time-zone): + Return calendar-current-time-zone-cache if non-nil. + +2012-07-17 Masatake YAMATO +2012-07-06 Andreas Schwab + + * calendar/cal-dst.el (calendar-current-time-zone): + Return calendar-current-time-zone-cache if non-nil. + +2012-07-06 Glenn Morris + + * Makefile.in (cvs-update): Remove old alias. + +2012-07-05 Michael Albinus + + Sync with Tramp 2.2.6-pre. + + * net/tramp.el (tramp-drop-volume-letter): Provide an XEmacs + compatible declaration. + + * net/tramp-cmds.el (tramp-append-tramp-buffers): + Protect `list-load-path-shadows' call. + + * net/tramp-compat.el (top): Require packages, which aren't + autoloaded anymore for XEmacs. Protect call of + `tramp-file-name-handler' by `tramp-compat-funcall', pacifying the + compiler. Do not require tramp-util.el and tramp-vc.el anymore, + it hurts at least for SXEmacs. + (tramp-compat-temporary-file-directory): In XEmacs, there is no + standard-value for `temporary-file-directory'. + + * net/tramp-sh.el (tramp-do-directory-files-and-attributes-with-stat): + Redirect stderr to /dev/null. + (tramp-sh-handle-write-region): uid and gid can be floats. + Reported by Russell Sim . + (tramp-sh-handle-vc-registered): Hide errors. + (tramp-vc-file-name-handler): Use dummy results for `process-file' + and `start-file-process'. + (tramp-maybe-open-connection): Check also whether `non-essential' + is bound. + +2012-07-04 Chong Yidong + + * xml.el (xml--parse-buffer): Use xml-syntax-table. + (xml-parse-tag): Likewise, and avoid changing entity tables. + (xml-syntax-table): Define from scratch, making sure not to give + x2000 and other Unicode spaces whitespace syntax, since those are + not spaces in XML. + (xml-parse-fragment): Delete unused function. + (xml-name-start-char-re, xml-name-char-re, xml-name-re) + (xml-names-re, xml-nmtoken-re, xml-nmtokens-re, xml-char-ref-re) + (xml-entity-ref, xml-pe-reference-re) + (xml-reference-re,xml-att-value-re, xml-tokenized-type-re) + (xml-notation-type-re, xml-enumeration-re, xml-enumerated-type-re) + (xml-att-type-re, xml-default-decl-re, xml-att-def-re) + (xml-entity-value-re): Use syntax references in regexps where + possible; no need to define inside a let-binding. + (xml-parse-dtd): Use xml-pe-reference-re. + (xml-entity-or-char-ref-re): New defconst. + (xml-parse-string, xml-substitute-special): Use it. + +2012-07-04 Stefan Monnier + + * files.el (locate-dominating-file): Allow `name' to be a predicate. + (find-file--read-only): New function. + (find-file-read-only, find-file-read-only-other-window) + (find-file-read-only-other-frame): Use it. + (insert-file-contents-literally): Don't `fset'. + (get-free-disk-space): Use locate-dominating-file. + + * emacs-lisp/bytecomp.el (byte-compile): Don't signal an error if the + function is already compiled. + + * xml.el (xml-name-regexp): Remove, redundant. Use xml-name-re. + +2012-07-03 Michael Albinus + + * vc/ediff-diff.el (ediff-same-file-contents): Fix it for remote + files on the same host. + +2012-07-03 Andreas Schwab + + * help-fns.el (describe-function-1): Only call + help-fns--autoloaded-p when we have a file name. (Bug#11848) + +2012-07-03 Chong Yidong + + * xml.el: Protect parser against XML bombs. + (xml-entity-expansion-limit): New variable. + (xml-parse-string, xml-substitute-special): Use it. + (xml-parse-dtd): Avoid infloop if the DTD is not terminated. + +2012-07-03 Glenn Morris + + * progmodes/bug-reference.el (bug-reference-bug-regexp): + Allow linking to specific messages in debbugs reports (eg 123#5). + +2012-07-02 Chong Yidong + + * xml.el: Fix entity and character reference expansion, allowing + them to expand into markup as per XML spec. + (xml-default-ns): New variable. + (xml-entity-alist): Use XML spec definitions for lt and amp. + (xml-parse-region): Make first two arguments optional. + Discard text properties. + (xml-parse-tag-1): New function, spun off from xml-parse-tag. + All callers changed. + (xml-parse-tag): Call xml-parse-tag-1. For backward + compatibility, this function should not modify buffer contents. + (xml-parse-tag-1): Fix opening-tag regexp. + (xml-parse-string): Rewrite, handling entity and character + references properly. + (xml--entity-replacement-text): Signal an error if a parameter + entity is undefined. + +2012-07-02 Stefan Monnier + + * comint.el (comint-output-filter): Filter out repeated prompts. + + * net/ange-ftp.el (ange-ftp-expand-file-name): Use ange-ftp-ftp-name + and file-name-absolute-p. + (ange-ftp-file-exists-p): Use ange-ftp-file-exists-p for + internal calls. + +2012-07-02 Paul Eggert + + Spelling fixes. + * emacs-lisp/bytecomp.el (byte-compile--reify-function): + Rename from byte-compile--refiy-function. All uses changed. + +2012-07-01 Chong Yidong + + * xml.el (xml--parse-buffer): New function. Move most of + xml-parse-region here. + (xml-parse-region): Copy region into a temporary buffer, since + parameter entity substitution requires changing buffer contents. + Use xml--parse-buffer. + (xml-parse-file): Use xml--parse-buffer. + (xml-parse-dtd): Make parameter entity substitution work right. + Use proper regexps for ELEMENT declarations (Bug#7172). + +2012-06-30 Glenn Morris + + * comint.el (follow-comint-scroll-to-bottom): Fix declaration. + + * net/secrets.el, net/tramp-gvfs.el, net/xesam.el, net/zeroconf.el: + Remove outdated and unnecessary dbus declarations. + +2012-06-30 Eli Zaretskii + + * emacs-lisp/timer.el (timer-until): Subtract results of + float-time, instead of taking float-time of the result of + time-subtract, since float-time signals an error for negative time + arguments. + +2012-06-30 Chong Yidong + + * xml.el (xml-*-re): Convert defvars into defconsts, and + eval-and-compile them so eval-and-compile works on derivatives. + (xml--entity-replacement-text): Use eval-and-comple. + +2012-06-30 Michael Albinus + + * vc/vc-git.el (vc-git-registered): Use cache property + `git-registered'. + (vc-git-mode-line-string): Call `vc-working-revision' instead of + `vc-git-working-revision' in order to benefit from the cache. + (vc-git-root): Use cache property `git-root'. (Bug#11757) + +2012-06-30 Dmitry Gutov + + * vc/vc-hooks.el (vc-before-save): Clear cache if file has been + removed (likely outside Emacs). (Bug#11757) + +2012-06-30 Stefan Monnier + + * emacs-lisp/cl-lib.el: Require macroexp. + +2012-06-30 Chong Yidong + + * xml.el: Implement XML parameter entities. + (xml-parameter-entity-alist): New variable. + (xml-parse-region, xml-parse-fragment): Preserve previous values + of xml-entity-alist and xml-parameter-entity-alist, so that + repeated calls on different documents do not change them. + (xml-parse-tag): Fix doctype regexp. + (xml--entity-replacement-text): New function. + (xml-parse-dtd): Use it. Don't handle system entities; doing that + properly requires url retrieval which is unimplemented. + (xml-escape-string): Doc fix. + +2012-06-30 Stefan Monnier + + * emacs-lisp/cl-lib.el (cl-pushnew): Use macroexp-let2. + +2012-06-29 Dmitry Antipov + + * fringe.el (fringe-mode): Doc fix. + +2012-06-29 Michael Albinus + + * net/ange-ftp.el (ange-ftp-get-passwd): Throw if `non-essential' + is non-nil. + (ange-ftp-ignore-errors-if-non-essential): New defmacro. + (ange-ftp-file-name-all-completions): Use it. (Bug#11808) + +2012-06-29 Andreas Schwab + + * calendar/cal-dst.el (calendar-current-time-zone): + Return calendar-current-time-zone-cache if non-nil. + +2012-06-29 Masatake YAMATO + + * progmodes/which-func.el (which-func-format): + Add mouse-face. (Bug#11698) + +2012-06-29 Leo Liu + + * textmodes/enriched.el (enriched-next-annotation): Use eq (Bug#11528). + +2012-06-29 Stefan Monnier + + * minibuffer.el (minibuffer-confirm-exit-commands): + Add completion-at-point (bug#11725). + +2012-06-29 Glenn Morris + + * progmodes/f90.el (f90-font-lock-keywords-2): + Add some preprocessor elements. (Bug#10499) + +2012-06-29 Stefan Monnier + + * progmodes/cperl-mode.el (cperl-update-syntaxification): + Use syntax-propertize (bug#11739). + +2012-06-28 Juanma Barranquero + + * emacs-lisp/cl-lib.el (cl-pushnew): Don't capture X (bug#11811). + +2012-06-28 Julien Danjou + + * term.el (term-handle-colors-array): Use a set of new faces to + color the terminal. Also uses :inverse-video property. + (term-default-fg-color): Set to nil by default, deprecate in favor + of `term-face'. + (term-default-bg-color): Set to nil by default, deprecate in favor + of `term-face'. + (term-current-face): Use `term-face' by default. + (term-bold-attribute): Variable deleted. + +2012-06-28 Glenn Morris + + * simple.el (completion-list-mode-finish): + Don't use toggle-read-only. (Since completion-list-mode has + a special mode-class, it wasn't doing anything extra anyway.) + +2012-06-28 Stefan Monnier + + Make inlining of other-mode interpreted functions work (bug#11799). + * emacs-lisp/bytecomp.el (byte-compile--refiy-function): New fun. + (byte-compile): Use it to fix compilation of lexical-binding closures. + * emacs-lisp/byte-opt.el (byte-compile-inline-expand): Compile the + function, if needed. + +2012-06-27 Stefan Monnier + + * help-mode.el (help-make-xrefs): Don't just withstand + cyclic-variable-indirection but any error in documentation-property. + + * loadup.el (purify-flag): Pre-grow the hash-table to reduce the + memory use. + * bindings.el (bindings--define-key): New function. + * vc/vc-hooks.el, replace.el, menu-bar.el, international/mule-cmds.el: + * emacs-lisp/lisp-mode.el, buff-menu.el, bookmark.el: + * bindings.el: Use it to purecopy define-key bindings. + + * textmodes/rst.el (rst-adornment-faces-alist): Avoid copy-list. + + * emacs-lisp/cl.el (flet): Mark obsolete. + * emacs-lisp/cl-macs.el (cl-flet*): New macro. + * vc/vc-rcs.el (vc-rcs-annotate-command, vc-rcs-parse): + * progmodes/js.el (js-c-fill-paragraph): + * progmodes/ebrowse.el (ebrowse-switch-member-buffer-to-sibling-class) + (ebrowse-switch-member-buffer-to-derived-class): + * play/5x5.el (5x5-solver): Use cl-flet. + + * emacs-lisp/cl.el: Use lexical-binding. Fix flet (bug#11780). + (cl--symbol-function): New macro. + (cl--letf, cl--letf*): Use it. + + * emacs-lisp/easy-mmode.el (easy-mmode-pretty-mode-name): + Strip "toggle-" if any. + +2012-06-27 Glenn Morris + + * info.el (Info-default-directory-list): Move here from paths.el. + * paths.el: Remove file, which is now empty. + * loadup.el: No longer load "paths". + + * custom.el (custom-initialize-delay): Doc fix. + + * eshell/em-alias.el, eshell/em-banner.el, eshell/em-basic.el: + * eshell/em-cmpl.el, eshell/em-dirs.el, eshell/em-glob.el: + * eshell/em-hist.el, eshell/em-ls.el, eshell/em-pred.el: + * eshell/em-prompt.el, eshell/em-rebind.el, eshell/em-script.el: + * eshell/em-smart.el, eshell/em-term.el, eshell/em-unix.el: + * eshell/em-xtra.el: Replace eshell-defgroup with "(progn (defgroup". + * eshell/eshell.el (eshell-defgroup): Remove alias. + +2012-06-27 Chong Yidong + + * help.el (help-enable-auto-load): New variable. + + * help-fns.el (help-fns--autoloaded-p): New function. + (describe-function-1): Refer to a function as "autoloaded" if it + was autoloaded at any time in the past. Perform autoloading if + help-enable-auto-load is non-nil. + +2012-06-26 Eli Zaretskii + + * makefile.w32-in (compile, compile-always): Depend on + update-subdirs, not on subdirs.el. Otherwise, several different + sub-targets of 'bootstrap' running in parallel could + simultaneously write to subdirs.el, producing a garbled file. + +2012-06-26 Sam Steingold + + * files.el (file-name-base): New convenience function. + * autoinsert.el, cus-dep.el, doc-view.el, image-dired.el: + * woman.el, eshell/esh-cmd.el, progmodes/ada-xref.el: + * progmodes/cc-defs.el, progmodes/cperl-mode.el: + * progmodes/flymake.el, progmodes/gud.el, progmodes/idlwave.el: + * textmodes/ispell.el, textmodes/reftex-ref.el: + * textmodes/tex-mode.el: Use it. + Did not touch cedet and org because they are maintained elsewhere. + +2012-06-26 Martin Rudalics + + * calendar/calendar.el (calendar-exit): Don't try to delete or + iconify last frame. See: + http://lists.gnu.org/archive/html/emacs-devel/2012-06/msg00372.html + +2012-06-25 Jim Diamond (tiny change) + + * server.el (server-process-filter): Remember dir in the + process's `server-client-directory' properties. + +2012-06-24 Chong Yidong + + * xml.el (xml-parse-tag): Correctly handle comment embedded in + non-tag text. + +2012-06-23 Juanma Barranquero + + * makefile.w32-in (COMPILE_FIRST): Synch with changes in 2012-06-22T21:24:54Z!monnier@iro.umontreal.ca. + +2012-06-23 Stefan Monnier + + * help-fns.el (describe-variable): Don't croak when doc is not found. + * vc/pcvs.el (cvs-retrieve-revision): Avoid toggle-read-only. + * menu-bar.el (menu-bar-line-wrapping-menu): Purecopy a tiny bit more. + * emacs-lisp/syntax.el (syntax-ppss): Simplify with new `if' place. + * emacs-lisp/smie.el (smie-next-sexp): CSE. + * emacs-lisp/macroexp.el (macroexp-let2): Fix edebug spec and avoid + ((lambda ..) ..). + * emacs-lisp/eieio.el (eieio-oref, slot-value): Use simpler defsetf. + +2012-06-23 Chong Yidong + + * info.el (Info-mouse-follow-link): Accept symbol values of + link-args. Select window; suggested by Gerhard Kahl (Bug#11672). + (Info-fontify-node): Use Info-link-keymap for all navigation + buttons, with link-args property to perform the desired action. + (Info-link-keymap): Doc fix. + (Info-next-link-keymap, Info-prev-link-keymap) + (Info-up-link-keymap): Delete now-unused keymaps. + +2012-06-23 Chong Yidong + + * mouse.el (mouse-drag-track): Deactivate the mark before popping. + + * progmodes/python.el (python-skeleton-define): Mark abbrevs as + system abbrevs. + + * ansi-color.el (ansi-color-apply-on-region): Doc fix. + +2012-06-23 Stefan Monnier + + * emacs-lisp/cl-macs.el (cl--make-usage-args): Handle improper lists + (bug#11719). + + * minibuffer.el (completion--twq-try): Try to fail more gracefully when + the requote function doesn't work properly (bug#11714). + +2012-06-23 Glenn Morris + + * pcmpl-rpm.el (pcmpl-rpm-packages): Give status messages. + +2012-06-22 Stefan Monnier + + Further GV/CL cleanups. + * emacs-lisp/gv.el (gv-get): Autoload functions to find their + gv-expander. + (gv--defun-declaration): New function. + (defun-declarations-alist): Use it. + (gv-define-modify-macro, gv-pushnew!, gv-inc!, gv-dec!): Remove. + (gv-place): Autoload. + * emacs-lisp/cl.el (cl--dotimes, cl--dolist): Remember subr.el's + original definition of dotimes and dolist. + * emacs-lisp/cl-macs.el (cl-expr-access-order): Remove unused. + (cl-dolist, cl-dotimes): Use `dolist' and `dotimes'. + * emacs-lisp/cl-lib.el: Move gv handlers from cl-macs to here. + (cl-fifth, cl-sixth, cl-seventh, cl-eighth) + (cl-ninth, cl-tenth): Move gv handler to the function's definition. + * emacs-lisp/cl-extra.el (cl-subseq, cl-get, cl-getf): Move gv handler + to the function's definition. + * Makefile.in (COMPILE_FIRST): Re-order to speed it up by about 50%. + * window.el: + * files.el: + * faces.el: + * env.el: Don't use CL. + +2012-06-22 Paul Eggert + + Support higher-resolution time stamps (Bug#9000). + + * calendar/time-date.el (with-decoded-time-value): New arg + PICO-SYMBOL in VARLIST. It's optional, for backward compatibility. + (encode-time-value): New optional arg PICO. New type 3. + (time-to-seconds) [!float-time]: Support the new picoseconds + component if it's used. + (seconds-to-time, time-subtract, time-add): + Support ps-resolution time stamps as well. + + * emacs-lisp/timer.el (timer): New component psecs. All uses changed. + (timerp): Timer vectors now have length 9, not 8. + (timer--time): Support new-style (4-part) time stamps. + (timer-next-integral-multiple-of-time): Time stamps now have + picosecond resolution, so take a bit more care about rounding. + (timer-relative-time, timer-inc-time): New optional arg psecs. + (timer-set-time-with-usecs): Set psecs to 0. + (timer--activate): Check psecs component, too. + + * proced.el (proced-time-lessp): Support ps-resolution stamps. + +2012-06-22 Stefan Monnier + + * icomplete.el (icomplete-minibuffer-setup, icomplete-completions): + Move the non-essential binding to the post/pre-command-hook where it is + more obviously correct. + + * subr.el (read-passwd): Don't use a history at all. + * savehist.el (savehist-save): Remove password saved accidentally + because of the above bug. + +2012-06-22 Bastien Guerry + + * files.el (toggle-read-only): Display a message telling whether + the buffer is read-only or not (bug#11726). + +2012-06-22 Stefan Monnier + + * emacs-lisp/gv.el: New file. + * subr.el (push, pop): Extend to generalized variables. + * loadup.el (macroexp): Unload if preloaded and uncompiled (bug#11657). + * emacs-lisp/cl-lib.el (cl-pop, cl-push, cl--set-nthcdr): Remove. + * emacs-lisp/cl-macs.el: Require gv. Use gv-define-setter, + gv-define-simple-setter, and gv-define-expander. + Remove setf-methods defined in gv. Rename cl-setf -> setf. + (cl-setf, cl-do-pop, cl-get-setf-method): Remove. + (cl-letf, cl-letf*, cl-define-modify-macro, cl-defsetf) + (cl-define-setf-expander, cl-struct-setf-expander): Move to cl.el. + (cl-remf, cl-shiftf, cl-rotatef, cl-callf, cl-callf2): Rewrite with + gv-letplace. + (cl-defstruct): Don't define setf-method any more. + * emacs-lisp/cl.el (flet): Don't autoload. + (cl--letf, letf, cl--letf*, letf*, cl--gv-adapt) + (define-setf-expander, defsetf, define-modify-macro) + (cl-struct-setf-expander): Move from cl-lib.el. + * emacs-lisp/syntax.el: + * emacs-lisp/ewoc.el: + * emacs-lisp/smie.el: + * emacs-lisp/cconv.el: + * emacs-lisp/timer.el: Rename cl-setf -> setf, cl-push -> push. + (timer--time): Use gv-define-simple-setter. + * emacs-lisp/macroexp.el (macroexp-let2): Rename from macroexp-let² + to avoid coding-system problems in subr.el. Adjust all users. + (macroexp--maxsize, macroexp-small-p): New functions. + * emacs-lisp/bytecomp.el (byte-compile-file): Don't use cl-letf. + * scroll-bar.el (scroll-bar-mode): + * simple.el (auto-fill-mode, overwrite-mode, binary-overwrite-mode) + (normal-erase-is-backspace-mode): Don't use the `eq' place. + * winner.el (winner-configuration, winner-make-point-alist) + (winner-set-conf, winner-get-point, winner-set): Don't abuse letf. + * files.el (locate-file-completion-table): Avoid list*. + +2012-06-22 Chong Yidong + + * dired-aux.el (dired-do-create-files): Doc fix (Bug#11327). + (dired-create-files): Doc fix (Bug#11329). + (dired-do-copy): Doc fix (Bug#11334). + (dired-mark-read-string): Doc fix (Bug#11553). + + * dired.el (dired-recursive-copies, dired-recursive-deletes): + Doc fix (Bug#11326). + (dired-make-relative): Doc fix (Bug#11332). Remove unused arg. + (dired-dwim-target): Doc fix. + + * wdired.el (wdired-mode): Doc fix. + +2012-06-22 Glenn Morris + + * pcmpl-rpm.el (pcmpl-rpm-cache): New option. + (pcmpl-rpm-cache-stamp-file): New constant. + (pcmpl-rpm-cache-time, pcmpl-rpm-packages): New variables. + (pcmpl-rpm-packages): Optionally cache list of packages. + + * pcmpl-rpm.el (pcmpl-rpm): New group. + (pcmpl-rpm-query-options): New option. + (pcmpl-rpm-packages): No need to inline it. + Use pcmpl-rpm-query-options. + + * calendar/calendar.el (calendar-in-read-only-buffer): + Avoid some needless mode changes. + +2012-06-21 Chong Yidong + + * desktop.el (desktop-read): Don't prompt if daemon (Bug#11674). + (desktop-path): Remove . from the default value (Bug#10977). + (desktop-read): Use user-emacs-directory if desktop-path is nil. + +2012-06-20 Chong Yidong + + * term.el (term-send-raw-meta): Make C-M- keys work (Bug#8172). + +2012-06-20 David Röthlisberger (tiny change) + + * ido.el (ido-switch-buffer, ido-find-file): Fix up doc of C-j + (bug#11201). + +2012-06-20 Chong Yidong + + * term.el (term-window-width): Handle the case of a missing right + fringe (Bug#8837). + (term-check-size): Use window-text-height (Bug#5445). + (term-mode): Use define-derived-mode. Minor cleanups. + Set font-lock-defaults (Bug#7692). + (term-move-columns, term-insert-char, term-emulate-terminal) + (term-erase-in-line, term-insert-spaces): Use font-lock-face. + +2012-06-20 Michael Albinus + + * net/ange-ftp.el (ange-ftp-get-passwd): + Bind `enable-recursive-minibuffers'. + (ange-ftp-get-process): Throw if `non-essential' is non-nil. + +2012-06-19 David Röthlisberger (tiny change) + + * ido.el (ido-find-file): Mention C-d binding in docstring (bug#11244). + 2012-06-19 Glenn Morris * progmodes/python.el (python-mode): Derive from prog-mode. @@ -940,7 +2159,7 @@ * vc/vc-rcs.el (vc-rcs-rcs2log-program): New. (vc-rcs-update-changelog): Use it. - * emacs-lisp/authors.el (authors-fixed-entries): Remove vcdiff + * emacs-lisp/authors.el (authors-fixed-entries): Remove vcdiff. * vc/vc-sccs.el (vc-sccs-write-revision): New function. (vc-sccs-workfile-unchanged-p): Use vc-sccs-write-revision. @@ -952,12 +2171,12 @@ 2012-06-05 Sam Steingold - * calendar/calendar.el (calendar-exit): reinstate the 2012-03-28 + * calendar/calendar.el (calendar-exit): Reinstate the 2012-03-28 patch (Bug#11140). 2012-06-05 Stefan Monnier - * emacs-list/cust-print.el: Move to obsolete. + * emacs-lisp/cust-print.el: Move to obsolete. * emacs-lisp/macroexp.el (macroexpand-all-1): Tolerate errors during compiler-macro expansion. @@ -1253,7 +2472,7 @@ * calendar/icalendar.el (icalendar-export-region): Export UID properly. -2012-05-29 Leo +2012-05-29 Leo Liu * calendar/icalendar.el (icalendar-import-format): Add `icalendar-import-format-uid' (Bug#11525). (icalendar-import-format-uid): New. @@ -1587,7 +2806,7 @@ Simplify; Don't bother removing a ] just to add it back. * textmodes/ispell.el (ispell-program-name): Use executable-find. -2012-05-18 Rüdiger Sonderfeld +2012-05-18 Rüdiger Sonderfeld * calc/calc-lang.el (math-C-parse-bess, math-C-parse-fma): New functions. @@ -1595,9 +2814,9 @@ 2012-05-18 Agustín Martín Domingo - * flyspell.el (flyspell-check-pre-word-p, flyspell-check-word-p) - (flyspell-debug-signal-word-checked): Protect delay handling for - otherchars against empty otherchars. + * textmodes/flyspell.el (flyspell-check-pre-word-p) + (flyspell-check-word-p, flyspell-debug-signal-word-checked): + Protect delay handling for otherchars against empty otherchars. 2012-05-18 Stefan Monnier @@ -1649,9 +2868,9 @@ 2012-05-16 Agustín Martín Domingo - * flyspell.el (flyspell-check-pre-word-p, flyspell-check-word-p) - (flyspell-debug-signal-word-checked): Delay for otherchars as for - normal word components. + * textmodes/flyspell.el (flyspell-check-pre-word-p) + (flyspell-check-word-p, flyspell-debug-signal-word-checked): + Delay for otherchars as for normal word components. 2012-05-16 Stefan Monnier @@ -1923,7 +3142,7 @@ 2012-05-08 Glenn Morris - * lisp/language/burmese.el, language/cham.el, language/czech.el: + * language/burmese.el, language/cham.el, language/czech.el: * language/english.el, language/georgian.el, language/greek.el: * language/japanese.el, language/khmer.el, language/korean.el: * language/lao.el, language/misc-lang.el, language/romanian.el: @@ -2355,7 +3574,7 @@ (verilog-pretty-expr): Don't line up assignment operations to the test and increment in if and for loops (verilog-extended-complete-re, verilog-complete-reg): Change so - that DPI inport functions don't look like fuction declarations + that DPI inport functions don't look like fuction declarations. 2012-05-03 Kenichi Handa @@ -2688,17 +3907,17 @@ Sync with soap-client repository. Support SOAP simpleType (Bug#10331). - * soap-client.el (soap-resolve-references-for-sequence-type) + * net/soap-client.el (soap-resolve-references-for-sequence-type) (soap-resolve-references-for-array-type): Hack to prevent self references, see Bug#9. (soap-parse-envelope): Report the contents of the 'detail' node when receiving a fault reply. (soap-parse-envelope): Report the contents of the entire 'detail' node. - * soap-inspect.el (soap-sample-value-for-simple-type) + * net/soap-inspect.el (soap-sample-value-for-simple-type) (soap-inspect-simple-type): New function. - * soap-client.el (soap-simple-type): New struct. + * net/soap-client.el (soap-simple-type): New struct. (soap-default-xsd-types, soap-default-soapenc-types) (soap-decode-basic-type, soap-encode-basic-type): support unsignedInt and double basic types. @@ -2706,7 +3925,7 @@ (soap-parse-simple-type, soap-encode-simple-type): New function. (soap-parse-schema): Parse xsd:simpleType declarations. - * soap-client.el (soap-default-xsd-types) + * net/soap-client.el (soap-default-xsd-types) (soap-default-soapenc-types): Add integer, byte and anyURI types. (soap-parse-complex-type-complex-content): Use `soap-wk2l' to find the local name of "soapenc:Array". @@ -2815,21 +4034,21 @@ Preserve ispell session localwords when switching back to original buffer. - * ispell.el (ispell-buffer-session-localwords): New buffer-local - variable to hold buffer session localwords. - (ispell-kill-ispell): add option 'clear to delete session + * textmodes/ispell.el (ispell-buffer-session-localwords): + New buffer-local variable to hold buffer session localwords. + (ispell-kill-ispell): Add option 'clear to delete session localwords. (ispell-command-loop, ispell-change-dictionary) (ispell-buffer-local-words): Preserve session localwords when needed. - * flyspell.el (flyspell-process-localwords, flyspell-do-correct): - Preserve session localwords when needed. + * textmodes/flyspell.el (flyspell-process-localwords) + (flyspell-do-correct): Preserve session localwords when needed. 2012-04-23 Agustín Martín Domingo - * ispell.el (ispell-insert-word) Remove unneeded function using - obsolete `translation-table-for-input'. + * textmodes/ispell.el (ispell-insert-word) Remove unneeded function + using obsolete `translation-table-for-input'. (ispell-word, ispell-process-line, ispell-complete-word): Use plain `insert' instead of removed `ispell-insert-word'. @@ -3259,15 +4478,15 @@ 2012-04-12 Agustín Martín Domingo - * ispell.el (ispell-set-spellchecker-params): Post-process + * textmodes/ispell.el (ispell-set-spellchecker-params): Post-process `ispell-dictionary-alist' to use [:alpha:] and utf-8 if possible. (ispell-dictionary-base-alist): Revert to original XEmacs friendly version for default. [:alpha:] will be added in - `ispell-set-spellchecker-params' if needed + `ispell-set-spellchecker-params' if needed. 2012-04-16 Chong Yidong - * image.el (imagemagick--extension-regexp): New variable. + * image.el (imagemagick--file-regexp): New variable. (imagemagick-register-types): Use it. (imagemagick-types-inhibit): Add :set function. Allow new value of t to inhibit all types. @@ -3776,7 +4995,7 @@ 2012-03-30 Agustín Martín Domingo - * ispell.el (ispell-get-extended-character-mode): + * textmodes/ispell.el (ispell-get-extended-character-mode): Disable extended-char-mode for hunspell. hunspell does not support it and treats ~word as ordinary words in pipe mode. @@ -4751,7 +5970,7 @@ files from Git, SVN, Bazaar, and Mercurial. (save-place-to-alist): Use it. -2012-02-17 Lawrence Mitchell +2012-02-17 Lawrence Mitchell Stefan Monnier * newcomment.el (uncomment-region-default): Don't leave extra space @@ -14999,7 +16218,7 @@ * vc/log-view.el: * vc/smerge-mode.el: * textmodes/bibtex-style.el: - * textmodes/css.el: + * textmodes/css-mode.el: * startup.el: * uniquify.el: * minibuffer.el: diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 4af584e77dc..0cb142a7267 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -92,13 +92,17 @@ BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))" BYTE_COMPILE_FLAGS = $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) # Files to compile before others during a bootstrap. This is done to -# speed up the bootstrap process. +# speed up the bootstrap process. They're ordered by size, so we use +# the slowest-compiler on the smallest file and move to larger files as the +# compiler gets faster. `autoload.elc' comes last because it is not used by +# the compiler (so its compilation does not speed up subsequent compilations), +# it's only placed here so as to speed up generation of the loaddefs.el file. COMPILE_FIRST = \ - $(lisp)/emacs-lisp/bytecomp.elc \ - $(lisp)/emacs-lisp/byte-opt.elc \ $(lisp)/emacs-lisp/macroexp.elc \ - $(lisp)/emacs-lisp/cconv.elc \ + $(lisp)/emacs-lisp/cconv.elc \ + $(lisp)/emacs-lisp/byte-opt.elc \ + $(lisp)/emacs-lisp/bytecomp.elc \ $(lisp)/emacs-lisp/autoload.elc # The actual Emacs command run in the targets below. @@ -129,8 +133,6 @@ setwins_for_subdirs=subdirs=`find . -type d -print`; \ esac; \ done -# `compile-main' tends to be slower than `recompile' but can be parallelized -# with "make -j" and results in more deterministic compilation warnings. # cus-load and finder-inf are not explicitly requested by anything, so # we add them here to make sure they get built. all: compile-main $(lisp)/cus-load.el $(lisp)/finder-inf.el @@ -182,13 +184,16 @@ update-subdirs: doit $(top_srcdir)/build-aux/update-subdirs $$file; \ done; +# Some modes of make-dist use this. updates: update-subdirs autoloads finder-data custom-deps -# This is useful after "bzr up". -bzr-update: recompile autoloads finder-data custom-deps - -# For backwards compatibility: -cvs-update: bzr-update +# This is useful after "bzr up"; but it doesn't do anything that a +# plain "make" at top-level doesn't. +# The only difference between this and this directory's "all" rule +# is that this runs "autoloads" as well (because it uses "compile" +# rather than "compile-main"). In a bootstrap, $(lisp) in src/Makefile +# triggers this directory's autoloads rule. +bzr-update: compile finder-data custom-deps # Update the AUTHORS file. @@ -314,19 +319,22 @@ backup-compiled-files: compile-after-backup: backup-compiled-files compile-always -# Recompile all Lisp files which are newer than their .elc files and compile -# new ones. -# This has the same effect as compile-main. recompile has some advantages: -# i) It is faster (on a single processor), since it only has to start -# Emacs once. It was 33% faster on a test with a random 10% of the .el -# files needing recompilation. -# ii) The explicit cc-mode dependency. -# recompile's disadvantages are: -# i) Not parallelizable. -# ii) Compiling multiple files in the same instance of Emacs is wrong, -# since the environment of later files is affected by definitions in -# earlier ones. -recompile: doit $(LOADDEFS) compile-first $(lisp)/progmodes/cc-mode.elc +# This does the same job as the "compile" rule, but in a different way. +# Rather than spawning a separate Emacs instance to compile each file, +# it uses the same Emacs instance to compile everything. +# This is faster on a single core, since it avoids the overhead of +# starting Emacs many times (it was 33% faster on a test with a +# random 10% of the .el files needing recompilation). +# Unlike compile, this is not parallelizable; so if you have more than +# one core and use make -j#, compile will be (much) faster. +# This rule also produces less accurate compilation warnings. +# The environment of later files is affected by definitions in +# earlier ones, so it does not produce some warnings that it should. +# It can also produces spurious warnings about "invalid byte code" if +# files that use byte-compile-dynamic are updated. +# There is no reason to use this rule unless you only have a single +# core and CPU time is an issue. +compile-one-process: doit $(LOADDEFS) compile-first $(lisp)/progmodes/cc-mode.elc $(emacs) $(BYTE_COMPILE_FLAGS) \ --eval "(batch-byte-recompile-directory 0)" $(lisp) @@ -410,19 +418,6 @@ $(CAL_DIR)/hol-loaddefs.el: $(CAL_SRC) --eval "(setq make-backup-files nil)" \ -f batch-update-autoloads $(CAL_DIR) -# Prepare a bootstrap in the lisp subdirectory. -# -# Build loaddefs.el to make sure it's up-to-date. If it's not, that -# might lead to errors during the bootstrap because something fails to -# autoload as expected. If there is no emacs binary, then we can't -# build autoloads yet. In that case we have to use ldefs-boot.el. -# Bootstrap should always work with ldefs-boot.el. Therefore, -# whenever a new autoload cookie gets added that is necessary during -# bootstrapping, ldefs-boot.el should be updated by overwriting it with -# an up-to-date copy of loaddefs.el that is uncorrupted by -# local changes. (Because loaddefs.el is an automatically generated -# file, we don't want to store it in the source repository). - bootstrap-clean: cd $(lisp); rm -f *.elc */*.elc */*/*.elc */*/*/*.elc $(AUTOGENEL) diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 9b82b3bc893..114afd8c813 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -31,7 +31,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defgroup abbrev-mode nil "Word abbreviations mode." @@ -540,7 +540,7 @@ the current abbrev table before abbrev lookup happens." (dotimes (i (length table)) (aset table i 0)) ;; Preserve the table's properties. - (assert sym) + (cl-assert sym) (let ((newsym (intern "" table))) (set newsym nil) ; Make sure it won't be confused for an abbrev. (setplist newsym (symbol-plist sym))) @@ -583,8 +583,8 @@ An obsolete but still supported calling form is: \(define-abbrev TABLE NAME EXPANSION &optional HOOK COUNT SYSTEM)." (when (and (consp props) (or (null (car props)) (numberp (car props)))) ;; Old-style calling convention. - (setq props (list* :count (car props) - (if (cadr props) (list :system (cadr props)))))) + (setq props `(:count ,(car props) + ,@(if (cadr props) (list :system (cadr props)))))) (unless (plist-get props :count) (setq props (plist-put props :count 0))) (let ((system-flag (plist-get props :system)) @@ -621,7 +621,7 @@ current (if global is nil) or standard syntax table." (let ((badchars ()) (pos 0)) (while (string-match "\\W" abbrev pos) - (pushnew (aref abbrev (match-beginning 0)) badchars) + (cl-pushnew (aref abbrev (match-beginning 0)) badchars) (setq pos (1+ pos))) (error "Some abbrev characters (%s) are not word constituents %s" (apply 'string (nreverse badchars)) @@ -836,8 +836,7 @@ return value is that of `abbrev-insert'.)" (interactive) (run-hooks 'pre-abbrev-expand-hook) (with-wrapper-hook abbrev-expand-functions () - (destructuring-bind (&optional sym name wordstart wordend) - (abbrev--before-point) + (pcase-let ((`(,sym ,name ,wordstart ,wordend) (abbrev--before-point))) (when sym (let ((startpos (copy-marker (point) t)) (endmark (copy-marker wordend t))) diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index d677f706704..18b2c846274 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -358,11 +358,12 @@ it will override BEGIN, the start of the region. Set "Translates SGR control sequences into overlays or extents. Delete all other control sequences without processing them. -SGR control sequences are applied by setting foreground and -background colors to the text between BEGIN and END using -overlays. The colors used are given in `ansi-color-faces-vector' -and `ansi-color-names-vector'. See `ansi-color-apply-sequence' -for details. +SGR control sequences are applied by calling the function +specified by `ansi-color-apply-face-function'. The default +function sets foreground and background colors to the text +between BEGIN and END, using overlays. The colors used are given +in `ansi-color-faces-vector' and `ansi-color-names-vector'. See +`ansi-color-apply-sequence' for details. Every call to this function will set and use the buffer-local variable `ansi-color-context-region' to save position and current face. This diff --git a/lisp/apropos.el b/lisp/apropos.el index f5373b38682..6c6e3b325e8 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -36,12 +36,12 @@ ;; Fixed bug, current-local-map can return nil. ;; Change, doesn't calculate key-bindings unless needed. ;; Added super-apropos capability, changed print functions. -;;; Made fast-apropos and super-apropos share code. -;;; Sped up fast-apropos again. +;; Made fast-apropos and super-apropos share code. +;; Sped up fast-apropos again. ;; Added apropos-do-all option. -;;; Added fast-command-apropos. +;; Added fast-command-apropos. ;; Changed doc strings to comments for helping functions. -;;; Made doc file buffer read-only, buried it. +;; Made doc file buffer read-only, buried it. ;; Only call substitute-command-keys if do-all set. ;; Optionally use configurable faces to make the output more legible. @@ -57,7 +57,6 @@ ;;; Code: (require 'button) -(eval-when-compile (require 'cl)) (defgroup apropos nil "Apropos commands for users and programmers." @@ -640,11 +639,11 @@ the output includes key-bindings of commands." (setq lh (cdr lh))))) (unless lh-entry (error "Unknown library `%s'" file))) (dolist (x (cdr lh-entry)) - (case (car-safe x) + (pcase (car-safe x) ;; (autoload (push (cdr x) autoloads)) - (require (push (cdr x) requires)) - (provide (push (cdr x) provides)) - (t (push (or (cdr-safe x) x) symbols)))) + (`require (push (cdr x) requires)) + (`provide (push (cdr x) provides)) + (_ (push (or (cdr-safe x) x) symbols)))) (let ((apropos-pattern "")) ;Dummy binding for apropos-symbols-internal. (apropos-symbols-internal symbols apropos-do-all @@ -981,7 +980,7 @@ Will return nil instead." (setq function (if (byte-code-function-p function) (if (> (length function) 4) (aref function 4)) - (if (eq (car-safe function) 'autoload) + (if (autoloadp function) (nth 2 function) (if (eq (car-safe function) 'lambda) (if (stringp (nth 2 function)) @@ -1115,7 +1114,7 @@ If non-nil TEXT is a string that will be printed as a heading." (consp (setq symbol (symbol-function symbol))) (or (eq (car symbol) 'macro) - (if (eq (car symbol) 'autoload) + (if (autoloadp symbol) (memq (nth 4 symbol) '(macro t)))))) diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el index e7639b6f8a3..fbf8c466585 100644 --- a/lisp/autoinsert.el +++ b/lisp/autoinsert.el @@ -140,14 +140,14 @@ If this contains a %s, that will be replaced by the matching rule." " .\\\" You may distribute this file under the terms of the GNU Free .\\\" Documentation License. -.TH " (file-name-sans-extension (file-name-nondirectory (buffer-file-name))) +.TH " (file-name-base) " " (file-name-extension (buffer-file-name)) " " (format-time-string "%Y-%m-%d ") "\n.SH NAME\n" - (file-name-sans-extension (file-name-nondirectory (buffer-file-name))) + (file-name-base) " \\- " str "\n.SH SYNOPSIS -.B " (file-name-sans-extension (file-name-nondirectory (buffer-file-name))) +.B " (file-name-base) "\n" _ " @@ -207,7 +207,7 @@ If this contains a %s, that will be replaced by the matching rule." \(provide '" - (file-name-sans-extension (file-name-nondirectory (buffer-file-name))) + (file-name-base) ") \;;; " (file-name-nondirectory (buffer-file-name)) " ends here\n") (("\\.texi\\(nfo\\)?\\'" . "Texinfo file skeleton") @@ -215,8 +215,7 @@ If this contains a %s, that will be replaced by the matching rule." "\\input texinfo @c -*-texinfo-*- @c %**start of header @setfilename " - (file-name-sans-extension - (file-name-nondirectory (buffer-file-name))) ".info\n" + (file-name-base) ".info\n" "@settitle " str " @c %**end of header @copying\n" diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 11005f49f44..0f082d2ee9c 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -94,9 +94,6 @@ (require 'timer) -(eval-when-compile (require 'cl)) - - ;; Custom Group: ;; ;; The two modes will be placed next to Auto Save Mode under the diff --git a/lisp/avoid.el b/lisp/avoid.el index bfe15de0ca2..2fa6ef39e70 100644 --- a/lisp/avoid.el +++ b/lisp/avoid.el @@ -67,7 +67,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defgroup avoid nil "Make mouse pointer stay out of the way of editing." @@ -206,30 +206,30 @@ If you want the mouse banished to a different corner set (let* ((fra-or-win (assoc-default 'frame-or-window mouse-avoidance-banish-position 'eq)) - (list-values (case fra-or-win - (frame (list 0 0 (frame-width) (frame-height))) - (window (window-edges)))) - (alist (loop for v in list-values - for k in '(left top right bottom) - collect (cons k v))) + (list-values (pcase fra-or-win + (`frame (list 0 0 (frame-width) (frame-height))) + (`window (window-edges)))) + (alist (cl-loop for v in list-values + for k in '(left top right bottom) + collect (cons k v))) (side (assoc-default 'side - mouse-avoidance-banish-position 'eq)) + mouse-avoidance-banish-position #'eq)) (side-dist (assoc-default 'side-pos - mouse-avoidance-banish-position 'eq)) + mouse-avoidance-banish-position #'eq)) (top-or-bottom (assoc-default 'top-or-bottom - mouse-avoidance-banish-position 'eq)) + mouse-avoidance-banish-position #'eq)) (top-or-bottom-dist (assoc-default 'top-or-bottom-pos - mouse-avoidance-banish-position 'eq)) - (side-fn (case side - (left '+) - (right '-))) - (top-or-bottom-fn (case top-or-bottom - (top '+) - (bottom '-)))) + mouse-avoidance-banish-position #'eq)) + (side-fn (pcase side + (`left '+) + (`right '-))) + (top-or-bottom-fn (pcase top-or-bottom + (`top '+) + (`bottom '-)))) (cons (funcall side-fn ; -/+ (assoc-default side alist 'eq) ; right or left side-dist) ; distance from side diff --git a/lisp/battery.el b/lisp/battery.el index dcfe07121b3..8e98291b11c 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -31,8 +31,7 @@ ;;; Code: (require 'timer) -(eval-when-compile (require 'cl)) - +(eval-when-compile (require 'cl-lib)) (defgroup battery nil "Display battery status information." @@ -360,16 +359,16 @@ The following %-sequences are provided: (when (re-search-forward "present: +yes$" nil t) (when (re-search-forward "design capacity: +\\([0-9]+\\) m[AW]h$" nil t) - (incf design-capacity (string-to-number (match-string 1)))) + (cl-incf design-capacity (string-to-number (match-string 1)))) (when (re-search-forward "last full capacity: +\\([0-9]+\\) m[AW]h$" nil t) - (incf last-full-capacity (string-to-number (match-string 1)))) + (cl-incf last-full-capacity (string-to-number (match-string 1)))) (when (re-search-forward "design capacity warning: +\\([0-9]+\\) m[AW]h$" nil t) - (incf warn (string-to-number (match-string 1)))) + (cl-incf warn (string-to-number (match-string 1)))) (when (re-search-forward "design capacity low: +\\([0-9]+\\) m[AW]h$" nil t) - (incf low (string-to-number (match-string 1))))))) + (cl-incf low (string-to-number (match-string 1))))))) (setq full-capacity (if (> last-full-capacity 0) last-full-capacity design-capacity)) (and capacity rate diff --git a/lisp/bindings.el b/lisp/bindings.el index b92d5e9a1ee..655cda235b4 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -40,7 +40,7 @@ corresponding to the mode line clicked." (interactive "e") (save-selected-window (select-window (posn-window (event-start event))) - (with-no-warnings (toggle-read-only)) + (toggle-read-only nil t) (force-mode-line-update))) (defun mode-line-toggle-modified (event) @@ -273,14 +273,34 @@ Normally nil in most modes, since there is no process to display.") (put 'mode-line-process 'risky-local-variable t) (make-variable-buffer-local 'mode-line-process) +(defun bindings--define-key (map key item) + "Make as much as possible of the menus pure." + (declare (indent 2)) + (define-key map key + (cond + ((not (consp item)) item) ;Not sure that could be other than a symbol. + ;; Keymaps can't be made pure otherwise users can't remove/add elements + ;; from/to them any more. + ((keymapp item) item) + ((stringp (car item)) + (if (keymapp (cdr item)) + (cons (purecopy (car item)) (cdr item)) + (purecopy item))) + ((eq 'menu-item (car item)) + (if (keymapp (nth 2 item)) + `(menu-item ,(purecopy (nth 1 item)) ,(nth 2 item) + ,@(purecopy (nthcdr 3 item))) + (purecopy item))) + (t (message "non-menu-item: %S" item) item)))) + (defvar mode-line-mode-menu (make-sparse-keymap "Minor Modes") "\ Menu of mode operations in the mode line.") (defvar mode-line-major-mode-keymap (let ((map (make-sparse-keymap))) - (define-key map [mode-line down-mouse-1] - `(menu-item ,(purecopy "Menu Bar") ignore - :filter (lambda (_) (mouse-menu-major-mode-map)))) + (bindings--define-key map [mode-line down-mouse-1] + `(menu-item "Menu Bar" ignore + :filter ,(lambda (_) (mouse-menu-major-mode-map)))) (define-key map [mode-line mouse-2] 'describe-mode) (define-key map [mode-line down-mouse-3] mode-line-mode-menu) map) "\ @@ -327,13 +347,13 @@ mouse-3: Toggle minor modes" (defvar mode-line-column-line-number-mode-map (let ((map (make-sparse-keymap)) (menu-map (make-sparse-keymap "Toggle Line and Column Number Display"))) - (define-key menu-map [line-number-mode] - `(menu-item ,(purecopy "Display Line Numbers") line-number-mode - :help ,(purecopy "Toggle displaying line numbers in the mode-line") + (bindings--define-key menu-map [line-number-mode] + '(menu-item "Display Line Numbers" line-number-mode + :help "Toggle displaying line numbers in the mode-line" :button (:toggle . line-number-mode))) - (define-key menu-map [column-number-mode] - `(menu-item ,(purecopy "Display Column Numbers") column-number-mode - :help ,(purecopy "Toggle displaying column numbers in the mode-line") + (bindings--define-key menu-map [column-number-mode] + '(menu-item "Display Column Numbers" column-number-mode + :help "Toggle displaying column numbers in the mode-line" :button (:toggle . column-number-mode))) (define-key map [mode-line down-mouse-1] menu-map) map) "\ @@ -491,51 +511,51 @@ Switch to the most recently selected buffer other than the current one." ;; Use mode-line-mode-menu for local minor-modes only. ;; Global ones can go on the menubar (Options --> Show/Hide). -(define-key mode-line-mode-menu [overwrite-mode] - `(menu-item ,(purecopy "Overwrite (Ovwrt)") overwrite-mode - :help ,(purecopy "Overwrite mode: typed characters replace existing text") +(bindings--define-key mode-line-mode-menu [overwrite-mode] + '(menu-item "Overwrite (Ovwrt)" overwrite-mode + :help "Overwrite mode: typed characters replace existing text" :button (:toggle . overwrite-mode))) -(define-key mode-line-mode-menu [outline-minor-mode] - `(menu-item ,(purecopy "Outline (Outl)") outline-minor-mode +(bindings--define-key mode-line-mode-menu [outline-minor-mode] + '(menu-item "Outline (Outl)" outline-minor-mode ;; XXX: This needs a good, brief description. - :help ,(purecopy "") + :help "" :button (:toggle . (bound-and-true-p outline-minor-mode)))) -(define-key mode-line-mode-menu [highlight-changes-mode] - `(menu-item ,(purecopy "Highlight changes (Chg)") highlight-changes-mode - :help ,(purecopy "Show changes in the buffer in a distinctive color") +(bindings--define-key mode-line-mode-menu [highlight-changes-mode] + '(menu-item "Highlight changes (Chg)" highlight-changes-mode + :help "Show changes in the buffer in a distinctive color" :button (:toggle . (bound-and-true-p highlight-changes-mode)))) -(define-key mode-line-mode-menu [hide-ifdef-mode] - `(menu-item ,(purecopy "Hide ifdef (Ifdef)") hide-ifdef-mode - :help ,(purecopy "Show/Hide code within #ifdef constructs") +(bindings--define-key mode-line-mode-menu [hide-ifdef-mode] + '(menu-item "Hide ifdef (Ifdef)" hide-ifdef-mode + :help "Show/Hide code within #ifdef constructs" :button (:toggle . (bound-and-true-p hide-ifdef-mode)))) -(define-key mode-line-mode-menu [glasses-mode] - `(menu-item ,(purecopy "Glasses (o^o)") glasses-mode - :help ,(purecopy "Insert virtual separators to make long identifiers easy to read") +(bindings--define-key mode-line-mode-menu [glasses-mode] + '(menu-item "Glasses (o^o)" glasses-mode + :help "Insert virtual separators to make long identifiers easy to read" :button (:toggle . (bound-and-true-p glasses-mode)))) -(define-key mode-line-mode-menu [font-lock-mode] - `(menu-item ,(purecopy "Font Lock") font-lock-mode - :help ,(purecopy "Syntax coloring") +(bindings--define-key mode-line-mode-menu [font-lock-mode] + '(menu-item "Font Lock" font-lock-mode + :help "Syntax coloring" :button (:toggle . font-lock-mode))) -(define-key mode-line-mode-menu [flyspell-mode] - `(menu-item ,(purecopy "Flyspell (Fly)") flyspell-mode - :help ,(purecopy "Spell checking on the fly") +(bindings--define-key mode-line-mode-menu [flyspell-mode] + '(menu-item "Flyspell (Fly)" flyspell-mode + :help "Spell checking on the fly" :button (:toggle . (bound-and-true-p flyspell-mode)))) -(define-key mode-line-mode-menu [auto-revert-tail-mode] - `(menu-item ,(purecopy "Auto revert tail (Tail)") auto-revert-tail-mode - :help ,(purecopy "Revert the tail of the buffer when buffer grows") +(bindings--define-key mode-line-mode-menu [auto-revert-tail-mode] + '(menu-item "Auto revert tail (Tail)" auto-revert-tail-mode + :help "Revert the tail of the buffer when buffer grows" :enable (buffer-file-name) :button (:toggle . (bound-and-true-p auto-revert-tail-mode)))) -(define-key mode-line-mode-menu [auto-revert-mode] - `(menu-item ,(purecopy "Auto revert (ARev)") auto-revert-mode - :help ,(purecopy "Revert the buffer when the file on disk changes") +(bindings--define-key mode-line-mode-menu [auto-revert-mode] + '(menu-item "Auto revert (ARev)" auto-revert-mode + :help "Revert the buffer when the file on disk changes" :button (:toggle . (bound-and-true-p auto-revert-mode)))) -(define-key mode-line-mode-menu [auto-fill-mode] - `(menu-item ,(purecopy "Auto fill (Fill)") auto-fill-mode - :help ,(purecopy "Automatically insert new lines") +(bindings--define-key mode-line-mode-menu [auto-fill-mode] + '(menu-item "Auto fill (Fill)" auto-fill-mode + :help "Automatically insert new lines" :button (:toggle . auto-fill-function))) -(define-key mode-line-mode-menu [abbrev-mode] - `(menu-item ,(purecopy "Abbrev (Abbrev)") abbrev-mode - :help ,(purecopy "Automatically expand abbreviations") +(bindings--define-key mode-line-mode-menu [abbrev-mode] + '(menu-item "Abbrev (Abbrev)" abbrev-mode + :help "Automatically expand abbreviations" :button (:toggle . abbrev-mode))) (defun mode-line-minor-mode-help (event) @@ -630,9 +650,22 @@ okay. See `mode-line-format'.") user-error ;; That's the main one! )) - (make-variable-buffer-local 'indent-tabs-mode) +;; These per-buffer variables are never reset by +;; `kill-all-local-variables', because they have no default value. +;; For consistency, we give them the `permanent-local' property, even +;; though `kill-all-local-variables' does not actually consult it. + +(mapc (lambda (sym) (put sym 'permanent-local t)) + '(buffer-file-name default-directory buffer-backed-up + buffer-saved-size buffer-auto-save-file-name + buffer-read-only buffer-undo-list mark-active + point-before-scroll buffer-file-truename + buffer-file-format buffer-auto-save-file-format + buffer-display-count buffer-display-time + enable-multibyte-characters)) + ;; We have base64, md5 and sha1 functions built in now. (provide 'base64) (provide 'md5) @@ -760,7 +793,7 @@ if `inhibit-field-text-motion' is non-nil." (define-key ctl-x-map "\C-o" 'delete-blank-lines) (define-key esc-map " " 'just-one-space) (define-key esc-map "z" 'zap-to-char) -(define-key esc-map "=" 'count-words-region) +(define-key esc-map "=" 'count-words) (define-key ctl-x-map "=" 'what-cursor-position) (define-key esc-map ":" 'eval-expression) ;; Define ESC ESC : like ESC : for people who type ESC ESC out of habit. @@ -1150,7 +1183,30 @@ if `inhibit-field-text-motion' is non-nil." (define-key ctl-x-5-map "m" 'compose-mail-other-frame) -(defvar ctl-x-r-map (make-sparse-keymap) +(defvar ctl-x-r-map + (let ((map (make-sparse-keymap))) + (define-key map "c" 'clear-rectangle) + (define-key map "k" 'kill-rectangle) + (define-key map "d" 'delete-rectangle) + (define-key map "y" 'yank-rectangle) + (define-key map "o" 'open-rectangle) + (define-key map "t" 'string-rectangle) + (define-key map "N" 'rectangle-number-lines) + (define-key map "\M-w" 'copy-rectangle-as-kill) + (define-key map "\C-@" 'point-to-register) + (define-key map [?\C-\ ] 'point-to-register) + (define-key map " " 'point-to-register) + (define-key map "j" 'jump-to-register) + (define-key map "s" 'copy-to-register) + (define-key map "x" 'copy-to-register) + (define-key map "i" 'insert-register) + (define-key map "g" 'insert-register) + (define-key map "r" 'copy-rectangle-to-register) + (define-key map "n" 'number-to-register) + (define-key map "+" 'increment-register) + (define-key map "w" 'window-configuration-to-register) + (define-key map "f" 'frame-configuration-to-register) + map) "Keymap for subcommands of C-x r.") (define-key ctl-x-map "r" ctl-x-r-map) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index f7266dc2250..8e6fb94c0dd 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -33,7 +33,7 @@ ;;; Code: (require 'pp) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;;; Misc comments: ;; @@ -2015,11 +2015,11 @@ To carry out the deletions that you've marked, use \\\\ (tmp-list ())) (while (let ((char (read-key (concat prompt bookmark-search-pattern)))) - (case char - ((?\e ?\r) nil) ; RET or ESC break the search loop. + (pcase char + ((or ?\e ?\r) nil) ; RET or ESC break the search loop. (?\C-g (setq bookmark-quit-flag t) nil) (?\d (pop tmp-list) t) ; Delete last char of pattern with DEL - (t + (_ (if (characterp char) (push char tmp-list) (setq unread-command-events @@ -2034,9 +2034,9 @@ To carry out the deletions that you've marked, use \\\\ (defun bookmark-bmenu-filter-alist-by-regexp (regexp) "Filter `bookmark-alist' with bookmarks matching REGEXP and rebuild list." (let ((bookmark-alist - (loop for i in bookmark-alist - when (string-match regexp (car i)) collect i into new - finally return new))) + (cl-loop for i in bookmark-alist + when (string-match regexp (car i)) collect i into new + finally return new))) (bookmark-bmenu-list))) @@ -2115,36 +2115,36 @@ strings returned are not." ;;;###autoload (defvar menu-bar-bookmark-map (let ((map (make-sparse-keymap "Bookmark functions"))) - (define-key map [load] - `(menu-item ,(purecopy "Load a Bookmark File...") bookmark-load - :help ,(purecopy "Load bookmarks from a bookmark file)"))) - (define-key map [write] - `(menu-item ,(purecopy "Save Bookmarks As...") bookmark-write - :help ,(purecopy "Write bookmarks to a file (reading the file name with the minibuffer)"))) - (define-key map [save] - `(menu-item ,(purecopy "Save Bookmarks") bookmark-save - :help ,(purecopy "Save currently defined bookmarks"))) - (define-key map [edit] - `(menu-item ,(purecopy "Edit Bookmark List") bookmark-bmenu-list - :help ,(purecopy "Display a list of existing bookmarks"))) - (define-key map [delete] - `(menu-item ,(purecopy "Delete Bookmark...") bookmark-delete - :help ,(purecopy "Delete a bookmark from the bookmark list"))) - (define-key map [rename] - `(menu-item ,(purecopy "Rename Bookmark...") bookmark-rename - :help ,(purecopy "Change the name of a bookmark"))) - (define-key map [locate] - `(menu-item ,(purecopy "Insert Location...") bookmark-locate - :help ,(purecopy "Insert the name of the file associated with a bookmark"))) - (define-key map [insert] - `(menu-item ,(purecopy "Insert Contents...") bookmark-insert - :help ,(purecopy "Insert the text of the file pointed to by a bookmark"))) - (define-key map [set] - `(menu-item ,(purecopy "Set Bookmark...") bookmark-set - :help ,(purecopy "Set a bookmark named inside a file."))) - (define-key map [jump] - `(menu-item ,(purecopy "Jump to Bookmark...") bookmark-jump - :help ,(purecopy "Jump to a bookmark (a point in some file)"))) + (bindings--define-key map [load] + '(menu-item "Load a Bookmark File..." bookmark-load + :help "Load bookmarks from a bookmark file)")) + (bindings--define-key map [write] + '(menu-item "Save Bookmarks As..." bookmark-write + :help "Write bookmarks to a file (reading the file name with the minibuffer)")) + (bindings--define-key map [save] + '(menu-item "Save Bookmarks" bookmark-save + :help "Save currently defined bookmarks")) + (bindings--define-key map [edit] + '(menu-item "Edit Bookmark List" bookmark-bmenu-list + :help "Display a list of existing bookmarks")) + (bindings--define-key map [delete] + '(menu-item "Delete Bookmark..." bookmark-delete + :help "Delete a bookmark from the bookmark list")) + (bindings--define-key map [rename] + '(menu-item "Rename Bookmark..." bookmark-rename + :help "Change the name of a bookmark")) + (bindings--define-key map [locate] + '(menu-item "Insert Location..." bookmark-locate + :help "Insert the name of the file associated with a bookmark")) + (bindings--define-key map [insert] + '(menu-item "Insert Contents..." bookmark-insert + :help "Insert the text of the file pointed to by a bookmark")) + (bindings--define-key map [set] + '(menu-item "Set Bookmark..." bookmark-set + :help "Set a bookmark named inside a file.")) + (bindings--define-key map [jump] + '(menu-item "Jump to Bookmark..." bookmark-jump + :help "Jump to a bookmark (a point in some file)")) map)) ;;;###autoload diff --git a/lisp/bs.el b/lisp/bs.el index 08d05a946e3..45a7e4d4440 100644 --- a/lisp/bs.el +++ b/lisp/bs.el @@ -124,8 +124,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - ;; ---------------------------------------------------------------------- ;; Globals for customization ;; ---------------------------------------------------------------------- @@ -830,10 +828,10 @@ See `visit-tags-table'." (interactive) (let ((res (with-current-buffer (bs--current-buffer) - (setq bs-buffer-show-mark (case bs-buffer-show-mark - ((nil) 'never) - ((never) 'always) - (t nil)))))) + (setq bs-buffer-show-mark (pcase bs-buffer-show-mark + (`nil 'never) + (`never 'always) + (_ nil)))))) (bs--update-current-line) (bs--set-window-height) (bs--show-config-message res))) @@ -964,7 +962,7 @@ Default is `bs--current-sort-function'." Uses function `toggle-read-only'." (interactive) (with-current-buffer (bs--current-buffer) - (call-interactively 'toggle-read-only)) + (toggle-read-only)) (bs--update-current-line)) (defun bs-clear-modified () diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index f501583b9ba..6a65749e0c5 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -134,68 +134,68 @@ commands.") (define-key map [follow-link] 'mouse-face) (define-key map [menu-bar Buffer-menu-mode] (cons (purecopy "Buffer-Menu") menu-map)) - (define-key menu-map [quit] - `(menu-item ,(purecopy "Quit") quit-window - :help ,(purecopy "Remove the buffer menu from the display"))) - (define-key menu-map [rev] - `(menu-item ,(purecopy "Refresh") revert-buffer - :help ,(purecopy "Refresh the *Buffer List* buffer contents"))) - (define-key menu-map [s0] menu-bar-separator) - (define-key menu-map [tf] - `(menu-item ,(purecopy "Show Only File Buffers") Buffer-menu-toggle-files-only + (bindings--define-key menu-map [quit] + '(menu-item "Quit" quit-window + :help "Remove the buffer menu from the display")) + (bindings--define-key menu-map [rev] + '(menu-item "Refresh" revert-buffer + :help "Refresh the *Buffer List* buffer contents")) + (bindings--define-key menu-map [s0] menu-bar-separator) + (bindings--define-key menu-map [tf] + '(menu-item "Show Only File Buffers" Buffer-menu-toggle-files-only :button (:toggle . Buffer-menu-files-only) - :help ,(purecopy "Toggle whether the current buffer-menu displays only file buffers"))) - (define-key menu-map [s1] menu-bar-separator) + :help "Toggle whether the current buffer-menu displays only file buffers")) + (bindings--define-key menu-map [s1] menu-bar-separator) ;; FIXME: The "Select" entries could use better names... - (define-key menu-map [sel] - `(menu-item ,(purecopy "Select Marked") Buffer-menu-select - :help ,(purecopy "Select this line's buffer; also display buffers marked with `>'"))) - (define-key menu-map [bm2] - `(menu-item ,(purecopy "Select Two") Buffer-menu-2-window - :help ,(purecopy "Select this line's buffer, with previous buffer in second window"))) - (define-key menu-map [bm1] - `(menu-item ,(purecopy "Select Current") Buffer-menu-1-window - :help ,(purecopy "Select this line's buffer, alone, in full frame"))) - (define-key menu-map [ow] - `(menu-item ,(purecopy "Select in Other Window") Buffer-menu-other-window - :help ,(purecopy "Select this line's buffer in other window, leaving buffer menu visible"))) - (define-key menu-map [tw] - `(menu-item ,(purecopy "Select in Current Window") Buffer-menu-this-window - :help ,(purecopy "Select this line's buffer in this window"))) - (define-key menu-map [s2] menu-bar-separator) - (define-key menu-map [is] - `(menu-item ,(purecopy "Regexp Isearch Marked Buffers...") Buffer-menu-isearch-buffers-regexp - :help ,(purecopy "Search for a regexp through all marked buffers using Isearch"))) - (define-key menu-map [ir] - `(menu-item ,(purecopy "Isearch Marked Buffers...") Buffer-menu-isearch-buffers - :help ,(purecopy "Search for a string through all marked buffers using Isearch"))) - (define-key menu-map [s3] menu-bar-separator) - (define-key menu-map [by] - `(menu-item ,(purecopy "Bury") Buffer-menu-bury - :help ,(purecopy "Bury the buffer listed on this line"))) - (define-key menu-map [vt] - `(menu-item ,(purecopy "Set Unmodified") Buffer-menu-not-modified - :help ,(purecopy "Mark buffer on this line as unmodified (no changes to save)"))) - (define-key menu-map [ex] - `(menu-item ,(purecopy "Execute") Buffer-menu-execute - :help ,(purecopy "Save and/or delete buffers marked with s or k commands"))) - (define-key menu-map [s4] menu-bar-separator) - (define-key menu-map [delb] - `(menu-item ,(purecopy "Mark for Delete and Move Backwards") Buffer-menu-delete-backwards - :help ,(purecopy "Mark buffer on this line to be deleted by x command and move up one line"))) - (define-key menu-map [del] - `(menu-item ,(purecopy "Mark for Delete") Buffer-menu-delete - :help ,(purecopy "Mark buffer on this line to be deleted by x command"))) + (bindings--define-key menu-map [sel] + '(menu-item "Select Marked" Buffer-menu-select + :help "Select this line's buffer; also display buffers marked with `>'")) + (bindings--define-key menu-map [bm2] + '(menu-item "Select Two" Buffer-menu-2-window + :help "Select this line's buffer, with previous buffer in second window")) + (bindings--define-key menu-map [bm1] + '(menu-item "Select Current" Buffer-menu-1-window + :help "Select this line's buffer, alone, in full frame")) + (bindings--define-key menu-map [ow] + '(menu-item "Select in Other Window" Buffer-menu-other-window + :help "Select this line's buffer in other window, leaving buffer menu visible")) + (bindings--define-key menu-map [tw] + '(menu-item "Select in Current Window" Buffer-menu-this-window + :help "Select this line's buffer in this window")) + (bindings--define-key menu-map [s2] menu-bar-separator) + (bindings--define-key menu-map [is] + '(menu-item "Regexp Isearch Marked Buffers..." Buffer-menu-isearch-buffers-regexp + :help "Search for a regexp through all marked buffers using Isearch")) + (bindings--define-key menu-map [ir] + '(menu-item "Isearch Marked Buffers..." Buffer-menu-isearch-buffers + :help "Search for a string through all marked buffers using Isearch")) + (bindings--define-key menu-map [s3] menu-bar-separator) + (bindings--define-key menu-map [by] + '(menu-item "Bury" Buffer-menu-bury + :help "Bury the buffer listed on this line")) + (bindings--define-key menu-map [vt] + '(menu-item "Set Unmodified" Buffer-menu-not-modified + :help "Mark buffer on this line as unmodified (no changes to save)")) + (bindings--define-key menu-map [ex] + '(menu-item "Execute" Buffer-menu-execute + :help "Save and/or delete buffers marked with s or k commands")) + (bindings--define-key menu-map [s4] menu-bar-separator) + (bindings--define-key menu-map [delb] + '(menu-item "Mark for Delete and Move Backwards" Buffer-menu-delete-backwards + :help "Mark buffer on this line to be deleted by x command and move up one line")) + (bindings--define-key menu-map [del] + '(menu-item "Mark for Delete" Buffer-menu-delete + :help "Mark buffer on this line to be deleted by x command")) - (define-key menu-map [sv] - `(menu-item ,(purecopy "Mark for Save") Buffer-menu-save - :help ,(purecopy "Mark buffer on this line to be saved by x command"))) - (define-key menu-map [umk] - `(menu-item ,(purecopy "Unmark") Buffer-menu-unmark - :help ,(purecopy "Cancel all requested operations on buffer on this line and move down"))) - (define-key menu-map [mk] - `(menu-item ,(purecopy "Mark") Buffer-menu-mark - :help ,(purecopy "Mark buffer on this line for being displayed by v command"))) + (bindings--define-key menu-map [sv] + '(menu-item "Mark for Save" Buffer-menu-save + :help "Mark buffer on this line to be saved by x command")) + (bindings--define-key menu-map [umk] + '(menu-item "Unmark" Buffer-menu-unmark + :help "Cancel all requested operations on buffer on this line and move down")) + (bindings--define-key menu-map [mk] + '(menu-item "Mark" Buffer-menu-mark + :help "Mark buffer on this line for being displayed by v command")) map) "Local keymap for `Buffer-menu-mode' buffers.") @@ -515,11 +515,12 @@ The current window remains selected." (bury-buffer menu))) (defun Buffer-menu-toggle-read-only () - "Toggle read-only status of buffer on this line." + "Toggle read-only status of buffer on this line. +This behaves like invoking \\[toggle-read-only] in that buffer." (interactive) (let (read-only) (with-current-buffer (Buffer-menu-buffer t) - (with-no-warnings (toggle-read-only)) + (toggle-read-only) (setq read-only buffer-read-only)) (tabulated-list-set-col 1 (if read-only "%" " ") t))) diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el index 8e41b175321..50b31400a6a 100644 --- a/lisp/calc/calc-alg.el +++ b/lisp/calc/calc-alg.el @@ -530,7 +530,10 @@ (not (Math-realp (nth 1 math-simplify-expr)))) (math-common-constant-factor (nth 1 math-simplify-expr)))) (if (and (eq (car-safe nn) 'frac) (eq (nth 1 nn) 1) (not n)) - (progn + (unless (and (eq (car-safe math-simplify-expr) 'calcFunc-eq) + (eq (car-safe (nth 1 math-simplify-expr)) 'var) + (not (math-expr-contains (nth 2 math-simplify-expr) + (nth 1 math-simplify-expr)))) (setcar (cdr math-simplify-expr) (math-mul (nth 2 nn) (nth 1 math-simplify-expr))) (setcar (cdr (cdr math-simplify-expr)) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 4d64209dd36..7fb9148535a 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -914,7 +914,7 @@ Used by `calc-user-invocation'.") ;; Set up the autoloading linkage. (let ((name (and (fboundp 'calc-dispatch) - (eq (car-safe (symbol-function 'calc-dispatch)) 'autoload) + (autoloadp (symbol-function 'calc-dispatch)) (nth 1 (symbol-function 'calc-dispatch)))) (p load-path)) diff --git a/lisp/calculator.el b/lisp/calculator.el index 14f50a0adcb..b1a3f9e0759 100644 --- a/lisp/calculator.el +++ b/lisp/calculator.el @@ -43,8 +43,6 @@ ;;; History: ;; I hate history. -(eval-when-compile (require 'cl)) - ;;;===================================================================== ;;; Customization: diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el index e3996cae3de..4af3ea53ab3 100644 --- a/lisp/calendar/cal-dst.el +++ b/lisp/calendar/cal-dst.el @@ -347,8 +347,8 @@ DST-ZONE are equal, and all the DST-* integer variables are 0. Some operating systems cannot provide all this information to Emacs; in this case, `calendar-current-time-zone' returns a list containing nil for the data it can't find." - (unless calendar-current-time-zone-cache - (setq calendar-current-time-zone-cache (calendar-dst-find-data)))) + (or calendar-current-time-zone-cache + (setq calendar-current-time-zone-cache (calendar-dst-find-data)))) ;; Following options should be set based on conditions when the code diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 0d6ea8e7f4c..d5514d14a32 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -1112,7 +1112,7 @@ with disabled undo. Leaves point at point-min, displays BUFFER." (declare (indent 1) (debug t)) `(progn (set-buffer (get-buffer-create ,buffer)) - (special-mode) + (or (derived-mode-p 'special-mode) (special-mode)) (setq buffer-read-only nil buffer-undo-list t) (erase-buffer) @@ -1818,10 +1818,11 @@ the STRINGS are just concatenated and the result truncated." (dolist (w (window-list-1 nil nil t)) (if (and (memq (window-buffer w) calendar-buffers) (window-dedicated-p w)) - (if calendar-remove-frame-by-deleting - (delete-frame (window-frame w)) - (iconify-frame (window-frame w))) - (quit-window kill w))) + (if (eq (window-deletable-p w) 'frame) + (if calendar-remove-frame-by-deleting + (delete-frame (window-frame w)) + (iconify-frame (window-frame w))) + (quit-window kill w)))) (dolist (b calendar-buffers) (quit-windows-on b kill)))))) diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el index baf92065550..f8f4c7b3fac 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -34,7 +34,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) ;and ah ain't kiddin' 'bout it +(eval-when-compile (require 'cl-lib)) (defvar parse-time-digits (make-vector 256 nil)) @@ -43,8 +43,8 @@ (defvar parse-time-val) (unless (aref parse-time-digits ?0) - (loop for i from ?0 to ?9 - do (aset parse-time-digits i (- i ?0)))) + (cl-loop for i from ?0 to ?9 + do (aset parse-time-digits i (- i ?0)))) (defsubst digit-char-p (char) (aref parse-time-digits char)) @@ -92,11 +92,11 @@ (index 0) (c nil)) (while (< index end) - (while (and (< index end) ;skip invalid characters + (while (and (< index end) ;Skip invalid characters. (not (setq c (parse-time-string-chars (aref string index))))) - (incf index)) + (cl-incf index)) (setq start index all-digits (eq c ?0)) - (while (and (< (incf index) end) ;scan valid characters + (while (and (< (cl-incf index) end) ;Scan valid characters. (setq c (parse-time-string-chars (aref string index)))) (setq all-digits (and all-digits (eq c ?0)))) (if (<= index end) diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 46e38ae46a8..38b766084c9 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -23,15 +23,15 @@ ;;; Commentary: -;; Time values come in three formats. The oldest format is a cons +;; Time values come in several formats. The oldest format is a cons ;; cell of the form (HIGH . LOW). This format is obsolete, but still -;; supported. The two other formats are the lists (HIGH LOW) and -;; (HIGH LOW MICRO). The first two formats specify HIGH * 2^16 + LOW -;; seconds; the third format specifies HIGH * 2^16 + LOW + MICRO / -;; 1000000 seconds. We should have 0 <= MICRO < 1000000 and 0 <= LOW -;; < 2^16. If the time value represents a point in time, then HIGH is -;; nonnegative. If the time value is a time difference, then HIGH can -;; be negative as well. The macro `with-decoded-time-value' and the +;; supported. The other formats are the lists (HIGH LOW), (HIGH LOW +;; USEC), and (HIGH LOW USEC PSEC). These formats specify the time +;; value equal to HIGH * 2^16 + LOW + USEC * 10^-6 + PSEC * 10^-12 +;; seconds, where missing components are treated as zero. HIGH can be +;; negative, either because the value is a time difference, or because +;; the machine supports negative time stamps that fall before the +;; epoch. The macro `with-decoded-time-value' and the ;; function `encode-time-value' make it easier to deal with these ;; three formats. See `time-subtract' for an example of how to use ;; them. @@ -44,13 +44,15 @@ The value of the last form in BODY is returned. Each element of the list VARLIST is a list of the form -\(HIGH-SYMBOL LOW-SYMBOL MICRO-SYMBOL [TYPE-SYMBOL] TIME-VALUE). +\(HIGH-SYMBOL LOW-SYMBOL MICRO-SYMBOL [PICO-SYMBOL [TYPE-SYMBOL]] TIME-VALUE). The time value TIME-VALUE is decoded and the result it bound to the symbols HIGH-SYMBOL, LOW-SYMBOL and MICRO-SYMBOL. +The optional PICO-SYMBOL is bound to the picoseconds part. The optional TYPE-SYMBOL is bound to the type of the time value. Type 0 is the cons cell (HIGH . LOW), type 1 is the list (HIGH -LOW), and type 2 is the list (HIGH LOW MICRO)." +LOW), type 2 is the list (HIGH LOW MICRO), and type 3 is the +list (HIGH LOW MICRO PICO)." (declare (indent 1) (debug ((&rest (symbolp symbolp symbolp &or [symbolp form] form)) body))) @@ -59,6 +61,8 @@ LOW), and type 2 is the list (HIGH LOW MICRO)." (high (pop elt)) (low (pop elt)) (micro (pop elt)) + (pico (unless (<= (length elt) 2) + (pop elt))) (type (unless (eq (length elt) 1) (pop elt))) (time-value (car elt)) @@ -66,28 +70,44 @@ LOW), and type 2 is the list (HIGH LOW MICRO)." `(let* ,(append `((,gensym ,time-value) (,high (pop ,gensym)) ,low ,micro) + (when pico `(,pico)) (when type `(,type))) (if (consp ,gensym) (progn (setq ,low (pop ,gensym)) (if ,gensym - ,(append `(setq ,micro (car ,gensym)) - (when type `(,type 2))) + (progn + (setq ,micro (car ,gensym)) + ,(cond (pico + `(if (cdr ,gensym) + ,(append `(setq ,pico (cadr ,gensym)) + (when type `(,type 3))) + ,(append `(setq ,pico 0) + (when type `(,type 2))))) + (type + `(setq type 2)))) ,(append `(setq ,micro 0) + (when pico `(,pico 0)) (when type `(,type 1))))) ,(append `(setq ,low ,gensym ,micro 0) + (when pico `(,pico 0)) (when type `(,type 0)))) (with-decoded-time-value ,varlist ,@body))) `(progn ,@body))) -(defun encode-time-value (high low micro type) - "Encode HIGH, LOW, and MICRO into a time value of type TYPE. +(defun encode-time-value (high low micro pico &optional type) + "Encode HIGH, LOW, MICRO, and PICO into a time value of type TYPE. Type 0 is the cons cell (HIGH . LOW), type 1 is the list (HIGH LOW), -and type 2 is the list (HIGH LOW MICRO)." +type 2 is (HIGH LOW MICRO), and type 3 is (HIGH LOW MICRO PICO). + +For backward compatibility, if only four arguments are given, +it is assumed that PICO was omitted and should be treated as zero." (cond ((eq type 0) (cons high low)) ((eq type 1) (list high low)) - ((eq type 2) (list high low micro)))) + ((eq type 2) (list high low micro)) + ((eq type 3) (list high low micro pico)) + ((null type) (encode-time-value high low micro 0 pico)))) (autoload 'parse-time-string "parse-time") (autoload 'timezone-make-date-arpa-standard "timezone") @@ -125,28 +145,45 @@ If DATE lacks timezone information, GMT is assumed." (subrp (symbol-function 'float-time))) (defun time-to-seconds (time) "Convert time value TIME to a floating point number." - (with-decoded-time-value ((high low micro time)) + (with-decoded-time-value ((high low micro pico type time)) (+ (* 1.0 high 65536) low - (/ micro 1000000.0)))))) + (/ (+ (* micro 1e6) pico) 1e12)))))) ;;;###autoload (defun seconds-to-time (seconds) "Convert SECONDS (a floating point number) to a time value." - (list (floor seconds 65536) - (floor (mod seconds 65536)) - (floor (* (- seconds (ffloor seconds)) 1000000)))) + (let* ((usec (* 1000000 (mod seconds 1))) + (ps (round (* 1000000 (mod usec 1)))) + (us (floor usec)) + (lo (floor (mod seconds 65536))) + (hi (floor seconds 65536))) + (if (eq ps 1000000) + (progn + (setq ps 0) + (setq us (1+ us)) + (if (eq us 1000000) + (progn + (setq us 0) + (setq lo (1+ lo)) + (if (eq lo 65536) + (progn + (setq lo 0) + (setq hi (1+ hi)))))))) + (list hi lo us ps))) ;;;###autoload (defun time-less-p (t1 t2) "Return non-nil if time value T1 is earlier than time value T2." - (with-decoded-time-value ((high1 low1 micro1 t1) - (high2 low2 micro2 t2)) + (with-decoded-time-value ((high1 low1 micro1 pico1 type1 t1) + (high2 low2 micro2 pico2 type2 t2)) (or (< high1 high2) (and (= high1 high2) (or (< low1 low2) (and (= low1 low2) - (< micro1 micro2))))))) + (or (< micro1 micro2) + (and (= micro1 micro2) + (< pico1 pico2))))))))) ;;;###autoload (defun days-to-time (days) @@ -173,36 +210,44 @@ TIME should be either a time value or a date-time string." (defun time-subtract (t1 t2) "Subtract two time values, T1 minus T2. Return the difference in the format of a time value." - (with-decoded-time-value ((high low micro type t1) - (high2 low2 micro2 type2 t2)) + (with-decoded-time-value ((high low micro pico type t1) + (high2 low2 micro2 pico2 type2 t2)) (setq high (- high high2) low (- low low2) micro (- micro micro2) + pico (- pico pico2) type (max type type2)) + (when (< pico 0) + (setq micro (1- micro) + pico (+ pico 1000000))) (when (< micro 0) (setq low (1- low) micro (+ micro 1000000))) (when (< low 0) (setq high (1- high) low (+ low 65536))) - (encode-time-value high low micro type))) + (encode-time-value high low micro pico type))) ;;;###autoload (defun time-add (t1 t2) "Add two time values T1 and T2. One should represent a time difference." - (with-decoded-time-value ((high low micro type t1) - (high2 low2 micro2 type2 t2)) + (with-decoded-time-value ((high low micro pico type t1) + (high2 low2 micro2 pico2 type2 t2)) (setq high (+ high high2) low (+ low low2) micro (+ micro micro2) + pico (+ pico pico2) type (max type type2)) + (when (>= pico 1000000) + (setq micro (1+ micro) + pico (- pico 1000000))) (when (>= micro 1000000) (setq low (1+ low) micro (- micro 1000000))) (when (>= low 65536) (setq high (1+ high) low (- low 65536))) - (encode-time-value high low micro type))) + (encode-time-value high low micro pico type))) ;;;###autoload (defun date-to-day (date) diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index f185c457ee2..d98ef42438c 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog @@ -1,3 +1,17 @@ +2012-07-09 Andreas Schwab + + * ede/project-am.el: Fix typo. + +2012-07-09 Paul Eggert + + Rename configure.in to configure.ac (Bug#11603). + * ede/autoconf-edit.el (autoconf-find-query-for-program) + (autoconf-new-program): + * ede/emacs.el (ede-emacs-version): + * ede/proj.el (ede-proj-setup-buildenvironment): + * ede/project-am.el (project-am-autoconf-file-options): + Prefer configure.ac to configure.in. + 2012-03-12 David Engster * semantic/db-find.el @@ -932,6 +946,7 @@ (srecode-template-inserter-ask, srecode-template-inserter-width) (srecode-template-inserter-section-start) (srecode-template-inserter-section-end, srecode-insert-method): + Fix typos in docstrings. 2010-01-12 Juanma Barranquero diff --git a/lisp/cedet/ede/autoconf-edit.el b/lisp/cedet/ede/autoconf-edit.el index 666ba0b0a06..e3c9d2cb4f8 100644 --- a/lisp/cedet/ede/autoconf-edit.el +++ b/lisp/cedet/ede/autoconf-edit.el @@ -31,7 +31,7 @@ (declare-function ede-srecode-insert "ede/srecode") (defun autoconf-new-program (rootdir program testfile) - "Initialize a new configure.in in ROOTDIR for PROGRAM using TESTFILE. + "Initialize a new configure.ac in ROOTDIR for PROGRAM using TESTFILE. ROOTDIR is the root directory of a given autoconf controlled project. PROGRAM is the program to be configured. TESTFILE is the file used with AC_INIT. @@ -325,7 +325,7 @@ Optional argument PARAM is the parameter to pass to the macro as one string." "Position the cursor where PROG is queried. PROG is the VARIABLE to use in autoconf to identify the program. PROG excludes the _PROG suffix. Thus if PROG were EMACS, then the -variable in configure.in would be EMACS_PROG." +variable in configure.ac would be EMACS_PROG." (let ((op (point)) (found t) (builtin (assoc prog autoconf-program-builtin))) diff --git a/lisp/cedet/ede/emacs.el b/lisp/cedet/ede/emacs.el index d7c83749ffa..e3afe30063c 100644 --- a/lisp/cedet/ede/emacs.el +++ b/lisp/cedet/ede/emacs.el @@ -74,13 +74,16 @@ DIR is the directory to search from." "Find the Emacs version for the Emacs src in DIR. Return a tuple of ( EMACSNAME . VERSION )." (let ((buff (get-buffer-create " *emacs-query*")) + (configure_ac "configure.ac") (emacs "Emacs") (ver "")) (with-current-buffer buff (erase-buffer) (setq default-directory (file-name-as-directory dir)) + (or (file-exists-p configure_ac) + (setq configure_ac "configure.in")) ;(call-process "egrep" nil buff nil "-n" "-e" "^version=" "Makefile") - (call-process "egrep" nil buff nil "-n" "-e" "AC_INIT" "configure.in") + (call-process "egrep" nil buff nil "-n" "-e" "AC_INIT" configure_ac) (goto-char (point-min)) ;(re-search-forward "version=\\([0-9.]+\\)") (cond @@ -100,7 +103,7 @@ emacs_beta_version=\\([0-9]+\\)") ;; Vaguely recent version of GNU Emacs? (t - (insert-file-contents "configure.in") + (insert-file-contents configure_ac) (goto-char (point-min)) (re-search-forward "AC_INIT(emacs,\\s-*\\([0-9.]+\\)\\s-*)") (setq ver (match-string 1)) diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el index d80d55bf916..a8afe9ec804 100644 --- a/lisp/cedet/ede/proj.el +++ b/lisp/cedet/ede/proj.el @@ -642,7 +642,7 @@ MFILENAME is the makefile to generate." (defmethod ede-proj-setup-buildenvironment ((this ede-proj-project) &optional force) "Setup the build environment for project THIS. -Handles the Makefile, or a Makefile.am configure.in combination. +Handles the Makefile, or a Makefile.am configure.ac combination. Optional argument FORCE will force items to be regenerated." (if (not force) (ede-proj-makefile-create-maybe this (ede-proj-dist-makefile this)) diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el index b775cddbc0e..e951598ba55 100644 --- a/lisp/cedet/ede/project-am.el +++ b/lisp/cedet/ede/project-am.el @@ -896,10 +896,10 @@ files in the project." out)) -;;; Configure.in queries. +;;; Configure.ac queries. ;; (defvar project-am-autoconf-file-options - '("configure.in" "configure.ac") + '("configure.ac" "configure.in") "List of possible configure files to look in for project info.") (defun project-am-autoconf-file (dir) @@ -948,7 +948,7 @@ Kill the Configure buffer if it was not already in a buffer." (configfiles nil) ) (cond - ;; Try configure.in or configure.ac + ;; Try configure.ac or configure.in (conf-in (project-am-with-config-current conf-in (let ((aci (autoconf-parameters-for-macro "AC_INIT")) diff --git a/lisp/comint.el b/lisp/comint.el index 0e614d469d7..431d05b75c2 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -101,7 +101,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) (require 'ring) (require 'ansi-color) (require 'regexp-opt) ;For regexp-opt-charset. @@ -2006,6 +2005,20 @@ Make backspaces delete the previous character." (goto-char (process-mark process)) (set-marker comint-last-output-start (point)) + ;; Try to skip repeated prompts, which can occur as a result of + ;; commands sent without inserting them in the buffer. + (let ((bol (save-excursion (forward-line 0) (point)))) ;No fields. + (when (and (not (bolp)) + (looking-back comint-prompt-regexp bol)) + (let* ((prompt (buffer-substring bol (point))) + (prompt-re (concat "\\`" (regexp-quote prompt)))) + (while (string-match prompt-re string) + (setq string (substring string (match-end 0))))))) + (while (string-match (concat "\\(^" comint-prompt-regexp + "\\)\\1+") + string) + (setq string (replace-match "\\1" nil nil string))) + ;; insert-before-markers is a bad thing. XXX ;; Luckily we don't have to use it any more, we use ;; window-point-insertion-type instead. @@ -2093,7 +2106,7 @@ This function should be a pre-command hook." nil t)))))) (defvar follow-mode) -(declare-function follow-comint-scroll-to-bottom "follow" ()) +(declare-function follow-comint-scroll-to-bottom "follow" (&optional window)) (defun comint-postoutput-scroll-to-bottom (_string) "Go to the end of buffer in some or all windows showing it. @@ -2672,6 +2685,7 @@ prompts should stay at the beginning of a line. If this is not the case, this command just calls `kill-region' with all read-only properties intact. The read-only status of newlines is updated using `comint-update-fence', if necessary." + (declare (advertised-calling-convention (beg end) "23.3")) (interactive "r") (save-excursion (let* ((true-beg (min beg end)) @@ -2690,8 +2704,6 @@ updated using `comint-update-fence', if necessary." (let ((inhibit-read-only t)) (kill-region beg end yank-handler) (comint-update-fence)))))) -(set-advertised-calling-convention 'comint-kill-region '(beg end) "23.3") - ;; Support for source-file processing commands. ;;============================================================================ diff --git a/lisp/completion.el b/lisp/completion.el index 75f8920920c..05358ad7711 100644 --- a/lisp/completion.el +++ b/lisp/completion.el @@ -228,7 +228,7 @@ ;; superior to that of the LISPM version. ;; ;;----------------------------------------------- -;; Acknowledgements +;; Acknowledgments ;;----------------------------------------------- ;; Cliff Lasser (cal@think.com), Kevin Herbert (kph@cisco.com), ;; eero@media-lab, kgk@cs.brown.edu, jla@ai.mit.edu, diff --git a/lisp/composite.el b/lisp/composite.el index 72317ac470e..4832848cb90 100644 --- a/lisp/composite.el +++ b/lisp/composite.el @@ -29,8 +29,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - (defconst reference-point-alist '((tl . 0) (tc . 1) (tr . 2) (Bl . 3) (Bc . 4) (Br . 5) diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el index 23f3eac5d66..bfe3ae36c7e 100644 --- a/lisp/cus-dep.el +++ b/lisp/cus-dep.el @@ -25,7 +25,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) (require 'widget) (require 'cus-face) @@ -53,9 +52,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" (default-directory (expand-file-name subdir)) (preloaded (concat "\\`" (regexp-opt (mapcar - (lambda (f) - (file-name-sans-extension - (file-name-nondirectory f))) + 'file-name-base preloaded-file-list) t) "\\.el\\'"))) (dolist (file files) diff --git a/lisp/custom.el b/lisp/custom.el index 50481f2aa7f..edb7fe2eaad 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -120,7 +120,9 @@ the :set function. For variables in preloaded files, you can simply use this function for the :initialize property. For autoloaded variables, you will also need to add an autoload stanza calling this -function, and another one setting the standard-value property." +function, and another one setting the standard-value property. +Or you can wrap the defcustom in a progn, to force the autoloader +to include all of it." ; see eg vc-sccs-search-project-dir ;; No longer true: ;; "See `send-mail-function' in sendmail.el for an example." diff --git a/lisp/descr-text.el b/lisp/descr-text.el index bcb95a54ad6..6be33066d52 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -533,7 +533,7 @@ relevant to POS." (col (current-column))) (if (or (/= beg 1) (/= end (1+ total))) (format "%d of %d (%d%%), restriction: <%d-%d>, column: %d%s" - pos total percent col beg end hscroll) + pos total percent beg end col hscroll) (if (= pos end) (format "%d of %d (EOB), column: %d%s" pos total col hscroll) (format "%d of %d (%d%%), column: %d%s" diff --git a/lisp/desktop.el b/lisp/desktop.el index 5d9982940bf..a873a6b63bf 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -220,7 +220,7 @@ the normal hook `desktop-not-loaded-hook' is run." :group 'desktop :version "22.2") -(defcustom desktop-path (list "." user-emacs-directory "~") +(defcustom desktop-path (list user-emacs-directory "~") "List of directories to search for the desktop file. The base name of the file is specified in `desktop-base-file-name'." :type '(repeat directory) @@ -410,8 +410,7 @@ is passed as the argument DESKTOP-BUFFER-MISC to functions in 'desktop-save-buffer "22.1") ;;;###autoload -(defvar desktop-buffer-mode-handlers - nil +(defvar desktop-buffer-mode-handlers nil "Alist of major mode specific functions to restore a desktop buffer. Functions listed are called by `desktop-create-buffer' when `desktop-read' evaluates the desktop file. List elements must have the form @@ -471,8 +470,7 @@ this table. See also `desktop-minor-mode-handlers'." :group 'desktop) ;;;###autoload -(defvar desktop-minor-mode-handlers - nil +(defvar desktop-minor-mode-handlers nil "Alist of functions to restore non-standard minor modes. Functions are called by `desktop-create-buffer' to restore minor modes. List elements must have the form @@ -968,8 +966,8 @@ It returns t if a desktop file was loaded, nil otherwise." (and dirs (car dirs))) ;; If not found and `desktop-path' is non-nil, use its first element. (and desktop-path (car desktop-path)) - ;; Default: Home directory. - "~")))) + ;; Default: .emacs.d. + user-emacs-directory)))) (if (file-exists-p (desktop-full-file-name)) ;; Desktop file found, but is it already in use? (let ((desktop-first-buffer nil) @@ -981,6 +979,7 @@ It returns t if a desktop file was loaded, nil otherwise." (if (and owner (memq desktop-load-locked-desktop '(nil ask)) (or (null desktop-load-locked-desktop) + (daemonp) (not (y-or-n-p (format "Warning: desktop file appears to be in use by PID %s.\n\ Using it may cause conflicts. Use it anyway? " owner))))) (let ((default-directory desktop-dirname)) @@ -1120,11 +1119,8 @@ directory DIRNAME." (defun desktop-load-file (function) "Load the file where auto loaded FUNCTION is defined." - (when function - (let ((fcell (and (fboundp function) (symbol-function function)))) - (when (and (listp fcell) - (eq 'autoload (car fcell))) - (load (cadr fcell)))))) + (when (fboundp function) + (autoload-do-load (symbol-function function) function))) ;; ---------------------------------------------------------------------------- ;; Create a buffer, load its file, set its mode, ...; diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 8a499c47464..6186f762e0a 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -395,16 +395,15 @@ Return the user input (a string). INITIAL, if non-nil, is the initial minibuffer input. OP-SYMBOL is an operation symbol (see `dired-no-confirm'). -ARG is normally the prefix argument for the calling command. -FILES should be a list of file names. +ARG is normally the prefix argument for the calling command; +it is passed as the first argument to `dired-mark-prompt'. +FILES should be a list of marked files' names. -DEFAULT-VALUE, if non-nil, should be a \"standard\" value or list -of such values, available via history commands. Note that if the -user enters empty input, this function returns the empty string, -not DEFAULT-VALUE. +Optional arg DEFAULT-VALUE is a default value or list of default +values, passed as the seventh arg to `completing-read'. -Optional argument COLLECTION is a collection of possible completions, -suitable for use by `completing-read'." +Optional arg COLLECTION is a collection of possible completions, +passed as the second arg to `completing-read'." (dired-mark-pop-up nil op-symbol files 'completing-read (format prompt (dired-mark-prompt arg files)) @@ -546,8 +545,17 @@ offer a smarter default choice of shell command." (defun dired-do-async-shell-command (command &optional arg file-list) "Run a shell command COMMAND on the marked files asynchronously. -Like `dired-do-shell-command' but if COMMAND doesn't end in ampersand, -adds `* &' surrounded by whitespace and executes the command asynchronously. +Like `dired-do-shell-command', but adds `&' at the end of COMMAND +to execute it asynchronously. + +When operating on multiple files, asynchronous commands +are executed in the background on each file in parallel. +In shell syntax this means separating the individual commands +with `&'. However, when COMMAND ends in `;' or `;&' then commands +are executed in the background on each file sequentially waiting +for each command to terminate before running the next command. +In shell syntax this means separating the individual commands with `;'. + The output appears in the buffer `*Async Shell Command*'." (interactive (let ((files (dired-get-marked-files t current-prefix-arg))) @@ -556,18 +564,14 @@ The output appears in the buffer `*Async Shell Command*'." (dired-read-shell-command "& on %s: " current-prefix-arg files) current-prefix-arg files))) - (unless (string-match "[*?][ \t]*\\'" command) - (setq command (concat command " *"))) (unless (string-match "&[ \t]*\\'" command) (setq command (concat command " &"))) (dired-do-shell-command command arg file-list)) -;; The in-background argument is only needed in Emacs 18 where -;; shell-command doesn't understand an appended ampersand `&'. ;;;###autoload (defun dired-do-shell-command (command &optional arg file-list) "Run a shell command COMMAND on the marked files. -If no files are marked or a specific numeric prefix arg is given, +If no files are marked or a numeric prefix arg is given, the next ARG files are used. Just \\[universal-argument] means the current file. The prompt mentions the file(s) or the marker, as appropriate. @@ -589,7 +593,17 @@ If you want to use `*' as a shell wildcard with whitespace around it, write `*\"\"' in place of just `*'. This is equivalent to just `*' in the shell, but avoids Dired's special handling. -If COMMAND produces output, it goes to a separate buffer. +If COMMAND ends in `&', `;', or `;&', it is executed in the +background asynchronously, and the output appears in the buffer +`*Async Shell Command*'. When operating on multiple files and COMMAND +ends in `&', the shell command is executed on each file in parallel. +However, when COMMAND ends in `;' or `;&' then commands are executed +in the background on each file sequentially waiting for each command +to terminate before running the next command. You can also use +`dired-do-async-shell-command' that automatically adds `&'. + +Otherwise, COMMAND is executed synchronously, and the output +appears in the buffer `*Shell Command Output*'. This feature does not try to redisplay Dired buffers afterward, as there's no telling what files COMMAND may have changed. @@ -608,10 +622,7 @@ can be produced by `dired-get-marked-files', for example." (let ((files (dired-get-marked-files t current-prefix-arg))) (list ;; Want to give feedback whether this file or marked files are used: - (dired-read-shell-command (concat "! on " - "%s: ") - current-prefix-arg - files) + (dired-read-shell-command "! on %s: " current-prefix-arg files) current-prefix-arg files))) (let* ((on-each (not (string-match dired-star-subst-regexp command))) @@ -655,23 +666,34 @@ can be produced by `dired-get-marked-files', for example." ;; Might be redefined for smarter things and could then use RAW-ARG ;; (coming from interactive P and currently ignored) to decide what to do. ;; Smart would be a way to access basename or extension of file names. - (let ((stuff-it - (if (or (string-match dired-star-subst-regexp command) - (string-match dired-quark-subst-regexp command)) - (lambda (x) - (let ((retval command)) - (while (string-match - "\\(^\\|[ \t]\\)\\([*?]\\)\\([ \t]\\|$\\)" retval) - (setq retval (replace-match x t t retval 2))) - retval)) - (lambda (x) (concat command dired-mark-separator x))))) - (if on-each - (mapconcat stuff-it (mapcar 'shell-quote-argument file-list) ";") - (let ((files (mapconcat 'shell-quote-argument - file-list dired-mark-separator))) - (if (> (length file-list) 1) - (setq files (concat dired-mark-prefix files dired-mark-postfix))) - (funcall stuff-it files))))) + (let* ((in-background (string-match "[ \t]*&[ \t]*\\'" command)) + (command (if in-background + (substring command 0 (match-beginning 0)) + command)) + (sequentially (string-match "[ \t]*;[ \t]*\\'" command)) + (command (if sequentially + (substring command 0 (match-beginning 0)) + command)) + (stuff-it + (if (or (string-match dired-star-subst-regexp command) + (string-match dired-quark-subst-regexp command)) + (lambda (x) + (let ((retval command)) + (while (string-match + "\\(^\\|[ \t]\\)\\([*?]\\)\\([ \t]\\|$\\)" retval) + (setq retval (replace-match x t t retval 2))) + retval)) + (lambda (x) (concat command dired-mark-separator x))))) + (concat + (if on-each + (mapconcat stuff-it (mapcar 'shell-quote-argument file-list) + (if (and in-background (not sequentially)) "&" ";")) + (let ((files (mapconcat 'shell-quote-argument + file-list dired-mark-separator))) + (if (> (length file-list) 1) + (setq files (concat dired-mark-prefix files dired-mark-postfix))) + (funcall stuff-it files))) + (if in-background "&" "")))) ;; This is an extra function so that it can be redefined by ange-ftp. ;;;###autoload @@ -1408,9 +1430,9 @@ NAME-CONSTRUCTOR should be a function accepting a single argument, the name of an old file, and returning either the corresponding new file name or nil to skip. -Optional MARKER-CHAR is a character with which to mark every -newfile's entry, or t to use the current marker character if the -old file was marked." +If optional argument MARKER-CHAR is non-nil, mark each +newly-created file's Dired entry with the character MARKER-CHAR, +or with the current marker character if MARKER-CHAR is t." (let (dired-create-files-failures failures skipped (success-count 0) (total (length fn-list))) (let (to overwrite-query @@ -1513,10 +1535,11 @@ ESC or `q' to not overwrite any of the remaining files, &optional marker-char op1 how-to) "Create a new file for each marked file. -Prompts user for target, which is a directory in which to create - the new files. Target may also be a plain file if only one marked - file exists. The way the default for the target directory is - computed depends on the value of `dired-dwim-target-directory'. +Prompt user for a target directory in which to create the new + files. The target may also be a non-directory file, if only + one file is marked. The initial suggestion for target is the + Dired buffer's current directory (or, if `dired-dwim-target' is + non-nil, the current directory of a neighboring Dired window). OP-SYMBOL is the symbol for the operation. Function `dired-mark-pop-up' will determine whether pop-ups are appropriate for this OP-SYMBOL. FILE-CREATOR and OPERATION as in `dired-create-files'. @@ -1721,16 +1744,21 @@ See HOW-TO argument for `dired-do-create-files'.") ;;;###autoload (defun dired-do-copy (&optional arg) "Copy all marked (or next ARG) files, or copy the current file. -This normally preserves the last-modified date when copying. -When operating on just the current file, you specify the new name. -When operating on multiple or marked files, you specify a directory, -and new copies of these files are made in that directory -with the same names that the files currently have. The default -suggested for the target directory depends on the value of -`dired-dwim-target', which see. +When operating on just the current file, prompt for the new name. -This command copies symbolic links by creating new ones, -like `cp -d'." +When operating on multiple or marked files, prompt for a target +directory, and make the new copies in that directory, with the +same names as the original files. The initial suggestion for the +target directory is the Dired buffer's current directory (or, if +`dired-dwim-target' is non-nil, the current directory of a +neighboring Dired window). + +If `dired-copy-preserve-time' is non-nil, this command preserves +the modification time of each old file in the copy, similar to +the \"-p\" option for the \"cp\" shell command. + +This command copies symbolic links by creating new ones, similar +to the \"-d\" option for the \"cp\" shell command." (interactive "P") (let ((dired-recursive-copies dired-recursive-copies)) (dired-do-create-files 'copy (function dired-copy-file) @@ -1996,9 +2024,10 @@ See Info node `(emacs)Subdir switches' for more details." ;;;###autoload (defun dired-insert-subdir (dirname &optional switches no-error-if-not-dir-p) - "Insert this subdirectory into the same dired buffer. -If it is already present, overwrites previous entry, - else inserts it at its natural place (as `ls -lR' would have done). + "Insert this subdirectory into the same Dired buffer. +If it is already present, overwrite the previous entry; + otherwise, insert it at its natural place (as `ls -lR' would + have done). With a prefix arg, you may edit the `ls' switches used for this listing. You can add `R' to the switches to expand the whole tree starting at this subdirectory. diff --git a/lisp/dired.el b/lisp/dired.el index 7428087ca8f..a80f48fa0c2 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -34,8 +34,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - ;;; Customizable variables (defgroup dired nil @@ -170,8 +168,9 @@ If a character, new links are unconditionally marked with that character." (defcustom dired-dwim-target nil "If non-nil, Dired tries to guess a default target directory. -This means: if there is a dired buffer displayed in the next window, -use its current subdir, instead of the current subdir of this dired buffer. +This means: if there is a Dired buffer displayed in the next +window, use its current directory, instead of this Dired buffer's +current directory. The target is used in the prompt for file copy, rename etc." :type 'boolean @@ -1957,15 +1956,14 @@ You can use it to recover marks, killed lines or subdirs." Actual changes in files cannot be undone by Emacs.")) (defun dired-toggle-read-only () - "Edit dired buffer with Wdired, or set it read-only. -Call `wdired-change-to-wdired-mode' in dired buffers whose editing is -supported by Wdired (the major mode of the dired buffer is `dired-mode'). -Otherwise, for buffers inheriting from dired-mode, call `toggle-read-only'." + "Edit Dired buffer with Wdired, or make it read-only. +If the current buffer can be edited with Wdired, (i.e. the major +mode is `dired-mode'), call `wdired-change-to-wdired-mode'. +Otherwise, call `toggle-read-only'." (interactive) (if (eq major-mode 'dired-mode) (wdired-change-to-wdired-mode) - (with-no-warnings - (toggle-read-only)))) + (toggle-read-only nil t))) (defun dired-next-line (arg) "Move down lines then position at filename. @@ -2209,10 +2207,11 @@ Optional arg GLOBAL means to replace all matches." ;; dired-get-filename. (concat (or dir default-directory) file)) -(defun dired-make-relative (file &optional dir _ignore) +(defun dired-make-relative (file &optional dir) "Convert FILE (an absolute file name) to a name relative to DIR. -If this is impossible, return FILE unchanged. -DIR must be a directory name, not a file name." +If DIR is omitted or nil, it defaults to `default-directory'. +If FILE is not in the directory tree of DIR, return FILE +unchanged." (or dir (setq dir default-directory)) ;; This case comes into play if default-directory is set to ;; use ~. @@ -2220,8 +2219,6 @@ DIR must be a directory name, not a file name." (setq dir (expand-file-name dir))) (if (string-match (concat "^" (regexp-quote dir)) file) (substring file (match-end 0)) -;;; (or no-error -;;; (error "%s: not in directory tree growing at %s" file dir)) file)) ;;; Functions for finding the file name in a dired buffer line. @@ -2467,8 +2464,6 @@ You can then feed the file name(s) to other commands with \\[yank]." dired-subdir-alist)))) cur-dir)))) -;(defun dired-get-subdir-min (elt) -; (cdr elt)) ;; can't use macro, must be redefinable for other alist format in dired-nstd. (defalias 'dired-get-subdir-min 'cdr) @@ -2730,12 +2725,14 @@ Optional argument means return a file name relative to `default-directory'." ;; Deleting files (defcustom dired-recursive-deletes 'top - "Decide whether recursive deletes are allowed. -A value of nil means no recursive deletes. -`always' means delete recursively without asking. This is DANGEROUS! -`top' means ask for each directory at top level, but delete its subdirectories -without asking. -Anything else means ask for each directory." + "Whether Dired deletes directories recursively. +If nil, Dired will not delete non-empty directories. +`always' means to delete non-empty directories recursively, +without asking. This is dangerous! +`top' means to ask for each top-level directory specified by the +Dired deletion command, and delete its subdirectories without +asking. +Any other value means to ask for each directory." :type '(choice :tag "Delete non-empty directories" (const :tag "Yes" always) (const :tag "No--only delete empty directories" nil) @@ -3577,11 +3574,11 @@ To be called first in body of `dired-sort-other', etc." ;;;; Drag and drop support (defcustom dired-recursive-copies 'top - "Decide whether recursive copies are allowed. -A value of nil means no recursive copies. -`always' means copy recursively without asking. -`top' means ask for each directory at top level. -Anything else means ask for each directory." + "Whether Dired copies directories recursively. +If nil, never copy recursively. +`always' means to copy recursively without asking. +`top' means to ask for each directory at top level. +Any other value means to ask for each directory." :type '(choice :tag "Copy directories" (const :tag "No recursive copies" nil) (const :tag "Ask for each directory" t) @@ -3739,7 +3736,7 @@ 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" "de7e4c64718c8ba8438a6397a460bf23") +;;;;;; dired-diff) "dired-aux" "dired-aux.el" "9499f79f5853da0aa93d26465c7bf3a1") ;;; Generated autoloads from dired-aux.el (autoload 'dired-diff "dired-aux" "\ @@ -3832,15 +3829,24 @@ with a prefix argument. (autoload 'dired-do-async-shell-command "dired-aux" "\ Run a shell command COMMAND on the marked files asynchronously. -Like `dired-do-shell-command' but if COMMAND doesn't end in ampersand, -adds `* &' surrounded by whitespace and executes the command asynchronously. +Like `dired-do-shell-command', but adds `&' at the end of COMMAND +to execute it asynchronously. + +When operating on multiple files, asynchronous commands +are executed in the background on each file in parallel. +In shell syntax this means separating the individual commands +with `&'. However, when COMMAND ends in `;' or `;&' then commands +are executed in the background on each file sequentially waiting +for each command to terminate before running the next command. +In shell syntax this means separating the individual commands with `;'. + The output appears in the buffer `*Async Shell Command*'. \(fn COMMAND &optional ARG FILE-LIST)" t nil) (autoload 'dired-do-shell-command "dired-aux" "\ Run a shell command COMMAND on the marked files. -If no files are marked or a specific numeric prefix arg is given, +If no files are marked or a numeric prefix arg is given, the next ARG files are used. Just \\[universal-argument] means the current file. The prompt mentions the file(s) or the marker, as appropriate. @@ -3862,7 +3868,17 @@ If you want to use `*' as a shell wildcard with whitespace around it, write `*\"\"' in place of just `*'. This is equivalent to just `*' in the shell, but avoids Dired's special handling. -If COMMAND produces output, it goes to a separate buffer. +If COMMAND ends in `&', `;', or `;&', it is executed in the +background asynchronously, and the output appears in the buffer +`*Async Shell Command*'. When operating on multiple files and COMMAND +ends in `&', the shell command is executed on each file in parallel. +However, when COMMAND ends in `;' or `;&' then commands are executed +in the background on each file sequentially waiting for each command +to terminate before running the next command. You can also use +`dired-do-async-shell-command' that automatically adds `&'. + +Otherwise, COMMAND is executed synchronously, and the output +appears in the buffer `*Shell Command Output*'. This feature does not try to redisplay Dired buffers afterward, as there's no telling what files COMMAND may have changed. @@ -3979,16 +3995,21 @@ If DIRECTORY already exists, signal an error. (autoload 'dired-do-copy "dired-aux" "\ Copy all marked (or next ARG) files, or copy the current file. -This normally preserves the last-modified date when copying. -When operating on just the current file, you specify the new name. -When operating on multiple or marked files, you specify a directory, -and new copies of these files are made in that directory -with the same names that the files currently have. The default -suggested for the target directory depends on the value of -`dired-dwim-target', which see. +When operating on just the current file, prompt for the new name. -This command copies symbolic links by creating new ones, -like `cp -d'. +When operating on multiple or marked files, prompt for a target +directory, and make the new copies in that directory, with the +same names as the original files. The initial suggestion for the +target directory is the Dired buffer's current directory (or, if +`dired-dwim-target' is non-nil, the current directory of a +neighboring Dired window). + +If `dired-copy-preserve-time' is non-nil, this command preserves +the modification time of each old file in the copy, similar to +the \"-p\" option for the \"cp\" shell command. + +This command copies symbolic links by creating new ones, similar +to the \"-d\" option for the \"cp\" shell command. \(fn &optional ARG)" t nil) @@ -4091,9 +4112,10 @@ See Info node `(emacs)Subdir switches' for more details. \(fn DIRNAME &optional SWITCHES NO-ERROR-IF-NOT-DIR-P)" t nil) (autoload 'dired-insert-subdir "dired-aux" "\ -Insert this subdirectory into the same dired buffer. -If it is already present, overwrites previous entry, - else inserts it at its natural place (as `ls -lR' would have done). +Insert this subdirectory into the same Dired buffer. +If it is already present, overwrite the previous entry; + otherwise, insert it at its natural place (as `ls -lR' would + have done). With a prefix arg, you may edit the `ls' switches used for this listing. You can add `R' to the switches to expand the whole tree starting at this subdirectory. diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 78b6610ff3c..72b36feb1d8 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -133,7 +133,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'dired) (require 'image-mode) (require 'jka-compr) @@ -259,9 +259,9 @@ of the page moves to the previous page." (setq ol nil)) (if ol (progn - (assert (eq (overlay-buffer ol) (current-buffer))) + (cl-assert (eq (overlay-buffer ol) (current-buffer))) (setq ol (copy-overlay ol))) - (assert (not (get-char-property (point-min) 'display))) + (cl-assert (not (get-char-property (point-min) 'display))) (setq ol (make-overlay (point-min) (point-max) nil t)) (overlay-put ol 'doc-view t)) (overlay-put ol 'window (car winprops)) @@ -892,30 +892,30 @@ Start by converting PAGES, and then the rest." (defun doc-view-doc->txt (txt callback) "Convert the current document to text and call CALLBACK when done." (make-directory (doc-view-current-cache-dir) t) - (case doc-view-doc-type - (pdf + (pcase doc-view-doc-type + (`pdf ;; Doc is a PDF, so convert it to TXT (doc-view-pdf->txt doc-view-buffer-file-name txt callback)) - (ps + (`ps ;; Doc is a PS, so convert it to PDF (which will be converted to ;; TXT thereafter). (let ((pdf (expand-file-name "doc.pdf" (doc-view-current-cache-dir)))) (doc-view-ps->pdf doc-view-buffer-file-name pdf (lambda () (doc-view-pdf->txt pdf txt callback))))) - (dvi + (`dvi ;; Doc is a DVI. This means that a doc.pdf already exists in its ;; cache subdirectory. (doc-view-pdf->txt (expand-file-name "doc.pdf" (doc-view-current-cache-dir)) txt callback)) - (odf + (`odf ;; Doc is some ODF (or MS Office) doc. This means that a doc.pdf ;; already exists in its cache subdirectory. (doc-view-pdf->txt (expand-file-name "doc.pdf" (doc-view-current-cache-dir)) txt callback)) - (t (error "DocView doesn't know what to do")))) + (_ (error "DocView doesn't know what to do")))) (defun doc-view-ps->pdf (ps pdf callback) "Convert PS to PDF asynchronously and call CALLBACK when finished." @@ -950,19 +950,18 @@ Those files are saved in the directory given by the function (let ((png-file (expand-file-name "page-%d.png" (doc-view-current-cache-dir)))) (make-directory (doc-view-current-cache-dir) t) - (case doc-view-doc-type - (dvi + (pcase doc-view-doc-type + (`dvi ;; DVI files have to be converted to PDF before Ghostscript can process ;; it. (let ((pdf (expand-file-name "doc.pdf" doc-view-current-cache-dir))) (doc-view-dvi->pdf doc-view-buffer-file-name pdf (lambda () (doc-view-pdf/ps->png pdf png-file))))) - (odf + (`odf ;; ODF files have to be converted to PDF before Ghostscript can ;; process it. (let ((pdf (expand-file-name "doc.pdf" doc-view-current-cache-dir)) - (opdf (expand-file-name (concat (file-name-sans-extension - (file-name-nondirectory doc-view-buffer-file-name)) + (opdf (expand-file-name (concat (file-name-base doc-view-buffer-file-name) ".pdf") doc-view-current-cache-dir)) (png-file png-file)) @@ -974,11 +973,11 @@ Those files are saved in the directory given by the function ;; Rename to doc.pdf (rename-file opdf pdf) (doc-view-pdf/ps->png pdf png-file))))) - (pdf + (`pdf (let ((pages (doc-view-active-pages))) ;; Convert PDF to PNG images starting with the active pages. (doc-view-pdf->png doc-view-buffer-file-name png-file pages))) - (t + (_ ;; Convert to PNG images. (doc-view-pdf/ps->png doc-view-buffer-file-name png-file))))) @@ -1104,7 +1103,7 @@ have the page we want to view." (and (not (member pagefile prev-pages)) (member pagefile doc-view-current-files))) (with-selected-window win - (assert (eq (current-buffer) buffer)) + (cl-assert (eq (current-buffer) buffer)) (doc-view-goto-page page)))))))) (defun doc-view-buffer-message () diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 4bc7f6af69a..b1a24bc88a6 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -63,8 +63,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'kmacro) @@ -319,17 +318,18 @@ or nil, use a compact 80-column format." mac)))) (if no-keys (when cmd - (loop for key in (where-is-internal cmd '(keymap)) do - (global-unset-key key))) + (cl-loop for key in (where-is-internal cmd '(keymap)) do + (global-unset-key key))) (when keys (if (= (length mac) 0) - (loop for key in keys do (global-unset-key key)) - (loop for key in keys do - (global-set-key key - (or cmd - (if (and mac-counter mac-format) - (kmacro-lambda-form mac mac-counter mac-format) - mac)))))))))) + (cl-loop for key in keys do (global-unset-key key)) + (cl-loop for key in keys do + (global-set-key key + (or cmd + (if (and mac-counter mac-format) + (kmacro-lambda-form + mac mac-counter mac-format) + mac)))))))))) (kill-buffer buf) (when (buffer-name obuf) (switch-to-buffer obuf)) @@ -437,9 +437,9 @@ doubt, use whitespace." (one-line (eq verbose 1))) (if one-line (setq verbose nil)) (when (stringp macro) - (loop for i below (length macro) do - (when (>= (aref rest-mac i) 128) - (incf (aref rest-mac i) (- ?\M-\^@ 128))))) + (cl-loop for i below (length macro) do + (when (>= (aref rest-mac i) 128) + (cl-incf (aref rest-mac i) (- ?\M-\^@ 128))))) (while (not (eq (aref rest-mac 0) 'end-macro)) (let* ((prefix (or (and (integerp (aref rest-mac 0)) @@ -448,57 +448,58 @@ doubt, use whitespace." '(digit-argument negative-argument)) (let ((i 1)) (while (memq (aref rest-mac i) (cdr mdigs)) - (incf i)) + (cl-incf i)) (and (not (memq (aref rest-mac i) pkeys)) (prog1 (vconcat "M-" (edmacro-subseq rest-mac 0 i) " ") - (callf edmacro-subseq rest-mac i))))) + (cl-callf edmacro-subseq rest-mac i))))) (and (eq (aref rest-mac 0) ?\C-u) (eq (key-binding [?\C-u]) 'universal-argument) (let ((i 1)) (while (eq (aref rest-mac i) ?\C-u) - (incf i)) + (cl-incf i)) (and (not (memq (aref rest-mac i) pkeys)) - (prog1 (loop repeat i concat "C-u ") - (callf edmacro-subseq rest-mac i))))) + (prog1 (cl-loop repeat i concat "C-u ") + (cl-callf edmacro-subseq rest-mac i))))) (and (eq (aref rest-mac 0) ?\C-u) (eq (key-binding [?\C-u]) 'universal-argument) (let ((i 1)) (when (eq (aref rest-mac i) ?-) - (incf i)) + (cl-incf i)) (while (memq (aref rest-mac i) '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) - (incf i)) + (cl-incf i)) (and (not (memq (aref rest-mac i) pkeys)) (prog1 (vconcat "C-u " (edmacro-subseq rest-mac 1 i) " ") - (callf edmacro-subseq rest-mac i))))))) + (cl-callf edmacro-subseq rest-mac i))))))) (bind-len (apply 'max 1 - (loop for map in maps - for b = (lookup-key map rest-mac) - when b collect b))) + (cl-loop for map in maps + for b = (lookup-key map rest-mac) + when b collect b))) (key (edmacro-subseq rest-mac 0 bind-len)) (fkey nil) tlen tkey - (bind (or (loop for map in maps for b = (lookup-key map key) - thereis (and (not (integerp b)) b)) + (bind (or (cl-loop for map in maps for b = (lookup-key map key) + thereis (and (not (integerp b)) b)) (and (setq fkey (lookup-key local-function-key-map rest-mac)) (setq tlen fkey tkey (edmacro-subseq rest-mac 0 tlen) fkey (lookup-key local-function-key-map tkey)) - (loop for map in maps - for b = (lookup-key map fkey) - when (and (not (integerp b)) b) - do (setq bind-len tlen key tkey) - and return b - finally do (setq fkey nil))))) + (cl-loop for map in maps + for b = (lookup-key map fkey) + when (and (not (integerp b)) b) + do (setq bind-len tlen key tkey) + and return b + finally do (setq fkey nil))))) (first (aref key 0)) - (text (loop for i from bind-len below (length rest-mac) - for ch = (aref rest-mac i) - while (and (integerp ch) - (> ch 32) (< ch maxkey) (/= ch 92) - (eq (key-binding (char-to-string ch)) - 'self-insert-command) - (or (> i (- (length rest-mac) 2)) - (not (eq ch (aref rest-mac (+ i 1)))) - (not (eq ch (aref rest-mac (+ i 2)))))) - finally return i)) + (text + (cl-loop for i from bind-len below (length rest-mac) + for ch = (aref rest-mac i) + while (and (integerp ch) + (> ch 32) (< ch maxkey) (/= ch 92) + (eq (key-binding (char-to-string ch)) + 'self-insert-command) + (or (> i (- (length rest-mac) 2)) + (not (eq ch (aref rest-mac (+ i 1)))) + (not (eq ch (aref rest-mac (+ i 2)))))) + finally return i)) desc) (if (stringp bind) (setq bind nil)) (cond ((and (eq bind 'self-insert-command) (not prefix) @@ -509,7 +510,7 @@ doubt, use whitespace." (setq desc (concat (edmacro-subseq rest-mac 0 text))) (when (string-match "^[ACHMsS]-." desc) (setq text 2) - (callf substring desc 0 2)) + (cl-callf substring desc 0 2)) (not (string-match "^;;\\|^<.*>$\\|^\\\\[0-9]+$\\|^[0-9]+\\*." desc)))) @@ -535,17 +536,17 @@ doubt, use whitespace." (cond ((integerp ch) (concat - (loop for pf across "ACHMsS" - for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@ - ?\M-\^@ ?\s-\^@ ?\S-\^@) - when (/= (logand ch bit) 0) - concat (format "%c-" pf)) + (cl-loop for pf across "ACHMsS" + for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@ + ?\M-\^@ ?\s-\^@ ?\S-\^@) + when (/= (logand ch bit) 0) + concat (format "%c-" pf)) (let ((ch2 (logand ch (1- (lsh 1 18))))) (cond ((<= ch2 32) - (case ch2 + (pcase ch2 (0 "NUL") (9 "TAB") (10 "LFD") (13 "RET") (27 "ESC") (32 "SPC") - (t + (_ (format "C-%c" (+ (if (<= ch2 26) 96 64) ch2))))) @@ -563,30 +564,30 @@ doubt, use whitespace." (let ((times 1) (pos bind-len)) (while (not (edmacro-mismatch rest-mac rest-mac 0 bind-len pos (+ bind-len pos))) - (incf times) - (incf pos bind-len)) + (cl-incf times) + (cl-incf pos bind-len)) (when (> times 1) (setq desc (format "%d*%s" times desc)) (setq bind-len (* bind-len times))))) (setq rest-mac (edmacro-subseq rest-mac bind-len)) (if verbose (progn - (unless (equal res "") (callf concat res "\n")) - (callf concat res desc) + (unless (equal res "") (cl-callf concat res "\n")) + (cl-callf concat res desc) (when (and bind (or (stringp bind) (symbolp bind))) - (callf concat res + (cl-callf concat res (make-string (max (- 3 (/ (length desc) 8)) 1) 9) ";; " (if (stringp bind) bind (symbol-name bind)))) (setq len 0)) (if (and (> (+ len (length desc) 2) 72) (not one-line)) (progn - (callf concat res "\n ") + (cl-callf concat res "\n ") (setq len 1)) (unless (equal res "") - (callf concat res " ") - (incf len))) - (callf concat res desc) - (incf len (length desc))))) + (cl-callf concat res " ") + (cl-incf len))) + (cl-callf concat res desc) + (cl-incf len (length desc))))) res)) (defun edmacro-mismatch (cl-seq1 cl-seq2 cl-start1 cl-end1 cl-start2 cl-end2) @@ -638,9 +639,9 @@ If START or END is negative, it counts from the end." The string represents the same events; Meta is indicated by bit 7. This function assumes that the events can be stored in a string." (setq seq (copy-sequence seq)) - (loop for i below (length seq) do - (when (logand (aref seq i) 128) - (setf (aref seq i) (logand (aref seq i) 127)))) + (cl-loop for i below (length seq) do + (when (logand (aref seq i) 128) + (setf (aref seq i) (logand (aref seq i) 127)))) seq) (defun edmacro-fix-menu-commands (macro &optional noerror) @@ -655,7 +656,7 @@ This function assumes that the events can be stored in a string." ((eq (car ev) 'switch-frame)) ((equal ev '(menu-bar)) (push 'menu-bar result)) - ((equal (cadadr ev) '(menu-bar)) + ((equal (cl-cadadr ev) '(menu-bar)) (push (vector 'menu-bar (car ev)) result)) ;; It would be nice to do pop-up menus, too, but not enough ;; info is recorded in macros to make this possible. @@ -715,30 +716,31 @@ This function assumes that the events can be stored in a string." (t (let ((orig-word word) (prefix 0) (bits 0)) (while (string-match "^[ACHMsS]-." word) - (incf bits (cdr (assq (aref word 0) + (cl-incf bits (cdr (assq (aref word 0) '((?A . ?\A-\^@) (?C . ?\C-\^@) (?H . ?\H-\^@) (?M . ?\M-\^@) (?s . ?\s-\^@) (?S . ?\S-\^@))))) - (incf prefix 2) - (callf substring word 2)) + (cl-incf prefix 2) + (cl-callf substring word 2)) (when (string-match "^\\^.$" word) - (incf bits ?\C-\^@) - (incf prefix) - (callf substring word 1)) + (cl-incf bits ?\C-\^@) + (cl-incf prefix) + (cl-callf substring word 1)) (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r") ("LFD" . "\n") ("TAB" . "\t") ("ESC" . "\e") ("SPC" . " ") ("DEL" . "\177"))))) (when found (setq word (cdr found)))) (when (string-match "^\\\\[0-7]+$" word) - (loop for ch across word - for n = 0 then (+ (* n 8) ch -48) - finally do (setq word (vector n)))) + (cl-loop for ch across word + for n = 0 then (+ (* n 8) ch -48) + finally do (setq word (vector n)))) (cond ((= bits 0) (setq key word)) ((and (= bits ?\M-\^@) (stringp word) (string-match "^-?[0-9]+$" word)) - (setq key (loop for x across word collect (+ x bits)))) + (setq key (cl-loop for x across word + collect (+ x bits)))) ((/= (length word) 1) (error "%s must prefix a single character, not %s" (substring orig-word 0 prefix) word)) @@ -752,7 +754,7 @@ This function assumes that the events can be stored in a string." (t (setq key (list (+ bits (aref word 0))))))))) (when key - (loop repeat times do (callf vconcat res key))))) + (cl-loop repeat times do (cl-callf vconcat res key))))) (when (and (>= (length res) 4) (eq (aref res 0) ?\C-x) (eq (aref res 1) ?\() @@ -760,13 +762,13 @@ This function assumes that the events can be stored in a string." (eq (aref res (- (length res) 1)) ?\))) (setq res (edmacro-subseq res 2 -2))) (if (and (not need-vector) - (loop for ch across res - always (and (characterp ch) - (let ((ch2 (logand ch (lognot ?\M-\^@)))) - (and (>= ch2 0) (<= ch2 127)))))) - (concat (loop for ch across res - collect (if (= (logand ch ?\M-\^@) 0) - ch (+ ch 128)))) + (cl-loop for ch across res + always (and (characterp ch) + (let ((ch2 (logand ch (lognot ?\M-\^@)))) + (and (>= ch2 0) (<= ch2 127)))))) + (concat (cl-loop for ch across res + collect (if (= (logand ch ?\M-\^@) 0) + ch (+ ch 128)))) res))) (provide 'edmacro) diff --git a/lisp/electric.el b/lisp/electric.el index 6a31ba1f1d3..3108a0ed4c0 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -38,8 +38,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - ;; This loop is the guts for non-standard modes which retain control ;; until some event occurs. It is a `do-forever', the only way out is ;; to throw. It assumes that you have set up the keymap, window, and @@ -324,12 +322,13 @@ This can be convenient for people who find it easier to hit ) than C-f." ((and (memq syntax '(?\( ?\" ?\$)) (use-region-p)) (if (> (mark) (point)) (goto-char (mark)) - ;; We already inserted the open-paren but at the end of the region, - ;; so we have to remove it and start over. - (delete-char -1) - (save-excursion + ;; We already inserted the open-paren but at the end of the + ;; region, so we have to remove it and start over. + (delete-char -1) + (save-excursion (goto-char (mark)) - (insert last-command-event))) + ;; Do not insert after `save-excursion' marker (Bug#11520). + (insert-before-markers last-command-event))) (insert closer)) ;; Backslash-escaped: no pairing, no skipping. ((save-excursion @@ -394,16 +393,16 @@ arguments that returns one of those symbols.") (not (nth 8 (save-excursion (syntax-ppss pos))))) (let ((end (copy-marker (point) t))) (goto-char pos) - (case (if (functionp rule) (funcall rule) rule) + (pcase (if (functionp rule) (funcall rule) rule) ;; FIXME: we used `newline' down here which called ;; self-insert-command and ran post-self-insert-hook recursively. ;; It happened to make electric-indent-mode work automatically with ;; electric-layout-mode (at the cost of re-indenting lines ;; multiple times), but I'm not sure it's what we want. - (before (goto-char (1- pos)) (skip-chars-backward " \t") + (`before (goto-char (1- pos)) (skip-chars-backward " \t") (unless (bolp) (insert "\n"))) - (after (insert "\n")) ; FIXME: check eolp before inserting \n? - (around (save-excursion + (`after (insert "\n")) ; FIXME: check eolp before inserting \n? + (`around (save-excursion (goto-char (1- pos)) (skip-chars-backward " \t") (unless (bolp) (insert "\n"))) (insert "\n"))) ; FIXME: check eolp before inserting \n? diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 09dde2c1c17..cac76d2bce1 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -2542,7 +2542,7 @@ definition (see the code for `documentation')." For that it has to be fbound with a non-autoload definition." (and (symbolp function) (fboundp function) - (not (eq (car-safe (symbol-function function)) 'autoload)))) + (not (autoloadp (symbol-function function))))) ;; The following two are necessary for the sake of packages such as ;; ange-ftp which redefine functions via fcell indirection: diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el index babb5bf8fc9..20cc38cd9c2 100644 --- a/lisp/emacs-lisp/authors.el +++ b/lisp/emacs-lisp/authors.el @@ -427,7 +427,7 @@ Changes to files in this list are not listed.") ;; No longer distributed. ;;; ("Ishikawa Chiaki" :changed "aviion.h" "dgux.h") ;; ymakefile no longer distributed. - ("Michael K. Johnson" :changed "configure.in" "emacs.c" "intel386.h" + ("Michael K. Johnson" :changed "configure.ac" "emacs.c" "intel386.h" "mem-limits.h" "process.c" "template.h" "sysdep.c" "syssignal.h" "systty.h" "unexcoff.c" "linux.h") ;; No longer distributed. @@ -580,6 +580,7 @@ in the repository.") ("s/windowsnt.h" . "s/ms-w32.h") ("winnt.el" . "w32-fns.el") ("config.emacs" . "configure") + ("configure.in" . "configure.ac") ("config.h.dist" . "config.in") ("config.h-dist" . "config.in") ("config.h.in" . "config.in") @@ -702,7 +703,7 @@ or is on the list of removed files. Returns the non-directory part of the file name. Only uses the LOG-FILE position POS and associated AUTHOR to print a message if FILE is not found." ;; FILE should be re-checked in every different directory associated - ;; with a LOG-FILE. Eg configure.in from src/ChangeLog is not the + ;; with a LOG-FILE. Eg configure.ac from src/ChangeLog is not the ;; same as that from top-level/ChangeLog. (let* ((fullname (expand-file-name file (file-name-directory log-file))) (entry (assoc fullname authors-checked-files-alist)) diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index fba8915fd5f..3fc185dda25 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -155,30 +155,31 @@ expression, in which case we want to handle forms differently." define-overloadable-function)) (let* ((macrop (memq car '(defmacro defmacro*))) (name (nth 1 form)) - (args (cl-case car - ((defun defmacro defun* defmacro* - define-overloadable-function) (nth 2 form)) - ((define-skeleton) '(&optional str arg)) - ((define-generic-mode define-derived-mode - define-compilation-mode) nil) - (t))) - (body (nthcdr (or (get car 'doc-string-elt) 3) form)) + (args (pcase car + ((or `defun `defmacro + `defun* `defmacro* `cl-defun `cl-defmacro + `define-overloadable-function) (nth 2 form)) + (`define-skeleton '(&optional str arg)) + ((or `define-generic-mode `define-derived-mode + `define-compilation-mode) nil) + (_ t))) + (body (nthcdr (or (function-get car 'doc-string-elt) 3) form)) (doc (if (stringp (car body)) (pop body)))) ;; Add the usage form at the end where describe-function-1 ;; can recover it. (when (listp args) (setq doc (help-add-fundoc-usage doc args))) ;; `define-generic-mode' quotes the name, so take care of that - (list 'autoload (if (listp name) name (list 'quote name)) - file doc - (or (and (memq car '(define-skeleton define-derived-mode - define-generic-mode - easy-mmode-define-global-mode - define-global-minor-mode - define-globalized-minor-mode - easy-mmode-define-minor-mode - define-minor-mode)) t) - (eq (car-safe (car body)) 'interactive)) - (if macrop (list 'quote 'macro) nil)))) + `(autoload ,(if (listp name) name (list 'quote name)) + ,file ,doc + ,(or (and (memq car '(define-skeleton define-derived-mode + define-generic-mode + easy-mmode-define-global-mode + define-global-minor-mode + define-globalized-minor-mode + easy-mmode-define-minor-mode + define-minor-mode)) t) + (eq (car-safe (car body)) 'interactive)) + ,(if macrop ''macro nil)))) ;; For defclass forms, use `eieio-defclass-autoload'. ((eq car 'defclass) @@ -276,7 +277,7 @@ put the output in." ;; Symbols at the toplevel are meaningless. ((symbolp form) nil) (t - (let ((doc-string-elt (get (car-safe form) 'doc-string-elt)) + (let ((doc-string-elt (function-get (car-safe form) 'doc-string-elt)) (outbuf autoload-print-form-outbuf)) (if (and doc-string-elt (stringp (nth doc-string-elt form))) ;; We need to hack the printing because the @@ -355,7 +356,7 @@ not be relied upon." "Insert the section-header line, which lists the file name and which functions are in it, etc." (insert generate-autoload-section-header) - (prin1 (list 'autoloads autoloads load-name file time) + (prin1 `(autoloads ,autoloads ,load-name ,file ,time) outbuf) (terpri outbuf) ;; Break that line at spaces, to avoid very long lines. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 92a10dff774..a4c3e8aac4e 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -249,8 +249,8 @@ (let* ((name (car form)) (localfn (cdr (assq name byte-compile-function-environment))) (fn (or localfn (and (fboundp name) (symbol-function name))))) - (when (and (consp fn) (eq (car fn) 'autoload)) - (load (nth 1 fn)) + (when (autoloadp fn) + (autoload-do-load fn) (setq fn (or (and (fboundp name) (symbol-function name)) (cdr (assq name byte-compile-function-environment))))) (pcase fn @@ -266,42 +266,30 @@ ;; (message "Inlining byte-code for %S!" name) ;; The byte-code will be really inlined in byte-compile-unfold-bcf. `(,fn ,@(cdr form))) - ((or (and `(lambda ,args . ,body) (let env nil)) - `(closure ,env ,args . ,body)) + ((or `(lambda . ,_) `(closure . ,_)) (if (not (or (eq fn localfn) ;From the same file => same mode. - (eq (not lexical-binding) (not env)))) ;Same mode. + (eq (car fn) ;Same mode. + (if lexical-binding 'closure 'lambda)))) ;; While byte-compile-unfold-bcf can inline dynbind byte-code into ;; letbind byte-code (or any other combination for that matter), we ;; can only inline dynbind source into dynbind source or letbind ;; source into letbind source. - ;; FIXME: we could of course byte-compile the inlined function - ;; first, and then inline its byte-code. - form - (let ((renv ())) - ;; Turn the function's closed vars (if any) into local let bindings. - (dolist (binding env) - (cond - ((consp binding) - ;; We check shadowing by the args, so that the `let' can be - ;; moved within the lambda, which can then be unfolded. - ;; FIXME: Some of those bindings might be unused in `body'. - (unless (memq (car binding) args) ;Shadowed. - (push `(,(car binding) ',(cdr binding)) renv))) - ((eq binding t)) - (t (push `(defvar ,binding) body)))) - (let ((newfn (if (eq fn localfn) - ;; If `fn' is from the same file, it has already - ;; been preprocessed! - `(function ,fn) - (byte-compile-preprocess - (if (null renv) - `(lambda ,args ,@body) - `(lambda ,args (let ,(nreverse renv) ,@body))))))) - (if (eq (car-safe newfn) 'function) - (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form))) - (byte-compile-log-warning - (format "Inlining closure %S failed" name)) - form))))) + (progn + ;; We can of course byte-compile the inlined function + ;; first, and then inline its byte-code. + (byte-compile name) + `(,(symbol-function name) ,@(cdr form))) + (let ((newfn (if (eq fn localfn) + ;; If `fn' is from the same file, it has already + ;; been preprocessed! + `(function ,fn) + (byte-compile-preprocess + (byte-compile--reify-function fn))))) + (if (eq (car-safe newfn) 'function) + (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form))) + (byte-compile-log-warning + (format "Inlining closure %S failed" name)) + form)))) (t ;; Give up on inlining. form)))) @@ -598,10 +586,11 @@ (let (opt new) (if (and (consp form) (symbolp (car form)) - (or (and for-effect - ;; we don't have any of these yet, but we might. - (setq opt (get (car form) 'byte-for-effect-optimizer))) - (setq opt (get (car form) 'byte-optimizer))) + (or ;; (and for-effect + ;; ;; We don't have any of these yet, but we might. + ;; (setq opt (get (car form) + ;; 'byte-for-effect-optimizer))) + (setq opt (function-get (car form) 'byte-optimizer))) (not (eq form (setq new (funcall opt form))))) (progn ;; (if (equal form new) (error "bogus optimizer -- %s" opt)) @@ -642,10 +631,10 @@ (while (eq (car-safe form) 'progn) (setq form (car (last (cdr form))))) (cond ((consp form) - (cl-case (car form) - (quote (cadr form)) + (pcase (car form) + (`quote (cadr form)) ;; Can't use recursion in a defsubst. - ;; (progn (byte-compile-trueconstp (car (last (cdr form))))) + ;; (`progn (byte-compile-trueconstp (car (last (cdr form))))) )) ((not (symbolp form))) ((eq form t)) @@ -656,10 +645,10 @@ (while (eq (car-safe form) 'progn) (setq form (car (last (cdr form))))) (cond ((consp form) - (cl-case (car form) - (quote (null (cadr form))) + (pcase (car form) + (`quote (null (cadr form))) ;; Can't use recursion in a defsubst. - ;; (progn (byte-compile-nilconstp (car (last (cdr form))))) + ;; (`progn (byte-compile-nilconstp (car (last (cdr form))))) )) ((not (symbolp form)) nil) ((null form)))) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 934c0f01fcd..e5df8dd112c 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 toggle-read-only) + goto-line comint-run delete-backward-char) "List of commands that are not meant to be called from Lisp.") (defvar byte-compile-not-obsolete-vars nil @@ -1355,7 +1355,7 @@ extra args." nums sig min max) (when calls (when (and (symbolp name) - (eq (get name 'byte-optimizer) + (eq (function-get name 'byte-optimizer) 'byte-compile-inline-expand)) (byte-compile-warn "defsubst `%s' was used before it was defined" name)) @@ -1591,10 +1591,11 @@ that already has a `.elc' file." (not (auto-save-file-name-p source)) (not (string-equal dir-locals-file (file-name-nondirectory source)))) - (progn (cl-case (byte-recompile-file source force arg) - (no-byte-compile (setq skip-count (1+ skip-count))) - ((t) (setq file-count (1+ file-count))) - ((nil) (setq fail-count (1+ fail-count)))) + (progn (cl-incf + (pcase (byte-recompile-file source force arg) + (`no-byte-compile skip-count) + (`t file-count) + (_ fail-count))) (or noninteractive (message "Checking %s..." directory)) (if (not (eq last-dir directory)) @@ -1725,14 +1726,18 @@ The value is non-nil if there were no errors, nil if errors." (set-buffer-multibyte nil)) ;; Run hooks including the uncompression hook. ;; If they change the file name, then change it for the output also. - (cl-letf ((buffer-file-name filename) - ((default-value 'major-mode) 'emacs-lisp-mode) - ;; Ignore unsafe local variables. - ;; We only care about a few of them for our purposes. - (enable-local-variables :safe) - (enable-local-eval nil)) - ;; Arg of t means don't alter enable-local-variables. - (normal-mode t) + (let ((buffer-file-name filename) + (dmm (default-value 'major-mode)) + ;; Ignore unsafe local variables. + ;; We only care about a few of them for our purposes. + (enable-local-variables :safe) + (enable-local-eval nil)) + (unwind-protect + (progn + (setq-default major-mode 'emacs-lisp-mode) + ;; Arg of t means don't alter enable-local-variables. + (normal-mode t)) + (setq-default major-mode dmm)) ;; There may be a file local variable setting (bug#10419). (setq buffer-read-only nil filename buffer-file-name)) @@ -2363,7 +2368,7 @@ not to take responsibility for the actual compilation of the code." ;;(byte-compile-set-symbol-position name) (byte-compile-warn "probable `\"' without `\\' in doc string of %s" name)) - + (if (not (listp body)) ;; The precise definition requires evaluation to find out, so it ;; will only be known at runtime. @@ -2447,7 +2452,26 @@ If QUOTED is non-nil, print with quoting; otherwise, print without quoting." (- (position-bytes (point)) (point-min) -1) (goto-char (point-max)))))) - +(defun byte-compile--reify-function (fun) + "Return an expression which will evaluate to a function value FUN. +FUN should be either a `lambda' value or a `closure' value." + (pcase-let* (((or (and `(lambda ,args . ,body) (let env nil)) + `(closure ,env ,args . ,body)) fun) + (renv ())) + ;; Turn the function's closed vars (if any) into local let bindings. + (dolist (binding env) + (cond + ((consp binding) + ;; We check shadowing by the args, so that the `let' can be moved + ;; within the lambda, which can then be unfolded. FIXME: Some of those + ;; bindings might be unused in `body'. + (unless (memq (car binding) args) ;Shadowed. + (push `(,(car binding) ',(cdr binding)) renv))) + ((eq binding t)) + (t (push `(defvar ,binding) body)))) + (if (null renv) + `(lambda ,args ,@body) + `(lambda ,args (let ,(nreverse renv) ,@body))))) ;;;###autoload (defun byte-compile (form) @@ -2455,23 +2479,39 @@ If QUOTED is non-nil, print with quoting; otherwise, print without quoting." If FORM is a lambda or a macro, byte-compile it as a function." (displaying-byte-compile-warnings (byte-compile-close-variables - (let* ((fun (if (symbolp form) + (let* ((lexical-binding lexical-binding) + (fun (if (symbolp form) (and (fboundp form) (symbol-function form)) form)) (macro (eq (car-safe fun) 'macro))) (if macro (setq fun (cdr fun))) - (cond ((eq (car-safe fun) 'lambda) - ;; Expand macros. - (setq fun (byte-compile-preprocess fun)) - ;; Get rid of the `function' quote added by the `lambda' macro. - (if (eq (car-safe fun) 'function) (setq fun (cadr fun))) - (setq fun (if macro - (cons 'macro (byte-compile-lambda fun)) - (byte-compile-lambda fun))) - (if (symbolp form) - (defalias form fun) - fun))))))) + (cond + ;; Up until Emacs-24.1, byte-compile silently did nothing when asked to + ;; compile something invalid. So let's tune down the complaint from an + ;; error to a simple message for the known case where signaling an error + ;; causes problems. + ((byte-code-function-p fun) + (message "Function %s is already compiled" + (if (symbolp form) form "provided")) + fun) + (t + (when (symbolp form) + (unless (memq (car-safe fun) '(closure lambda)) + (error "Don't know how to compile %S" fun)) + (setq fun (byte-compile--reify-function fun)) + (setq lexical-binding (eq (car fun) 'closure))) + (unless (eq (car-safe fun) 'lambda) + (error "Don't know how to compile %S" fun)) + ;; Expand macros. + (setq fun (byte-compile-preprocess fun)) + ;; Get rid of the `function' quote added by the `lambda' macro. + (if (eq (car-safe fun) 'function) (setq fun (cadr fun))) + (setq fun (byte-compile-lambda fun)) + (if macro (push 'macro fun)) + (if (symbolp form) + (fset form fun) + fun))))))) (defun byte-compile-sexp (sexp) "Compile and return SEXP." @@ -2935,12 +2975,12 @@ That command is designed for interactive use only" fn)) ;; Old-style byte-code. (cl-assert (listp fargs)) (while fargs - (cl-case (car fargs) - (&optional (setq fargs (cdr fargs))) - (&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1)) + (pcase (car fargs) + (`&optional (setq fargs (cdr fargs))) + (`&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1)) (push (cadr fargs) dynbinds) (setq fargs nil)) - (t (push (pop fargs) dynbinds)))) + (_ (push (pop fargs) dynbinds)))) (unless fmax2 (setq fmax2 (* 2 (length dynbinds))))) (cond ((<= (+ alen alen) fmax2) @@ -2985,10 +3025,10 @@ That command is designed for interactive use only" fn)) (and od (not (memq var byte-compile-not-obsolete-vars)) (not (memq var byte-compile-global-not-obsolete-vars)) - (or (cl-case (nth 1 od) - (set (not (eq access-type 'reference))) - (get (eq access-type 'reference)) - (t t))))) + (or (pcase (nth 1 od) + (`set (not (eq access-type 'reference))) + (`get (eq access-type 'reference)) + (_ t))))) (byte-compile-warn-obsolete var)))) (defsubst byte-compile-dynamic-variable-op (base-op var) @@ -4312,21 +4352,21 @@ invoked interactively." (if byte-compile-call-tree-sort (setq byte-compile-call-tree (sort byte-compile-call-tree - (cl-case byte-compile-call-tree-sort - (callers + (pcase byte-compile-call-tree-sort + (`callers (lambda (x y) (< (length (nth 1 x)) (length (nth 1 y))))) - (calls + (`calls (lambda (x y) (< (length (nth 2 x)) (length (nth 2 y))))) - (calls+callers + (`calls+callers (lambda (x y) (< (+ (length (nth 1 x)) (length (nth 2 x))) (+ (length (nth 1 y)) (length (nth 2 y)))))) - (name + (`name (lambda (x y) (string< (car x) (car y)))) - (t (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode" + (_ (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode" byte-compile-call-tree-sort)))))) (message "Generating call tree...") (let ((rest byte-compile-call-tree) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 6f411bdeb30..5a1d6265848 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -346,13 +346,13 @@ places where they originally did not directly appear." (if (not (eq (cadr mapping) 'apply-partially)) mapping (cl-assert (eq (car mapping) (nth 2 mapping))) - (cl-list* (car mapping) - 'apply-partially - (car mapping) - (mapcar (lambda (arg) - (if (eq var arg) - closedsym arg)) - (nthcdr 3 mapping))))) + `(,(car mapping) + apply-partially + ,(car mapping) + ,@(mapcar (lambda (arg) + (if (eq var arg) + closedsym arg)) + (nthcdr 3 mapping))))) new-env)) (setq new-extend (remq var new-extend)) (push closedsym new-extend) @@ -559,8 +559,8 @@ FORM is the parent form that binds this var." (when (car y) (setcar x t) (setq free t)) (setq x (cdr x) y (cdr y))) (when free - (cl-push (caar env) (cdr freevars)) - (cl-setf (nth 3 (car env)) t)) + (push (caar env) (cdr freevars)) + (setf (nth 3 (car env)) t)) (setq env (cdr env) envcopy (cdr envcopy)))))) (defun cconv-analyse-form (form env) @@ -610,7 +610,7 @@ and updates the data stored in ENV." ;; it is a mutated variable. (while forms (let ((v (assq (car forms) env))) ; v = non nil if visible - (when v (cl-setf (nth 2 v) t))) + (when v (setf (nth 2 v) t))) (cconv-analyse-form (cadr forms) env) (setq forms (cddr forms)))) @@ -656,7 +656,7 @@ and updates the data stored in ENV." ;; lambda candidate list. (let ((fdata (and (symbolp fun) (assq fun env)))) (if fdata - (cl-setf (nth 4 fdata) t) + (setf (nth 4 fdata) t) (cconv-analyse-form fun env))) (dolist (form args) (cconv-analyse-form form env))) @@ -676,7 +676,7 @@ and updates the data stored in ENV." ((pred symbolp) (let ((dv (assq form env))) ; dv = declared and visible (when dv - (cl-setf (nth 1 dv) t)))))) + (setf (nth 1 dv) t)))))) (provide 'cconv) ;;; cconv.el ends here diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el index 74087014d69..31aeb1f8076 100644 --- a/lisp/emacs-lisp/chart.el +++ b/lisp/emacs-lisp/chart.el @@ -1,4 +1,4 @@ -;;; chart.el --- Draw charts (bar charts, etc) +;;; chart.el --- Draw charts (bar charts, etc) -*- lexical-binding: t -*- ;; Copyright (C) 1996, 1998-1999, 2001, 2004-2005, 2007-2012 ;; Free Software Foundation, Inc. @@ -156,7 +156,7 @@ Returns the newly created buffer." ) "Superclass for all charts to be displayed in an Emacs buffer.") -(defmethod initialize-instance :AFTER ((obj chart) &rest fields) +(defmethod initialize-instance :AFTER ((obj chart) &rest _fields) "Initialize the chart OBJ being created with FIELDS. Make sure the width/height is correct." (oset obj x-width (- (window-width) 10)) @@ -276,7 +276,7 @@ START and END represent the boundary." (float (- (cdr range) (car range))))))))) ) -(defmethod chart-axis-draw ((a chart-axis-range) &optional dir margin zone start end) +(defmethod chart-axis-draw ((a chart-axis-range) &optional dir margin zone _start _end) "Draw axis information based upon a range to be spread along the edge. A is the chart to draw. DIR is the direction. MARGIN, ZONE, START, and END specify restrictions in chart space." @@ -329,7 +329,7 @@ Automatically compensates for direction." (+ m -1 (round (* lpn (+ 1.0 (float n)))))) )) -(defmethod chart-axis-draw ((a chart-axis-names) &optional dir margin zone start end) +(defmethod chart-axis-draw ((a chart-axis-names) &optional dir margin zone _start _end) "Draw axis information based upon A range to be spread along the edge. Optional argument DIR is the direction of the chart. Optional arguments MARGIN, ZONE, START and END specify boundaries of the drawing." @@ -675,28 +675,14 @@ SORT-PRED if desired." (defun chart-emacs-storage () "Chart the current storage requirements of Emacs." (interactive) - (let* ((data (garbage-collect)) - (names '("strings/2" "vectors" - "conses" "free cons" - "syms" "free syms" - "markers" "free mark" - ;; "floats" "free flt" - )) - (nums (list (/ (nth 3 data) 2) - (nth 4 data) - (car (car data)) ; conses - (cdr (car data)) - (car (nth 1 data)) ; syms - (cdr (nth 1 data)) - (car (nth 2 data)) ; markers - (cdr (nth 2 data)) - ;(car (nth 5 data)) ; floats are Emacs only - ;(cdr (nth 5 data)) - ))) + (let* ((data (garbage-collect))) ;; Let's create the chart! (chart-bar-quickie 'vertical "Emacs Runtime Storage Usage" - names "Storage Items" - nums "Objects"))) + (mapcar (lambda (x) (symbol-name (car x))) data) + "Storage Items" + (mapcar (lambda (x) (* (nth 1 x) (nth 2 x))) + data) + "Bytes"))) (defun chart-emacs-lists () "Chart out the size of various important lists." diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 53c83e73d2e..ea5e1cf9beb 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -305,7 +305,7 @@ If so, return the true (non-nil) value returned by PREDICATE. (setq cl-ovl (cdr cl-ovl)))) (set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil))))) -;;; Support for `cl-setf'. +;;; Support for `setf'. ;;;###autoload (defun cl--set-frame-visible-p (frame val) (cond ((null val) (make-frame-invisible frame)) @@ -313,25 +313,6 @@ If so, return the true (non-nil) value returned by PREDICATE. (t (make-frame-visible frame))) val) -;;; Support for `cl-progv'. -(defvar cl--progv-save) -;;;###autoload -(defun cl--progv-before (syms values) - (while syms - (push (if (boundp (car syms)) - (cons (car syms) (symbol-value (car syms))) - (car syms)) cl--progv-save) - (if values - (set (pop syms) (pop values)) - (makunbound (pop syms))))) - -(defun cl--progv-after () - (while cl--progv-save - (if (consp (car cl--progv-save)) - (set (car (car cl--progv-save)) (cdr (car cl--progv-save))) - (makunbound (car cl--progv-save))) - (pop cl--progv-save))) - ;;; Numbers. @@ -523,6 +504,10 @@ This sets the values of: `cl-most-positive-float', `cl-most-negative-float', "Return the subsequence of SEQ from START to END. If END is omitted, it defaults to the length of the sequence. If START or END is negative, it counts from the end." + (declare (gv-setter + (lambda (new) + `(progn (cl-replace ,seq ,new :start1 ,start :end1 ,end) + ,new)))) (if (stringp seq) (substring seq start end) (let (len) (and end (< end 0) (setq end (+ end (setq len (length seq))))) @@ -587,9 +572,11 @@ If START or END is negative, it counts from the end." (defun cl-get (sym tag &optional def) "Return the value of SYMBOL's PROPNAME property, or DEFAULT if none. \n(fn SYMBOL PROPNAME &optional DEFAULT)" - (declare (compiler-macro cl--compiler-macro-get)) + (declare (compiler-macro cl--compiler-macro-get) + (gv-setter (lambda (store) `(put ,sym ,tag ,store)))) (or (get sym tag) (and def + ;; Make sure `def' is really absent as opposed to set to nil. (let ((plist (symbol-plist sym))) (while (and plist (not (eq (car plist) tag))) (setq plist (cdr (cdr plist)))) @@ -601,12 +588,22 @@ If START or END is negative, it counts from the end." "Search PROPLIST for property PROPNAME; return its value or DEFAULT. PROPLIST is a list of the sort returned by `symbol-plist'. \n(fn PROPLIST PROPNAME &optional DEFAULT)" + (declare (gv-expander + (lambda (do) + (gv-letplace (getter setter) plist + (macroexp-let2 nil k tag + (macroexp-let2 nil d def + (funcall do `(cl-getf ,getter ,k ,d) + (lambda (v) + (funcall setter + `(cl--set-getf ,getter ,k ,v)))))))))) (setplist '--cl-getf-symbol-- plist) (or (get '--cl-getf-symbol-- tag) ;; Originally we called cl-get here, ;; but that fails, because cl-get has a compiler macro ;; definition that uses getf! (when def + ;; Make sure `def' is really absent as opposed to set to nil. (while (and plist (not (eq (car plist) tag))) (setq plist (cdr (cdr plist)))) (if plist (car (cdr plist)) def)))) diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index bf7f6232ab7..aa12c709b1a 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -91,6 +91,8 @@ ;;; Code: +(require 'macroexp) + (defvar cl-optimize-speed 1) (defvar cl-optimize-safety 1) @@ -123,7 +125,7 @@ a future Emacs interpreter will be able to use it.") (defmacro cl-incf (place &optional x) "Increment PLACE by X (1 by default). -PLACE may be a symbol, or any generalized variable allowed by `cl-setf'. +PLACE may be a symbol, or any generalized variable allowed by `setf'. The return value is the incremented value of PLACE." (declare (debug (place &optional form))) (if (symbolp place) @@ -132,38 +134,16 @@ The return value is the incremented value of PLACE." (defmacro cl-decf (place &optional x) "Decrement PLACE by X (1 by default). -PLACE may be a symbol, or any generalized variable allowed by `cl-setf'. +PLACE may be a symbol, or any generalized variable allowed by `setf'. The return value is the decremented value of PLACE." (declare (debug cl-incf)) (if (symbolp place) (list 'setq place (if x (list '- place x) (list '1- place))) (list 'cl-callf '- place (or x 1)))) -;; Autoloaded, but we haven't loaded cl-loaddefs yet. -(declare-function cl-do-pop "cl-macs" (place)) - -(defmacro cl-pop (place) - "Remove and return the head of the list stored in PLACE. -Analogous to (prog1 (car PLACE) (cl-setf PLACE (cdr PLACE))), though more -careful about evaluating each argument only once and in the right order. -PLACE may be a symbol, or any generalized variable allowed by `cl-setf'." - (declare (debug (place))) - (if (symbolp place) - (list 'car (list 'prog1 place (list 'setq place (list 'cdr place)))) - (cl-do-pop place))) - -(defmacro cl-push (x place) - "Insert X at the head of the list stored in PLACE. -Analogous to (cl-setf PLACE (cons X PLACE)), though more careful about -evaluating each argument only once and in the right order. PLACE may -be a symbol, or any generalized variable allowed by `cl-setf'." - (declare (debug (form place))) - (if (symbolp place) (list 'setq place (list 'cons x place)) - (list 'cl-callf2 'cons x place))) - (defmacro cl-pushnew (x place &rest keys) "(cl-pushnew X PLACE): insert X at the head of the list if not already there. -Like (cl-push X PLACE), except that the list is unmodified if X is `eql' to +Like (push X PLACE), except that the list is unmodified if X is `eql' to an element already on the list. \nKeywords supported: :test :test-not :key \n(fn X PLACE [KEYWORD VALUE]...)" @@ -173,24 +153,21 @@ an element already on the list. [keywordp form]))) (if (symbolp place) (if (null keys) - `(let ((x ,x)) - (if (memql x ,place) + (macroexp-let2 nil var x + `(if (memql ,var ,place) ;; This symbol may later on expand to actual code which then - ;; trigger warnings like "value unused" since cl-pushnew's return - ;; value is rarely used. It should not matter that other - ;; warnings may be silenced, since `place' is used earlier and - ;; should have triggered them already. + ;; trigger warnings like "value unused" since cl-pushnew's + ;; return value is rarely used. It should not matter that + ;; other warnings may be silenced, since `place' is used + ;; earlier and should have triggered them already. (with-no-warnings ,place) - (setq ,place (cons x ,place)))) + (setq ,place (cons ,var ,place)))) (list 'setq place (cl-list* 'cl-adjoin x place keys))) (cl-list* 'cl-callf2 'cl-adjoin x place keys))) (defun cl--set-elt (seq n val) (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val))) -(defsubst cl--set-nthcdr (n list x) - (if (<= n 0) x (setcdr (nthcdr (1- n) list) x) list)) - (defun cl--set-buffer-substring (start end val) (save-excursion (delete-region start end) (goto-char start) @@ -253,12 +230,13 @@ one value." "Apply FUNCTION to ARGUMENTS, taking multiple values into account. This implementation only handles the case where there is only one argument.") -(defsubst cl-nth-value (n expression) +(cl--defalias 'cl-nth-value #'nth "Evaluate EXPRESSION to get multiple values and return the Nth one. This handles multiple values in Common Lisp style, but it does not work right when EXPRESSION calls an ordinary Emacs Lisp function that returns just -one value." - (nth n expression)) +one value. + +\(fn N EXPRESSION)") ;;; Declarations. @@ -403,26 +381,32 @@ SEQ, this is like `mapcar'. With several, it is like the Common Lisp (defsubst cl-fifth (x) "Return the fifth element of the list X." + (declare (gv-setter (lambda (store) `(setcar (nthcdr 4 ,x) ,store)))) (nth 4 x)) (defsubst cl-sixth (x) "Return the sixth element of the list X." + (declare (gv-setter (lambda (store) `(setcar (nthcdr 5 ,x) ,store)))) (nth 5 x)) (defsubst cl-seventh (x) "Return the seventh element of the list X." + (declare (gv-setter (lambda (store) `(setcar (nthcdr 6 ,x) ,store)))) (nth 6 x)) (defsubst cl-eighth (x) "Return the eighth element of the list X." + (declare (gv-setter (lambda (store) `(setcar (nthcdr 7 ,x) ,store)))) (nth 7 x)) (defsubst cl-ninth (x) "Return the ninth element of the list X." + (declare (gv-setter (lambda (store) `(setcar (nthcdr 8 ,x) ,store)))) (nth 8 x)) (defsubst cl-tenth (x) "Return the tenth element of the list X." + (declare (gv-setter (lambda (store) `(setcar (nthcdr 9 ,x) ,store)))) (nth 9 x)) (defun cl-caaar (x) @@ -637,6 +621,108 @@ If ALIST is non-nil, the new pairs are prepended to it." (nconc (cl-mapcar 'cons keys values) alist)) +;;; Generalized variables. + +;; These used to be in cl-macs.el since all macros that use them (like setf) +;; were autoloaded from cl-macs.el. But now that setf, push, and pop are in +;; core Elisp, they need to either be right here or be autoloaded via +;; cl-loaddefs.el, which is more trouble than it is worth. + +;; Some more Emacs-related place types. +(gv-define-simple-setter buffer-file-name set-visited-file-name t) +(gv-define-setter buffer-modified-p (flag &optional buf) + `(with-current-buffer ,buf + (set-buffer-modified-p ,flag))) +(gv-define-simple-setter buffer-name rename-buffer t) +(gv-define-setter buffer-string (store) + `(progn (erase-buffer) (insert ,store))) +(gv-define-simple-setter buffer-substring cl--set-buffer-substring) +(gv-define-simple-setter current-buffer set-buffer) +(gv-define-simple-setter current-case-table set-case-table) +(gv-define-simple-setter current-column move-to-column t) +(gv-define-simple-setter current-global-map use-global-map t) +(gv-define-setter current-input-mode (store) + `(progn (apply #'set-input-mode ,store) ,store)) +(gv-define-simple-setter current-local-map use-local-map t) +(gv-define-simple-setter current-window-configuration + set-window-configuration t) +(gv-define-simple-setter default-file-modes set-default-file-modes t) +(gv-define-simple-setter documentation-property put) +(gv-define-setter face-background (x f &optional s) + `(set-face-background ,f ,x ,s)) +(gv-define-setter face-background-pixmap (x f &optional s) + `(set-face-background-pixmap ,f ,x ,s)) +(gv-define-setter face-font (x f &optional s) `(set-face-font ,f ,x ,s)) +(gv-define-setter face-foreground (x f &optional s) + `(set-face-foreground ,f ,x ,s)) +(gv-define-setter face-underline-p (x f &optional s) + `(set-face-underline-p ,f ,x ,s)) +(gv-define-simple-setter file-modes set-file-modes t) +(gv-define-simple-setter frame-height set-screen-height t) +(gv-define-simple-setter frame-parameters modify-frame-parameters t) +(gv-define-simple-setter frame-visible-p cl--set-frame-visible-p) +(gv-define-simple-setter frame-width set-screen-width t) +(gv-define-simple-setter getenv setenv t) +(gv-define-simple-setter get-register set-register) +(gv-define-simple-setter global-key-binding global-set-key) +(gv-define-simple-setter local-key-binding local-set-key) +(gv-define-simple-setter mark set-mark t) +(gv-define-simple-setter mark-marker set-mark t) +(gv-define-simple-setter marker-position set-marker t) +(gv-define-setter mouse-position (store scr) + `(set-mouse-position ,scr (car ,store) (cadr ,store) + (cddr ,store))) +(gv-define-simple-setter point goto-char) +(gv-define-simple-setter point-marker goto-char t) +(gv-define-setter point-max (store) + `(progn (narrow-to-region (point-min) ,store) ,store)) +(gv-define-setter point-min (store) + `(progn (narrow-to-region ,store (point-max)) ,store)) +(gv-define-setter read-mouse-position (store scr) + `(set-mouse-position ,scr (car ,store) (cdr ,store))) +(gv-define-simple-setter screen-height set-screen-height t) +(gv-define-simple-setter screen-width set-screen-width t) +(gv-define-simple-setter selected-window select-window) +(gv-define-simple-setter selected-screen select-screen) +(gv-define-simple-setter selected-frame select-frame) +(gv-define-simple-setter standard-case-table set-standard-case-table) +(gv-define-simple-setter syntax-table set-syntax-table) +(gv-define-simple-setter visited-file-modtime set-visited-file-modtime t) +(gv-define-setter window-height (store) + `(progn (enlarge-window (- ,store (window-height))) ,store)) +(gv-define-setter window-width (store) + `(progn (enlarge-window (- ,store (window-width)) t) ,store)) +(gv-define-simple-setter x-get-secondary-selection x-own-secondary-selection t) +(gv-define-simple-setter x-get-selection x-own-selection t) + +;; More complex setf-methods. + +;; This is a hack that allows (setf (eq a 7) B) to mean either +;; (setq a 7) or (setq a nil) depending on whether B is nil or not. +;; This is useful when you have control over the PLACE but not over +;; the VALUE, as is the case in define-minor-mode's :variable. +;; It turned out that :variable needed more flexibility anyway, so +;; this doesn't seem too useful now. +(gv-define-expander eq + (lambda (do place val) + (gv-letplace (getter setter) place + (macroexp-let2 nil val val + (funcall do `(eq ,getter ,val) + (lambda (v) + `(cond + (,v ,(funcall setter val)) + ((eq ,getter ,val) ,(funcall setter `(not ,val)))))))))) + +(gv-define-expander substring + (lambda (do place from &optional to) + (gv-letplace (getter setter) place + (macroexp-let2 nil start from + (macroexp-let2 nil end to + (funcall do `(substring ,getter ,start ,end) + (lambda (v) + (funcall setter `(cl--set-substring + ,getter ,start ,end ,v))))))))) + ;;; Miscellaneous. ;;;###autoload diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 7b1f8465dc5..e984d22f5d7 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -7,11 +7,11 @@ ;;;;;; cl-getf cl-get cl-tailp cl-list-length cl-nreconc cl-revappend ;;;;;; cl-concatenate cl-subseq cl-float-limits cl-random-state-p ;;;;;; cl-make-random-state cl-random cl-signum cl-rem cl-mod cl-round -;;;;;; cl-truncate cl-ceiling cl-floor cl-isqrt cl-lcm cl-gcd cl--progv-before -;;;;;; cl--set-frame-visible-p cl--map-overlays cl--map-intervals -;;;;;; cl--map-keymap-recursively cl-notevery cl-notany cl-every -;;;;;; cl-some cl-mapcon cl-mapcan cl-mapl cl-maplist cl-map cl--mapcar-many -;;;;;; cl-equalp cl-coerce) "cl-extra" "cl-extra.el" "1f486111e93d119ceb6e95c434e3fd4b") +;;;;;; cl-truncate cl-ceiling cl-floor cl-isqrt cl-lcm cl-gcd cl--set-frame-visible-p +;;;;;; cl--map-overlays cl--map-intervals cl--map-keymap-recursively +;;;;;; cl-notevery cl-notany cl-every cl-some cl-mapcon cl-mapcan +;;;;;; cl-mapl cl-maplist cl-map cl--mapcar-many cl-equalp cl-coerce) +;;;;;; "cl-extra" "cl-extra.el" "535a24c1cff55a16e3d51219498a7858") ;;; Generated autoloads from cl-extra.el (autoload 'cl-coerce "cl-extra" "\ @@ -102,11 +102,6 @@ Return true if PREDICATE is false of some element of SEQ or SEQs. \(fn FRAME VAL)" nil nil) -(autoload 'cl--progv-before "cl-extra" "\ - - -\(fn SYMS VALUES)" nil nil) - (autoload 'cl-gcd "cl-extra" "\ Return the greatest common divisor of the arguments. @@ -257,17 +252,15 @@ Remove from SYMBOL's plist the property PROPNAME and its value. ;;;### (autoloads (cl--compiler-macro-cXXr cl--compiler-macro-list* ;;;;;; cl--compiler-macro-adjoin cl-defsubst cl-compiler-macroexpand ;;;;;; cl-define-compiler-macro cl-assert cl-check-type cl-typep -;;;;;; cl-deftype cl-struct-setf-expander cl-defstruct cl-define-modify-macro -;;;;;; cl-callf2 cl-callf cl-letf* cl-letf cl-rotatef cl-shiftf -;;;;;; cl-remf cl-do-pop cl-psetf cl-setf cl-get-setf-method cl-defsetf -;;;;;; cl-define-setf-expander cl-declare cl-the cl-locally cl-multiple-value-setq -;;;;;; cl-multiple-value-bind cl-symbol-macrolet cl-macrolet cl-labels -;;;;;; cl-flet cl-progv cl-psetq cl-do-all-symbols cl-do-symbols -;;;;;; cl-dotimes cl-dolist cl-do* cl-do cl-loop cl-return-from -;;;;;; cl-return cl-block cl-etypecase cl-typecase cl-ecase cl-case -;;;;;; cl-load-time-value cl-eval-when cl-destructuring-bind cl-function -;;;;;; cl-defmacro cl-defun cl-gentemp cl-gensym) "cl-macs" "cl-macs.el" -;;;;;; "178bb5377dbd371f1038a7bf5f4d7f29") +;;;;;; cl-deftype cl-defstruct cl-callf2 cl-callf cl-letf* cl-letf +;;;;;; cl-rotatef cl-shiftf cl-remf cl-psetf cl-declare cl-the cl-locally +;;;;;; cl-multiple-value-setq cl-multiple-value-bind cl-symbol-macrolet +;;;;;; cl-macrolet cl-labels cl-flet* cl-flet cl-progv cl-psetq +;;;;;; cl-do-all-symbols cl-do-symbols cl-dotimes cl-dolist cl-do* +;;;;;; cl-do cl-loop cl-return-from cl-return cl-block cl-etypecase +;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when +;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp +;;;;;; cl-gensym) "cl-macs" "cl-macs.el" "570bedbd0b42cfe5ead36f6983e54829") ;;; Generated autoloads from cl-macs.el (autoload 'cl-gensym "cl-macs" "\ @@ -348,7 +341,7 @@ Key values are compared by `eql'. (put 'cl-case 'lisp-indent-function '1) (autoload 'cl-ecase "cl-macs" "\ -Like `cl-case', but error if no cl-case fits. +Like `cl-case', but error if no case fits. `otherwise'-clauses are not allowed. \(fn EXPR (KEYLIST BODY...)...)" nil t) @@ -443,6 +436,8 @@ An implicit nil block is established around the loop. \(fn (VAR LIST [RESULT]) BODY...)" nil t) +(put 'cl-dolist 'lisp-indent-function '1) + (autoload 'cl-dotimes "cl-macs" "\ Loop a certain number of times. Evaluate BODY with VAR bound to successive integers from 0, inclusive, @@ -451,6 +446,8 @@ nil. \(fn (VAR COUNT [RESULT]) BODY...)" nil t) +(put 'cl-dotimes 'lisp-indent-function '1) + (autoload 'cl-do-symbols "cl-macs" "\ Loop over all symbols. Evaluate BODY with VAR bound to each interned symbol, or to each symbol @@ -494,9 +491,18 @@ Like `cl-labels' but the definitions are not recursive. (put 'cl-flet 'lisp-indent-function '1) +(autoload 'cl-flet* "cl-macs" "\ +Make temporary function definitions. +Like `cl-flet' but the definitions can refer to previous ones. + +\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t) + +(put 'cl-flet* 'lisp-indent-function '1) + (autoload 'cl-labels "cl-macs" "\ Make temporary function bindings. -The bindings can be recursive. Assumes the use of `lexical-binding'. +The bindings can be recursive and the scoping is lexical, but capturing them +in closures will only work if `lexical-binding' is in use. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t) @@ -513,7 +519,7 @@ This is like `cl-flet', but for macros instead of functions. (autoload 'cl-symbol-macrolet "cl-macs" "\ Make symbol macro definitions. Within the body FORMs, references to the variable NAME will be replaced -by EXPANSION, and (setq NAME ...) will act like (cl-setf EXPANSION ...). +by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). \(fn ((NAME EXPANSION) ...) FORM...)" nil t) @@ -565,69 +571,16 @@ See Info node `(cl)Declarations' for details. \(fn &rest SPECS)" nil t) -(autoload 'cl-define-setf-expander "cl-macs" "\ -Define a `cl-setf' method. -This method shows how to handle `cl-setf's to places of the form (NAME ARGS...). -The argument forms ARGS are bound according to ARGLIST, as if NAME were -going to be expanded as a macro, then the BODY forms are executed and must -return a list of five elements: a temporary-variables list, a value-forms -list, a store-variables list (of length one), a store-form, and an access- -form. See `cl-defsetf' for a simpler way to define most setf-methods. - -\(fn NAME ARGLIST BODY...)" nil t) - -(autoload 'cl-defsetf "cl-macs" "\ -Define a `cl-setf' method. -This macro is an easy-to-use substitute for `cl-define-setf-expander' that works -well for simple place forms. In the simple `cl-defsetf' form, `cl-setf's of -the form (cl-setf (NAME ARGS...) VAL) are transformed to function or macro -calls of the form (FUNC ARGS... VAL). Example: - - (cl-defsetf aref aset) - -Alternate form: (cl-defsetf NAME ARGLIST (STORE) BODY...). -Here, the above `cl-setf' call is expanded by binding the argument forms ARGS -according to ARGLIST, binding the value form VAL to STORE, then executing -BODY, which must return a Lisp form that does the necessary `cl-setf' operation. -Actually, ARGLIST and STORE may be bound to temporary variables which are -introduced automatically to preserve proper execution order of the arguments. -Example: - - (cl-defsetf nth (n x) (v) `(setcar (nthcdr ,n ,x) ,v)) - -\(fn NAME [FUNC | ARGLIST (STORE) BODY...])" nil t) - -(autoload 'cl-get-setf-method "cl-macs" "\ -Return a list of five values describing the setf-method for PLACE. -PLACE may be any Lisp form which can appear as the PLACE argument to -a macro like `cl-setf' or `cl-incf'. - -\(fn PLACE &optional ENV)" nil nil) - -(autoload 'cl-setf "cl-macs" "\ -Set each PLACE to the value of its VAL. -This is a generalized version of `setq'; the PLACEs may be symbolic -references such as (car x) or (aref x i), as well as plain symbols. -For example, (cl-setf (cl-cadar x) y) is equivalent to (setcar (cdar x) y). -The return value is the last VAL in the list. - -\(fn PLACE VAL PLACE VAL ...)" nil t) - (autoload 'cl-psetf "cl-macs" "\ Set PLACEs to the values VALs in parallel. -This is like `cl-setf', except that all VAL forms are evaluated (in order) +This is like `setf', except that all VAL forms are evaluated (in order) before assigning any PLACEs to the corresponding values. \(fn PLACE VAL PLACE VAL ...)" nil t) -(autoload 'cl-do-pop "cl-macs" "\ - - -\(fn PLACE)" nil nil) - (autoload 'cl-remf "cl-macs" "\ Remove TAG from property list PLACE. -PLACE may be a symbol, or any generalized variable allowed by `cl-setf'. +PLACE may be a symbol, or any generalized variable allowed by `setf'. The form returns true if TAG was found and removed, nil otherwise. \(fn PLACE TAG)" nil t) @@ -635,21 +588,21 @@ The form returns true if TAG was found and removed, nil otherwise. (autoload 'cl-shiftf "cl-macs" "\ Shift left among PLACEs. Example: (cl-shiftf A B C) sets A to B, B to C, and returns the old A. -Each PLACE may be a symbol, or any generalized variable allowed by `cl-setf'. +Each PLACE may be a symbol, or any generalized variable allowed by `setf'. \(fn PLACE... VAL)" nil t) (autoload 'cl-rotatef "cl-macs" "\ Rotate left among PLACEs. Example: (cl-rotatef A B C) sets A to B, B to C, and C to A. It returns nil. -Each PLACE may be a symbol, or any generalized variable allowed by `cl-setf'. +Each PLACE may be a symbol, or any generalized variable allowed by `setf'. \(fn PLACE...)" nil t) (autoload 'cl-letf "cl-macs" "\ Temporarily bind to PLACEs. This is the analogue of `let', but with generalized variables (in the -sense of `cl-setf') for the PLACEs. Each PLACE is set to the corresponding +sense of `setf') for the PLACEs. Each PLACE is set to the corresponding VALUE, then the BODY forms are executed. On exit, either normally or because of a `throw' or error, the PLACEs are set back to their original values. Note that this macro is *not* available in Common Lisp. @@ -662,24 +615,19 @@ the PLACE is not modified before executing BODY. (autoload 'cl-letf* "cl-macs" "\ Temporarily bind to PLACEs. -This is the analogue of `let*', but with generalized variables (in the -sense of `cl-setf') for the PLACEs. Each PLACE is set to the corresponding -VALUE, then the BODY forms are executed. On exit, either normally or -because of a `throw' or error, the PLACEs are set back to their original -values. Note that this macro is *not* available in Common Lisp. -As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', -the PLACE is not modified before executing BODY. +Like `cl-letf' but where the bindings are performed one at a time, +rather than all at the end (i.e. like `let*' rather than like `let'). -\(fn ((PLACE VALUE) ...) BODY...)" nil t) +\(fn BINDINGS &rest BODY)" nil t) (put 'cl-letf* 'lisp-indent-function '1) (autoload 'cl-callf "cl-macs" "\ Set PLACE to (FUNC PLACE ARGS...). FUNC should be an unquoted function name. PLACE may be a symbol, -or any generalized variable allowed by `cl-setf'. +or any generalized variable allowed by `setf'. -\(fn FUNC PLACE ARGS...)" nil t) +\(fn FUNC PLACE &rest ARGS)" nil t) (put 'cl-callf 'lisp-indent-function '2) @@ -691,19 +639,12 @@ Like `cl-callf', but PLACE is the second argument of FUNC, not the first. (put 'cl-callf2 'lisp-indent-function '3) -(autoload 'cl-define-modify-macro "cl-macs" "\ -Define a `cl-setf'-like modify macro. -If NAME is called, it combines its PLACE argument with the other arguments -from ARGLIST using FUNC: (cl-define-modify-macro cl-incf (&optional (n 1)) +) - -\(fn NAME ARGLIST FUNC &optional DOC)" nil t) - (autoload 'cl-defstruct "cl-macs" "\ Define a struct type. This macro defines a new data type called NAME that stores data in SLOTs. It defines a `make-NAME' constructor, a `copy-NAME' copier, a `NAME-p' predicate, and slot accessors named `NAME-SLOT'. -You can use the accessors to set the corresponding slots, via `cl-setf'. +You can use the accessors to set the corresponding slots, via `setf'. NAME may instead take the form (NAME OPTIONS...), where each OPTION is either a single keyword or (KEYWORD VALUE). @@ -712,17 +653,12 @@ See Info node `(cl)Structures' for a list of valid keywords. Each SLOT may instead take the form (SLOT SLOT-OPTS...), where SLOT-OPTS are keyword-value pairs for that slot. Currently, only one keyword is supported, `:read-only'. If this has a non-nil -value, that slot cannot be set via `cl-setf'. +value, that slot cannot be set via `setf'. \(fn NAME SLOTS...)" nil t) (put 'cl-defstruct 'doc-string-elt '2) -(autoload 'cl-struct-setf-expander "cl-macs" "\ - - -\(fn X NAME ACCESSOR PRED-FORM POS)" nil nil) - (autoload 'cl-deftype "cl-macs" "\ Define NAME as a new data type. The type name can then be used in `cl-typecase', `cl-check-type', etc. @@ -779,6 +715,8 @@ surrounded by (cl-block NAME ...). \(fn NAME ARGLIST [DOCSTRING] BODY...)" nil t) +(put 'cl-defsubst 'lisp-indent-function '2) + (autoload 'cl--compiler-macro-adjoin "cl-macs" "\ diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 982873af681..3c92f174a0a 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -45,6 +45,8 @@ (require 'cl-lib) (require 'macroexp) +;; `gv' is required here because cl-macs can be loaded before loaddefs.el. +(require 'gv) (defmacro cl-pop2 (place) (declare (debug edebug-sexps)) @@ -108,20 +110,6 @@ (defun cl--const-expr-val (x) (and (macroexp-const-p x) (if (consp x) (nth 1 x) x))) -(defun cl-expr-access-order (x v) - ;; This apparently tries to return nil iff the expression X evaluates - ;; the variables V in the same order as they appear in V (so as to - ;; be able to replace those vars with the expressions they're bound - ;; to). - ;; FIXME: This is very naive, it doesn't even check to see if those - ;; variables appear more than once. - (if (macroexp-const-p x) v - (if (consp x) - (progn - (while (setq x (cdr x)) (setq v (cl-expr-access-order (car x) v))) - v) - (if (eq x (car v)) (cdr v) '(t))))) - (defun cl--expr-contains (x y) "Count number of times X refers to Y. Return nil for 0 times." ;; FIXME: This is naive, and it will cl-count Y as referred twice in @@ -262,7 +250,7 @@ and BODY is implicitly surrounded by (cl-block NAME ...). \(fn NAME ARGLIST [DOCSTRING] BODY...)" (declare (debug ;; Same as defun but use cl-lambda-list. - (&define [&or name ("cl-setf" :name cl-setf name)] + (&define [&or name ("setf" :name setf name)] cl-lambda-list cl-declarations-or-string [&optional ("interactive" interactive)] @@ -362,28 +350,36 @@ its argument list allows full Common Lisp conventions." (t x))) (defun cl--make-usage-args (arglist) - ;; `orig-args' can contain &cl-defs (an internal - ;; CL thingy I don't understand), so remove it. - (let ((x (memq '&cl-defs arglist))) - (when x (setq arglist (delq (car x) (remq (cadr x) arglist))))) - (let ((state nil)) - (mapcar (lambda (x) - (cond - ((symbolp x) - (if (eq ?\& (aref (symbol-name x) 0)) - (setq state x) - (make-symbol (upcase (symbol-name x))))) - ((not (consp x)) x) - ((memq state '(nil &rest)) (cl--make-usage-args x)) - (t ;(VAR INITFORM SVAR) or ((KEYWORD VAR) INITFORM SVAR). - (cl-list* - (if (and (consp (car x)) (eq state '&key)) - (list (caar x) (cl--make-usage-var (nth 1 (car x)))) - (cl--make-usage-var (car x))) - (nth 1 x) ;INITFORM. - (cl--make-usage-args (nthcdr 2 x)) ;SVAR. - )))) - arglist))) + (if (cdr-safe (last arglist)) ;Not a proper list. + (let* ((last (last arglist)) + (tail (cdr last))) + (unwind-protect + (progn + (setcdr last nil) + (nconc (cl--make-usage-args arglist) (cl--make-usage-var tail))) + (setcdr last tail))) + ;; `orig-args' can contain &cl-defs (an internal + ;; CL thingy I don't understand), so remove it. + (let ((x (memq '&cl-defs arglist))) + (when x (setq arglist (delq (car x) (remq (cadr x) arglist))))) + (let ((state nil)) + (mapcar (lambda (x) + (cond + ((symbolp x) + (if (eq ?\& (aref (symbol-name x) 0)) + (setq state x) + (make-symbol (upcase (symbol-name x))))) + ((not (consp x)) x) + ((memq state '(nil &rest)) (cl--make-usage-args x)) + (t ;(VAR INITFORM SVAR) or ((KEYWORD VAR) INITFORM SVAR). + (cl-list* + (if (and (consp (car x)) (eq state '&key)) + (list (caar x) (cl--make-usage-var (nth 1 (car x)))) + (cl--make-usage-var (car x))) + (nth 1 x) ;INITFORM. + (cl--make-usage-args (nthcdr 2 x)) ;SVAR. + )))) + arglist)))) (defun cl--do-arglist (args expr &optional num) ; uses bind-* (if (nlistp args) @@ -628,7 +624,7 @@ Key values are compared by `eql'. ;;;###autoload (defmacro cl-ecase (expr &rest clauses) - "Like `cl-case', but error if no cl-case fits. + "Like `cl-case', but error if no case fits. `otherwise'-clauses are not allowed. \n(fn EXPR (KEYLIST BODY...)...)" (declare (indent 1) (debug cl-case)) @@ -1486,31 +1482,11 @@ Then evaluate RESULT to get return value, default nil. An implicit nil block is established around the loop. \(fn (VAR LIST [RESULT]) BODY...)" - (declare (debug ((symbolp form &optional form) cl-declarations body))) - (let ((temp (make-symbol "--cl-dolist-temp--"))) - ;; FIXME: Copy&pasted from subr.el. - `(cl-block nil - ;; This is not a reliable test, but it does not matter because both - ;; semantics are acceptable, tho one is slightly faster with dynamic - ;; scoping and the other is slightly faster (and has cleaner semantics) - ;; with lexical scoping. - ,(if lexical-binding - `(let ((,temp ,(nth 1 spec))) - (while ,temp - (let ((,(car spec) (car ,temp))) - ,@body - (setq ,temp (cdr ,temp)))) - ,@(if (cdr (cdr spec)) - ;; FIXME: This let often leads to "unused var" warnings. - `((let ((,(car spec) nil)) ,@(cdr (cdr spec)))))) - `(let ((,temp ,(nth 1 spec)) - ,(car spec)) - (while ,temp - (setq ,(car spec) (car ,temp)) - ,@body - (setq ,temp (cdr ,temp))) - ,@(if (cdr (cdr spec)) - `((setq ,(car spec) nil) ,@(cddr spec)))))))) + (declare (debug ((symbolp form &optional form) cl-declarations body)) + (indent 1)) + `(cl-block nil + (,(if (eq 'cl-dolist (symbol-function 'dolist)) 'cl--dolist 'dolist) + ,spec ,@body))) ;;;###autoload (defmacro cl-dotimes (spec &rest body) @@ -1520,31 +1496,10 @@ to COUNT, exclusive. Then evaluate RESULT to get return value, default nil. \(fn (VAR COUNT [RESULT]) BODY...)" - (declare (debug cl-dolist)) - (let ((temp (make-symbol "--cl-dotimes-temp--")) - (end (nth 1 spec))) - ;; FIXME: Copy&pasted from subr.el. - `(cl-block nil - ;; This is not a reliable test, but it does not matter because both - ;; semantics are acceptable, tho one is slightly faster with dynamic - ;; scoping and the other has cleaner semantics. - ,(if lexical-binding - (let ((counter '--dotimes-counter--)) - `(let ((,temp ,end) - (,counter 0)) - (while (< ,counter ,temp) - (let ((,(car spec) ,counter)) - ,@body) - (setq ,counter (1+ ,counter))) - ,@(if (cddr spec) - ;; FIXME: This let often leads to "unused var" warnings. - `((let ((,(car spec) ,counter)) ,@(cddr spec)))))) - `(let ((,temp ,end) - (,(car spec) 0)) - (while (< ,(car spec) ,temp) - ,@body - (cl-incf ,(car spec))) - ,@(cdr (cdr spec))))))) + (declare (debug cl-dolist) (indent 1)) + `(cl-block nil + (,(if (eq 'cl-dotimes (symbol-function 'dotimes)) 'cl--dotimes 'dotimes) + ,spec ,@body))) ;;;###autoload (defmacro cl-do-symbols (spec &rest body) @@ -1592,10 +1547,19 @@ second list (or made unbound if VALUES is shorter than SYMBOLS); then the BODY forms are executed and their result is returned. This is much like a `let' form, except that the list of symbols can be computed at run-time." (declare (indent 2) (debug (form form body))) - `(let ((cl--progv-save nil)) - (unwind-protect - (progn (cl--progv-before ,symbols ,values) ,@body) - (cl--progv-after)))) + (let ((bodyfun (make-symbol "cl--progv-body")) + (binds (make-symbol "binds")) + (syms (make-symbol "syms")) + (vals (make-symbol "vals"))) + `(progn + (defvar ,bodyfun) + (let* ((,syms ,symbols) + (,vals ,values) + (,bodyfun (lambda () ,@body)) + (,binds ())) + (while ,syms + (push (list (pop ,syms) (list 'quote (pop ,vals))) ,binds)) + (eval (list 'let ,binds '(funcall ,bodyfun))))))) (defvar cl--labels-convert-cache nil) @@ -1616,7 +1580,6 @@ a `let' form, except that the list of symbols can be computed at run-time." (setq cl--labels-convert-cache (cons f res)) res)))))) -;;; This should really have some way to shadow 'byte-compile properties, etc. ;;;###autoload (defmacro cl-flet (bindings &rest body) "Make temporary function definitions. @@ -1641,10 +1604,23 @@ Like `cl-labels' but the definitions are not recursive. (if (assq 'function newenv) newenv (cons (cons 'function #'cl--labels-convert) newenv))))))) +;;;###autoload +(defmacro cl-flet* (bindings &rest body) + "Make temporary function definitions. +Like `cl-flet' but the definitions can refer to previous ones. + +\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" + (declare (indent 1) (debug cl-flet)) + (cond + ((null bindings) (macroexp-progn body)) + ((null (cdr bindings)) `(cl-flet ,bindings ,@body)) + (t `(cl-flet (,(pop bindings)) (cl-flet* ,bindings ,@body))))) + ;;;###autoload (defmacro cl-labels (bindings &rest body) "Make temporary function bindings. -The bindings can be recursive. Assumes the use of `lexical-binding'. +The bindings can be recursive and the scoping is lexical, but capturing them +in closures will only work if `lexical-binding' is in use. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" (declare (indent 1) (debug cl-flet)) @@ -1707,12 +1683,12 @@ except that it additionally expands symbol macros." (when (cdr (assq (symbol-name cl-macro) cl-env)) (setq cl-macro (cadr (assq (symbol-name cl-macro) cl-env))))) ((eq 'setq (car-safe cl-macro)) - ;; Convert setq to cl-setf if required by symbol-macro expansion. + ;; Convert setq to setf if required by symbol-macro expansion. (let* ((args (mapcar (lambda (f) (cl--sm-macroexpand f cl-env)) (cdr cl-macro))) (p args)) (while (and p (symbolp (car p))) (setq p (cddr p))) - (if p (setq cl-macro (cons 'cl-setf args)) + (if p (setq cl-macro (cons 'setf args)) (setq cl-macro (cons 'setq args)) ;; Don't loop further. nil)))))) @@ -1722,13 +1698,13 @@ except that it additionally expands symbol macros." (defmacro cl-symbol-macrolet (bindings &rest body) "Make symbol macro definitions. Within the body FORMs, references to the variable NAME will be replaced -by EXPANSION, and (setq NAME ...) will act like (cl-setf EXPANSION ...). +by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). \(fn ((NAME EXPANSION) ...) FORM...)" (declare (indent 1) (debug ((&rest (symbol sexp)) cl-declarations body))) (cond ((cdr bindings) - `(cl-symbol-macrolet (,(car bindings)) + `(cl-symbol-macrolet (,(car bindings)) (cl-symbol-macrolet ,(cdr bindings) ,@body))) ((null bindings) (macroexp-progn body)) (t @@ -1738,8 +1714,8 @@ by EXPANSION, and (setq NAME ...) will act like (cl-setf EXPANSION ...). (fset 'macroexpand #'cl--sm-macroexpand) ;; FIXME: For N bindings, this will traverse `body' N times! (macroexpand-all (cons 'progn body) - (cons (list (symbol-name (caar bindings)) - (cl-cadar bindings)) + (cons (list (symbol-name (caar bindings)) + (cl-cadar bindings)) macroexpand-all-environment))) (fset 'macroexpand previous-macroexpand)))))) @@ -1862,408 +1838,18 @@ See Info node `(cl)Declarations' for details." -;;; Generalized variables. - -;;;###autoload -(defmacro cl-define-setf-expander (func args &rest body) - "Define a `cl-setf' method. -This method shows how to handle `cl-setf's to places of the form (NAME ARGS...). -The argument forms ARGS are bound according to ARGLIST, as if NAME were -going to be expanded as a macro, then the BODY forms are executed and must -return a list of five elements: a temporary-variables list, a value-forms -list, a store-variables list (of length one), a store-form, and an access- -form. See `cl-defsetf' for a simpler way to define most setf-methods. - -\(fn NAME ARGLIST BODY...)" - (declare (debug - (&define name cl-lambda-list cl-declarations-or-string def-body))) - `(cl-eval-when (compile load eval) - ,@(if (stringp (car body)) - (list `(put ',func 'setf-documentation ,(pop body)))) - (put ',func 'setf-method (cl-function (lambda ,args ,@body))))) - -;;;###autoload -(defmacro cl-defsetf (func arg1 &rest args) - "Define a `cl-setf' method. -This macro is an easy-to-use substitute for `cl-define-setf-expander' that works -well for simple place forms. In the simple `cl-defsetf' form, `cl-setf's of -the form (cl-setf (NAME ARGS...) VAL) are transformed to function or macro -calls of the form (FUNC ARGS... VAL). Example: - - (cl-defsetf aref aset) - -Alternate form: (cl-defsetf NAME ARGLIST (STORE) BODY...). -Here, the above `cl-setf' call is expanded by binding the argument forms ARGS -according to ARGLIST, binding the value form VAL to STORE, then executing -BODY, which must return a Lisp form that does the necessary `cl-setf' operation. -Actually, ARGLIST and STORE may be bound to temporary variables which are -introduced automatically to preserve proper execution order of the arguments. -Example: - - (cl-defsetf nth (n x) (v) `(setcar (nthcdr ,n ,x) ,v)) - -\(fn NAME [FUNC | ARGLIST (STORE) BODY...])" - (declare (debug - (&define name - [&or [symbolp &optional stringp] - [cl-lambda-list (symbolp)]] - cl-declarations-or-string def-body))) - (if (and (listp arg1) (consp args)) - (let* ((largs nil) (largsr nil) - (temps nil) (tempsr nil) - (restarg nil) (rest-temps nil) - (store-var (car (prog1 (car args) (setq args (cdr args))))) - (store-temp (intern (format "--%s--temp--" store-var))) - (lets1 nil) (lets2 nil) - (docstr nil) (p arg1)) - (if (stringp (car args)) - (setq docstr (prog1 (car args) (setq args (cdr args))))) - (while (and p (not (eq (car p) '&aux))) - (if (eq (car p) '&rest) - (setq p (cdr p) restarg (car p)) - (or (memq (car p) '(&optional &key &allow-other-keys)) - (setq largs (cons (if (consp (car p)) (car (car p)) (car p)) - largs) - temps (cons (intern (format "--%s--temp--" (car largs))) - temps)))) - (setq p (cdr p))) - (setq largs (nreverse largs) temps (nreverse temps)) - (if restarg - (setq largsr (append largs (list restarg)) - rest-temps (intern (format "--%s--temp--" restarg)) - tempsr (append temps (list rest-temps))) - (setq largsr largs tempsr temps)) - (let ((p1 largs) (p2 temps)) - (while p1 - (setq lets1 (cons `(,(car p2) - (make-symbol ,(format "--cl-%s--" (car p1)))) - lets1) - lets2 (cons (list (car p1) (car p2)) lets2) - p1 (cdr p1) p2 (cdr p2)))) - (if restarg (setq lets2 (cons (list restarg rest-temps) lets2))) - `(cl-define-setf-expander ,func ,arg1 - ,@(and docstr (list docstr)) - (let* - ,(nreverse - (cons `(,store-temp - (make-symbol ,(format "--cl-%s--" store-var))) - (if restarg - `((,rest-temps - (mapcar (lambda (_) (make-symbol "--cl-var--")) - ,restarg)) - ,@lets1) - lets1))) - (list ; 'values - (,(if restarg 'cl-list* 'list) ,@tempsr) - (,(if restarg 'cl-list* 'list) ,@largsr) - (list ,store-temp) - (let* - ,(nreverse - (cons (list store-var store-temp) - lets2)) - ,@args) - (,(if restarg 'cl-list* 'list) - ,@(cons `',func tempsr)))))) - `(cl-defsetf ,func (&rest args) (store) - ,(let ((call `(cons ',arg1 - (append args (list store))))) - (if (car args) - `(list 'progn ,call store) - call))))) - -;;; Some standard place types from Common Lisp. -(cl-defsetf aref aset) -(cl-defsetf car setcar) -(cl-defsetf cdr setcdr) -(cl-defsetf caar (x) (val) `(setcar (car ,x) ,val)) -(cl-defsetf cadr (x) (val) `(setcar (cdr ,x) ,val)) -(cl-defsetf cdar (x) (val) `(setcdr (car ,x) ,val)) -(cl-defsetf cddr (x) (val) `(setcdr (cdr ,x) ,val)) -(cl-defsetf elt (seq n) (store) - `(if (listp ,seq) (setcar (nthcdr ,n ,seq) ,store) - (aset ,seq ,n ,store))) -(cl-defsetf get put) -(cl-defsetf cl-get (x y &optional d) (store) `(put ,x ,y ,store)) -(cl-defsetf gethash (x h &optional d) (store) `(puthash ,x ,store ,h)) -(cl-defsetf nth (n x) (store) `(setcar (nthcdr ,n ,x) ,store)) -(cl-defsetf cl-subseq (seq start &optional end) (new) - `(progn (cl-replace ,seq ,new :start1 ,start :end1 ,end) ,new)) -(cl-defsetf symbol-function fset) -(cl-defsetf symbol-plist setplist) -(cl-defsetf symbol-value set) - -;;; Various car/cdr aliases. Note that `cadr' is handled specially. -(cl-defsetf cl-first setcar) -(cl-defsetf cl-second (x) (store) `(setcar (cdr ,x) ,store)) -(cl-defsetf cl-third (x) (store) `(setcar (cddr ,x) ,store)) -(cl-defsetf cl-fourth (x) (store) `(setcar (cl-cdddr ,x) ,store)) -(cl-defsetf cl-fifth (x) (store) `(setcar (nthcdr 4 ,x) ,store)) -(cl-defsetf cl-sixth (x) (store) `(setcar (nthcdr 5 ,x) ,store)) -(cl-defsetf cl-seventh (x) (store) `(setcar (nthcdr 6 ,x) ,store)) -(cl-defsetf cl-eighth (x) (store) `(setcar (nthcdr 7 ,x) ,store)) -(cl-defsetf cl-ninth (x) (store) `(setcar (nthcdr 8 ,x) ,store)) -(cl-defsetf cl-tenth (x) (store) `(setcar (nthcdr 9 ,x) ,store)) -(cl-defsetf cl-rest setcdr) - -;;; Some more Emacs-related place types. -(cl-defsetf buffer-file-name set-visited-file-name t) -(cl-defsetf buffer-modified-p (&optional buf) (flag) - `(with-current-buffer ,buf - (set-buffer-modified-p ,flag))) -(cl-defsetf buffer-name rename-buffer t) -(cl-defsetf buffer-string () (store) - `(progn (erase-buffer) (insert ,store))) -(cl-defsetf buffer-substring cl--set-buffer-substring) -(cl-defsetf current-buffer set-buffer) -(cl-defsetf current-case-table set-case-table) -(cl-defsetf current-column move-to-column t) -(cl-defsetf current-global-map use-global-map t) -(cl-defsetf current-input-mode () (store) - `(progn (apply #'set-input-mode ,store) ,store)) -(cl-defsetf current-local-map use-local-map t) -(cl-defsetf current-window-configuration set-window-configuration t) -(cl-defsetf default-file-modes set-default-file-modes t) -(cl-defsetf default-value set-default) -(cl-defsetf documentation-property put) -(cl-defsetf face-background (f &optional s) (x) `(set-face-background ,f ,x ,s)) -(cl-defsetf face-background-pixmap (f &optional s) (x) - `(set-face-background-pixmap ,f ,x ,s)) -(cl-defsetf face-font (f &optional s) (x) `(set-face-font ,f ,x ,s)) -(cl-defsetf face-foreground (f &optional s) (x) `(set-face-foreground ,f ,x ,s)) -(cl-defsetf face-underline-p (f &optional s) (x) - `(set-face-underline-p ,f ,x ,s)) -(cl-defsetf file-modes set-file-modes t) -(cl-defsetf frame-height set-screen-height t) -(cl-defsetf frame-parameters modify-frame-parameters t) -(cl-defsetf frame-visible-p cl--set-frame-visible-p) -(cl-defsetf frame-width set-screen-width t) -(cl-defsetf frame-parameter set-frame-parameter t) -(cl-defsetf terminal-parameter set-terminal-parameter) -(cl-defsetf getenv setenv t) -(cl-defsetf get-register set-register) -(cl-defsetf global-key-binding global-set-key) -(cl-defsetf keymap-parent set-keymap-parent) -(cl-defsetf local-key-binding local-set-key) -(cl-defsetf mark set-mark t) -(cl-defsetf mark-marker set-mark t) -(cl-defsetf marker-position set-marker t) -(cl-defsetf match-data set-match-data t) -(cl-defsetf mouse-position (scr) (store) - `(set-mouse-position ,scr (car ,store) (cadr ,store) - (cddr ,store))) -(cl-defsetf overlay-get overlay-put) -(cl-defsetf overlay-start (ov) (store) - `(progn (move-overlay ,ov ,store (overlay-end ,ov)) ,store)) -(cl-defsetf overlay-end (ov) (store) - `(progn (move-overlay ,ov (overlay-start ,ov) ,store) ,store)) -(cl-defsetf point goto-char) -(cl-defsetf point-marker goto-char t) -(cl-defsetf point-max () (store) - `(progn (narrow-to-region (point-min) ,store) ,store)) -(cl-defsetf point-min () (store) - `(progn (narrow-to-region ,store (point-max)) ,store)) -(cl-defsetf process-buffer set-process-buffer) -(cl-defsetf process-filter set-process-filter) -(cl-defsetf process-sentinel set-process-sentinel) -(cl-defsetf process-get process-put) -(cl-defsetf read-mouse-position (scr) (store) - `(set-mouse-position ,scr (car ,store) (cdr ,store))) -(cl-defsetf screen-height set-screen-height t) -(cl-defsetf screen-width set-screen-width t) -(cl-defsetf selected-window select-window) -(cl-defsetf selected-screen select-screen) -(cl-defsetf selected-frame select-frame) -(cl-defsetf standard-case-table set-standard-case-table) -(cl-defsetf syntax-table set-syntax-table) -(cl-defsetf visited-file-modtime set-visited-file-modtime t) -(cl-defsetf window-buffer set-window-buffer t) -(cl-defsetf window-display-table set-window-display-table t) -(cl-defsetf window-dedicated-p set-window-dedicated-p t) -(cl-defsetf window-height () (store) - `(progn (enlarge-window (- ,store (window-height))) ,store)) -(cl-defsetf window-hscroll set-window-hscroll) -(cl-defsetf window-parameter set-window-parameter) -(cl-defsetf window-point set-window-point) -(cl-defsetf window-start set-window-start) -(cl-defsetf window-width () (store) - `(progn (enlarge-window (- ,store (window-width)) t) ,store)) -(cl-defsetf x-get-secondary-selection x-own-secondary-selection t) -(cl-defsetf x-get-selection x-own-selection t) - -;; This is a hack that allows (cl-setf (eq a 7) B) to mean either -;; (setq a 7) or (setq a nil) depending on whether B is nil or not. -;; This is useful when you have control over the PLACE but not over -;; the VALUE, as is the case in define-minor-mode's :variable. -(cl-define-setf-expander eq (place val) - (let ((method (cl-get-setf-method place macroexpand-all-environment)) - (val-temp (make-symbol "--eq-val--")) - (store-temp (make-symbol "--eq-store--"))) - (list (append (nth 0 method) (list val-temp)) - (append (nth 1 method) (list val)) - (list store-temp) - `(let ((,(car (nth 2 method)) - (if ,store-temp ,val-temp (not ,val-temp)))) - ,(nth 3 method) ,store-temp) - `(eq ,(nth 4 method) ,val-temp)))) - -;;; More complex setf-methods. -;; These should take &environment arguments, but since full arglists aren't -;; available while compiling cl-macs, we fake it by referring to the global -;; variable macroexpand-all-environment directly. - -(cl-define-setf-expander apply (func arg1 &rest rest) - (or (and (memq (car-safe func) '(quote function cl-function)) - (symbolp (car-safe (cdr-safe func)))) - (error "First arg to apply in cl-setf is not (function SYM): %s" func)) - (let* ((form (cons (nth 1 func) (cons arg1 rest))) - (method (cl-get-setf-method form macroexpand-all-environment))) - (list (car method) (nth 1 method) (nth 2 method) - (cl-setf-make-apply (nth 3 method) (cadr func) (car method)) - (cl-setf-make-apply (nth 4 method) (cadr func) (car method))))) - -(defun cl-setf-make-apply (form func temps) - (if (eq (car form) 'progn) - `(progn ,(cl-setf-make-apply (cadr form) func temps) ,@(cddr form)) - (or (equal (last form) (last temps)) - (error "%s is not suitable for use with setf-of-apply" func)) - `(apply ',(car form) ,@(cdr form)))) - -(cl-define-setf-expander nthcdr (n place) - (let ((method (cl-get-setf-method place macroexpand-all-environment)) - (n-temp (make-symbol "--cl-nthcdr-n--")) - (store-temp (make-symbol "--cl-nthcdr-store--"))) - (list (cons n-temp (car method)) - (cons n (nth 1 method)) - (list store-temp) - `(let ((,(car (nth 2 method)) - (cl--set-nthcdr ,n-temp ,(nth 4 method) - ,store-temp))) - ,(nth 3 method) ,store-temp) - `(nthcdr ,n-temp ,(nth 4 method))))) - -(cl-define-setf-expander cl-getf (place tag &optional def) - (let ((method (cl-get-setf-method place macroexpand-all-environment)) - (tag-temp (make-symbol "--cl-getf-tag--")) - (def-temp (make-symbol "--cl-getf-def--")) - (store-temp (make-symbol "--cl-getf-store--"))) - (list (append (car method) (list tag-temp def-temp)) - (append (nth 1 method) (list tag def)) - (list store-temp) - `(let ((,(car (nth 2 method)) - (cl--set-getf ,(nth 4 method) ,tag-temp ,store-temp))) - ,(nth 3 method) ,store-temp) - `(cl-getf ,(nth 4 method) ,tag-temp ,def-temp)))) - -(cl-define-setf-expander substring (place from &optional to) - (let ((method (cl-get-setf-method place macroexpand-all-environment)) - (from-temp (make-symbol "--cl-substring-from--")) - (to-temp (make-symbol "--cl-substring-to--")) - (store-temp (make-symbol "--cl-substring-store--"))) - (list (append (car method) (list from-temp to-temp)) - (append (nth 1 method) (list from to)) - (list store-temp) - `(let ((,(car (nth 2 method)) - (cl--set-substring ,(nth 4 method) - ,from-temp ,to-temp ,store-temp))) - ,(nth 3 method) ,store-temp) - `(substring ,(nth 4 method) ,from-temp ,to-temp)))) - -;;; Getting and optimizing setf-methods. -;;;###autoload -(defun cl-get-setf-method (place &optional env) - "Return a list of five values describing the setf-method for PLACE. -PLACE may be any Lisp form which can appear as the PLACE argument to -a macro like `cl-setf' or `cl-incf'." - (if (symbolp place) - (let ((temp (make-symbol "--cl-setf--"))) - (list nil nil (list temp) `(setq ,place ,temp) place)) - (or (and (symbolp (car place)) - (let* ((func (car place)) - (name (symbol-name func)) - (method (get func 'setf-method)) - (case-fold-search nil)) - (or (and method - (let ((macroexpand-all-environment env)) - (setq method (apply method (cdr place)))) - (if (and (consp method) (= (length method) 5)) - method - (error "Setf-method for %s returns malformed method" - func))) - (and (string-match-p "\\`c[ad][ad][ad]?[ad]?r\\'" name) - (cl-get-setf-method (cl-compiler-macroexpand place))) - (and (eq func 'edebug-after) - (cl-get-setf-method (nth (1- (length place)) place) - env))))) - (if (eq place (setq place (macroexpand place env))) - (if (and (symbolp (car place)) (fboundp (car place)) - (symbolp (symbol-function (car place)))) - (cl-get-setf-method (cons (symbol-function (car place)) - (cdr place)) env) - (error "No setf-method known for %s" (car place))) - (cl-get-setf-method place env))))) - -(defun cl-setf-do-modify (place opt-expr) - (let* ((method (cl-get-setf-method place macroexpand-all-environment)) - (temps (car method)) (values (nth 1 method)) - (lets nil) (subs nil) - (optimize (and (not (eq opt-expr 'no-opt)) - (or (and (not (eq opt-expr 'unsafe)) - (cl--safe-expr-p opt-expr)) - (cl-setf-simple-store-p (car (nth 2 method)) - (nth 3 method))))) - (simple (and optimize (consp place) (cl--simple-exprs-p (cdr place))))) - (while values - (if (or simple (macroexp-const-p (car values))) - (push (cons (pop temps) (pop values)) subs) - (push (list (pop temps) (pop values)) lets))) - (list (nreverse lets) - (cons (car (nth 2 method)) (cl-sublis subs (nth 3 method))) - (cl-sublis subs (nth 4 method))))) - -(defun cl-setf-do-store (spec val) - (let ((sym (car spec)) - (form (cdr spec))) - (if (or (macroexp-const-p val) - (and (cl--simple-expr-p val) (eq (cl--expr-contains form sym) 1)) - (cl-setf-simple-store-p sym form)) - (cl-subst val sym form) - `(let ((,sym ,val)) ,form)))) - -(defun cl-setf-simple-store-p (sym form) - (and (consp form) (eq (cl--expr-contains form sym) 1) - (eq (nth (1- (length form)) form) sym) - (symbolp (car form)) (fboundp (car form)) - (not (eq (car-safe (symbol-function (car form))) 'macro)))) - ;;; The standard modify macros. -;;;###autoload -(defmacro cl-setf (&rest args) - "Set each PLACE to the value of its VAL. -This is a generalized version of `setq'; the PLACEs may be symbolic -references such as (car x) or (aref x i), as well as plain symbols. -For example, (cl-setf (cl-cadar x) y) is equivalent to (setcar (cdar x) y). -The return value is the last VAL in the list. -\(fn PLACE VAL PLACE VAL ...)" - (declare (debug (&rest [place form]))) - (if (cdr (cdr args)) - (let ((sets nil)) - (while args (push `(cl-setf ,(pop args) ,(pop args)) sets)) - (cons 'progn (nreverse sets))) - (if (symbolp (car args)) - (and args (cons 'setq args)) - (let* ((method (cl-setf-do-modify (car args) (nth 1 args))) - (store (cl-setf-do-store (nth 1 method) (nth 1 args)))) - (if (car method) `(let* ,(car method) ,store) store))))) +;; `setf' is now part of core Elisp, defined in gv.el. ;;;###autoload (defmacro cl-psetf (&rest args) "Set PLACEs to the values VALs in parallel. -This is like `cl-setf', except that all VAL forms are evaluated (in order) +This is like `setf', except that all VAL forms are evaluated (in order) before assigning any PLACEs to the corresponding values. \(fn PLACE VAL PLACE VAL ...)" - (declare (debug cl-setf)) + (declare (debug setf)) (let ((p args) (simple t) (vars nil)) (while p (if (or (not (symbolp (car p))) (cl--expr-depends-p (nth 1 p) vars)) @@ -2274,41 +1860,23 @@ before assigning any PLACEs to the corresponding values. (or p (error "Odd number of arguments to cl-psetf")) (pop p)) (if simple - `(progn (cl-setf ,@args) nil) + `(progn (setf ,@args) nil) (setq args (reverse args)) - (let ((expr `(cl-setf ,(cadr args) ,(car args)))) + (let ((expr `(setf ,(cadr args) ,(car args)))) (while (setq args (cddr args)) - (setq expr `(cl-setf ,(cadr args) (prog1 ,(car args) ,expr)))) + (setq expr `(setf ,(cadr args) (prog1 ,(car args) ,expr)))) `(progn ,expr nil))))) -;;;###autoload -(defun cl-do-pop (place) - (if (cl--simple-expr-p place) - `(prog1 (car ,place) (cl-setf ,place (cdr ,place))) - (let* ((method (cl-setf-do-modify place t)) - (temp (make-symbol "--cl-pop--"))) - `(let* (,@(car method) - (,temp ,(nth 2 method))) - (prog1 (car ,temp) - ,(cl-setf-do-store (nth 1 method) `(cdr ,temp))))))) - ;;;###autoload (defmacro cl-remf (place tag) "Remove TAG from property list PLACE. -PLACE may be a symbol, or any generalized variable allowed by `cl-setf'. +PLACE may be a symbol, or any generalized variable allowed by `setf'. The form returns true if TAG was found and removed, nil otherwise." (declare (debug (place form))) - (let* ((method (cl-setf-do-modify place t)) - (tag-temp (and (not (macroexp-const-p tag)) (make-symbol "--cl-remf-tag--"))) - (val-temp (and (not (cl--simple-expr-p place)) - (make-symbol "--cl-remf-place--"))) - (ttag (or tag-temp tag)) - (tval (or val-temp (nth 2 method)))) - `(let* (,@(car method) - ,@(and val-temp `((,val-temp ,(nth 2 method)))) - ,@(and tag-temp `((,tag-temp ,tag)))) - (if (eq ,ttag (car ,tval)) - (progn ,(cl-setf-do-store (nth 1 method) `(cddr ,tval)) + (gv-letplace (tval setter) place + (macroexp-let2 macroexp-copyable-p ttag tag + `(if (eq ,ttag (car ,tval)) + (progn ,(funcall setter `(cddr ,tval)) t) (cl--do-remf ,tval ,ttag))))) @@ -2316,7 +1884,7 @@ The form returns true if TAG was found and removed, nil otherwise." (defmacro cl-shiftf (place &rest args) "Shift left among PLACEs. Example: (cl-shiftf A B C) sets A to B, B to C, and returns the old A. -Each PLACE may be a symbol, or any generalized variable allowed by `cl-setf'. +Each PLACE may be a symbol, or any generalized variable allowed by `setf'. \(fn PLACE... VAL)" (declare (debug (&rest place))) @@ -2324,16 +1892,15 @@ Each PLACE may be a symbol, or any generalized variable allowed by `cl-setf'. ((null args) place) ((symbolp place) `(prog1 ,place (setq ,place (cl-shiftf ,@args)))) (t - (let ((method (cl-setf-do-modify place 'unsafe))) - `(let* ,(car method) - (prog1 ,(nth 2 method) - ,(cl-setf-do-store (nth 1 method) `(cl-shiftf ,@args)))))))) + (gv-letplace (getter setter) place + `(prog1 ,getter + ,(funcall setter `(cl-shiftf ,@args))))))) ;;;###autoload (defmacro cl-rotatef (&rest args) "Rotate left among PLACEs. Example: (cl-rotatef A B C) sets A to B, B to C, and C to A. It returns nil. -Each PLACE may be a symbol, or any generalized variable allowed by `cl-setf'. +Each PLACE may be a symbol, or any generalized variable allowed by `setf'. \(fn PLACE...)" (declare (debug (&rest place))) @@ -2348,19 +1915,71 @@ Each PLACE may be a symbol, or any generalized variable allowed by `cl-setf'. (temp (make-symbol "--cl-rotatef--")) (form temp)) (while (cdr places) - (let ((method (cl-setf-do-modify (pop places) 'unsafe))) - (setq form `(let* ,(car method) - (prog1 ,(nth 2 method) - ,(cl-setf-do-store (nth 1 method) form)))))) - (let ((method (cl-setf-do-modify (car places) 'unsafe))) - `(let* (,@(car method) (,temp ,(nth 2 method))) - ,(cl-setf-do-store (nth 1 method) form) nil))))) + (setq form + (gv-letplace (getter setter) (pop places) + `(prog1 ,getter ,(funcall setter form))))) + (gv-letplace (getter setter) (car places) + (macroexp-let* `((,temp ,getter)) + `(progn ,(funcall setter form) nil)))))) + +;; FIXME: `letf' is unsatisfactory because it does not really "restore" the +;; previous state. If the getter/setter loses information, that info is +;; not recovered. + +(defun cl--letf (bindings simplebinds binds body) + ;; It's not quite clear what the semantics of cl-letf should be. + ;; E.g. in (cl-letf ((PLACE1 VAL1) (PLACE2 VAL2)) BODY), while it's clear + ;; that the actual assignments ("bindings") should only happen after + ;; evaluating VAL1 and VAL2, it's not clear when the sub-expressions of + ;; PLACE1 and PLACE2 should be evaluated. Should we have + ;; PLACE1; VAL1; PLACE2; VAL2; bind1; bind2 + ;; or + ;; VAL1; VAL2; PLACE1; PLACE2; bind1; bind2 + ;; or + ;; VAL1; VAL2; PLACE1; bind1; PLACE2; bind2 + ;; Common-Lisp's `psetf' does the first, so we'll do the same. + (if (null bindings) + (if (and (null binds) (null simplebinds)) (macroexp-progn body) + `(let* (,@(mapcar (lambda (x) + (pcase-let ((`(,vold ,getter ,_setter ,_vnew) x)) + (list vold getter))) + binds) + ,@simplebinds) + (unwind-protect + ,(macroexp-progn + (append + (delq nil + (mapcar (lambda (x) + (pcase x + ;; If there's no vnew, do nothing. + (`(,_vold ,_getter ,setter ,vnew) + (funcall setter vnew)))) + binds)) + body)) + ,@(mapcar (lambda (x) + (pcase-let ((`(,vold ,_getter ,setter ,_vnew) x)) + (funcall setter vold))) + binds)))) + (let ((binding (car bindings))) + (gv-letplace (getter setter) (car binding) + (macroexp-let2 nil vnew (cadr binding) + (if (symbolp (car binding)) + ;; Special-case for simple variables. + (cl--letf (cdr bindings) + (cons `(,getter ,(if (cdr binding) vnew getter)) + simplebinds) + binds body) + (cl--letf (cdr bindings) simplebinds + (cons `(,(make-symbol "old") ,getter ,setter + ,@(if (cdr binding) (list vnew))) + binds) + body))))))) ;;;###autoload (defmacro cl-letf (bindings &rest body) "Temporarily bind to PLACEs. This is the analogue of `let', but with generalized variables (in the -sense of `cl-setf') for the PLACEs. Each PLACE is set to the corresponding +sense of `setf') for the PLACEs. Each PLACE is set to the corresponding VALUE, then the BODY forms are executed. On exit, either normally or because of a `throw' or error, the PLACEs are set back to their original values. Note that this macro is *not* available in Common Lisp. @@ -2368,87 +1987,32 @@ As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', the PLACE is not modified before executing BODY. \(fn ((PLACE VALUE) ...) BODY...)" - (declare (indent 1) (debug ((&rest (gate place &optional form)) body))) + (declare (indent 1) (debug ((&rest (gate gv-place &optional form)) body))) (if (and (not (cdr bindings)) (cdar bindings) (symbolp (caar bindings))) `(let ,bindings ,@body) - (let ((lets nil) - (rev (reverse bindings))) - (while rev - (let* ((place (if (symbolp (caar rev)) - `(symbol-value ',(caar rev)) - (caar rev))) - (value (cl-cadar rev)) - (method (cl-setf-do-modify place 'no-opt)) - (save (make-symbol "--cl-letf-save--")) - (bound (and (memq (car place) '(symbol-value symbol-function)) - (make-symbol "--cl-letf-bound--"))) - (temp (and (not (macroexp-const-p value)) (cdr bindings) - (make-symbol "--cl-letf-val--")))) - (setq lets (nconc (car method) - (if bound - (list (list bound - (list (if (eq (car place) - 'symbol-value) - 'boundp 'fboundp) - (nth 1 (nth 2 method)))) - (list save `(and ,bound - ,(nth 2 method)))) - (list (list save (nth 2 method)))) - (and temp (list (list temp value))) - lets) - body (list - `(unwind-protect - (progn - ,@(if (cdr (car rev)) - (cons (cl-setf-do-store (nth 1 method) - (or temp value)) - body) - body)) - ,(if bound - `(if ,bound - ,(cl-setf-do-store (nth 1 method) save) - (,(if (eq (car place) 'symbol-value) - #'makunbound #'fmakunbound) - ,(nth 1 (nth 2 method)))) - (cl-setf-do-store (nth 1 method) save)))) - rev (cdr rev)))) - `(let* ,lets ,@body)))) - + (cl--letf bindings () () body))) ;;;###autoload (defmacro cl-letf* (bindings &rest body) "Temporarily bind to PLACEs. -This is the analogue of `let*', but with generalized variables (in the -sense of `cl-setf') for the PLACEs. Each PLACE is set to the corresponding -VALUE, then the BODY forms are executed. On exit, either normally or -because of a `throw' or error, the PLACEs are set back to their original -values. Note that this macro is *not* available in Common Lisp. -As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', -the PLACE is not modified before executing BODY. - -\(fn ((PLACE VALUE) ...) BODY...)" +Like `cl-letf' but where the bindings are performed one at a time, +rather than all at the end (i.e. like `let*' rather than like `let')." (declare (indent 1) (debug cl-letf)) - (if (null bindings) - (cons 'progn body) - (setq bindings (reverse bindings)) - (while bindings - (setq body (list `(cl-letf (,(pop bindings)) ,@body)))) - (car body))) + (dolist (binding (reverse bindings)) + (setq body (list `(cl-letf (,binding) ,@body)))) + (macroexp-progn body)) ;;;###autoload (defmacro cl-callf (func place &rest args) "Set PLACE to (FUNC PLACE ARGS...). FUNC should be an unquoted function name. PLACE may be a symbol, -or any generalized variable allowed by `cl-setf'. - -\(fn FUNC PLACE ARGS...)" +or any generalized variable allowed by `setf'." (declare (indent 2) (debug (cl-function place &rest form))) - (let* ((method (cl-setf-do-modify place (cons 'list args))) - (rargs (cons (nth 2 method) args))) - `(let* ,(car method) - ,(cl-setf-do-store (nth 1 method) - (if (symbolp func) (cons func rargs) - `(funcall #',func ,@rargs)))))) + (gv-letplace (getter setter) place + (let* ((rargs (cons getter args))) + (funcall setter + (if (symbolp func) (cons func rargs) + `(funcall #',func ,@rargs)))))) ;;;###autoload (defmacro cl-callf2 (func arg1 place &rest args) @@ -2458,31 +2022,13 @@ Like `cl-callf', but PLACE is the second argument of FUNC, not the first. \(fn FUNC ARG1 PLACE ARGS...)" (declare (indent 3) (debug (cl-function form place &rest form))) (if (and (cl--safe-expr-p arg1) (cl--simple-expr-p place) (symbolp func)) - `(cl-setf ,place (,func ,arg1 ,place ,@args)) - (let* ((method (cl-setf-do-modify place (cons 'list args))) - (temp (and (not (macroexp-const-p arg1)) (make-symbol "--cl-arg1--"))) - (rargs (cl-list* (or temp arg1) (nth 2 method) args))) - `(let* (,@(and temp (list (list temp arg1))) ,@(car method)) - ,(cl-setf-do-store (nth 1 method) - (if (symbolp func) (cons func rargs) - `(funcall #',func ,@rargs))))))) - -;;;###autoload -(defmacro cl-define-modify-macro (name arglist func &optional doc) - "Define a `cl-setf'-like modify macro. -If NAME is called, it combines its PLACE argument with the other arguments -from ARGLIST using FUNC: (cl-define-modify-macro cl-incf (&optional (n 1)) +)" - (declare (debug - (&define name cl-lambda-list ;; should exclude &key - symbolp &optional stringp))) - (if (memq '&key arglist) (error "&key not allowed in cl-define-modify-macro")) - (let ((place (make-symbol "--cl-place--"))) - `(cl-defmacro ,name (,place ,@arglist) - ,doc - (,(if (memq '&rest arglist) #'cl-list* #'list) - #'cl-callf ',func ,place - ,@(cl--arglist-args arglist))))) - + `(setf ,place (,func ,arg1 ,place ,@args)) + (macroexp-let2 nil a1 arg1 + (gv-letplace (getter setter) place + (let* ((rargs (cl-list* a1 getter args))) + (funcall setter + (if (symbolp func) (cons func rargs) + `(funcall #',func ,@rargs)))))))) ;;; Structures. @@ -2492,7 +2038,7 @@ from ARGLIST using FUNC: (cl-define-modify-macro cl-incf (&optional (n 1)) +)" This macro defines a new data type called NAME that stores data in SLOTs. It defines a `make-NAME' constructor, a `copy-NAME' copier, a `NAME-p' predicate, and slot accessors named `NAME-SLOT'. -You can use the accessors to set the corresponding slots, via `cl-setf'. +You can use the accessors to set the corresponding slots, via `setf'. NAME may instead take the form (NAME OPTIONS...), where each OPTION is either a single keyword or (KEYWORD VALUE). @@ -2501,7 +2047,7 @@ See Info node `(cl)Structures' for a list of valid keywords. Each SLOT may instead take the form (SLOT SLOT-OPTS...), where SLOT-OPTS are keyword-value pairs for that slot. Currently, only one keyword is supported, `:read-only'. If this has a non-nil -value, that slot cannot be set via `cl-setf'. +value, that slot cannot be set via `setf'. \(fn NAME SLOTS...)" (declare (doc-string 2) @@ -2655,35 +2201,35 @@ value, that slot cannot be set via `cl-setf'. (let ((accessor (intern (format "%s%s" conc-name slot)))) (push slot slots) (push (nth 1 desc) defaults) - (push (cl-list* - 'cl-defsubst accessor '(cl-x) - (append - (and pred-check + (push `(cl-defsubst ,accessor (cl-x) + ,@(and pred-check (list `(or ,pred-check (error "%s accessing a non-%s" ',accessor ',name)))) - (list (if (eq type 'vector) `(aref cl-x ,pos) - (if (= pos 0) '(car cl-x) - `(nth ,pos cl-x)))))) forms) + ,(if (eq type 'vector) `(aref cl-x ,pos) + (if (= pos 0) '(car cl-x) + `(nth ,pos cl-x)))) forms) (push (cons accessor t) side-eff) - (push `(cl-define-setf-expander ,accessor (cl-x) - ,(if (cadr (memq :read-only (cddr desc))) - `(progn (ignore cl-x) - (error "%s is a read-only slot" - ',accessor)) - ;; If cl is loaded only for compilation, - ;; the call to cl-struct-setf-expander would - ;; cause a warning because it may not be - ;; defined at run time. Suppress that warning. - `(progn - (declare-function - cl-struct-setf-expander "cl-macs" - (x name accessor pred-form pos)) - (cl-struct-setf-expander - cl-x ',name ',accessor - ,(and pred-check `',pred-check) - ,pos)))) - forms) + ;; Don't bother defining a setf-expander, since gv-get can use + ;; the compiler macro to get the same result. + ;;(push `(gv-define-setter ,accessor (cl-val cl-x) + ;; ,(if (cadr (memq :read-only (cddr desc))) + ;; `(progn (ignore cl-x cl-val) + ;; (error "%s is a read-only slot" + ;; ',accessor)) + ;; ;; If cl is loaded only for compilation, + ;; ;; the call to cl--struct-setf-expander would + ;; ;; cause a warning because it may not be + ;; ;; defined at run time. Suppress that warning. + ;; `(progn + ;; (declare-function + ;; cl--struct-setf-expander "cl-macs" + ;; (x name accessor pred-form pos)) + ;; (cl--struct-setf-expander + ;; cl-val cl-x ',name ',accessor + ;; ,(and pred-check `',pred-check) + ;; ,pos)))) + ;; forms) (if print-auto (nconc print-func (list `(princ ,(format " %s" slot) cl-s) @@ -2739,29 +2285,6 @@ value, that slot cannot be set via `cl-setf'. forms) `(progn ,@(nreverse (cons `',name forms))))) -;;;###autoload -(defun cl-struct-setf-expander (x name accessor pred-form pos) - (let* ((temp (make-symbol "--cl-x--")) (store (make-symbol "--cl-store--"))) - (list (list temp) (list x) (list store) - `(progn - ,@(and pred-form - (list `(or ,(cl-subst temp 'cl-x pred-form) - (error ,(format - "%s storing a non-%s" - accessor name))))) - ,(if (eq (car (get name 'cl-struct-type)) 'vector) - `(aset ,temp ,pos ,store) - `(setcar - ,(if (<= pos 5) - (let ((xx temp)) - (while (>= (setq pos (1- pos)) 0) - (setq xx `(cdr ,xx))) - xx) - `(nthcdr ,pos ,temp)) - ,store))) - (list accessor temp)))) - - ;;; Types and assertions. ;;;###autoload @@ -2836,6 +2359,7 @@ STRING is an optional description of the desired type." ;;;###autoload (defmacro cl-assert (form &optional show-args string &rest args) + ;; FIXME: This is actually not compatible with Common-Lisp's `assert'. "Verify that FORM returns non-nil; signal an error if not. Second arg SHOW-ARGS means to include arguments of FORM in message. Other args STRING and ARGS... are arguments to be passed to `error'. @@ -2896,8 +2420,8 @@ and then returning foo." (while (and (symbolp func) (not (setq handler (get func 'compiler-macro))) (fboundp func) - (or (not (eq (car-safe (symbol-function func)) 'autoload)) - (load (nth 1 (symbol-function func))))) + (or (not (autoloadp (symbol-function func))) + (autoload-do-load (symbol-function func) func))) (setq func (symbol-function func))) (and handler (not (eq form (setq form (apply handler form (cdr form)))))))) @@ -2932,7 +2456,7 @@ ARGLIST allows full Common Lisp conventions, and BODY is implicitly surrounded by (cl-block NAME ...). \(fn NAME ARGLIST [DOCSTRING] BODY...)" - (declare (debug cl-defun)) + (declare (debug cl-defun) (indent 2)) (let* ((argns (cl--arglist-args args)) (p argns) (pbody (cons 'progn body)) (unsafe (not (cl--safe-expr-p pbody)))) @@ -2978,8 +2502,6 @@ surrounded by (cl-block NAME ...). ;; Compile-time optimizations for some functions defined in this package. -;; Note that cl.el arranges to force cl-macs to be loaded at compile-time, -;; mainly to make sure these macros will be present. (defun cl--compiler-macro-member (form a list &rest keys) (let ((test (and (= (length keys) 2) (eq (car keys) :test) @@ -3021,7 +2543,7 @@ surrounded by (cl-block NAME ...). (cl-define-compiler-macro cl-typep (&whole form val type) (if (macroexp-const-p type) - (macroexp-let² macroexp-copyable-p temp val + (macroexp-let2 macroexp-copyable-p temp val (cl--make-type-test temp (cl--const-expr-val type))) form)) @@ -3055,8 +2577,8 @@ surrounded by (cl-block NAME ...). (put y 'side-effect-free t)) ;;; Things that are inline. -(cl-proclaim '(inline cl-floatp-safe cl-acons cl-map cl-concatenate cl-notany cl-notevery - cl--set-elt cl-revappend cl-nreconc gethash)) +(cl-proclaim '(inline cl-floatp-safe cl-acons cl-map cl-concatenate cl-notany + cl-notevery cl--set-elt cl-revappend cl-nreconc gethash)) ;;; Things that are side-effect-free. (mapc (lambda (x) (put x 'side-effect-free t)) diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index 508deed333e..dda3e12dae3 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -1,4 +1,4 @@ -;;; cl.el --- Compatibility aliases for the old CL library. +;;; cl.el --- Compatibility aliases for the old CL library. -*- lexical-binding: t -*- ;; Copyright (C) 2012 Free Software Foundation, Inc. @@ -82,6 +82,9 @@ ;; (while (re-search-forward re nil t) ;; (delete-region (1- (point)) (point))) ;; (save-buffer))))) + +;;; Aliases to cl-lib's features. + (dolist (var '( ;; loop-result-var ;; loop-result @@ -104,6 +107,14 @@ )) (defvaralias var (intern (format "cl-%s" var)))) +;; Before overwriting subr.el's `dotimes' and `dolist', let's remember +;; them under a different name, so we can use them in our implementation +;; of `dotimes' and `dolist'. +(unless (fboundp 'cl--dotimes) + (defalias 'cl--dotimes (symbol-function 'dotimes) "The non-CL `dotimes'.")) +(unless (fboundp 'cl--dolist) + (defalias 'cl--dolist (symbol-function 'dolist) "The non-CL `dolist'.")) + (dolist (fun '( (get* . cl-get) (random* . cl-random) @@ -208,20 +219,15 @@ typep deftype defstruct - define-modify-macro callf2 callf letf* - letf + ;; letf rotatef shiftf remf psetf - setf - get-setf-method - defsetf - (define-setf-method . cl-define-setf-expander) - define-setf-expander + (define-setf-method . define-setf-expander) declare the locally @@ -229,7 +235,6 @@ multiple-value-bind symbol-macrolet macrolet - flet progv psetq do-all-symbols @@ -310,23 +315,17 @@ values-list values pushnew - push - pop decf incf )) (let ((new (if (consp fun) (prog1 (cdr fun) (setq fun (car fun))) (intern (format "cl-%s" fun))))) - (defalias fun new) - ;; If `cl-foo' is declare inline, then make `foo' inline as well, and - ;; similarly. Same for edebug specifications, indent rules and - ;; doc-string position. - ;; FIXME: For most of them, we should instead follow aliases - ;; where applicable. - (dolist (prop '(byte-optimizer doc-string-elt edebug-form-spec - lisp-indent-function)) - (if (get new prop) - (put fun prop (get new prop)))))) + (defalias fun new))) + +;;; Features provided a bit differently in Elisp. + +;; First, the old lexical-let is now better served by `lexical-binding', tho +;; it's not 100% compatible. (defvar cl-closure-vars nil) (defvar cl--function-convert-cache nil) @@ -421,7 +420,7 @@ lexical closures as in Common Lisp. (list (cl-caddr x) `(make-symbol ,(format "--%s--" (car x))))) vars) - (cl-setf ,@(apply #'append + (setf ,@(apply #'append (mapcar (lambda (x) (list `(symbol-value ,(cl-caddr x)) (cadr x))) vars))) @@ -442,46 +441,46 @@ Common Lisp. (car body))) ;; This should really have some way to shadow 'byte-compile properties, etc. -;;;###autoload (defmacro flet (bindings &rest body) - "Make temporary function definitions. -This is an analogue of `let' that operates on the function cell of FUNC -rather than its value cell. The FORMs are evaluated with the specified -function definitions in place, then the definitions are undone (the FUNCs -go back to their previous definitions, or lack thereof). + "Make temporary overriding function definitions. +This is an analogue of a dynamically scoped `let' that operates on the function +cell of FUNCs rather than their value cell. +If you want the Common-Lisp style of `flet', you should use `cl-flet'. +The FORMs are evaluated with the specified function definitions in place, +then the definitions are undone (the FUNCs go back to their previous +definitions, or lack thereof). \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" - (declare (indent 1) (debug cl-flet)) - `(cl-letf* ,(mapcar - (lambda (x) - (if (or (and (fboundp (car x)) - (eq (car-safe (symbol-function (car x))) 'macro)) - (cdr (assq (car x) macroexpand-all-environment))) - (error "Use `labels', not `flet', to rebind macro names")) - (let ((func `(cl-function - (lambda ,(cadr x) - (cl-block ,(car x) ,@(cddr x)))))) - (when (cl--compiling-file) - ;; Bug#411. It would be nice to fix this. - (and (get (car x) 'byte-compile) - (error "Byte-compiling a redefinition of `%s' \ + (declare (indent 1) (debug cl-flet) + (obsolete "Use either `cl-flet' or `cl-letf'." "24.2")) + `(letf ,(mapcar + (lambda (x) + (if (or (and (fboundp (car x)) + (eq (car-safe (symbol-function (car x))) 'macro)) + (cdr (assq (car x) macroexpand-all-environment))) + (error "Use `labels', not `flet', to rebind macro names")) + (let ((func `(cl-function + (lambda ,(cadr x) + (cl-block ,(car x) ,@(cddr x)))))) + (when (cl--compiling-file) + ;; Bug#411. It would be nice to fix this. + (and (get (car x) 'byte-compile) + (error "Byte-compiling a redefinition of `%s' \ will not work - use `labels' instead" (symbol-name (car x)))) - ;; FIXME This affects the rest of the file, when it - ;; should be restricted to the flet body. - (and (boundp 'byte-compile-function-environment) - (push (cons (car x) (eval func)) - byte-compile-function-environment))) - (list `(symbol-function ',(car x)) func))) - bindings) + ;; FIXME This affects the rest of the file, when it + ;; should be restricted to the flet body. + (and (boundp 'byte-compile-function-environment) + (push (cons (car x) (eval func)) + byte-compile-function-environment))) + (list `(symbol-function ',(car x)) func))) + bindings) ,@body)) (defmacro labels (bindings &rest body) "Make temporary function bindings. -This is like `flet', except the bindings are lexical instead of dynamic. -Unlike `flet', this macro is fully compliant with the Common Lisp standard. - -\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" - (declare (indent 1) (debug cl-flet)) +Like `cl-labels' except that the lexical scoping is handled via `lexical-let' +rather than relying on `lexical-binding'." + (declare (indent 1) (debug cl-flet) (obsolete cl-labels "24.2")) (let ((vars nil) (sets nil) (newenv macroexpand-all-environment)) (dolist (binding bindings) ;; It's important that (not (eq (symbol-name var1) (symbol-name var2))) @@ -497,7 +496,161 @@ Unlike `flet', this macro is fully compliant with the Common Lisp standard. newenv))) (macroexpand-all `(lexical-let ,vars (setq ,@sets) ,@body) newenv))) -;;; Additional compatibility code +;; Generalized variables are provided by gv.el, but some details are +;; not 100% compatible: not worth the trouble to add them to cl-lib.el, but we +;; still need to support old users of cl.el. + +(defmacro cl--symbol-function (symbol) + "Like `symbol-function' but return `cl--unbound' if not bound." + ;; (declare (gv-setter (lambda (store) + ;; `(if (eq ,store 'cl--unbound) + ;; (fmakunbound ,symbol) (fset ,symbol ,store))))) + `(if (fboundp ,symbol) (symbol-function ,symbol) 'cl--unbound)) +(gv-define-setter cl--symbol-function (store symbol) + `(if (eq ,store 'cl--unbound) (fmakunbound ,symbol) (fset ,symbol ,store))) + +(defmacro letf (bindings &rest body) + "Dynamically scoped let-style bindings for places. +Like `cl-letf', but with some extra backward compatibility." + ;; Like cl-letf, but with special handling of symbol-function. + `(cl-letf ,(mapcar (lambda (x) (if (eq (car-safe (car x)) 'symbol-function) + `((cl--symbol-function ,@(cdar x)) ,@(cdr x)) + x)) + bindings) + ,@body)) + +(defun cl--gv-adapt (cl-gv do) + ;; This function is used by all .elc files that use define-setf-expander and + ;; were compiled with Emacs>=24.2. + (let ((vars (nth 0 cl-gv)) + (vals (nth 1 cl-gv)) + (binds ()) + (substs ())) + ;; Use cl-sublis as was done in cl-setf-do-modify. + (while vars + (if (macroexp-copyable-p (car vals)) + (push (cons (pop vars) (pop vals)) substs) + (push (list (pop vars) (pop vals)) binds))) + (macroexp-let* + binds + (funcall do (cl-sublis substs (nth 4 cl-gv)) + ;; We'd like to do something like + ;; (lambda ,(nth 2 cl-gv) ,(nth 3 cl-gv)). + (lambda (exp) + (macroexp-let2 macroexp-copyable-p v exp + (cl-sublis (cons (cons (car (nth 2 cl-gv)) v) + substs) + (nth 3 cl-gv)))))))) + +(defmacro define-setf-expander (name arglist &rest body) + "Define a `setf' method. +This method shows how to handle `setf's to places of the form (NAME ARGS...). +The argument forms ARGS are bound according to ARGLIST, as if NAME were +going to be expanded as a macro, then the BODY forms are executed and must +return a list of five elements: a temporary-variables list, a value-forms +list, a store-variables list (of length one), a store-form, and an access- +form. See `gv-define-expander', `gv-define-setter', and `gv-define-expander' +for a better and simpler ways to define setf-methods." + (declare (debug + (&define name cl-lambda-list cl-declarations-or-string def-body))) + `(progn + ,@(if (stringp (car body)) + (list `(put ',name 'setf-documentation ,(pop body)))) + (gv-define-expander ,name + (cl-function + (lambda (do ,@arglist) + (cl--gv-adapt (progn ,@body) do)))))) + +(defmacro defsetf (name arg1 &rest args) + "Define a `setf' method. +This macro is an easy-to-use substitute for `define-setf-expander' that works +well for simple place forms. In the simple `defsetf' form, `setf's of +the form (setf (NAME ARGS...) VAL) are transformed to function or macro +calls of the form (FUNC ARGS... VAL). Example: + + (cl-defsetf aref aset) + +Alternate form: (cl-defsetf NAME ARGLIST (STORE) BODY...). +Here, the above `setf' call is expanded by binding the argument forms ARGS +according to ARGLIST, binding the value form VAL to STORE, then executing +BODY, which must return a Lisp form that does the necessary `setf' operation. +Actually, ARGLIST and STORE may be bound to temporary variables which are +introduced automatically to preserve proper execution order of the arguments. +Example: + + (cl-defsetf nth (n x) (v) `(setcar (nthcdr ,n ,x) ,v)) + +\(fn NAME [FUNC | ARGLIST (STORE) BODY...])" + (declare (debug + (&define name + [&or [symbolp &optional stringp] + [cl-lambda-list (symbolp)]] + cl-declarations-or-string def-body))) + (if (and (listp arg1) (consp args)) + ;; Like `gv-define-setter' but with `cl-function'. + `(gv-define-expander ,name + (lambda (do &rest args) + (gv--defsetter ',name + (cl-function + (lambda (,@(car args) ,@arg1) ,@(cdr args))) + do args))) + `(gv-define-simple-setter ,name ,arg1))) + +;; FIXME: CL used to provide a setf method for `apply', but I haven't been able +;; to find a case where it worked. The code below tries to handle it as well. +;; (defun cl--setf-apply (form last-witness last) +;; (cond +;; ((not (consp form)) form) +;; ((eq (ignore-errors (car (last form))) last-witness) +;; `(apply #',(car form) ,@(butlast (cdr form)) ,last)) +;; ((and (memq (car form) '(let let*)) +;; (rassoc (list last-witness) (cadr form))) +;; (let ((rebind (rassoc (list last-witness) (cadr form)))) +;; `(,(car form) ,(remq rebind (cadr form)) +;; ,@(mapcar (lambda (form) (cl--setf-apply form (car rebind) last)) +;; (cddr form))))) +;; (t (mapcar (lambda (form) (cl--setf-apply form last-witness last)) form)))) +;; (gv-define-setter apply (val fun &rest args) +;; (pcase fun (`#',(and (pred symbolp) f) (setq fun f)) +;; (_ (error "First arg to apply in setf is not #'SYM: %S" fun))) +;; (let* ((butlast (butlast args)) +;; (last (car (last args))) +;; (last-witness (make-symbol "--cl-tailarg--")) +;; (setter (macroexpand `(setf (,fun ,@butlast ,last-witness) ,val) +;; macroexpand-all-environment))) +;; (cl--setf-apply setter last-witness last))) + + +;; FIXME: CL used to provide get-setf-method, which was used by some +;; setf-expanders, but now that we use gv.el, it is a lot more difficult +;; and in general impossible to provide get-setf-method. Hopefully, it +;; won't be needed. If needed, we'll have to do something nasty along the +;; lines of +;; (defun get-setf-method (place &optional env) +;; (let* ((witness (list 'cl-gsm)) +;; (expansion (gv-letplace (getter setter) place +;; `(,witness ,getter ,(funcall setter witness))))) +;; ...find "let prefix" of expansion, extract getter and setter from +;; ...the rest, and build the 5-tuple)) +(make-obsolete 'get-setf-method 'gv-letplace "24.2") + +(defmacro define-modify-macro (name arglist func &optional doc) + "Define a `setf'-like modify macro. +If NAME is called, it combines its PLACE argument with the other arguments +from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)" + (declare (debug + (&define name cl-lambda-list ;; should exclude &key + symbolp &optional stringp))) + (if (memq '&key arglist) + (error "&key not allowed in define-modify-macro")) + (let ((place (make-symbol "--cl-place--"))) + `(cl-defmacro ,name (,place ,@arglist) + ,doc + (,(if (memq '&rest arglist) #'cl-list* #'list) + #'cl-callf ',func ,place + ,@(cl--arglist-args arglist))))) + +;;; Additional compatibility code. ;; For names that were clean but really aren't needed any more. (define-obsolete-function-alias 'cl-macroexpand 'macroexpand "24.2") @@ -509,9 +662,9 @@ Unlike `flet', this macro is fully compliant with the Common Lisp standard. ;; This is just kept for compatibility with code byte-compiled by Emacs-20. ;; No idea if this might still be needed. -(defun cl-not-hash-table (x &optional y &rest z) +(defun cl-not-hash-table (x &optional y &rest _z) + (declare (obsolete nil "24.2")) (signal 'wrong-type-argument (list 'cl-hash-table-p (or y x)))) -(make-obsolete 'cl-not-hash-table nil "24.2") (defvar cl-builtin-gethash (symbol-function 'gethash)) (make-obsolete-variable 'cl-builtin-gethash nil "24.2") @@ -538,7 +691,28 @@ Unlike `flet', this macro is fully compliant with the Common Lisp standard. (while (and list (not (equal item (car list)))) (setq list (cdr list))) list) -;; FIXME: More candidates: define-modify-macro, define-setf-expander. +;; Used in the expansion of the old `defstruct'. +(defun cl-struct-setf-expander (x name accessor pred-form pos) + (declare (obsolete nil "24.2")) + (let* ((temp (make-symbol "--cl-x--")) (store (make-symbol "--cl-store--"))) + (list (list temp) (list x) (list store) + `(progn + ,@(and pred-form + (list `(or ,(cl-subst temp 'cl-x pred-form) + (error ,(format + "%s storing a non-%s" + accessor name))))) + ,(if (eq (car (get name 'cl-struct-type)) 'vector) + `(aset ,temp ,pos ,store) + `(setcar + ,(if (<= pos 5) + (let ((xx temp)) + (while (>= (setq pos (1- pos)) 0) + (setq xx `(cdr ,xx))) + xx) + `(nthcdr ,pos ,temp)) + ,store))) + (list accessor temp)))) (provide 'cl) ;;; cl.el ends here diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index b0813aebef6..7bc93a19d1a 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -805,9 +805,9 @@ Redefining FUNCTION also cancels it." ,(interactive-form (symbol-function function)) (apply ',(symbol-function function) debug-on-entry-args))) - (when (eq (car-safe (symbol-function function)) 'autoload) + (when (autoloadp (symbol-function function)) ;; The function is autoloaded. Load its real definition. - (load (cadr (symbol-function function)) nil noninteractive nil t)) + (autoload-do-load (symbol-function function) function)) (when (or (not (consp (symbol-function function))) (and (eq (car (symbol-function function)) 'macro) (not (consp (cdr (symbol-function function)))))) diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index ba720b42868..206166bc77a 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el @@ -80,14 +80,10 @@ redefine OBJECT if it is a symbol." obj (symbol-function obj))) (if (subrp obj) (error "Can't disassemble #" name)) - (when (and (listp obj) (eq (car obj) 'autoload)) - (load (nth 1 obj)) - (setq obj (symbol-function name))) - (if (eq (car-safe obj) 'macro) ;handle macros + (setq obj (autoload-do-load obj name)) + (if (eq (car-safe obj) 'macro) ;Handle macros. (setq macro t obj (cdr obj))) - (when (and (listp obj) (eq (car obj) 'closure)) - (error "Don't know how to compile an interpreted closure")) (if (and (listp obj) (eq (car obj) 'byte-code)) (setq obj (list 'lambda nil obj))) (if (and (listp obj) (not (eq (car obj) 'lambda))) diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 4da48805278..ee4e36a9eba 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -65,7 +65,8 @@ replacing its case-insensitive matches with the literal string in LIGHTER." ;; "foo-bar-minor" -> "Foo-Bar-Minor" (capitalize (replace-regexp-in-string ;; "foo-bar-minor-mode" -> "foo-bar-minor" - "-mode\\'" "" (symbol-name mode)))) + "toggle-\\|-mode\\'" "" + (symbol-name mode)))) " mode"))) (if (not (stringp lighter)) name ;; Strip leading and trailing whitespace from LIGHTER. diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index c1c65b6f661..bbf0757c3bc 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -242,10 +242,13 @@ If the result is non-nil, then break. Errors are ignored." (defun get-edebug-spec (symbol) ;; Get the spec of symbol resolving all indirection. - (let ((edebug-form-spec (get symbol 'edebug-form-spec)) - indirect) - (while (and (symbolp edebug-form-spec) - (setq indirect (get edebug-form-spec 'edebug-form-spec))) + (let ((edebug-form-spec nil) + (indirect symbol)) + (while + (progn + (and (symbolp indirect) + (setq indirect + (function-get indirect 'edebug-form-spec 'autoload)))) ;; (edebug-trace "indirection: %s" edebug-form-spec) (setq edebug-form-spec indirect)) edebug-form-spec @@ -263,7 +266,7 @@ An extant spec symbol is a symbol that is not a function and has a (setq spec (cdr spec))) t)) ((symbolp spec) - (unless (functionp spec) (get spec 'edebug-form-spec))))) + (unless (functionp spec) (function-get spec 'edebug-form-spec))))) ;;; Utilities diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el index b09f6b6a0e9..59aeb161d8e 100644 --- a/lisp/emacs-lisp/eieio-custom.el +++ b/lisp/emacs-lisp/eieio-custom.el @@ -345,7 +345,7 @@ These groups are specified with the `:group' slot flag." (concat "*CUSTOMIZE " (object-name obj) " " (symbol-name g) "*"))) - (toggle-read-only -1) + (setq buffer-read-only nil) (kill-all-local-variables) (erase-buffer) (let ((all (overlay-lists))) diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 1efb74e7139..5f4be78b082 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -44,8 +44,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl)) ;FIXME: Use cl-lib! (defvar eieio-version "1.3" "Current version of EIEIO.") @@ -431,10 +430,10 @@ See `defclass' for more information." (run-hooks 'eieio-hook) (setq eieio-hook nil) - (if (not (symbolp cname)) (signal 'wrong-type-argument '(symbolp cname))) - (if (not (listp superclasses)) (signal 'wrong-type-argument '(listp superclasses))) + (if (not (listp superclasses)) + (signal 'wrong-type-argument '(listp superclasses))) - (let* ((pname (if superclasses superclasses nil)) + (let* ((pname superclasses) (newc (make-vector class-num-slots nil)) (oldc (when (class-p cname) (class-v cname))) (groups nil) ;; list of groups id'd from slots @@ -553,8 +552,8 @@ See `defclass' for more information." (put cname 'cl-deftype-handler (list 'lambda () `(list 'satisfies (quote ,csym))))) - ;; before adding new slots, let's add all the methods and classes - ;; in from the parent class + ;; Before adding new slots, let's add all the methods and classes + ;; in from the parent class. (eieio-copy-parents-into-subclass newc superclasses) ;; Store the new class vector definition into the symbol. We need to @@ -652,9 +651,9 @@ See `defclass' for more information." ;; We need to id the group, and store them in a group list attribute. (mapc (lambda (cg) (add-to-list 'groups cg)) customg) - ;; anyone can have an accessor function. This creates a function + ;; Anyone can have an accessor function. This creates a function ;; of the specified name, and also performs a `defsetf' if applicable - ;; so that users can `setf' the space returned by this function + ;; so that users can `setf' the space returned by this function. (if acces (progn (eieio--defmethod @@ -668,18 +667,26 @@ See `defclass' for more information." ;; Else - Some error? nil? nil))) - ;; Provide a setf method. It would be cleaner to use - ;; defsetf, but that would require CL at runtime. - (put acces 'setf-method - `(lambda (widget) - (let* ((--widget-sym-- (make-symbol "--widget--")) - (--store-sym-- (make-symbol "--store--"))) - (list - (list --widget-sym--) - (list widget) - (list --store-sym--) - (list 'eieio-oset --widget-sym-- '',name --store-sym--) - (list 'getfoo --widget-sym--))))))) + (if (fboundp 'gv-define-setter) + ;; FIXME: We should move more of eieio-defclass into the + ;; defclass macro so we don't have to use `eval' and require + ;; `gv' at run-time. + (eval `(gv-define-setter ,acces (eieio--store eieio--object) + (list 'eieio-oset eieio--object '',name + eieio--store))) + ;; Provide a setf method. It would be cleaner to use + ;; defsetf, but that would require CL at runtime. + (put acces 'setf-method + `(lambda (widget) + (let* ((--widget-sym-- (make-symbol "--widget--")) + (--store-sym-- (make-symbol "--store--"))) + (list + (list --widget-sym--) + (list widget) + (list --store-sym--) + (list 'eieio-oset --widget-sym-- '',name + --store-sym--) + (list 'getfoo --widget-sym--)))))))) ;; If a writer is defined, then create a generic method of that ;; name whose purpose is to set the value of the slot. @@ -702,7 +709,8 @@ See `defclass' for more information." ) (setq slots (cdr slots))) - ;; Now that everything has been loaded up, all our lists are backwards! Fix that up now. + ;; Now that everything has been loaded up, all our lists are backwards! + ;; Fix that up now. (aset newc class-public-a (nreverse (aref newc class-public-a))) (aset newc class-public-d (nreverse (aref newc class-public-d))) (aset newc class-public-doc (nreverse (aref newc class-public-doc))) @@ -2543,8 +2551,13 @@ This is usually a symbol that starts with `:'." ;;; Here are some CLOS items that need the CL package ;; -(defsetf slot-value (obj slot) (store) (list 'eieio-oset obj slot store)) -(defsetf eieio-oref (obj slot) (store) (list 'eieio-oset obj slot store)) +(defsetf eieio-oref eieio-oset) + +(if (eval-when-compile (fboundp 'gv-define-expander)) + ;; Not needed for Emacs>=24.2 since gv.el's setf expands macros and + ;; follows aliases. + nil +(defsetf slot-value eieio-oset) ;; The below setf method was written by Arnd Kohrs (define-setf-method oref (obj slot) @@ -2558,7 +2571,7 @@ This is usually a symbol that starts with `:'." (list store-temp) (list 'set-slot-value obj-temp slot-temp store-temp) - (list 'slot-value obj-temp slot-temp))))) + (list 'slot-value obj-temp slot-temp)))))) ;;; @@ -3038,7 +3051,7 @@ Optional argument NOESCAPE is passed to `prin1-to-string' when appropriate." ;;; Start of automatically extracted autoloads. ;;;### (autoloads (customize-object) "eieio-custom" "eieio-custom.el" -;;;;;; "9cf80224540c52045d515a4c2c833543") +;;;;;; "928623502e8bf40454822355388542b5") ;;; Generated autoloads from eieio-custom.el (autoload 'customize-object "eieio-custom" "\ diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el index 82e958533e8..2ff0ace9f4c 100644 --- a/lisp/emacs-lisp/elint.el +++ b/lisp/emacs-lisp/elint.el @@ -46,6 +46,8 @@ ;;; Code: +(require 'help-fns) + (defgroup elint nil "Linting for Emacs Lisp." :prefix "elint-" @@ -466,6 +468,9 @@ Return nil if there are no more forms, t otherwise." (add-to-list 'elint-features name) ;; cl loads cl-macs in an opaque manner. ;; Since cl-macs requires cl, we can just process cl-macs. + ;; FIXME: AFAIK, `cl' now behaves properly and does not need any + ;; special treatment any more. Can someone who understands this + ;; code confirm? --Stef (and (eq name 'cl) (not elint-doing-cl) ;; We need cl if elint-form is to be able to expand cl macros. (require 'cl) @@ -710,14 +715,8 @@ Returns `unknown' if we couldn't find arguments." (defun elint-find-args-in-code (code) "Extract the arguments from CODE. CODE can be a lambda expression, a macro, or byte-compiled code." - (cond - ((byte-code-function-p code) - (aref code 0)) - ((and (listp code) (eq (car code) 'lambda)) - (car (cdr code))) - ((and (listp code) (eq (car code) 'macro)) - (elint-find-args-in-code (cdr code))) - (t 'unknown))) + (let ((args (help-function-arglist code))) + (if (listp args) args 'unknown))) ;;; ;;; Functions to check some special forms diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index 08390327414..b94817cdb02 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -258,7 +258,7 @@ FUNSYM must be a symbol of a defined function." ;; the autoload here, since that could have side effects, and ;; elp-instrument-function is similar (in my mind) to defun-ish ;; type functionality (i.e. it shouldn't execute the function). - (and (eq (car-safe funguts) 'autoload) + (and (autoloadp funguts) (error "ELP cannot profile autoloaded function: %s" funsym)) ;; We cannot profile functions used internally during profiling. (unless (elp-profilable-p funsym) diff --git a/lisp/emacs-lisp/ewoc.el b/lisp/emacs-lisp/ewoc.el index 02fdbc6e77f..5de3da65174 100644 --- a/lisp/emacs-lisp/ewoc.el +++ b/lisp/emacs-lisp/ewoc.el @@ -196,10 +196,10 @@ NODE and leaving the new node's start there. Return the new node." (save-excursion (let ((elemnode (ewoc--node-create (copy-marker (ewoc--node-start-marker node)) data))) - (cl-setf (ewoc--node-left elemnode) (ewoc--node-left node) - (ewoc--node-right elemnode) node - (ewoc--node-right (ewoc--node-left node)) elemnode - (ewoc--node-left node) elemnode) + (setf (ewoc--node-left elemnode) (ewoc--node-left node) + (ewoc--node-right elemnode) node + (ewoc--node-right (ewoc--node-left node)) elemnode + (ewoc--node-left node) elemnode) (ewoc--refresh-node pretty-printer elemnode dll) elemnode))) @@ -244,8 +244,8 @@ Normally, a newline is automatically inserted after the header, the footer and every node's printed representation. Optional fourth arg NOSEP non-nil inhibits this." (let* ((dummy-node (ewoc--node-create 'DL-LIST 'DL-LIST)) - (dll (progn (cl-setf (ewoc--node-right dummy-node) dummy-node) - (cl-setf (ewoc--node-left dummy-node) dummy-node) + (dll (progn (setf (ewoc--node-right dummy-node) dummy-node) + (setf (ewoc--node-left dummy-node) dummy-node) dummy-node)) (wrap (if nosep 'identity 'ewoc--wrap)) (new-ewoc (ewoc--create (current-buffer) @@ -258,12 +258,12 @@ fourth arg NOSEP non-nil inhibits this." ;; Set default values (unless header (setq header "")) (unless footer (setq footer "")) - (cl-setf (ewoc--node-start-marker dll) (copy-marker pos) - foot (ewoc--insert-new-node dll footer hf-pp dll) - head (ewoc--insert-new-node foot header hf-pp dll) - (ewoc--hf-pp new-ewoc) hf-pp - (ewoc--footer new-ewoc) foot - (ewoc--header new-ewoc) head)) + (setf (ewoc--node-start-marker dll) (copy-marker pos) + foot (ewoc--insert-new-node dll footer hf-pp dll) + head (ewoc--insert-new-node foot header hf-pp dll) + (ewoc--hf-pp new-ewoc) hf-pp + (ewoc--footer new-ewoc) foot + (ewoc--header new-ewoc) head)) ;; Return the ewoc new-ewoc)) @@ -274,7 +274,7 @@ fourth arg NOSEP non-nil inhibits this." (defun ewoc-set-data (node data) "Set NODE to encapsulate DATA." - (cl-setf (ewoc--node-data node) data)) + (setf (ewoc--node-data node) data)) (defun ewoc-enter-first (ewoc data) "Enter DATA first in EWOC. @@ -356,18 +356,18 @@ arguments will be passed to MAP-FUNCTION." ;; If we are about to delete the node pointed at by last-node, ;; set last-node to nil. (when (eq last node) - (cl-setf last nil (ewoc--last-node ewoc) nil)) + (setf last nil (ewoc--last-node ewoc) nil)) (delete-region (ewoc--node-start-marker node) (ewoc--node-start-marker (ewoc--node-next dll node))) (set-marker (ewoc--node-start-marker node) nil) - (cl-setf L (ewoc--node-left node) - R (ewoc--node-right node) - ;; Link neighbors to each other. - (ewoc--node-right L) R - (ewoc--node-left R) L - ;; Forget neighbors. - (ewoc--node-left node) nil - (ewoc--node-right node) nil)))) + (setf L (ewoc--node-left node) + R (ewoc--node-right node) + ;; Link neighbors to each other. + (ewoc--node-right L) R + (ewoc--node-left R) L + ;; Forget neighbors. + (ewoc--node-left node) nil + (ewoc--node-right node) nil)))) (defun ewoc-filter (ewoc predicate &rest args) "Remove all elements in EWOC for which PREDICATE returns nil. @@ -503,7 +503,7 @@ Return the node (or nil if we just passed the last node)." (ewoc--set-buffer-bind-dll ewoc (goto-char (ewoc--node-start-marker node)) (if goal-column (move-to-column goal-column)) - (cl-setf (ewoc--last-node ewoc) node))) + (setf (ewoc--last-node ewoc) node))) (defun ewoc-refresh (ewoc) "Refresh all data in EWOC. @@ -564,8 +564,8 @@ Return nil if the buffer has been deleted." ((head (ewoc--header ewoc)) (foot (ewoc--footer ewoc)) (hf-pp (ewoc--hf-pp ewoc))) - (cl-setf (ewoc--node-data head) header - (ewoc--node-data foot) footer) + (setf (ewoc--node-data head) header + (ewoc--node-data foot) footer) (save-excursion (ewoc--refresh-node hf-pp head dll) (ewoc--refresh-node hf-pp foot dll)))) diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index d64281d0e81..e1e153d9117 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -347,8 +347,7 @@ in `load-path'." (if aliases (message "%s" aliases)) (let ((library - (cond ((eq (car-safe def) 'autoload) - (nth 1 def)) + (cond ((autoloadp def) (nth 1 def)) ((subrp def) (if lisp-only (error "%s is a built-in function" function)) diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el new file mode 100644 index 00000000000..d1f997c99c4 --- /dev/null +++ b/lisp/emacs-lisp/gv.el @@ -0,0 +1,448 @@ +;;; gv.el --- Generalized variables -*- lexical-binding: t -*- + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; Author: Stefan Monnier +;; Keywords: extensions + +;; 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 . + +;;; Commentary: + +;; This is a re-implementation of the setf machinery using a different +;; underlying approach than the one used earlier in CL, which was based on +;; define-setf-expander. +;; `define-setf-expander' makes every "place-expander" return a 5-tuple +;; (VARS VALUES STORES GETTER SETTER) +;; where STORES is a list with a single variable (Common-Lisp allows multiple +;; variables for use with multiple-return-values, but this is rarely used and +;; not applicable to Elisp). +;; It basically says that GETTER is an expression that returns the place's +;; value, and (lambda STORES SETTER) is an expression that assigns the value(s) +;; passed to that function to the place, and that you need to wrap the whole +;; thing within a `(let* ,(zip VARS VALUES) ...). +;; +;; Instead, we use here a higher-order approach: instead +;; of a 5-tuple, a place-expander returns a function. +;; If you think about types, the old approach return things of type +;; {vars: List Var, values: List Exp, +;; stores: List Var, getter: Exp, setter: Exp} +;; whereas the new approach returns a function of type +;; (do: ((getter: Exp, setter: ((store: Exp) -> Exp)) -> Exp)) -> Exp. +;; You can get the new function from the old 5-tuple with something like: +;; (lambda (do) +;; `(let* ,(zip VARS VALUES) +;; (funcall do GETTER (lambda ,STORES ,SETTER)))) +;; You can't easily do the reverse, because this new approach is more +;; expressive than the old one, so we can't provide a backward-compatible +;; get-setf-method. +;; +;; While it may seem intimidating for people not used to higher-order +;; functions, you will quickly see that its use (especially with the +;; `gv-letplace' macro) is actually much easier and more elegant than the old +;; approach which is clunky and often leads to unreadable code. + +;; Food for thought: the syntax of places does not actually conflict with the +;; pcase patterns. The `cons' gv works just like a `(,a . ,b) pcase +;; pattern, and actually the `logand' gv is even closer since it should +;; arguably fail when trying to set a value outside of the mask. +;; Generally, places are used for destructors (gethash, aref, car, ...) +;; whereas pcase patterns are used for constructors (backquote, constants, +;; vectors, ...). + +;;; Code: + +(require 'macroexp) + +;; What we call a "gvar" is basically a function of type "(getter * setter -> +;; code) -> code", where "getter" is code and setter is "code -> code". + +;; (defvar gv--macro-environment nil +;; "Macro expanders for generalized variables.") + +;;;###autoload +(defun gv-get (place do) + "Build the code that applies DO to PLACE. +PLACE must be a valid generalized variable. +DO must be a function; it will be called with 2 arguments: GETTER and SETTER, +where GETTER is a (copyable) Elisp expression that returns the value of PLACE, +and SETTER is a function which returns the code to set PLACE when called +with a (not necessarily copyable) Elisp expression that returns the value to +set it to. +DO must return an Elisp expression." + (if (symbolp place) + (funcall do place (lambda (v) `(setq ,place ,v))) + (let* ((head (car place)) + (gf (function-get head 'gv-expander 'autoload))) + (if gf (apply gf do (cdr place)) + (let ((me (macroexpand place ;FIXME: expand one step at a time! + ;; (append macroexpand-all-environment + ;; gv--macro-environment) + macroexpand-all-environment))) + (if (and (eq me place) (get head 'compiler-macro)) + ;; Expand compiler macros: this takes care of all the accessors + ;; defined via cl-defsubst, such as cXXXr and defstruct slots. + (setq me (apply (get head 'compiler-macro) place (cdr place)))) + (if (and (eq me place) (fboundp head) + (symbolp (symbol-function head))) + ;; Follow aliases. + (setq me (cons (symbol-function head) (cdr place)))) + (if (eq me place) + (error "%S is not a valid place expression" place) + (gv-get me do))))))) + +;;;###autoload +(defmacro gv-letplace (vars place &rest body) + "Build the code manipulating the generalized variable PLACE. +GETTER will be bound to a copyable expression that returns the value +of PLACE. +SETTER will be bound to a function that takes an expression V and returns +and new expression that sets PLACE to V. +BODY should return some Elisp expression E manipulating PLACE via GETTER +and SETTER. +The returned value will then be an Elisp expression that first evaluates +all the parts of PLACE that can be evaluated and then runs E. + +\(fn (GETTER SETTER) PLACE &rest BODY)" + (declare (indent 2) (debug (sexp form body))) + `(gv-get ,place (lambda ,vars ,@body))) + +;; Different ways to declare a generalized variable. +;;;###autoload +(defmacro gv-define-expander (name handler) + "Use HANDLER to handle NAME as a generalized var. +NAME is a symbol: the name of a function, macro, or special form. +HANDLER is a function which takes an argument DO followed by the same +arguments as NAME. DO is a function as defined in `gv-get'." + (declare (indent 1) (debug (sexp form))) + ;; Use eval-and-compile so the method can be used in the same file as it + ;; is defined. + ;; FIXME: Just like byte-compile-macro-environment, we should have something + ;; like byte-compile-symbolprop-environment so as to handle these things + ;; cleanly without affecting the running Emacs. + `(eval-and-compile (put ',name 'gv-expander ,handler))) + +;;;###autoload +(defun gv--defun-declaration (symbol name args handler &optional fix) + `(progn + ;; No need to autoload this part, since gv-get will auto-load the + ;; function's definition before checking the `gv-expander' property. + :autoload-end + ,(pcase (cons symbol handler) + (`(gv-expander . (lambda (,do) . ,body)) + `(gv-define-expander ,name (lambda (,do ,@args) ,@body))) + (`(gv-expander . ,(pred symbolp)) + `(gv-define-expander ,name #',handler)) + (`(gv-setter . (lambda (,store) . ,body)) + `(gv-define-setter ,name (,store ,@args) ,@body)) + (`(gv-setter . ,(pred symbolp)) + `(gv-define-simple-setter ,name ,handler ,fix)) + ;; (`(expand ,expander) `(gv-define-expand ,name ,expander)) + (_ (message "Unknown %s declaration %S" symbol handler) nil)))) + +;;;###autoload +(push `(gv-expander ,(apply-partially #'gv--defun-declaration 'gv-expander)) + defun-declarations-alist) +;;;###autoload +(push `(gv-setter ,(apply-partially #'gv--defun-declaration 'gv-setter)) + defun-declarations-alist) + +;; (defmacro gv-define-expand (name expander) +;; "Use EXPANDER to handle NAME as a generalized var. +;; NAME is a symbol: the name of a function, macro, or special form. +;; EXPANDER is a function that will be called as a macro-expander to reduce +;; uses of NAME to some other generalized variable." +;; (declare (debug (sexp form))) +;; `(eval-and-compile +;; (if (not (boundp 'gv--macro-environment)) +;; (setq gv--macro-environment nil)) +;; (push (cons ',name ,expander) gv--macro-environment))) + +(defun gv--defsetter (name setter do args &optional vars) + "Helper function used by code generated by `gv-define-setter'. +NAME is the name of the getter function. +SETTER is a function that generates the code for the setter. +NAME accept ARGS as arguments and SETTER accepts (NEWVAL . ARGS). +VARS is used internally for recursive calls." + (if (null args) + (let ((vars (nreverse vars))) + (funcall do `(,name ,@vars) (lambda (v) (apply setter v vars)))) + ;; FIXME: Often it would be OK to skip this `let', but in general, + ;; `do' may have all kinds of side-effects. + (macroexp-let2 nil v (car args) + (gv--defsetter name setter do (cdr args) (cons v vars))))) + +;;;###autoload +(defmacro gv-define-setter (name arglist &rest body) + "Define a setter method for generalized variable NAME. +This macro is an easy-to-use substitute for `gv-define-expander' that works +well for simple place forms. +Assignments of VAL to (NAME ARGS...) are expanded by binding the argument +forms (VAL ARGS...) according to ARGLIST, then executing BODY, which must +return a Lisp form that does the assignment. +Actually, ARGLIST may be bound to temporary variables which are introduced +automatically to preserve proper execution order of the arguments. Example: + (gv-define-setter aref (v a i) `(aset ,a ,i ,v))" + (declare (indent 2) (debug (&define name sexp body))) + `(gv-define-expander ,name + (lambda (do &rest args) + (gv--defsetter ',name (lambda ,arglist ,@body) do args)))) + +;;;###autoload +(defmacro gv-define-simple-setter (name setter &optional fix-return) + "Define a simple setter method for generalized variable NAME. +This macro is an easy-to-use substitute for `gv-define-expander' that works +well for simple place forms. Assignments of VAL to (NAME ARGS...) are +turned into calls of the form (SETTER ARGS... VAL). +If FIX-RETURN is non-nil, then SETTER is not assumed to return VAL and +instead the assignment is turned into (prog1 VAL (SETTER ARGS... VAL)) +so as to preserve the semantics of `setf'." + (declare (debug (sexp (&or symbolp lambda-expr) &optional sexp))) + (let ((set-call `(cons ',setter (append args (list val))))) + `(gv-define-setter ,name (val &rest args) + ,(if fix-return `(list 'prog1 val ,set-call) set-call)))) + +;;; Typical operations on generalized variables. + +;;;###autoload +(defmacro setf (&rest args) + "Set each PLACE to the value of its VAL. +This is a generalized version of `setq'; the PLACEs may be symbolic +references such as (car x) or (aref x i), as well as plain symbols. +For example, (setf (cadr x) y) is equivalent to (setcar (cdr x) y). +The return value is the last VAL in the list. + +\(fn PLACE VAL PLACE VAL ...)" + (declare (debug (gv-place form))) + (if (and args (null (cddr args))) + (let ((place (pop args)) + (val (car args))) + (gv-letplace (_getter setter) place + (funcall setter val))) + (let ((sets nil)) + (while args (push `(setf ,(pop args) ,(pop args)) sets)) + (cons 'progn (nreverse sets))))) + +;; (defmacro gv-pushnew! (val place) +;; "Like `gv-push!' but only adds VAL if it's not yet in PLACE. +;; Presence is checked with `member'. +;; The return value is unspecified." +;; (declare (debug (form gv-place))) +;; (macroexp-let2 macroexp-copyable-p v val +;; (gv-letplace (getter setter) place +;; `(if (member ,v ,getter) nil +;; ,(funcall setter `(cons ,v ,getter)))))) + +;; (defmacro gv-inc! (place &optional val) +;; "Increment PLACE by VAL (default to 1)." +;; (declare (debug (gv-place &optional form))) +;; (gv-letplace (getter setter) place +;; (funcall setter `(+ ,getter ,(or val 1))))) + +;; (defmacro gv-dec! (place &optional val) +;; "Decrement PLACE by VAL (default to 1)." +;; (declare (debug (gv-place &optional form))) +;; (gv-letplace (getter setter) place +;; (funcall setter `(- ,getter ,(or val 1))))) + +;; For Edebug, the idea is to let Edebug instrument gv-places just like it does +;; for normal expressions, and then give it a gv-expander to DTRT. +;; Maybe this should really be in edebug.el rather than here. + +;; Autoload this `put' since a user might use C-u C-M-x on an expression +;; containing a non-trivial `push' even before gv.el was loaded. +;;;###autoload +(put 'gv-place 'edebug-form-spec 'edebug-match-form) +;; CL did the equivalent of: +;;(gv-define-expand edebug-after (lambda (before index place) place)) + +(put 'edebug-after 'gv-expander + (lambda (do before index place) + (gv-letplace (getter setter) place + (funcall do `(edebug-after ,before ,index ,getter) + setter)))) + +;;; The common generalized variables. + +(gv-define-simple-setter aref aset) +(gv-define-simple-setter car setcar) +(gv-define-simple-setter cdr setcdr) +;; FIXME: add compiler-macros for `cXXr' instead! +(gv-define-setter caar (val x) `(setcar (car ,x) ,val)) +(gv-define-setter cadr (val x) `(setcar (cdr ,x) ,val)) +(gv-define-setter cdar (val x) `(setcdr (car ,x) ,val)) +(gv-define-setter cddr (val x) `(setcdr (cdr ,x) ,val)) +(gv-define-setter elt (store seq n) + `(if (listp ,seq) (setcar (nthcdr ,n ,seq) ,store) + (aset ,seq ,n ,store))) +(gv-define-simple-setter get put) +(gv-define-setter gethash (val k h &optional _d) `(puthash ,k ,val ,h)) + +;; (gv-define-expand nth (lambda (idx list) `(car (nthcdr ,idx ,list)))) +(put 'nth 'gv-expander + (lambda (do idx list) + (macroexp-let2 nil c `(nthcdr ,idx ,list) + (funcall do `(car ,c) (lambda (v) `(setcar ,c ,v)))))) +(gv-define-simple-setter symbol-function fset) +(gv-define-simple-setter symbol-plist setplist) +(gv-define-simple-setter symbol-value set) + +(put 'nthcdr 'gv-expander + (lambda (do n place) + (macroexp-let2 nil idx n + (gv-letplace (getter setter) place + (funcall do `(nthcdr ,idx ,getter) + (lambda (v) `(if (<= ,idx 0) ,(funcall setter v) + (setcdr (nthcdr (1- ,idx) ,getter) ,v)))))))) + +;;; Elisp-specific generalized variables. + +(gv-define-simple-setter default-value set-default) +(gv-define-simple-setter frame-parameter set-frame-parameter 'fix) +(gv-define-simple-setter terminal-parameter set-terminal-parameter) +(gv-define-simple-setter keymap-parent set-keymap-parent) +(gv-define-simple-setter match-data set-match-data 'fix) +(gv-define-simple-setter overlay-get overlay-put) +(gv-define-setter overlay-start (store ov) + `(progn (move-overlay ,ov ,store (overlay-end ,ov)) ,store)) +(gv-define-setter overlay-end (store ov) + `(progn (move-overlay ,ov (overlay-start ,ov) ,store) ,store)) +(gv-define-simple-setter process-buffer set-process-buffer) +(gv-define-simple-setter process-filter set-process-filter) +(gv-define-simple-setter process-sentinel set-process-sentinel) +(gv-define-simple-setter process-get process-put) +(gv-define-simple-setter window-buffer set-window-buffer) +(gv-define-simple-setter window-display-table set-window-display-table 'fix) +(gv-define-simple-setter window-dedicated-p set-window-dedicated-p) +(gv-define-simple-setter window-hscroll set-window-hscroll) +(gv-define-simple-setter window-parameter set-window-parameter) +(gv-define-simple-setter window-point set-window-point) +(gv-define-simple-setter window-start set-window-start) + +;;; Some occasionally handy extensions. + +;; While several of the "places" below are not terribly useful for direct use, +;; they can show up as the output of the macro expansion of reasonable places, +;; such as struct-accessors. + +(put 'progn 'gv-expander + (lambda (do &rest exps) + (let ((start (butlast exps)) + (end (car (last exps)))) + (if (null start) (gv-get end do) + `(progn ,@start ,(gv-get end do)))))) + +(let ((let-expander + (lambda (letsym) + (lambda (do bindings &rest body) + `(,letsym ,bindings + ,@(macroexp-unprogn + (gv-get (macroexp-progn body) do))))))) + (put 'let 'gv-expander (funcall let-expander 'let)) + (put 'let* 'gv-expander (funcall let-expander 'let*))) + +(put 'if 'gv-expander + (lambda (do test then &rest else) + (if (macroexp-small-p (funcall do 'dummy (lambda (_) 'dummy))) + ;; This duplicates the `do' code, which is a problem if that + ;; code is large, but otherwise results in more efficient code. + `(if ,test ,(gv-get then do) + ,@(macroexp-unprogn (gv-get (macroexp-progn else) do))) + (let ((v (make-symbol "v"))) + (macroexp-let2 nil + gv `(if ,test ,(gv-letplace (getter setter) then + `(cons (lambda () ,getter) + (lambda (,v) ,(funcall setter v)))) + ,(gv-letplace (getter setter) (macroexp-progn else) + `(cons (lambda () ,getter) + (lambda (,v) ,(funcall setter v))))) + (funcall do `(funcall (car ,gv)) + (lambda (v) `(funcall (cdr ,gv) ,v)))))))) + +(put 'cond 'gv-expander + (lambda (do &rest branches) + (if (macroexp-small-p (funcall do 'dummy (lambda (_) 'dummy))) + ;; This duplicates the `do' code, which is a problem if that + ;; code is large, but otherwise results in more efficient code. + `(cond + ,@(mapcar (lambda (branch) + (if (cdr branch) + (cons (car branch) + (macroexp-unprogn + (gv-get (macroexp-progn (cdr branch)) do))) + (gv-get (car branch) do))) + branches)) + (let ((v (make-symbol "v"))) + (macroexp-let2 nil + gv `(cond + ,@(mapcar + (lambda (branch) + (if (cdr branch) + `(,(car branch) + ,@(macroexp-unprogn + (gv-letplace (getter setter) + (macroexp-progn (cdr branch)) + `(cons (lambda () ,getter) + (lambda (,v) ,(funcall setter v)))))) + (gv-letplace (getter setter) + (car branch) + `(cons (lambda () ,getter) + (lambda (,v) ,(funcall setter v)))))) + branches)) + (funcall do `(funcall (car ,gv)) + (lambda (v) `(funcall (cdr ,gv) ,v)))))))) + +;;; Even more debatable extensions. + +(put 'cons 'gv-expander + (lambda (do a d) + (gv-letplace (agetter asetter) a + (gv-letplace (dgetter dsetter) d + (funcall do + `(cons ,agetter ,dgetter) + (lambda (v) `(progn + ,(funcall asetter `(car ,v)) + ,(funcall dsetter `(cdr ,v))))))))) + +(put 'logand 'gv-expander + (lambda (do place &rest masks) + (gv-letplace (getter setter) place + (macroexp-let2 macroexp-copyable-p + mask (if (cdr masks) `(logand ,@masks) (car masks)) + (funcall + do `(logand ,getter ,mask) + (lambda (v) + (funcall setter + `(logior (logand ,v ,mask) + (logand ,getter (lognot ,mask)))))))))) + +;;; Vaguely related definitions that should be moved elsewhere. + +;; (defun alist-get (key alist) +;; "Get the value associated to KEY in ALIST." +;; (declare +;; (gv-expander +;; (lambda (do) +;; (macroexp-let2 macroexp-copyable-p k key +;; (gv-letplace (getter setter) alist +;; (macroexp-let2 nil p `(assoc ,k ,getter) +;; (funcall do `(cdr ,p) +;; (lambda (v) +;; `(if ,p (setcdr ,p ,v) +;; ,(funcall setter +;; `(cons (cons ,k ,v) ,getter))))))))))) +;; (cdr (assoc key alist))) + +(provide 'gv) +;;; gv.el ends here diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 2a4cd704a43..e29407f5a8b 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -158,7 +158,8 @@ It has `lisp-mode-abbrev-table' as its parent." (goto-char listbeg) (and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)") (match-string 1))))) - (docelt (and firstsym (get (intern-soft firstsym) + (docelt (and firstsym + (function-get (intern-soft firstsym) lisp-doc-string-elt-property)))) (if (and docelt ;; It's a string in a form that can have a docstring. @@ -264,110 +265,111 @@ font-lock keywords will not be case sensitive." (define-key map "\e\t" 'completion-at-point) (define-key map "\e\C-x" 'eval-defun) (define-key map "\e\C-q" 'indent-pp-sexp) - (define-key map [menu-bar emacs-lisp] (cons (purecopy "Emacs-Lisp") menu-map)) - (define-key menu-map [eldoc] - `(menu-item ,(purecopy "Auto-Display Documentation Strings") eldoc-mode + (bindings--define-key map [menu-bar emacs-lisp] + (cons "Emacs-Lisp" menu-map)) + (bindings--define-key menu-map [eldoc] + '(menu-item "Auto-Display Documentation Strings" eldoc-mode :button (:toggle . (bound-and-true-p eldoc-mode)) - :help ,(purecopy "Display the documentation string for the item under cursor"))) - (define-key menu-map [checkdoc] - `(menu-item ,(purecopy "Check Documentation Strings") checkdoc - :help ,(purecopy "Check documentation strings for style requirements"))) - (define-key menu-map [re-builder] - `(menu-item ,(purecopy "Construct Regexp") re-builder - :help ,(purecopy "Construct a regexp interactively"))) - (define-key menu-map [tracing] (cons (purecopy "Tracing") tracing-map)) - (define-key tracing-map [tr-a] - `(menu-item ,(purecopy "Untrace All") untrace-all - :help ,(purecopy "Untrace all currently traced functions"))) - (define-key tracing-map [tr-uf] - `(menu-item ,(purecopy "Untrace Function...") untrace-function - :help ,(purecopy "Untrace function, and possibly activate all remaining advice"))) - (define-key tracing-map [tr-sep] menu-bar-separator) - (define-key tracing-map [tr-q] - `(menu-item ,(purecopy "Trace Function Quietly...") trace-function-background - :help ,(purecopy "Trace the function with trace output going quietly to a buffer"))) - (define-key tracing-map [tr-f] - `(menu-item ,(purecopy "Trace Function...") trace-function - :help ,(purecopy "Trace the function given as an argument"))) - (define-key menu-map [profiling] (cons (purecopy "Profiling") prof-map)) - (define-key prof-map [prof-restall] - `(menu-item ,(purecopy "Remove Instrumentation for All Functions") elp-restore-all - :help ,(purecopy "Restore the original definitions of all functions being profiled"))) - (define-key prof-map [prof-restfunc] - `(menu-item ,(purecopy "Remove Instrumentation for Function...") elp-restore-function - :help ,(purecopy "Restore an instrumented function to its original definition"))) + :help "Display the documentation string for the item under cursor")) + (bindings--define-key menu-map [checkdoc] + '(menu-item "Check Documentation Strings" checkdoc + :help "Check documentation strings for style requirements")) + (bindings--define-key menu-map [re-builder] + '(menu-item "Construct Regexp" re-builder + :help "Construct a regexp interactively")) + (bindings--define-key menu-map [tracing] (cons "Tracing" tracing-map)) + (bindings--define-key tracing-map [tr-a] + '(menu-item "Untrace All" untrace-all + :help "Untrace all currently traced functions")) + (bindings--define-key tracing-map [tr-uf] + '(menu-item "Untrace Function..." untrace-function + :help "Untrace function, and possibly activate all remaining advice")) + (bindings--define-key tracing-map [tr-sep] menu-bar-separator) + (bindings--define-key tracing-map [tr-q] + '(menu-item "Trace Function Quietly..." trace-function-background + :help "Trace the function with trace output going quietly to a buffer")) + (bindings--define-key tracing-map [tr-f] + '(menu-item "Trace Function..." trace-function + :help "Trace the function given as an argument")) + (bindings--define-key menu-map [profiling] (cons "Profiling" prof-map)) + (bindings--define-key prof-map [prof-restall] + '(menu-item "Remove Instrumentation for All Functions" elp-restore-all + :help "Restore the original definitions of all functions being profiled")) + (bindings--define-key prof-map [prof-restfunc] + '(menu-item "Remove Instrumentation for Function..." elp-restore-function + :help "Restore an instrumented function to its original definition")) - (define-key prof-map [sep-rem] menu-bar-separator) - (define-key prof-map [prof-resall] - `(menu-item ,(purecopy "Reset Counters for All Functions") elp-reset-all - :help ,(purecopy "Reset the profiling information for all functions being profiled"))) - (define-key prof-map [prof-resfunc] - `(menu-item ,(purecopy "Reset Counters for Function...") elp-reset-function - :help ,(purecopy "Reset the profiling information for a function"))) - (define-key prof-map [prof-res] - `(menu-item ,(purecopy "Show Profiling Results") elp-results - :help ,(purecopy "Display current profiling results"))) - (define-key prof-map [prof-pack] - `(menu-item ,(purecopy "Instrument Package...") elp-instrument-package - :help ,(purecopy "Instrument for profiling all function that start with a prefix"))) - (define-key prof-map [prof-func] - `(menu-item ,(purecopy "Instrument Function...") elp-instrument-function - :help ,(purecopy "Instrument a function for profiling"))) - (define-key menu-map [lint] (cons (purecopy "Linting") lint-map)) - (define-key lint-map [lint-di] - `(menu-item ,(purecopy "Lint Directory...") elint-directory - :help ,(purecopy "Lint a directory"))) - (define-key lint-map [lint-f] - `(menu-item ,(purecopy "Lint File...") elint-file - :help ,(purecopy "Lint a file"))) - (define-key lint-map [lint-b] - `(menu-item ,(purecopy "Lint Buffer") elint-current-buffer - :help ,(purecopy "Lint the current buffer"))) - (define-key lint-map [lint-d] - `(menu-item ,(purecopy "Lint Defun") elint-defun - :help ,(purecopy "Lint the function at point"))) - (define-key menu-map [edebug-defun] - `(menu-item ,(purecopy "Instrument Function for Debugging") edebug-defun - :help ,(purecopy "Evaluate the top level form point is in, stepping through with Edebug") - :keys ,(purecopy "C-u C-M-x"))) - (define-key menu-map [separator-byte] menu-bar-separator) - (define-key menu-map [disas] - `(menu-item ,(purecopy "Disassemble Byte Compiled Object...") disassemble - :help ,(purecopy "Print disassembled code for OBJECT in a buffer"))) - (define-key menu-map [byte-recompile] - `(menu-item ,(purecopy "Byte-recompile Directory...") byte-recompile-directory - :help ,(purecopy "Recompile every `.el' file in DIRECTORY that needs recompilation"))) - (define-key menu-map [emacs-byte-compile-and-load] - `(menu-item ,(purecopy "Byte-compile and Load") emacs-lisp-byte-compile-and-load - :help ,(purecopy "Byte-compile the current file (if it has changed), then load compiled code"))) - (define-key menu-map [byte-compile] - `(menu-item ,(purecopy "Byte-compile This File") emacs-lisp-byte-compile - :help ,(purecopy "Byte compile the file containing the current buffer"))) - (define-key menu-map [separator-eval] menu-bar-separator) - (define-key menu-map [ielm] - `(menu-item ,(purecopy "Interactive Expression Evaluation") ielm - :help ,(purecopy "Interactively evaluate Emacs Lisp expressions"))) - (define-key menu-map [eval-buffer] - `(menu-item ,(purecopy "Evaluate Buffer") eval-buffer - :help ,(purecopy "Execute the current buffer as Lisp code"))) - (define-key menu-map [eval-region] - `(menu-item ,(purecopy "Evaluate Region") eval-region - :help ,(purecopy "Execute the region as Lisp code") + (bindings--define-key prof-map [sep-rem] menu-bar-separator) + (bindings--define-key prof-map [prof-resall] + '(menu-item "Reset Counters for All Functions" elp-reset-all + :help "Reset the profiling information for all functions being profiled")) + (bindings--define-key prof-map [prof-resfunc] + '(menu-item "Reset Counters for Function..." elp-reset-function + :help "Reset the profiling information for a function")) + (bindings--define-key prof-map [prof-res] + '(menu-item "Show Profiling Results" elp-results + :help "Display current profiling results")) + (bindings--define-key prof-map [prof-pack] + '(menu-item "Instrument Package..." elp-instrument-package + :help "Instrument for profiling all function that start with a prefix")) + (bindings--define-key prof-map [prof-func] + '(menu-item "Instrument Function..." elp-instrument-function + :help "Instrument a function for profiling")) + (bindings--define-key menu-map [lint] (cons "Linting" lint-map)) + (bindings--define-key lint-map [lint-di] + '(menu-item "Lint Directory..." elint-directory + :help "Lint a directory")) + (bindings--define-key lint-map [lint-f] + '(menu-item "Lint File..." elint-file + :help "Lint a file")) + (bindings--define-key lint-map [lint-b] + '(menu-item "Lint Buffer" elint-current-buffer + :help "Lint the current buffer")) + (bindings--define-key lint-map [lint-d] + '(menu-item "Lint Defun" elint-defun + :help "Lint the function at point")) + (bindings--define-key menu-map [edebug-defun] + '(menu-item "Instrument Function for Debugging" edebug-defun + :help "Evaluate the top level form point is in, stepping through with Edebug" + :keys "C-u C-M-x")) + (bindings--define-key menu-map [separator-byte] menu-bar-separator) + (bindings--define-key menu-map [disas] + '(menu-item "Disassemble Byte Compiled Object..." disassemble + :help "Print disassembled code for OBJECT in a buffer")) + (bindings--define-key menu-map [byte-recompile] + '(menu-item "Byte-recompile Directory..." byte-recompile-directory + :help "Recompile every `.el' file in DIRECTORY that needs recompilation")) + (bindings--define-key menu-map [emacs-byte-compile-and-load] + '(menu-item "Byte-compile and Load" emacs-lisp-byte-compile-and-load + :help "Byte-compile the current file (if it has changed), then load compiled code")) + (bindings--define-key menu-map [byte-compile] + '(menu-item "Byte-compile This File" emacs-lisp-byte-compile + :help "Byte compile the file containing the current buffer")) + (bindings--define-key menu-map [separator-eval] menu-bar-separator) + (bindings--define-key menu-map [ielm] + '(menu-item "Interactive Expression Evaluation" ielm + :help "Interactively evaluate Emacs Lisp expressions")) + (bindings--define-key menu-map [eval-buffer] + '(menu-item "Evaluate Buffer" eval-buffer + :help "Execute the current buffer as Lisp code")) + (bindings--define-key menu-map [eval-region] + '(menu-item "Evaluate Region" eval-region + :help "Execute the region as Lisp code" :enable mark-active)) - (define-key menu-map [eval-sexp] - `(menu-item ,(purecopy "Evaluate Last S-expression") eval-last-sexp - :help ,(purecopy "Evaluate sexp before point; print value in minibuffer"))) - (define-key menu-map [separator-format] menu-bar-separator) - (define-key menu-map [comment-region] - `(menu-item ,(purecopy "Comment Out Region") comment-region - :help ,(purecopy "Comment or uncomment each line in the region") + (bindings--define-key menu-map [eval-sexp] + '(menu-item "Evaluate Last S-expression" eval-last-sexp + :help "Evaluate sexp before point; print value in minibuffer")) + (bindings--define-key menu-map [separator-format] menu-bar-separator) + (bindings--define-key menu-map [comment-region] + '(menu-item "Comment Out Region" comment-region + :help "Comment or uncomment each line in the region" :enable mark-active)) - (define-key menu-map [indent-region] - `(menu-item ,(purecopy "Indent Region") indent-region - :help ,(purecopy "Indent each nonblank line in the region") + (bindings--define-key menu-map [indent-region] + '(menu-item "Indent Region" indent-region + :help "Indent each nonblank line in the region" :enable mark-active)) - (define-key menu-map [indent-line] - `(menu-item ,(purecopy "Indent Line") lisp-indent-line)) + (bindings--define-key menu-map [indent-line] + '(menu-item "Indent Line" lisp-indent-line)) map) "Keymap for Emacs Lisp mode. All commands in `lisp-mode-shared-map' are inherited by this map.") @@ -430,16 +432,16 @@ if that value is non-nil." (set-keymap-parent map lisp-mode-shared-map) (define-key map "\e\C-x" 'lisp-eval-defun) (define-key map "\C-c\C-z" 'run-lisp) - (define-key map [menu-bar lisp] (cons (purecopy "Lisp") menu-map)) - (define-key menu-map [run-lisp] - `(menu-item ,(purecopy "Run inferior Lisp") run-lisp - :help ,(purecopy "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'"))) - (define-key menu-map [ev-def] - `(menu-item ,(purecopy "Eval defun") lisp-eval-defun - :help ,(purecopy "Send the current defun to the Lisp process made by M-x run-lisp"))) - (define-key menu-map [ind-sexp] - `(menu-item ,(purecopy "Indent sexp") indent-sexp - :help ,(purecopy "Indent each line of the list starting just after point"))) + (bindings--define-key map [menu-bar lisp] (cons "Lisp" menu-map)) + (bindings--define-key menu-map [run-lisp] + '(menu-item "Run inferior Lisp" run-lisp + :help "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'")) + (bindings--define-key menu-map [ev-def] + '(menu-item "Eval defun" lisp-eval-defun + :help "Send the current defun to the Lisp process made by M-x run-lisp")) + (bindings--define-key menu-map [ind-sexp] + '(menu-item "Indent sexp" indent-sexp + :help "Indent each line of the list starting just after point")) map) "Keymap for ordinary Lisp mode. All commands in `lisp-mode-shared-map' are inherited by this map.") @@ -487,23 +489,24 @@ if that value is non-nil." (define-key map "\e\C-q" 'indent-pp-sexp) (define-key map "\e\t" 'completion-at-point) (define-key map "\n" 'eval-print-last-sexp) - (define-key map [menu-bar lisp-interaction] (cons (purecopy "Lisp-Interaction") menu-map)) - (define-key menu-map [eval-defun] - `(menu-item ,(purecopy "Evaluate Defun") eval-defun - :help ,(purecopy "Evaluate the top-level form containing point, or after point"))) - (define-key menu-map [eval-print-last-sexp] - `(menu-item ,(purecopy "Evaluate and Print") eval-print-last-sexp - :help ,(purecopy "Evaluate sexp before point; print value into current buffer"))) - (define-key menu-map [edebug-defun-lisp-interaction] - `(menu-item ,(purecopy "Instrument Function for Debugging") edebug-defun - :help ,(purecopy "Evaluate the top level form point is in, stepping through with Edebug") - :keys ,(purecopy "C-u C-M-x"))) - (define-key menu-map [indent-pp-sexp] - `(menu-item ,(purecopy "Indent or Pretty-Print") indent-pp-sexp - :help ,(purecopy "Indent each line of the list starting just after point, or prettyprint it"))) - (define-key menu-map [complete-symbol] - `(menu-item ,(purecopy "Complete Lisp Symbol") completion-at-point - :help ,(purecopy "Perform completion on Lisp symbol preceding point"))) + (bindings--define-key map [menu-bar lisp-interaction] + (cons "Lisp-Interaction" menu-map)) + (bindings--define-key menu-map [eval-defun] + '(menu-item "Evaluate Defun" eval-defun + :help "Evaluate the top-level form containing point, or after point")) + (bindings--define-key menu-map [eval-print-last-sexp] + '(menu-item "Evaluate and Print" eval-print-last-sexp + :help "Evaluate sexp before point; print value into current buffer")) + (bindings--define-key menu-map [edebug-defun-lisp-interaction] + '(menu-item "Instrument Function for Debugging" edebug-defun + :help "Evaluate the top level form point is in, stepping through with Edebug" + :keys "C-u C-M-x")) + (bindings--define-key menu-map [indent-pp-sexp] + '(menu-item "Indent or Pretty-Print" indent-pp-sexp + :help "Indent each line of the list starting just after point, or prettyprint it")) + (bindings--define-key menu-map [complete-symbol] + '(menu-item "Complete Lisp Symbol" completion-at-point + :help "Perform completion on Lisp symbol preceding point")) map) "Keymap for Lisp Interaction mode. All commands in `lisp-mode-shared-map' are inherited by this map.") @@ -1133,7 +1136,8 @@ Lisp function does not specify a special indentation." (let ((function (buffer-substring (point) (progn (forward-sexp 1) (point)))) method) - (setq method (or (get (intern-soft function) 'lisp-indent-function) + (setq method (or (function-get (intern-soft function) + 'lisp-indent-function) (get (intern-soft function) 'lisp-indent-hook))) (cond ((or (eq method 'defun) (and (null method) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 95fe43a34a2..70eab149837 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -185,12 +185,7 @@ Assumes the caller has bound `macroexpand-all-environment'." ;; Macro expand compiler macros. This cannot be delayed to ;; byte-optimize-form because the output of the compiler-macro can ;; use macros. - (let ((handler nil)) - (while (and (symbolp func) - (not (setq handler (get func 'compiler-macro))) - (fboundp func)) - ;; Follow the sequence of aliases. - (setq func (symbol-function func))) + (let ((handler (function-get func 'compiler-macro))) (if (null handler) ;; No compiler macro. We just expand each argument (for ;; setq/setq-default this works alright because the variable names @@ -198,12 +193,9 @@ Assumes the caller has bound `macroexpand-all-environment'." (macroexp--all-forms form 1) ;; If the handler is not loaded yet, try (auto)loading the ;; function itself, which may in turn load the handler. - (when (and (not (functionp handler)) - (fboundp func) (eq (car-safe (symbol-function func)) - 'autoload)) + (unless (functionp handler) (ignore-errors - (load (nth 1 (symbol-function func)) - 'noerror 'nomsg))) + (autoload-do-load (indirect-function func) func))) (let ((newform (macroexp--compiler-macro handler form))) (if (eq form newform) ;; The compiler macro did not find anything to do. @@ -263,23 +255,44 @@ definitions to shadow the loaded ones for use in file byte-compilation." ((memq (car-safe then) '(if cond)) (macroexp-if `(not ,test) else then)) (t `(if ,test ,then ,else)))) -(defmacro macroexp-let² (test var exp &rest exps) +(defmacro macroexp-let2 (test var exp &rest exps) "Bind VAR to a copyable expression that returns the value of EXP. This is like `(let ((v ,EXP)) ,EXPS) except that `v' is a new generated symbol which EXPS can find in VAR. TEST should be the name of a predicate on EXP checking whether the `let' can be skipped; if nil, as is usual, `macroexp-const-p' is used." - (declare (indent 3) (debug (sexp form sexp body))) + (declare (indent 3) (debug (sexp sexp form body))) (let ((bodysym (make-symbol "body")) (expsym (make-symbol "exp"))) `(let* ((,expsym ,exp) - (,var (if (,(or test #'macroexp-const-p) ,expsym) - ,expsym (make-symbol "x"))) + (,var (if (funcall #',(or test #'macroexp-const-p) ,expsym) + ,expsym (make-symbol ,(symbol-name var)))) (,bodysym ,(macroexp-progn exps))) (if (eq ,var ,expsym) ,bodysym (macroexp-let* (list (list ,var ,expsym)) ,bodysym))))) +(defun macroexp--maxsize (exp size) + (cond ((< size 0) size) + ((symbolp exp) (1- size)) + ((stringp exp) (- size (/ (length exp) 16))) + ((vectorp exp) + (dotimes (i (length exp)) + (setq size (macroexp--maxsize (aref exp i) size))) + (1- size)) + ((consp exp) + ;; We could try to be more clever with quote&function, + ;; but it is difficult to do so correctly, and it's not obvious that + ;; it would be worth the effort. + (dolist (e exp) + (setq size (macroexp--maxsize e size))) + (1- size)) + (t -1))) + +(defun macroexp-small-p (exp) + "Return non-nil if EXP can be considered small." + (> (macroexp--maxsize exp 10) 0)) + (defsubst macroexp--const-symbol-p (symbol &optional any-value) "Non-nil if SYMBOL is constant. If ANY-VALUE is nil, only return non-nil if the value of the symbol is the diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index cc4e642daf8..e7806440bf3 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el @@ -5,6 +5,7 @@ ;; Author: Roland McGrath ;; Maintainer: FSF ;; Keywords: lisp, extensions +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index f91a1645e21..4aeed7e4d0e 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -64,7 +64,7 @@ ;; (defconst pcase--memoize-1 (make-hash-table :test 'eq)) ;; (defconst pcase--memoize-2 (make-hash-table :weakness 'key :test 'equal)) -(defconst pcase--dontcare-upats '(t _ dontcare)) +(defconst pcase--dontcare-upats '(t _ pcase--dontcare)) (def-edebug-spec pcase-UPAT @@ -94,6 +94,7 @@ CASES is a list of elements of the form (UPATTERN CODE...). UPatterns can take the following forms: _ matches anything. + SELFQUOTING matches itself. This includes keywords, numbers, and strings. SYMBOL matches anything and binds it to SYMBOL. (or UPAT...) matches if any of the patterns matches. (and UPAT...) matches if all the patterns match. @@ -113,7 +114,8 @@ QPatterns for vectors are not implemented yet. PRED can take the form FUNCTION in which case it gets called with one argument. - (FUN ARG1 .. ARGN) in which case it gets called with N+1 arguments. + (FUN ARG1 .. ARGN) in which case it gets called with an N+1'th argument + which is the value being matched. A PRED of the form FUNCTION is equivalent to one of the form (FUNCTION). PRED patterns can refer to variables bound earlier in the pattern. E.g. you can match pairs where the cdr is larger than the car with a pattern @@ -153,11 +155,12 @@ like `(,a . ,(pred (< a))) or, with more checks: (pcase--expand (cadr binding) `((,(car binding) ,(pcase--let* bindings body)) - ;; We can either signal an error here, or just use `dontcare' which - ;; generates more efficient code. In practice, if we use `dontcare' - ;; we will still often get an error and the few cases where we don't - ;; do not matter that much, so it's a better choice. - (dontcare nil))))))) + ;; We can either signal an error here, or just use `pcase--dontcare' + ;; which generates more efficient code. In practice, if we use + ;; `pcase--dontcare' we will still often get an error and the few + ;; cases where we don't do not matter that much, so + ;; it's a better choice. + (pcase--dontcare nil))))))) ;;;###autoload (defmacro pcase-let* (bindings &rest body) @@ -210,7 +213,7 @@ of the form (UPAT EXP)." (defun pcase--expand (exp cases) ;; (message "pid=%S (pcase--expand %S ...hash=%S)" ;; (emacs-pid) exp (sxhash cases)) - (macroexp-let² macroexp-copyable-p val exp + (macroexp-let2 macroexp-copyable-p val exp (let* ((defs ()) (seen '()) (codegen @@ -274,7 +277,7 @@ of the form (UPAT EXP)." vars)))) cases)))) (dolist (case cases) - (unless (or (memq case used-cases) (eq (car case) 'dontcare)) + (unless (or (memq case used-cases) (eq (car case) 'pcase--dontcare)) (message "Redundant pcase pattern: %S" (car case)))) (macroexp-let* defs main)))) @@ -509,6 +512,9 @@ MATCH is the pattern that needs to be matched, of the form: (and (memq sexp vars) (not (memq sexp res)) (push sexp res)) res)) +(defun pcase--self-quoting-p (upat) + (or (keywordp upat) (numberp upat) (stringp upat))) + ;; It's very tempting to use `pcase' below, tho obviously, it'd create ;; bootstrapping problems. (defun pcase--u1 (matches code vars rest) @@ -571,7 +577,7 @@ Otherwise, it defers to REST which is a list of branches of the form (upat (cdr cdrpopmatches))) (cond ((memq upat '(t _)) (pcase--u1 matches code vars rest)) - ((eq upat 'dontcare) :pcase--dontcare) + ((eq upat 'pcase--dontcare) :pcase--dontcare) ((memq (car-safe upat) '(guard pred)) (if (eq (car upat) 'pred) (put sym 'pcase-used t)) (let* ((splitrest @@ -605,6 +611,9 @@ Otherwise, it defers to REST which is a list of branches of the form `(let* ,env ,call)))) (pcase--u1 matches code vars then-rest) (pcase--u else-rest)))) + ((pcase--self-quoting-p upat) + (put sym 'pcase-used t) + (pcase--q1 sym upat matches code vars rest)) ((symbolp upat) (put sym 'pcase-used t) (if (not (assq upat vars)) @@ -617,7 +626,7 @@ Otherwise, it defers to REST which is a list of branches of the form ;; A upat of the form (let VAR EXP). ;; (pcase--u1 matches code ;; (cons (cons (nth 1 upat) (nth 2 upat)) vars) rest) - (macroexp-let² + (macroexp-let2 macroexp-copyable-p sym (let* ((exp (nth 2 upat)) (found (assq exp vars))) @@ -636,14 +645,16 @@ Otherwise, it defers to REST which is a list of branches of the form (memq-fine t)) (when all (dolist (alt (cdr upat)) - (unless (and (eq (car-safe alt) '\`) - (or (symbolp (cadr alt)) (integerp (cadr alt)) - (setq memq-fine nil) - (stringp (cadr alt)))) + (unless (or (pcase--self-quoting-p alt) + (and (eq (car-safe alt) '\`) + (or (symbolp (cadr alt)) (integerp (cadr alt)) + (setq memq-fine nil) + (stringp (cadr alt))))) (setq all nil)))) (if all ;; Use memq for (or `a `b `c `d) rather than a big tree. - (let* ((elems (mapcar 'cadr (cdr upat))) + (let* ((elems (mapcar (lambda (x) (if (consp x) (cadr x) x)) + (cdr upat))) (splitrest (pcase--split-rest sym (lambda (pat) (pcase--split-member elems pat)) rest)) diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index 48e0d6d6a21..30c16b51b9e 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -110,7 +110,8 @@ after OUT-BUFFER-NAME." (progn (select-window window) (run-hooks 'temp-buffer-show-hook)) - (select-window old-selected) + (when (window-live-p old-selected) + (select-window old-selected)) (message "See buffer %s." out-buffer-name))) (message "%s" (buffer-substring (point-min) (point))) )))))) diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 136dff6df68..9fa8a108236 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -307,7 +307,7 @@ be either: (dolist (op (cdr (assoc first-nt first-ops-table))) (unless (member op first-ops) (setq again t) - (cl-push op (cdr first-ops)))))))) + (push op (cdr first-ops)))))))) ;; Same thing for last-ops. (setq again t) (while (prog1 again (setq again nil)) @@ -318,7 +318,7 @@ be either: (dolist (op (cdr (assoc last-nt last-ops-table))) (unless (member op last-ops) (setq again t) - (cl-push op (cdr last-ops)))))))) + (push op (cdr last-ops)))))))) ;; Now generate the 2D precedence table. (dolist (rules bnf) (dolist (rhs (cdr rules)) @@ -601,10 +601,10 @@ PREC2 is a table as returned by `smie-precs->prec2' or ;; left side of any < constraint). (dolist (x table) (unless (nth 1 x) - (cl-setf (nth 1 x) i) + (setf (nth 1 x) i) (cl-incf i)) ;See other (cl-incf i) above. (unless (nth 2 x) - (cl-setf (nth 2 x) i) + (setf (nth 2 x) i) (cl-incf i)))) ;See other (cl-incf i) above. ;; Mark closers and openers. (dolist (x (gethash :smie-open/close-alist prec2)) @@ -613,7 +613,7 @@ PREC2 is a table as returned by `smie-precs->prec2' or (`closer (cddr (assoc token table))) (`opener (cdr (assoc token table)))))) (cl-assert (numberp (car cons))) - (cl-setf (car cons) (list (car cons))))) + (setf (car cons) (list (car cons))))) (let ((ca (gethash :smie-closer-alist prec2))) (when ca (push (cons :smie-closer-alist ca) table))) ;; (smie-check-grammar table prec2 'step3) @@ -708,13 +708,12 @@ Possible return values: (when (zerop (length token)) (condition-case err (progn (goto-char pos) (funcall next-sexp 1) nil) - (scan-error (throw 'return - (list t (cl-caddr err) - (buffer-substring-no-properties - (cl-caddr err) - (+ (cl-caddr err) - (if (< (point) (cl-caddr err)) - -1 1))))))) + (scan-error + (let ((pos (nth 2 err))) + (throw 'return + (list t pos + (buffer-substring-no-properties + pos (+ pos (if (< (point) pos) -1 1)))))))) (if (eq pos (point)) ;; We did not move, so let's abort the loop. (throw 'return (list t (point)))))) diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index 51bfc05ff5f..c3d78b3444b 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -511,10 +511,8 @@ Point is at POS when this function returns." (setq ppss (parse-partial-sexp pt-min (setq pt-min (/ (+ pt-min pos) 2)) nil nil ppss)) - (let ((pair (cons pt-min ppss))) - (if cache-pred - (cl-push pair (cdr cache-pred)) - (push pair syntax-ppss-cache)))) + (push (cons pt-min ppss) + (if cache-pred (cdr cache-pred) syntax-ppss-cache))) ;; Compute the actual return value. (setq ppss (parse-partial-sexp pt-min pos nil nil ppss)) @@ -533,7 +531,7 @@ Point is at POS when this function returns." (let ((pair (cons pos ppss))) (if cache-pred (if (> (- (caar cache-pred) pos) syntax-ppss-max-span) - (cl-push pair (cdr cache-pred)) + (push pair (cdr cache-pred)) (setcar cache-pred pair)) (if (or (null syntax-ppss-cache) (> (- (caar syntax-ppss-cache) pos) diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index 1c30563c6a3..a66d5972d82 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -28,7 +28,7 @@ ;;; Code: ;; Layout of a timer vector: -;; [triggered-p high-seconds low-seconds usecs repeat-delay +;; [triggered-p high-seconds low-seconds usecs psecs repeat-delay ;; function args idle-delay] ;; triggered-p is nil if the timer is active (waiting to be triggered), ;; t if it is inactive ("already triggered", in theory) @@ -42,27 +42,35 @@ (:type vector) (:conc-name timer--)) (triggered t) - high-seconds low-seconds usecs repeat-delay function args idle-delay) + high-seconds low-seconds usecs psecs repeat-delay function args idle-delay) (defun timerp (object) "Return t if OBJECT is a timer." - (and (vectorp object) (= (length object) 8))) + (and (vectorp object) (= (length object) 9))) ;; Pseudo field `time'. (defun timer--time (timer) (list (timer--high-seconds timer) (timer--low-seconds timer) - (timer--usecs timer))) + (timer--usecs timer) + (timer--psecs timer))) -(cl-defsetf timer--time +(gv-define-simple-setter timer--time (lambda (timer time) (or (timerp timer) (error "Invalid timer")) - (cl-setf (timer--high-seconds timer) (pop time)) - (cl-setf (timer--low-seconds timer) - (if (consp time) (car time) time)) - (cl-setf (timer--usecs timer) (or (and (consp time) (consp (cdr time)) - (cadr time)) - 0)))) + (setf (timer--high-seconds timer) (pop time)) + (let ((low time) (usecs 0) (psecs 0)) + (if (consp time) + (progn + (setq low (pop time)) + (if time + (progn + (setq usecs (pop time)) + (if time + (setq psecs (car time))))))) + (setf (timer--low-seconds timer) low) + (setf (timer--usecs timer) usecs) + (setf (timer--psecs timer) psecs)))) (defun timer-set-time (timer time &optional delta) @@ -70,62 +78,67 @@ TIME must be in the internal format returned by, e.g., `current-time'. If optional third argument DELTA is a positive number, make the timer fire repeatedly that many seconds apart." - (cl-setf (timer--time timer) time) - (cl-setf (timer--repeat-delay timer) (and (numberp delta) (> delta 0) delta)) + (setf (timer--time timer) time) + (setf (timer--repeat-delay timer) (and (numberp delta) (> delta 0) delta)) timer) (defun timer-set-idle-time (timer secs &optional repeat) "Set the trigger idle time of TIMER to SECS. SECS may be an integer, floating point number, or the internal -time format (HIGH LOW USECS) returned by, e.g., `current-idle-time'. +time format returned by, e.g., `current-idle-time'. If optional third argument REPEAT is non-nil, make the timer fire each time Emacs is idle for that many seconds." (if (consp secs) - (cl-setf (timer--time timer) secs) - (cl-setf (timer--time timer) '(0 0 0)) + (setf (timer--time timer) secs) + (setf (timer--time timer) '(0 0 0)) (timer-inc-time timer secs)) - (cl-setf (timer--repeat-delay timer) repeat) + (setf (timer--repeat-delay timer) repeat) timer) (defun timer-next-integral-multiple-of-time (time secs) "Yield the next value after TIME that is an integral multiple of SECS. More precisely, the next value, after TIME, that is an integral multiple of SECS seconds since the epoch. SECS may be a fraction." - (let ((time-base (ash 1 16))) - ;; Use floating point, taking care to not lose precision. - (let* ((float-time-base (float time-base)) - (million 1000000.0) - (time-usec (+ (* million - (+ (* float-time-base (nth 0 time)) - (nth 1 time))) - (nth 2 time))) - (secs-usec (* million secs)) - (mod-usec (mod time-usec secs-usec)) - (next-usec (+ (- time-usec mod-usec) secs-usec)) - (time-base-million (* float-time-base million))) - (list (floor next-usec time-base-million) - (floor (mod next-usec time-base-million) million) - (floor (mod next-usec million)))))) + (let* ((trillion 1e12) + (time-sec (+ (nth 1 time) + (* 65536.0 (nth 0 time)))) + (delta-sec (mod (- time-sec) secs)) + (next-sec (+ time-sec (ffloor delta-sec))) + (next-sec-psec (ffloor (* trillion (mod delta-sec 1)))) + (sub-time-psec (+ (or (nth 3 time) 0) + (* 1e6 (nth 2 time)))) + (psec-diff (- sub-time-psec next-sec-psec))) + (if (and (<= next-sec time-sec) (< 0 psec-diff)) + (setq next-sec-psec (+ sub-time-psec + (mod (- psec-diff) (* trillion secs))))) + (setq next-sec (+ next-sec (floor next-sec-psec trillion))) + (setq next-sec-psec (mod next-sec-psec trillion)) + (list (floor next-sec 65536) + (floor (mod next-sec 65536)) + (floor next-sec-psec 1000000) + (floor (mod next-sec-psec 1000000))))) -(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." +(defun timer-relative-time (time secs &optional usecs psecs) + "Advance TIME by SECS seconds and optionally USECS nanoseconds +and PSECS picoseconds. SECS may be either an integer or a +floating point number." (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)))) + (if (or usecs psecs) + (setq delta (time-add delta (list 0 0 (or usecs 0) (or psecs 0))))) (time-add time delta))) (defun timer--time-less-p (t1 t2) "Say whether time value T1 is less than time value T2." (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. -SECS may be a fraction. If USECS is omitted, that means it is zero." - (cl-setf (timer--time timer) - (timer-relative-time (timer--time timer) secs usecs))) +(defun timer-inc-time (timer secs &optional usecs psecs) + "Increment the time set in TIMER by SECS seconds, USECS nanoseconds, +and PSECS picoseconds. SECS may be a fraction. If USECS or PSECS are +omitted, they are treated as zero." + (setf (timer--time timer) + (timer-relative-time (timer--time timer) secs usecs psecs))) (defun timer-set-time-with-usecs (timer time usecs &optional delta) "Set the trigger time of TIMER to TIME plus USECS. @@ -133,9 +146,10 @@ TIME must be in the internal format returned by, e.g., `current-time'. The microsecond count from TIME is ignored, and USECS is used instead. If optional fourth argument DELTA is a positive number, make the timer fire repeatedly that many seconds apart." - (cl-setf (timer--time timer) time) - (cl-setf (timer--usecs timer) usecs) - (cl-setf (timer--repeat-delay timer) (and (numberp delta) (> delta 0) delta)) + (setf (timer--time timer) time) + (setf (timer--usecs timer) usecs) + (setf (timer--psecs timer) 0) + (setf (timer--repeat-delay timer) (and (numberp delta) (> delta 0) delta)) timer) (make-obsolete 'timer-set-time-with-usecs "use `timer-set-time' and `timer-inc-time' instead." @@ -145,8 +159,8 @@ fire repeatedly that many seconds apart." "Make TIMER call FUNCTION with optional ARGS when triggering." (or (timerp timer) (error "Invalid timer")) - (cl-setf (timer--function timer) function) - (cl-setf (timer--args timer) args) + (setf (timer--function timer) function) + (setf (timer--args timer) args) timer) (defun timer--activate (timer &optional triggered-p reuse-cell idle) @@ -154,6 +168,7 @@ fire repeatedly that many seconds apart." (integerp (timer--high-seconds timer)) (integerp (timer--low-seconds timer)) (integerp (timer--usecs timer)) + (integerp (timer--psecs timer)) (timer--function timer)) (let ((timers (if idle timer-idle-list timer-list)) last) @@ -170,8 +185,8 @@ fire repeatedly that many seconds apart." (cond (last (setcdr last reuse-cell)) (idle (setq timer-idle-list reuse-cell)) (t (setq timer-list reuse-cell))) - (cl-setf (timer--triggered timer) triggered-p) - (cl-setf (timer--idle-delay timer) idle) + (setf (timer--triggered timer) triggered-p) + (setf (timer--idle-delay timer) idle) nil) (error "Invalid or uninitialized timer"))) @@ -253,7 +268,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." - (float-time (time-subtract time (timer--time timer)))) + (- (float-time time) (float-time (timer--time timer)))) (defun timer-event-handler (timer) "Call the handler for the timer TIMER. @@ -294,7 +309,7 @@ This function is called, by name, directly by the C code." (apply (timer--function timer) (timer--args timer))) (error nil)) (if retrigger - (cl-setf (timer--triggered timer) nil))) + (setf (timer--triggered timer) nil))) (error "Bogus timer event")))) ;; This function is incompatible with the one in levents.el. @@ -386,7 +401,7 @@ This function is for compatibility; see also `run-with-timer'." "Perform an action the next time Emacs is idle for SECS seconds. The action is to call FUNCTION with arguments ARGS. SECS may be an integer, a floating point number, or the internal -time format (HIGH LOW USECS) returned by, e.g., `current-idle-time'. +time format returned by, e.g., `current-idle-time'. If Emacs is currently idle, and has been idle for N seconds (N < SECS), then it will call FUNCTION in SECS - N seconds from now. diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el index fd66c9364f2..c6fff7aa443 100644 --- a/lisp/emacs-lisp/trace.el +++ b/lisp/emacs-lisp/trace.el @@ -285,7 +285,7 @@ Activation is performed with `ad-update', hence remaining advice will get activated only if the advice of FUNCTION is currently active. If FUNCTION was not traced this is a noop." (interactive - (list (ad-read-advised-function "Untrace function: " 'trace-is-traced))) + (list (ad-read-advised-function "Untrace function" 'trace-is-traced))) (when (trace-is-traced function) (ad-remove-advice function 'around trace-advice-name) (ad-update function))) diff --git a/lisp/emulation/crisp.el b/lisp/emulation/crisp.el index cfb8ed07595..d29736d6860 100644 --- a/lisp/emulation/crisp.el +++ b/lisp/emulation/crisp.el @@ -54,8 +54,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - ;; local variables (defgroup crisp nil @@ -361,7 +359,7 @@ if ARG is omitted or nil." (when crisp-mode ;; Make menu entries show M-u or f14 in preference to C-x u. (put 'undo :advertised-binding - (list* [?\M-u] [f14] (get 'undo :advertised-binding))) + `([?\M-u] [f14] ,@(get 'undo :advertised-binding))) ;; Force transient-mark-mode, so that the marking routines work as ;; expected. If the user turns off transient mark mode, most ;; things will still work fine except the crisp-(copy|kill) diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el index 4286afba938..39ce5901524 100644 --- a/lisp/emulation/cua-rect.el +++ b/lisp/emulation/cua-rect.el @@ -21,7 +21,7 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . -;;; Acknowledgements +;;; Acknowledgments ;; The rectangle handling and display code borrows from the standard ;; GNU emacs rect.el package and the rect-mark.el package by Rick diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 9cf6c91265e..4219688a4ba 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -103,8 +103,8 @@ ;; (require 'viper) ;; -;;; Acknowledgements: -;; ----------------- +;;; Acknowledgments: +;; ---------------- ;; Bug reports and ideas contributed by many users have helped ;; improve Viper and the various versions of VIP. ;; See the on-line manual for a complete list of contributors. diff --git a/lisp/env.el b/lisp/env.el index 53922b5e262..d0d8ed0b998 100644 --- a/lisp/env.el +++ b/lisp/env.el @@ -34,8 +34,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - ;; History list for environment variable names. (defvar read-envvar-name-history nil) diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index f84df4c7b89..37758048258 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,3 +1,7 @@ +2012-07-21 Julien Danjou + + * erc-notifications.el: New file. + 2012-06-15 Julien Danjou * erc.el (erc-open): Use `auth-source' for password retrieval when diff --git a/lisp/erc/erc-notifications.el b/lisp/erc/erc-notifications.el new file mode 100644 index 00000000000..4faffc913c5 --- /dev/null +++ b/lisp/erc/erc-notifications.el @@ -0,0 +1,90 @@ +;; erc-notifications.el -- Send notification on PRIVMSG or mentions + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; Author: Julien Danjou +;; Keywords: comm + +;; 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 . + +;;; Commentary: + +;; This implements notifications using `notifications-notify' on +;; PRIVMSG received and on public nickname mentions. + +;;; Code: + +(require 'erc) +(require 'xml) +(require 'notifications) +(require 'erc-match) +(require 'dbus) + +(defgroup erc-notifications nil + "Send notifications on PRIVMSG or mentions." + :group 'erc) + +(defvar erc-notifications-last-notification nil + "Last notification id.") + +(defcustom erc-notifications-icon nil + "Icon to use for notification." + :group 'erc-notifications + :type 'file) + +(defun erc-notifications-notify (nick msg) + "Notify that NICK send some MSG. +This will replace the last notification sent with this function." + (dbus-ignore-errors + (setq erc-notifications-last-notification + (notifications-notify :title (xml-escape-string nick) + :body (xml-escape-string msg) + :replaces-id erc-notifications-last-notification + :app-icon erc-notifications-icon)))) + +(defun erc-notifications-PRIVMSG (proc parsed) + (let ((nick (car (erc-parse-user (erc-response.sender parsed)))) + (target (car (erc-response.command-args parsed))) + (msg (erc-response.contents parsed))) + (when (and (erc-current-nick-p target) + (not (and (boundp 'erc-track-exclude) + (member nick erc-track-exclude))) + (not (erc-is-message-ctcp-and-not-action-p msg))) + (erc-notifications-notify nick msg))) + ;; Return nil to continue processing by ERC + nil) + +(defun erc-notifications-notify-on-match (match-type nickuserhost msg) + (when (eq match-type 'current-nick) + (let ((nick (nth 0 (erc-parse-user nickuserhost)))) + (unless (or (string-match-p "^Server:" nick) + (when (boundp 'erc-track-exclude) + (member nick erc-track-exclude))) + (erc-notifications-notify nick msg))))) + +;;;###autoload(autoload 'erc-notifications-mode "erc-notifications" "" t) +(define-erc-module notifications nil + "Send notifications on private message reception and mentions." + ;; Enable + ((add-hook 'erc-server-PRIVMSG-functions 'erc-notifications-PRIVMSG) + (add-hook 'erc-text-matched-hook 'erc-notifications-notify-on-match)) + ;; Disable + ((remove-hook 'erc-server-PRIVMSG-functions 'erc-notifications-PRIVMSG) + (remove-hook 'erc-text-matched-hook 'erc-notifications-notify-on-match))) + +(provide 'erc-notifications) + +;;; erc-notifications.el ends here diff --git a/lisp/eshell/em-alias.el b/lisp/eshell/em-alias.el index d45f918113d..4b62fec95e6 100644 --- a/lisp/eshell/em-alias.el +++ b/lisp/eshell/em-alias.el @@ -95,11 +95,12 @@ (require 'eshell) ;;;###autoload -(eshell-defgroup eshell-alias nil +(progn +(defgroup eshell-alias nil "Command aliases allow for easy definition of alternate commands." :tag "Command aliases" ;; :link '(info-link "(eshell)Command aliases") - :group 'eshell-module) + :group 'eshell-module)) (defcustom eshell-aliases-file (expand-file-name "alias" eshell-directory-name) "The file in which aliases are kept. diff --git a/lisp/eshell/em-banner.el b/lisp/eshell/em-banner.el index a96a3dfe6af..8fdad66f3f0 100644 --- a/lisp/eshell/em-banner.el +++ b/lisp/eshell/em-banner.el @@ -39,20 +39,21 @@ ;;; Code: (eval-when-compile - (require 'cl) + (require 'cl-lib) (require 'esh-mode) (require 'eshell)) (require 'esh-util) ;;;###autoload -(eshell-defgroup eshell-banner nil +(progn +(defgroup eshell-banner nil "This sample module displays a welcome banner at login. It exists so that others wishing to create their own Eshell extension modules may have a simple template to begin with." :tag "Login banner" ;; :link '(info-link "(eshell)Login banner") - :group 'eshell-module) + :group 'eshell-module)) ;;; User Variables: @@ -76,10 +77,10 @@ This can be any sexp, and should end with at least two newlines." ;; `insert', because `insert' doesn't know how to interact with the ;; I/O code used by Eshell (unless eshell-non-interactive-p - (assert eshell-mode) - (assert eshell-banner-message) + (cl-assert eshell-mode) + (cl-assert eshell-banner-message) (let ((msg (eval eshell-banner-message))) - (assert msg) + (cl-assert msg) (eshell-interactive-print msg)))) (provide 'em-banner) diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el index ece029c39f2..e07bc75f89a 100644 --- a/lisp/eshell/em-basic.el +++ b/lisp/eshell/em-basic.el @@ -66,14 +66,15 @@ (require 'esh-opt) ;;;###autoload -(eshell-defgroup eshell-basic nil +(progn +(defgroup eshell-basic nil "The \"basic\" code provides a set of convenience functions which are traditionally considered shell builtins. Since all of the functionality provided by them is accessible through Lisp, they are not really builtins at all, but offer a command-oriented way to do the same thing." :tag "Basic shell commands" - :group 'eshell-module) + :group 'eshell-module)) (defcustom eshell-plain-echo-behavior nil "If non-nil, `echo' tries to behave like an ordinary shell echo. diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index a5e1b6194c7..a67861e83a9 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el @@ -70,17 +70,18 @@ ;;; Code: (eval-when-compile - (require 'cl) + (require 'cl-lib) (require 'eshell)) (require 'esh-util) ;;;###autoload -(eshell-defgroup eshell-cmpl nil +(progn +(defgroup eshell-cmpl nil "This module provides a programmable completion function bound to the TAB key, which allows for completing command names, file names, variable names, arguments, etc." :tag "Argument completion" - :group 'eshell-module) + :group 'eshell-module)) ;;; User Variables: @@ -357,7 +358,7 @@ to writing a completion function." (nconc posns (list pos))) (setq pos (1+ pos)))) (setq posns (cdr posns)) - (assert (= (length args) (length posns))) + (cl-assert (= (length args) (length posns))) (let ((a args) (i 0) l final) @@ -369,7 +370,7 @@ to writing a completion function." (and l (setq args (nthcdr (1+ l) args) posns (nthcdr (1+ l) posns)))) - (assert (= (length args) (length posns))) + (cl-assert (= (length args) (length posns))) (when (and args (eq (char-syntax (char-before end)) ? ) (not (eq (char-before (1- end)) ?\\))) (nconc args (list "")) @@ -382,7 +383,7 @@ to writing a completion function." (let ((result (eshell-do-eval (list 'eshell-commands arg) t))) - (assert (eq (car result) 'quote)) + (cl-assert (eq (car result) 'quote)) (cadr result)) arg))) (if (numberp val) diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index 992b5bdd77e..4a3fa54626b 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -47,14 +47,15 @@ (require 'esh-opt) ;;;###autoload -(eshell-defgroup eshell-dirs nil +(progn +(defgroup eshell-dirs nil "Directory navigation involves changing directories, examining the current directory, maintaining a directory stack, and also keeping track of a history of the last directory locations the user was in. Emacs does provide standard Lisp definitions of `pwd' and `cd', but they lack somewhat in feel from the typical shell equivalents." :tag "Directory navigation" - :group 'eshell-module) + :group 'eshell-module)) ;;; User Variables: diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el index 623d2c8e193..288aa9b773b 100644 --- a/lisp/eshell/em-glob.el +++ b/lisp/eshell/em-glob.el @@ -53,11 +53,12 @@ (require 'esh-util) ;;;###autoload -(eshell-defgroup eshell-glob nil +(progn +(defgroup eshell-glob nil "This module provides extended globbing syntax, similar what is used by zsh for filename generation." :tag "Extended filename globbing" - :group 'eshell-module) + :group 'eshell-module)) ;;; User Variables: diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index 05097a8deaf..64a7ad94c53 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -54,8 +54,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'ring) (require 'esh-opt) @@ -63,10 +62,11 @@ (require 'eshell) ;;;###autoload -(eshell-defgroup eshell-hist nil +(progn +(defgroup eshell-hist nil "This module provides command history management." :tag "History list management" - :group 'eshell-module) + :group 'eshell-module)) ;;; User Variables: @@ -559,8 +559,8 @@ See also `eshell-read-history'." (forward-char)) (setq posb (cdr posb) pose (cdr pose)) - (assert (= (length posb) (length args))) - (assert (<= (length posb) (length pose)))) + (cl-assert (= (length posb) (length args))) + (cl-assert (<= (length posb) (length pose)))) (setq hist (buffer-substring-no-properties begin end)) (let ((b posb) (e pose)) (while b @@ -570,7 +570,7 @@ See also `eshell-read-history'." (setq b (cdr b) e (cdr e)))) (setq textargs (cdr textargs)) - (assert (= (length textargs) (length args))) + (cl-assert (= (length textargs) (length args))) (list textargs posb pose)))) (defun eshell-expand-history-references (beg end) diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index 144b4dda8e2..2dd92ba3530 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -27,20 +27,21 @@ ;;; Code: (eval-when-compile - (require 'cl) + (require 'cl-lib) (require 'eshell)) (require 'esh-util) (require 'esh-opt) ;;;###autoload -(eshell-defgroup eshell-ls nil +(progn +(defgroup eshell-ls nil "This module implements the \"ls\" utility fully in Lisp. If it is passed any unrecognized command switches, it will revert to the operating system's version. This version of \"ls\" uses text properties to colorize its output based on the setting of `eshell-ls-use-colors'." :tag "Implementation of `ls' in Lisp" - :group 'eshell-module) + :group 'eshell-module)) ;;; User Variables: @@ -311,7 +312,7 @@ instead." (let ((insert-func 'eshell-buffered-print) (error-func 'eshell-error) (flush-func 'eshell-flush)) - (eshell-do-ls args))) + (apply 'eshell-do-ls args))) (put 'eshell/ls 'eshell-no-numeric-conversions t) @@ -462,7 +463,7 @@ name should be displayed as, etc. Think of it as cooking a FILEINFO." (progn (setcdr fileinfo attr) (setcar fileinfo (eshell-ls-decorated-name fileinfo))) - (assert (eq listing-style 'long-listing)) + (cl-assert (eq listing-style 'long-listing)) (setcar fileinfo (concat (eshell-ls-decorated-name fileinfo) " -> " (eshell-ls-decorated-name @@ -697,7 +698,7 @@ Each member of FILES is either a string or a cons cell of the form (let* ((col-vals (if (eq listing-style 'by-columns) (eshell-ls-find-column-lengths display-files) - (assert (eq listing-style 'by-lines)) + (cl-assert (eq listing-style 'by-lines)) (eshell-ls-find-column-widths display-files))) (col-widths (car col-vals)) (display-files (cdr col-vals)) diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el index 56b0fdfc9a2..fc23c0099e8 100644 --- a/lisp/eshell/em-pred.el +++ b/lisp/eshell/em-pred.el @@ -49,13 +49,14 @@ (eval-when-compile (require 'eshell)) ;;;###autoload -(eshell-defgroup eshell-pred nil +(progn +(defgroup eshell-pred nil "This module allows for predicates to be applied to globbing patterns (similar to zsh), in addition to string modifiers which can be applied either to globbing results, variable references, or just ordinary strings." :tag "Value modifiers and predicates" - :group 'eshell-module) + :group 'eshell-module)) ;;; User Variables: diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el index c13bb6d9630..f4701ec35ea 100644 --- a/lisp/eshell/em-prompt.el +++ b/lisp/eshell/em-prompt.el @@ -29,11 +29,12 @@ (eval-when-compile (require 'eshell)) ;;;###autoload -(eshell-defgroup eshell-prompt nil +(progn +(defgroup eshell-prompt nil "This module provides command prompts, and navigation between them, as is common with most shells." :tag "Command prompts" - :group 'eshell-module) + :group 'eshell-module)) ;;; User Variables: diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el index 243e71d7533..929b74d789d 100644 --- a/lisp/eshell/em-rebind.el +++ b/lisp/eshell/em-rebind.el @@ -26,7 +26,8 @@ (eval-when-compile (require 'eshell)) ;;;###autoload -(eshell-defgroup eshell-rebind nil +(progn +(defgroup eshell-rebind nil "This module allows for special keybindings that only take effect while the point is in a region of input text. By default, it binds C-a to move to the beginning of the input text (rather than just the @@ -37,7 +38,7 @@ commands to cause the point to leave the input area, such as `backward-word', `previous-line', etc. This module intends to mimic the behavior of normal shells while the user editing new input text." :tag "Rebind keys at input" - :group 'eshell-module) + :group 'eshell-module)) ;;; User Variables: diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el index 8acbc2644be..f219a4b6f12 100644 --- a/lisp/eshell/em-script.el +++ b/lisp/eshell/em-script.el @@ -24,13 +24,15 @@ ;;; Code: (require 'eshell) +(require 'esh-opt) ;;;###autoload -(eshell-defgroup eshell-script nil +(progn +(defgroup eshell-script nil "This module allows for the execution of files containing Eshell commands, as a script file." :tag "Running script files." - :group 'eshell-module) + :group 'eshell-module)) ;;; User Variables: diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el index cdaed9b717c..b427fe69ea4 100644 --- a/lisp/eshell/em-smart.el +++ b/lisp/eshell/em-smart.el @@ -71,7 +71,8 @@ (eval-when-compile (require 'eshell)) ;;;###autoload -(eshell-defgroup eshell-smart nil +(progn +(defgroup eshell-smart nil "This module combines the facility of normal, modern shells with some of the edit/review concepts inherent in the design of Plan 9's 9term. See the docs for more details. @@ -80,7 +81,7 @@ Most likely you will have to turn this option on and play around with it to get a real sense of how it works." :tag "Smart display of output" ;; :link '(info-link "(eshell)Smart display of output") - :group 'eshell-module) + :group 'eshell-module)) ;;; User Variables: diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el index 33c47d1c0ec..37fa939cc10 100644 --- a/lisp/eshell/em-term.el +++ b/lisp/eshell/em-term.el @@ -35,14 +35,15 @@ (require 'term) ;;;###autoload -(eshell-defgroup eshell-term nil +(progn +(defgroup eshell-term nil "This module causes visual commands (e.g., 'vi') to be executed by the `term' package, which comes with Emacs. This package handles most of the ANSI control codes, allowing curses-based applications to run within an Emacs window. The variable `eshell-visual-commands' defines which commands are considered visual in nature." :tag "Running visual commands" - :group 'eshell-module) + :group 'eshell-module)) ;;; User Variables: diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 1875506fe9d..35f7a0a9e3d 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -40,7 +40,8 @@ (require 'pcomplete) ;;;###autoload -(eshell-defgroup eshell-unix nil +(progn +(defgroup eshell-unix nil "This module defines many of the more common UNIX utilities as aliases implemented in Lisp. These include mv, ln, cp, rm, etc. If the user passes arguments which are too complex, or are unrecognized @@ -51,7 +52,7 @@ with Eshell makes them more versatile than their traditional cousins \(such as being able to use `kill' to kill Eshell background processes by name)." :tag "UNIX commands in Lisp" - :group 'eshell-module) + :group 'eshell-module)) (defcustom eshell-unix-load-hook nil "A list of functions to run when `eshell-unix' is loaded." @@ -1036,12 +1037,8 @@ Show wall-clock time elapsed during execution of COMMAND.") (put 'eshell/occur 'eshell-no-numeric-conversions t) -;; Pacify the byte-compiler. -(defvar tramp-default-proxies-alist) - (defun eshell/su (&rest args) "Alias \"su\" to call Tramp." - (require 'tramp) (setq args (eshell-stringify-list (eshell-flatten-list args))) (let ((orig-args (copy-tree args))) (eshell-eval-using-options @@ -1056,29 +1053,29 @@ Become another USER during a login session.") (host (or (file-remote-p default-directory 'host) "localhost")) (dir (or (file-remote-p default-directory 'localname) - (expand-file-name default-directory)))) + (expand-file-name default-directory))) + (prefix (file-remote-p default-directory))) (dolist (arg args) (if (string-equal arg "-") (setq login t) (setq user arg))) ;; `eshell-eval-using-options' does not handle "-". (if (member "-" orig-args) (setq login t)) (if login (setq dir "~/")) - (if (and (file-remote-p default-directory) + (if (and prefix (or (not (string-equal "su" (file-remote-p default-directory 'method))) (not (string-equal user (file-remote-p default-directory 'user))))) - (add-to-list - 'tramp-default-proxies-alist - (list host user (file-remote-p default-directory)))) - (eshell-parse-command - "cd" (list (format "/su:%s@%s:%s" user host dir)))))))) + (eshell-parse-command + "cd" (list (format "%s|su:%s@%s:%s" + (substring prefix 0 -1) user host dir))) + (eshell-parse-command + "cd" (list (format "/su:%s@%s:%s" user host dir))))))))) (put 'eshell/su 'eshell-no-numeric-conversions t) (defun eshell/sudo (&rest args) "Alias \"sudo\" to call Tramp." - (require 'tramp) (setq args (eshell-stringify-list (eshell-flatten-list args))) (let ((orig-args (copy-tree args))) (eshell-eval-using-options @@ -1093,21 +1090,26 @@ Execute a COMMAND as the superuser or another USER.") (host (or (file-remote-p default-directory 'host) "localhost")) (dir (or (file-remote-p default-directory 'localname) - (expand-file-name default-directory)))) + (expand-file-name default-directory))) + (prefix (file-remote-p default-directory))) ;; `eshell-eval-using-options' reads options of COMMAND. (while (and (stringp (car orig-args)) (member (car orig-args) '("-u" "--user"))) (setq orig-args (cddr orig-args))) - (if (and (file-remote-p default-directory) - (or - (not (string-equal - "sudo" (file-remote-p default-directory 'method))) - (not (string-equal - user (file-remote-p default-directory 'user))))) - (add-to-list - 'tramp-default-proxies-alist - (list host user (file-remote-p default-directory)))) - (let ((default-directory (format "/sudo:%s@%s:%s" user host dir))) + (let ((default-directory + (if (and prefix + (or + (not + (string-equal + "sudo" + (file-remote-p default-directory 'method))) + (not + (string-equal + user + (file-remote-p default-directory 'user))))) + (format "%s|sudo:%s@%s:%s" + (substring prefix 0 -1) user host dir) + (format "/sudo:%s@%s:%s" user host dir)))) (eshell-named-command (car orig-args) (cdr orig-args)))))))) (put 'eshell/sudo 'eshell-no-numeric-conversions t) diff --git a/lisp/eshell/em-xtra.el b/lisp/eshell/em-xtra.el index 3dfb33d37e3..2e7a813cb75 100644 --- a/lisp/eshell/em-xtra.el +++ b/lisp/eshell/em-xtra.el @@ -29,13 +29,14 @@ (require 'compile) ;;;###autoload -(eshell-defgroup eshell-xtra nil +(progn +(defgroup eshell-xtra nil "This module defines some extra alias functions which are entirely optional. They can be viewed as samples for how to write Eshell alias functions, or as aliases which make some of Emacs's behavior more naturally accessible within Emacs." :tag "Extra alias functions" - :group 'eshell-module) + :group 'eshell-module)) ;;; Functions: diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 850cecbc0a5..515a23f81d7 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -108,7 +108,7 @@ (require 'esh-ext) (eval-when-compile - (require 'cl) + (require 'cl-lib) (require 'pcomplete)) @@ -604,7 +604,7 @@ For an external command, it means an exit code of 0." (list (if (<= (length pieces) 1) (car pieces) - (assert (not eshell-in-pipeline-p)) + (cl-assert (not eshell-in-pipeline-p)) `(eshell-execute-pipeline (quote ,pieces)))))) (setq bp (cdr bp)))) ;; `results' might be empty; this happens in the case of @@ -615,7 +615,7 @@ For an external command, it means an exit code of 0." results (cdr results) sep-terms (nreverse sep-terms)) (while results - (assert (car sep-terms)) + (cl-assert (car sep-terms)) (setq final (eshell-structure-basic-command 'if (string= (car sep-terms) "&&") "if" `(eshell-protect ,(car results)) @@ -1026,7 +1026,7 @@ be finished later after the completion of an asynchronous subprocess." ;; `eshell-copy-tree' is needed here so that the test argument ;; doesn't get modified and thus always yield the same result. (when (car eshell-command-body) - (assert (not synchronous-p)) + (cl-assert (not synchronous-p)) (eshell-do-eval (car eshell-command-body)) (setcar eshell-command-body nil) (setcar eshell-test-body nil)) @@ -1046,7 +1046,7 @@ be finished later after the completion of an asynchronous subprocess." ;; doesn't get modified and thus always yield the same result. (if (car eshell-command-body) (progn - (assert (not synchronous-p)) + (cl-assert (not synchronous-p)) (eshell-do-eval (car eshell-command-body))) (unless (car eshell-test-body) (setcar eshell-test-body (eshell-copy-tree (car args)))) @@ -1201,7 +1201,7 @@ COMMAND may result in an alias being executed, or a plain command." (setq eshell-last-arguments args eshell-last-command-name (eshell-stringify command)) (run-hook-with-args 'eshell-prepare-command-hook) - (assert (stringp eshell-last-command-name)) + (cl-assert (stringp eshell-last-command-name)) (if eshell-last-command-name (or (run-hook-with-args-until-success 'eshell-named-command-hook eshell-last-command-name @@ -1220,9 +1220,7 @@ COMMAND may result in an alias being executed, or a plain command." (if (and file (string-match "\\(em\\|esh\\)-\\(.*\\)\\(\\.el\\)?\\'" file)) (let ((module-sym - (intern (file-name-sans-extension - (file-name-nondirectory - (concat "eshell-" (match-string 2 file))))))) + (intern (file-name-base (concat "eshell-" (match-string 2 file)))))) (if (and (functionp sym) (or (null module-sym) (eshell-using-module module-sym) diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el index f025c66df32..603da6f2e30 100644 --- a/lisp/eshell/esh-ext.el +++ b/lisp/eshell/esh-ext.el @@ -34,9 +34,10 @@ (provide 'esh-ext) (eval-when-compile - (require 'cl) + (require 'cl-lib) (require 'esh-cmd)) (require 'esh-util) +(require 'esh-opt) (defgroup eshell-ext nil "External commands are invoked when operating system executables are @@ -188,6 +189,7 @@ all the output from the remote command, and sends it all at once, causing the user to wonder if anything's really going on..." (let ((outbuf (generate-new-buffer " *eshell remote output*")) (errbuf (generate-new-buffer " *eshell remote error*")) + (command (or (file-remote-p command 'localname) command)) (exitcode 1)) (unwind-protect (progn @@ -205,10 +207,10 @@ causing the user to wonder if anything's really going on..." (defun eshell-external-command (command args) "Insert output from an external COMMAND, using ARGS." (setq args (eshell-stringify-list (eshell-flatten-list args))) - (if (file-remote-p default-directory) - (eshell-remote-command command args)) + ;; (if (file-remote-p default-directory) + ;; (eshell-remote-command command args)) (let ((interp (eshell-find-interpreter command))) - (assert interp) + (cl-assert interp) (if (functionp (car interp)) (apply (car interp) (append (cdr interp) args)) (eshell-gather-process-output diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index c8230e0baad..9f3cfe0f6d0 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -59,7 +59,7 @@ (provide 'esh-io) (eval-when-compile - (require 'cl) + (require 'cl-lib) (require 'eshell)) (defgroup eshell-io nil @@ -298,7 +298,7 @@ completed successfully. RESULT is the quoted value of the last command. If nil, then the meta variables for keeping track of the last execution result should not be changed." (let ((idx 0)) - (assert (or (not result) (eq (car result) 'quote))) + (cl-assert (or (not result) (eq (car result) 'quote))) (setq eshell-last-command-status exit-code eshell-last-command-result (cadr result)) (while (< idx eshell-number-of-handles) diff --git a/lisp/eshell/esh-module.el b/lisp/eshell/esh-module.el index 8875395e1d1..2e3c6b8b7b5 100644 --- a/lisp/eshell/esh-module.el +++ b/lisp/eshell/esh-module.el @@ -36,7 +36,9 @@ customizing the variable `eshell-modules-list'." ;; load the defgroup's for the standard extension modules, so that ;; documentation can be provided when the user customize's -;; `eshell-modules-list'. +;; `eshell-modules-list'. We use "(progn (defgroup ..." in each file +;; to force the autoloader into including the entire defgroup, rather +;; than an abbreviated version. (load "esh-groups" nil 'nomessage) ;;; User Variables: diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el index edb115b7f4f..fed2d8f1c62 100644 --- a/lisp/eshell/esh-opt.el +++ b/lisp/eshell/esh-opt.el @@ -106,7 +106,9 @@ interned variable `args' (created using a `let' form)." (and (listp opt) (nth 3 opt))) (cadr options))) '(usage-msg last-value ext-command args)) - (eshell-do-opt ,name ,options (quote ,body-forms))))) + ;; FIXME: `options' ends up hiding some variable names under `quote', + ;; which is incompatible with lexical scoping!! + (eshell-do-opt ,name ,options (lambda () ,@body-forms))))) ;;; Internal Functions: @@ -117,7 +119,7 @@ interned variable `args' (created using a `let' form)." ;; Documented part of the interface; see eshell-eval-using-options. (defvar args) -(defun eshell-do-opt (name options body-forms) +(defun eshell-do-opt (name options body-fun) "Helper function for `eshell-eval-using-options'. This code doesn't really need to be macro expanded everywhere." (setq args temp-args) @@ -133,8 +135,7 @@ This code doesn't really need to be macro expanded everywhere." (throw 'eshell-usage (eshell-show-usage name options))) (setq args (eshell-process-args name args options) - last-value (eval (append (list 'progn) - body-forms))) + last-value (funcall body-fun)) nil)) (error "%s" usage-msg)))) (throw 'eshell-external @@ -218,10 +219,8 @@ switch is unrecognized." found) (while opts (if (and (listp (car opts)) - (nth kind (car opts)) - (if (= kind 0) - (eq switch (nth kind (car opts))) - (string= switch (nth kind (car opts))))) + (nth kind (car opts)) + (equal switch (nth kind (car opts)))) (progn (eshell-set-option name ai (car opts) options) (setq found t opts nil)) diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index 28984c2747d..6a0e159e82e 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -110,8 +110,8 @@ (eval-when-compile (require 'pcomplete) (require 'esh-util) - (require 'esh-opt) (require 'esh-mode)) +(require 'esh-opt) (require 'env) (require 'ring) diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el index f8c9788b24d..a1717756696 100644 --- a/lisp/eshell/eshell.el +++ b/lisp/eshell/eshell.el @@ -222,7 +222,7 @@ ;; things up. (eval-when-compile - (require 'cl) + (require 'cl-lib) (require 'esh-util)) (require 'esh-util) (require 'esh-mode) @@ -236,10 +236,6 @@ shells such as bash, zsh, rc, 4dos." :version "21.1" :group 'applications) -;; This is hack to force make-autoload to put the whole definition -;; into the autoload file (see esh-module.el). -(defalias 'eshell-defgroup 'defgroup) - ;;;_* User Options ;; ;; The following user options modify the behavior of Eshell overall. @@ -302,7 +298,7 @@ switches to the session with that number, creating it if necessary. A nonnumeric prefix arg means to create a new session. Returns the buffer selected (or created)." (interactive "P") - (assert eshell-buffer-name) + (cl-assert eshell-buffer-name) (let ((buf (cond ((numberp arg) (get-buffer-create (format "%s<%d>" eshell-buffer-name @@ -316,7 +312,7 @@ buffer selected (or created)." ;; window that that command was invoked from. To achieve this, ;; it's necessary to add `eshell-buffer-name' to the variable ;; `same-window-buffer-names', which is done when Eshell is loaded - (assert (and buf (buffer-live-p buf))) + (cl-assert (and buf (buffer-live-p buf))) (pop-to-buffer buf) (unless (eq major-mode 'eshell-mode) (eshell-mode)) @@ -384,11 +380,11 @@ With prefix ARG, insert output into the current buffer at point." (when intr (if (eshell-interactive-process) (eshell-wait-for-process (eshell-interactive-process))) - (assert (not (eshell-interactive-process))) + (cl-assert (not (eshell-interactive-process))) (goto-char (point-max)) (while (and (bolp) (not (bobp))) (delete-char -1))) - (assert (and buf (buffer-live-p buf))) + (cl-assert (and buf (buffer-live-p buf))) (unless arg (let ((len (if (not intr) 2 (count-lines (point-min) (point-max))))) @@ -428,7 +424,7 @@ corresponding to a successful execution." (list 'eshell-commands (list 'eshell-command-to-value (eshell-parse-command command))) t))) - (assert (eq (car result) 'quote)) + (cl-assert (eq (car result) 'quote)) (if (and status-var (symbolp status-var)) (set status-var eshell-last-command-status)) (cadr result)))))) diff --git a/lisp/face-remap.el b/lisp/face-remap.el index e2f9e3d2bd2..09503d7c154 100644 --- a/lisp/face-remap.el +++ b/lisp/face-remap.el @@ -315,9 +315,9 @@ a top-level keymap, `text-scale-increase' or (let* ((base (event-basic-type ev)) (step (pcase base - ((or `?+ `?=) inc) - (`?- (- inc)) - (`?0 0) + ((or ?+ ?=) inc) + (?- (- inc)) + (?0 0) (t inc)))) (text-scale-increase step) ;; FIXME: do it after every "iteration of the loop". diff --git a/lisp/faces.el b/lisp/faces.el index 40b45187f6c..2e1ba7798e9 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -25,9 +25,6 @@ ;;; Code: -(eval-when-compile - (require 'cl)) - (defcustom term-file-prefix (purecopy "term/") "If non-nil, Emacs startup performs terminal-specific initialization. It does this by: (load (concat term-file-prefix (getenv \"TERM\"))) @@ -996,28 +993,28 @@ Value is an alist of (NAME . VALUE) if ATTRIBUTE expects a value out of a set of discrete values. Value is `integerp' if ATTRIBUTE expects an integer value." (let ((valid - (case attribute - (:family + (pcase attribute + (`:family (if (window-system frame) (mapcar (lambda (x) (cons x x)) (font-family-list)) ;; Only one font on TTYs. (list (cons "default" "default")))) - (:foundry + (`:foundry (list nil)) - (:width + (`:width (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1))) font-width-table)) - (:weight + (`:weight (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1))) font-weight-table)) - (:slant + (`:slant (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1))) font-slant-table)) - (:inverse-video + (`:inverse-video (mapcar #'(lambda (x) (cons (symbol-name x) x)) (internal-lisp-face-attribute-values attribute))) - ((:underline :overline :strike-through :box) + ((or `:underline `:overline `:strike-through `:box) (if (window-system frame) (nconc (mapcar #'(lambda (x) (cons (symbol-name x) x)) (internal-lisp-face-attribute-values attribute)) @@ -1025,12 +1022,12 @@ an integer value." (defined-colors frame))) (mapcar #'(lambda (x) (cons (symbol-name x) x)) (internal-lisp-face-attribute-values attribute)))) - ((:foreground :background) + ((or `:foreground `:background) (mapcar #'(lambda (c) (cons c c)) (defined-colors frame))) - ((:height) + (`:height 'integerp) - (:stipple + (`:stipple (and (memq (window-system frame) '(x ns)) ; No stipple on w32 (mapcar #'list (apply #'nconc @@ -1039,11 +1036,11 @@ an integer value." (file-directory-p dir) (directory-files dir))) x-bitmap-file-path))))) - (:inherit + (`:inherit (cons '("none" . nil) (mapcar #'(lambda (c) (cons (symbol-name c) c)) (face-list)))) - (t + (_ (error "Internal error"))))) (if (and (listp valid) (not (memq attribute '(:inherit)))) (nconc (list (cons "unspecified" 'unspecified)) valid) @@ -1550,10 +1547,14 @@ If SPEC is nil, return nil." ;; temacs, prior to loading frame.el. (unless (and (fboundp 'display-graphic-p) (display-graphic-p frame)) - '(:family "default" :foundry "default" :width normal + `(:family "default" :foundry "default" :width normal :height 1 :weight normal :slant normal - :foreground "unspecified-fg" - :background "unspecified-bg"))) + :foreground ,(if (frame-parameter nil 'reverse) + "unspecified-bg" + "unspecified-fg") + :background ,(if (frame-parameter nil 'reverse) + "unspecified-fg" + "unspecified-bg")))) ;; For all other faces, unspecify all attributes. (apply 'append (mapcar (lambda (x) (list (car x) 'unspecified)) diff --git a/lisp/ffap.el b/lisp/ffap.el index a8455189cb9..3d1f402ab6c 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1698,9 +1698,11 @@ Only intended for interactive use." (set-window-dedicated-p win wdp)) value)) -(defun ffap--toggle-read-only (buffer) - (with-current-buffer buffer - (with-no-warnings +(defun ffap--toggle-read-only (buffer-or-list) + (dolist (buffer (if (listp buffer-or-list) + buffer-or-list + (list buffer-or-list))) + (with-current-buffer buffer (toggle-read-only 1)))) (defun ffap-read-only () @@ -1710,8 +1712,7 @@ Only intended for interactive use." (let ((value (call-interactively 'ffap))) (unless (or (bufferp value) (bufferp (car-safe value))) (setq value (current-buffer))) - (mapc #'ffap--toggle-read-only - (if (listp value) value (list value))) + (ffap--toggle-read-only value) value)) (defun ffap-read-only-other-window () @@ -1719,8 +1720,7 @@ Only intended for interactive use." Only intended for interactive use." (interactive) (let ((value (ffap-other-window))) - (mapc #'ffap--toggle-read-only - (if (listp value) value (list value))) + (ffap--toggle-read-only value) value)) (defun ffap-read-only-other-frame () @@ -1728,8 +1728,7 @@ Only intended for interactive use." Only intended for interactive use." (interactive) (let ((value (ffap-other-frame))) - (mapc #'ffap--toggle-read-only - (if (listp value) value (list value))) + (ffap--toggle-read-only value) value)) (defun ffap-alternate-file () diff --git a/lisp/files.el b/lisp/files.el index b1f6fe6e4c6..7fc7ccc8553 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -28,8 +28,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - (defvar font-lock-keywords) (defgroup backup nil @@ -782,10 +780,10 @@ one or more of those symbols." (read-file-name-internal string pred action)) ((eq (car-safe action) 'boundaries) (let ((suffix (cdr action))) - (list* 'boundaries - (length (file-name-directory string)) - (let ((x (file-name-directory suffix))) - (if x (1- (length x)) (length suffix)))))) + `(boundaries + ,(length (file-name-directory string)) + ,@(let ((x (file-name-directory suffix))) + (if x (1- (length x)) (length suffix)))))) (t (let ((names '()) ;; If we have files like "foo.el" and "foo.elc", we could load one of @@ -878,12 +876,12 @@ or mount points potentially requiring authentication as a different user.") ;; nil))) (defun locate-dominating-file (file name) - "Look up the directory hierarchy from FILE for a file named NAME. + "Look up the directory hierarchy from FILE for a directory containing NAME. Stop at the first parent directory containing a file NAME, and return the directory. Return nil if not found. - -This function only tests if FILE exists. If you care about whether -it is readable, regular, etc., you should test the result." +Instead of a string, NAME can also be a predicate taking one argument +\(a directory) and returning a non-nil value if that directory is the one for +which we're looking." ;; We used to use the above locate-dominating-files code, but the ;; directory-files call is very costly, so we're much better off doing ;; multiple calls using the code in here. @@ -910,16 +908,14 @@ it is readable, regular, etc., you should test the result." ;; (setq user (nth 2 (file-attributes file))) ;; (and prev-user (not (equal user prev-user)))) (string-match locate-dominating-stop-dir-regexp file))) - ;; FIXME? maybe this function should (optionally?) - ;; use file-readable-p instead. In many cases, an unreadable - ;; FILE is no better than a non-existent one. - ;; See eg dir-locals-find-file. - (setq try (file-exists-p (expand-file-name name file))) + (setq try (if (stringp name) + (file-exists-p (expand-file-name name file)) + (funcall name file))) (cond (try (setq root file)) ((equal file (setq file (file-name-directory (directory-file-name file)))) (setq file nil)))) - root)) + (if root (file-name-as-directory root)))) (defun executable-find (command) @@ -1469,6 +1465,17 @@ file names with wildcards." (find-file filename) (current-buffer))) +(defun find-file--read-only (fun filename wildcards) + (unless (or (and wildcards find-file-wildcards + (not (string-match "\\`/:" filename)) + (string-match "[[*?]" filename)) + (file-exists-p filename)) + (error "%s does not exist" filename)) + (let ((value (funcall fun filename wildcards))) + (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) + (if (listp value) value (list value))) + value)) + (defun find-file-read-only (filename &optional wildcards) "Edit file FILENAME but don't allow changes. Like \\[find-file], but marks buffer as read-only. @@ -1476,15 +1483,7 @@ Use \\[toggle-read-only] to permit editing." (interactive (find-file-read-args "Find file read-only: " (confirm-nonexistent-file-or-buffer))) - (unless (or (and wildcards find-file-wildcards - (not (string-match "\\`/:" filename)) - (string-match "[[*?]" filename)) - (file-exists-p filename)) - (error "%s does not exist" filename)) - (let ((value (find-file filename wildcards))) - (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) - (if (listp value) value (list value))) - value)) + (find-file--read-only #'find-file filename wildcards)) (defun find-file-read-only-other-window (filename &optional wildcards) "Edit file FILENAME in another window but don't allow changes. @@ -1493,15 +1492,7 @@ Use \\[toggle-read-only] to permit editing." (interactive (find-file-read-args "Find file read-only other window: " (confirm-nonexistent-file-or-buffer))) - (unless (or (and wildcards find-file-wildcards - (not (string-match "\\`/:" filename)) - (string-match "[[*?]" filename)) - (file-exists-p filename)) - (error "%s does not exist" filename)) - (let ((value (find-file-other-window filename wildcards))) - (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) - (if (listp value) value (list value))) - value)) + (find-file--read-only #'find-file-other-window filename wildcards)) (defun find-file-read-only-other-frame (filename &optional wildcards) "Edit file FILENAME in another frame but don't allow changes. @@ -1510,15 +1501,7 @@ Use \\[toggle-read-only] to permit editing." (interactive (find-file-read-args "Find file read-only other frame: " (confirm-nonexistent-file-or-buffer))) - (unless (or (and wildcards find-file-wildcards - (not (string-match "\\`/:" filename)) - (string-match "[[*?]" filename)) - (file-exists-p filename)) - (error "%s does not exist" filename)) - (let ((value (find-file-other-frame filename wildcards))) - (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) - (if (listp value) value (list value))) - value)) + (find-file--read-only #'find-file-other-frame filename wildcards)) (defun find-alternate-file-other-window (filename &optional wildcards) "Find file FILENAME as a replacement for the file in the next window. @@ -2022,6 +2005,8 @@ Do you want to revisit the file normally now? ") (after-find-file error (not nowarn))) (current-buffer)))) +(defvar file-name-buffer-file-type-alist) ;From dos-w32.el. + (defun insert-file-contents-literally (filename &optional visit beg end replace) "Like `insert-file-contents', but only reads in the file literally. A buffer may be modified in several ways after reading into the buffer, @@ -2033,21 +2018,14 @@ This function ensures that none of these modifications will take place." (after-insert-file-functions nil) (coding-system-for-read 'no-conversion) (coding-system-for-write 'no-conversion) - (find-buffer-file-type-function - (if (fboundp 'find-buffer-file-type) - (symbol-function 'find-buffer-file-type) - nil)) + (file-name-buffer-file-type-alist '(("" . t))) (inhibit-file-name-handlers + ;; FIXME: Yuck!! We should turn insert-file-contents-literally + ;; into a file operation instead! (append '(jka-compr-handler image-file-handler epa-file-handler) inhibit-file-name-handlers)) (inhibit-file-name-operation 'insert-file-contents)) - (unwind-protect - (progn - (fset 'find-buffer-file-type (lambda (_filename) t)) - (insert-file-contents filename visit beg end replace)) - (if find-buffer-file-type-function - (fset 'find-buffer-file-type find-buffer-file-type-function) - (fmakunbound 'find-buffer-file-type))))) + (insert-file-contents filename visit beg end replace))) (defun insert-file-1 (filename insert-func) (if (file-directory-p filename) @@ -4085,6 +4063,12 @@ the value is \"\"." (if period ""))))) +(defun file-name-base (&optional filename) + "Return the base name of the FILENAME: no directory, no extension. +FILENAME defaults to `buffer-file-name'." + (file-name-sans-extension + (file-name-nondirectory (or filename (buffer-file-name))))) + (defcustom make-backup-file-name-function nil "A function to use instead of the default `make-backup-file-name'. A value of nil gives the default `make-backup-file-name' behavior. @@ -4348,7 +4332,9 @@ on a DOS/Windows machine, it returns FILENAME in expanded form." default-directory)))) (setq filename (expand-file-name filename)) (let ((fremote (file-remote-p filename)) - (dremote (file-remote-p directory))) + (dremote (file-remote-p directory)) + (fold-case (or (memq system-type '(ms-dos cygwin windows-nt)) + read-file-name-completion-ignore-case))) (if ;; Conditions for separate trees (or ;; Test for different filesystems on DOS/Windows @@ -4357,7 +4343,7 @@ on a DOS/Windows machine, it returns FILENAME in expanded form." (memq system-type '(ms-dos cygwin windows-nt)) (or ;; Test for different drive letters - (not (eq t (compare-strings filename 0 2 directory 0 2))) + (not (eq t (compare-strings filename 0 2 directory 0 2 fold-case))) ;; Test for UNCs on different servers (not (eq t (compare-strings (progn @@ -4382,16 +4368,16 @@ on a DOS/Windows machine, it returns FILENAME in expanded form." (while (not (or (eq t (compare-strings filename-dir nil (length directory) - directory nil nil case-fold-search)) + directory nil nil fold-case)) (eq t (compare-strings filename nil (length directory) - directory nil nil case-fold-search)))) + directory nil nil fold-case)))) (setq directory (file-name-directory (substring directory 0 -1)) ancestor (if (equal ancestor ".") ".." (concat "../" ancestor)))) ;; Now ancestor is empty, or .., or ../.., etc. (if (eq t (compare-strings filename nil (length directory) - directory nil nil case-fold-search)) + directory nil nil fold-case)) ;; We matched within FILENAME's directory part. ;; Add the rest of FILENAME onto ANCESTOR. (let ((rest (substring filename (length directory)))) @@ -4838,37 +4824,51 @@ prints a message in the minibuffer. Instead, use `set-buffer-modified-p'." "Modification-flag cleared")) (set-buffer-modified-p arg)) -(defun toggle-read-only (&optional arg) - "Change whether this buffer is read-only. +(defun toggle-read-only (&optional arg message) + "Toggle the read-only state of the current buffer. With prefix argument ARG, make the buffer read-only if ARG is -positive, otherwise make it writable. If buffer is read-only -and `view-read-only' is non-nil, enter view mode. +positive; otherwise make it writable. -This function is usually the wrong thing to use in a Lisp program. -It can have side-effects beyond changing the read-only status of a buffer -\(e.g., enabling view mode), and does not affect read-only regions that -are caused by text properties. To make a buffer read-only in Lisp code, -set `buffer-read-only'. To ignore read-only status (whether due to text -properties or buffer state) and make changes, temporarily bind -`inhibit-read-only'." +When making the buffer read-only, enable View mode if +`view-read-only' is non-nil. When making the buffer writable, +disable View mode if View mode is enabled. + +If called interactively, or if called from Lisp with MESSAGE +non-nil, print a message reporting the buffer's new read-only +status. + +Do not call this from a Lisp program unless you really intend to +do the same thing as the \\[toggle-read-only] command, including +possibly enabling or disabling View mode. Also, note that this +command works by setting the variable `buffer-read-only', which +does not affect read-only regions caused by text properties. To +ignore read-only status in a Lisp program (whether due to text +properties or buffer state), bind `inhibit-read-only' temporarily +to a non-nil value." (interactive "P") - (if (and arg - (if (> (prefix-numeric-value arg) 0) buffer-read-only - (not buffer-read-only))) ; If buffer-read-only is set correctly, - nil ; do nothing. - ;; Toggle. - (cond - ((and buffer-read-only view-mode) - (View-exit-and-edit) - (make-local-variable 'view-read-only) - (setq view-read-only t)) ; Must leave view mode. - ((and (not buffer-read-only) view-read-only - ;; If view-mode is already active, `view-mode-enter' is a nop. - (not view-mode) - (not (eq (get major-mode 'mode-class) 'special))) - (view-mode-enter)) - (t (setq buffer-read-only (not buffer-read-only)) - (force-mode-line-update))))) + (cond + ;; Do nothing if `buffer-read-only' already matches the state + ;; specified by ARG. + ((and arg + (if (> (prefix-numeric-value arg) 0) + buffer-read-only + (not buffer-read-only)))) + ;; If View mode is enabled, exit it. + ((and buffer-read-only view-mode) + (View-exit-and-edit) + (set (make-local-variable 'view-read-only) t)) + ;; If `view-read-only' is non-nil, enable View mode. + ((and view-read-only + (not buffer-read-only) + (not view-mode) + (not (eq (get major-mode 'mode-class) 'special))) + (view-mode-enter)) + ;; The usual action: flip `buffer-read-only'. + (t (setq buffer-read-only (not buffer-read-only)) + (force-mode-line-update))) + (if (or message (called-interactively-p 'interactive)) + (message "Read-only %s for this buffer" + (if buffer-read-only "enabled" "disabled")))) (defun insert-file (filename) "Insert contents of file FILENAME into buffer after point. @@ -5951,11 +5951,12 @@ returns nil." (when (and directory-free-space-program ;; Avoid failure if the default directory does ;; not exist (Bug#2631, Bug#3911). - (let ((default-directory "/")) - (eq (call-process directory-free-space-program + (let ((default-directory + (locate-dominating-file dir 'file-directory-p))) + (eq (process-file directory-free-space-program nil t nil directory-free-space-args - dir) + (file-relative-name dir)) 0))) ;; Assume that the "available" column is before the ;; "capacity" column. Find the "%" and scan backward. @@ -6461,19 +6462,19 @@ only these files will be asked to be saved." "/" (substring (car pair) 2))))) (setq file-arg-indices (cdr file-arg-indices)))) - (cl-case method - (identity (car arguments)) - (add (concat "/:" (apply operation arguments))) - (insert-file-contents + (pcase method + (`identity (car arguments)) + (`add (concat "/:" (apply operation arguments))) + (`insert-file-contents (let ((visit (nth 1 arguments))) (prog1 (apply operation arguments) (when (and visit buffer-file-name) (setq buffer-file-name (concat "/:" buffer-file-name)))))) - (unquote-then-quote + (`unquote-then-quote (let ((buffer-file-name (substring buffer-file-name 2))) (apply operation arguments))) - (t + (_ (apply operation arguments))))) ;; Symbolic modes and read-file-modes. diff --git a/lisp/filesets.el b/lisp/filesets.el index 86ebe47580b..6c24a4f43d6 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -88,9 +88,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) - +(eval-when-compile (require 'cl-lib)) ;;; Some variables @@ -1286,11 +1284,11 @@ on-close-all ... Not used" (or entry (filesets-get-external-viewer filename))))) (filesets-alist-get def - (case event - ((on-open-all) ':ignore-on-open-all) - ((on-grep) ':ignore-on-read-text) - ((on-cmd) nil) - ((on-close-all) nil)) + (pcase event + (`on-open-all ':ignore-on-open-all) + (`on-grep ':ignore-on-read-text) + (`on-cmd nil) + (`on-close-all nil)) nil t))) (defun filesets-filetype-get-prop (property filename &optional entry) @@ -1559,11 +1557,9 @@ SAVE-FUNCTION takes no argument, but works on the current buffer." (defun filesets-get-fileset-from-name (name &optional mode) "Get fileset definition for NAME." - (case mode - ((:ingroup :tree) - name) - (t - (assoc name filesets-data)))) + (pcase mode + ((or `:ingroup `:tree) name) + (_ (assoc name filesets-data)))) ;;; commands @@ -1720,22 +1716,22 @@ Replace or <> with filename." Assume MODE (see `filesets-entry-mode'), if provided." (let* ((mode (or mode (filesets-entry-mode entry))) - (fl (case mode - ((:files) + (fl (pcase mode + (:files (filesets-entry-get-files entry)) - ((:file) + (:file (list (filesets-entry-get-file entry))) - ((:ingroup) + (:ingroup (let ((entry (expand-file-name (if (stringp entry) entry (filesets-entry-get-master entry))))) (cons entry (filesets-ingroup-cache-get entry)))) - ((:tree) + (:tree (let ((dir (nth 0 entry)) (patt (nth 1 entry))) (filesets-directory-files dir patt ':files t))) - ((:pattern) + (:pattern (let ((dirpatt (filesets-entry-get-pattern entry))) (if dirpatt (let ((dir (filesets-entry-get-pattern--dir dirpatt)) @@ -1904,12 +1900,12 @@ User will be queried, if no fileset name is provided." (let* ((result nil) (factor (ceiling (/ (float bl) filesets-max-submenu-length)))) - (do ((data submenu-body (cdr data)) - (n 1 (+ n 1)) - (count 0 (+ count factor))) + (cl-do ((data submenu-body (cdr data)) + (n 1 (+ n 1)) + (count 0 (+ count factor))) ((or (> count bl) (null data))) -; (let ((sl (subseq submenu-body count + ;; (let ((sl (subseq submenu-body count (let ((sl (filesets-sublist submenu-body count (let ((x (+ count factor))) (if (>= bl x) @@ -1926,7 +1922,7 @@ User will be queried, if no fileset name is provided." `((,(concat (filesets-get-shortcut n) (let ((rv "")) - (do ((x sl (cdr x))) + (cl-do ((x sl (cdr x))) ((null x)) (let ((y (concat (elt (car x) 0) (if (null (cdr x)) @@ -1952,8 +1948,8 @@ User will be queried, if no fileset name is provided." "Get submenu epilog for SOMETHING (usually a fileset). If mode is :tree or :ingroup, SOMETHING is some weird construct and LOOKUP-NAME is used as lookup name for retrieving fileset specific settings." - (case mode - ((:tree) + (pcase mode + (:tree `("---" ["Close all files" (filesets-close ',mode ',something ',lookup-name)] ["Run Command" (filesets-run-cmd nil ',something ',mode)] @@ -1962,14 +1958,14 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings." ,@(when rebuild-flag `(["Rebuild this submenu" (filesets-rebuild-this-submenu ',lookup-name)])))) - ((:ingroup) + (:ingroup `("---" ["Close all files" (filesets-close ',mode ',something ',lookup-name)] ["Run Command" (filesets-run-cmd nil ',something ',mode)] ,@(when rebuild-flag `(["Rebuild this submenu" (filesets-rebuild-this-submenu ',lookup-name)])))) - ((:pattern) + (:pattern `("---" ["Close all files" (filesets-close ',mode ',something)] ["Run Command" (filesets-run-cmd nil ',something ',mode)] @@ -1986,7 +1982,7 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings." ,@(when rebuild-flag `(["Rebuild this submenu" (filesets-rebuild-this-submenu ',lookup-name)])))) - ((:files) + (:files `("---" [,(concat "Close all files") (filesets-close ',mode ',something)] ["Run Command" (filesets-run-cmd nil ',something ',mode)] @@ -1997,7 +1993,7 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings." ,@(when rebuild-flag `(["Rebuild this submenu" (filesets-rebuild-this-submenu ',lookup-name)])))) - (t + (_ (filesets-error 'error "Filesets: malformed definition of " something)))) (defun filesets-ingroup-get-data (master pos &optional fun) @@ -2249,15 +2245,15 @@ Construct a shortcut from COUNT." (filesets-verbosity (filesets-entry-get-verbosity entry)) (this-lookup-name (concat (filesets-get-shortcut count) lookup-name))) - (case mode - ((:file) + (pcase mode + (:file (let* ((file (filesets-entry-get-file entry))) `[,this-lookup-name (filesets-file-open nil ',file ',lookup-name)])) - (t + (_ `(,this-lookup-name - ,@(case mode - ((:pattern) + ,@(pcase mode + (:pattern (let* ((files (filesets-get-filelist entry mode 'on-ls)) (dirpatt (filesets-entry-get-pattern entry)) (pattname (apply 'concat (cons "Pattern: " dirpatt))) @@ -2276,7 +2272,7 @@ Construct a shortcut from COUNT." files)) ,@(filesets-get-menu-epilog lookup-name mode lookup-name t)))) - ((:ingroup) + (:ingroup (let* ((master (filesets-entry-get-master entry))) ;;(filesets-message 3 "Filesets: parsing %S" master) `([,(concat "Inclusion Group: " @@ -2288,12 +2284,12 @@ Construct a shortcut from COUNT." ,@(filesets-wrap-submenu (filesets-build-ingroup-submenu lookup-name master)) ,@(filesets-get-menu-epilog master mode lookup-name t)))) - ((:tree) + (:tree (let* ((dirpatt (filesets-entry-get-tree entry)) (dir (car dirpatt)) (patt (cadr dirpatt))) (filesets-build-dir-submenu entry lookup-name dir patt))) - ((:files) + (:files (let ((files (filesets-get-filelist entry mode 'on-open-all)) (count 0)) `([,(concat "Files: " lookup-name) @@ -2331,9 +2327,9 @@ bottom up, set `filesets-submenus' to nil, first.)" (setq filesets-has-changed-flag nil) (setq filesets-updated-buffers nil) (setq filesets-update-cache-file-flag t) - (do ((data (filesets-conditional-sort filesets-data (function car)) - (cdr data)) - (count 1 (+ count 1))) + (cl-do ((data (filesets-conditional-sort filesets-data (function car)) + (cdr data)) + (count 1 (+ count 1))) ((null data)) (let* ((this (car data)) (name (filesets-data-get-name this)) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index de2e043a56a..f3e313e9c35 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -207,7 +207,7 @@ ;;; Code: (require 'syntax) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;; Define core `font-lock' group. (defgroup font-lock '((jit-lock custom-group)) @@ -613,9 +613,6 @@ Major/minor modes can set this variable if they know which option applies.") ;; Font Lock mode. (eval-when-compile - ;; - ;; We don't do this at the top-level as we only use non-autoloaded macros. - (require 'cl) ;; ;; Borrowed from lazy-lock.el. ;; We use this to preserve or protect things when modifying text properties. @@ -917,10 +914,10 @@ The value of this variable is used when Font Lock mode is turned on." (declare-function lazy-lock-mode "lazy-lock") (defun font-lock-turn-on-thing-lock () - (case (font-lock-value-in-major-mode font-lock-support-mode) - (fast-lock-mode (fast-lock-mode t)) - (lazy-lock-mode (lazy-lock-mode t)) - (jit-lock-mode + (pcase (font-lock-value-in-major-mode font-lock-support-mode) + (`fast-lock-mode (fast-lock-mode t)) + (`lazy-lock-mode (lazy-lock-mode t)) + (`jit-lock-mode ;; Prepare for jit-lock (remove-hook 'after-change-functions 'font-lock-after-change-function t) @@ -1654,7 +1651,7 @@ LOUDLY, if non-nil, allows progress-meter bar." ;; Fontify each item in `font-lock-keywords' from `start' to `end'. (while keywords (if loudly (message "Fontifying %s... (regexps..%s)" bufname - (make-string (incf count) ?.))) + (make-string (cl-incf count) ?.))) ;; ;; Find an occurrence of `matcher' from `start' to `end'. (setq keyword (car keywords) matcher (car keyword)) diff --git a/lisp/frame.el b/lisp/frame.el index 43704d3f20d..778028390e7 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -25,8 +25,6 @@ ;;; Commentary: ;;; Code: -(eval-when-compile (require 'cl)) - (defvar frame-creation-function-alist (list (cons nil (if (fboundp 'tty-create-frame-with-faces) diff --git a/lisp/fringe.el b/lisp/fringe.el index 70a28bd92f9..329370b5fe5 100644 --- a/lisp/fringe.el +++ b/lisp/fringe.el @@ -43,7 +43,7 @@ ;; Define the built-in fringe bitmaps and setup default mappings (when (boundp 'fringe-bitmaps) - (let ((bitmaps '(question-mark + (let ((bitmaps '(question-mark exclamation-mark left-arrow right-arrow up-arrow down-arrow left-curly-arrow right-curly-arrow left-triangle right-triangle @@ -207,8 +207,8 @@ frame parameter is used." "Set the default appearance of fringes on all frames. When called interactively, query the user for MODE. Valid values -for MODE include `none', `default', `left-only', `right-only', -`minimal' and `half'. +for MODE include `no-fringes', `default', `left-only', `right-only', +`minimal' and `half-width'. When used in a Lisp program, MODE can be a cons cell where the integer in car specifies the left fringe width and the integer in diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 0923ed4db96..83cb55d3594 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,546 @@ +2012-07-25 Julien Danjou + + * gnus-art.el (gnus-kill-sticky-article-buffers): Reintroduce. + +2012-07-25 Katsumi Yamaoka + + * nnimap.el (nnimap-get-responses): Don't remove, still used. + +2012-07-24 Julien Danjou + + * mail-source.el (mail-source-movemail-and-remove): Remove, unused. + + * nntp.el (nntp-send-nosy-authinfo, nntp-send-authinfo-from-file) + (nntp-async-timer-handler): Remove, unused. + + * nnimap.el (nnimap-get-responses): Remove, unused. + + * nnheader.el (mail-header-set-extra): Remove, unused. + + * mm-view.el (mm-view-sound-file): Remove, unused. + + * mm-url.el (mm-url-fetch-simple, mm-url-fetch-form) + (mm-url-encode-multipart-form-data): Remove, unused. + + * message.el (message-remove-signature, message-make-host-name) + (message-fill-address): Remove, unused. + + * gnus.el (gnus-writable-groups, gnus-group-guess-prefixed-name) + (gnus-group-guess-full-name, gnus-group-guess-prefixed-name): Remove, + unused. + + * gnus-uu.el (gnus-uu-find-name-in-shar): Remove, unused. + + * gnus-util.el (gnus-extract-address-component-name) + (gnus-extract-address-component-email, gnus-sortable-date) + (gnus-alist-to-hashtable, gnus-hashtable-to-alist) + (gnus-process-live-p): Remove, unused. + + * gnus-topic.el (gnus-group-parent-topic): Remove, unused. + + * gnus-sum.el (gnus-score-set-default, gnus-article-parent-p) + (gnus-article-read-p, gnus-uncompress-marks): Remove, unused. + (gnus-summary-set-current-mark): Remove obsolete, empty and unused + function. + + * gnus-start.el (gnus-kill-newsgroup): Remove unused obsolete function. + + * gnus-score.el (gnus-summary-score-crossposting) + (gnus-score-regexp-bad-p): Remove, unused. + + * gnus-salt.el (gnus-tree-goto-article): Remove, unused. + + * gnus-range.el (gnus-sublist-p): Remove, unused. + + * gnus-msg.el (gnus-mail-parse-comma-list, gnus-put-message): Remove, + unused. + + * gnus-kill.el (gnus-Newsgroup-kill-file): Remove, unused. + + * gnus-int.el (gnus-list-active-group, gnus-request-group-articles) + (gnus-request-associate-buffer): Remove, unused. + + * gnus-group.el (gnus-group-set-method-info) + (gnus-group-set-params-info): Remove, unused. + + * gnus-fun.el (gnus-shell-command-to-string) + (gnus-shell-command-on-region): Remove, unused. + + * gnus-cite.el (gnus-cited-line-p): Remove, unused. + + * gnus-art.el (gnus-article-text-type-exists-p) + (article-translate-characters, gnus-article-hide-text-of-type) + (gnus-kill-sticky-article-buffers, gnus-article-maybe-highlight): + Remove, unused. + +2012-07-23 Katsumi Yamaoka + + * nnir.el ("nnir"): Revert last change, that's premature to merge from + Gnus master. + +2012-07-22 Andrew Cohen + + * nnir.el ("nnir"): Add 'virtual ability to nnir backend. + +2012-07-21 Julien Danjou + + * message.el (message-dont-reply-to-names): Replace deprecated + `rmail-dont-reply-to-names' with `mail-dont-reply-to-names'. + (message-get-reply-headers): Ditto. + +2012-07-18 Julien Danjou + + * sieve-mode.el (sieve-mode-map): Bind C-c C-c to + `sieve-upload-and-kill'. + + * sieve.el (sieve-bury-buffer): Remove function. + (sieve-manage-mode-map): Map "q" to `kill-buffer'. + (sieve-upload-and-kill): New function, mapped to C-c C-c. + +2012-07-17 Andreas Schwab + + * shr.el (shr-expand-url): Handle URL starting with `//'. + +2012-07-17 Toke Høiland-Jørgensen (tiny change) +2012-07-13 Chong Yidong + + * smime.el (smime-certificate-info): Set buffer-read-only directly, + instead of calling toggle-read-only with a (bogus) argument. + +2012-07-09 Tassilo Horn + + * gnus-sum.el (gnus-summary-limit-to-author): Use default value instead + of initial input when reading the author to restrict the summary to. + +2012-07-09 Lars Magne Ingebrigtsen + + * gnus-sum.el (gnus-select-newsgroup): Don't assume that the group + buffer exists, which it doesn't if we haven't started Gnus. + +2012-07-09 Katsumi Yamaoka + + * mm-decode.el (mm-shr): + Allow overriding charset by mm-charset-override-alist. + +2012-07-03 Katsumi Yamaoka + + * gnus-art.el (gnus-article-view-part): + Toggle subparts of multipart/alternative part. + +2012-07-02 Katsumi Yamaoka + + * gnus-sync.el: Simply require json. + + * registry.el: Simply require eieio and eieio-base. + +2012-06-29 Katsumi Yamaoka + + * tests/gnustest-nntp.el, tests/gnustest-registry.el, tests/: Remove. + +2012-06-27 Stefan Monnier + + * shr.el (shr-render-buffer): New command. + (shr-visit-file): Use it. + +2012-06-27 Katsumi Yamaoka + + * tests/gnustest-nntp.el, tests/gnustest-registry.el: + Set no-byte-compile and no-update-autoloads. + +2012-06-26 Katsumi Yamaoka + + * mm-decode.el: Add coding cookie for a soft hyphen that mm-shr uses. + +2012-06-26 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-read-summary-keys): Protect against the key + being bound to a lambda form. + +2012-06-26 Wolfgang Jenkner + + * gnus-picon.el (gnus-picon-properties): New defcustom. + (gnus-picon-create-glyph): Use it. + +2012-06-26 Lars Magne Ingebrigtsen + + * shr.el: Add a iso-8859-1 cookie to make stuff work under other + locales. + + * mm-decode.el (mm-display-part): Dissect archives when hitting `RET' + on a handle. + + * gnus-sum.el (gnus-summary-limit-to-author): Use the current From + address as the default. + + * nnfolder.el (nnfolder-save-buffer): Delete old versions silently. + It makes no sense to query the user about internal files. + + * gnus-spec.el: Remove all the byte-compilation stuff, since + benchmarking shows that it doesn't help when entering large summary + buffers. + + * gnus-util.el (gnus-byte-code): Remove. + + * gnus-spec.el (gnus-update-format-specifications): Remove outdated + grouplens stuff. + +2012-06-26 Lars Magne Ingebrigtsen + + * gnus-msg.el (gnus-msg-mail): Warn the user about Gnus not running + (bug#11514). + +2012-06-26 Stephen Eglen + + * message.el (message-buffers): Return all buffers derived from Message + to make `gnus-dired-attach' work with mu4e. + +2012-06-26 Daiki Ueno + + * mm-decode.el (mm-inhibit-auto-detect-attachment): New variable. + (mm-dissect-singlepart): Don't guess the MIME type of + application/octet-stream parts if mm-inhibit-auto-detect-attachment is + set. + (mm-dissect-multipart): Bind mm-inhibit-auto-detect-attachment if the + toplevel MIME type is multipart/encrypted. + +2012-06-26 Wolfgang Jenkner + + * gnus-agent.el (gnus-agent-save-active): Deal with the "groups" format. + In particular, add an optional argument and a docstring. + + * gnus-start.el (gnus-groups-to-gnus-format): Use it. + + * nntp.el (nntp-finish-retrieve-group-infos): Make `nntp-server-buffer' + current before calling `gnus-groups-to-gnus-format'. + Note that this was already the case for `gnus-active-to-gnus-format'. + +2012-06-26 Katsumi Yamaoka + + * pop3.el (pop3-wait-for-messages): Fix retrieved data size calculation. + +2012-06-26 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-dissect-buffer): Doc fix. + + * gnus-sum.el (gnus-handle-ephemeral-exit): + Avoid creating the group buffer if it doesn't exist. + + * gnus-group.el (gnus-group-read-ephemeral-group): If no quit-config + is given, mark the group as ephemeral with the current window conf. + + * gnus-sum.el (gnus-set-global-variables): Don't assume that the group + buffer exists, which it doesn't if we haven't started Gnus. + (gnus-summary-exit): Allow quitting when we don't have a group buffer. + +2012-06-26 Lars Magne Ingebrigtsen + + * mml.el (mml-generate-mime): + Allow specifying what the top-level part type is. + + * gnus-sum.el (gnus-auto-center-summary): + `scroll-margin' isn't defined on XEmacs. + +2012-06-26 Philipp Haselwarter (tiny change) + + * gnus-sum.el (gnus-auto-center-summary): + Set default to respect `scroll-margin'. + +2012-06-26 Elias Oltmanns (tiny change) + + * gnus-cite.el (gnus-dissect-cited-text): A single line without + citation prefix within a block of cited text should be considered + part of that block *only* if it is a blank line. + +2012-06-26 Katsumi Yamaoka + + * shr.el (shr-find-fill-point): Remove unused code; don't break a line + before kinsoku-bol characters nor within kinsoku-eol characters. + +2012-06-26 Katsumi Yamaoka + + * gnus-sync.el (gnus-topic-alist, gnus-group-topic) + (gnus-topic-create-topic, gnus-topic-enter-dribble): + Silence compiler. + (gnus-sync-read): Use mapc instead of mapcar. + + * mm-archive.el: Require mm-decode for some macros. + (gnus-recursive-directory-files, mailcap-extension-to-mime): + Silence the byte compiler. + (mm-archive-decoders): New function that returns the value of + the mm-archive-decoders variable. + + * mm-decode.el: + Don't require mm-archive; autoload mm-archive functions instead. + (mm-dissect-singlepart): Use the function mm-archive-decoders. + + * nnmail.el (mail-send-and-exit): Silence the byte compiler. + +2012-06-26 Peter Munster + + * gnus-demon.el (gnus-demon-timers): Now a plist (function -> timer). + (gnus-demon-cancel): Ditto. + (gnus-demon-run-callback): When function cannot be called due to low + idleness, call it when idleness reaches the expected value, instead + of waiting another timer period. + (gnus-demon-init): Add `time' to arguments of call-back. + +2012-06-26 Lars Magne Ingebrigtsen + + * gnus.el: Register gnus-registry functions. + + * gnus-registry.el (gnus-try-warping-via-registry): + Moved here and indent. + + * gnus-int.el (gnus-warp-to-article): + Check whether the registry is enabled before warping. + +2012-06-26 Dave Abrahams + + * gnus-sum.el (gnus-summary-insert-subject): Record information + in the registry about each article retrieved. + + * gnus-int.el (gnus-select-group-with-message-id): New function. + (gnus-try-warping-via-registry): Ditto. + (gnus-warp-to-article): Fall back on the registry. + +2012-06-26 Lars Magne Ingebrigtsen + + * nnimap.el (nnimap-fetch-partial-articles): Minor doc string fixup. + +2012-06-26 Katsumi Yamaoka + + * gnus-msg.el (gnus-summary-resend-message-insert-gcc): Assume that + gnus-gcc-self-resent-messages may be a group parameter. + (gnus-summary-resend-message): + Don't encode encoded words in header when Gcc'ing resent message. + +2012-06-26 Lars Magne Ingebrigtsen + + * shr.el (shr-insert): Treat non-breaking space just like normal + space. This seems to produce more pleasing results. + (shr-insert): + Only insert a blank line if we're starting from an image. + (shr-tag-br): + Allow
to end lines or to make a single blank line. + (shr-ensure-paragraph): Consider lines with white space to be blank. + +2012-06-26 Christopher Schmidt + + * gnus-msg.el (gnus-inews-do-gcc): Add gnus-gcc-pre-body-encode-hook + and gnus-gcc-post-body-encode-hook. + +2012-06-26 Lars Ingebrigtsen + + * mm-decode.el (mm-dissect-singlepart): + Guess what the type of application/octet-stream parts really is. + + * gnus-sum.el (gnus-propagate-marks): Remove. + +2012-06-26 Lars Ingebrigtsen + + * nntp.el (nntp-coding-system-for-read): Remove. + (nntp-coding-system-for-write): Ditto. + (nntp-open-connection): Just use `binary' directly. + +2012-06-26 Teodor Zlatanov + + * registry.el (registry-usage-test, registry-persistence-test): + Move to tests/gnustest-registry.el. + (registry-make-testable-db, registry-match-test) + (registry-instantiation-test): Move to tests/gnustest-registry.el. + + * gnus-registry.el (gnus-registry-misc-test) + (gnus-registry-usage-test): Move to tests/gnustest-registry.el. + + * tests/gnustest-registry.el: + New file with the registry and gnus-registry ERT tests. + +2012-06-26 Katsumi Yamaoka + + * gnus-msg.el (gnus-summary-resend-message): + Make gnus-summary-resend-message-insert-gcc be last item in + message-header-setup-hook. + +2012-06-26 Lars Ingebrigtsen + + * nnfolder.el (nnfolder-marks-directory, nnfolder-marks-is-evil) + (nnfolder-marks, nnfolder-marks-file-suffix) + (nnfolder-marks-modtime): Remove. + (nnfolder-open-server): Don't use marks. + (nnfolder-request-delete-group): Ditto. + (nnfolder-request-rename-group): Ditto. + (nnfolder-request-set-mark, nnfolder-request-marks) + (nnfolder-group-marks-pathname, nnfolder-marks-changed-p) + (nnfolder-save-marks, nnfolder-open-marks): Remove. + + * nnml.el (nnml-marks-is-evil, nnml-marks-file-name, nnml-marks) + (nnml-marks-modtime): Remove. + (nnml-request-delete-group): Don't use marks. + (nnml-request-rename-group): Ditto. + (nnml-request-set-mark, nnml-request-marks, nnml-marks-changed-p) + (nnml-save-marks, nnml-open-marks): Remove. + + * nntp.el (nntp-marks-is-evil, nntp-marks-file-name, nntp-marks) + (nntp-marks-modtime, nntp-marks-directory, nntp-request-set-mark) + (nntp-request-marks, nntp-marks-directory, nntp-marks-changed-p) + (nntp-save-marks, nntp-open-marks, nntp-possibly-create-directory) + (nntp-server-to-method-cache): Remove. + + * shr.el (shr-rescale-image): Fix wrong merge. + +2012-06-26 Lars Ingebrigtsen + + * shr.el (shr-remove-trailing-whitespace): + Really delete the padding on too-wide lines. + +2012-06-26 Lars Ingebrigtsen + + * mm-archive.el (mm-archive-dissect-and-inline): New function. + (mm-archive-dissect-and-inline): Fix up the undisplayer. + + * mm-decode.el (mm-display-external): Output the text from + the command in the buffer after the command finished. + This makes text-based commands behave better. + +2012-06-26 Lars Ingebrigtsen + + * message.el (smtpmail-smtp-user): Silence compiler warning. + +2012-06-26 Lars Ingebrigtsen + + * message.el (message-multi-smtp-send-mail): Also allow specifying + the SMTP user name. + +2012-06-26 Katsumi Yamaoka + + * gnus-sum.el (gnus-summary-article-map): Fix typo. + +2012-06-26 Lars Ingebrigtsen + + * message.el (message-multi-smtp-send-mail): New function. + (message-multi-smtp-send-mail): Respect the X-Message-SMTP-Method + header to implement multi-SMTP functionality. + + * gnus-agent.el (gnus-agent-send-mail-function): Removed. + (gnus-agentize): Don't set it. + (gnus-agent-send-mail): Don't use it. + + * gnus-sum.el (gnus-summary-widget-backward): + New function and keystroke. + + * shr.el (shr-put-image): Remove underlines from sliced images. + (shr-zoom-image): Compute the region to be replaced more correctly. + +2012-06-26 Katsumi Yamaoka + + * gnus-msg.el (gnus-gcc-self-resent-messages): New user option. + (gnus-summary-resend-message-insert-gcc): New function. + (gnus-summary-resend-message): Modify message-header-setup-hook and + message-sent-hook to make it work for Gcc. + (gnus-inews-do-gcc): Update the number of unread articles of groups + that messages are Gcc'd to. + + * message.el (message-resend): Run message-sent-hook to do Gcc. + +2012-06-26 Lars Ingebrigtsen + + * gnus-registry.el (gnus-registry-fixup-registry): + Move the message to a higher level to silence compilation. + + * gnus-art.el (gnus-shr-put-image): Take and pass on a `flags' + parameter to allow controlling the scaling. + + * shr.el (shr-zoom-image): New command and keystroke. + (shr-put-image): Take a `size' flag to say how to scale the image. + + * mm-archive.el (mm-dissect-archive): Use it to get all file names. + Use recursive deletion. + (mm-dissect-archive): Add support for zip files. + + * gnus-util.el (gnus-recursive-directory-files): New function. + + * mm-archive.el (mm-archive-list-files): Inline text and image parts. + (mm-archive-decoders): Add tgz support. + + * mm-decode.el (mm-shr): Make sure that the HTML ends with a newline. + Otherwise inserting text into the Gnus buffer can look odd. + + * gnus-art.el (gnus-mime-inline-part): Slight clean-up. + + * mm-archive.el (mm-archive-decoders): Add support for tar. + + * gnus.el (gnus-logo-color-alist): Change the colours for Ma Gnus. + + * nnmail.el (nnmail-extra-headers): Add Cc to the default. + +2012-06-26 Lars Ingebrigtsen + + * mm-decode.el (mm-dissect-singlepart): Check that the decoder exists. + + * mm-archive.el: New file. + + * mm-decode.el (mm-dissect-singlepart): + Use it to decode ms-tnef files. + + * mm-util.el (mm-find-buffer-file-coding-system): Comment fix. + + * message.el (message-goto-*): Make all the `message-goto-*' commands + push the mark before moving point. This makes it easier to go back + to where you came from after editing whatever you jumped to. + +2012-06-26 Teodor Zlatanov + + * gnus-sync.el (gnus-sync-newsrc-groups): Quote normally. + (gnus-sync-lesync-pre-save-group-entry): Remove invalid invlists. + (gnus-sync-lesync-normalize-group-entry): Ignore a few more keys. + +2012-06-26 Teodor Zlatanov + + * spam.el: Move BBDB autoloads. + (spam-exists-in-BBDB-p): + New function to do the BBDB search directly in BBDB 2 and 3. + (spam-check-BBDB): Use it. + (spam-enter-ham-BBDB): Use it. + +2012-06-26 Peter Munster (tiny change) + + * gnus-group.el (gnus-group-get-new-news): + New parameter `one-level' for scanning exactly one level. + + * gnus-start.el (gnus-get-unread-articles): Ditto. + +2012-06-26 Teodor Zlatanov + + * gnus-sync.el: More commentary about setup. + +2012-06-26 Teodor Zlatanov + + * gnus-sync.el: More commentary about `gnus-sync-read' issues. + +2012-06-26 Teodor Zlatanov + + * gnus-sync.el: Improve docs about CouchDB admins. + +2012-06-26 Teodor Zlatanov + + * gnus-sync.el (gnus-sync-lesync-setup): Fix salt when user setup is + not needed. Provide xmlplistread list function to produce XML plist + output for non-Gnus LeSync clients. + +2012-06-26 Teodor Zlatanov + + * gnus-sync.el: Add LeSync synchronization backend and logic to read + and save against it. Group subscriptions, read marks, other marks, + subscription levels, topic names, and topic offsets (the group's + position within the topic) are saved. This is an experimental + backend and may change significantly. Load json.el from + the gnus-fallback-lib if it's not available otherwise. + (gnus-sync-save): Don't use `apply-partially' because of XEmacs. + +2012-06-26 David Engster + + * tests/gnustest-nntp.el: New file for simple NNTP testing. + 2012-06-18 Nelson Ferreira (tiny change) * gnus-win.el (gnus-configure-frame): Pass an arg to window-dedicated-p. @@ -4292,7 +4835,7 @@ 2010-11-29 Binjo (tiny change) * nnimap.el (nnimap-open-connection-1): w32 open-network-stream doesn't - seem to accept strings-with-numbers as port numbers, + seem to accept strings-with-numbers as port numbers. 2010-11-29 Andrew Cohen @@ -4491,7 +5034,7 @@ 2010-11-25 Julien Danjou - * shr-color.el (shr-color->hexadecimal): Use color-rgb->hex + * shr-color.el (shr-color->hexadecimal): Use color-rgb->hex. * color.el: Rename from color-lab.el (color-rgb->hex): Add. @@ -20553,8 +21096,8 @@ 2004-05-20 Danny Siu - * gnus-sum.el (gnus-summary-recenter): Summery buffer was not auto - centered even when gnus-auto-center-summary is t + * gnus-sum.el (gnus-summary-recenter): Summary buffer was not auto + centered even when gnus-auto-center-summary is t. 2004-05-22 Lars Magne Ingebrigtsen @@ -21776,7 +22319,7 @@ * gnus.el (gnus-method-to-server): Move defsubst before first use. - * gnus-diary.el (gnus-diary-header-schedule): caddr -> car (cddr + * gnus-diary.el (gnus-diary-header-schedule): caddr -> car (cddr. * gnus-art.el (gnus-article-edit-mode): Define before first reference. @@ -22008,7 +22551,7 @@ * gnus-sum.el (gnus-select-newgroup): Replace inline code with gnus-agent-possibly-alter-active. - (gnus-adjust-marked-articles): Faster handling of simple lists + (gnus-adjust-marked-articles): Faster handling of simple lists. 2004-01-21 Jesper Harder diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 0d469b174bf..525008c351f 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -242,7 +242,6 @@ NOTES: (defvar gnus-category-group-cache nil) (defvar gnus-agent-spam-hashtb nil) (defvar gnus-agent-file-name nil) -(defvar gnus-agent-send-mail-function nil) (defvar gnus-agent-file-coding-system 'raw-text) (defvar gnus-agent-file-loading-cache nil) (defvar gnus-agent-total-fetched-hashtb nil) @@ -683,11 +682,7 @@ This will modify the `gnus-setup-news-hook', and minor mode in all Gnus buffers." (interactive) (gnus-open-agent) - (unless gnus-agent-send-mail-function - (setq gnus-agent-send-mail-function - (or message-send-mail-real-function - (function (lambda () (funcall message-send-mail-function)))) - message-send-mail-real-function 'gnus-agent-send-mail)) + (setq message-send-mail-real-function 'gnus-agent-send-mail) ;; If the servers file doesn't exist, auto-agentize some servers and ;; save the servers file so this auto-agentizing isn't invoked @@ -723,7 +718,7 @@ Optional arg GROUP-NAME allows to specify another group." (defun gnus-agent-send-mail () (if (or (not gnus-agent-queue-mail) (and gnus-plugged (not (eq gnus-agent-queue-mail 'always)))) - (funcall gnus-agent-send-mail-function) + (message-multi-smtp-send-mail) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n")) @@ -1304,12 +1299,18 @@ This can be added to `gnus-select-article-hook' or (gnus-group-update-group group t))) nil)) -(defun gnus-agent-save-active (method) +(defun gnus-agent-save-active (method &optional groups-p) + "Sync the agent's active file with the current buffer. +Pass non-nil for GROUPS-P if the buffer starts out in groups format. +Regardless, both the file and the buffer end up in active format +if METHOD is agentized; otherwise the function is a no-op." (when (gnus-agent-method-p method) (let* ((gnus-command-method method) (new (gnus-make-hashtable (count-lines (point-min) (point-max)))) (file (gnus-agent-lib-file "active"))) - (gnus-active-to-gnus-format nil new) + (if groups-p + (gnus-groups-to-gnus-format nil new) + (gnus-active-to-gnus-format nil new)) (gnus-agent-write-active file new) (erase-buffer) (let ((nnheader-file-coding-system gnus-agent-file-coding-system)) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index b04615dc5a9..bb374fba11b 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -1794,14 +1794,6 @@ Initialized from `text-mode-syntax-table.") (put-text-property (max (1- b) (point-min)) b 'intangible nil))) -(defun gnus-article-hide-text-of-type (type) - "Hide text of TYPE in the current buffer." - (save-excursion - (let ((b (point-min)) - (e (point-max))) - (while (setq b (text-property-any b e 'article-type type)) - (add-text-properties b (incf b) gnus-hidden-properties))))) - (defun gnus-article-delete-text-of-type (type) "Delete text of TYPE in the current buffer." (save-excursion @@ -1834,10 +1826,6 @@ Initialized from `text-mode-syntax-table.") b (or (text-property-not-all b (point-max) 'invisible t) (point-max))))))) -(defun gnus-article-text-type-exists-p (type) - "Say whether any text of type TYPE exists in the buffer." - (text-property-any (point-min) (point-max) 'article-type type)) - (defsubst gnus-article-header-rank () "Give the rank of the string HEADER as given by `gnus-sorted-header-list'." (let ((list gnus-sorted-header-list) @@ -2146,23 +2134,6 @@ try this wash." props) (insert replace))))))))) -(defun article-translate-characters (from to) - "Translate all characters in the body of the article according to FROM and TO. -FROM is a string of characters to translate from; to is a string of -characters to translate to." - (save-excursion - (when (article-goto-body) - (let ((inhibit-read-only t) - (x (make-string 225 ?x)) - (i -1)) - (while (< (incf i) (length x)) - (aset x i i)) - (setq i 0) - (while (< i (length from)) - (aset x (aref from i) (aref to i)) - (incf i)) - (translate-region (point) (point-max) x))))) - (defun article-translate-strings (map) "Translate all string in the body of the article according to MAP. MAP is an alist where the elements are on the form (\"from\" \"to\")." @@ -2231,7 +2202,8 @@ unfolded." (unfoldable (or (equal gnus-article-unfold-long-headers t) (and (stringp gnus-article-unfold-long-headers) - (string-match gnus-article-unfold-long-headers header))))) + (string-match gnus-article-unfold-long-headers + header))))) (with-temp-buffer (insert header) (goto-char (point-min)) @@ -4810,10 +4782,10 @@ If a prefix ARG is given, ask for confirmation." (dolist (buf (gnus-buffers)) (with-current-buffer buf (when (eq major-mode 'gnus-sticky-article-mode) - (if (not arg) - (gnus-kill-buffer buf) - (when (yes-or-no-p (concat "Kill buffer " (buffer-name buf) "? ")) - (gnus-kill-buffer buf))))))) + (if (not arg) + (gnus-kill-buffer buf) + (when (yes-or-no-p (concat "Kill buffer " (buffer-name buf) "? ")) + (gnus-kill-buffer buf))))))) ;;; ;;; Gnus MIME viewing functions @@ -5329,9 +5301,8 @@ Compressed files like .gz and .bz2 are decompressed." (or (cdr (assq arg gnus-summary-show-article-charset-alist)) (mm-read-coding-system "Charset: ")))) - (t - (if (mm-handle-undisplayer handle) - (mm-remove-part handle)))) + ((mm-handle-undisplayer handle) + (mm-remove-part handle))) (forward-line 2) (mm-display-inline handle) (goto-char b))))) @@ -5621,7 +5592,9 @@ all parts." (let ((handle (cdr (assq n gnus-article-mime-handle-alist)))) (when (gnus-article-goto-part n) (if (equal (car handle) "multipart/alternative") - (gnus-article-press-button) + (progn + (beginning-of-line) ;; Make it toggle subparts + (gnus-article-press-button)) (when (eq (gnus-mm-display-part handle) 'internal) (gnus-set-window-start))))))) @@ -6200,12 +6173,13 @@ Provided for backwards compatibility." (not gnus-inhibit-hiding)) (gnus-article-hide-headers))) -(declare-function shr-put-image "shr" (data alt)) +(declare-function shr-put-image "shr" (data alt &optional flags)) -(defun gnus-shr-put-image (data alt) +(defun gnus-shr-put-image (data alt &optional flags) "Put image DATA with a string ALT. Enable image to be deleted." (let ((image (shr-put-image data (propertize (or alt "*") - 'gnus-image-category 'shr)))) + 'gnus-image-category 'shr) + flags))) (when image (gnus-add-image 'shr image)))) @@ -6524,7 +6498,8 @@ not have a face in `gnus-article-boring-faces'." (ding) (unless (member keys nosave-in-article) (set-buffer gnus-article-current-summary)) - (when (get func 'disabled) + (when (and (symbolp func) + (get func 'disabled)) (error "Function %s disabled" func)) (call-interactively func) (setq new-sum-point (point))) @@ -6766,11 +6741,6 @@ If given a prefix, show the hidden text instead." (gnus-article-hide-citation-maybe arg force) (gnus-article-hide-signature arg)) -(defun gnus-article-maybe-highlight () - "Do some article highlighting if article highlighting is requested." - (when (gnus-visual-p 'article-highlight 'highlight) - (gnus-article-highlight-some))) - (defun gnus-check-group-server () ;; Make sure the connection to the server is alive. (unless (gnus-server-opened diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index c7443446ceb..d107dfad32e 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -509,6 +509,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps (if (and (equal (cdadr m) "") (equal (cdar m) (cdaddr m)) (goto-char (caadr m)) + (looking-at "[ \t]*$") (forward-line 1) (= (point) (caaddr m))) (setcdr m (cdddr m)) @@ -1163,18 +1164,6 @@ See also the documentation for `gnus-article-highlight-citation'." (while vars (make-local-variable (pop vars))))) -(defun gnus-cited-line-p () - "Say whether the current line is a cited line." - (save-excursion - (beginning-of-line) - (let ((found nil)) - (dolist (prefix (mapcar 'car gnus-cite-prefix-alist)) - (when (string= (buffer-substring (point) (+ (length prefix) (point))) - prefix) - (setq found t))) - found))) - - ;; Highlighting of different citation levels in message-mode. ;; - message-cite-prefix will be overridden if this is enabled. diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el index 2a4fa6f483e..115c5777448 100644 --- a/lisp/gnus/gnus-demon.el +++ b/lisp/gnus/gnus-demon.el @@ -71,7 +71,7 @@ Emacs has been idle for IDLE `gnus-demon-timestep's." ;;; Internal variables. (defvar gnus-demon-timers nil - "List of idle timers which are running.") + "Plist of idle timers which are running.") (defvar gnus-inhibit-demon nil "If non-nil, no daemonic function will be run.") @@ -98,15 +98,32 @@ Emacs has been idle for IDLE `gnus-demon-timestep's." (float-time (or (current-idle-time) '(0 0 0))))) -(defun gnus-demon-run-callback (func &optional idle) - "Run FUNC if Emacs has been idle for longer than IDLE seconds." +(defun gnus-demon-run-callback (func &optional idle time special) + "Run FUNC if Emacs has been idle for longer than IDLE seconds. +If not, and a TIME is given, restart a new idle timer, so FUNC +can be called at the next opportunity. Such a special idle run is +marked with SPECIAL." (unless gnus-inhibit-demon - (when (or (not idle) - (and (eq idle t) (> (gnus-demon-idle-since) 0)) - (<= idle (gnus-demon-idle-since))) + (block run-callback + (when (eq idle t) + (setq idle 0.001)) + (cond (special + (setq gnus-demon-timers + (plist-put gnus-demon-timers func + (run-with-timer time time 'gnus-demon-run-callback + func idle time)))) + ((and idle (> idle (gnus-demon-idle-since))) + (when time + (nnheader-cancel-timer (plist-get gnus-demon-timers func)) + (setq gnus-demon-timers + (plist-put gnus-demon-timers func + (run-with-idle-timer idle nil + 'gnus-demon-run-callback + func idle time t)))) + (return-from run-callback))) (with-local-quit - (ignore-errors - (funcall func)))))) + (ignore-errors + (funcall func)))))) (defun gnus-demon-init () "Initialize the Gnus daemon." @@ -140,12 +157,14 @@ Emacs has been idle for IDLE `gnus-demon-timestep's." ;; (func number any) ;; Call every `time' ((integerp time) - (run-with-timer time time 'gnus-demon-run-callback func idle)) + (run-with-timer time time 'gnus-demon-run-callback + func idle time)) ;; (func string any) ((stringp time) - (run-with-timer time (* 24 60 60) 'gnus-demon-run-callback func idle))))) + (run-with-timer time (* 24 60 60) 'gnus-demon-run-callback + func idle))))) (when timer - (add-to-list 'gnus-demon-timers timer))))) + (setq gnus-demon-timers (plist-put gnus-demon-timers func timer)))))) (defun gnus-demon-time-to-step (time) "Find out how many steps to TIME, which is on the form \"17:43\"." @@ -184,8 +203,8 @@ Emacs has been idle for IDLE `gnus-demon-timestep's." (defun gnus-demon-cancel () "Cancel any Gnus daemons." (interactive) - (dolist (timer gnus-demon-timers) - (nnheader-cancel-timer timer)) + (dotimes (i (/ (length gnus-demon-timers) 2)) + (nnheader-cancel-timer (nth (1+ (* i 2)) gnus-demon-timers))) (setq gnus-demon-timers nil)) (defun gnus-demon-add-disconnection () diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index 1cd5ce5bb1e..f33eb910c6a 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -85,13 +85,6 @@ PNG format." (call-process shell-file-name nil (list standard-output nil) nil shell-command-switch command))) -(defun gnus-shell-command-on-region (start end command) - "A simplified `shell-command-on-region'. -Output to the current buffer, replace text, and don't mingle error." - (call-process-region start end shell-file-name t - (list (current-buffer) nil) - nil shell-command-switch command)) - ;;;###autoload (defun gnus-random-x-face () "Return X-Face header data chosen randomly from `gnus-x-face-directory'." diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index ff41f13de30..2f6fc0ccd19 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -56,7 +56,7 @@ (autoload 'gnus-group-make-nnir-group "nnir") -(defcustom gnus-no-groups-message "No Gnus is good news" +(defcustom gnus-no-groups-message "No news is good news" "*Message displayed by Gnus when no groups are available." :group 'gnus-start :type 'string) @@ -2290,9 +2290,12 @@ Return the name of the group if selection was successful." ;; (gnus-read-group "Group name: ") (gnus-group-completing-read) (gnus-read-method "From method"))) - ;; Transform the select method into a unique server. (unless (gnus-alive-p) - (gnus-no-server)) + (nnheader-init-server-buffer) + ;; Necessary because of funky inlining. + (require 'gnus-cache) + (setq gnus-newsrc-hashtb (gnus-make-hashtable))) + ;; Transform the select method into a unique server. (when (stringp method) (setq method (gnus-server-to-method method))) (let ((address-slot @@ -2312,18 +2315,22 @@ Return the name of the group if selection was successful." `(-1 nil (,group ,gnus-level-default-subscribed nil nil ,method ,(cons - (cond - (quit-config - (cons 'quit-config quit-config)) - ((assq gnus-current-window-configuration - gnus-buffer-configuration) - (cons 'quit-config + (cons 'quit-config + (cond + (quit-config + quit-config) + ((assq gnus-current-window-configuration + gnus-buffer-configuration) (cons gnus-summary-buffer - gnus-current-window-configuration)))) + gnus-current-window-configuration)) + (t + (cons (current-buffer) + (current-window-configuration))))) parameters))) gnus-newsrc-hashtb) (push method gnus-ephemeral-servers) - (set-buffer gnus-group-buffer) + (when (gnus-buffer-live-p gnus-group-buffer) + (set-buffer gnus-group-buffer)) (unless (gnus-check-server method) (error "Unable to contact server: %s" (gnus-status-message method))) (when activate @@ -4014,11 +4021,13 @@ entail asking the server for the groups." (gnus-activate-foreign-newsgroups level)) (gnus-group-get-new-news))) -(defun gnus-group-get-new-news (&optional arg) +(defun gnus-group-get-new-news (&optional arg one-level) "Get newly arrived articles. If ARG is a number, it specifies which levels you are interested in re-scanning. If ARG is non-nil and not a number, this will force -\"hard\" re-reading of the active files from all servers." +\"hard\" re-reading of the active files from all servers. +If ONE-LEVEL is not nil, then re-scan only the specified level, +otherwise all levels below ARG will be scanned too." (interactive "P") (require 'nnmail) (let ((gnus-inhibit-demon t) @@ -4032,7 +4041,8 @@ re-scanning. If ARG is non-nil and not a number, this will force (unless gnus-slave (gnus-master-read-slave-newsrc)) - (gnus-get-unread-articles (gnus-group-default-level arg t)) + (gnus-get-unread-articles (gnus-group-default-level arg t) + nil one-level) ;; If the user wants it, we scan for new groups. (when (eq gnus-check-new-newsgroups 'always) @@ -4440,12 +4450,6 @@ and the second element is the address." (gnus-list-of-unread-articles (car info)))))) (error "No such group: %s" (gnus-info-group info)))))) -(defun gnus-group-set-method-info (group select-method) - (gnus-group-set-info select-method group 'method)) - -(defun gnus-group-set-params-info (group params) - (gnus-group-set-info params group 'params)) - ;; Ad-hoc function for inserting data from a different newsrc.eld ;; file. Use with caution, if at all. (defun gnus-import-other-newsrc-file (file) diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index 52a8520a252..339e3d951c2 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -416,14 +416,6 @@ If it is down, start it up (again)." dont-check info))) -(defun gnus-list-active-group (group) - "Request active information on GROUP." - (let ((gnus-command-method (gnus-find-method-for-group group)) - (func 'list-active-group)) - (when (gnus-check-backend-function func group) - (funcall (gnus-get-function gnus-command-method func) - (gnus-group-real-name group) (nth 1 gnus-command-method))))) - (defun gnus-request-group-description (group) "Request a description of GROUP." (let ((gnus-command-method (gnus-find-method-for-group group)) @@ -432,14 +424,6 @@ If it is down, start it up (again)." (funcall (gnus-get-function gnus-command-method func) (gnus-group-real-name group) (nth 1 gnus-command-method))))) -(defun gnus-request-group-articles (group) - "Request a list of existing articles in GROUP." - (let ((gnus-command-method (gnus-find-method-for-group group)) - (func 'request-group-articles)) - (when (gnus-check-backend-function func group) - (funcall (gnus-get-function gnus-command-method func) - (gnus-group-real-name group) (nth 1 gnus-command-method))))) - (defun gnus-close-group (group) "Request the GROUP be closed." (let ((gnus-command-method (inline (gnus-find-method-for-group group)))) @@ -533,16 +517,69 @@ If BUFFER, insert the article in that group." header (gnus-group-real-name group)))) +(defun gnus-select-group-with-message-id (group message-id) + "Activate and select GROUP with the given MESSAGE-ID selected. +Returns the article number of the message. + +If GROUP is not already selected, the message will be the only one in +the group's summary. +" + ;; TODO: is there a way to know at this point whether the group will + ;; be newly-selected? If so we could clean up the logic at the end + ;; + ;; save the new group's display parameter, if any, so we + ;; can replace it temporarily with zero. + (let ((saved-display + (gnus-group-get-parameter group 'display :allow-list))) + + ;; Tell gnus we really don't want any articles + (gnus-group-set-parameter group 'display 0) + + (unwind-protect + (gnus-summary-read-group-1 + group (not :show-all) :no-article (not :kill-buffer) + ;; The combination of no-display and this dummy list of + ;; articles to select somehow makes it possible to open a + ;; group with no articles in it. Black magic. + :no-display '(-1); select-articles + ) + ;; Restore the new group's display parameter + (gnus-group-set-parameter group 'display saved-display))) + + ;; The summary buffer was suppressed by :no-display above. + ;; Create it now and insert the message + (let ((group-is-new (gnus-summary-setup-buffer group))) + (condition-case err + (let ((article-number + (gnus-summary-insert-subject message-id))) + (unless article-number + (signal 'error "message-id not in group")) + (gnus-summary-select-article nil nil nil article-number) + article-number) + ;; Clean up the new summary and propagate the error + (error (when group-is-new (gnus-summary-exit)) + (apply 'signal err))))) + +(defun gnus-simplify-group-name (group) + "Return the simplest representation of the name of GROUP. +This is the string that Gnus uses to identify the group." + (gnus-group-prefixed-name + (gnus-group-real-name group) + (gnus-group-method group))) + (defun gnus-warp-to-article () "Warps from an article in a virtual group to the article in its real group. Does nothing on a real group." (interactive) (when (gnus-virtual-group-p gnus-newsgroup-name) (let ((gnus-command-method - (gnus-find-method-for-group gnus-newsgroup-name))) - (when (gnus-check-backend-function - 'warp-to-article (car gnus-command-method)) - (funcall (gnus-get-function gnus-command-method 'warp-to-article)))))) + (gnus-find-method-for-group gnus-newsgroup-name))) + (or + (when (gnus-check-backend-function + 'warp-to-article (car gnus-command-method)) + (funcall (gnus-get-function gnus-command-method 'warp-to-article))) + (and (bound-and-true-p gnus-registry-enabled) + (gnus-try-warping-via-registry)))))) (defun gnus-request-head (article group) "Request the head of ARTICLE in GROUP." @@ -745,11 +782,6 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." (gnus-agent-regenerate-group group (list article))) result)) -(defun gnus-request-associate-buffer (group) - (let ((gnus-command-method (gnus-find-method-for-group group))) - (funcall (gnus-get-function gnus-command-method 'request-associate-buffer) - (gnus-group-real-name group)))) - (defun gnus-request-restore-buffer (article group) "Request a new buffer restored to the state of ARTICLE." (let ((gnus-command-method (gnus-find-method-for-group group))) diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el index e70b9b8e73a..c1e5bcb7d01 100644 --- a/lisp/gnus/gnus-kill.el +++ b/lisp/gnus/gnus-kill.el @@ -328,24 +328,6 @@ If NEWSGROUP is nil, the global kill file is selected." ;; For kill files -(defun gnus-Newsgroup-kill-file (newsgroup) - "Return the name of a kill file for NEWSGROUP. -If NEWSGROUP is nil, return the global kill file instead." - (cond ((or (null newsgroup) - (string-equal newsgroup "")) - ;; The global kill file is placed at top of the directory. - (expand-file-name gnus-kill-file-name gnus-kill-files-directory)) - (gnus-use-long-file-name - ;; Append ".KILL" to capitalized newsgroup name. - (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup) - "." gnus-kill-file-name) - gnus-kill-files-directory)) - (t - ;; Place "KILL" under the hierarchical directory. - (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) - "/" gnus-kill-file-name) - gnus-kill-files-directory)))) - (defun gnus-expunge (marks) "Remove lines marked with MARKS." (with-current-buffer gnus-summary-buffer diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index a041a85d444..bcd2cd438e9 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -163,6 +163,22 @@ if nil, attach files as normal parts." (const all :tag "Any") (string :tag "Regexp"))) +(defcustom gnus-gcc-self-resent-messages 'no-gcc-self + "Like `gcc-self' group parameter, only for unmodified resent messages. +Applied to messages sent by `gnus-summary-resend-message'. Non-nil +value of this variable takes precedence over any existing Gcc header. + +If this is `none', no Gcc copy will be made. If this is t, messages +resent will be Gcc'd to the current group. If this is a string, it +specifies a group to which resent messages will be Gcc'd. If this is +nil, Gcc will be done according to existing Gcc header(s), if any. +If this is `no-gcc-self', resent messages will be Gcc'd to groups that +existing Gcc header specifies, except for the current group." + :version "24.2" + :group 'gnus-message + :type '(choice (const none) (const t) string (const nil) + (const no-gcc-self))) + (gnus-define-group-parameter posting-charset-alist :type list @@ -297,6 +313,22 @@ If nil, the address field will always be empty after invoking :group 'gnus-message :type 'boolean) +(defcustom gnus-gcc-pre-body-encode-hook nil + "A hook called before encoding the body of the Gcc copy of a message. +The current buffer (when the hook is run) contains the message +including the message header. Changes made to the message will +only affect the Gcc copy, but not the original message." + :group 'gnus-message + :type 'hook) + +(defcustom gnus-gcc-post-body-encode-hook nil + "A hook called after encoding the body of the Gcc copy of a message. +The current buffer (when the hook is run) contains the message +including the message header. Changes made to the message will +only affect the Gcc copy, but not the original message." + :group 'gnus-message + :type 'hook) + (autoload 'gnus-message-citation-mode "gnus-cite" nil t) ;;; Internal variables. @@ -1285,6 +1317,44 @@ For the \"inline\" alternatives, also see the variable (set-buffer gnus-original-article-buffer) (message-forward post))))))) +(defun gnus-summary-resend-message-insert-gcc () + "Insert Gcc header according to `gnus-gcc-self-resent-messages'." + (gnus-inews-insert-gcc) + (let ((gcc (mapcar + (lambda (group) + (mm-encode-coding-string + group + (gnus-group-name-charset (gnus-inews-group-method group) + group))) + (message-unquote-tokens + (message-tokenize-header (mail-fetch-field "gcc" nil t) + " ,")))) + (self (with-current-buffer gnus-summary-buffer + gnus-gcc-self-resent-messages))) + (message-remove-header "gcc") + (when gcc + (goto-char (point-max)) + (cond ((eq self 'none)) + ((eq self t) + (insert "Gcc: \"" gnus-newsgroup-name "\"\n")) + ((stringp self) + (insert "Gcc: " + (mm-encode-coding-string + (if (string-match " " self) + (concat "\"" self "\"") + self) + (gnus-group-name-charset (gnus-inews-group-method self) + self)) + "\n")) + ((null self) + (insert "Gcc: " (mapconcat 'identity gcc ", ") "\n")) + ((eq self 'no-gcc-self) + (when (setq gcc (delete + gnus-newsgroup-name + (delete (concat "\"" gnus-newsgroup-name "\"") + gcc))) + (insert "Gcc: " (mapconcat 'identity gcc ", ") "\n"))))))) + (defun gnus-summary-resend-message (address n) "Resend the current article to ADDRESS." (interactive @@ -1298,12 +1368,24 @@ For the \"inline\" alternatives, also see the variable (with-current-buffer gnus-original-article-buffer (nnmail-fetch-field "to")))) current-prefix-arg)) - (dolist (article (gnus-summary-work-articles n)) - (gnus-summary-select-article nil nil nil article) - (with-current-buffer gnus-original-article-buffer - (let ((gnus-gcc-externalize-attachments nil)) - (message-resend address))) - (gnus-summary-mark-article-as-forwarded article))) + (let ((message-header-setup-hook (copy-sequence message-header-setup-hook)) + (message-sent-hook (copy-sequence message-sent-hook))) + ;; `gnus-summary-resend-message-insert-gcc' must run last. + (add-hook 'message-header-setup-hook + 'gnus-summary-resend-message-insert-gcc t) + (add-hook 'message-sent-hook + `(lambda () + (let ((rfc2047-encode-encoded-words nil)) + ,(if gnus-agent + '(gnus-agent-possibly-do-gcc) + '(gnus-inews-do-gcc))))) + (dolist (article (gnus-summary-work-articles n)) + (gnus-summary-select-article nil nil nil article) + (with-current-buffer gnus-original-article-buffer + (let ((gnus-gcc-externalize-attachments nil) + (message-inhibit-body-encoding t)) + (message-resend address))) + (gnus-summary-mark-article-as-forwarded article)))) ;; From: Matthieu Moy (defun gnus-summary-resend-message-edit () @@ -1375,33 +1457,6 @@ See `gnus-summary-mail-forward' for ARG." (when (gnus-y-or-n-p "Send this complaint? ") (message-send-and-exit)))))) -(defun gnus-mail-parse-comma-list () - (let (accumulated - beg) - (skip-chars-forward " ") - (while (not (eobp)) - (setq beg (point)) - (skip-chars-forward "^,") - (while (zerop - (save-excursion - (save-restriction - (let ((i 0)) - (narrow-to-region beg (point)) - (goto-char beg) - (logand (progn - (while (search-forward "\"" nil t) - (incf i)) - (if (zerop i) 2 i)) - 2))))) - (skip-chars-forward ",") - (skip-chars-forward "^,")) - (skip-chars-backward " ") - (push (buffer-substring beg (point)) - accumulated) - (skip-chars-forward "^,") - (skip-chars-forward ", ")) - accumulated)) - (defun gnus-inews-add-to-address (group) (let ((to-address (mail-fetch-field "to"))) (when (and to-address @@ -1412,41 +1467,6 @@ See `gnus-summary-mail-forward' for ARG." (format "Do you want to add this as `to-list': %s? " to-address)) (gnus-group-add-parameter group (cons 'to-list to-address)))))) -(defun gnus-put-message () - "Put the current message in some group and return to Gnus." - (interactive) - (let ((reply gnus-article-reply) - (winconf gnus-prev-winconf) - (group gnus-newsgroup-name)) - (unless (and group - (not (gnus-group-read-only-p group))) - (setq group (read-string "Put in group: " nil (gnus-writable-groups)))) - - (when (gnus-group-entry group) - (error "No such group: %s" group)) - (save-excursion - (save-restriction - (widen) - (message-narrow-to-headers) - (let ((gnus-deletable-headers nil)) - (message-generate-headers - (if (message-news-p) - message-required-news-headers - message-required-mail-headers))) - (goto-char (point-max)) - (if (string-match " " group) - (insert "Gcc: \"" group "\"\n") - (insert "Gcc: " group "\n")) - (widen))) - (gnus-inews-do-gcc) - (when (and (get-buffer gnus-group-buffer) - (gnus-buffer-exists-p (car-safe reply)) - (cdr reply)) - (set-buffer (car reply)) - (gnus-summary-mark-article-as-replied (cdr reply))) - (when winconf - (set-window-configuration winconf)))) - (defun gnus-article-mail (yank) "Send a reply to the address near point. If YANK is non-nil, include the original article." @@ -1595,7 +1615,9 @@ this is a reply." (nnheader-set-temp-buffer " *acc*") (setq message-options (with-current-buffer cur message-options)) (insert-buffer-substring cur) + (run-hooks 'gnus-gcc-pre-body-encode-hook) (message-encode-message-body) + (run-hooks 'gnus-gcc-post-body-encode-hook) (save-restriction (message-narrow-to-headers) (let* ((mail-parse-charset message-default-charset) @@ -1644,12 +1666,16 @@ this is a reply." (when (and group-art ;; FIXME: Should gcc-mark-as-read work when ;; Gnus is not running? - (gnus-alive-p) - (or gnus-gcc-mark-as-read - (and - (boundp 'gnus-inews-mark-gcc-as-read) - (symbol-value 'gnus-inews-mark-gcc-as-read)))) - (gnus-group-mark-article-read group (cdr group-art))) + (gnus-alive-p)) + (if (or gnus-gcc-mark-as-read + (and (boundp 'gnus-inews-mark-gcc-as-read) + (symbol-value 'gnus-inews-mark-gcc-as-read))) + (gnus-group-mark-article-read group (cdr group-art)) + (with-current-buffer gnus-group-buffer + (let ((gnus-group-marked (list group)) + (gnus-get-new-news-hook nil) + (inhibit-read-only t)) + (gnus-group-get-new-news-this-group nil t))))) (setq options message-options) (with-current-buffer cur (setq message-options options)) (kill-buffer (current-buffer))))))))) diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el index 2f347efe579..3b335b335dd 100644 --- a/lisp/gnus/gnus-picon.el +++ b/lisp/gnus/gnus-picon.el @@ -75,6 +75,12 @@ Some people may want to add \"unknown\" to this list." :type '(repeat string) :group 'gnus-picon) +(defcustom gnus-picon-properties '(:color-symbols (("None" . "white"))) + "List of image properties applied to picons." + :type 'list + :version "24.2" + :group 'gnus-picon) + (defcustom gnus-picon-style 'inline "How should picons be displayed. If `inline', the textual representation is replaced. If `right', picons are @@ -157,9 +163,9 @@ replacement is added." (defun gnus-picon-create-glyph (file) (or (cdr (assoc file gnus-picon-glyph-alist)) - (cdar (push (cons file (gnus-create-image - file nil nil - :color-symbols '(("None" . "white")))) + (cdar (push (cons file (apply 'gnus-create-image + file nil nil + gnus-picon-properties)) gnus-picon-glyph-alist)))) ;;; Functions that does picon transformations: diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el index b80f177fb61..68729da0910 100644 --- a/lisp/gnus/gnus-range.el +++ b/lisp/gnus/gnus-range.el @@ -592,15 +592,6 @@ LIST is a sorted list." (setq sum (+ sum (if (consp x) (- (cdr x) (car x) -1) 1)))))))) -(defun gnus-sublist-p (list sublist) - "Test whether all elements in SUBLIST are members of LIST." - (let ((sublistp t)) - (while sublist - (unless (memq (pop sublist) list) - (setq sublistp nil - sublist nil))) - sublistp)) - (defun gnus-range-add (range1 range2) "Add RANGE2 to RANGE1 (nondestructively)." (unless (listp (cdr range1)) diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 53690f04169..8aecc98ee86 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -78,12 +78,6 @@ (eval-when-compile (require 'cl)) -(eval-when-compile - (when (null (ignore-errors (require 'ert))) - (defmacro* ert-deftest (name () &body docstring-keys-and-body)))) - -(ignore-errors - (require 'ert)) (require 'gnus) (require 'gnus-int) (require 'gnus-sum) @@ -267,7 +261,7 @@ the Bit Bucket." (append gnus-registry-track-extra '(mark group keyword))) (when (not (equal old (oref db :tracked))) - (gnus-message 4 "Reindexing the Gnus registry (tracked change)") + (gnus-message 9 "Reindexing the Gnus registry (tracked change)") (registry-reindex db)))) db) @@ -1077,79 +1071,6 @@ only the last one's marks are returned." (gnus-registry-set-id-key id key val)))) (message "Import done, collected %d entries" count)))) -(ert-deftest gnus-registry-misc-test () - (should-error (gnus-registry-extract-addresses '("" ""))) - - (should (equal '("Ted Zlatanov " - "noname " - "noname " - "noname ") - (gnus-registry-extract-addresses - (concat "Ted Zlatanov , " - "ed , " ; "ed" is not a valid name here - "cyd@stupidchicken.com, " - "tzz@lifelogs.com"))))) - -(ert-deftest gnus-registry-usage-test () - (let* ((n 100) - (tempfile (make-temp-file "gnus-registry-persist")) - (db (gnus-registry-make-db tempfile)) - (gnus-registry-db db) - back size) - (message "Adding %d keys to the test Gnus registry" n) - (dotimes (i n) - (let ((id (number-to-string i))) - (gnus-registry-handle-action id - (if (>= 50 i) "fromgroup" nil) - "togroup" - (when (>= 70 i) - (format "subject %d" (mod i 10))) - (when (>= 80 i) - (format "sender %d" (mod i 10)))))) - (message "Testing Gnus registry size is %d" n) - (should (= n (registry-size db))) - (message "Looking up individual keys (registry-lookup)") - (should (equal (loop for e - in (mapcar 'cadr - (registry-lookup db '("20" "83" "72"))) - collect (assq 'subject e) - collect (assq 'sender e) - collect (assq 'group e)) - '((subject "subject 0") (sender "sender 0") (group "togroup") - (subject) (sender) (group "togroup") - (subject) (sender "sender 2") (group "togroup")))) - - (message "Looking up individual keys (gnus-registry-id-key)") - (should (equal (gnus-registry-get-id-key "34" 'group) '("togroup"))) - (should (equal (gnus-registry-get-id-key "34" 'subject) '("subject 4"))) - (message "Trying to insert a duplicate key") - (should-error (gnus-registry-insert db "55" '())) - (message "Looking up individual keys (gnus-registry-get-or-make-entry)") - (should (gnus-registry-get-or-make-entry "22")) - (message "Saving the Gnus registry to %s" tempfile) - (should (gnus-registry-save tempfile db)) - (setq size (nth 7 (file-attributes tempfile))) - (message "Saving the Gnus registry to %s: size %d" tempfile size) - (should (< 0 size)) - (with-temp-buffer - (insert-file-contents-literally tempfile) - (should (looking-at (concat ";; Object " - "Gnus Registry" - "\n;; EIEIO PERSISTENT OBJECT")))) - (message "Reading Gnus registry back") - (setq back (eieio-persistent-read tempfile)) - (should back) - (message "Read Gnus registry back: %d keys, expected %d==%d" - (registry-size back) n (registry-size db)) - (should (= (registry-size back) n)) - (should (= (registry-size back) (registry-size db))) - (delete-file tempfile) - (message "Pruning Gnus registry to 0 by setting :max-soft") - (oset db :max-soft 0) - (registry-prune db) - (should (= (registry-size db) 0))) - (message "Done with Gnus registry usage testing.")) - ;;;###autoload (defun gnus-registry-initialize () "Initialize the Gnus registry." @@ -1206,6 +1127,52 @@ the user is asked first. Returns non-nil iff the registry is enabled." (gnus-registry-initialize))) gnus-registry-enabled) +;; largely based on nnir-warp-to-article +(defun gnus-try-warping-via-registry () + "Try to warp via the registry. +This will be done via the current article's source group based on +data stored in the registry." + (interactive) + (when (gnus-summary-article-header) + (let* ((message-id (mail-header-id (gnus-summary-article-header))) + ;; Retrieve the message's group(s) from the registry + (groups (gnus-registry-get-id-key message-id 'group)) + ;; If starting from an ephemeral group, this describes + ;; how to restore the window configuration + (quit-config + (gnus-ephemeral-group-p gnus-newsgroup-name)) + (seen-groups (list (gnus-group-group-name)))) + + (catch 'found + (dolist (group (mapcar 'gnus-simplify-group-name groups)) + + ;; skip over any groups we really don't want to warp to. + (unless (or (member group seen-groups) + (gnus-ephemeral-group-p group) ;; any ephemeral group + (memq (car (gnus-find-method-for-group group)) + ;; Specific methods; this list may need to expand. + '(nnir))) + + ;; remember that we've seen this group already + (push group seen-groups) + + ;; first exit from any ephemeral summary buffer. + (when quit-config + (gnus-summary-exit) + ;; and if the ephemeral summary buffer in turn came from + ;; another summary buffer we have to clean that summary + ;; up too. + (when (eq (cdr quit-config) 'summary) + (gnus-summary-exit)) + ;; remember that we've already done this part + (setq quit-config nil)) + + ;; Try to activate the group. If that fails, just move + ;; along. We may have more groups to work with + (ignore-errors + (gnus-select-group-with-message-id group message-id)) + (throw 'found t))))))) + ;; TODO: a few things (provide 'gnus-registry) diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index 6d165fb72dd..760a7a0942e 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -536,12 +536,6 @@ Two predefined functions are available: (when pos (cons pos (next-single-property-change pos 'gnus-number))))) -(defun gnus-tree-goto-article (article) - (let ((pos (text-property-any - (point-min) (point-max) 'gnus-number article))) - (when pos - (goto-char pos)))) - (defun gnus-tree-recenter () "Center point in the tree window." (let ((selected (selected-window)) diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index f86b6f837a7..f24d889216e 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -947,25 +947,6 @@ EXTRA is the possible non-standard header." (gnus-summary-raise-score score)))) (beginning-of-line 2)))) (gnus-set-mode-line 'summary)) - -(defun gnus-summary-score-crossposting (score date) - ;; Enter score file entry for current crossposting. - ;; SCORE is the score to add. - ;; DATE is the expire date. - (let ((xref (gnus-summary-header "xref")) - (start 0) - group) - (unless xref - (error "This article is not crossposted")) - (while (string-match " \\([^ \t]+\\):" xref start) - (setq start (match-end 0)) - (when (not (string= - (setq group - (substring xref (match-beginning 1) (match-end 1))) - gnus-newsgroup-name)) - (gnus-summary-score-entry - "xref" (concat " " group ":") nil score date t))))) - ;;; ;;; Gnus Score Files @@ -3056,62 +3037,6 @@ If ADAPT, return the home adaptive file instead." ;; Return whether this score file needs to be saved. By Je-haysuss! updated)) -(defun gnus-score-regexp-bad-p (regexp) - "Test whether REGEXP is safe for Gnus scoring. -A regexp is unsafe if it matches newline or a buffer boundary. - -If the regexp is good, return nil. If the regexp is bad, return a -cons cell (SYM . STRING), where the symbol SYM is `new' or `bad'. -In the `new' case, the string is a safe replacement for REGEXP. -In the `bad' case, the string is a unsafe subexpression of REGEXP, -and we do not have a simple replacement to suggest. - -See Info node `(gnus)Scoring Tips' for examples of good regular expressions." - (let (case-fold-search) - (and - ;; First, try a relatively fast necessary condition. - ;; Notice ranges (like [^:] or [\t-\r]), \s>, \Sw, \W, \', \`: - (string-match "\n\\|\\\\[SsW`']\\|\\[\\^\\|[\0-\n]-" regexp) - ;; Now break the regexp into tokens, and check each: - (let ((tail regexp) ; remaining regexp to check - tok ; current token - bad ; nil, or bad subexpression - new ; nil, or replacement regexp so far - end) ; length of current token - (while (and (not bad) - (string-match - "\\`\\(\\\\[sS]?.\\|\\[\\^?]?[^]]*]\\|[^\\]\\)" - tail)) - (setq end (match-end 0) - tok (substring tail 0 end) - tail (substring tail end)) - (if;; Is token `bad' (matching newline or buffer ends)? - (or (member tok '("\n" "\\W" "\\`" "\\'")) - ;; This next handles "[...]", "\\s.", and "\\S.": - (and (> end 2) (string-match tok "\n"))) - (let ((newtok - ;; Try to suggest a replacement for tok ... - (cond ((string-equal tok "\\`") "^") ; or "\\(^\\)" - ((string-equal tok "\\'") "$") ; or "\\($\\)" - ((string-match "\\[\\^" tok) ; very common - (concat (substring tok 0 -1) "\n]"))))) - (if newtok - (setq new - (concat - (or new - ;; good prefix so far: - (substring regexp 0 (- (+ (length tail) end)))) - newtok)) - ;; No replacement idea, so give up: - (setq bad tok))) - ;; tok is good, may need to extend new - (and new (setq new (concat new tok))))) - ;; Now return a value: - (cond - (bad (cons 'bad bad)) - (new (cons 'new new)) - (t nil)))))) - (provide 'gnus-score) ;;; gnus-score.el ends here diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el index e1879202ef3..f40177d5c60 100644 --- a/lisp/gnus/gnus-spec.el +++ b/lisp/gnus/gnus-spec.el @@ -101,66 +101,13 @@ text properties. This is only needed on XEmacs, as Emacs does this anyway." (propertize (string 8206) 'invisible t) "")) -(defun gnus-summary-line-format-spec () - (insert gnus-tmp-unread gnus-tmp-replied - gnus-tmp-score-char gnus-tmp-indentation) - (gnus-put-text-property - (point) - (progn - (insert - (format "%c%4s: %-23s%c" gnus-tmp-opening-bracket gnus-tmp-lines - (let ((val - (inline - (gnus-summary-from-or-to-or-newsgroups - gnus-tmp-header gnus-tmp-from)))) - (if (> (length val) 23) - (if (gnus-lrm-string-p val) - (concat (substring val 0 23) gnus-lrm-string) - (substring val 0 23)) - val)) - gnus-tmp-closing-bracket)) - (point)) - gnus-mouse-face-prop gnus-mouse-face) - (insert " " gnus-tmp-subject-or-nil "\n")) - -(defvar gnus-summary-line-format-spec - (gnus-byte-code 'gnus-summary-line-format-spec)) - -(defun gnus-summary-dummy-line-format-spec () - (insert "* ") - (gnus-put-text-property - (point) - (progn - (insert ": :") - (point)) - gnus-mouse-face-prop gnus-mouse-face) - (insert " " gnus-tmp-subject "\n")) - -(defvar gnus-summary-dummy-line-format-spec - (gnus-byte-code 'gnus-summary-dummy-line-format-spec)) - -(defun gnus-group-line-format-spec () - (insert gnus-tmp-marked-mark gnus-tmp-subscribed - gnus-tmp-process-marked - gnus-group-indentation - (format "%5s: " gnus-tmp-number-of-unread)) - (gnus-put-text-property - (point) - (progn - (insert gnus-tmp-group "\n") - (1- (point))) - gnus-mouse-face-prop gnus-mouse-face)) -(defvar gnus-group-line-format-spec - (gnus-byte-code 'gnus-group-line-format-spec)) +(defvar gnus-summary-line-format-spec nil) +(defvar gnus-summary-dummy-line-format-spec nil) +(defvar gnus-group-line-format-spec nil) (defvar gnus-format-specs `((version . ,emacs-version) - (gnus-version . ,(gnus-continuum-version)) - (group "%M\%S\%p\%P\%5y: %(%g%)\n" ,gnus-group-line-format-spec) - (summary-dummy "* %(: :%) %S\n" - ,gnus-summary-dummy-line-format-spec) - (summary "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n" - ,gnus-summary-line-format-spec)) + (gnus-version . ,(gnus-continuum-version))) "Alist of format specs.") (defvar gnus-default-format-specs gnus-format-specs) @@ -214,15 +161,6 @@ Return a list of updated types." (not (equal emacs-version (cdr (assq 'version gnus-format-specs))))) (setq gnus-format-specs nil)) - ;; Flush the group format spec cache if there's the grouplens stuff - ;; or it doesn't support decoded group names. - (when (memq 'group types) - (let* ((spec (assq 'group gnus-format-specs)) - (sspec (gnus-prin1-to-string (nth 2 spec)))) - (when (or (string-match " gnus-tmp-grouplens[ )]" sspec) - (not (string-match " gnus-tmp-decoded-group[ )]" sspec))) - (setq gnus-format-specs (delq spec gnus-format-specs))))) - ;; Go through all the formats and see whether they need updating. (let (new-format entry type val updated) (while (setq type (pop types)) @@ -778,36 +716,6 @@ If PROPS, insert the result." (gnus-add-text-properties (point) (progn (eval form) (point)) props) (eval form)))) -(defun gnus-compile () - "Byte-compile the user-defined format specs." - (interactive) - (require 'bytecomp) - (let ((entries gnus-format-specs) - (byte-compile-warnings '(unresolved callargs redefine)) - entry gnus-tmp-func) - (save-excursion - (gnus-message 7 "Compiling format specs...") - - (while entries - (setq entry (pop entries)) - (if (memq (car entry) '(gnus-version version)) - (setq gnus-format-specs (delq entry gnus-format-specs)) - (let ((form (caddr entry))) - (when (and (listp form) - ;; Under GNU Emacs, it's (byte-code ...) - (not (eq 'byte-code (car form))) - ;; Under XEmacs, it's (funcall #) - (not (and (eq 'funcall (car form)) - (byte-code-function-p (cadr form))))) - (defalias 'gnus-tmp-func `(lambda () ,form)) - (byte-compile 'gnus-tmp-func) - (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))) - - (push (cons 'version emacs-version) gnus-format-specs) - ;; Mark the .newsrc.eld file as "dirty". - (gnus-dribble-touch) - (gnus-message 7 "Compiling user specs...done")))) - (defun gnus-set-format (type &optional insertable) (set (intern (format "gnus-%s-line-format-spec" type)) (gnus-parse-format diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index f025960c348..40ee78bb695 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -1369,11 +1369,6 @@ for new groups, and subscribe the new groups as zombies." (funcall gnus-group-change-level-function group level oldlevel previous))))) -(defun gnus-kill-newsgroup (newsgroup) - "Obsolete function. Kills a newsgroup." - (gnus-group-change-level - (gnus-group-entry newsgroup) gnus-level-killed)) - (defun gnus-check-bogus-newsgroups (&optional confirm) "Remove bogus newsgroups. If CONFIRM is non-nil, the user has to confirm the deletion of every @@ -1504,8 +1499,6 @@ backend check whether the group actually exists." ;; Return the new active info. active))))) -(defvar gnus-propagate-marks) ; gnus-sum - (defun gnus-get-unread-articles-in-group (info active &optional update) (when (and info active) ;; Allow the backend to update the info in the group. @@ -1515,13 +1508,6 @@ backend check whether the group actually exists." (gnus-info-group info))))) (gnus-activate-group (gnus-info-group info) nil t)) - ;; Allow backends to update marks, - (when gnus-propagate-marks - (let ((method (inline (gnus-find-method-for-group - (gnus-info-group info))))) - (when (gnus-check-backend-function 'request-marks (car method)) - (gnus-request-marks info method)))) - (let* ((range (gnus-info-read info)) (num 0)) @@ -1610,7 +1596,7 @@ backend check whether the group actually exists." ;; 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 dont-connect) +(defun gnus-get-unread-articles (&optional level dont-connect one-level) (setq gnus-server-method-cache nil) (require 'gnus-agent) (let* ((newsrc (cdr gnus-newsrc-alist)) @@ -1667,7 +1653,7 @@ backend check whether the group actually exists." (push (setq method-group-list (list method method-type nil nil)) type-cache)) ;; Only add groups that need updating. - (if (<= (gnus-info-level info) + (if (funcall (if one-level #'= #'<=) (gnus-info-level info) (if (eq (cadr method-group-list) 'foreign) foreign-level alevel)) @@ -2230,7 +2216,7 @@ backend check whether the group actually exists." (gnus-online method) (gnus-agent-method-p method)) (progn - (gnus-agent-save-active method) + (gnus-agent-save-active method t) (gnus-active-to-gnus-format method hashtb nil real-active)) (goto-char (point-min)) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 7f095e15496..06f17bcf646 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -451,7 +451,8 @@ current article is unread." :group 'gnus-summary-maneuvering :type 'boolean) -(defcustom gnus-auto-center-summary 2 +(defcustom gnus-auto-center-summary + (max (or (bound-and-true-p scroll-margin) 0) 2) "*If non-nil, always center the current summary buffer. In particular, if `vertical' do only vertical recentering. If non-nil and non-`vertical', do both horizontal and vertical recentering." @@ -1243,13 +1244,6 @@ For example: ((1 . cn-gb-2312) (2 . big5))." :type 'boolean :group 'gnus-summary-marks) -(defcustom gnus-propagate-marks nil - "If non-nil, Gnus will store and retrieve marks from the backends. -This means that marks will be stored both in .newsrc.eld and in -the backend, and will slow operation down somewhat." - :type 'boolean - :group 'gnus-summary-marks) - (defcustom gnus-alter-articles-to-read-function nil "Function to be called to alter the list of articles to be selected." :type '(choice (const nil) function) @@ -1918,6 +1912,7 @@ increase the score of each group you read." "x" gnus-summary-limit-to-unread "s" gnus-summary-isearch-article [tab] gnus-summary-widget-forward + [backtab] gnus-summary-widget-backward "t" gnus-summary-toggle-header "g" gnus-summary-show-article "l" gnus-summary-goto-last-article @@ -2082,6 +2077,7 @@ increase the score of each group you read." "g" gnus-summary-show-article "s" gnus-summary-isearch-article [tab] gnus-summary-widget-forward + [backtab] gnus-summary-widget-backward "P" gnus-summary-print-article "S" gnus-sticky-article "M" gnus-mailing-list-insinuate @@ -2971,12 +2967,6 @@ When FORCE, rebuild the tool bar." (setq gnus-summary-tool-bar-map map)))) (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map)) -(defun gnus-score-set-default (var value) - "A version of set that updates the GNU Emacs menu-bar." - (set var value) - ;; It is the message that forces the active status to be updated. - (message "")) - (defun gnus-make-score-map (type) "Make a summary score map of type TYPE." (if t @@ -3262,13 +3252,6 @@ The following commands are available: "Say whether this article is a sparse article or not." `(memq ,article gnus-newsgroup-ancient)) -(defun gnus-article-parent-p (number) - "Say whether this article is a parent or not." - (let ((data (gnus-data-find-list number))) - (and (cdr data) ; There has to be an article after... - (< (gnus-data-level (car data)) ; And it has to have a higher level. - (gnus-data-level (nth 1 data)))))) - (defun gnus-article-children (number) "Return a list of all children to NUMBER." (let* ((data (gnus-data-find-list number)) @@ -3290,14 +3273,6 @@ The following commands are available: "Say whether this article is intangible or not." '(get-text-property (point) 'gnus-intangible)) -(defun gnus-article-read-p (article) - "Say whether ARTICLE is read or not." - (not (or (memq article gnus-newsgroup-marked) - (memq article gnus-newsgroup-spam-marked) - (memq article gnus-newsgroup-unreads) - (memq article gnus-newsgroup-unselected) - (memq article gnus-newsgroup-dormant)))) - ;; Some summary mode macros. (defmacro gnus-summary-article-number () @@ -3558,7 +3533,7 @@ buffer that was in action when the last article was fetched." (push (eval (car locals)) vlist)) (setq locals (cdr locals))) (setq vlist (nreverse vlist))) - (with-current-buffer gnus-group-buffer + (with-temp-buffer (setq gnus-newsgroup-name name gnus-newsgroup-marked marked gnus-newsgroup-spam-marked spam @@ -5683,7 +5658,9 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; Init the dependencies hash table. (setq gnus-newsgroup-dependencies (gnus-make-hashtable (length articles))) - (gnus-set-global-variables) + (if (gnus-buffer-live-p gnus-group-buffer) + (gnus-set-global-variables) + (set-default 'gnus-newsgroup-name gnus-newsgroup-name)) ;; Retrieve the headers and read them in. (setq gnus-newsgroup-headers (gnus-fetch-headers articles)) @@ -5927,17 +5904,6 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq articles (cdr articles))) out)) -(defun gnus-uncompress-marks (marks) - "Uncompress the mark ranges in MARKS." - (let ((uncompressed '(score bookmark)) - out) - (while marks - (if (memq (caar marks) uncompressed) - (push (car marks) out) - (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out)) - (setq marks (cdr marks))) - out)) - (defun gnus-article-mark-to-type (mark) "Return the type of MARK." (or (cadr (assq mark gnus-article-special-mark-lists)) @@ -5965,7 +5931,6 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq mark (car marks) mark-type (gnus-article-mark-to-type mark) var (intern (format "gnus-newsgroup-%s" (car (rassq mark types))))) - ;; We set the variable according to the type of the marks list, ;; and then adjust the marks to a subset of the active articles. (cond @@ -6074,10 +6039,6 @@ If SELECT-ARTICLES, only select those articles from GROUP." (when (and (gnus-check-backend-function 'request-set-mark gnus-newsgroup-name) - (or gnus-propagate-marks - (gnus-method-option-p - (gnus-find-method-for-group gnus-newsgroup-name) - 'server-marks)) (not (gnus-article-unpropagatable-p (cdr type)))) (let* ((old (cdr (assq (cdr type) (gnus-info-marks info)))) ;; Don't do anything about marks for articles we @@ -6289,10 +6250,9 @@ The resulting hash table is returned, or nil if no Xrefs were found." (info (nth 2 entry)) (active (gnus-active group)) (set-marks - (or gnus-propagate-marks - (gnus-method-option-p - (gnus-find-method-for-group group) - 'server-marks))) + (gnus-method-option-p + (gnus-find-method-for-group group) + 'server-marks)) range) (if (not entry) ;; Group that Gnus doesn't know exists, but still allow the @@ -6629,9 +6589,9 @@ too, instead of trying to fetch new headers." ;; article if ID is a number -- so that the next `P' or `N' ;; command will fetch the previous (or next) article even ;; if the one we tried to fetch this time has been canceled. - (when (> number gnus-newsgroup-end) + (unless (and gnus-newsgroup-end (< number gnus-newsgroup-end)) (setq gnus-newsgroup-end number)) - (when (< number gnus-newsgroup-begin) + (unless (and gnus-newsgroup-begin (> number gnus-newsgroup-begin)) (setq gnus-newsgroup-begin number)) (setq gnus-newsgroup-unselected (delq number gnus-newsgroup-unselected))) @@ -7257,7 +7217,8 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-summary-update-info)) (gnus-close-group group) ;; Make sure where we were, and go to next newsgroup. - (set-buffer gnus-group-buffer) + (when (buffer-live-p (get-buffer gnus-group-buffer)) + (set-buffer gnus-group-buffer)) (unless quit-config (gnus-group-jump-to-group group)) (gnus-run-hooks 'gnus-summary-exit-hook) @@ -7282,7 +7243,8 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-kill-buffer buf))) (setq gnus-current-select-method gnus-select-method) - (set-buffer gnus-group-buffer) + (when (gnus-buffer-live-p gnus-group-buffer) + (set-buffer gnus-group-buffer)) (if quit-config (gnus-handle-ephemeral-exit quit-config) (goto-char group-point) @@ -7361,7 +7323,8 @@ If FORCE (the prefix), also save the .newsrc file(s)." "Handle movement when leaving an ephemeral group. The state which existed when entering the ephemeral is reset." (if (not (buffer-live-p (car quit-config))) - (gnus-configure-windows 'group 'force) + (when (gnus-buffer-live-p gnus-group-buffer) + (gnus-configure-windows 'group 'force)) (set-buffer (car quit-config)) (unless (eq (cdr quit-config) 'group) (setq gnus-current-select-method @@ -7759,10 +7722,6 @@ be displayed." gnus-buttonized-mime-types))) (gnus-summary-select-article nil 'force))) -(defun gnus-summary-set-current-mark (&optional current-mark) - "Obsolete function." - nil) - (defun gnus-summary-next-article (&optional unread subject backward push) "Select the next article. If UNREAD, only unread articles are selected. @@ -8236,9 +8195,17 @@ If NOT-MATCHING, excluding articles that have subjects that match a regexp." "Limit the summary buffer to articles that have authors that match a regexp. If NOT-MATCHING, excluding articles that have authors that match a regexp." (interactive - (list (read-string (if current-prefix-arg - "Exclude author (regexp): " - "Limit to author (regexp): ")) + (list (let* ((header (gnus-summary-article-header)) + (default (and header (car (mail-header-parse-address + (mail-header-from header)))))) + (read-string (concat (if current-prefix-arg + "Exclude author (regexp" + "Limit to author (regexp") + (if default + (concat ", default \"" default "\"): ") + "): ")) + nil nil + default)) current-prefix-arg)) (gnus-summary-limit-to-subject from "from" not-matching)) @@ -9270,6 +9237,17 @@ With optional ARG, move across that many fields." (select-window (gnus-get-buffer-window gnus-article-buffer)) (widget-forward arg)) +(defun gnus-summary-widget-backward (arg) + "Move point to the previous field or button in the article. +With optional ARG, move across that many fields." + (interactive "p") + (gnus-summary-select-article) + (gnus-configure-windows 'article) + (select-window (gnus-get-buffer-window gnus-article-buffer)) + (unless (widget-at (point)) + (goto-char (point-max))) + (widget-backward arg)) + (defun gnus-summary-isearch-article (&optional regexp-p) "Do incremental search forward on the current article. If REGEXP-P (the prefix) is non-nil, do regexp isearch." @@ -10080,10 +10058,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." to-group 'expire (list to-article) info)) (when (and to-marks - (or gnus-propagate-marks - (gnus-method-option-p - (gnus-find-method-for-group to-group) - 'server-marks))) + (gnus-method-option-p + (gnus-find-method-for-group to-group) + 'server-marks)) (gnus-request-set-mark to-group (list (list (list to-article) 'add to-marks))))) @@ -12418,6 +12395,13 @@ If REVERSE, save parts that do not match TYPE." (not (setq header (car (gnus-get-newsgroup-headers nil t))))) () ; Malformed head. (unless (gnus-summary-article-sparse-p (mail-header-number header)) + (when (and (bound-and-true-p gnus-registry-enabled) + (not (gnus-ephemeral-group-p (car where)))) + (gnus-registry-handle-action + (mail-header-id header) nil + (gnus-group-prefixed-name (car where) gnus-override-method) + (mail-header-subject header) + (mail-header-from header))) (when (and (stringp id) (or (not (string= (gnus-group-real-name group) @@ -12565,10 +12549,9 @@ UNREAD is a sorted list." (save-excursion (let (setmarkundo) ;; Propagate the read marks to the backend. - (when (and (or gnus-propagate-marks - (gnus-method-option-p - (gnus-find-method-for-group group) - 'server-marks)) + (when (and (gnus-method-option-p + (gnus-find-method-for-group group) + 'server-marks) (gnus-check-backend-function 'request-set-mark group)) (let ((del (gnus-remove-from-range (gnus-info-read info) read)) (add (gnus-remove-from-range read (gnus-info-read info)))) diff --git a/lisp/gnus/gnus-sync.el b/lisp/gnus/gnus-sync.el index 6efd34e1596..15d94810c3a 100644 --- a/lisp/gnus/gnus-sync.el +++ b/lisp/gnus/gnus-sync.el @@ -24,44 +24,83 @@ ;; This is the gnus-sync.el package. -;; It's due for a rewrite using gnus-after-set-mark-hook and -;; gnus-before-update-mark-hook, and my plan is to do this once No -;; Gnus development is done. Until then please consider it -;; experimental. - ;; Put this in your startup file (~/.gnus.el for instance) ;; possibilities for gnus-sync-backend: ;; Tramp over SSH: /ssh:user@host:/path/to/filename -;; Tramp over IMAP: /imaps:user@yourhosthere.com:/INBOX.test/filename ;; ...or any other file Tramp and Emacs can handle... ;; (setq gnus-sync-backend "/remote:/path.gpg" ; will use Tramp+EPA if loaded -;; gnus-sync-global-vars `(gnus-newsrc-last-checked-date) -;; gnus-sync-newsrc-groups `("nntp" "nnrss") -;; gnus-sync-newsrc-offsets `(2 3)) +;; gnus-sync-global-vars '(gnus-newsrc-last-checked-date) +;; gnus-sync-newsrc-groups '("nntp" "nnrss")) +;; gnus-sync-newsrc-offsets '(2 3)) +;; against a LeSync server (beware the vampire LeSync, who knows your newsrc) + +;; (setq gnus-sync-backend '(lesync "http://lesync.info:5984/tzz") +;; gnus-sync-newsrc-groups '("nntp" "nnrss")) + +;; What's a LeSync server? + +;; 1. install CouchDB, set up a real server admin user, and create a +;; database, e.g. "tzz" and save the URL, +;; e.g. http://lesync.info:5984/tzz + +;; 2. run `M-: (gnus-sync-lesync-setup "http://lesync.info:5984/tzz" "tzzadmin" "mypassword" "mysalt" t t)' + +;; (If you run it more than once, you have to remove the entry from +;; _users yourself. This is intentional. This sets up a database +;; admin for the "tzz" database, distinct from the server admin +;; user in (1) above.) + +;; That's it, you can start using http://lesync.info:5984/tzz in your +;; gnus-sync-backend as a LeSync backend. Fan fiction about the +;; vampire LeSync is welcome. + +;; You may not want to expose a CouchDB install to the Big Bad +;; Internet, especially if your love of all things furry would be thus +;; revealed. Make sure it's not accessible by unauthorized users and +;; guests, at least. + +;; If you want to try it out, I will create a test DB for you under +;; http://lesync.info:5984/yourfavoritedbname ;; TODO: -;; - after gnus-sync-read, the message counts are wrong. So it's not -;; run automatically, you have to call it with M-x gnus-sync-read +;; - after gnus-sync-read, the message counts look wrong until you do +;; `g'. So it's not run automatically, you have to call it with M-x +;; gnus-sync-read ;; - use gnus-after-set-mark-hook and gnus-before-update-mark-hook to ;; catch the mark updates +;; - repositioning of groups within topic after a LeSync sync is a +;; weird sort of bubble sort ("buttle" sort: the old entry ends up +;; at the rear of the list); you will eventually end up with the +;; right order after calling `gnus-sync-read' a bunch of times. + +;; - installing topics and groups is inefficient and annoying, lots of +;; prompts could be avoided + ;;; Code: (eval-when-compile (require 'cl)) +(require 'json) (require 'gnus) (require 'gnus-start) (require 'gnus-util) +(defvar gnus-topic-alist) ;; gnus-group.el +(eval-when-compile + (autoload 'gnus-group-topic "gnus-topic") + (autoload 'gnus-topic-create-topic "gnus-topic" nil t) + (autoload 'gnus-topic-enter-dribble "gnus-topic")) + (defgroup gnus-sync nil "The Gnus synchronization facility." :version "24.1" :group 'gnus) -(defcustom gnus-sync-newsrc-groups `("nntp" "nnrss") +(defcustom gnus-sync-newsrc-groups '("nntp" "nnrss") "List of groups to be synchronized in the gnus-newsrc-alist. The group names are matched, they don't have to be fully qualified. Typically you would choose all of these. That's the @@ -70,20 +109,12 @@ this setting is harmless until the user chooses a sync backend." :group 'gnus-sync :type '(repeat regexp)) -(defcustom gnus-sync-newsrc-offsets '(2 3) - "List of per-group data to be synchronized." - :group 'gnus-sync - :type '(set (const :tag "Read ranges" 2) - (const :tag "Marks" 3))) - (defcustom gnus-sync-global-vars nil "List of global variables to be synchronized. You may want to sync `gnus-newsrc-last-checked-date' but pretty much any symbol is fair game. You could additionally sync `gnus-newsrc-alist', `gnus-server-alist', `gnus-topic-topology', -and `gnus-topic-alist' to cover all the variables in -newsrc.eld (except for `gnus-format-specs' which should not be -synchronized, I believe). Also see `gnus-variable-list'." +and `gnus-topic-alist'. Also see `gnus-variable-list'." :group 'gnus-sync :type '(repeat (choice (variable :tag "A known variable") (symbol :tag "Any symbol")))) @@ -92,30 +123,625 @@ synchronized, I believe). Also see `gnus-variable-list'." "The synchronization backend." :group 'gnus-sync :type '(radio (const :format "None" nil) + (list :tag "Sync server" + (const :format "LeSync Server API" lesync) + (string :tag "URL of a CouchDB database for API access")) (string :tag "Sync to a file"))) (defvar gnus-sync-newsrc-loader nil "Carrier for newsrc data") -(defun gnus-sync-save () -"Save the Gnus sync data to the backend." - (interactive) +(defcustom gnus-sync-lesync-name (system-name) + "The LeSync name for this machine." + :group 'gnus-sync + :type 'string) + +(defcustom gnus-sync-lesync-install-topics 'ask + "Should LeSync install the recorded topics?" + :group 'gnus-sync + :type '(choice (const :tag "Never Install" nil) + (const :tag "Always Install" t) + (const :tag "Ask Me Once" ask))) + +(defvar gnus-sync-lesync-props-hash (make-hash-table :test 'equal) + "LeSync props, keyed by group name") + +(defvar gnus-sync-lesync-design-prefix "/_design/lesync" + "The LeSync design prefix for CouchDB") + +(defvar gnus-sync-lesync-security-object "/_security" + "The LeSync security object for CouchDB") + +(defun gnus-sync-lesync-parse () + "Parse the result of a LeSync request." + (goto-char (point-min)) + (condition-case nil + (when (search-forward-regexp "^$" nil t) + (json-read)) + (error + (gnus-message + 1 + "gnus-sync-lesync-parse: Could not read the LeSync response!") + nil))) + +(defun gnus-sync-lesync-call (url method headers &optional kvdata) + "Make an access request to URL using KVDATA and METHOD. +KVDATA must be an alist." + (flet ((json-alist-p (list) (gnus-sync-json-alist-p list))) ; temp patch + (let ((url-request-method method) + (url-request-extra-headers headers) + (url-request-data (if kvdata (json-encode kvdata) nil))) + (with-current-buffer (url-retrieve-synchronously url) + (let ((data (gnus-sync-lesync-parse))) + (gnus-message 12 "gnus-sync-lesync-call: %s URL %s sent %S got %S" + method url `((headers . ,headers) (data ,kvdata)) data) + (kill-buffer (current-buffer)) + data))))) + +(defun gnus-sync-lesync-PUT (url headers &optional data) + (gnus-sync-lesync-call url "PUT" headers data)) + +(defun gnus-sync-lesync-POST (url headers &optional data) + (gnus-sync-lesync-call url "POST" headers data)) + +(defun gnus-sync-lesync-GET (url headers &optional data) + (gnus-sync-lesync-call url "GET" headers data)) + +(defun gnus-sync-lesync-DELETE (url headers &optional data) + (gnus-sync-lesync-call url "DELETE" headers data)) + +;; this is not necessary with newer versions of json.el but 1.2 or older +;; (which are in Emacs 24.1 and earlier) need it +(defun gnus-sync-json-alist-p (list) + "Non-null if and only if LIST is an alist." + (while (consp list) + (setq list (if (consp (car list)) + (cdr list) + 'not-alist))) + (null list)) + +;; this is not necessary with newer versions of json.el but 1.2 or older +;; (which are in Emacs 24.1 and earlier) need it +(defun gnus-sync-json-plist-p (list) + "Non-null if and only if LIST is a plist." + (while (consp list) + (setq list (if (and (keywordp (car list)) + (consp (cdr list))) + (cddr list) + 'not-plist))) + (null list)) + +; (gnus-sync-lesync-setup "http://lesync.info:5984/tzz" "tzzadmin" "mypassword" "mysalt" t t) +; (gnus-sync-lesync-setup "http://lesync.info:5984/tzz") + +(defun gnus-sync-lesync-setup (url &optional user password salt reader admin) + (interactive "sEnter URL to set up: ") + "Set up the LeSync database at URL. +Install USER as a READER and/or an ADMIN in the security object +under \"_security\", and in the CouchDB \"_users\" table using +PASSWORD and SALT. Only one USER is thus supported for now. +When SALT is nil, a random one will be generated using `random'." + (let* ((design-url (concat url gnus-sync-lesync-design-prefix)) + (security-object (concat url "/_security")) + (user-record `((names . [,user]) (roles . []))) + (couch-user-name (format "org.couchdb.user:%s" user)) + (salt (or salt (sha1 (format "%s" (random t))))) + (couch-user-record + `((_id . ,couch-user-name) + (type . user) + (name . ,(format "%s" user)) + (roles . []) + (salt . ,salt) + (password_sha . ,(when password + (sha1 + (format "%s%s" password salt)))))) + (rev (progn + (gnus-sync-lesync-find-prop 'rev design-url design-url) + (gnus-sync-lesync-get-prop 'rev design-url))) + (latest-func "function(head,req) +{ + var tosend = []; + var row; + var ftime = (req.query['ftime'] || 0); + while (row = getRow()) + { + if (row.value['float-time'] > ftime) + { + var s = row.value['_id']; + if (s) tosend.push('\"'+s.replace('\"', '\\\"')+'\"'); + } + } + send('['+tosend.join(',') + ']'); +}") +;; read +;; +;; de.alt.fan.ipod +;; +;; 1 +;; 2 +;; +;; start +;; 100 +;; length +;; 100 +;; +;; +;; + (xmlplistread-func "function(head, req) { + var row; + start({ 'headers': { 'Content-Type': 'text/xml' } }); + + send(''); + send('read'); + send(''); + while(row = getRow()) + { + var read = row.value.read; + if (read && read[0] && read[0] == 'invlist') + { + send(''+row.key+''); + //send(''+read+''); + send(''); + + var from = 0; + var flip = false; + + for (var i = 1; i < read.length && read[i]; i++) + { + var cur = read[i]; + if (flip) + { + if (from == cur-1) + { + send(''+read[i]+''); + } + else + { + send(''); + send('start'); + send(''+from+''); + send('end'); + send(''+(cur-1)+''); + send(''); + } + + } + flip = ! flip; + from = cur; + } + send(''); + } + } + + send(''); + send(''); +} +") + (subs-func "function(doc){emit([doc._id, doc.source], doc._rev);}") + (revs-func "function(doc){emit(doc._id, doc._rev);}") + (bytimesubs-func "function(doc) +{emit([(doc['float-time']||0), doc._id], doc._rev);}") + (bytime-func "function(doc) +{emit([(doc['float-time']||0), doc._id], doc);}") + (groups-func "function(doc){emit(doc._id, doc);}")) + (and (if user + (and (assq 'ok (gnus-sync-lesync-PUT + security-object + nil + (append (and reader + (list `(readers . ,user-record))) + (and admin + (list `(admins . ,user-record)))))) + (assq 'ok (gnus-sync-lesync-PUT + (concat (file-name-directory url) + "_users/" + couch-user-name) + nil + couch-user-record))) + t) + (assq 'ok (gnus-sync-lesync-PUT + design-url + nil + `(,@(when rev (list (cons '_rev rev))) + (lists . ((latest . ,latest-func) + (xmlplistread . ,xmlplistread-func))) + (views . ((subs . ((map . ,subs-func))) + (revs . ((map . ,revs-func))) + (bytimesubs . ((map . ,bytimesubs-func))) + (bytime . ((map . ,bytime-func))) + (groups . ((map . ,groups-func))))))))))) + +(defun gnus-sync-lesync-find-prop (prop url key) + "Retrieve a PROPerty of a document KEY at URL. +Calls `gnus-sync-lesync-set-prop'. +For the 'rev PROP, uses '_rev against the document." + (gnus-sync-lesync-set-prop + prop key (cdr (assq (if (eq prop 'rev) '_rev prop) + (gnus-sync-lesync-GET url nil))))) + +(defun gnus-sync-lesync-set-prop (prop key val) + "Update the PROPerty of document KEY at URL to VAL. +Updates `gnus-sync-lesync-props-hash'." + (puthash (format "%s.%s" key prop) val gnus-sync-lesync-props-hash)) + +(defun gnus-sync-lesync-get-prop (prop key) + "Get the PROPerty of KEY from `gnus-sync-lesync-props-hash'." + (gethash (format "%s.%s" key prop) gnus-sync-lesync-props-hash)) + +(defun gnus-sync-deep-print (data) + (let* ((print-quoted t) + (print-readably t) + (print-escape-multibyte nil) + (print-escape-nonascii t) + (print-length nil) + (print-level nil) + (print-circle nil) + (print-escape-newlines t)) + (format "%S" data))) + +(defun gnus-sync-newsrc-loader-builder (&optional only-modified) + (let* ((entries (cdr gnus-newsrc-alist)) + entry name ret) + (while entries + (setq entry (pop entries) + name (car entry)) + (when (gnus-grep-in-list name gnus-sync-newsrc-groups) + (if only-modified + (when (not (equal (gnus-sync-deep-print entry) + (gnus-sync-lesync-get-prop 'checksum name))) + (gnus-message 9 "%s: add %s, it's modified" + "gnus-sync-newsrc-loader-builder" name) + (push entry ret)) + (push entry ret)))) + ret)) + +; (json-encode (gnus-sync-range2invlist '((1 . 47137) (47139 . 47714) 48129 48211 49231 49281 49342 49473 49475 49502))) +(defun gnus-sync-range2invlist (ranges) + (append '(invlist) + (let ((ranges (delq nil ranges)) + ret range from to) + (while ranges + (setq range (pop ranges)) + (if (atom range) + (setq from range + to range) + (setq from (car range) + to (cdr range))) + (push from ret) + (push (1+ to) ret)) + (reverse ret)))) + +; (let* ((d '((1 . 47137) (47139 . 47714) 48129 48211 49231 49281 49342 49473 49475 49502)) (j (format "%S" (gnus-sync-invlist2range (gnus-sync-range2invlist d))))) (or (equal (format "%S" d) j) j)) +(defun gnus-sync-invlist2range (inv) + (setq inv (append inv nil)) + (if (equal (format "%s" (car inv)) "invlist") + (let ((i (cdr inv)) + (start 0) + ret cur top flip) + (while i + (setq cur (pop i)) + (when flip + (setq top (1- cur)) + (if (= start top) + (push start ret) + (push (cons start top) ret))) + (setq flip (not flip)) + (setq start cur)) + (reverse ret)) + inv)) + +(defun gnus-sync-position (search list &optional test) + "Find the position of SEARCH in LIST using TEST, defaulting to `eq'." + (let ((pos 0) + (test (or test 'eq))) + (while (and list (not (funcall test (car list) search))) + (pop list) + (incf pos)) + (if (funcall test (car list) search) pos nil))) + +(defun gnus-sync-topic-group-position (group topic-name) + (gnus-sync-position + group (cdr (assoc topic-name gnus-topic-alist)) 'equal)) + +(defun gnus-sync-fix-topic-group-position (group topic-name position) + (unless (equal position (gnus-sync-topic-group-position group topic-name)) + (let* ((loc "gnus-sync-fix-topic-group-position") + (groups (delete group (cdr (assoc topic-name gnus-topic-alist)))) + (position (min position (1- (length groups)))) + (old (nth position groups))) + (when (and old (not (equal old group))) + (setf (nth position groups) group) + (setcdr (assoc topic-name gnus-topic-alist) + (append groups (list old))) + (gnus-message 9 "%s: %s moved to %d, swap with %s" + loc group position old))))) + +(defun gnus-sync-lesync-pre-save-group-entry (url nentry &rest passed-props) + (let* ((loc "gnus-sync-lesync-save-group-entry") + (k (car nentry)) + (revision (gnus-sync-lesync-get-prop 'rev k)) + (sname gnus-sync-lesync-name) + (topic (gnus-group-topic k)) + (topic-offset (gnus-sync-topic-group-position k topic)) + (sources (gnus-sync-lesync-get-prop 'source k))) + ;; set the revision so we don't have a conflict + `(,@(when revision + (list (cons '_rev revision))) + (_id . ,k) + ;; the time we saved + ,@passed-props + ;; add our name to the sources list for this key + (source ,@(if (member gnus-sync-lesync-name sources) + sources + (cons gnus-sync-lesync-name sources))) + ,(cons 'level (nth 1 nentry)) + ,@(if topic (list (cons 'topic topic)) nil) + ,@(if topic-offset (list (cons 'topic-offset topic-offset)) nil) + ;; the read marks + ,(cons 'read (gnus-sync-range2invlist (nth 2 nentry))) + ;; the other marks + ,@(delq nil (mapcar (lambda (mark-entry) + (gnus-message 12 "%s: prep param %s in %s" + loc + (car mark-entry) + (nth 3 nentry)) + (if (listp (cdr mark-entry)) + (cons (car mark-entry) + (gnus-sync-range2invlist + (cdr mark-entry))) + (progn ; else this is not a list + (gnus-message 9 "%s: non-list param %s in %s" + loc + (car mark-entry) + (nth 3 nentry)) + nil))) + (nth 3 nentry)))))) + +(defun gnus-sync-lesync-post-save-group-entry (url entry) + (let* ((loc "gnus-sync-lesync-post-save-group-entry") + (k (cdr (assq 'id entry)))) + (cond + ;; success! + ((and (assq 'rev entry) (assq 'id entry)) + (progn + (gnus-sync-lesync-set-prop 'rev k (cdr (assq 'rev entry))) + (gnus-sync-lesync-set-prop 'checksum + k + (gnus-sync-deep-print + (assoc k gnus-newsrc-alist))) + (gnus-message 9 "%s: successfully synced %s to %s" + loc k url))) + ;; specifically check for document conflicts + ((equal "conflict" (format "%s" (cdr-safe (assq 'error entry)))) + (gnus-error + 1 + "%s: use `%s' to resolve the conflict synchronizing %s to %s: %s" + loc "gnus-sync-read" k url (cdr (assq 'reason entry)))) + ;; generic errors + ((assq 'error entry) + (gnus-error 1 "%s: got error while synchronizing %s to %s: %s" + loc k url (cdr (assq 'reason entry)))) + + (t + (gnus-message 2 "%s: unknown sync status after %s to %s: %S" + loc k url entry))) + (assoc 'error entry))) + +(defun gnus-sync-lesync-groups-builder (url) + (let ((u (concat url gnus-sync-lesync-design-prefix "/_view/groups"))) + (cdr (assq 'rows (gnus-sync-lesync-GET u nil))))) + +(defun gnus-sync-subscribe-group (name) + "Subscribe to group NAME. Returns NAME on success, nil otherwise." + (gnus-subscribe-newsgroup name)) + +(defun gnus-sync-lesync-read-group-entry (url name entry &rest passed-props) + "Read ENTRY information for NAME. Returns NAME if successful. +Skips entries whose sources don't contain +`gnus-sync-lesync-name'. When the alist PASSED-PROPS has a +`subscribe-all' element that evaluates to true, we attempt to +subscribe to unknown groups. The user is also allowed to delete +unwanted groups via the LeSync URL." + (let* ((loc "gnus-sync-lesync-read-group-entry") + (entry (gnus-sync-lesync-normalize-group-entry entry passed-props)) + (subscribe-all (cdr (assq 'subscribe-all passed-props))) + (sources (cdr (assq 'source entry))) + (rev (cdr (assq 'rev entry))) + (in-sources (member gnus-sync-lesync-name sources)) + (known (assoc name gnus-newsrc-alist)) + cell) + (unless known + (if (and subscribe-all + (y-or-n-p (format "Subscribe to group %s?" name))) + (setq known (gnus-sync-subscribe-group name) + in-sources t) + ;; else... + (when (y-or-n-p (format "Delete group %s from server?" name)) + (if (equal name (gnus-sync-lesync-delete-group url name)) + (gnus-message 1 "%s: removed group %s from server %s" + loc name url) + (gnus-error 1 "%s: could not remove group %s from server %s" + loc name url))))) + (when known + (unless in-sources + (setq in-sources + (y-or-n-p + (format "Read group %s even though %s is not in sources %S?" + name gnus-sync-lesync-name (or sources "")))))) + (when rev + (gnus-sync-lesync-set-prop 'rev name rev)) + + ;; if the source matches AND we have this group + (if (and known in-sources) + (progn + (gnus-message 10 "%s: reading LeSync entry %s, sources %S" + loc name sources) + (while entry + (setq cell (pop entry)) + (let ((k (car cell)) + (val (cdr cell))) + (gnus-sync-lesync-set-prop k name val))) + name) + ;; else... + (unless known + (gnus-message 5 "%s: ignoring entry %s, it wasn't subscribed. %s" + loc name "Call `gnus-sync-read' with C-u to force it.")) + (unless in-sources + (gnus-message 5 "%s: ignoring entry %s, %s not in sources %S" + loc name gnus-sync-lesync-name (or sources ""))) + nil))) + +(defun gnus-sync-lesync-install-group-entry (name) + (let* ((master (assoc name gnus-newsrc-alist)) + (old-topic-name (gnus-group-topic name)) + (old-topic (assoc old-topic-name gnus-topic-alist)) + (target-topic-name (gnus-sync-lesync-get-prop 'topic name)) + (target-topic-offset (gnus-sync-lesync-get-prop 'topic-offset name)) + (target-topic (assoc target-topic-name gnus-topic-alist)) + (loc "gnus-sync-lesync-install-group-entry")) + (if master + (progn + (when (eq 'ask gnus-sync-lesync-install-topics) + (setq gnus-sync-lesync-install-topics + (y-or-n-p "Install topics from LeSync?"))) + (when (and (eq t gnus-sync-lesync-install-topics) + target-topic-name) + (if (equal old-topic-name target-topic-name) + (gnus-message 12 "%s: %s is already in topic %s" + loc name target-topic-name) + ;; see `gnus-topic-move-group' + (when (and old-topic target-topic) + (setcdr old-topic (gnus-delete-first name (cdr old-topic))) + (gnus-message 5 "%s: removing %s from topic %s" + loc name old-topic-name)) + (unless target-topic + (when (y-or-n-p (format "Create missing topic %s?" + target-topic-name)) + (gnus-topic-create-topic target-topic-name nil) + (setq target-topic (assoc target-topic-name + gnus-topic-alist)))) + (if target-topic + (prog1 + (nconc target-topic (list name)) + (gnus-message 5 "%s: adding %s to topic %s" + loc name (car target-topic)) + (gnus-topic-enter-dribble)) + (gnus-error 2 "%s: LeSync group %s can't go in missing topic %s" + loc name target-topic-name))) + (when (and target-topic-offset target-topic) + (gnus-sync-fix-topic-group-position + name target-topic-name target-topic-offset))) + ;; install the subscription level + (when (gnus-sync-lesync-get-prop 'level name) + (setf (nth 1 master) (gnus-sync-lesync-get-prop 'level name))) + ;; install the read and other marks + (setf (nth 2 master) (gnus-sync-lesync-get-prop 'read name)) + (setf (nth 3 master) (gnus-sync-lesync-get-prop 'marks name)) + (gnus-sync-lesync-set-prop 'checksum + name + (gnus-sync-deep-print master)) + nil) + (gnus-error 1 "%s: invalid LeSync group %s" loc name) + 'invalid-name))) + +; (gnus-sync-lesync-delete-group (cdr gnus-sync-backend) "nntp+Gmane:gwene.org.slashdot") + +(defun gnus-sync-lesync-delete-group (url name) + "Returns NAME if successful deleting it from URL, an error otherwise." + (interactive "sEnter URL to set up: \rsEnter group name: ") + (let* ((u (concat (cadr gnus-sync-backend) "/" (url-hexify-string name))) + (del (gnus-sync-lesync-DELETE + u + `(,@(when (gnus-sync-lesync-get-prop 'rev name) + (list (cons "If-Match" + (gnus-sync-lesync-get-prop 'rev name)))))))) + (or (cdr (assq 'id del)) del))) + +;;; (gnus-sync-lesync-normalize-group-entry '((subscribe . ["invlist"]) (read . ["invlist"]) (topic-offset . 20) (topic . "news") (level . 6) (source . ["a" "b"]) (float-time . 1319671237.099285) (_rev . "10-edf5107f41e5e6f7f6629d1c0ee172f7") (_id . "nntp+news.net:alt.movies")) '((read-time 1319672156.486414) (subscribe-all nil))) + +(defun gnus-sync-lesync-normalize-group-entry (entry &optional passed-props) + (let (ret + marks + cell) + (setq entry (append passed-props entry)) + (while (setq cell (pop entry)) + (let ((k (car cell)) + (val (cdr cell))) + (cond + ((eq k 'read) + (push (cons k (gnus-sync-invlist2range val)) ret)) + ;; we ignore these parameters + ((member k '(_id subscribe-all _deleted_conflicts)) + nil) + ((eq k '_rev) + (push (cons 'rev val) ret)) + ((eq k 'source) + (push (cons 'source (append val nil)) ret)) + ((or (eq k 'float-time) + (eq k 'level) + (eq k 'topic) + (eq k 'topic-offset) + (eq k 'read-time)) + (push (cons k val) ret)) +;;; "How often have I said to you that when you have eliminated the +;;; impossible, whatever remains, however improbable, must be the +;;; truth?" --Sherlock Holmes + ;; everything remaining must be a mark + (t (push (cons k (gnus-sync-invlist2range val)) marks))))) + (cons (cons 'marks marks) ret))) + +(defun gnus-sync-save (&optional force) +"Save the Gnus sync data to the backend. +With a prefix, FORCE is set and all groups will be saved." + (interactive "P") (cond + ((and (listp gnus-sync-backend) + (eq (nth 0 gnus-sync-backend) 'lesync) + (stringp (nth 1 gnus-sync-backend))) + + ;; refresh the revisions if we're forcing the save + (when force + (mapc (lambda (entry) + (when (and (assq 'key entry) + (assq 'value entry)) + (gnus-sync-lesync-set-prop + 'rev + (cdr (assq 'key entry)) + (cdr (assq 'value entry))))) + ;; the revs view is key = name, value = rev + (cdr (assq 'rows (gnus-sync-lesync-GET + (concat (nth 1 gnus-sync-backend) + gnus-sync-lesync-design-prefix + "/_view/revs") + nil))))) + + (let* ((ftime (float-time)) + (url (nth 1 gnus-sync-backend)) + (entries + (mapcar (lambda (entry) + (gnus-sync-lesync-pre-save-group-entry + (cadr gnus-sync-backend) + entry + (cons 'float-time ftime))) + (gnus-sync-newsrc-loader-builder (not force)))) + ;; when there are no entries, there's nothing to save + (sync (if entries + (gnus-sync-lesync-POST + (concat url "/_bulk_docs") + '(("Content-Type" . "application/json")) + `((docs . ,(vconcat entries nil)))) + (gnus-message + 2 "gnus-sync-save: nothing to save to the LeSync backend") + nil))) + (mapcar (lambda (e) (gnus-sync-lesync-post-save-group-entry url e)) + sync))) ((stringp gnus-sync-backend) - (gnus-message 7 "gnus-sync: saving to backend %s" gnus-sync-backend) + (gnus-message 7 "gnus-sync-save: saving to backend %s" gnus-sync-backend) ;; populate gnus-sync-newsrc-loader from all but the first dummy ;; entry in gnus-newsrc-alist whose group matches any of the ;; gnus-sync-newsrc-groups ;; TODO: keep the old contents for groups we don't have! - (let ((gnus-sync-newsrc-loader - (loop for entry in (cdr gnus-newsrc-alist) - when (gnus-grep-in-list - (car entry) ;the group name - gnus-sync-newsrc-groups) - collect (cons (car entry) - (mapcar (lambda (offset) - (cons offset (nth offset entry))) - gnus-sync-newsrc-offsets))))) + (let ((gnus-sync-newsrc-loader (gnus-sync-newsrc-loader-builder))) (with-temp-file gnus-sync-backend (progn (let ((coding-system-for-write gnus-ding-file-coding-system) @@ -123,6 +749,7 @@ synchronized, I believe). Also see `gnus-variable-list'." (princ (format ";; -*- mode:emacs-lisp; coding: %s; -*-\n" gnus-ding-file-coding-system)) (princ ";; Gnus sync data v. 0.0.1\n") + ;; TODO: replace with `gnus-sync-deep-print' (let* ((print-quoted t) (print-readably t) (print-escape-multibyte nil) @@ -147,14 +774,14 @@ synchronized, I believe). Also see `gnus-variable-list'." (princ (symbol-name variable))))) (gnus-message 7 - "gnus-sync: stored variables %s and %d groups in %s" + "gnus-sync-save: stored variables %s and %d groups in %s" gnus-sync-global-vars (length gnus-sync-newsrc-loader) gnus-sync-backend) ;; Idea from Dan Christensen ;; Save the .eld file with extra line breaks. - (gnus-message 8 "gnus-sync: adding whitespace to %s" + (gnus-message 8 "gnus-sync-save: adding whitespace to %s" gnus-sync-backend) (save-excursion (goto-char (point-min)) @@ -166,49 +793,74 @@ synchronized, I believe). Also see `gnus-variable-list'." ;; the pass-through case: gnus-sync-backend is not a known choice (nil))) -(defun gnus-sync-read () -"Load the Gnus sync data from the backend." - (interactive) +(defun gnus-sync-read (&optional subscribe-all) + "Load the Gnus sync data from the backend. +With a prefix, SUBSCRIBE-ALL is set and unknown groups will be subscribed." + (interactive "P") (when gnus-sync-backend - (gnus-message 7 "gnus-sync: loading from backend %s" gnus-sync-backend) - (cond ((stringp gnus-sync-backend) - ;; read data here... - (if (or debug-on-error debug-on-quit) - (load gnus-sync-backend nil t) - (condition-case var - (load gnus-sync-backend nil t) - (error - (error "Error in %s: %s" gnus-sync-backend (cadr var))))) - (let ((valid-count 0) - invalid-groups) - (dolist (node gnus-sync-newsrc-loader) - (if (gnus-gethash (car node) gnus-newsrc-hashtb) - (progn - (incf valid-count) - (loop for store in (cdr node) - do (setf (nth (car store) - (assoc (car node) gnus-newsrc-alist)) - (cdr store)))) - (push (car node) invalid-groups))) - (gnus-message - 7 - "gnus-sync: loaded %d groups (out of %d) from %s" - valid-count (length gnus-sync-newsrc-loader) - gnus-sync-backend) - (when invalid-groups - (gnus-message - 7 - "gnus-sync: skipped %d groups (out of %d) from %s" - (length invalid-groups) - (length gnus-sync-newsrc-loader) - gnus-sync-backend) - (gnus-message 9 "gnus-sync: skipped groups: %s" - (mapconcat 'identity invalid-groups ", "))))) - (nil)) - ;; make the hashtable again because the newsrc-alist may have been modified - (when gnus-sync-newsrc-offsets - (gnus-message 9 "gnus-sync: remaking the newsrc hashtable") - (gnus-make-hashtable-from-newsrc-alist)))) + (gnus-message 7 "gnus-sync-read: loading from backend %s" gnus-sync-backend) + (cond + ((and (listp gnus-sync-backend) + (eq (nth 0 gnus-sync-backend) 'lesync) + (stringp (nth 1 gnus-sync-backend))) + (let ((errored nil) + name ftime) + (mapc (lambda (entry) + (setq name (cdr (assq 'id entry))) + ;; set ftime the FIRST time through this loop, that + ;; way it reflects the time we FINISHED reading + (unless ftime (setq ftime (float-time))) + + (unless errored + (setq errored + (when (equal name + (gnus-sync-lesync-read-group-entry + (nth 1 gnus-sync-backend) + name + (cdr (assq 'value entry)) + `(read-time ,ftime) + `(subscribe-all ,subscribe-all))) + (gnus-sync-lesync-install-group-entry + (cdr (assq 'id entry))))))) + (gnus-sync-lesync-groups-builder (nth 1 gnus-sync-backend))))) + + ((stringp gnus-sync-backend) + ;; read data here... + (if (or debug-on-error debug-on-quit) + (load gnus-sync-backend nil t) + (condition-case var + (load gnus-sync-backend nil t) + (error + (error "Error in %s: %s" gnus-sync-backend (cadr var))))) + (let ((valid-count 0) + invalid-groups) + (dolist (node gnus-sync-newsrc-loader) + (if (gnus-gethash (car node) gnus-newsrc-hashtb) + (progn + (incf valid-count) + (loop for store in (cdr node) + do (setf (nth (car store) + (assoc (car node) gnus-newsrc-alist)) + (cdr store)))) + (push (car node) invalid-groups))) + (gnus-message + 7 + "gnus-sync-read: loaded %d groups (out of %d) from %s" + valid-count (length gnus-sync-newsrc-loader) + gnus-sync-backend) + (when invalid-groups + (gnus-message + 7 + "gnus-sync-read: skipped %d groups (out of %d) from %s" + (length invalid-groups) + (length gnus-sync-newsrc-loader) + gnus-sync-backend) + (gnus-message 9 "gnus-sync-read: skipped groups: %s" + (mapconcat 'identity invalid-groups ", "))))) + (nil)) + + (gnus-message 9 "gnus-sync-read: remaking the newsrc hashtable") + (gnus-make-hashtable-from-newsrc-alist))) ;;;###autoload (defun gnus-sync-initialize () @@ -228,14 +880,11 @@ synchronized, I believe). Also see `gnus-variable-list'." (defun gnus-sync-unload-hook () "Uninstall the sync hooks." (interactive) - (remove-hook 'gnus-get-new-news-hook 'gnus-sync-read) - (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save) - (remove-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read)) + (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save)) (add-hook 'gnus-sync-unload-hook 'gnus-sync-unload-hook) -;; this is harmless by default, until the gnus-sync-backend is set -(gnus-sync-initialize) +(when gnus-sync-backend (gnus-sync-initialize)) (provide 'gnus-sync) diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index 0c6c2d36f83..3567f37aeb3 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -145,13 +145,6 @@ See Info node `(gnus)Formatting Variables'." (setq alist (cdr alist))) out)) -(defun gnus-group-parent-topic (group) - "Return the topic GROUP is member of by looking at the group buffer." - (with-current-buffer gnus-group-buffer - (if (gnus-group-goto-group group) - (gnus-current-topic) - (gnus-group-topic group)))) - (defun gnus-topic-goto-topic (topic) (when topic (gnus-goto-char (text-property-any (point-min) (point-max) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index da899f4bf10..26178afa864 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -169,15 +169,6 @@ This is a compatibility function for different Emacsen." `(delete-region (point-at-bol) (progn (forward-line ,(or n 1)) (point)))) -(defun gnus-byte-code (func) - "Return a form that can be `eval'ed based on FUNC." - (let ((fval (indirect-function func))) - (if (byte-code-function-p fval) - (let ((flist (append fval nil))) - (setcar flist 'byte-code) - flist) - (cons 'progn (cddr fval))))) - (defun gnus-extract-address-components (from) "Extract address components from a From header. Given an RFC-822 address FROM, extract full name and canonical address. @@ -216,16 +207,6 @@ is slower." (match-end 0))))) (list (if (string= name "") nil name) (or address from)))) -(defun gnus-extract-address-component-name (from) - "Extract name from a From header. -Uses `gnus-extract-address-components'." - (nth 0 (gnus-extract-address-components from))) - -(defun gnus-extract-address-component-email (from) - "Extract e-mail address from a From header. -Uses `gnus-extract-address-components'." - (nth 1 (gnus-extract-address-components from))) - (declare-function message-fetch-field "message" (header &optional not-all)) (defun gnus-fetch-field (field) @@ -664,10 +645,6 @@ If N, return the Nth ancestor instead." ;; should be gnus-characterp, but this can't be called in XEmacs anyway (cons (and (numberp event) event) event))) -(defun gnus-sortable-date (date) - "Make string suitable for sorting from DATE." - (gnus-time-iso8601 (date-to-time date))) - (defun gnus-copy-file (file &optional to) "Copy FILE to TO." (interactive @@ -852,28 +829,6 @@ If there's no subdirectory, delete DIRECTORY as well." (unless dir (delete-directory directory))))) -;; The following two functions are used in gnus-registry. -;; They were contributed by Andreas Fuchs . -(defun gnus-alist-to-hashtable (alist) - "Build a hashtable from the values in ALIST." - (let ((ht (make-hash-table - :size 4096 - :test 'equal))) - (mapc - (lambda (kv-pair) - (puthash (car kv-pair) (cdr kv-pair) ht)) - alist) - ht)) - -(defun gnus-hashtable-to-alist (hash) - "Build an alist from the values in HASH." - (let ((list nil)) - (maphash - (lambda (key value) - (setq list (cons (cons key value) list))) - hash) - list)) - (defun gnus-strip-whitespace (string) "Return STRING stripped of all whitespace." (while (string-match "[\r\n\t ]+" string) @@ -1250,13 +1205,6 @@ This function saves the current buffer." (with-current-buffer gnus-group-buffer (eq major-mode 'gnus-group-mode)))) -(defun gnus-process-live-p (process) - "Returns non-nil if PROCESS is alive. -A process is considered alive if its status is `run', `open', -`listen', `connect' or `stop'." - (memq (process-status process) - '(run open listen connect stop))) - (defun gnus-remove-if (predicate sequence &optional hash-table-p) "Return a copy of SEQUENCE with all items satisfying PREDICATE removed. SEQUENCE should be a list, a vector, or a string. Returns always a list. @@ -1927,6 +1875,19 @@ Sizes are in pixels." image))) image))) +(defun gnus-recursive-directory-files (dir) + "Return all regular files below DIR." + (let (files) + (dolist (file (directory-files dir t)) + (when (and (not (member (file-name-nondirectory file) '("." ".."))) + (file-readable-p file)) + (cond + ((file-regular-p file) + (push file files)) + ((file-directory-p file) + (setq files (append (gnus-recursive-directory-files file) files)))))) + files)) + (defun gnus-list-memq-of-list (elements list) "Return non-nil if any of the members of ELEMENTS are in LIST." (let ((found nil)) diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index 717b6162a1b..1ca6d0e10ed 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -1615,16 +1615,6 @@ Gnus might fail to display all of it.") gnus-shell-command-separator " sh"))))) state)) -;; Returns the name of what the shar file is going to unpack. -(defun gnus-uu-find-name-in-shar () - (let ((oldpoint (point)) - res) - (goto-char (point-min)) - (when (re-search-forward gnus-uu-shar-name-marker nil t) - (setq res (buffer-substring (match-beginning 1) (match-end 1)))) - (goto-char oldpoint) - res)) - ;; `gnus-uu-choose-action' chooses what action to perform given the name ;; and `gnus-uu-file-action-list'. Returns either nil if no action is ;; found, or the name of the command to run if such a rule is found. diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index bba56e31d9b..e48fa385284 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1009,10 +1009,11 @@ be set in `.emacs' instead." (purp "#9999cc" "#666699") (no "#ff0000" "#ffff00") (neutral "#b4b4b4" "#878787") + (ma "#2020e0" "#8080ff") (september "#bf9900" "#ffcc00")) "Color alist used for the Gnus logo.") -(defcustom gnus-logo-color-style 'no +(defcustom gnus-logo-color-style 'ma "*Color styles used for the Gnus logo." :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem))) gnus-logo-color-alist)) @@ -2803,6 +2804,8 @@ gnus-registry.el will populate this if it's loaded.") ("gnus-kill" gnus-kill gnus-apply-kill-file-internal gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author gnus-execute gnus-expunge gnus-batch-kill gnus-batch-score) + ("gnus-registry" gnus-try-warping-via-registry + gnus-registry-handle-action) ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers gnus-cache-possibly-remove-articles gnus-cache-request-article gnus-cache-retrieve-headers gnus-cache-possibly-alter-active @@ -3409,15 +3412,6 @@ that that variable is buffer-local to the summary buffers." (t ;Has positive number (eq (gnus-request-type group article) 'news)))) ;use it. -;; Returns a list of writable groups. -(defun gnus-writable-groups () - (let ((alist gnus-newsrc-alist) - groups group) - (while (setq group (car (pop alist))) - (unless (gnus-group-read-only-p group) - (push group groups))) - (nreverse groups))) - ;; Check whether to use long file names. (defun gnus-use-long-file-name (symbol) ;; The variable has to be set... @@ -3693,21 +3687,10 @@ server is native)." group (concat (gnus-method-to-server-name method) ":" group))) -(defun gnus-group-guess-prefixed-name (group) - "Guess the whole name from GROUP and METHOD." - (gnus-group-prefixed-name group (gnus-find-method-for-group - group))) - (defun gnus-group-full-name (group method) "Return the full name from GROUP and METHOD, even if the method is native." (gnus-group-prefixed-name group method t)) -(defun gnus-group-guess-full-name (group) - "Guess the full name from GROUP, even if the method is native." - (if (gnus-group-prefixed-p group) - group - (gnus-group-full-name group (gnus-find-method-for-group group)))) - (defun gnus-group-guess-full-name-from-command-method (group) "Guess the full name from GROUP, even if the method is native." (if (gnus-group-prefixed-p group) diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index 2cd9233db61..ad66fecc427 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -721,12 +721,6 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) ;; Return whether we moved successfully or not. to))) -(defun mail-source-movemail-and-remove (from to) - "Move FROM to TO using movemail, then remove FROM if empty." - (or (not (mail-source-movemail from to)) - (not (zerop (nth 7 (file-attributes from)))) - (delete-file from))) - (defun mail-source-fetch-with-program (program) (eq 0 (call-process shell-file-name nil nil nil shell-command-switch program))) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 4ce9279114b..ecc797314c4 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1332,11 +1332,11 @@ If nil, you might be asked to input the charset." :type 'symbol) (defcustom message-dont-reply-to-names - (and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names) + (and (boundp 'mail-dont-reply-to-names) mail-dont-reply-to-names) "*Addresses to prune when doing wide replies. This can be a regexp or a list of regexps. Also, a value of nil means exclude your own user name only." - :version "21.1" + :version "24.2" :group 'message :link '(custom-manual "(message)Wide Reply") :type '(choice (const :tag "Yourself" nil) @@ -1933,7 +1933,7 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." (autoload 'nndraft-request-associate-buffer "nndraft") (autoload 'nndraft-request-expire-articles "nndraft") (autoload 'nnvirtual-find-group-art "nnvirtual") -(autoload 'rmail-dont-reply-to "mail-utils") +(autoload 'mail-dont-reply-to "mail-utils") (autoload 'rmail-msg-is-pruned "rmail") (autoload 'rmail-output "rmailout") @@ -3057,66 +3057,79 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (defun message-goto-to () "Move point to the To header." (interactive) + (push-mark) (message-position-on-field "To")) (defun message-goto-from () "Move point to the From header." (interactive) + (push-mark) (message-position-on-field "From")) (defun message-goto-subject () "Move point to the Subject header." (interactive) + (push-mark) (message-position-on-field "Subject")) (defun message-goto-cc () "Move point to the Cc header." (interactive) + (push-mark) (message-position-on-field "Cc" "To")) (defun message-goto-bcc () "Move point to the Bcc header." (interactive) + (push-mark) (message-position-on-field "Bcc" "Cc" "To")) (defun message-goto-fcc () "Move point to the Fcc header." (interactive) + (push-mark) (message-position-on-field "Fcc" "To" "Newsgroups")) (defun message-goto-reply-to () "Move point to the Reply-To header." (interactive) + (push-mark) (message-position-on-field "Reply-To" "Subject")) (defun message-goto-newsgroups () "Move point to the Newsgroups header." (interactive) + (push-mark) (message-position-on-field "Newsgroups")) (defun message-goto-distribution () "Move point to the Distribution header." (interactive) + (push-mark) (message-position-on-field "Distribution")) (defun message-goto-followup-to () "Move point to the Followup-To header." (interactive) + (push-mark) (message-position-on-field "Followup-To" "Newsgroups")) (defun message-goto-mail-followup-to () "Move point to the Mail-Followup-To header." (interactive) + (push-mark) (message-position-on-field "Mail-Followup-To" "To")) (defun message-goto-keywords () "Move point to the Keywords header." (interactive) + (push-mark) (message-position-on-field "Keywords" "Subject")) (defun message-goto-summary () "Move point to the Summary header." (interactive) + (push-mark) (message-position-on-field "Summary" "Subject")) (eval-when-compile @@ -3137,6 +3150,7 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (when (and (message-called-interactively-p 'any) (looking-at "[ \t]*\n")) (expand-abbrev)) + (push-mark) (goto-char (point-min)) (or (search-forward (concat "\n" mail-header-separator "\n") nil t) (search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t))) @@ -3157,6 +3171,7 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." If there is no signature in the article, go to the end and return nil." (interactive) + (push-mark) (goto-char (point-min)) (if (re-search-forward message-signature-separator nil t) (forward-line 1) @@ -3796,7 +3811,7 @@ prefix, and don't delete any headers." (save-current-buffer (dolist (buffer (buffer-list t)) (set-buffer buffer) - (when (and (eq major-mode 'message-mode) + (when (and (derived-mode-p 'message-mode) (null message-sent-message-via)) (push (buffer-name buffer) buffers)))) (nreverse buffers))) @@ -3996,28 +4011,6 @@ This function strips off the signature from the original message." (forward-char -1) nil)))) -(defun message-remove-signature () - "Remove the signature from the text between point and mark. -The text will also be indented the normal way." - (save-excursion - (let ((start (point)) - mark) - (if (not (re-search-forward message-signature-separator (mark t) t)) - ;; No signature here, so we just indent the cited text. - (message-indent-citation) - ;; Find the last non-empty line. - (forward-line -1) - (while (looking-at "[ \t]*$") - (forward-line -1)) - (forward-line 1) - (setq mark (set-marker (make-marker) (point))) - (goto-char start) - (message-indent-citation) - ;; Enable undoing the deletion. - (undo-boundary) - (delete-region mark (mark t)) - (set-marker mark nil))))) - ;;; @@ -4479,8 +4472,9 @@ This function could be useful in `message-setup-hook'." (end-of-line) (insert (format " (%d/%d)" n total)) (widen) - (funcall (or message-send-mail-real-function - message-send-mail-function))) + (if message-send-mail-real-function + (funcall message-send-mail-real-function) + (message-multi-smtp-send-mail))) (setq n (+ n 1)) (setq p (pop plist)) (erase-buffer))) @@ -4634,8 +4628,9 @@ If you always want Gnus to send messages in one piece, set "))) (progn (message "Sending via mail...") - (funcall (or message-send-mail-real-function - message-send-mail-function))) + (if message-send-mail-real-function + (funcall message-send-mail-real-function) + (message-multi-smtp-send-mail))) (message-send-mail-partially)) (setq options message-options)) (kill-buffer tembuf)) @@ -4644,6 +4639,28 @@ If you always want Gnus to send messages in one piece, set (push 'mail message-sent-message-via))) (defvar sendmail-program) +(defvar smtpmail-smtp-user) + +(defun message-multi-smtp-send-mail () + "Send the current buffer to `message-send-mail-function'. +Or, if there's a header that specifies a different method, use +that instead." + (let ((method (message-field-value "X-Message-SMTP-Method"))) + (if (not method) + (funcall message-send-mail-function) + (message-remove-header "X-Message-SMTP-Method") + (setq method (split-string method)) + (cond + ((equal (car method) "sendmail") + (message-send-mail-with-sendmail)) + ((equal (car method) "smtp") + (require 'smtpmail) + (let ((smtpmail-smtp-server (nth 1 method)) + (smtpmail-smtp-service (nth 2 method)) + (smtpmail-smtp-user (or (nth 3 method) smtpmail-smtp-user))) + (message-smtpmail-send-it))) + (t + (error "Unknown method %s" method)))))) (defun message-send-mail-with-sendmail () "Send off the prepared buffer with sendmail." @@ -5766,12 +5783,6 @@ give as trustworthy answer as possible." (concat system-name ".i-did-not-set--mail-host-address--so-tickle-me"))))) -(defun message-make-host-name () - "Return the name of the host." - (let ((fqdn (message-make-fqdn))) - (string-match "^[^.]+\\." fqdn) - (substring fqdn 0 (1- (match-end 0))))) - (defun message-make-domain () "Return the domain name." (or mail-host-address @@ -6095,13 +6106,6 @@ Headers already prepared in the buffer are not modified." (forward-char 1))) (skip-chars-forward " \t\n"))) -(defun message-fill-address (header value) - (insert (capitalize (symbol-name header)) - ": " - (if (consp value) (car value) value) - "\n") - (message-fill-field-address)) - (defun message-split-line () "Split current line, moving portion beyond point vertically down. If the current line has `message-yank-prefix', insert it on the new line." @@ -6763,9 +6767,9 @@ want to get rid of this query permanently."))) ;; Squeeze whitespace. (while (string-match "[ \t][ \t]+" recipients) (setq recipients (replace-match " " t t recipients))) - ;; Remove addresses that match `rmail-dont-reply-to-names'. - (let ((rmail-dont-reply-to-names (message-dont-reply-to-names))) - (setq recipients (rmail-dont-reply-to recipients))) + ;; Remove addresses that match `mail-dont-reply-to-names'. + (let ((mail-dont-reply-to-names (message-dont-reply-to-names))) + (setq recipients (mail-dont-reply-to recipients))) ;; Perhaps "Mail-Copies-To: never" removed the only address? (if (string-equal recipients "") (setq recipients author)) @@ -7530,7 +7534,7 @@ is for the internal use." (message "Resending message to %s..." address) (save-excursion (let ((cur (current-buffer)) - beg) + gcc beg) ;; We first set up a normal mail buffer. (unless (message-mail-user-agent) (set-buffer (get-buffer-create " *message resend*")) @@ -7543,6 +7547,8 @@ is for the internal use." ;; Insert our usual headers. (message-generate-headers '(From Date To Message-ID)) (message-narrow-to-headers) + (when (setq gcc (mail-fetch-field "gcc" nil t)) + (message-remove-header "gcc")) ;; Remove X-Draft-From header etc. (message-remove-header message-ignored-mail-headers t) ;; Rename them all to "Resent-*". @@ -7584,6 +7590,10 @@ is for the internal use." message-generate-hashcash rfc2047-encode-encoded-words) (message-send-mail)) + (when gcc + (message-goto-eoh) + (insert "Gcc: " gcc "\n")) + (run-hooks 'message-sent-hook) (kill-buffer (current-buffer))) (message "Resending message to %s...done" address))) diff --git a/lisp/gnus/mm-archive.el b/lisp/gnus/mm-archive.el new file mode 100644 index 00000000000..7cfa4659fd9 --- /dev/null +++ b/lisp/gnus/mm-archive.el @@ -0,0 +1,107 @@ +;;; mm-archive.el --- Functions for parsing archive files as MIME + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen +;; 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 . + +;;; Commentary: + +;;; Code: + +(require 'mm-decode) +(eval-when-compile + (autoload 'gnus-recursive-directory-files "gnus-util") + (autoload 'mailcap-extension-to-mime "mailcap")) + +(defvar mm-archive-decoders + '(("application/ms-tnef" t "tnef" "-f" "-" "-C") + ("application/zip" nil "unzip" "-j" "-x" "%f" "-d") + ("application/x-gtar-compressed" nil "tar" "xzf" "-" "-C") + ("application/x-tar" nil "tar" "xf" "-" "-C"))) + +(defun mm-archive-decoders () mm-archive-decoders) + +(defun mm-dissect-archive (handle) + (let ((decoder (cddr (assoc (car (mm-handle-type handle)) + mm-archive-decoders))) + (dir (mm-make-temp-file + (expand-file-name "emm." mm-tmp-directory) 'dir))) + (set-file-modes dir #o700) + (unwind-protect + (progn + (mm-with-unibyte-buffer + (mm-insert-part handle) + (if (member "%f" decoder) + (let ((file (expand-file-name "mail.zip" dir))) + (write-region (point-min) (point-max) file nil 'silent) + (setq decoder (copy-sequence decoder)) + (setcar (member "%f" decoder) file) + (apply 'call-process (car decoder) nil nil nil + (append (cdr decoder) (list dir))) + (delete-file file)) + (apply 'call-process-region (point-min) (point-max) (car decoder) + nil (get-buffer-create "*tnef*") + nil (append (cdr decoder) (list dir))))) + `("multipart/mixed" + ,handle + ,@(mm-archive-list-files (gnus-recursive-directory-files dir)))) + (delete-directory dir t)))) + +(defun mm-archive-list-files (files) + (let ((handles nil) + type disposition) + (dolist (file files) + (with-temp-buffer + (when (string-match "\\.\\([^.]+\\)$" file) + (setq type (mailcap-extension-to-mime (match-string 1 file)))) + (unless type + (setq type "application/octet-stream")) + (setq disposition + (if (string-match "^image/\\|^text/" type) + "inline" + "attachment")) + (insert (format "Content-type: %s\n" type)) + (insert "Content-Transfer-Encoding: 8bit\n\n") + (insert-file-contents file) + (push + (mm-make-handle (mm-copy-to-buffer) + (list type) + '8bit nil + `(,disposition (filename . ,file)) + nil nil nil) + handles))) + handles)) + +(defun mm-archive-dissect-and-inline (handle) + (let ((start (point-marker))) + (save-restriction + (narrow-to-region (point) (point)) + (dolist (handle (cddr (mm-dissect-archive handle))) + (goto-char (point-max)) + (mm-display-inline handle)) + (goto-char (point-max)) + (mm-handle-set-undisplayer + handle + `(lambda () + (let ((inhibit-read-only t) + (end ,(point-marker))) + (remove-images ,start end) + (delete-region ,start end))))))) + +(provide 'mm-archive) + +;; mm-archive.el ends here diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 4a6da2d437c..7982b745d66 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -41,6 +41,10 @@ (autoload 'mm-extern-cache-contents "mm-extern") (autoload 'mm-insert-inline "mm-view") +(autoload 'mm-archive-decoders "mm-archive") +(autoload 'mm-archive-dissect-and-inline "mm-archive") +(autoload 'mm-dissect-archive "mm-archive") + (defvar gnus-current-window-configuration) (add-hook 'gnus-exit-gnus-hook 'mm-destroy-postponed-undisplay-list) @@ -248,6 +252,8 @@ before the external MIME handler is invoked." ("message/partial" mm-inline-partial identity) ("message/external-body" mm-inline-external-body identity) ("text/.*" mm-inline-text identity) + ("application/x-.?tar\\(-.*\\)?" mm-archive-dissect-and-inline identity) + ("application/zip" mm-archive-dissect-and-inline identity) ("audio/wav" mm-inline-audio (lambda (handle) (and (or (featurep 'nas-sound) (featurep 'native-sound)) @@ -275,7 +281,8 @@ before the external MIME handler is invoked." (ignore-errors (if (fboundp 'create-image) (create-image (buffer-string) 'imagemagick 'data-p) - (mm-create-image-xemacs (mm-handle-media-subtype handle)))))) + (mm-create-image-xemacs + (mm-handle-media-subtype handle)))))) (when image (setcar (cdr handle) (list "image/imagemagick")) (mm-image-fit-p handle))))))) @@ -297,6 +304,9 @@ before the external MIME handler is invoked." "application/pgp-signature" "application/x-pkcs7-signature" "application/pkcs7-signature" "application/x-pkcs7-mime" "application/pkcs7-mime" + "application/x-gtar-compressed" + "application/x-tar" + "application/zip" ;; Mutt still uses this even though it has already been withdrawn. "application/pgp") "List of media types that are to be displayed inline. @@ -448,6 +458,7 @@ If not set, `default-directory' will be used." (defvar mm-last-shell-command "") (defvar mm-content-id-alist nil) (defvar mm-postponed-undisplay-list nil) +(defvar mm-inhibit-auto-detect-attachment nil) ;; According to RFC2046, in particular, in a digest, the default ;; Content-Type value for a body part is changed from "text/plain" to @@ -567,7 +578,9 @@ Postpone undisplaying of viewers for types in (autoload 'message-fetch-field "message") (defun mm-dissect-buffer (&optional no-strict-mime loose-mime from) - "Dissect the current buffer and return a list of MIME handles." + "Dissect the current buffer and return a list of MIME handles. +If NO-STRICT-MIME, don't require the message to have a +MIME-Version header before proceeding." (save-excursion (let (ct ctl type subtype cte cd description id result) (save-restriction @@ -653,8 +666,26 @@ Postpone undisplaying of viewers for types in (if (equal "text/plain" (car ctl)) (assoc 'format ctl) t)) - (mm-make-handle - (mm-copy-to-buffer) ctl cte nil cdl description nil id))) + ;; Guess what the type of application/octet-stream parts should + ;; really be. + (let ((filename (cdr (assq 'filename (cdr cdl))))) + (when (and (not mm-inhibit-auto-detect-attachment) + (equal (car ctl) "application/octet-stream") + filename + (string-match "\\.\\([^.]+\\)$" filename)) + (let ((new-type (mailcap-extension-to-mime (match-string 1 filename)))) + (when new-type + (setcar ctl new-type))))) + (let ((handle + (mm-make-handle + (mm-copy-to-buffer) ctl cte nil cdl description nil id)) + (decoder (assoc (car ctl) (mm-archive-decoders)))) + (if (and decoder + ;; Do automatic decoding + (cadr decoder) + (executable-find (caddr decoder))) + (mm-dissect-archive handle) + handle)))) (defun mm-dissect-multipart (ctl from) (goto-char (point-min)) @@ -665,7 +696,9 @@ Postpone undisplaying of viewers for types in (goto-char (point-max)) (if (re-search-backward close-delimiter nil t) (match-beginning 0) - (point-max))))) + (point-max)))) + (mm-inhibit-auto-detect-attachment + (equal (car ctl) "multipart/encrypted"))) (setq boundary (concat (regexp-quote boundary) "[ \t]*$")) (while (and (< (point) end) (re-search-forward boundary end t)) (goto-char (match-beginning 0)) @@ -736,23 +769,29 @@ external if displayed external." (mail-content-type-get (mm-handle-type handle) 'name) "")) - (external mm-enable-external)) - (if (and (mm-inlinable-p ehandle) - (mm-inlined-p ehandle)) - (progn - (forward-line 1) - (mm-display-inline handle) - 'inline) - (when (or method - (not no-default)) - (if (and (not method) - (equal "text" (car (split-string type "/")))) - (progn - (forward-line 1) - (mm-insert-inline handle (mm-get-part handle)) - 'inline) - (setq external - (and method ;; If nil, we always use "save". + (external mm-enable-external) + (decoder (assoc (car (mm-handle-type handle)) + (mm-archive-decoders)))) + (cond + ((and decoder + (executable-find (caddr decoder))) + (mm-archive-dissect-and-inline handle) + 'inline) + ((and (mm-inlinable-p ehandle) + (mm-inlined-p ehandle)) + (forward-line 1) + (mm-display-inline handle) + 'inline) + ((or method + (not no-default)) + (if (and (not method) + (equal "text" (car (split-string type "/")))) + (progn + (forward-line 1) + (mm-insert-inline handle (mm-get-part handle)) + 'inline) + (setq external + (and method ;; If nil, we always use "save". (stringp method) ;; 'mailcap-save-binary-file (or (eq mm-enable-external t) (and (eq mm-enable-external 'ask) @@ -765,12 +804,12 @@ external if displayed external." (concat " \"" (format method filename) "\"") "") - "? ")))))) - (if external - (mm-display-external - handle (or method 'mailcap-save-binary-file)) + "? ")))))) + (if external (mm-display-external - handle 'mailcap-save-binary-file))))))))) + handle (or method 'mailcap-save-binary-file)) + (mm-display-external + handle 'mailcap-save-binary-file))))))))) (declare-function gnus-configure-windows "gnus-win" (setting &optional force)) (defvar mailcap-mime-extensions) ; mailcap-mime-info autoloads @@ -918,46 +957,38 @@ external if displayed external." shell-command-switch command) (set-process-sentinel (get-buffer-process buffer) - (lexical-let ;; Don't use `let'. - ;; Function used to remove temp file and directory. - ((fn `(lambda nil - ;; Don't use `ignore-errors'. - (condition-case nil - (delete-file ,file) - (error)) - (condition-case nil - (delete-directory - ,(file-name-directory file)) - (error)))) - ;; Form uses to kill the process buffer and - ;; remove the undisplayer. - (fm `(progn - (kill-buffer ,buffer) - ,(macroexpand - (list 'mm-handle-set-undisplayer - (list 'quote handle) - nil)))) - ;; Message to be issued when the process exits. - (done (format "Displaying %s...done" command)) - ;; In particular, the timer object (which is - ;; a vector in Emacs but is a list in XEmacs) - ;; requires that it is lexically scoped. - (timer (run-at-time 30.0 nil 'ignore))) - (if (featurep 'xemacs) - (lambda (process state) - (when (eq 'exit (process-status process)) - (if (memq timer itimer-list) - (set-itimer-function timer fn) - (funcall fn)) - (ignore-errors (eval fm)) - (message "%s" done))) - (lambda (process state) - (when (eq 'exit (process-status process)) - (if (memq timer timer-list) - (timer-set-function timer fn) - (funcall fn)) - (ignore-errors (eval fm)) - (message "%s" done))))))) + (lexical-let ((outbuf outbuf) + (file file) + (buffer buffer) + (command command) + (handle handle)) + (run-at-time + 30.0 nil + (lambda () + (ignore-errors + (delete-file file)) + (ignore-errors + (delete-directory (file-name-directory file))))) + (lambda (process state) + (when (eq (process-status process) 'exit) + (condition-case nil + (delete-file file) + (error)) + (condition-case nil + (delete-directory (file-name-directory file)) + (error)) + (when (buffer-live-p outbuf) + (with-current-buffer outbuf + (let ((buffer-read-only nil) + (point (point))) + (forward-line 2) + (mm-insert-inline + handle (with-current-buffer buffer + (buffer-string))) + (goto-char point)))) + (when (buffer-live-p buffer) + (kill-buffer buffer))) + (message "Displaying %s...done" command))))) (mm-handle-set-external-undisplayer handle (cons file buffer))) (message "Displaying %s..." command)) @@ -1741,7 +1772,8 @@ If RECURSIVE, search recursively." (insert (prog1 (if (and charset (setq charset - (mm-charset-to-coding-system charset)) + (mm-charset-to-coding-system charset + nil t)) (not (eq charset 'ascii))) (mm-decode-coding-string (buffer-string) charset) (mm-string-as-multibyte (buffer-string))) @@ -1762,6 +1794,8 @@ If RECURSIVE, search recursively." (while (search-forward "" nil t) (replace-match "" t t)) (libxml-parse-html-region (point-min) (point-max)))) + (unless (bobp) + (insert "\n")) (mm-handle-set-undisplayer handle `(lambda () @@ -1778,4 +1812,8 @@ If RECURSIVE, search recursively." (provide 'mm-decode) +;; Local Variables: +;; coding: iso-8859-1 +;; End: + ;;; mm-decode.el ends here diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index a0322b00cf3..109bd265faa 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -416,69 +416,6 @@ spaces. Die Die Die." (autoload 'mml-compute-boundary "mml") -(defun mm-url-encode-multipart-form-data (pairs &optional boundary) - "Return PAIRS encoded in multipart/form-data." - ;; RFC1867 - - ;; Get a good boundary - (unless boundary - (setq boundary (mml-compute-boundary '()))) - - (concat - - ;; Start with the boundary - "--" boundary "\r\n" - - ;; Create name value pairs - (mapconcat - 'identity - ;; Delete any returned items that are empty - (delq nil - (mapcar (lambda (data) - (when (car data) - ;; For each pair - (concat - - ;; Encode the name - "Content-Disposition: form-data; name=\"" - (car data) "\"\r\n" - "Content-Type: text/plain; charset=utf-8\r\n" - "Content-Transfer-Encoding: binary\r\n\r\n" - - (cond ((stringp (cdr data)) - (cdr data)) - ((integerp (cdr data)) - (int-to-string (cdr data)))) - - "\r\n"))) - pairs)) - ;; use the boundary as a separator - (concat "--" boundary "\r\n")) - - ;; put a boundary at the end. - "--" boundary "--\r\n")) - -(defun mm-url-fetch-form (url pairs) - "Fetch a form from URL with PAIRS as the data using the POST method." - (mm-url-load-url) - (let ((url-request-data (mm-url-encode-www-form-urlencoded pairs)) - (url-request-method "POST") - (url-request-extra-headers - '(("Content-type" . "application/x-www-form-urlencoded")))) - (url-insert-file-contents url) - (setq buffer-file-name nil)) - t) - -(defun mm-url-fetch-simple (url content) - (mm-url-load-url) - (let ((url-request-data content) - (url-request-method "POST") - (url-request-extra-headers - '(("Content-type" . "application/x-www-form-urlencoded")))) - (url-insert-file-contents url) - (setq buffer-file-name nil)) - t) - (defun mm-url-remove-markup () "Remove all HTML markup, leaving just plain text." (goto-char (point-min)) diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index e9119284a04..4fb5ea704bd 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -1592,7 +1592,7 @@ gzip, bzip2, etc. are allowed." (unless filename (setq filename buffer-file-name)) (save-excursion - (let ((decomp (unless ;; No worth to examine charset of tar files. + (let ((decomp (unless ;; Not worth it to examine charset of tar files. (and filename (string-match "\\.\\(?:tar\\.[^.]+\\|tbz\\|tgz\\)\\'" diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 1d7b174d5a4..d3e1014fcd4 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -496,9 +496,6 @@ (defun mm-inline-audio (handle) (message "Not implemented")) -(defun mm-view-sound-file () - (message "Not implemented")) - (defun mm-w3-prepare-buffer () (require 'w3) (let ((url-standalone-mode t) diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index a9901d7163e..cc1aedf1b97 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -463,8 +463,10 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (defvar mml-multipart-number 0) (defvar mml-inhibit-compute-boundary nil) -(defun mml-generate-mime () - "Generate a MIME message based on the current MML document." +(defun mml-generate-mime (&optional multipart-type) + "Generate a MIME message based on the current MML document. +MULTIPART-TYPE defaults to \"mixed\", but can also +be \"related\" or \"alternate\"." (let ((cont (mml-parse)) (mml-multipart-number mml-multipart-number) (options message-options)) @@ -476,8 +478,9 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (if (and (consp (car cont)) (= (length cont) 1)) (mml-generate-mime-1 (car cont)) - (mml-generate-mime-1 (nconc (list 'multipart '(type . "mixed")) - cont))) + (mml-generate-mime-1 + (nconc (list 'multipart (cons 'type (or multipart-type "mixed"))) + cont))) (setq options message-options) (buffer-string)) (setq message-options options))))) diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index 89961dc7dad..e93bd7f43e0 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -2,7 +2,7 @@ ;; Copyright (C) 1995-2012 Free Software Foundation, Inc. -;; Author: Simon Josefsson (adding MARKS) +;; Author: Simon Josefsson ;; ShengHuo Zhu (adding NOV) ;; Scott Byer ;; Lars Magne Ingebrigtsen @@ -53,10 +53,6 @@ "The name of the nnfolder NOV directory. If nil, `nnfolder-directory' is used.") -(defvoo nnfolder-marks-directory nil - "The name of the nnfolder MARKS directory. -If nil, `nnfolder-directory' is used.") - (defvoo nnfolder-active-file (nnheader-concat nnfolder-directory "active") "The name of the active file.") @@ -134,21 +130,6 @@ all. This may very well take some time.") (defvar nnfolder-nov-buffer-file-name nil) -(defvoo nnfolder-marks-is-evil nil - "If non-nil, Gnus will never generate and use marks file for mail groups. -Using marks files makes it possible to backup and restore mail groups -separately from `.newsrc.eld'. If you have, for some reason, set -this to t, and want to set it to nil again, you should always remove -the corresponding marks file (usually base nnfolder file name -concatenated with `.mrk', but see `nnfolder-marks-file-suffix') for -the group. Then the marks file will be regenerated properly by Gnus.") - -(defvoo nnfolder-marks nil) - -(defvoo nnfolder-marks-file-suffix ".mrk") - -(defvar nnfolder-marks-modtime (gnus-make-hashtable)) - ;;; Interface functions @@ -231,9 +212,6 @@ the group. Then the marks file will be regenerated properly by Gnus.") (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) (and nnfolder-nov-directory (gnus-make-directory nnfolder-nov-directory))) - (unless nnfolder-marks-is-evil - (and nnfolder-marks-directory - (gnus-make-directory nnfolder-marks-directory))) (cond ((not (file-exists-p nnfolder-directory)) (nnfolder-close-server) @@ -607,11 +585,9 @@ the group. Then the marks file will be regenerated properly by Gnus.") () ; Don't delete the articles. ;; Delete the file that holds the group. (let ((data (nnfolder-group-pathname group)) - (nov (nnfolder-group-nov-pathname group)) - (mrk (nnfolder-group-marks-pathname group))) + (nov (nnfolder-group-nov-pathname group))) (ignore-errors (delete-file data)) - (ignore-errors (delete-file nov)) - (ignore-errors (delete-file mrk)))) + (ignore-errors (delete-file nov)))) ;; Remove the group from all structures. (setq nnfolder-group-alist (delq (assoc group nnfolder-group-alist) nnfolder-group-alist) @@ -632,11 +608,7 @@ the group. Then the marks file will be regenerated properly by Gnus.") (when (file-exists-p (nnfolder-group-nov-pathname group)) (setq new-file (nnfolder-group-nov-pathname new-name)) (gnus-make-directory (file-name-directory new-file)) - (rename-file (nnfolder-group-nov-pathname group) new-file)) - (when (file-exists-p (nnfolder-group-marks-pathname group)) - (setq new-file (nnfolder-group-marks-pathname new-name)) - (gnus-make-directory (file-name-directory new-file)) - (rename-file (nnfolder-group-marks-pathname group) new-file))) + (rename-file (nnfolder-group-nov-pathname group) new-file))) t) ;; That went ok, so we change the internal structures. (let ((entry (assoc group nnfolder-group-alist))) @@ -1087,16 +1059,17 @@ This command does not work if you use short group names." (defun nnfolder-save-buffer () "Save the buffer." - (when (buffer-modified-p) - (run-hooks 'nnfolder-save-buffer-hook) - (gnus-make-directory (file-name-directory (buffer-file-name))) - (let ((coding-system-for-write - (or nnfolder-file-coding-system-for-write - nnfolder-file-coding-system))) - (set (make-local-variable 'copyright-update) nil) - (save-buffer))) - (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) - (nnfolder-save-nov))) + (let ((delete-old-versions t)) + (when (buffer-modified-p) + (run-hooks 'nnfolder-save-buffer-hook) + (gnus-make-directory (file-name-directory (buffer-file-name))) + (let ((coding-system-for-write + (or nnfolder-file-coding-system-for-write + nnfolder-file-coding-system))) + (set (make-local-variable 'copyright-update) nil) + (save-buffer))) + (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) + (nnfolder-save-nov)))) (defun nnfolder-save-active (group-alist active-file) (let ((nnmail-active-file-coding-system @@ -1182,100 +1155,6 @@ This command does not work if you use short group names." (mail-header-set-number headers article) (nnheader-insert-nov headers))) -(deffoo nnfolder-request-set-mark (group actions &optional server) - (when (and server - (not (nnfolder-server-opened server))) - (nnfolder-open-server server)) - (unless nnfolder-marks-is-evil - (nnfolder-open-marks group server) - (setq nnfolder-marks (nnheader-update-marks-actions nnfolder-marks actions)) - (nnfolder-save-marks group server)) - nil) - -(deffoo nnfolder-request-marks (group info &optional server) - ;; Change servers. - (when (and server - (not (nnfolder-server-opened server))) - (nnfolder-open-server server)) - (when (and (not nnfolder-marks-is-evil) (nnfolder-marks-changed-p group)) - (nnheader-message 8 "Updating marks for %s..." group) - (nnfolder-open-marks group server) - ;; Update info using `nnfolder-marks'. - (mapc (lambda (pred) - (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists) - (gnus-info-set-marks - info - (gnus-update-alist-soft - (cdr pred) - (cdr (assq (cdr pred) nnfolder-marks)) - (gnus-info-marks info)) - t))) - gnus-article-mark-lists) - (let ((seen (cdr (assq 'read nnfolder-marks)))) - (gnus-info-set-read info - (if (and (integerp (car seen)) - (null (cdr seen))) - (list (cons (car seen) (car seen))) - seen))) - (nnheader-message 8 "Updating marks for %s...done" group)) - info) - -(defun nnfolder-group-marks-pathname (group) - "Make pathname for GROUP NOV." - (let ((nnfolder-directory (or nnfolder-marks-directory nnfolder-directory))) - (concat (nnfolder-group-pathname group) nnfolder-marks-file-suffix))) - -(defun nnfolder-marks-changed-p (group) - (let ((file (nnfolder-group-marks-pathname group))) - (if (null (gnus-gethash file nnfolder-marks-modtime)) - t ;; never looked at marks file, assume it has changed - (not (equal (gnus-gethash file nnfolder-marks-modtime) - (nth 5 (file-attributes file))))))) - -(defun nnfolder-save-marks (group server) - (let ((file-name-coding-system nnmail-pathname-coding-system) - (file (nnfolder-group-marks-pathname group))) - (condition-case err - (progn - (with-temp-file file - (erase-buffer) - (gnus-prin1 nnfolder-marks) - (insert "\n")) - (gnus-sethash file - (nth 5 (file-attributes file)) - nnfolder-marks-modtime)) - (error (or (gnus-yes-or-no-p - (format "Could not write to %s (%s). Continue? " file err)) - (error "Cannot write to %s (%s)" file err)))))) - -(defun nnfolder-open-marks (group server) - (let ((file (nnfolder-group-marks-pathname group))) - (if (file-exists-p file) - (condition-case err - (with-temp-buffer - (gnus-sethash file (nth 5 (file-attributes file)) - nnfolder-marks-modtime) - (nnheader-insert-file-contents file) - (setq nnfolder-marks (read (current-buffer))) - (dolist (el gnus-article-unpropagated-mark-lists) - (setq nnfolder-marks (gnus-remassoc el nnfolder-marks)))) - (error (or (gnus-yes-or-no-p - (format "Error reading nnfolder marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err)) - (error "Cannot read nnfolder marks file %s (%s)" file err)))) - ;; User didn't have a .marks file. Probably first time - ;; user of the .marks stuff. Bootstrap it from .newsrc.eld. - (let ((info (gnus-get-info - (gnus-group-prefixed-name - group - (gnus-server-to-method (format "nnfolder:%s" server)))))) - (nnheader-message 7 "Bootstrapping marks for %s..." group) - (setq nnfolder-marks (gnus-info-marks info)) - (push (cons 'read (gnus-info-read info)) nnfolder-marks) - (dolist (el gnus-article-unpropagated-mark-lists) - (setq nnfolder-marks (gnus-remassoc el nnfolder-marks))) - (nnfolder-save-marks group server) - (nnheader-message 7 "Bootstrapping marks for %s...done" group))))) - (provide 'nnfolder) ;;; nnfolder.el ends here diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 114d83b7286..5126c25f66b 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -117,7 +117,7 @@ some servers.") (defvoo nnimap-fetch-partial-articles nil "If non-nil, Gnus will fetch partial articles. -If t, nnimap will fetch only the first part. If a string, it +If t, Gnus will fetch only the first part. If a string, it will fetch all parts that have types that match that string. A likely value would be \"text/\" to automatically fetch all textual parts.") diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index 9c3a814d3ea..1645f49091f 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -40,6 +40,8 @@ (autoload 'gnus-add-buffer "gnus") (autoload 'gnus-kill-buffer "gnus") +(eval-when-compile + (autoload 'mail-send-and-exit "sendmail" nil t)) (defgroup nnmail nil "Reading mail with Gnus." @@ -553,11 +555,11 @@ parameter. It should return nil, `warn' or `delete'." (const warn) (const delete))) -(defcustom nnmail-extra-headers '(To Newsgroups) +(defcustom nnmail-extra-headers '(To Newsgroups Cc) "Extra headers to parse. In addition to the standard headers, these extra headers will be included in NOV headers (and the like) when backends parse headers." - :version "21.1" + :version "24.2" :group 'nnmail :type '(repeat symbol)) diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el index b8652600ae7..600a0d21e3c 100644 --- a/lisp/gnus/nnml.el +++ b/lisp/gnus/nnml.el @@ -4,7 +4,7 @@ ;; Foundation, Inc. ;; Authors: Didier Verna (adding compaction) -;; Simon Josefsson (adding MARKS) +;; Simon Josefsson ;; Lars Magne Ingebrigtsen ;; Masanobu UMEDA ;; Keywords: news, mail @@ -67,15 +67,6 @@ the `nnml-generate-nov-databases' command. The function will go through all nnml directories and generate nov databases for them all. This may very well take some time.") -(defvoo nnml-marks-is-evil nil - "If non-nil, Gnus will never generate and use marks file for mail spools. -Using marks files makes it possible to backup and restore mail groups -separately from `.newsrc.eld'. If you have, for some reason, set this -to t, and want to set it to nil again, you should always remove the -corresponding marks file (usually named `.marks' in the nnml group -directory, but see `nnml-marks-file-name') for the group. Then the -marks file will be regenerated properly by Gnus.") - (defvoo nnml-prepare-save-mail-hook nil "Hook run narrowed to an article before saving.") @@ -102,7 +93,6 @@ non-nil.") "nnml version.") (defvoo nnml-nov-file-name ".overview") -(defvoo nnml-marks-file-name ".marks") (defvoo nnml-current-directory nil) (defvoo nnml-current-group nil) @@ -118,10 +108,6 @@ non-nil.") (defvoo nnml-file-coding-system nnmail-file-coding-system) -(defvoo nnml-marks nil) - -(defvar nnml-marks-modtime (gnus-make-hashtable)) - ;;; Interface functions. @@ -513,8 +499,7 @@ non-nil.") nnml-current-directory t (concat nnheader-numerical-short-files - "\\|" (regexp-quote nnml-nov-file-name) "$" - "\\|" (regexp-quote nnml-marks-file-name) "$"))) + "\\|" (regexp-quote nnml-nov-file-name) "$"))) (decoded (nnml-decoded-group-name group server))) (dolist (article articles) (when (file-writable-p article) @@ -554,10 +539,6 @@ non-nil.") (let ((overview (concat old-dir nnml-nov-file-name))) (when (file-exists-p overview) (rename-file overview (concat new-dir nnml-nov-file-name)))) - ;; Move .marks file. - (let ((marks (concat old-dir nnml-marks-file-name))) - (when (file-exists-p marks) - (rename-file marks (concat new-dir nnml-marks-file-name)))) (when (<= (length (directory-files old-dir)) 2) (ignore-errors (delete-directory old-dir))) ;; That went ok, so we change the internal structures. @@ -1033,99 +1014,6 @@ Use the nov database for the current group if available." (forward-line 1)) alist)))) -(deffoo nnml-request-set-mark (group actions &optional server) - (nnml-possibly-change-directory group server) - (unless nnml-marks-is-evil - (nnml-open-marks group server) - (setq nnml-marks (nnheader-update-marks-actions nnml-marks actions)) - (nnml-save-marks group server)) - nil) - -(deffoo nnml-request-marks (group info &optional server) - (nnml-possibly-change-directory group server) - (when (and (not nnml-marks-is-evil) (nnml-marks-changed-p group server)) - (nnheader-message 8 "Updating marks for %s..." group) - (nnml-open-marks group server) - ;; Update info using `nnml-marks'. - (mapc (lambda (pred) - (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists) - (gnus-info-set-marks - info - (gnus-update-alist-soft - (cdr pred) - (cdr (assq (cdr pred) nnml-marks)) - (gnus-info-marks info)) - t))) - gnus-article-mark-lists) - (let ((seen (cdr (assq 'read nnml-marks)))) - (gnus-info-set-read info - (if (and (integerp (car seen)) - (null (cdr seen))) - (list (cons (car seen) (car seen))) - seen))) - (nnheader-message 8 "Updating marks for %s...done" group)) - info) - -(defun nnml-marks-changed-p (group server) - (let ((file (nnml-group-pathname group nnml-marks-file-name server))) - (if (null (gnus-gethash file nnml-marks-modtime)) - t ;; never looked at marks file, assume it has changed - (not (equal (gnus-gethash file nnml-marks-modtime) - (nth 5 (file-attributes file))))))) - -(defun nnml-save-marks (group server) - (let ((file-name-coding-system nnmail-pathname-coding-system) - (file (nnml-group-pathname group nnml-marks-file-name server))) - (condition-case err - (progn - (nnml-possibly-create-directory group server) - (with-temp-file file - (erase-buffer) - (gnus-prin1 nnml-marks) - (insert "\n")) - (gnus-sethash file - (nth 5 (file-attributes file)) - nnml-marks-modtime)) - (error (or (gnus-yes-or-no-p - (format "Could not write to %s (%s). Continue? " file err)) - (error "Cannot write to %s (%s)" file err)))))) - -(defun nnml-open-marks (group server) - (let* ((decoded (nnml-decoded-group-name group server)) - (file (nnmail-group-pathname decoded nnml-directory - nnml-marks-file-name)) - (file-name-coding-system nnmail-pathname-coding-system)) - (if (file-exists-p file) - (condition-case err - (with-temp-buffer - (gnus-sethash file (nth 5 (file-attributes file)) - nnml-marks-modtime) - (nnheader-insert-file-contents file) - (setq nnml-marks (read (current-buffer))) - (dolist (el gnus-article-unpropagated-mark-lists) - (setq nnml-marks (gnus-remassoc el nnml-marks)))) - (error (or (gnus-yes-or-no-p - (format "Error reading nnml marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err)) - (error "Cannot read nnml marks file %s (%s)" file err)))) - ;; User didn't have a .marks file. Probably first time - ;; user of the .marks stuff. Bootstrap it from .newsrc.eld. - (let ((info (gnus-get-info - (gnus-group-prefixed-name - group - (gnus-server-to-method - (format "nnml:%s" (or server ""))))))) - (setq decoded (if (member server '(nil "")) - (concat "nnml:" decoded) - (format "nnml+%s:%s" server decoded))) - (nnheader-message 7 "Bootstrapping marks for %s..." decoded) - (setq nnml-marks (gnus-info-marks info)) - (push (cons 'read (gnus-info-read info)) nnml-marks) - (dolist (el gnus-article-unpropagated-mark-lists) - (setq nnml-marks (gnus-remassoc el nnml-marks))) - (nnml-save-marks group server) - (nnheader-message 7 "Bootstrapping marks for %s...done" decoded))))) - - ;;; ;;; Group and server compaction. -- dvl ;;; @@ -1275,19 +1163,11 @@ Use the nov database for the current group if available." (gnus-set-active group-full-name active)) ;; 1 bis/ ;; #### NOTE: normally, we should save the overview (NOV) file - ;; #### here, just like we save the marks file. However, there is no - ;; #### such function as nnml-save-nov for a single group. Only for - ;; #### all groups. Gnus inconsistency is getting worse every day... - ;; 2/ Rebuild marks file: - (unless nnml-marks-is-evil - ;; #### NOTE: this constant use of global variables everywhere is - ;; #### truly disgusting. Gnus really needs a *major* cleanup. - (setq nnml-marks (gnus-info-marks info)) - (push (cons 'read (gnus-info-read info)) nnml-marks) - (dolist (el gnus-article-unpropagated-mark-lists) - (setq nnml-marks (gnus-remassoc el nnml-marks))) - (nnml-save-marks group server)) - ;; 3/ Save everything if this was not part of a bigger operation: + ;; #### here. However, there is no such function as + ;; #### nnml-save-nov for a single group. Only for all + ;; #### groups. Gnus inconsistency is getting worse every + ;; #### day... ;; 3/ Save everything if this was not part of + ;; #### a bigger operation: (if (not save) ;; Nothing to save (yet): t @@ -1298,9 +1178,6 @@ Use the nov database for the current group if available." (nnml-save-nov) ;; b/ Save the active file: (nnmail-save-active nnml-group-alist nnml-active-file) - (let ((marks (nnml-group-pathname group nnml-marks-file-name server))) - (when (file-exists-p marks) - (delete-file marks))) t))))) (defun nnml-request-compact (&optional server) diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index e237227f78a..be5d1e6ff4c 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -222,27 +222,6 @@ then use this hook to rsh to the remote machine and start a proxy NNTP server there that you can connect to. See also `nntp-open-connection-function'") -(defvoo nntp-coding-system-for-read 'binary - "*Coding system to read from NNTP.") - -(defvoo nntp-coding-system-for-write 'binary - "*Coding system to write to NNTP.") - -;; Marks -(defvoo nntp-marks-is-evil nil - "*If non-nil, Gnus will never generate and use marks file for nntp groups. -See `nnml-marks-is-evil' for more information.") - -(defvoo nntp-marks-file-name ".marks") -(defvoo nntp-marks nil) -(defvar nntp-marks-modtime (gnus-make-hashtable)) - -(defcustom nntp-marks-directory - (nnheader-concat gnus-directory "marks/") - "*The directory where marks for nntp groups will be stored." - :group 'nntp - :type 'directory) - (defcustom nntp-authinfo-file "~/.authinfo" ".netrc-like file that holds nntp authinfo passwords." :group 'nntp @@ -826,7 +805,8 @@ command whose response triggered the error." (progn (nntp-copy-to-buffer nntp-server-buffer (point-min) (point-max)) - (gnus-groups-to-gnus-format method gnus-active-hashtb t)) + (with-current-buffer nntp-server-buffer + (gnus-groups-to-gnus-format method gnus-active-hashtb t))) ;; We have read active entries, so we just delete the ;; superfluous gunk. (goto-char (point-min)) @@ -1184,43 +1164,6 @@ command whose response triggered the error." (deffoo nntp-asynchronous-p () t) -(deffoo nntp-request-set-mark (group actions &optional server) - (when (and (not nntp-marks-is-evil) - nntp-marks-file-name) - (nntp-possibly-create-directory group server) - (nntp-open-marks group server) - (setq nntp-marks (nnheader-update-marks-actions nntp-marks actions)) - (nntp-save-marks group server)) - nil) - -(deffoo nntp-request-marks (group info &optional server) - (when (and (not nntp-marks-is-evil) - nntp-marks-file-name) - (nntp-possibly-create-directory group server) - (when (nntp-marks-changed-p group server) - (nnheader-message 8 "Updating marks for %s..." group) - (nntp-open-marks group server) - ;; Update info using `nntp-marks'. - (mapc (lambda (pred) - (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists) - (gnus-info-set-marks - info - (gnus-update-alist-soft - (cdr pred) - (cdr (assq (cdr pred) nntp-marks)) - (gnus-info-marks info)) - t))) - gnus-article-mark-lists) - (let ((seen (cdr (assq 'read nntp-marks)))) - (gnus-info-set-read info - (if (and (integerp (car seen)) - (null (cdr seen))) - (list (cons (car seen) (car seen))) - seen))) - (nnheader-message 8 "Updating marks for %s...done" group))) - nil) - - ;;; Hooky functions. @@ -1287,30 +1230,6 @@ If SEND-IF-FORCE, only send authinfo to the server if the (read-passwd (format "NNTP (%s@%s) password: " user nntp-address)))))))))) -(defun nntp-send-nosy-authinfo () - "Send the AUTHINFO to the nntp server." - (let ((user (read-string (format "NNTP (%s) user name: " nntp-address)))) - (unless (member user '(nil "")) - (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user) - (when t ;???Should check if AUTHINFO succeeded - (nntp-send-command "^2.*\r?\n" "AUTHINFO PASS" - (read-passwd (format "NNTP (%s@%s) password: " - user nntp-address))))))) - -(defun nntp-send-authinfo-from-file () - "Send the AUTHINFO to the nntp server. - -The authinfo login name is taken from the user's login name and the -password contained in '~/.nntp-authinfo'." - (when (file-exists-p "~/.nntp-authinfo") - (with-temp-buffer - (insert-file-contents "~/.nntp-authinfo") - (goto-char (point-min)) - (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name)) - (nntp-send-command - "^2.*\r?\n" "AUTHINFO PASS" - (buffer-substring (point) (point-at-eol)))))) - ;;; Internal functions. (defun nntp-handle-authinfo (process) @@ -1351,8 +1270,8 @@ password contained in '~/.nntp-authinfo'." (nntp-kill-buffer ,pbuffer))))) (process (condition-case err - (let ((coding-system-for-read nntp-coding-system-for-read) - (coding-system-for-write nntp-coding-system-for-write) + (let ((coding-system-for-read 'binary) + (coding-system-for-write 'binary) (map '((nntp-open-network-stream network) (network-only plain) ; compat (nntp-open-plain-stream plain) @@ -1437,14 +1356,6 @@ password contained in '~/.nntp-authinfo'." nntp-process-start-point (point-max)) (setq after-change-functions '(nntp-after-change-function)))) -(defun nntp-async-timer-handler () - (mapcar - (lambda (proc) - (if (memq (process-status proc) '(open run)) - (nntp-async-trigger proc) - (nntp-async-stop proc))) - nntp-async-process-list)) - (defun nntp-async-stop (proc) (setq nntp-async-process-list (delq proc nntp-async-process-list)) (when (and nntp-async-timer (not nntp-async-process-list)) @@ -2161,95 +2072,6 @@ Please refer to the following variables to customize the connection: (delete-region (point) (point-max))) proc))) -;; Marks handling - -(defun nntp-marks-directory (server) - (expand-file-name server nntp-marks-directory)) - -(defvar nntp-server-to-method-cache nil - "Alist of servers and select methods.") - -(defun nntp-group-pathname (server group &optional file) - "Return an absolute file name of FILE for GROUP on SERVER." - (let ((method (cdr (assoc server nntp-server-to-method-cache)))) - (unless method - (push (cons server (setq method (or (gnus-server-to-method server) - (gnus-find-method-for-group group)))) - nntp-server-to-method-cache)) - (nnmail-group-pathname - (mm-decode-coding-string group - (inline (gnus-group-name-charset method group))) - (nntp-marks-directory server) - file))) - -(defun nntp-possibly-create-directory (group server) - (let ((dir (nntp-group-pathname server group)) - (file-name-coding-system nnmail-pathname-coding-system)) - (unless (file-exists-p dir) - (make-directory (directory-file-name dir) t) - (nnheader-message 5 "Creating nntp marks directory %s" dir)))) - -(autoload 'time-less-p "time-date") - -(defun nntp-marks-changed-p (group server) - (let ((file (nntp-group-pathname server group nntp-marks-file-name)) - (file-name-coding-system nnmail-pathname-coding-system)) - (if (null (gnus-gethash file nntp-marks-modtime)) - t ;; never looked at marks file, assume it has changed - (time-less-p (gnus-gethash file nntp-marks-modtime) - (nth 5 (file-attributes file)))))) - -(defun nntp-save-marks (group server) - (let ((file-name-coding-system nnmail-pathname-coding-system) - (file (nntp-group-pathname server group nntp-marks-file-name))) - (condition-case err - (progn - (nntp-possibly-create-directory group server) - (with-temp-file file - (erase-buffer) - (gnus-prin1 nntp-marks) - (insert "\n")) - (gnus-sethash file - (nth 5 (file-attributes file)) - nntp-marks-modtime)) - (error (or (gnus-yes-or-no-p - (format "Could not write to %s (%s). Continue? " file err)) - (error "Cannot write to %s (%s)" file err)))))) - -(defun nntp-open-marks (group server) - (let ((file (nntp-group-pathname server group nntp-marks-file-name)) - (file-name-coding-system nnmail-pathname-coding-system)) - (if (file-exists-p file) - (condition-case err - (with-temp-buffer - (gnus-sethash file (nth 5 (file-attributes file)) - nntp-marks-modtime) - (nnheader-insert-file-contents file) - (setq nntp-marks (read (current-buffer))) - (dolist (el gnus-article-unpropagated-mark-lists) - (setq nntp-marks (gnus-remassoc el nntp-marks)))) - (error (or (gnus-yes-or-no-p - (format "Error reading nntp marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err)) - (error "Cannot read nntp marks file %s (%s)" file err)))) - ;; User didn't have a .marks file. Probably first time - ;; user of the .marks stuff. Bootstrap it from .newsrc.eld. - (let ((info (gnus-get-info - (gnus-group-prefixed-name - group - (gnus-server-to-method (format "nntp:%s" server))))) - (decoded-name (mm-decode-coding-string - group - (gnus-group-name-charset - (gnus-server-to-method server) group)))) - (nnheader-message 7 "Bootstrapping marks for %s..." decoded-name) - (setq nntp-marks (gnus-info-marks info)) - (push (cons 'read (gnus-info-read info)) nntp-marks) - (dolist (el gnus-article-unpropagated-mark-lists) - (setq nntp-marks (gnus-remassoc el nntp-marks))) - (nntp-save-marks group server) - (nnheader-message 7 "Bootstrapping marks for %s...done" - decoded-name))))) - (provide 'nntp) ;;; nntp.el ends here diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el index ee4345c2f4f..25330989e00 100644 --- a/lisp/gnus/pop3.el +++ b/lisp/gnus/pop3.el @@ -194,10 +194,16 @@ Use streaming commands." (unless (memq (process-status process) '(open run)) (error "pop3 process died")) (when total-size - (message "pop3 retrieved %dKB (%d%%)" - (truncate (/ (buffer-size) 1000)) - (truncate (* (/ (* (buffer-size) 1.0) - total-size) 100)))) + (let ((size 0)) + (goto-char (point-min)) + (while (re-search-forward "^\\+OK.*\n" nil t) + (setq size (+ size (- (point)) + (if (re-search-forward "^\\.\r?\n" nil 'move) + (match-beginning 0) + (point))))) + (message "pop3 retrieved %dKB (%d%%)" + (truncate (/ size 1000)) + (truncate (* (/ (* size 1.0) total-size) 100))))) (pop3-accept-process-output process)) start-point) diff --git a/lisp/gnus/registry.el b/lisp/gnus/registry.el index c54fe3e3d71..7b1029a2690 100644 --- a/lisp/gnus/registry.el +++ b/lisp/gnus/registry.el @@ -79,26 +79,8 @@ (eval-when-compile (require 'cl)) -(eval-when-compile - (when (null (ignore-errors (require 'ert))) - (defmacro* ert-deftest (name () &body docstring-keys-and-body)))) - -(ignore-errors - (require 'ert)) -(eval-and-compile - (or (ignore-errors (progn - (require 'eieio) - (require 'eieio-base))) - ;; gnus-fallback-lib/ from gnus/lisp/gnus-fallback-lib - (ignore-errors - (let ((load-path (cons (expand-file-name - "gnus-fallback-lib/eieio" - (file-name-directory (locate-library "gnus"))) - load-path))) - (require 'eieio) - (require 'eieio-base))) - (error - "eieio not found in `load-path' or gnus-fallback-lib/ directory."))) +(require 'eieio) +(require 'eieio-base) (defclass registry-db (eieio-persistent) ((version :initarg :version @@ -373,111 +355,5 @@ Proposes any entries over the max-hard limit minus size * prune-factor." collect k))) (list limit candidates)))) -(ert-deftest registry-instantiation-test () - (should (registry-db "Testing"))) - -(ert-deftest registry-match-test () - (let ((entry '((hello "goodbye" "bye") (blank)))) - - (message "Testing :regex matching") - (should (registry--match :regex entry '((hello "nye" "bye")))) - (should (registry--match :regex entry '((hello "good")))) - (should-not (registry--match :regex entry '((hello "nye")))) - (should-not (registry--match :regex entry '((hello)))) - - (message "Testing :member matching") - (should (registry--match :member entry '((hello "bye")))) - (should (registry--match :member entry '((hello "goodbye")))) - (should-not (registry--match :member entry '((hello "good")))) - (should-not (registry--match :member entry '((hello "nye")))) - (should-not (registry--match :member entry '((hello))))) - (message "Done with matching testing.")) - -(defun registry-make-testable-db (n &optional name file) - (let* ((db (registry-db - (or name "Testing") - :file (or file "unused") - :max-hard n - :max-soft 0 ; keep nothing not precious - :precious '(extra more-extra) - :tracked '(sender subject groups)))) - (dotimes (i n) - (registry-insert db i `((sender "me") - (subject "about you") - (more-extra) ; empty data key should be pruned - ;; first 5 entries will NOT have this extra data - ,@(when (< 5 i) (list (list 'extra "more data"))) - (groups ,(number-to-string i))))) - db)) - -(ert-deftest registry-usage-test () - (let* ((n 100) - (db (registry-make-testable-db n))) - (message "size %d" n) - (should (= n (registry-size db))) - (message "max-hard test") - (should-error (registry-insert db "new" '())) - (message "Individual lookup") - (should (= 58 (caadr (registry-lookup db '(1 58 99))))) - (message "Grouped individual lookup") - (should (= 3 (length (registry-lookup db '(1 58 99))))) - (when (boundp 'lexical-binding) - (message "Individual lookup (breaks before lexbind)") - (should (= 58 - (caadr (registry-lookup-breaks-before-lexbind db '(1 58 99))))) - (message "Grouped individual lookup (breaks before lexbind)") - (should (= 3 - (length (registry-lookup-breaks-before-lexbind db - '(1 58 99)))))) - (message "Search") - (should (= n (length (registry-search db :all t)))) - (should (= n (length (registry-search db :member '((sender "me")))))) - (message "Secondary index search") - (should (= n (length (registry-lookup-secondary-value db 'sender "me")))) - (should (equal '(74) (registry-lookup-secondary-value db 'groups "74"))) - (message "Delete") - (should (registry-delete db '(1) t)) - (decf n) - (message "Search after delete") - (should (= n (length (registry-search db :all t)))) - (message "Secondary search after delete") - (should (= n (length (registry-lookup-secondary-value db 'sender "me")))) - ;; (message "Pruning") - ;; (let* ((tokeep (registry-search db :member '((extra "more data")))) - ;; (count (- n (length tokeep))) - ;; (pruned (registry-prune db)) - ;; (prune-count (length pruned))) - ;; (message "Expecting to prune %d entries and pruned %d" - ;; count prune-count) - ;; (should (and (= count 5) - ;; (= count prune-count)))) - (message "Done with usage testing."))) - -(ert-deftest registry-persistence-test () - (let* ((n 100) - (tempfile (make-temp-file "registry-persistence-")) - (name "persistence tester") - (db (registry-make-testable-db n name tempfile)) - size back) - (message "Saving to %s" tempfile) - (eieio-persistent-save db) - (setq size (nth 7 (file-attributes tempfile))) - (message "Saved to %s: size %d" tempfile size) - (should (< 0 size)) - (with-temp-buffer - (insert-file-contents-literally tempfile) - (should (looking-at (concat ";; Object " - name - "\n;; EIEIO PERSISTENT OBJECT")))) - (message "Reading object back") - (setq back (eieio-persistent-read tempfile)) - (should back) - (message "Read object back: %d keys, expected %d==%d" - (registry-size back) n (registry-size db)) - (should (= (registry-size back) n)) - (should (= (registry-size back) (registry-size db))) - (delete-file tempfile)) - (message "Done with persistence testing.")) - (provide 'registry) ;;; registry.el ends here diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el index 42118298734..e7a6c5d2081 100644 --- a/lisp/gnus/shr.el +++ b/lisp/gnus/shr.el @@ -119,6 +119,7 @@ cid: URL as the argument.") (let ((map (make-sparse-keymap))) (define-key map "a" 'shr-show-alt-text) (define-key map "i" 'shr-browse-image) + (define-key map "z" 'shr-zoom-image) (define-key map "I" 'shr-insert-image) (define-key map "u" 'shr-copy-url) (define-key map "v" 'shr-browse-url) @@ -128,17 +129,23 @@ cid: URL as the argument.") ;; Public functions and commands. -(defun shr-visit-file (file) - "Parse FILE as an HTML document, and render it in a new buffer." - (interactive "fHTML file name: ") +(defun shr-render-buffer (buffer) + "Display the HTML rendering of the current buffer." + (interactive (list (current-buffer))) (pop-to-buffer "*html*") (erase-buffer) (shr-insert-document - (with-temp-buffer - (insert-file-contents file) + (with-current-buffer buffer (libxml-parse-html-region (point-min) (point-max)))) (goto-char (point-min))) +(defun shr-visit-file (file) + "Parse FILE as an HTML document, and render it in a new buffer." + (interactive "fHTML file name: ") + (with-temp-buffer + (insert-file-contents file) + (shr-render-buffer (current-buffer)))) + ;;;###autoload (defun shr-insert-document (dom) "Render the parsed document DOM into the current buffer. @@ -235,6 +242,40 @@ the URL of the image to the kill buffer instead." (list (current-buffer) (1- (point)) (point-marker)) t t)))) +(defun shr-zoom-image () + "Toggle the image size. +The size will be rotated between the default size, the original +size, and full-buffer size." + (interactive) + (let ((url (get-text-property (point) 'image-url)) + (size (get-text-property (point) 'image-size)) + (buffer-read-only nil)) + (if (not url) + (message "No image under point") + ;; Delete the old picture. + (while (get-text-property (point) 'image-url) + (forward-char -1)) + (forward-char 1) + (let ((start (point))) + (while (get-text-property (point) 'image-url) + (forward-char 1)) + (forward-char -1) + (put-text-property start (point) 'display nil) + (when (> (- (point) start) 2) + (delete-region start (1- (point))))) + (message "Inserting %s..." url) + (url-retrieve url 'shr-image-fetched + (list (current-buffer) (1- (point)) (point-marker) + (list (cons 'size + (cond ((or (eq size 'default) + (null size)) + 'original) + ((eq size 'original) + 'full) + ((eq size 'full) + 'default))))) + t)))) + ;;; Utility functions. (defun shr-transform-dom (dom) @@ -298,6 +339,7 @@ the URL of the image to the kill buffer instead." (defun shr-insert (text) (when (and (eq shr-state 'image) + (not (bolp)) (not (string-match "\\`[ \t\n]+\\'" text))) (insert "\n") (setq shr-state nil)) @@ -305,11 +347,11 @@ the URL of the image to the kill buffer instead." ((eq shr-folding-mode 'none) (insert text)) (t - (when (and (string-match "\\`[ \t\n]" text) + (when (and (string-match "\\`[ \t\n]" text) (not (bolp)) (not (eq (char-after (1- (point))) ? ))) (insert " ")) - (dolist (elem (split-string text)) + (dolist (elem (split-string text "[ \f\t\n\r\v]+" t)) (when (and (bolp) (> shr-indentation 0)) (shr-indent)) @@ -349,7 +391,7 @@ the URL of the image to the kill buffer instead." (shr-indent)) (end-of-line)) (insert " "))) - (unless (string-match "[ \t\n]\\'" text) + (unless (string-match "[ \t\n]\\'" text) (delete-char -1))))) (defun shr-find-fill-point () @@ -408,32 +450,29 @@ the URL of the image to the kill buffer instead." (shr-char-kinsoku-eol-p (following-char))))) (goto-char bp))) ((shr-char-kinsoku-eol-p (preceding-char)) - (if (shr-char-kinsoku-eol-p (following-char)) - ;; There are consecutive kinsoku-eol characters. - (setq failed t) - (let ((count 4)) - (while - (progn - (backward-char 1) - (and (> (setq count (1- count)) 0) - (not (memq (preceding-char) (list ?\C-@ ?\n ? ))) - (or (shr-char-kinsoku-eol-p (preceding-char)) - (shr-char-kinsoku-bol-p (following-char))))))) - (if (setq failed (= (current-column) shr-indentation)) - ;; There's no breakable point that doesn't violate kinsoku, - ;; so we go to the second best position. - (if (looking-at "\\(\\c<+\\)\\c<") - (goto-char (match-end 1)) - (forward-char 1))))) - (t - (if (shr-char-kinsoku-bol-p (preceding-char)) - ;; There are consecutive kinsoku-bol characters. - (setq failed t) - (let ((count 4)) - (while (and (>= (setq count (1- count)) 0) + ;; Find backward the point where kinsoku-eol characters begin. + (let ((count 4)) + (while + (progn + (backward-char 1) + (and (> (setq count (1- count)) 0) + (not (memq (preceding-char) (list ?\C-@ ?\n ? ))) + (or (shr-char-kinsoku-eol-p (preceding-char)) + (shr-char-kinsoku-bol-p (following-char))))))) + (if (setq failed (= (current-column) shr-indentation)) + ;; There's no breakable point that doesn't violate kinsoku, + ;; so we go to the second best position. + (if (looking-at "\\(\\c<+\\)\\c<") + (goto-char (match-end 1)) + (forward-char 1)))) + ((shr-char-kinsoku-bol-p (following-char)) + ;; Find forward the point where kinsoku-bol characters end. + (let ((count 4)) + (while (progn + (forward-char 1) + (and (>= (setq count (1- count)) 0) (shr-char-kinsoku-bol-p (following-char)) - (shr-char-breakable-p (following-char))) - (forward-char 1)))))) + (shr-char-breakable-p (following-char)))))))) (when (eq (following-char) ? ) (forward-char 1)))) (not failed))) @@ -445,6 +484,9 @@ the URL of the image to the kill buffer instead." (string-match "\\`[a-z]*:" url) (not shr-base)) url) + ((and (string-match "\\`//" url) + (string-match "\\`[a-z]*:" shr-base)) + (concat (match-string 0 shr-base) url)) ((and (not (string-match "/\\'" shr-base)) (not (string-match "\\`/" url))) (concat shr-base "/" url)) @@ -465,7 +507,7 @@ the URL of the image to the kill buffer instead." (if (save-excursion (beginning-of-line) (looking-at " *$")) - (insert "\n") + (delete-region (match-beginning 0) (match-end 0)) (insert "\n\n"))))) (defun shr-indent () @@ -523,7 +565,7 @@ the URL of the image to the kill buffer instead." (expand-file-name (file-name-nondirectory url) directory))))) -(defun shr-image-fetched (status buffer start end) +(defun shr-image-fetched (status buffer start end &optional flags) (let ((image-buffer (current-buffer))) (when (and (buffer-name buffer) (not (plist-get status :error))) @@ -534,30 +576,53 @@ the URL of the image to the kill buffer instead." (with-current-buffer buffer (save-excursion (let ((alt (buffer-substring start end)) + (properties (text-properties-at start)) (inhibit-read-only t)) (delete-region start end) (goto-char start) - (funcall shr-put-image-function data alt))))))) + (funcall shr-put-image-function data alt flags) + (while properties + (let ((type (pop properties)) + (value (pop properties))) + (unless (memq type '(display image-size)) + (put-text-property start (point) type value)))))))))) (kill-buffer image-buffer))) -(defun shr-put-image (data alt) +(defun shr-put-image (data alt &optional flags) "Put image DATA with a string ALT. Return image." (if (display-graphic-p) - (let ((image (ignore-errors - (shr-rescale-image data)))) + (let* ((size (cdr (assq 'size flags))) + (start (point)) + (image (cond + ((eq size 'original) + (create-image data nil t :ascent 100)) + ((eq size 'full) + (ignore-errors + (shr-rescale-image data t))) + (t + (ignore-errors + (shr-rescale-image data)))))) (when image ;; When inserting big-ish pictures, put them at the ;; beginning of the line. (when (and (> (current-column) 0) (> (car (image-size image t)) 400)) (insert "\n")) - (insert-image image (or alt "*")) + (if (eq size 'original) + (let ((overlays (overlays-at (point)))) + (insert-sliced-image image (or alt "*") nil 20 1) + (dolist (overlay overlays) + (overlay-put overlay 'face 'default))) + (insert-image image (or alt "*"))) + (put-text-property start (point) 'image-size size) (when (image-animated-p image) (image-animate image nil 60))) image) (insert alt))) -(defun shr-rescale-image (data) +(defun shr-rescale-image (data &optional force) + "Rescale DATA, if too big, to fit the current buffer. +If FORCE, rescale the image anyway." (let ((image (create-image data nil t :ascent 100))) (if (or (not (fboundp 'imagemagick-types)) (not (get-buffer-window (current-buffer)))) @@ -572,7 +637,8 @@ the URL of the image to the kill buffer instead." (window-height (truncate (* shr-max-image-proportion (- (nth 3 edges) (nth 1 edges))))) scaled-image) - (when (> height window-height) + (when (or force + (> height window-height)) (setq image (or (create-image data 'imagemagick t :height window-height :ascent 100) @@ -984,7 +1050,12 @@ ones, in case fg and bg are nil." (shr-generic cont))) (defun shr-tag-br (cont) - (unless (bobp) + (when (and (not (bobp)) + ;; Only add a newline if we break the current line, or + ;; the previous line isn't a blank line. + (or (not (bolp)) + (and (> (- (point) 2) (point-min)) + (not (= (char-after (- (point) 2)) ?\n))))) (insert "\n") (shr-indent)) (shr-generic cont)) diff --git a/lisp/gnus/sieve-mode.el b/lisp/gnus/sieve-mode.el index ded51bbb57e..f49f767d791 100644 --- a/lisp/gnus/sieve-mode.el +++ b/lisp/gnus/sieve-mode.el @@ -173,7 +173,7 @@ (defvar sieve-mode-map (let ((map (make-sparse-keymap))) (define-key map "\C-c\C-l" 'sieve-upload) - (define-key map "\C-c\C-c" 'sieve-upload-and-bury) + (define-key map "\C-c\C-c" 'sieve-upload-and-kill) (define-key map "\C-c\C-m" 'sieve-manage) map) "Key map used in sieve mode.") diff --git a/lisp/gnus/sieve.el b/lisp/gnus/sieve.el index c047a17b303..39b74e5eae0 100644 --- a/lisp/gnus/sieve.el +++ b/lisp/gnus/sieve.el @@ -109,7 +109,7 @@ require \"fileinto\"; ;; various (define-key map "?" 'sieve-help) (define-key map "h" 'sieve-help) - (define-key map "q" 'sieve-bury-buffer) + (define-key map "q" 'kill-buffer) ;; activating (define-key map "m" 'sieve-activate) (define-key map "u" 'sieve-deactivate) @@ -250,29 +250,6 @@ Used to bracket operations which move point in the sieve-buffer." (message "%s" (substitute-command-keys "`\\[sieve-edit-script]':edit `\\[sieve-activate]':activate `\\[sieve-deactivate]':deactivate `\\[sieve-remove]':remove")))) -(defun sieve-bury-buffer (buf &optional mainbuf) - "Hide the buffer BUF that was temporarily popped up. -BUF is assumed to be a temporary buffer used from the buffer MAINBUF." - (interactive (list (current-buffer))) - (save-current-buffer - (let ((win (if (eq buf (window-buffer (selected-window))) (selected-window) - (get-buffer-window buf t)))) - (when win - (if (window-dedicated-p win) - (condition-case () - (delete-window win) - (error (iconify-frame (window-frame win)))) - (if (and mainbuf (get-buffer-window mainbuf)) - (delete-window win))))) - (with-current-buffer buf - (bury-buffer (unless (and (eq buf (window-buffer (selected-window))) - (not (window-dedicated-p (selected-window)))) - buf))) - (when mainbuf - (let ((mainwin (or (get-buffer-window mainbuf) - (get-buffer-window mainbuf 'visible)))) - (when mainwin (select-window mainwin)))))) - ;; Create buffer: (defun sieve-setup-buffer (server port) @@ -389,6 +366,12 @@ Server : " server ":" (or port "2000") " (sieve-upload name) (bury-buffer)) +;;;###autoload +(defun sieve-upload-and-kill (&optional name) + (interactive) + (sieve-upload name) + (kill-buffer)) + (provide 'sieve) ;; sieve.el ends here diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index 73f4970fcd4..7492142947e 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -678,7 +678,7 @@ The following commands are available: "x509" "-in" (expand-file-name certfile) "-text") (fundamental-mode) (set-buffer-modified-p nil) - (toggle-read-only t) + (setq buffer-read-only t) (goto-char (point-min)))) (defun smime-draw-buffer () diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index 3cfbd7dba35..c3be15adc1a 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -2088,11 +2088,6 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ;; all this is done inside a condition-case to trap errors -(eval-when-compile - (autoload 'bbdb-buffer "bbdb") - (autoload 'bbdb-create-internal "bbdb") - (autoload 'bbdb-search-simple "bbdb")) - ;; Autoloaded in message, which we require. (declare-function gnus-extract-address-components "gnus-util" (from)) @@ -2104,9 +2099,13 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (file-error ;; `bbdb-records' should not be bound as an autoload function ;; before loading bbdb because of `bbdb-hashtable-size'. + (defalias 'bbdb-buffer 'ignore) + (defalias 'bbdb-create-internal 'ignore) (defalias 'bbdb-records 'ignore) (defalias 'spam-BBDB-register-routine 'ignore) (defalias 'spam-enter-ham-BBDB 'ignore) + (defalias 'spam-exists-in-BBDB-p 'ignore) + (defalias 'bbdb-gethash 'ignore) nil)) ;; when the BBDB changes, we want to clear out our cache @@ -2126,7 +2125,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." 'ignore)) (net-address (nth 1 parsed-address)) (record (and net-address - (bbdb-search-simple nil net-address)))) + (spam-exists-in-BBDB-p net-address)))) (when net-address (gnus-message 6 "%s address %s %s BBDB" (if remove "Deleting" "Adding") @@ -2148,15 +2147,17 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (defun spam-BBDB-unregister-routine (articles) (spam-BBDB-register-routine articles t)) + (defsubst spam-exists-in-BBDB-p (net) + (when (and (stringp net) (not (zerop (length net)))) + (bbdb-records) + (bbdb-gethash (downcase net)))) + (defun spam-check-BBDB () "Mail from people in the BBDB is classified as ham or non-spam" - (let ((who (message-fetch-field "from"))) - (when who - (setq who (nth 1 (gnus-extract-address-components who))) - (if - (if (fboundp 'bbdb-search) - (bbdb-search (bbdb-records) who) ;; v3 - (bbdb-search-simple nil who)) ;; v2 + (let ((net (message-fetch-field "from"))) + (when net + (setq net (nth 1 (gnus-extract-address-components net))) + (if (spam-exists-in-BBDB-p net) t (if spam-use-BBDB-exclusive spam-split-group diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 72b494f9800..f585bff871f 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -150,7 +150,7 @@ the same names as used in the original source code, when possible." arglist))) (unless (zerop rest) (push '&rest arglist) (push 'rest arglist)) (nreverse arglist)))) - ((and (eq (car-safe def) 'autoload) (not (eq (nth 4 def) 'keymap))) + ((and (autoloadp def) (not (eq (nth 4 def) 'keymap))) "[Arg list not available until function definition is loaded.]") (t t))) @@ -288,7 +288,7 @@ defined. If several such files exist, preference is given to a file found via `load-path'. The return value can also be `C-source', which means that OBJECT is a function or variable defined in C. If no suitable file is found, return nil." - (let* ((autoloaded (eq (car-safe type) 'autoload)) + (let* ((autoloaded (autoloadp type)) (file-name (or (and autoloaded (nth 1 type)) (symbol-file object (if (memq type (list 'defvar 'defface)) @@ -401,6 +401,21 @@ suitable file is found, return nil." (help-xref-button 1 'help-function-cmacro function lib))))) (princ ".\n\n")))) +;; We could use `symbol-file' but this is a wee bit more efficient. +(defun help-fns--autoloaded-p (function file) + "Return non-nil if FUNCTION has previously been autoloaded. +FILE is the file where FUNCTION was probably defined." + (let* ((file (file-name-sans-extension (file-truename file))) + (load-hist load-history) + (target (cons t function)) + found) + (while (and load-hist (not found)) + (and (caar load-hist) + (equal (file-name-sans-extension (caar load-hist)) file) + (setq found (member target (cdar load-hist)))) + (setq load-hist (cdr load-hist))) + found)) + ;;;###autoload (defun describe-function-1 (function) (let* ((advised (and (symbolp function) (featurep 'advice) @@ -416,59 +431,67 @@ suitable file is found, return nil." (def (if (symbolp real-function) (symbol-function real-function) function)) - file-name string - (beg (if (commandp def) "an interactive " "a ")) + (aliased (symbolp def)) + (real-def (if aliased + (let ((f def)) + (while (and (fboundp f) + (symbolp (symbol-function f))) + (setq f (symbol-function f))) + f) + def)) + (file-name (find-lisp-object-file-name function def)) (pt1 (with-current-buffer (help-buffer) (point))) - errtype) - (setq string - (cond ((or (stringp def) (vectorp def)) - "a keyboard macro") - ((subrp def) - (if (eq 'unevalled (cdr (subr-arity def))) - (concat beg "special form") - (concat beg "built-in function"))) - ((byte-code-function-p def) - (concat beg "compiled Lisp function")) - ((symbolp def) - (while (and (fboundp def) - (symbolp (symbol-function def))) - (setq def (symbol-function def))) - ;; Handle (defalias 'foo 'bar), where bar is undefined. - (or (fboundp def) (setq errtype 'alias)) - (format "an alias for `%s'" def)) - ((eq (car-safe def) 'lambda) - (concat beg "Lisp function")) - ((eq (car-safe def) 'macro) - "a Lisp macro") - ((eq (car-safe def) 'closure) - (concat beg "Lisp closure")) - ((eq (car-safe def) 'autoload) - (format "%s autoloaded %s" - (if (commandp def) "an interactive" "an") - (if (eq (nth 4 def) 'keymap) "keymap" - (if (nth 4 def) "Lisp macro" "Lisp function")))) - ((keymapp def) - (let ((is-full nil) - (elts (cdr-safe def))) - (while elts - (if (char-table-p (car-safe elts)) - (setq is-full t - elts nil)) - (setq elts (cdr-safe elts))) - (if is-full - "a full keymap" - "a sparse keymap"))) - (t ""))) - (princ string) - (if (eq errtype 'alias) + (beg (if (and (or (byte-code-function-p def) + (keymapp def) + (memq (car-safe def) '(macro lambda closure))) + file-name + (help-fns--autoloaded-p function file-name)) + (if (commandp def) + "an interactive autoloaded " + "an autoloaded ") + (if (commandp def) "an interactive " "a ")))) + + ;; Print what kind of function-like object FUNCTION is. + (princ (cond ((or (stringp def) (vectorp def)) + "a keyboard macro") + ((subrp def) + (if (eq 'unevalled (cdr (subr-arity def))) + (concat beg "special form") + (concat beg "built-in function"))) + ((byte-code-function-p def) + (concat beg "compiled Lisp function")) + (aliased + (format "an alias for `%s'" real-def)) + ((eq (car-safe def) 'lambda) + (concat beg "Lisp function")) + ((eq (car-safe def) 'macro) + (concat beg "Lisp macro")) + ((eq (car-safe def) 'closure) + (concat beg "Lisp closure")) + ((autoloadp def) + (format "%s autoloaded %s" + (if (commandp def) "an interactive" "an") + (if (eq (nth 4 def) 'keymap) "keymap" + (if (nth 4 def) "Lisp macro" "Lisp function")))) + ((keymapp def) + (let ((is-full nil) + (elts (cdr-safe def))) + (while elts + (if (char-table-p (car-safe elts)) + (setq is-full t + elts nil)) + (setq elts (cdr-safe elts))) + (concat beg (if is-full "keymap" "sparse keymap")))) + (t ""))) + + (if (and aliased (not (fboundp real-def))) (princ ",\nwhich is not defined. Please make a bug report.") (with-current-buffer standard-output (save-excursion (save-match-data (when (re-search-backward "alias for `\\([^`']+\\)'" nil t) - (help-xref-button 1 'help-function def))))) + (help-xref-button 1 'help-function real-def))))) - (setq file-name (find-lisp-object-file-name function def)) (when file-name (princ " in `") ;; We used to add .el to the file name, @@ -531,11 +554,21 @@ suitable file is found, return nil." (unless (looking-back "\n\n") (terpri))))) (help-fns--compiler-macro function) - (let* ((advertised (gethash def advertised-signature-table t)) + (let* ((advertised (gethash real-def advertised-signature-table t)) (arglist (if (listp advertised) - advertised (help-function-arglist def))) - (doc (condition-case err (documentation function) - (error (format "No Doc! %S" err)))) + advertised (help-function-arglist real-def))) + (doc-raw (condition-case err + (documentation function t) + (error (format "No Doc! %S" err)))) + ;; If the function is autoloaded, and its docstring has + ;; key substitution constructs, load the library. + (doc (progn + (and (autoloadp real-def) + help-enable-auto-load + (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]" + doc-raw) + (load (cadr real-def) t)) + (substitute-command-keys doc-raw))) (usage (help-split-fundoc doc function))) (with-current-buffer standard-output ;; If definition is a keymap, skip arglist note. @@ -556,9 +589,9 @@ suitable file is found, return nil." function))))) usage) (car usage)) - ((or (stringp def) - (vectorp def)) - (format "\nMacro: %s" (format-kbd-macro def))) + ((or (stringp real-def) + (vectorp real-def)) + (format "\nMacro: %s" (format-kbd-macro real-def))) (t "[Missing arglist. Please make a bug report.]"))) (high (help-highlight-arguments use doc))) (let ((fill-begin (point))) @@ -806,8 +839,12 @@ it is displayed along with the global value." (obsolete (get variable 'byte-obsolete-variable)) (use (car obsolete)) (safe-var (get variable 'safe-local-variable)) - (doc (or (documentation-property variable 'variable-documentation) - (documentation-property alias 'variable-documentation))) + (doc (condition-case err + (or (documentation-property + variable 'variable-documentation) + (documentation-property + alias 'variable-documentation)) + (error (format "Doc not found: %S" err)))) (extra-line nil)) ;; Add a note for variables that have been make-var-buffer-local. (when (and (local-variable-if-set-p variable) @@ -815,7 +852,10 @@ it is displayed along with the global value." (with-temp-buffer (local-variable-if-set-p variable)))) (setq extra-line t) - (princ " Automatically becomes buffer-local when set in any fashion.\n")) + (princ " Automatically becomes ") + (if (get variable 'permanent-local) + (princ "permanently ")) + (princ "buffer-local when set.\n")) ;; Mention if it's an alias (unless (eq alias variable) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 85c1e62e2c3..7b6490b6b13 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -30,7 +30,6 @@ ;;; Code: (require 'button) -(require 'view) (eval-when-compile (require 'easymenu)) (defvar help-mode-map @@ -288,10 +287,7 @@ Commands: ;;;###autoload (defun help-mode-finish () (when (eq major-mode 'help-mode) - ;; View mode's read-only status of existing *Help* buffer is lost - ;; by with-output-to-temp-buffer. - (toggle-read-only 1) - + (setq buffer-read-only t) (save-excursion (goto-char (point-min)) (let ((inhibit-read-only t)) @@ -500,14 +496,14 @@ that." ((and (or (boundp sym) (get sym 'variable-documentation)) - (or - (documentation-property - sym 'variable-documentation) - (condition-case nil + (condition-case err + (or + (documentation-property + sym 'variable-documentation) (documentation-property (indirect-variable sym) - 'variable-documentation) - (cyclic-variable-indirection nil)))) + 'variable-documentation)) + (error (message "No doc found: %S" err) nil))) (help-xref-button 8 'help-variable sym)) ((fboundp sym) (help-xref-button 8 'help-function sym))))))) diff --git a/lisp/help.el b/lisp/help.el index 2dbb31de97b..c02b058fef9 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1030,6 +1030,16 @@ by `with-help-window'" :group 'help :version "23.1") +(defcustom help-enable-auto-load t + "Whether Help commands can perform autoloading. +If non-nil, whenever \\[describe-function] is called for an +autoloaded function whose docstring contains any key substitution +construct (see `substitute-command-keys'), the library is loaded, +so that the documentation can show the right key bindings." + :type 'boolean + :group 'help + :version "24.2") + (defun help-window-display-message (quit-part window &optional scroll) "Display message telling how to quit and scroll help window. QUIT-PART is a string telling how to quit the help window WINDOW. diff --git a/lisp/hexl.el b/lisp/hexl.el index a754a151fb7..75094cd33b8 100644 --- a/lisp/hexl.el +++ b/lisp/hexl.el @@ -41,7 +41,7 @@ ;;; Code: (require 'eldoc) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;; ;; vars here @@ -462,7 +462,7 @@ and edit the file in `hexl-mode'." (let ((completion-ignored-extensions nil)) (read-file-name "Filename: " nil nil 'ret-must-match)))) ;; Ignore the user's setting of default major-mode. - (letf (((default-value 'major-mode) 'fundamental-mode)) + (cl-letf (((default-value 'major-mode) 'fundamental-mode)) (find-file-literally filename)) (if (not (eq major-mode 'hexl-mode)) (hexl-mode))) diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el index adcd83d33a5..f787319fb0c 100644 --- a/lisp/hippie-exp.el +++ b/lisp/hippie-exp.el @@ -156,7 +156,7 @@ ;; opposite situation to occur, that `hippie-expand' misses some ;; suggestion because it thinks it has already tried it. ;; -;; Acknowledgement +;; Acknowledgment ;; ;; I want to thank Mikael Djurfeldt in discussions with whom the idea ;; of this function took form. diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 58d38f77b66..97df90a65af 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -35,7 +35,7 @@ (eval-when-compile (require 'ibuf-macs) - (require 'cl)) + (require 'cl-lib)) ;;; Utility functions (defun ibuffer-delete-alist (key alist) @@ -497,12 +497,12 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'." (defun ibuffer-included-in-filter-p-1 (buf filter) (not (not - (case (car filter) - (or + (pcase (car filter) + (`or (memq t (mapcar #'(lambda (x) (ibuffer-included-in-filter-p buf x)) (cdr filter)))) - (saved + (`saved (let ((data (assoc (cdr filter) ibuffer-saved-filters))) @@ -510,19 +510,13 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'." (ibuffer-filter-disable t) (error "Unknown saved filter %s" (cdr filter))) (ibuffer-included-in-filters-p buf (cadr data)))) - (t - (let ((filterdat (assq (car filter) - ibuffer-filtering-alist))) - ;; filterdat should be like (TYPE DESCRIPTION FUNC) - ;; just a sanity check - (unless filterdat - (ibuffer-filter-disable t) - (error "Undefined filter %s" (car filter))) - (not - (not - (funcall (caddr filterdat) - buf - (cdr filter)))))))))) + (_ + (pcase-let ((`(,_type ,_desc ,func) + (assq (car filter) ibuffer-filtering-alist))) + (unless func + (ibuffer-filter-disable t) + (error "Undefined filter %s" (car filter))) + (funcall func buf (cdr filter)))))))) (defun ibuffer-generate-filter-groups (bmarklist &optional noempty nodefault) (let ((filter-group-alist (if nodefault @@ -536,14 +530,14 @@ To evaluate a form without viewing the buffer, see `ibuffer-do-eval'." (i 0)) (dolist (filtergroup filter-group-alist) (let ((filterset (cdr filtergroup))) - (multiple-value-bind (hip-crowd lamers) - (values-list + (cl-multiple-value-bind (hip-crowd lamers) + (cl-values-list (ibuffer-split-list (lambda (bufmark) (ibuffer-included-in-filters-p (car bufmark) filterset)) bmarklist)) (aset vec i hip-crowd) - (incf i) + (cl-incf i) (setq bmarklist lamers)))) (let (ret) (dotimes (j i ret) @@ -689,7 +683,7 @@ See also `ibuffer-kill-filter-group'." (if (equal (car groups) group) (setq found t groups nil) - (incf res) + (cl-incf res) (setq groups (cdr groups)))) res))) (cond ((not found) @@ -810,12 +804,12 @@ turned into two separate filters [name: foo] and [mode: bar-mode]." (when (null ibuffer-filtering-qualifiers) (error "No filters in effect")) (let ((lim (pop ibuffer-filtering-qualifiers))) - (case (car lim) - (or + (pcase (car lim) + (`or (setq ibuffer-filtering-qualifiers (append (cdr lim) ibuffer-filtering-qualifiers))) - (saved + (`saved (let ((data (assoc (cdr lim) ibuffer-saved-filters))) @@ -825,10 +819,10 @@ turned into two separate filters [name: foo] and [mode: bar-mode]." (setq ibuffer-filtering-qualifiers (append (cadr data) ibuffer-filtering-qualifiers)))) - (not + (`not (push (cdr lim) ibuffer-filtering-qualifiers)) - (t + (_ (error "Filter type %s is not compound" (car lim))))) (ibuffer-update nil t)) @@ -960,13 +954,13 @@ Interactively, prompt for NAME, and use the current filters." (ibuffer-format-qualifier-1 qualifier))) (defun ibuffer-format-qualifier-1 (qualifier) - (case (car qualifier) - (saved + (pcase (car qualifier) + (`saved (concat " [filter: " (cdr qualifier) "]")) - (or + (`or (concat " [OR" (mapconcat #'ibuffer-format-qualifier (cdr qualifier) "") "]")) - (t + (_ (let ((type (assq (car qualifier) ibuffer-filtering-alist))) (unless qualifier (error "Ibuffer: bad qualifier %s" qualifier)) @@ -1414,14 +1408,14 @@ You can then feed the file name(s) to other commands with \\[yank]." (concat ibuffer-copy-filename-as-kill-result (let ((name (buffer-file-name buf))) (if name - (case type - (full + (pcase type + (`full name) - (relative + (`relative (file-relative-name name (or ibuffer-default-directory default-directory))) - (t + (_ (file-name-nondirectory name))) "")) " ")))) @@ -1550,13 +1544,8 @@ You can then feed the file name(s) to other commands with \\[yank]." (with-current-buffer buf ;; hacked from midnight.el (when buffer-display-time - (let* ((tm (current-time)) - (now (+ (* (float (ash 1 16)) (car tm)) - (float (cadr tm)) (* 0.0000001 (caddr tm)))) - (then (+ (* (float (ash 1 16)) - (car buffer-display-time)) - (float (cadr buffer-display-time)) - (* 0.0000001 (caddr buffer-display-time))))) + (let* ((now (float-time)) + (then (float-time buffer-display-time))) (> (- now then) (* 60 60 ibuffer-old-time)))))))) ;;;###autoload diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el index 659b8e7d78c..ebf34c120e5 100644 --- a/lisp/ibuf-macs.el +++ b/lisp/ibuf-macs.el @@ -27,8 +27,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;; From Paul Graham's "ANSI Common Lisp", adapted for Emacs Lisp here. (defmacro ibuffer-aif (test true-body &rest false-body) @@ -73,7 +72,7 @@ During evaluation of body, bind `it' to the value returned by TEST." (ibuffer-redisplay t)))))) ;;;###autoload -(defmacro* define-ibuffer-column (symbol (&key name inline props summarizer +(cl-defmacro define-ibuffer-column (symbol (&key name inline props summarizer header-mouse-map) &rest body) "Define a column SYMBOL for use with `ibuffer-formats'. @@ -129,7 +128,7 @@ change its definition, you should explicitly call :autoload-end))) ;;;###autoload -(defmacro* define-ibuffer-sorter (name documentation +(cl-defmacro define-ibuffer-sorter (name documentation (&key description) &rest body) @@ -160,7 +159,7 @@ value if and only if `a' is \"less than\" `b'. :autoload-end)) ;;;###autoload -(defmacro* define-ibuffer-op (op args +(cl-defmacro define-ibuffer-op (op args documentation (&key interactive @@ -213,19 +212,19 @@ macro for exactly what it does. ,(if (not (null interactive)) `(interactive ,interactive) '(interactive)) - (assert (derived-mode-p 'ibuffer-mode)) + (cl-assert (derived-mode-p 'ibuffer-mode)) (setq ibuffer-did-modification nil) - (let ((marked-names (,(case mark + (let ((marked-names (,(pcase mark (:deletion 'ibuffer-deletion-marked-buffer-names) - (t + (_ 'ibuffer-marked-buffer-names))))) (when (null marked-names) (setq marked-names (list (buffer-name (ibuffer-current-buffer)))) - (ibuffer-set-mark ,(case mark + (ibuffer-set-mark ,(pcase mark (:deletion 'ibuffer-deletion-char) - (t + (_ 'ibuffer-marked-char)))) ,(let* ((finish (append '(progn) @@ -242,10 +241,10 @@ macro for exactly what it does. ,@body)) t))) (body `(let ((count - (,(case mark + (,(pcase mark (:deletion 'ibuffer-map-deletion-lines) - (t + (_ 'ibuffer-map-marked-lines)) #'(lambda (buf mark) ,(if (eq modifier-p :maybe) @@ -264,7 +263,7 @@ macro for exactly what it does. :autoload-end)) ;;;###autoload -(defmacro* define-ibuffer-filter (name documentation +(cl-defmacro define-ibuffer-filter (name documentation (&key reader description) diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index adb7a12243a..d29653c41ae 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -31,7 +31,7 @@ ;;; Code: (eval-when-compile - (require 'cl) + (require 'cl-lib) (require 'ibuf-macs) (require 'dired)) @@ -1017,7 +1017,7 @@ width and the longest string in LIST." (when (get-text-property (point) 'ibuffer-title) (forward-line 1) (setq arg 1)) - (decf arg))) + (cl-decf arg))) (defun ibuffer-forward-line (&optional arg skip-group-names) "Move forward ARG lines, wrapping around the list if necessary." @@ -1032,7 +1032,7 @@ width and the longest string in LIST." (and skip-group-names (get-text-property (point) 'ibuffer-filter-group-name))) (when (> arg 0) - (decf arg)) + (cl-decf arg)) (ibuffer-skip-properties (append '(ibuffer-title) (when skip-group-names '(ibuffer-filter-group-name))) @@ -1045,7 +1045,7 @@ width and the longest string in LIST." (or (eobp) (get-text-property (point) 'ibuffer-summary))) (goto-char (point-min))) - (decf arg) + (cl-decf arg) (ibuffer-skip-properties (append '(ibuffer-title) (when skip-group-names '(ibuffer-filter-group-name))) @@ -1190,7 +1190,7 @@ a new window in the current frame, splitting vertically." (setq trying nil)) (error ;; Handle a failure - (if (or (> (incf attempts) 4) + (if (or (> (cl-incf attempts) 4) (and (stringp (cadr err)) ;; This definitely falls in the ;; ghetto hack category... @@ -1243,7 +1243,7 @@ a new window in the current frame, splitting vertically." (ibuffer-map-on-mark ibuffer-deletion-char func)) (defsubst ibuffer-assert-ibuffer-mode () - (assert (derived-mode-p 'ibuffer-mode))) + (cl-assert (derived-mode-p 'ibuffer-mode))) (defun ibuffer-buffer-file-name () (or buffer-file-name @@ -1283,7 +1283,7 @@ With optional ARG, make read-only only if ARG is positive." (:opstring "toggled read only status in" :interactive "P" :modifier-p t) - (toggle-read-only arg)) + (toggle-read-only arg t)) (define-ibuffer-op ibuffer-do-delete () "Kill marked buffers as with `kill-this-buffer'." @@ -1504,11 +1504,11 @@ If point is on a group name, this function operates on that group." `(progn (setq tmp1 ,widthform tmp2 (/ tmp1 2)) - ,(case alignment + ,(pcase alignment (:right `(concat ,left ,right ,strvar)) (:center `(concat ,left ,strvar ,right)) (:left `(concat ,strvar ,left ,right)) - (t (error "Invalid alignment %s" alignment)))))) + (_ (error "Invalid alignment %s" alignment)))))) (defun ibuffer-compile-format (format) (let ((result nil) @@ -1529,7 +1529,7 @@ If point is on a group name, this function operates on that group." (max (nth 2 form)) (align (nth 3 form)) (elide (nth 4 form))) - (let* ((from-end-p (when (minusp min) + (let* ((from-end-p (when (cl-minusp min) (setq min (- min)) t)) (letbindings nil) @@ -1812,10 +1812,10 @@ If point is on a group name, this function operates on that group." (defun ibuffer-format-column (str width alignment) (let ((left (make-string (/ width 2) ?\s)) (right (make-string (- width (/ width 2)) ?\s))) - (case alignment + (pcase alignment (:right (concat left right str)) (:center (concat left str right)) - (t (concat str left right))))) + (_ (concat str left right))))) (defun ibuffer-buffer-name-face (buf mark) (cond ((char-equal mark ibuffer-marked-char) @@ -1913,18 +1913,18 @@ the buffer object itself and the current mark symbol." ;; `nil' if it chose not to affect the buffer ;; `kill' means the remove line from the buffer list ;; `t' otherwise - (incf ibuffer-map-lines-total) + (cl-incf ibuffer-map-lines-total) (cond ((null result) (forward-line 1)) ((eq result 'kill) (delete-region (line-beginning-position) (1+ (line-end-position))) - (incf ibuffer-map-lines-count) + (cl-incf ibuffer-map-lines-count) (when (< ibuffer-map-lines-total orig-target-line) - (decf target-line-offset))) + (cl-decf target-line-offset))) (t - (incf ibuffer-map-lines-count) + (cl-incf ibuffer-map-lines-count) (forward-line 1))))) ibuffer-map-lines-count) (progn @@ -2054,12 +2054,9 @@ the value of point at the beginning of the line for that buffer." (insert (if (stringp element) element - (let ((sym (car element)) - (min (cadr element)) - ;; (max (caddr element)) - (align (cadddr element))) + (pcase-let ((`(,sym ,min ,_max ,align) element)) ;; Ignore a negative min when we're inserting the title - (when (minusp min) + (when (cl-minusp min) (setq min (- min))) (let* ((name (or (get sym 'ibuffer-column-name) (error "Unknown column %s in ibuffer-formats" sym))) @@ -2107,24 +2104,23 @@ the value of point at the beginning of the line for that buffer." (insert (if (stringp element) (make-string (length element) ?\s) - (let ((sym (car element))) - (let ((min (cadr element)) - ;; (max (caddr element)) - (align (cadddr element))) - ;; Ignore a negative min when we're inserting the title - (when (minusp min) - (setq min (- min))) - (let* ((summary (if (get sym 'ibuffer-column-summarizer) - (funcall (get sym 'ibuffer-column-summarizer) - (get sym 'ibuffer-column-summary)) - (make-string (length (get sym 'ibuffer-column-name)) - ?\s))) - (len (length summary))) - (if (< len min) - (ibuffer-format-column summary - (- min len) - align) - summary))))))) + (pcase-let ((`(,sym ,min ,_max ,align) element)) + ;; Ignore a negative min when we're inserting the title. + (when (cl-minusp min) + (setq min (- min))) + (let* ((summary + (if (get sym 'ibuffer-column-summarizer) + (funcall (get sym 'ibuffer-column-summarizer) + (get sym 'ibuffer-column-summary)) + (make-string + (length (get sym 'ibuffer-column-name)) + ?\s))) + (len (length summary))) + (if (< len min) + (ibuffer-format-column summary + (- min len) + align) + summary)))))) (point)) `(ibuffer-summary t))))) @@ -2168,7 +2164,7 @@ If optional arg SILENT is non-nil, do not display progress messages." (eq ibuffer-always-show-last-buffer :nomini) (minibufferp (cadr bufs))) - (caddr bufs) + (cl-caddr bufs) (cadr bufs)) (ibuffer-current-buffers-with-marks bufs) ibuffer-display-maybe-show-predicates))) @@ -2200,7 +2196,7 @@ If optional arg SILENT is non-nil, do not display progress messages." (require 'ibuf-ext)) (let* ((sortdat (assq ibuffer-sorting-mode ibuffer-sorting-functions-alist)) - (func (caddr sortdat))) + (func (cl-caddr sortdat))) (let ((result ;; actually sort the buffers (if (and sortdat func) @@ -2574,11 +2570,11 @@ will be inserted before the group at point." ;; `ibuffer-update' puts this on header-line-format when needed. (setq ibuffer-header-line-format ;; Display the part that won't be in the mode-line. - (list* "" mode-name - (mapcar (lambda (elem) - (if (eq (car-safe elem) 'header-line-format) - (nth 2 elem) elem)) - mode-line-process))) + `("" ,mode-name + ,@(mapcar (lambda (elem) + (if (eq (car-safe elem) 'header-line-format) + (nth 2 elem) elem)) + mode-line-process))) (setq buffer-read-only t) (buffer-disable-undo) @@ -2645,7 +2641,7 @@ will be inserted before the group at point." ;;;;;; ibuffer-backward-filter-group ibuffer-forward-filter-group ;;;;;; ibuffer-toggle-filter-group ibuffer-mouse-toggle-filter-group ;;;;;; ibuffer-interactive-filter-by-mode ibuffer-mouse-filter-by-mode -;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "296999191b08d76d9763a8ebf510d5d8") +;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "c255d1ebe80ccabd8385f40bdd0b5451") ;;; Generated autoloads from ibuf-ext.el (autoload 'ibuffer-auto-mode "ibuf-ext" "\ diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 97a14b12891..a4e3e339470 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -209,10 +209,12 @@ Usually run by inclusion in `minibuffer-setup-hook'." (when (and icomplete-mode (icomplete-simple-completing-p)) (set (make-local-variable 'completion-show-inline-help) nil) (add-hook 'pre-command-hook - (lambda () (run-hooks 'icomplete-pre-command-hook)) + (lambda () (let ((non-essential t)) + (run-hooks 'icomplete-pre-command-hook))) nil t) (add-hook 'post-command-hook - (lambda () (run-hooks 'icomplete-post-command-hook)) + (lambda () (let ((non-essential t)) ;E.g. don't prompt for password! + (run-hooks 'icomplete-post-command-hook))) nil t) (run-hooks 'icomplete-minibuffer-setup-hook))) ; @@ -285,8 +287,7 @@ The displays for unambiguous matches have ` [Matched]' appended matches exist. \(Keybindings for uniquely matched commands are exhibited within the square braces.)" - (let* ((non-essential t) - (md (completion--field-metadata (field-beginning))) + (let* ((md (completion--field-metadata (field-beginning))) (comps (completion-all-sorted-completions)) (last (if (consp comps) (last comps))) (base-size (cdr last)) diff --git a/lisp/ido.el b/lisp/ido.el index 6e79a20767e..2100def1992 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -279,7 +279,7 @@ ;; can be used by other packages to read a buffer name, a file name, ;; or a directory name in the `ido' way. -;;; Acknowledgements +;;; Acknowledgments ;; Infinite amounts of gratitude goes to Stephen Eglen ;; who wrote iswitch-buffer mode - from which I ripped off 99% of the code @@ -4046,8 +4046,7 @@ their normal keybindings, except for the following: \\ RET Select the file at the front of the list of matches. If the list is empty, possibly prompt to create new file. -\\[ido-select-text] Select the current prompt as the buffer or file. -If no buffer or file is found, prompt for a new one. +\\[ido-select-text] Use the current input string verbatim. \\[ido-next-match] Put the first element at the end of the list. \\[ido-prev-match] Put the last element at the start of the list. @@ -4142,6 +4140,7 @@ If no buffer or file is found, prompt for a new one. matches all files. If there is only one match, select that file. If there is no common suffix, show a list of all matching files in a separate window. +\\[ido-magic-delete-char] Open the specified directory in Dired mode. \\[ido-edit-input] Edit input string (including directory). \\[ido-prev-work-directory] or \\[ido-next-work-directory] go to previous/next directory in work directory history. \\[ido-merge-work-directories] search for file in the work directory history. diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 8151985e747..3659894f08d 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -157,7 +157,7 @@ (require 'widget) (eval-when-compile - (require 'cl) + (require 'cl-lib) (require 'wid-edit)) (defgroup image-dired nil @@ -602,14 +602,14 @@ according to the Thumbnail Managing Standard." (md5 (file-name-as-directory (file-name-directory f))))) (format "%s%s%s.thumb.%s" (file-name-as-directory (expand-file-name (image-dired-dir))) - (file-name-sans-extension (file-name-nondirectory f)) + (file-name-base f) (if md5-hash (concat "_" md5-hash) "") (file-name-extension f)))) ((eq 'per-directory image-dired-thumbnail-storage) (let ((f (expand-file-name file))) (format "%s.image-dired/%s.thumb.%s" (file-name-directory f) - (file-name-sans-extension (file-name-nondirectory f)) + (file-name-base f) (file-name-extension f)))))) (defun image-dired-create-thumb (original-file thumbnail-file) @@ -653,21 +653,24 @@ previous -ARG, if ARG<0) files." (image-file (dired-get-filename nil t)) thumb-file overlay) - (when (and image-file (string-match-p (image-file-name-regexp) image-file)) + (when (and image-file + (string-match-p (image-file-name-regexp) image-file)) (setq thumb-file (image-dired-get-thumbnail-image image-file)) ;; If image is not already added, then add it. (let ((cur-ov (overlays-in (point) (1+ (point))))) (if cur-ov (delete-overlay (car cur-ov)) (put-image thumb-file image-pos) - (setq overlay (loop for o in (overlays-in (point) (1+ (point))) - when (overlay-get o 'put-image) collect o into ov - finally return (car ov))) + (setq overlay + (cl-loop for o in (overlays-in (point) (1+ (point))) + when (overlay-get o 'put-image) collect o into ov + finally return (car ov))) (overlay-put overlay 'image-file image-file) (overlay-put overlay 'thumb-file thumb-file))))) arg ; Show or hide image on ARG next files. 'show-progress) ; Update dired display after each image is updated. - (add-hook 'dired-after-readin-hook 'image-dired-dired-after-readin-hook nil t)) + (add-hook 'dired-after-readin-hook + 'image-dired-dired-after-readin-hook nil t)) (defun image-dired-dired-after-readin-hook () "Relocate existing thumbnail overlays in dired buffer after reverting. diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 46ce6aa14d3..fabc12c0219 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -34,7 +34,7 @@ ;;; Code: (require 'image) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;;; Image mode window-info management. @@ -70,12 +70,11 @@ A winprops object has the shape (WINDOW . ALIST)." winprops)) (defun image-mode-window-get (prop &optional winprops) + (declare (gv-setter (lambda (val) + `(image-mode-window-put ,prop ,val ,winprops)))) (unless (consp winprops) (setq winprops (image-mode-winprops winprops))) (cdr (assq prop (cdr winprops)))) -(defsetf image-mode-window-get (prop &optional winprops) (val) - `(image-mode-window-put ,prop ,val ,winprops)) - (defun image-mode-window-put (prop val &optional winprops) (unless (consp winprops) (setq winprops (image-mode-winprops winprops))) (setcdr winprops (cons (cons prop val) @@ -692,20 +691,20 @@ a slightly different angle. Currently this is done for values close to a multiple of 90, see `image-transform-right-angle-fudge'." (cond ((< (abs (- (mod (+ image-transform-rotation 90) 180) 90)) image-transform-right-angle-fudge) - (assert (not (zerop width)) t) + (cl-assert (not (zerop width)) t) (setq image-transform-rotation (float (round image-transform-rotation)) image-transform-scale (/ (float length) width)) (cons length nil)) ((< (abs (- (mod (+ image-transform-rotation 45) 90) 45)) image-transform-right-angle-fudge) - (assert (not (zerop height)) t) + (cl-assert (not (zerop height)) t) (setq image-transform-rotation (float (round image-transform-rotation)) image-transform-scale (/ (float length) height)) (cons nil length)) (t - (assert (not (and (zerop width) (zerop height))) t) + (cl-assert (not (and (zerop width) (zerop height))) t) (setq image-transform-scale (/ (float (1- length)) (image-transform-width width height))) ;; Assume we have a w x h image and an angle A, and let l = @@ -743,12 +742,12 @@ close to a multiple of 90, see `image-transform-right-angle-fudge'." (unless (numberp image-transform-resize) (let ((size (image-display-size (image-get-display-property) t))) (cond ((eq image-transform-resize 'fit-width) - (assert (= (car size) + (cl-assert (= (car size) (- (nth 2 (window-inside-pixel-edges)) (nth 0 (window-inside-pixel-edges)))) t)) ((eq image-transform-resize 'fit-height) - (assert (= (cdr size) + (cl-assert (= (cdr size) (- (nth 3 (window-inside-pixel-edges)) (nth 1 (window-inside-pixel-edges)))) t)))))) diff --git a/lisp/imenu.el b/lisp/imenu.el index 24beb9c89c1..8cef5161a37 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -59,7 +59,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -481,7 +481,7 @@ The returned list DOES NOT share structure with LIST." (i 0)) (while remain (push (pop remain) sublist) - (incf i) + (cl-incf i) (and (= i n) ;; We have finished a sublist (progn (push (nreverse sublist) result) @@ -593,17 +593,17 @@ Non-nil arguments are in recursive calls." t)) (defun imenu--create-keymap (title alist &optional cmd) - (list* 'keymap title - (mapcar - (lambda (item) - (list* (car item) (car item) - (cond - ((imenu--subalist-p item) - (imenu--create-keymap (car item) (cdr item) cmd)) - (t - `(lambda () (interactive) - ,(if cmd `(,cmd ',item) (list 'quote item))))))) - alist))) + `(keymap ,title + ,@(mapcar + (lambda (item) + `(,(car item) ,(car item) + ,@(cond + ((imenu--subalist-p item) + (imenu--create-keymap (car item) (cdr item) cmd)) + (t + `(lambda () (interactive) + ,(if cmd `(,cmd ',item) (list 'quote item))))))) + alist))) (defun imenu--in-alist (str alist) "Check whether the string STR is contained in multi-level ALIST." diff --git a/lisp/info-look.el b/lisp/info-look.el index 5eca62ed1bd..eb780fe5620 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -732,7 +732,7 @@ Return nil if there is nothing appropriate in the buffer near point." :parse-rule "\\$[^({]\\|\\.[_A-Z]*\\|[_a-zA-Z0-9-]+\\|##\\|\\+=" :doc-spec '( ;; "(automake)Macro Index" is autoconf macros used in - ;; configure.in, not Makefile.am, so don't have that here. + ;; configure.ac, not Makefile.am, so don't have that here. ("(automake)Variable Index" nil "^[ \t]*`" "'") ;; In automake 1.4 macros and variables were a combined node. ("(automake)Macro and Variable Index" nil "^[ \t]*`" "'") diff --git a/lisp/info-xref.el b/lisp/info-xref.el index 69ec00ce09d..ebe50551a69 100644 --- a/lisp/info-xref.el +++ b/lisp/info-xref.el @@ -45,8 +45,7 @@ ;;; Code: (require 'info) -(eval-when-compile - (require 'cl)) ;; for `incf' +(eval-when-compile (require 'cl-lib)) ;; for `incf' ;;----------------------------------------------------------------------------- ;; vaguely generic @@ -239,11 +238,11 @@ buffer's line and column of point." ;; if the file exists, try the node (cond ((not (cdr (assoc file info-xref-xfile-alist))) - (incf info-xref-unavail)) + (cl-incf info-xref-unavail)) ((info-xref-goto-node-p node) - (incf info-xref-good)) + (cl-incf info-xref-good)) (t - (incf info-xref-bad) + (cl-incf info-xref-bad) (info-xref-output-error "no such node: %s" node))))))) @@ -447,8 +446,8 @@ and can take a long time." (if (eq :tag (cadr link)) (setq link (cddr link))) (if (info-xref-goto-node-p (cadr link)) - (incf info-xref-good) - (incf info-xref-bad) + (cl-incf info-xref-good) + (cl-incf info-xref-bad) ;; symbol-file gives nil for preloaded variables, would need ;; to copy what describe-variable does to show the right place (info-xref-output "Symbol `%s' (file %s): cannot goto node: %s" diff --git a/lisp/info.el b/lisp/info.el index 112c9068353..163e0af161a 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -32,8 +32,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - (defgroup info nil "Info subsystem." :group 'help @@ -169,6 +167,83 @@ A header-line does not scroll with the rest of the buffer." "Face for Info nodes in a node header." :group 'info) +;; This is a defcustom largely so that we can get the benefit +;; of custom-initialize-delay. Perhaps it would work to make it a +;; defvar and explicitly give it a standard-value property, and +;; call custom-initialize-delay on it. +;; The progn forces the autoloader to include the whole thing, not +;; just an abbreviated version. +;;;###autoload +(progn +(defcustom Info-default-directory-list + (let* ((config-dir + (file-name-as-directory + ;; Self-contained NS build with info/ in the app-bundle. + (or (and (featurep 'ns) + (let ((dir (expand-file-name "../info" data-directory))) + (if (file-directory-p dir) dir))) + configure-info-directory))) + (prefixes + ;; Directory trees in which to look for info subdirectories + (prune-directory-list '("/usr/local/" "/usr/" "/opt/" "/"))) + (suffixes + ;; Subdirectories in each directory tree that may contain info + ;; directories. Most of these are rather outdated. + ;; It ought to be fine to stop checking the "emacs" ones now, + ;; since this is Emacs and we have not installed info files + ;; into such directories for a looong time... + '("share/" "" "gnu/" "gnu/lib/" "gnu/lib/emacs/" + "emacs/" "lib/" "lib/emacs/")) + (standard-info-dirs + (apply #'nconc + (mapcar (lambda (pfx) + (let ((dirs + (mapcar (lambda (sfx) + (concat pfx sfx "info/")) + suffixes))) + (prune-directory-list dirs))) + prefixes))) + ;; If $(prefix)/share/info is not one of the standard info + ;; directories, they are probably installing an experimental + ;; version of Emacs, so make sure that experimental version's Info + ;; files override the ones in standard directories. + (dirs + (if (member config-dir standard-info-dirs) + ;; FIXME? What is the point of adding it again at the end + ;; when it is already present earlier in the list? + (nconc standard-info-dirs (list config-dir)) + (cons config-dir standard-info-dirs)))) + (if (not (eq system-type 'windows-nt)) + dirs + ;; Include the info directory near where Emacs executable was installed. + (let* ((instdir (file-name-directory invocation-directory)) + (dir1 (expand-file-name "../info/" instdir)) + (dir2 (expand-file-name "../../../info/" instdir))) + (cond ((file-exists-p dir1) (append dirs (list dir1))) + ((file-exists-p dir2) (append dirs (list dir2))) + (t dirs))))) + + "Default list of directories to search for Info documentation files. +They are searched in the order they are given in the list. +Therefore, the directory of Info files that come with Emacs +normally should come last (so that local files override standard ones), +unless Emacs is installed into a non-standard directory. In the latter +case, the directory of Info files that come with Emacs should be +first in this list. + +Once Info is started, the list of directories to search +comes from the variable `Info-directory-list'. +This variable `Info-default-directory-list' is used as the default +for initializing `Info-directory-list' when Info is started, unless +the environment variable INFOPATH is set. + +Although this is a customizable variable, that is mainly for technical +reasons. Normally, you should either set INFOPATH or customize +`Info-additional-directory-list', rather than changing this variable." + :initialize 'custom-initialize-delay + :type '(repeat directory) + :group 'info)) + (defvar Info-directory-list nil "List of directories to search for Info documentation files. If nil, meaning not yet initialized, Info uses the environment @@ -3692,15 +3767,22 @@ If FORK is non-nil, it is passed to `Info-goto-node'." (defun Info-mouse-follow-link (click) "Follow a link where you click." - (interactive "e") + (interactive "@e") (let* ((position (event-start click)) (posn-string (and position (posn-string position))) - (string (car-safe posn-string)) - (string-pos (cdr-safe posn-string)) - (link-args (and string string-pos - (get-text-property string-pos 'link-args string)))) - (when link-args - (Info-goto-node link-args)))) + (link-args (if posn-string + (get-text-property (cdr posn-string) + 'link-args + (car posn-string)) + (get-char-property (posn-point position) + 'link-args)))) + (cond ((stringp link-args) + (Info-goto-node link-args)) + ;; These special values of the `link-args' property are used + ;; for navigation; see `Info-fontify-node'. + ((eq link-args 'prev) (Info-prev)) + ((eq link-args 'next) (Info-next)) + ((eq link-args 'up) (Info-up))))) (defvar Info-mode-map @@ -4275,45 +4357,17 @@ the variable `Info-file-list-for-emacs'." (t (Info-goto-emacs-command-node command))))) -(defvar Info-next-link-keymap - (let ((keymap (make-sparse-keymap))) - (define-key keymap [header-line mouse-1] 'Info-next) - (define-key keymap [header-line mouse-2] 'Info-next) - (define-key keymap [header-line down-mouse-1] 'ignore) - (define-key keymap [mouse-2] 'Info-next) - (define-key keymap [follow-link] 'mouse-face) - keymap) - "Keymap to put on the Next link in the text or the header line.") - -(defvar Info-prev-link-keymap - (let ((keymap (make-sparse-keymap))) - (define-key keymap [header-line mouse-1] 'Info-prev) - (define-key keymap [header-line mouse-2] 'Info-prev) - (define-key keymap [header-line down-mouse-1] 'ignore) - (define-key keymap [mouse-2] 'Info-prev) - (define-key keymap [follow-link] 'mouse-face) - keymap) - "Keymap to put on the Prev link in the text or the header line.") - -(defvar Info-up-link-keymap - (let ((keymap (make-sparse-keymap))) - (define-key keymap [header-line mouse-1] 'Info-up) - (define-key keymap [header-line mouse-2] 'Info-up) - (define-key keymap [header-line down-mouse-1] 'ignore) - (define-key keymap [mouse-2] 'Info-up) - (define-key keymap [follow-link] 'mouse-face) - keymap) - "Keymap to put on the Up link in the text or the header line.") - (defvar Info-link-keymap (let ((keymap (make-sparse-keymap))) - (define-key keymap [header-line mouse-1] 'Info-mouse-follow-link) + (define-key keymap [header-line down-mouse-1] 'mouse-drag-header-line) + (define-key keymap [header-line mouse-1] 'mouse-select-window) (define-key keymap [header-line mouse-2] 'Info-mouse-follow-link) - (define-key keymap [header-line down-mouse-1] 'ignore) (define-key keymap [mouse-2] 'Info-mouse-follow-link) (define-key keymap [follow-link] 'mouse-face) keymap) - "Keymap to put on the link in the text or the header line.") + "Keymap to put on Info links. +This is used for the \"Next\", \"Prev\", and \"Up\" links in the +first line or header line, and for breadcrumb links.") (defun Info-breadcrumbs () (let ((nodes (Info-toc-nodes Info-current-file)) @@ -4402,15 +4456,14 @@ the variable `Info-file-list-for-emacs'." 'help-echo (concat "mouse-2: Go to node " (buffer-substring nbeg nend))) - ;; Always set up the text property keymap. - ;; It will either be used in the buffer - ;; or copied in the header line. - (put-text-property - tbeg nend 'keymap - (cond - ((string-equal (downcase tag) "prev") Info-prev-link-keymap) - ((string-equal (downcase tag) "next") Info-next-link-keymap) - ((string-equal (downcase tag) "up" ) Info-up-link-keymap)))))) + ;; Set up the text property keymap. Depending on + ;; `Info-use-header-line', it is either used in the + ;; buffer, or copied to the header line. A symbol value + ;; of the `link-args' property is handled specially by + ;; `Info-mouse-follow-link'. + (put-text-property tbeg nend 'keymap Info-link-keymap) + (put-text-property tbeg nend 'link-args + (intern (downcase tag)))))) ;; (when (> Info-breadcrumbs-depth 0) ;; (insert (Info-breadcrumbs))) diff --git a/lisp/international/iso-ascii.el b/lisp/international/iso-ascii.el index 0566b8ead5c..536cd231753 100644 --- a/lisp/international/iso-ascii.el +++ b/lisp/international/iso-ascii.el @@ -32,7 +32,6 @@ ;;; Code: (require 'disp-table) -(eval-when-compile (require 'cl)) (defgroup iso-ascii nil "Set up char tables for ISO 8859/1 on ASCII terminals." @@ -167,9 +166,14 @@ With a prefix argument ARG, enable the mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil." - :variable (eq standard-display-table iso-ascii-display-table) - (unless standard-display-table - (setq standard-display-table iso-ascii-standard-display-table))) + :variable ((eq standard-display-table iso-ascii-display-table) + . (lambda (v) + (setq standard-display-table + (cond + (v iso-ascii-display-table) + ((eq standard-display-table iso-ascii-display-table) + iso-ascii-standard-display-table) + (t standard-display-table)))))) (provide 'iso-ascii) diff --git a/lisp/international/iso-transl.el b/lisp/international/iso-transl.el index 1afe00eeb2e..5d2818888fe 100644 --- a/lisp/international/iso-transl.el +++ b/lisp/international/iso-transl.el @@ -38,7 +38,6 @@ ;;; Code: ;;; Provide some binding for startup: -;;;###autoload (or key-translation-map (setq key-translation-map (make-sparse-keymap))) ;;;###autoload (define-key key-translation-map "\C-x8" 'iso-transl-ctl-x-8-map) ;;;###autoload (autoload 'iso-transl-ctl-x-8-map "iso-transl" "Keymap for C-x 8 prefix." t 'keymap) @@ -283,11 +282,6 @@ sequence VECTOR. (VECTOR is normally one character long.)") ;; with a language-specific mapping by using `M-x iso-transl-set-language'. (iso-transl-define-keys iso-transl-char-map) -(define-key isearch-mode-map "\C-x" nil) -(define-key isearch-mode-map [?\C-x t] 'isearch-other-control-char) -(define-key isearch-mode-map "\C-x8" nil) - - (provide 'iso-transl) ;;; iso-transl.el ends here diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 0f3d8c2d2bf..93c0cbf47f1 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -58,98 +58,98 @@ (defvar describe-language-environment-map (let ((map (make-sparse-keymap "Describe Language Environment"))) - (define-key map - [Default] `(menu-item ,(purecopy "Default") describe-specified-language-support)) + (bindings--define-key map + [Default] '(menu-item "Default" describe-specified-language-support)) map)) (defvar setup-language-environment-map (let ((map (make-sparse-keymap "Set Language Environment"))) - (define-key map - [Default] `(menu-item ,(purecopy "Default") setup-specified-language-environment)) + (bindings--define-key map + [Default] '(menu-item "Default" setup-specified-language-environment)) map)) (defvar set-coding-system-map (let ((map (make-sparse-keymap "Set Coding System"))) - (define-key-after map [universal-coding-system-argument] - `(menu-item ,(purecopy "For Next Command") universal-coding-system-argument - :help ,(purecopy "Coding system to be used by next command"))) - (define-key-after map [separator-1] menu-bar-separator) - (define-key-after map [set-buffer-file-coding-system] - `(menu-item ,(purecopy "For Saving This Buffer") set-buffer-file-coding-system - :help ,(purecopy "How to encode this buffer when saved"))) - (define-key-after map [revert-buffer-with-coding-system] - `(menu-item ,(purecopy "For Reverting This File Now") - revert-buffer-with-coding-system - :enable buffer-file-name - :help ,(purecopy "Revisit this file immediately using specified coding system"))) - (define-key-after map [set-file-name-coding-system] - `(menu-item ,(purecopy "For File Name") set-file-name-coding-system - :help ,(purecopy "How to decode/encode file names"))) - (define-key-after map [separator-2] menu-bar-separator) - - (define-key-after map [set-keyboard-coding-system] - `(menu-item ,(purecopy "For Keyboard") set-keyboard-coding-system - :help ,(purecopy "How to decode keyboard input"))) - (define-key-after map [set-terminal-coding-system] - `(menu-item ,(purecopy "For Terminal") set-terminal-coding-system - :enable (null (memq initial-window-system '(x w32 ns))) - :help ,(purecopy "How to encode terminal output"))) - (define-key-after map [separator-3] menu-bar-separator) - - (define-key-after map [set-selection-coding-system] - `(menu-item ,(purecopy "For X Selections/Clipboard") set-selection-coding-system - :visible (display-selections-p) - :help ,(purecopy "How to en/decode data to/from selection/clipboard"))) - (define-key-after map [set-next-selection-coding-system] - `(menu-item ,(purecopy "For Next X Selection") set-next-selection-coding-system - :visible (display-selections-p) - :help ,(purecopy "How to en/decode next selection/clipboard operation"))) - (define-key-after map [set-buffer-process-coding-system] - `(menu-item ,(purecopy "For I/O with Subprocess") set-buffer-process-coding-system + (bindings--define-key map [set-buffer-process-coding-system] + '(menu-item "For I/O with Subprocess" set-buffer-process-coding-system :visible (fboundp 'start-process) :enable (get-buffer-process (current-buffer)) - :help ,(purecopy "How to en/decode I/O from/to subprocess connected to this buffer"))) + :help "How to en/decode I/O from/to subprocess connected to this buffer")) + (bindings--define-key map [set-next-selection-coding-system] + '(menu-item "For Next X Selection" set-next-selection-coding-system + :visible (display-selections-p) + :help "How to en/decode next selection/clipboard operation")) + (bindings--define-key map [set-selection-coding-system] + '(menu-item "For X Selections/Clipboard" set-selection-coding-system + :visible (display-selections-p) + :help "How to en/decode data to/from selection/clipboard")) + + (bindings--define-key map [separator-3] menu-bar-separator) + (bindings--define-key map [set-terminal-coding-system] + '(menu-item "For Terminal" set-terminal-coding-system + :enable (null (memq initial-window-system '(x w32 ns))) + :help "How to encode terminal output")) + (bindings--define-key map [set-keyboard-coding-system] + '(menu-item "For Keyboard" set-keyboard-coding-system + :help "How to decode keyboard input")) + + (bindings--define-key map [separator-2] menu-bar-separator) + (bindings--define-key map [set-file-name-coding-system] + '(menu-item "For File Name" set-file-name-coding-system + :help "How to decode/encode file names")) + (bindings--define-key map [revert-buffer-with-coding-system] + '(menu-item "For Reverting This File Now" + revert-buffer-with-coding-system + :enable buffer-file-name + :help "Revisit this file immediately using specified coding system")) + (bindings--define-key map [set-buffer-file-coding-system] + '(menu-item "For Saving This Buffer" set-buffer-file-coding-system + :help "How to encode this buffer when saved")) + (bindings--define-key map [separator-1] menu-bar-separator) + (bindings--define-key map [universal-coding-system-argument] + '(menu-item "For Next Command" universal-coding-system-argument + :help "Coding system to be used by next command")) map)) (defvar mule-menu-keymap (let ((map (make-sparse-keymap "Mule (Multilingual Environment)"))) - (define-key-after map [set-language-environment] - `(menu-item ,(purecopy "Set Language Environment") ,setup-language-environment-map)) - (define-key-after map [separator-mule] menu-bar-separator) - - (define-key-after map [toggle-input-method] - `(menu-item ,(purecopy "Toggle Input Method") toggle-input-method)) - (define-key-after map [set-input-method] - `(menu-item ,(purecopy "Select Input Method...") set-input-method)) - (define-key-after map [describe-input-method] - `(menu-item ,(purecopy "Describe Input Method") describe-input-method)) - (define-key-after map [separator-input-method] menu-bar-separator) - - (define-key-after map [set-various-coding-system] - `(menu-item ,(purecopy "Set Coding Systems") ,set-coding-system-map - :enable (default-value 'enable-multibyte-characters))) - (define-key-after map [view-hello-file] - `(menu-item ,(purecopy "Show Multilingual Sample Text") view-hello-file + (bindings--define-key map [mule-diag] + '(menu-item "Show All Multilingual Settings" mule-diag + :help "Display multilingual environment settings")) + (bindings--define-key map [list-character-sets] + '(menu-item "List Character Sets" list-character-sets + :help "Show table of available character sets")) + (bindings--define-key map [describe-coding-system] + '(menu-item "Describe Coding System..." describe-coding-system)) + (bindings--define-key map [describe-input-method] + '(menu-item "Describe Input Method..." describe-input-method + :help "Keyboard layout for a specific input method")) + (bindings--define-key map [describe-language-environment] + `(menu-item "Describe Language Environment" + ,describe-language-environment-map + :help "Show multilingual settings for a specific language")) + + (bindings--define-key map [separator-coding-system] menu-bar-separator) + (bindings--define-key map [view-hello-file] + '(menu-item "Show Multilingual Sample Text" view-hello-file :enable (file-readable-p (expand-file-name "HELLO" data-directory)) - :help ,(purecopy "Demonstrate various character sets"))) - (define-key-after map [separator-coding-system] menu-bar-separator) + :help "Demonstrate various character sets")) + (bindings--define-key map [set-various-coding-system] + `(menu-item "Set Coding Systems" ,set-coding-system-map + :enable (default-value 'enable-multibyte-characters))) - (define-key-after map [describe-language-environment] - `(menu-item ,(purecopy "Describe Language Environment") - ,describe-language-environment-map - :help ,(purecopy "Show multilingual settings for a specific language"))) - (define-key-after map [describe-input-method] - `(menu-item ,(purecopy "Describe Input Method...") describe-input-method - :help ,(purecopy "Keyboard layout for a specific input method"))) - (define-key-after map [describe-coding-system] - `(menu-item ,(purecopy "Describe Coding System...") describe-coding-system)) - (define-key-after map [list-character-sets] - `(menu-item ,(purecopy "List Character Sets") list-character-sets - :help ,(purecopy "Show table of available character sets"))) - (define-key-after map [mule-diag] - `(menu-item ,(purecopy "Show All Multilingual Settings") mule-diag - :help ,(purecopy "Display multilingual environment settings"))) + (bindings--define-key map [separator-input-method] menu-bar-separator) + (bindings--define-key map [describe-input-method] + '(menu-item "Describe Input Method" describe-input-method)) + (bindings--define-key map [set-input-method] + '(menu-item "Select Input Method..." set-input-method)) + (bindings--define-key map [toggle-input-method] + '(menu-item "Toggle Input Method" toggle-input-method)) + + (bindings--define-key map [separator-mule] menu-bar-separator) + (bindings--define-key map [set-language-environment] + `(menu-item "Set Language Environment" ,setup-language-environment-map)) map) "Keymap for Mule (Multilingual environment) menu specific commands.") @@ -2954,43 +2954,7 @@ point or a number in hash notation, e.g. #o21430 for octal, (t (cdr (assoc-string input (ucs-names) t)))))) -(defun ucs-insert (character &optional count inherit) - "Insert COUNT copies of CHARACTER of the given Unicode code point. -Interactively, prompts for a Unicode character name or a hex number -using `read-char-by-name'. - -You can type a few of the first letters of the Unicode name and -use completion. If you type a substring of the Unicode name -preceded by an asterisk `*' and use completion, it will show all -the characters whose names include that substring, not necessarily -at the beginning of the name. - -This function also accepts a hexadecimal number of Unicode code -point or a number in hash notation, e.g. #o21430 for octal, -#x2318 for hex, or #10r8984 for decimal. - -The optional third arg INHERIT (non-nil when called interactively), -says to inherit text properties from adjoining text, if those -properties are sticky." - (interactive - (list (read-char-by-name "Unicode (name or hex): ") - (prefix-numeric-value current-prefix-arg) - t)) - (unless count (setq count 1)) - (if (and (stringp character) - (string-match-p "\\`[0-9a-fA-F]+\\'" character)) - (setq character (string-to-number character 16))) - (cond - ((null character) - (error "Not a Unicode character")) - ((not (integerp character)) - (error "Not a Unicode character code: %S" character)) - ((or (< character 0) (> character #x10FFFF)) - (error "Not a Unicode character code: 0x%X" character))) - (if inherit - (dotimes (i count) (insert-and-inherit character)) - (dotimes (i count) (insert character)))) - -(define-key ctl-x-map "8\r" 'ucs-insert) +(define-obsolete-function-alias 'ucs-insert 'insert-char "24.2") +(define-key ctl-x-map "8\r" 'insert-char) ;;; mule-cmds.el ends here diff --git a/lisp/international/quail.el b/lisp/international/quail.el index 4d69e2fdbcb..fecc9427731 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -53,7 +53,7 @@ ;;; Code: (require 'help-mode) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defgroup quail nil "Quail: multilingual input method." @@ -2395,10 +2395,10 @@ should be made by `quail-build-decode-map' (which see)." (let ((last-col-elt (or (nth (1- (* (1+ col) newrows)) single-list) (car (last single-list))))) - (incf width (+ (max 3 (length (car last-col-elt))) - 1 single-trans-width 1)))) + (cl-incf width (+ (max 3 (length (car last-col-elt))) + 1 single-trans-width 1)))) (< width window-width)) - (incf cols)) + (cl-incf cols)) (setq rows (/ (+ len cols -1) cols)) ;Round up. (let ((key-width (max 3 (length (car (nth (1- rows) single-list)))))) (insert "key") diff --git a/lisp/international/ucs-normalize.el b/lisp/international/ucs-normalize.el index cc75cc21cbe..54566e1d004 100644 --- a/lisp/international/ucs-normalize.el +++ b/lisp/international/ucs-normalize.el @@ -109,7 +109,7 @@ (defconst ucs-normalize-version "1.2") -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (declare-function nfd "ucs-normalize" (char)) @@ -179,7 +179,7 @@ (let ((char 0) ccc decomposition) (mapc (lambda (start-end) - (do ((char (car start-end) (+ char 1))) ((> char (cdr start-end))) + (cl-do ((char (car start-end) (+ char 1))) ((> char (cdr start-end))) (setq ccc (ucs-normalize-ccc char)) (setq decomposition (get-char-code-property char 'decomposition)) @@ -270,7 +270,7 @@ Note that Hangul are excluded.") (let (decomposition alist) (mapc (lambda (start-end) - (do ((char (car start-end) (+ char 1))) ((> char (cdr start-end))) + (cl-do ((char (car start-end) (+ char 1))) ((> char (cdr start-end))) (setq decomposition (funcall decomposition-function char)) (if decomposition (setq alist (cons (cons char @@ -391,7 +391,7 @@ decomposition." (let (entries decomposition composition) (mapc (lambda (start-end) - (do ((i (car start-end) (+ i 1))) ((> i (cdr start-end))) + (cl-do ((i (car start-end) (+ i 1))) ((> i (cdr start-end))) (setq decomposition (string-to-list (with-temp-buffer diff --git a/lisp/isearch.el b/lisp/isearch.el index 8fe2aba9499..27185bf3fa6 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -511,6 +511,13 @@ This is like `describe-bindings', but displays only Isearch keys." (define-key map "\M-so" 'isearch-occur) (define-key map "\M-shr" 'isearch-highlight-regexp) + ;; The key translations defined in the C-x 8 prefix should insert + ;; characters into the search string. See iso-transl.el. + (define-key map "\C-x" nil) + (define-key map [?\C-x t] 'isearch-other-control-char) + (define-key map "\C-x8" nil) + (define-key map "\C-x8\r" 'isearch-other-control-char) + map) "Keymap for `isearch-mode'.") diff --git a/lisp/iswitchb.el b/lisp/iswitchb.el index 6493a8f800c..624c3500939 100644 --- a/lisp/iswitchb.el +++ b/lisp/iswitchb.el @@ -233,7 +233,7 @@ ;;; TODO -;;; Acknowledgements +;;; Acknowledgments ;; Thanks to Jari Aalto for help with the ;; first version of this package, iswitch-buffer. Thanks also to many diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index ec44b17835c..55e25e4c262 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -29,8 +29,6 @@ (eval-when-compile - (require 'cl) - (defmacro with-buffer-prepared-for-jit-lock (&rest body) "Execute BODY in current buffer, overriding several variables. Preserves the `buffer-modified-p' state of the current buffer." diff --git a/lisp/kmacro.el b/lisp/kmacro.el index ffc97085a69..6ecac2cdf28 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -629,8 +629,7 @@ others, use \\[kmacro-name-last-macro]." (> (length (this-single-command-keys)) 1)) ;; Used when we're in the process of repeating. (eq no-repeat 'repeating)) - last-input-event)) - repeat-key-str) + last-input-event))) (if end-macro (kmacro-end-macro arg) (call-last-kbd-macro arg #'kmacro-loop-setup-function)) @@ -641,7 +640,13 @@ others, use \\[kmacro-name-last-macro]." (if (eq kmacro-call-repeat-key t) repeat-key kmacro-call-repeat-key))) - (setq repeat-key-str (format-kbd-macro (vector repeat-key) nil)) + ;; Issue a hint to the user, if the echo area isn't in use. + (unless (current-message) + (message "(Type %s to repeat macro%s)" + (format-kbd-macro (vector repeat-key) nil) + (if (and kmacro-call-repeat-with-arg + arg (> arg 1)) + (format " %d times" arg) ""))) ;; Can't use the `keep-pred' arg because this overlay keymap needs to be ;; removed during the next run of the kmacro (i.e. we need to add&remove ;; this overlay-map at each repetition). diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index f0ebc2e82ae..b2313339235 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" (20355 10021)) +;;;;;; "play/5x5.el" (20459 40320 865360 0)) ;;; Generated autoloads from play/5x5.el (autoload '5x5 "5x5" "\ @@ -68,7 +68,7 @@ should return a grid vector array that is the new solution. ;;;*** ;;;### (autoloads (ada-mode ada-add-extensions) "ada-mode" "progmodes/ada-mode.el" -;;;;;; (20355 10021)) +;;;;;; (20427 14766 970343 0)) ;;; Generated autoloads from progmodes/ada-mode.el (autoload 'ada-add-extensions "ada-mode" "\ @@ -88,7 +88,7 @@ Ada mode is the major mode for editing Ada code. ;;;*** ;;;### (autoloads (ada-header) "ada-stmt" "progmodes/ada-stmt.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from progmodes/ada-stmt.el (autoload 'ada-header "ada-stmt" "\ @@ -99,7 +99,7 @@ Insert a descriptive header at the top of the file. ;;;*** ;;;### (autoloads (ada-find-file) "ada-xref" "progmodes/ada-xref.el" -;;;;;; (20355 10021)) +;;;;;; (20458 56750 651721 0)) ;;; Generated autoloads from progmodes/ada-xref.el (autoload 'ada-find-file "ada-xref" "\ @@ -114,7 +114,7 @@ Completion is available. ;;;;;; add-change-log-entry-other-window add-change-log-entry find-change-log ;;;;;; prompt-for-change-log-name add-log-mailing-address add-log-full-name ;;;;;; add-log-current-defun-function) "add-log" "vc/add-log.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from vc/add-log.el (put 'change-log-default-name 'safe-local-variable 'string-or-null-p) @@ -253,7 +253,7 @@ old-style time formats for entries are supported. ;;;### (autoloads (defadvice ad-activate ad-add-advice ad-disable-advice ;;;;;; ad-enable-advice ad-default-compilation-action ad-redefinition-action) -;;;;;; "advice" "emacs-lisp/advice.el" (20355 10021)) +;;;;;; "advice" "emacs-lisp/advice.el" (20355 10021 546955 0)) ;;; Generated autoloads from emacs-lisp/advice.el (defvar ad-redefinition-action 'warn "\ @@ -390,7 +390,7 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) [DOCSTRING] [INTERACTIVE-FORM] BODY...) -\(fn FUNCTION ARGS &rest BODY)" nil (quote macro)) +\(fn FUNCTION ARGS &rest BODY)" nil t) (put 'defadvice 'doc-string-elt '3) @@ -398,7 +398,7 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) ;;;### (autoloads (align-newline-and-indent align-unhighlight-rule ;;;;;; align-highlight-rule align-current align-entire align-regexp -;;;;;; align) "align" "align.el" (20355 10021)) +;;;;;; align) "align" "align.el" (20355 10021 546955 0)) ;;; Generated autoloads from align.el (autoload 'align "align" "\ @@ -489,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" -;;;;;; (20399 35365)) +;;;;;; (20399 35365 4050 0)) ;;; Generated autoloads from allout.el (autoload 'allout-auto-activation-helper "allout" "\ @@ -566,7 +566,7 @@ With value nil, inhibit any automatic allout-mode activation.") (autoload 'allout-mode-p "allout" "\ Return t if `allout-mode' is active in current buffer. -\(fn)" nil (quote macro)) +\(fn)" nil t) (autoload 'allout-mode "allout" "\ Toggle Allout outline mode. @@ -850,7 +850,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" -;;;;;; (20385 23626)) +;;;;;; (20437 50597 545250 0)) ;;; 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)))) @@ -910,7 +910,7 @@ outline hot-spot navigation (see `allout-mode'). ;;;*** ;;;### (autoloads (ange-ftp-hook-function ange-ftp-reread-dir) "ange-ftp" -;;;;;; "net/ange-ftp.el" (20373 11301)) +;;;;;; "net/ange-ftp.el" (20461 32935 300400 0)) ;;; Generated autoloads from net/ange-ftp.el (defalias 'ange-ftp-re-read-dir 'ange-ftp-reread-dir) @@ -932,7 +932,7 @@ directory, so that Emacs will know its current contents. ;;;*** ;;;### (autoloads (animate-birthday-present animate-sequence animate-string) -;;;;;; "animate" "play/animate.el" (20355 10021)) +;;;;;; "animate" "play/animate.el" (20355 10021 546955 0)) ;;; Generated autoloads from play/animate.el (autoload 'animate-string "animate" "\ @@ -965,7 +965,7 @@ the buffer *Birthday-Present-for-Name*. ;;;*** ;;;### (autoloads (ansi-color-process-output ansi-color-for-comint-mode-on) -;;;;;; "ansi-color" "ansi-color.el" (20394 17446)) +;;;;;; "ansi-color" "ansi-color.el" (20453 38823 158957 0)) ;;; Generated autoloads from ansi-color.el (autoload 'ansi-color-for-comint-mode-on "ansi-color" "\ @@ -991,7 +991,8 @@ This is a good function to put in `comint-output-filter-functions'. ;;;*** ;;;### (autoloads (antlr-set-tabs antlr-mode antlr-show-makefile-rules) -;;;;;; "antlr-mode" "progmodes/antlr-mode.el" (20355 10021)) +;;;;;; "antlr-mode" "progmodes/antlr-mode.el" (20427 14766 970343 +;;;;;; 0)) ;;; Generated autoloads from progmodes/antlr-mode.el (autoload 'antlr-show-makefile-rules "antlr-mode" "\ @@ -1027,7 +1028,7 @@ Used in `antlr-mode'. Also a useful function in `java-mode-hook'. ;;;*** ;;;### (autoloads (appt-activate appt-add) "appt" "calendar/appt.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from calendar/appt.el (autoload 'appt-add "appt" "\ @@ -1050,7 +1051,8 @@ ARG is positive, otherwise off. ;;;### (autoloads (apropos-documentation apropos-value apropos-library ;;;;;; apropos apropos-documentation-property apropos-command apropos-variable -;;;;;; apropos-read-pattern) "apropos" "apropos.el" (20374 32165)) +;;;;;; apropos-read-pattern) "apropos" "apropos.el" (20374 32165 +;;;;;; 855366 0)) ;;; Generated autoloads from apropos.el (autoload 'apropos-read-pattern "apropos" "\ @@ -1159,7 +1161,7 @@ Returns list of symbols and documentation found. ;;;*** ;;;### (autoloads (archive-mode) "arc-mode" "arc-mode.el" (20387 -;;;;;; 44199)) +;;;;;; 44199 24128 0)) ;;; Generated autoloads from arc-mode.el (autoload 'archive-mode "arc-mode" "\ @@ -1179,7 +1181,8 @@ archive. ;;;*** -;;;### (autoloads (array-mode) "array" "array.el" (20355 10021)) +;;;### (autoloads (array-mode) "array" "array.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from array.el (autoload 'array-mode "array" "\ @@ -1251,7 +1254,7 @@ Entering array mode calls the function `array-mode-hook'. ;;;*** ;;;### (autoloads (artist-mode) "artist" "textmodes/artist.el" (20357 -;;;;;; 58785)) +;;;;;; 58785 834364 0)) ;;; Generated autoloads from textmodes/artist.el (autoload 'artist-mode "artist" "\ @@ -1457,7 +1460,7 @@ Keymap summary ;;;*** ;;;### (autoloads (asm-mode) "asm-mode" "progmodes/asm-mode.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from progmodes/asm-mode.el (autoload 'asm-mode "asm-mode" "\ @@ -1485,7 +1488,7 @@ Special commands: ;;;*** ;;;### (autoloads (auth-source-cache-expiry) "auth-source" "gnus/auth-source.el" -;;;;;; (20381 5411)) +;;;;;; (20425 59428 310626 0)) ;;; Generated autoloads from gnus/auth-source.el (defvar auth-source-cache-expiry 7200 "\ @@ -1498,7 +1501,7 @@ let-binding.") ;;;*** ;;;### (autoloads (autoarg-kp-mode autoarg-mode) "autoarg" "autoarg.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from autoarg.el (defvar autoarg-mode nil "\ @@ -1559,7 +1562,7 @@ This is similar to `autoarg-mode' but rebinds the keypad keys ;;;*** ;;;### (autoloads (autoconf-mode) "autoconf" "progmodes/autoconf.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from progmodes/autoconf.el (autoload 'autoconf-mode "autoconf" "\ @@ -1570,7 +1573,7 @@ Major mode for editing Autoconf configure.in files. ;;;*** ;;;### (autoloads (auto-insert-mode define-auto-insert auto-insert) -;;;;;; "autoinsert" "autoinsert.el" (20387 44199)) +;;;;;; "autoinsert" "autoinsert.el" (20458 56750 651721 0)) ;;; Generated autoloads from autoinsert.el (autoload 'auto-insert "autoinsert" "\ @@ -1610,7 +1613,7 @@ insert a template for the file depending on the mode of the buffer. ;;;### (autoloads (batch-update-autoloads update-directory-autoloads ;;;;;; update-file-autoloads) "autoload" "emacs-lisp/autoload.el" -;;;;;; (20423 17700)) +;;;;;; (20440 54677 388705 0)) ;;; Generated autoloads from emacs-lisp/autoload.el (put 'generated-autoload-file 'safe-local-variable 'stringp) @@ -1661,7 +1664,7 @@ should be non-nil). ;;;### (autoloads (global-auto-revert-mode turn-on-auto-revert-tail-mode ;;;;;; auto-revert-tail-mode turn-on-auto-revert-mode auto-revert-mode) -;;;;;; "autorevert" "autorevert.el" (20373 11301)) +;;;;;; "autorevert" "autorevert.el" (20373 11301 906925 0)) ;;; Generated autoloads from autorevert.el (autoload 'auto-revert-mode "autorevert" "\ @@ -1750,7 +1753,7 @@ specifies in the mode line. ;;;*** ;;;### (autoloads (mouse-avoidance-mode mouse-avoidance-mode) "avoid" -;;;;;; "avoid.el" (20369 14251)) +;;;;;; "avoid.el" (20369 14251 85829 0)) ;;; Generated autoloads from avoid.el (defvar mouse-avoidance-mode nil "\ @@ -1791,7 +1794,7 @@ definition of \"random distance\".) ;;;*** ;;;### (autoloads (display-battery-mode battery) "battery" "battery.el" -;;;;;; (20369 14251)) +;;;;;; (20369 14251 85829 0)) ;;; Generated autoloads from battery.el (put 'battery-mode-line-string 'risky-local-variable t) @@ -1827,7 +1830,8 @@ seconds. ;;;*** ;;;### (autoloads (benchmark benchmark-run-compiled benchmark-run) -;;;;;; "benchmark" "emacs-lisp/benchmark.el" (20355 10021)) +;;;;;; "benchmark" "emacs-lisp/benchmark.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from emacs-lisp/benchmark.el (autoload 'benchmark-run "benchmark" "\ @@ -1839,7 +1843,7 @@ Return a list of the total elapsed time for execution, the number of garbage collections that ran, and the time taken by garbage collection. See also `benchmark-run-compiled'. -\(fn &optional REPETITIONS &rest FORMS)" nil (quote macro)) +\(fn &optional REPETITIONS &rest FORMS)" nil t) (autoload 'benchmark-run-compiled "benchmark" "\ Time execution of compiled version of FORMS. @@ -1847,7 +1851,7 @@ This is like `benchmark-run', but what is timed is a funcall of the byte code obtained by wrapping FORMS in a `lambda' and compiling the result. The overhead of the `lambda's is accounted for. -\(fn &optional REPETITIONS &rest FORMS)" nil (quote macro)) +\(fn &optional REPETITIONS &rest FORMS)" nil t) (autoload 'benchmark "benchmark" "\ Print the time taken for REPETITIONS executions of FORM. @@ -1860,7 +1864,7 @@ For non-interactive use see also `benchmark-run' and ;;;*** ;;;### (autoloads (bibtex-search-entry bibtex-mode bibtex-initialize) -;;;;;; "bibtex" "textmodes/bibtex.el" (20355 10021)) +;;;;;; "bibtex" "textmodes/bibtex.el" (20439 5925 915283 0)) ;;; Generated autoloads from textmodes/bibtex.el (autoload 'bibtex-initialize "bibtex" "\ @@ -1949,7 +1953,7 @@ A prefix arg negates the value of `bibtex-search-entry-globally'. ;;;*** ;;;### (autoloads (bibtex-style-mode) "bibtex-style" "textmodes/bibtex-style.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from textmodes/bibtex-style.el (autoload 'bibtex-style-mode "bibtex-style" "\ @@ -1961,7 +1965,7 @@ Major mode for editing BibTeX style files. ;;;### (autoloads (binhex-decode-region binhex-decode-region-external ;;;;;; binhex-decode-region-internal) "binhex" "mail/binhex.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from mail/binhex.el (defconst binhex-begin-line "^:...............................................................$" "\ @@ -1986,7 +1990,7 @@ Binhex decode region between START and END. ;;;*** ;;;### (autoloads (blackbox) "blackbox" "play/blackbox.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from play/blackbox.el (autoload 'blackbox "blackbox" "\ @@ -2109,7 +2113,7 @@ a reflection. ;;;;;; bookmark-save bookmark-write bookmark-delete bookmark-insert ;;;;;; bookmark-rename bookmark-insert-location bookmark-relocate ;;;;;; bookmark-jump-other-window bookmark-jump bookmark-set) "bookmark" -;;;;;; "bookmark.el" (20399 35365)) +;;;;;; "bookmark.el" (20459 40320 865360 0)) ;;; Generated autoloads from bookmark.el (define-key ctl-x-r-map "b" 'bookmark-jump) (define-key ctl-x-r-map "m" 'bookmark-set) @@ -2296,7 +2300,7 @@ Incremental search of bookmarks, hiding the non-matches as we go. \(fn)" t nil) -(defvar menu-bar-bookmark-map (let ((map (make-sparse-keymap "Bookmark functions"))) (define-key map [load] `(menu-item ,(purecopy "Load a Bookmark File...") bookmark-load :help ,(purecopy "Load bookmarks from a bookmark file)"))) (define-key map [write] `(menu-item ,(purecopy "Save Bookmarks As...") bookmark-write :help ,(purecopy "Write bookmarks to a file (reading the file name with the minibuffer)"))) (define-key map [save] `(menu-item ,(purecopy "Save Bookmarks") bookmark-save :help ,(purecopy "Save currently defined bookmarks"))) (define-key map [edit] `(menu-item ,(purecopy "Edit Bookmark List") bookmark-bmenu-list :help ,(purecopy "Display a list of existing bookmarks"))) (define-key map [delete] `(menu-item ,(purecopy "Delete Bookmark...") bookmark-delete :help ,(purecopy "Delete a bookmark from the bookmark list"))) (define-key map [rename] `(menu-item ,(purecopy "Rename Bookmark...") bookmark-rename :help ,(purecopy "Change the name of a bookmark"))) (define-key map [locate] `(menu-item ,(purecopy "Insert Location...") bookmark-locate :help ,(purecopy "Insert the name of the file associated with a bookmark"))) (define-key map [insert] `(menu-item ,(purecopy "Insert Contents...") bookmark-insert :help ,(purecopy "Insert the text of the file pointed to by a bookmark"))) (define-key map [set] `(menu-item ,(purecopy "Set Bookmark...") bookmark-set :help ,(purecopy "Set a bookmark named inside a file."))) (define-key map [jump] `(menu-item ,(purecopy "Jump to Bookmark...") bookmark-jump :help ,(purecopy "Jump to a bookmark (a point in some file)"))) map)) +(defvar menu-bar-bookmark-map (let ((map (make-sparse-keymap "Bookmark functions"))) (bindings--define-key map [load] '(menu-item "Load a Bookmark File..." bookmark-load :help "Load bookmarks from a bookmark file)")) (bindings--define-key map [write] '(menu-item "Save Bookmarks As..." bookmark-write :help "Write bookmarks to a file (reading the file name with the minibuffer)")) (bindings--define-key map [save] '(menu-item "Save Bookmarks" bookmark-save :help "Save currently defined bookmarks")) (bindings--define-key map [edit] '(menu-item "Edit Bookmark List" bookmark-bmenu-list :help "Display a list of existing bookmarks")) (bindings--define-key map [delete] '(menu-item "Delete Bookmark..." bookmark-delete :help "Delete a bookmark from the bookmark list")) (bindings--define-key map [rename] '(menu-item "Rename Bookmark..." bookmark-rename :help "Change the name of a bookmark")) (bindings--define-key map [locate] '(menu-item "Insert Location..." bookmark-locate :help "Insert the name of the file associated with a bookmark")) (bindings--define-key map [insert] '(menu-item "Insert Contents..." bookmark-insert :help "Insert the text of the file pointed to by a bookmark")) (bindings--define-key map [set] '(menu-item "Set Bookmark..." bookmark-set :help "Set a bookmark named inside a file.")) (bindings--define-key map [jump] '(menu-item "Jump to Bookmark..." bookmark-jump :help "Jump to a bookmark (a point in some file)")) map)) (defalias 'menu-bar-bookmark-map menu-bar-bookmark-map) @@ -2310,7 +2314,7 @@ Incremental search of bookmarks, hiding the non-matches as we go. ;;;;;; browse-url-xdg-open 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" (20395 3526)) +;;;;;; "browse-url" "net/browse-url.el" (20395 3526 841101 0)) ;;; Generated autoloads from net/browse-url.el (defvar browse-url-browser-function 'browse-url-default-browser "\ @@ -2626,7 +2630,7 @@ from `browse-url-elinks-wrapper'. ;;;*** ;;;### (autoloads (bs-show bs-customize bs-cycle-previous bs-cycle-next) -;;;;;; "bs" "bs.el" (20369 14251)) +;;;;;; "bs" "bs.el" (20369 14251 85829 0)) ;;; Generated autoloads from bs.el (autoload 'bs-cycle-next "bs" "\ @@ -2666,7 +2670,8 @@ name of buffer configuration. ;;;*** -;;;### (autoloads (bubbles) "bubbles" "play/bubbles.el" (20355 10021)) +;;;### (autoloads (bubbles) "bubbles" "play/bubbles.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from play/bubbles.el (autoload 'bubbles "bubbles" "\ @@ -2688,7 +2693,7 @@ columns on its right towards the left. ;;;*** ;;;### (autoloads (bug-reference-prog-mode bug-reference-mode) "bug-reference" -;;;;;; "progmodes/bug-reference.el" (20355 10021)) +;;;;;; "progmodes/bug-reference.el" (20355 10021 546955 0)) ;;; Generated autoloads from progmodes/bug-reference.el (put 'bug-reference-url-format 'safe-local-variable (lambda (s) (or (stringp s) (and (symbolp s) (get s 'bug-reference-url-format))))) @@ -2712,7 +2717,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" (20423 17700)) +;;;;;; "bytecomp" "emacs-lisp/bytecomp.el" (20460 12069 586020 0)) ;;; 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) @@ -2833,7 +2838,7 @@ and corresponding effects. ;;;*** ;;;### (autoloads nil "cal-china" "calendar/cal-china.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from calendar/cal-china.el (put 'calendar-chinese-time-zone 'risky-local-variable t) @@ -2842,7 +2847,8 @@ and corresponding effects. ;;;*** -;;;### (autoloads nil "cal-dst" "calendar/cal-dst.el" (20355 10021)) +;;;### (autoloads nil "cal-dst" "calendar/cal-dst.el" (20461 32935 +;;;;;; 300400 0)) ;;; Generated autoloads from calendar/cal-dst.el (put 'calendar-daylight-savings-starts 'risky-local-variable t) @@ -2854,7 +2860,7 @@ and corresponding effects. ;;;*** ;;;### (autoloads (calendar-hebrew-list-yahrzeits) "cal-hebrew" "calendar/cal-hebrew.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from calendar/cal-hebrew.el (autoload 'calendar-hebrew-list-yahrzeits "cal-hebrew" "\ @@ -2871,7 +2877,7 @@ 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" (20407 -;;;;;; 29477)) +;;;;;; 29477 794904 0)) ;;; Generated autoloads from calc/calc.el (define-key ctl-x-map "*" 'calc-dispatch) @@ -2949,14 +2955,14 @@ actual Lisp function name. See Info node `(calc)Defining Functions'. -\(fn FUNC ARGS &rest BODY)" nil (quote macro)) +\(fn FUNC ARGS &rest BODY)" nil t) (put 'defmath 'doc-string-elt '3) ;;;*** ;;;### (autoloads (calc-undo) "calc-undo" "calc/calc-undo.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from calc/calc-undo.el (autoload 'calc-undo "calc-undo" "\ @@ -2966,8 +2972,8 @@ See Info node `(calc)Defining Functions'. ;;;*** -;;;### (autoloads (calculator) "calculator" "calculator.el" (20355 -;;;;;; 10021)) +;;;### (autoloads (calculator) "calculator" "calculator.el" (20427 +;;;;;; 14766 970343 0)) ;;; Generated autoloads from calculator.el (autoload 'calculator "calculator" "\ @@ -2978,8 +2984,8 @@ See the documentation for `calculator-mode' for more information. ;;;*** -;;;### (autoloads (calendar) "calendar" "calendar/calendar.el" (20388 -;;;;;; 65061)) +;;;### (autoloads (calendar) "calendar" "calendar/calendar.el" (20457 +;;;;;; 35879 688143 0)) ;;; Generated autoloads from calendar/calendar.el (autoload 'calendar "calendar" "\ @@ -3023,7 +3029,7 @@ This function is suitable for execution in a .emacs file. ;;;*** ;;;### (autoloads (canlock-verify canlock-insert-header) "canlock" -;;;;;; "gnus/canlock.el" (20355 10021)) +;;;;;; "gnus/canlock.el" (20355 10021 546955 0)) ;;; Generated autoloads from gnus/canlock.el (autoload 'canlock-insert-header "canlock" "\ @@ -3041,7 +3047,7 @@ it fails. ;;;*** ;;;### (autoloads (capitalized-words-mode) "cap-words" "progmodes/cap-words.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from progmodes/cap-words.el (autoload 'capitalized-words-mode "cap-words" "\ @@ -3081,14 +3087,14 @@ Obsoletes `c-forward-into-nomenclature'. ;;;*** ;;;### (autoloads nil "cc-compat" "progmodes/cc-compat.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from progmodes/cc-compat.el (put 'c-indent-level 'safe-local-variable 'integerp) ;;;*** ;;;### (autoloads (c-guess-basic-syntax) "cc-engine" "progmodes/cc-engine.el" -;;;;;; (20373 11301)) +;;;;;; (20373 11301 906925 0)) ;;; Generated autoloads from progmodes/cc-engine.el (autoload 'c-guess-basic-syntax "cc-engine" "\ @@ -3100,7 +3106,8 @@ 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" (20355 10021)) +;;;;;; c-guess) "cc-guess" "progmodes/cc-guess.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from progmodes/cc-guess.el (defvar c-guess-guessed-offsets-alist nil "\ @@ -3200,7 +3207,7 @@ the absolute file name of the file if STYLE-NAME is 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" -;;;;;; (20416 44451)) +;;;;;; (20416 44451 205563 0)) ;;; Generated autoloads from progmodes/cc-mode.el (autoload 'c-initialize-cc-mode "cc-mode" "\ @@ -3377,7 +3384,7 @@ Key bindings: ;;;*** ;;;### (autoloads (c-set-offset c-add-style c-set-style) "cc-styles" -;;;;;; "progmodes/cc-styles.el" (20355 10021)) +;;;;;; "progmodes/cc-styles.el" (20355 10021 546955 0)) ;;; Generated autoloads from progmodes/cc-styles.el (autoload 'c-set-style "cc-styles" "\ @@ -3428,7 +3435,8 @@ and exists only for compatibility reasons. ;;;*** -;;;### (autoloads nil "cc-vars" "progmodes/cc-vars.el" (20355 10021)) +;;;### (autoloads nil "cc-vars" "progmodes/cc-vars.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from progmodes/cc-vars.el (put 'c-basic-offset 'safe-local-variable 'integerp) (put 'c-backslash-column 'safe-local-variable 'integerp) @@ -3438,7 +3446,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" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from international/ccl.el (autoload 'ccl-compile "ccl" "\ @@ -3462,7 +3470,7 @@ execution. Optional arg VECTOR is a compiled CCL code of the CCL program. -\(fn NAME &optional VECTOR)" nil (quote macro)) +\(fn NAME &optional VECTOR)" nil t) (autoload 'define-ccl-program "ccl" "\ Set NAME the compiled code of CCL-PROGRAM. @@ -3675,7 +3683,7 @@ MAP-IDs := MAP-ID ... MAP-SET := MAP-IDs | (MAP-IDs) MAP-SET MAP-ID := integer -\(fn NAME CCL-PROGRAM &optional DOC)" nil (quote macro)) +\(fn NAME CCL-PROGRAM &optional DOC)" nil t) (put 'define-ccl-program 'doc-string-elt '3) @@ -3686,7 +3694,7 @@ CCL-PROGRAM, else return nil. If CCL-PROGRAM is a vector and optional arg NAME (symbol) is supplied, register CCL-PROGRAM by name NAME, and return NAME. -\(fn CCL-PROGRAM &optional NAME)" nil (quote macro)) +\(fn CCL-PROGRAM &optional NAME)" nil t) (autoload 'ccl-execute-with-args "ccl" "\ Execute CCL-PROGRAM with registers initialized by the remaining args. @@ -3699,7 +3707,7 @@ See the documentation of `define-ccl-program' for the detail of CCL program. ;;;*** ;;;### (autoloads (cconv-closure-convert) "cconv" "emacs-lisp/cconv.el" -;;;;;; (20421 62373)) +;;;;;; (20453 5437 764254 0)) ;;; Generated autoloads from emacs-lisp/cconv.el (autoload 'cconv-closure-convert "cconv" "\ @@ -3714,7 +3722,7 @@ Returns a form where all lambdas don't have any free variables. ;;;*** ;;;### (autoloads (cfengine-auto-mode cfengine2-mode cfengine3-mode) -;;;;;; "cfengine" "progmodes/cfengine.el" (20355 10021)) +;;;;;; "cfengine" "progmodes/cfengine.el" (20355 10021 546955 0)) ;;; Generated autoloads from progmodes/cfengine.el (autoload 'cfengine3-mode "cfengine" "\ @@ -3744,7 +3752,7 @@ on the buffer contents ;;;*** ;;;### (autoloads (check-declare-directory check-declare-file) "check-declare" -;;;;;; "emacs-lisp/check-declare.el" (20378 29222)) +;;;;;; "emacs-lisp/check-declare.el" (20378 29222 722320 0)) ;;; Generated autoloads from emacs-lisp/check-declare.el (autoload 'check-declare-file "check-declare" "\ @@ -3769,7 +3777,7 @@ Returns non-nil if any false statements are found. ;;;;;; checkdoc-comments checkdoc-continue checkdoc-start checkdoc-current-buffer ;;;;;; checkdoc-eval-current-buffer checkdoc-message-interactive ;;;;;; checkdoc-interactive checkdoc checkdoc-list-of-strings-p) -;;;;;; "checkdoc" "emacs-lisp/checkdoc.el" (20388 65061)) +;;;;;; "checkdoc" "emacs-lisp/checkdoc.el" (20388 65061 302484 0)) ;;; Generated autoloads from emacs-lisp/checkdoc.el (put 'checkdoc-force-docstrings-flag 'safe-local-variable 'booleanp) (put 'checkdoc-force-history-flag 'safe-local-variable 'booleanp) @@ -3965,7 +3973,7 @@ checking of documentation strings. ;;;### (autoloads (pre-write-encode-hz post-read-decode-hz encode-hz-buffer ;;;;;; encode-hz-region decode-hz-buffer decode-hz-region) "china-util" -;;;;;; "language/china-util.el" (20355 10021)) +;;;;;; "language/china-util.el" (20355 10021 546955 0)) ;;; Generated autoloads from language/china-util.el (autoload 'decode-hz-region "china-util" "\ @@ -4003,7 +4011,7 @@ Encode the text in the current buffer to HZ. ;;;*** ;;;### (autoloads (command-history list-command-history repeat-matching-complex-command) -;;;;;; "chistory" "chistory.el" (20355 10021)) +;;;;;; "chistory" "chistory.el" (20355 10021 546955 0)) ;;; Generated autoloads from chistory.el (autoload 'repeat-matching-complex-command "chistory" "\ @@ -4040,33 +4048,10 @@ and runs the normal hook `command-history-hook'. \(fn)" t nil) -;;;*** - -;;;### (autoloads nil "cl" "emacs-lisp/cl.el" (20406 8611)) -;;; Generated autoloads from emacs-lisp/cl.el - -(defvar custom-print-functions nil "\ -This is a list of functions that format user objects for printing. -Each function is called in turn with three arguments: the object, the -stream, and the print level (currently ignored). If it is able to -print the object it returns true; otherwise it returns nil and the -printer proceeds to the next function on the list. - -This variable is not used at present, but it is defined in hopes that -a future Emacs interpreter will be able to use it.") - -(put 'defun* 'doc-string-elt 3) - -(put 'defmacro* 'doc-string-elt 3) - -(put 'defsubst 'doc-string-elt 3) - -(put 'defstruct 'doc-string-elt 2) - ;;;*** ;;;### (autoloads (common-lisp-indent-function) "cl-indent" "emacs-lisp/cl-indent.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from emacs-lisp/cl-indent.el (autoload 'common-lisp-indent-function "cl-indent" "\ @@ -4142,10 +4127,38 @@ For example, the function `case' has an indent property \(fn INDENT-POINT STATE)" nil nil) +;;;*** + +;;;### (autoloads nil "cl-lib" "emacs-lisp/cl-lib.el" (20464 9124 +;;;;;; 585807 0)) +;;; Generated autoloads from emacs-lisp/cl-lib.el + +(define-obsolete-variable-alias 'custom-print-functions 'cl-custom-print-functions "24.2") + +(defvar cl-custom-print-functions nil "\ +This is a list of functions that format user objects for printing. +Each function is called in turn with three arguments: the object, the +stream, and the print level (currently ignored). If it is able to +print the object it returns true; otherwise it returns nil and the +printer proceeds to the next function on the list. + +This variable is not used at present, but it is defined in hopes that +a future Emacs interpreter will be able to use it.") + +(autoload 'cl--defsubst-expand "cl-macs") + +(put 'cl-defun 'doc-string-elt 3) + +(put 'cl-defmacro 'doc-string-elt 3) + +(put 'cl-defsubst 'doc-string-elt 3) + +(put 'cl-defstruct 'doc-string-elt 2) + ;;;*** ;;;### (autoloads (c-macro-expand) "cmacexp" "progmodes/cmacexp.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from progmodes/cmacexp.el (autoload 'c-macro-expand "cmacexp" "\ @@ -4166,7 +4179,7 @@ For use inside Lisp programs, see also `c-macro-expansion'. ;;;*** ;;;### (autoloads (run-scheme) "cmuscheme" "cmuscheme.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from cmuscheme.el (autoload 'run-scheme "cmuscheme" "\ @@ -4186,7 +4199,8 @@ is run). ;;;*** -;;;### (autoloads (color-name-to-rgb) "color" "color.el" (20355 10021)) +;;;### (autoloads (color-name-to-rgb) "color" "color.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from color.el (autoload 'color-name-to-rgb "color" "\ @@ -4208,7 +4222,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" -;;;;;; (20420 41510)) +;;;;;; (20464 9124 585807 0)) ;;; Generated autoloads from comint.el (defvar comint-output-filter-functions '(ansi-color-process-output comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt) "\ @@ -4308,7 +4322,7 @@ REGEXP-GROUP is the regular expression group in REGEXP to use. ;;;*** ;;;### (autoloads (compare-windows) "compare-w" "vc/compare-w.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from vc/compare-w.el (autoload 'compare-windows "compare-w" "\ @@ -4345,8 +4359,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" (20410 -;;;;;; 5673)) +;;;;;; compilation-mode-hook) "compile" "progmodes/compile.el" (20428 +;;;;;; 35620 209002 0)) ;;; Generated autoloads from progmodes/compile.el (defvar compilation-mode-hook nil "\ @@ -4528,7 +4542,7 @@ This is the value of `next-error-function' in Compilation buffers. ;;;*** ;;;### (autoloads (dynamic-completion-mode) "completion" "completion.el" -;;;;;; (20388 65061)) +;;;;;; (20388 65061 302484 0)) ;;; Generated autoloads from completion.el (defvar dynamic-completion-mode nil "\ @@ -4553,7 +4567,7 @@ if ARG is omitted or nil. ;;;### (autoloads (conf-xdefaults-mode conf-ppd-mode conf-colon-mode ;;;;;; conf-space-keywords conf-space-mode conf-javaprop-mode conf-windows-mode ;;;;;; conf-unix-mode conf-mode) "conf-mode" "textmodes/conf-mode.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from textmodes/conf-mode.el (autoload 'conf-mode "conf-mode" "\ @@ -4709,7 +4723,7 @@ For details see `conf-mode'. Example: ;;;*** ;;;### (autoloads (shuffle-vector cookie-snarf cookie-insert cookie) -;;;;;; "cookie1" "play/cookie1.el" (20364 27900)) +;;;;;; "cookie1" "play/cookie1.el" (20364 27900 192709 741000)) ;;; Generated autoloads from play/cookie1.el (autoload 'cookie "cookie1" "\ @@ -4742,7 +4756,7 @@ Randomly permute the elements of VECTOR (all permutations equally likely). ;;;### (autoloads (copyright-update-directory copyright copyright-fix-years ;;;;;; copyright-update) "copyright" "emacs-lisp/copyright.el" (20387 -;;;;;; 44199)) +;;;;;; 44199 24128 0)) ;;; Generated autoloads from emacs-lisp/copyright.el (put 'copyright-at-end-flag 'safe-local-variable 'booleanp) (put 'copyright-names-regexp 'safe-local-variable 'stringp) @@ -4781,7 +4795,8 @@ 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" (20355 10021)) +;;;;;; "cperl-mode" "progmodes/cperl-mode.el" (20461 32935 300400 +;;;;;; 0)) ;;; Generated autoloads from progmodes/cperl-mode.el (put 'cperl-indent-level 'safe-local-variable 'integerp) (put 'cperl-brace-offset 'safe-local-variable 'integerp) @@ -4980,7 +4995,7 @@ Run a `perldoc' on the word around point. ;;;*** ;;;### (autoloads (cpp-parse-edit cpp-highlight-buffer) "cpp" "progmodes/cpp.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from progmodes/cpp.el (autoload 'cpp-highlight-buffer "cpp" "\ @@ -4999,7 +5014,7 @@ Edit display information for cpp conditionals. ;;;*** ;;;### (autoloads (crisp-mode crisp-mode) "crisp" "emulation/crisp.el" -;;;;;; (20355 10021)) +;;;;;; (20427 14766 970343 0)) ;;; Generated autoloads from emulation/crisp.el (defvar crisp-mode nil "\ @@ -5025,7 +5040,7 @@ if ARG is omitted or nil. ;;;*** ;;;### (autoloads (completing-read-multiple) "crm" "emacs-lisp/crm.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from emacs-lisp/crm.el (autoload 'completing-read-multiple "crm" "\ @@ -5061,7 +5076,7 @@ INHERIT-INPUT-METHOD. ;;;*** ;;;### (autoloads (css-mode) "css-mode" "textmodes/css-mode.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from textmodes/css-mode.el (autoload 'css-mode "css-mode" "\ @@ -5072,7 +5087,7 @@ Major mode to edit Cascading Style Sheets. ;;;*** ;;;### (autoloads (cua-selection-mode cua-mode) "cua-base" "emulation/cua-base.el" -;;;;;; (20361 20134)) +;;;;;; (20434 17809 692608 0)) ;;; Generated autoloads from emulation/cua-base.el (defvar cua-mode nil "\ @@ -5132,7 +5147,7 @@ Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings. ;;;;;; 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" (20399 35365)) +;;;;;; "cus-edit" "cus-edit.el" (20437 50597 545250 0)) ;;; Generated autoloads from cus-edit.el (defvar custom-browse-sort-alphabetically nil "\ @@ -5445,7 +5460,7 @@ 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" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from cus-theme.el (autoload 'customize-create-theme "cus-theme" "\ @@ -5479,7 +5494,7 @@ omitted, a buffer named *Custom Themes* is used. ;;;*** ;;;### (autoloads (cvs-status-mode) "cvs-status" "vc/cvs-status.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from vc/cvs-status.el (autoload 'cvs-status-mode "cvs-status" "\ @@ -5490,7 +5505,7 @@ Mode used for cvs status output. ;;;*** ;;;### (autoloads (global-cwarn-mode turn-on-cwarn-mode cwarn-mode) -;;;;;; "cwarn" "progmodes/cwarn.el" (20355 10021)) +;;;;;; "cwarn" "progmodes/cwarn.el" (20439 5925 915283 0)) ;;; Generated autoloads from progmodes/cwarn.el (autoload 'cwarn-mode "cwarn" "\ @@ -5541,7 +5556,7 @@ See `cwarn-mode' for more information on Cwarn mode. ;;;### (autoloads (standard-display-cyrillic-translit cyrillic-encode-alternativnyj-char ;;;;;; cyrillic-encode-koi8-r-char) "cyril-util" "language/cyril-util.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from language/cyril-util.el (autoload 'cyrillic-encode-koi8-r-char "cyril-util" "\ @@ -5570,7 +5585,7 @@ If the argument is nil, we return the display table to its standard state. ;;;*** ;;;### (autoloads (dabbrev-expand dabbrev-completion) "dabbrev" "dabbrev.el" -;;;;;; (20397 45851)) +;;;;;; (20397 45851 446679 0)) ;;; Generated autoloads from dabbrev.el (put 'dabbrev-case-fold-search 'risky-local-variable t) (put 'dabbrev-case-replace 'risky-local-variable t) @@ -5617,7 +5632,7 @@ See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]. ;;;*** ;;;### (autoloads (data-debug-new-buffer) "data-debug" "cedet/data-debug.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from cedet/data-debug.el (autoload 'data-debug-new-buffer "data-debug" "\ @@ -5627,8 +5642,8 @@ Create a new data-debug buffer with NAME. ;;;*** -;;;### (autoloads (dbus-handle-event) "dbus" "net/dbus.el" (20399 -;;;;;; 35365)) +;;;### (autoloads (dbus-handle-event) "dbus" "net/dbus.el" (20440 +;;;;;; 54677 388705 0)) ;;; Generated autoloads from net/dbus.el (autoload 'dbus-handle-event "dbus" "\ @@ -5642,7 +5657,7 @@ If the HANDLER returns a `dbus-error', it is propagated as return message. ;;;*** ;;;### (autoloads (dcl-mode) "dcl-mode" "progmodes/dcl-mode.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from progmodes/dcl-mode.el (autoload 'dcl-mode "dcl-mode" "\ @@ -5769,7 +5784,7 @@ There is some minimal font-lock support (see vars ;;;*** ;;;### (autoloads (cancel-debug-on-entry debug-on-entry debug) "debug" -;;;;;; "emacs-lisp/debug.el" (20355 10021)) +;;;;;; "emacs-lisp/debug.el" (20355 10021 546955 0)) ;;; Generated autoloads from emacs-lisp/debug.el (setq debugger 'debug) @@ -5813,7 +5828,7 @@ To specify a nil argument interactively, exit with an empty minibuffer. ;;;*** ;;;### (autoloads (decipher-mode decipher) "decipher" "play/decipher.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from play/decipher.el (autoload 'decipher "decipher" "\ @@ -5843,7 +5858,7 @@ The most useful commands are: ;;;### (autoloads (delimit-columns-rectangle delimit-columns-region ;;;;;; delimit-columns-customize) "delim-col" "delim-col.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from delim-col.el (autoload 'delimit-columns-customize "delim-col" "\ @@ -5868,7 +5883,7 @@ START and END delimits the corners of text rectangle. ;;;*** ;;;### (autoloads (delphi-mode) "delphi" "progmodes/delphi.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from progmodes/delphi.el (autoload 'delphi-mode "delphi" "\ @@ -5920,7 +5935,7 @@ with no args, if that value is non-nil. ;;;*** ;;;### (autoloads (delete-selection-mode) "delsel" "delsel.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from delsel.el (defalias 'pending-delete-mode 'delete-selection-mode) @@ -5950,7 +5965,7 @@ any selection. ;;;*** ;;;### (autoloads (derived-mode-init-mode-variables define-derived-mode) -;;;;;; "derived" "emacs-lisp/derived.el" (20355 10021)) +;;;;;; "derived" "emacs-lisp/derived.el" (20437 50597 545250 0)) ;;; Generated autoloads from emacs-lisp/derived.el (autoload 'define-derived-mode "derived" "\ @@ -6002,7 +6017,7 @@ The new mode runs the hook constructed by the function See Info node `(elisp)Derived Modes' for more details. -\(fn CHILD PARENT NAME &optional DOCSTRING &rest BODY)" nil (quote macro)) +\(fn CHILD PARENT NAME &optional DOCSTRING &rest BODY)" nil t) (put 'define-derived-mode 'doc-string-elt '4) @@ -6017,7 +6032,7 @@ the first time the mode is used. ;;;*** ;;;### (autoloads (describe-char describe-text-properties) "descr-text" -;;;;;; "descr-text.el" (20369 14251)) +;;;;;; "descr-text.el" (20433 53542 563193 0)) ;;; Generated autoloads from descr-text.el (autoload 'describe-text-properties "descr-text" "\ @@ -6054,7 +6069,7 @@ relevant to POS. ;;;### (autoloads (desktop-revert desktop-save-in-desktop-dir desktop-change-dir ;;;;;; desktop-load-default desktop-read desktop-remove desktop-save ;;;;;; desktop-clear desktop-locals-to-save desktop-save-mode) "desktop" -;;;;;; "desktop.el" (20423 17700)) +;;;;;; "desktop.el" (20450 62630 628906 0)) ;;; Generated autoloads from desktop.el (defvar desktop-save-mode nil "\ @@ -6241,7 +6256,7 @@ Revert to the last loaded desktop. ;;;### (autoloads (gnus-article-outlook-deuglify-article gnus-outlook-deuglify-article ;;;;;; gnus-article-outlook-repair-attribution gnus-article-outlook-unwrap-lines) -;;;;;; "deuglify" "gnus/deuglify.el" (20355 10021)) +;;;;;; "deuglify" "gnus/deuglify.el" (20355 10021 546955 0)) ;;; Generated autoloads from gnus/deuglify.el (autoload 'gnus-article-outlook-unwrap-lines "deuglify" "\ @@ -6274,7 +6289,7 @@ Deuglify broken Outlook (Express) articles and redisplay. ;;;*** ;;;### (autoloads (diary-mode diary-mail-entries diary) "diary-lib" -;;;;;; "calendar/diary-lib.el" (20355 10021)) +;;;;;; "calendar/diary-lib.el" (20355 10021 546955 0)) ;;; Generated autoloads from calendar/diary-lib.el (autoload 'diary "diary-lib" "\ @@ -6317,7 +6332,7 @@ Major mode for editing the diary file. ;;;*** ;;;### (autoloads (diff-buffer-with-file diff-backup diff diff-command -;;;;;; diff-switches) "diff" "vc/diff.el" (20379 50083)) +;;;;;; diff-switches) "diff" "vc/diff.el" (20379 50083 187499 0)) ;;; Generated autoloads from vc/diff.el (defvar diff-switches (purecopy "-c") "\ @@ -6361,7 +6376,7 @@ This requires the external program `diff' to be in your `exec-path'. ;;;*** ;;;### (autoloads (diff-minor-mode diff-mode) "diff-mode" "vc/diff-mode.el" -;;;;;; (20415 23587)) +;;;;;; (20415 23587 118149 0)) ;;; Generated autoloads from vc/diff-mode.el (autoload 'diff-mode "diff-mode" "\ @@ -6393,7 +6408,7 @@ the mode if ARG is omitted or nil. ;;;*** -;;;### (autoloads (dig) "dig" "net/dig.el" (20355 10021)) +;;;### (autoloads (dig) "dig" "net/dig.el" (20355 10021 546955 0)) ;;; Generated autoloads from net/dig.el (autoload 'dig "dig" "\ @@ -6405,7 +6420,8 @@ 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" (20399 35754)) +;;;;;; dired dired-listing-switches) "dired" "dired.el" (20452 17962 +;;;;;; 966427 0)) ;;; Generated autoloads from dired.el (defvar dired-listing-switches (purecopy "-al") "\ @@ -6527,7 +6543,7 @@ Keybindings: ;;;*** ;;;### (autoloads (dirtrack dirtrack-mode) "dirtrack" "dirtrack.el" -;;;;;; (20399 35365)) +;;;;;; (20399 35365 4050 0)) ;;; Generated autoloads from dirtrack.el (autoload 'dirtrack-mode "dirtrack" "\ @@ -6557,8 +6573,8 @@ from `default-directory'. ;;;*** -;;;### (autoloads (disassemble) "disass" "emacs-lisp/disass.el" (20355 -;;;;;; 10021)) +;;;### (autoloads (disassemble) "disass" "emacs-lisp/disass.el" (20433 +;;;;;; 53542 563193 0)) ;;; Generated autoloads from emacs-lisp/disass.el (autoload 'disassemble "disass" "\ @@ -6577,7 +6593,7 @@ redefine OBJECT if it is a symbol. ;;;;;; standard-display-g1 standard-display-ascii standard-display-default ;;;;;; standard-display-8bit describe-current-display-table describe-display-table ;;;;;; set-display-table-slot display-table-slot make-display-table) -;;;;;; "disp-table" "disp-table.el" (20355 10021)) +;;;;;; "disp-table" "disp-table.el" (20355 10021 546955 0)) ;;; Generated autoloads from disp-table.el (autoload 'make-display-table "disp-table" "\ @@ -6699,7 +6715,7 @@ in `.emacs'. ;;;*** ;;;### (autoloads (dissociated-press) "dissociate" "play/dissociate.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from play/dissociate.el (autoload 'dissociated-press "dissociate" "\ @@ -6715,7 +6731,8 @@ Default is 2. ;;;*** -;;;### (autoloads (dnd-protocol-alist) "dnd" "dnd.el" (20355 10021)) +;;;### (autoloads (dnd-protocol-alist) "dnd" "dnd.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from dnd.el (defvar dnd-protocol-alist `((,(purecopy "^file:///") . dnd-open-local-file) (,(purecopy "^file://") . dnd-open-file) (,(purecopy "^file:") . dnd-open-local-file) (,(purecopy "^\\(https?\\|ftp\\|file\\|nfs\\)://") . dnd-open-file)) "\ @@ -6736,7 +6753,7 @@ if some action was made, or nil if the URL is ignored.") ;;;*** ;;;### (autoloads (dns-mode-soa-increment-serial dns-mode) "dns-mode" -;;;;;; "textmodes/dns-mode.el" (20355 10021)) +;;;;;; "textmodes/dns-mode.el" (20355 10021 546955 0)) ;;; Generated autoloads from textmodes/dns-mode.el (autoload 'dns-mode "dns-mode" "\ @@ -6760,8 +6777,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" (20378 -;;;;;; 29222)) +;;;;;; doc-view-mode doc-view-mode-p) "doc-view" "doc-view.el" (20458 +;;;;;; 56750 651721 0)) ;;; Generated autoloads from doc-view.el (autoload 'doc-view-mode-p "doc-view" "\ @@ -6807,7 +6824,8 @@ See the command `doc-view-mode' for more information on this mode. ;;;*** -;;;### (autoloads (doctor) "doctor" "play/doctor.el" (20355 10021)) +;;;### (autoloads (doctor) "doctor" "play/doctor.el" (20443 2992 +;;;;;; 177196 0)) ;;; Generated autoloads from play/doctor.el (autoload 'doctor "doctor" "\ @@ -6817,7 +6835,8 @@ Switch to *doctor* buffer and start giving psychotherapy. ;;;*** -;;;### (autoloads (double-mode) "double" "double.el" (20355 10021)) +;;;### (autoloads (double-mode) "double" "double.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from double.el (autoload 'double-mode "double" "\ @@ -6833,7 +6852,8 @@ strings when pressed twice. See `double-map' for details. ;;;*** -;;;### (autoloads (dunnet) "dunnet" "play/dunnet.el" (20355 10021)) +;;;### (autoloads (dunnet) "dunnet" "play/dunnet.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from play/dunnet.el (autoload 'dunnet "dunnet" "\ @@ -6845,7 +6865,7 @@ Switch to *dungeon* buffer and start game. ;;;### (autoloads (easy-mmode-defsyntax easy-mmode-defmap easy-mmode-define-keymap ;;;;;; define-globalized-minor-mode define-minor-mode) "easy-mmode" -;;;;;; "emacs-lisp/easy-mmode.el" (20423 17700)) +;;;;;; "emacs-lisp/easy-mmode.el" (20459 40320 865360 0)) ;;; Generated autoloads from emacs-lisp/easy-mmode.el (defalias 'easy-mmode-define-minor-mode 'define-minor-mode) @@ -6865,7 +6885,7 @@ the mode if the argument is `toggle'. If DOC is nil this function adds a basic doc-string stating these facts. Optional INIT-VALUE is the initial value of the mode's variable. -Optional LIGHTER is displayed in the modeline when the mode is on. +Optional LIGHTER is displayed in the mode line when the mode is on. Optional KEYMAP is the default keymap bound to the mode keymap. If non-nil, it should be a variable name (whose value is a keymap), or an expression that returns either a keymap or a list of @@ -6975,8 +6995,8 @@ CSS contains a list of syntax specifications of the form (CHAR . SYNTAX). ;;;*** ;;;### (autoloads (easy-menu-change easy-menu-create-menu easy-menu-do-define -;;;;;; easy-menu-define) "easymenu" "emacs-lisp/easymenu.el" (20355 -;;;;;; 10021)) +;;;;;; easy-menu-define) "easymenu" "emacs-lisp/easymenu.el" (20437 +;;;;;; 50597 545250 0)) ;;; Generated autoloads from emacs-lisp/easymenu.el (autoload 'easy-menu-define "easymenu" "\ @@ -7085,7 +7105,7 @@ as a solid horizontal line. A menu item can be a list with the same format as MENU. This is a submenu. -\(fn SYMBOL MAPS DOC MENU)" nil (quote macro)) +\(fn SYMBOL MAPS DOC MENU)" nil t) (put 'easy-menu-define 'lisp-indent-function 'defun) @@ -7130,7 +7150,7 @@ To implement dynamic menus, either call this from ;;;;;; ebnf-eps-file ebnf-eps-directory ebnf-spool-region ebnf-spool-buffer ;;;;;; ebnf-spool-file ebnf-spool-directory ebnf-print-region ebnf-print-buffer ;;;;;; ebnf-print-file ebnf-print-directory ebnf-customize) "ebnf2ps" -;;;;;; "progmodes/ebnf2ps.el" (20373 11301)) +;;;;;; "progmodes/ebnf2ps.el" (20373 11301 906925 0)) ;;; Generated autoloads from progmodes/ebnf2ps.el (autoload 'ebnf-customize "ebnf2ps" "\ @@ -7404,8 +7424,8 @@ See `ebnf-style-database' documentation. ;;;;;; ebrowse-tags-find-declaration-other-window ebrowse-tags-find-definition ;;;;;; ebrowse-tags-view-definition ebrowse-tags-find-declaration ;;;;;; ebrowse-tags-view-declaration ebrowse-member-mode ebrowse-electric-choose-tree -;;;;;; ebrowse-tree-mode) "ebrowse" "progmodes/ebrowse.el" (20355 -;;;;;; 10021)) +;;;;;; ebrowse-tree-mode) "ebrowse" "progmodes/ebrowse.el" (20459 +;;;;;; 40320 865360 0)) ;;; Generated autoloads from progmodes/ebrowse.el (autoload 'ebrowse-tree-mode "ebrowse" "\ @@ -7554,7 +7574,7 @@ Display statistics for a class tree. ;;;*** ;;;### (autoloads (electric-buffer-list) "ebuff-menu" "ebuff-menu.el" -;;;;;; (20400 56227)) +;;;;;; (20436 29731 313079 0)) ;;; Generated autoloads from ebuff-menu.el (autoload 'electric-buffer-list "ebuff-menu" "\ @@ -7587,7 +7607,7 @@ Run hooks in `electric-buffer-menu-mode-hook' on entry. ;;;*** ;;;### (autoloads (Electric-command-history-redo-expression) "echistory" -;;;;;; "echistory.el" (20355 10021)) +;;;;;; "echistory.el" (20355 10021 546955 0)) ;;; Generated autoloads from echistory.el (autoload 'Electric-command-history-redo-expression "echistory" "\ @@ -7599,7 +7619,7 @@ With prefix arg NOCONFIRM, execute current line as-is without editing. ;;;*** ;;;### (autoloads (ecomplete-setup) "ecomplete" "gnus/ecomplete.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/ecomplete.el (autoload 'ecomplete-setup "ecomplete" "\ @@ -7609,7 +7629,8 @@ With prefix arg NOCONFIRM, execute current line as-is without editing. ;;;*** -;;;### (autoloads (global-ede-mode) "ede" "cedet/ede.el" (20355 10021)) +;;;### (autoloads (global-ede-mode) "ede" "cedet/ede.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from cedet/ede.el (defvar global-ede-mode nil "\ @@ -7636,7 +7657,7 @@ an EDE controlled project. ;;;### (autoloads (edebug-all-forms edebug-all-defs edebug-eval-top-level-form ;;;;;; edebug-basic-spec edebug-all-forms edebug-all-defs) "edebug" -;;;;;; "emacs-lisp/edebug.el" (20417 65331)) +;;;;;; "emacs-lisp/edebug.el" (20440 54677 388705 0)) ;;; Generated autoloads from emacs-lisp/edebug.el (defvar edebug-all-defs nil "\ @@ -7709,7 +7730,8 @@ Toggle edebugging of all forms. ;;;;;; ediff-merge-directories-with-ancestor ediff-merge-directories ;;;;;; ediff-directories3 ediff-directory-revisions ediff-directories ;;;;;; ediff-buffers3 ediff-buffers ediff-backup ediff-current-file -;;;;;; ediff-files3 ediff-files) "ediff" "vc/ediff.el" (20373 11301)) +;;;;;; ediff-files3 ediff-files) "ediff" "vc/ediff.el" (20373 11301 +;;;;;; 906925 0)) ;;; Generated autoloads from vc/ediff.el (autoload 'ediff-files "ediff" "\ @@ -7941,7 +7963,7 @@ With optional NODE, goes to that node. ;;;*** ;;;### (autoloads (ediff-customize) "ediff-help" "vc/ediff-help.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from vc/ediff-help.el (autoload 'ediff-customize "ediff-help" "\ @@ -7952,7 +7974,7 @@ With optional NODE, goes to that node. ;;;*** ;;;### (autoloads (ediff-show-registry) "ediff-mult" "vc/ediff-mult.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from vc/ediff-mult.el (autoload 'ediff-show-registry "ediff-mult" "\ @@ -7965,7 +7987,7 @@ Display Ediff's registry. ;;;*** ;;;### (autoloads (ediff-toggle-use-toolbar ediff-toggle-multiframe) -;;;;;; "ediff-util" "vc/ediff-util.el" (20355 10021)) +;;;;;; "ediff-util" "vc/ediff-util.el" (20355 10021 546955 0)) ;;; Generated autoloads from vc/ediff-util.el (autoload 'ediff-toggle-multiframe "ediff-util" "\ @@ -7986,7 +8008,7 @@ To change the default, set the variable `ediff-use-toolbar-p', which see. ;;;### (autoloads (format-kbd-macro read-kbd-macro edit-named-kbd-macro ;;;;;; edit-last-kbd-macro edit-kbd-macro) "edmacro" "edmacro.el" -;;;;;; (20355 10021)) +;;;;;; (20438 24016 194668 0)) ;;; Generated autoloads from edmacro.el (autoload 'edit-kbd-macro "edmacro" "\ @@ -8035,7 +8057,7 @@ or nil, use a compact 80-column format. ;;;*** ;;;### (autoloads (edt-emulation-on edt-set-scroll-margins) "edt" -;;;;;; "emulation/edt.el" (20355 10021)) +;;;;;; "emulation/edt.el" (20448 20900 17488 0)) ;;; Generated autoloads from emulation/edt.el (autoload 'edt-set-scroll-margins "edt" "\ @@ -8053,7 +8075,7 @@ Turn on EDT Emulation. ;;;*** ;;;### (autoloads (electric-helpify with-electric-help) "ehelp" "ehelp.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from ehelp.el (autoload 'with-electric-help "ehelp" "\ @@ -8090,7 +8112,7 @@ BUFFER is put back into its original major mode. ;;;*** ;;;### (autoloads (turn-on-eldoc-mode eldoc-mode eldoc-minor-mode-string) -;;;;;; "eldoc" "emacs-lisp/eldoc.el" (20355 10021)) +;;;;;; "eldoc" "emacs-lisp/eldoc.el" (20355 10021 546955 0)) ;;; Generated autoloads from emacs-lisp/eldoc.el (defvar eldoc-minor-mode-string (purecopy " ElDoc") "\ @@ -8137,7 +8159,7 @@ Emacs Lisp mode) that support ElDoc.") ;;;*** ;;;### (autoloads (electric-layout-mode electric-pair-mode electric-indent-mode) -;;;;;; "electric" "electric.el" (20369 14251)) +;;;;;; "electric" "electric.el" (20369 14251 85829 0)) ;;; Generated autoloads from electric.el (defvar electric-indent-chars '(10) "\ @@ -8208,7 +8230,7 @@ The variable `electric-layout-rules' says when and how to insert newlines. ;;;*** ;;;### (autoloads (elide-head) "elide-head" "elide-head.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from elide-head.el (autoload 'elide-head "elide-head" "\ @@ -8225,7 +8247,7 @@ This is suitable as an entry on `find-file-hook' or appropriate mode hooks. ;;;### (autoloads (elint-initialize elint-defun elint-current-buffer ;;;;;; elint-directory elint-file) "elint" "emacs-lisp/elint.el" -;;;;;; (20421 62373)) +;;;;;; (20421 62373 255269 0)) ;;; Generated autoloads from emacs-lisp/elint.el (autoload 'elint-file "elint" "\ @@ -8262,7 +8284,7 @@ optional prefix argument REINIT is non-nil. ;;;### (autoloads (elp-results elp-instrument-package elp-instrument-list ;;;;;; elp-instrument-function) "elp" "emacs-lisp/elp.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from emacs-lisp/elp.el (autoload 'elp-instrument-function "elp" "\ @@ -8297,7 +8319,7 @@ displayed. ;;;*** ;;;### (autoloads (emacs-lock-mode) "emacs-lock" "emacs-lock.el" -;;;;;; (20399 35365)) +;;;;;; (20399 35365 4050 0)) ;;; Generated autoloads from emacs-lock.el (autoload 'emacs-lock-mode "emacs-lock" "\ @@ -8325,7 +8347,7 @@ Other values are interpreted as usual. ;;;*** ;;;### (autoloads (report-emacs-bug-query-existing-bugs report-emacs-bug) -;;;;;; "emacsbug" "mail/emacsbug.el" (20411 26532)) +;;;;;; "emacsbug" "mail/emacsbug.el" (20431 40251 885267 983000)) ;;; Generated autoloads from mail/emacsbug.el (autoload 'report-emacs-bug "emacsbug" "\ @@ -8346,7 +8368,7 @@ The result is an alist with items of the form (URL SUBJECT NO). ;;;;;; emerge-revisions emerge-files-with-ancestor-remote emerge-files-remote ;;;;;; emerge-files-with-ancestor-command emerge-files-command emerge-buffers-with-ancestor ;;;;;; emerge-buffers emerge-files-with-ancestor emerge-files) "emerge" -;;;;;; "vc/emerge.el" (20355 10021)) +;;;;;; "vc/emerge.el" (20355 10021 546955 0)) ;;; Generated autoloads from vc/emerge.el (autoload 'emerge-files "emerge" "\ @@ -8407,7 +8429,7 @@ Emerge two RCS revisions of a file, with another revision as ancestor. ;;;*** ;;;### (autoloads (enriched-decode enriched-encode enriched-mode) -;;;;;; "enriched" "textmodes/enriched.el" (20355 10021)) +;;;;;; "enriched" "textmodes/enriched.el" (20461 32935 300400 0)) ;;; Generated autoloads from textmodes/enriched.el (autoload 'enriched-mode "enriched" "\ @@ -8447,8 +8469,8 @@ Commands: ;;;;;; epa-sign-region epa-verify-cleartext-in-region epa-verify-region ;;;;;; epa-decrypt-armor-in-region epa-decrypt-region epa-encrypt-file ;;;;;; epa-sign-file epa-verify-file epa-decrypt-file epa-select-keys -;;;;;; epa-list-secret-keys epa-list-keys) "epa" "epa.el" (20355 -;;;;;; 10021)) +;;;;;; epa-list-secret-keys epa-list-keys) "epa" "epa.el" (20434 +;;;;;; 17809 692608 0)) ;;; Generated autoloads from epa.el (autoload 'epa-list-keys "epa" "\ @@ -8626,7 +8648,8 @@ Insert selected KEYS after the point. ;;;*** ;;;### (autoloads (epa-dired-do-encrypt epa-dired-do-sign epa-dired-do-verify -;;;;;; epa-dired-do-decrypt) "epa-dired" "epa-dired.el" (20355 10021)) +;;;;;; epa-dired-do-decrypt) "epa-dired" "epa-dired.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from epa-dired.el (autoload 'epa-dired-do-decrypt "epa-dired" "\ @@ -8652,7 +8675,7 @@ Encrypt marked files. ;;;*** ;;;### (autoloads (epa-file-disable epa-file-enable epa-file-handler) -;;;;;; "epa-file" "epa-file.el" (20355 10021)) +;;;;;; "epa-file" "epa-file.el" (20355 10021 546955 0)) ;;; Generated autoloads from epa-file.el (autoload 'epa-file-handler "epa-file" "\ @@ -8674,7 +8697,7 @@ Encrypt marked files. ;;;### (autoloads (epa-global-mail-mode epa-mail-import-keys epa-mail-encrypt ;;;;;; epa-mail-sign epa-mail-verify epa-mail-decrypt epa-mail-mode) -;;;;;; "epa-mail" "epa-mail.el" (20355 10021)) +;;;;;; "epa-mail" "epa-mail.el" (20355 10021 546955 0)) ;;; Generated autoloads from epa-mail.el (autoload 'epa-mail-mode "epa-mail" "\ @@ -8744,7 +8767,8 @@ if ARG is omitted or nil. ;;;*** -;;;### (autoloads (epg-make-context) "epg" "epg.el" (20355 10021)) +;;;### (autoloads (epg-make-context) "epg" "epg.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from epg.el (autoload 'epg-make-context "epg" "\ @@ -8755,7 +8779,7 @@ Return a context object. ;;;*** ;;;### (autoloads (epg-expand-group epg-check-configuration epg-configuration) -;;;;;; "epg-config" "epg-config.el" (20373 11301)) +;;;;;; "epg-config" "epg-config.el" (20373 11301 906925 0)) ;;; Generated autoloads from epg-config.el (autoload 'epg-configuration "epg-config" "\ @@ -8776,7 +8800,7 @@ Look at CONFIG and try to expand GROUP. ;;;*** ;;;### (autoloads (erc-handle-irc-url erc-tls erc erc-select-read-args) -;;;;;; "erc" "erc/erc.el" (20356 2211)) +;;;;;; "erc" "erc/erc.el" (20444 23842 968143 0)) ;;; Generated autoloads from erc/erc.el (autoload 'erc-select-read-args "erc" "\ @@ -8825,32 +8849,35 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL. ;;;*** ;;;### (autoloads nil "erc-autoaway" "erc/erc-autoaway.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from erc/erc-autoaway.el (autoload 'erc-autoaway-mode "erc-autoaway") ;;;*** -;;;### (autoloads nil "erc-button" "erc/erc-button.el" (20355 10021)) +;;;### (autoloads nil "erc-button" "erc/erc-button.el" (20434 17809 +;;;;;; 692608 0)) ;;; Generated autoloads from erc/erc-button.el (autoload 'erc-button-mode "erc-button" nil t) ;;;*** -;;;### (autoloads nil "erc-capab" "erc/erc-capab.el" (20355 10021)) +;;;### (autoloads nil "erc-capab" "erc/erc-capab.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from erc/erc-capab.el (autoload 'erc-capab-identify-mode "erc-capab" nil t) ;;;*** -;;;### (autoloads nil "erc-compat" "erc/erc-compat.el" (20355 10021)) +;;;### (autoloads nil "erc-compat" "erc/erc-compat.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from erc/erc-compat.el (autoload 'erc-define-minor-mode "erc-compat") ;;;*** ;;;### (autoloads (erc-ctcp-query-DCC pcomplete/erc-mode/DCC erc-cmd-DCC) -;;;;;; "erc-dcc" "erc/erc-dcc.el" (20402 11562)) +;;;;;; "erc-dcc" "erc/erc-dcc.el" (20439 5925 915283 0)) ;;; Generated autoloads from erc/erc-dcc.el (autoload 'erc-dcc-mode "erc-dcc") @@ -8868,7 +8895,7 @@ Provides completion for the /DCC command. \(fn)" nil nil) (defvar erc-ctcp-query-DCC-hook '(erc-ctcp-query-DCC) "\ -Hook variable for CTCP DCC queries") +Hook variable for CTCP DCC queries.") (autoload 'erc-ctcp-query-DCC "erc-dcc" "\ The function called when a CTCP DCC request is detected by the client. @@ -8883,7 +8910,7 @@ that subcommand. ;;;;;; erc-ezb-add-session erc-ezb-end-of-session-list erc-ezb-init-session-list ;;;;;; erc-ezb-identify erc-ezb-notice-autodetect erc-ezb-lookup-action ;;;;;; erc-ezb-get-login erc-cmd-ezb) "erc-ezbounce" "erc/erc-ezbounce.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from erc/erc-ezbounce.el (autoload 'erc-cmd-ezb "erc-ezbounce" "\ @@ -8946,7 +8973,7 @@ Add EZBouncer convenience functions to ERC. ;;;*** ;;;### (autoloads (erc-fill) "erc-fill" "erc/erc-fill.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from erc/erc-fill.el (autoload 'erc-fill-mode "erc-fill" nil t) @@ -8959,7 +8986,7 @@ You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'. ;;;*** ;;;### (autoloads (erc-identd-stop erc-identd-start) "erc-identd" -;;;;;; "erc/erc-identd.el" (20355 10021)) +;;;;;; "erc/erc-identd.el" (20355 10021 546955 0)) ;;; Generated autoloads from erc/erc-identd.el (autoload 'erc-identd-mode "erc-identd") @@ -8981,7 +9008,7 @@ system. ;;;*** ;;;### (autoloads (erc-create-imenu-index) "erc-imenu" "erc/erc-imenu.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from erc/erc-imenu.el (autoload 'erc-create-imenu-index "erc-imenu" "\ @@ -8991,20 +9018,22 @@ system. ;;;*** -;;;### (autoloads nil "erc-join" "erc/erc-join.el" (20356 2211)) +;;;### (autoloads nil "erc-join" "erc/erc-join.el" (20356 2211 532900 +;;;;;; 0)) ;;; Generated autoloads from erc/erc-join.el (autoload 'erc-autojoin-mode "erc-join" nil t) ;;;*** -;;;### (autoloads nil "erc-list" "erc/erc-list.el" (20355 10021)) +;;;### (autoloads nil "erc-list" "erc/erc-list.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from erc/erc-list.el (autoload 'erc-list-mode "erc-list") ;;;*** ;;;### (autoloads (erc-save-buffer-in-logs erc-logging-enabled) "erc-log" -;;;;;; "erc/erc-log.el" (20355 10021)) +;;;;;; "erc/erc-log.el" (20355 10021 546955 0)) ;;; Generated autoloads from erc/erc-log.el (autoload 'erc-log-mode "erc-log" nil t) @@ -9036,7 +9065,7 @@ You can save every individual message by putting this function on ;;;### (autoloads (erc-delete-dangerous-host erc-add-dangerous-host ;;;;;; erc-delete-keyword erc-add-keyword erc-delete-fool erc-add-fool ;;;;;; erc-delete-pal erc-add-pal) "erc-match" "erc/erc-match.el" -;;;;;; (20355 10021)) +;;;;;; (20434 17809 692608 0)) ;;; Generated autoloads from erc/erc-match.el (autoload 'erc-match-mode "erc-match") @@ -9082,14 +9111,15 @@ Delete dangerous-host interactively to `erc-dangerous-hosts'. ;;;*** -;;;### (autoloads nil "erc-menu" "erc/erc-menu.el" (20355 10021)) +;;;### (autoloads nil "erc-menu" "erc/erc-menu.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from erc/erc-menu.el (autoload 'erc-menu-mode "erc-menu" nil t) ;;;*** ;;;### (autoloads (erc-cmd-WHOLEFT) "erc-netsplit" "erc/erc-netsplit.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from erc/erc-netsplit.el (autoload 'erc-netsplit-mode "erc-netsplit") @@ -9101,7 +9131,7 @@ Show who's gone. ;;;*** ;;;### (autoloads (erc-server-select erc-determine-network) "erc-networks" -;;;;;; "erc/erc-networks.el" (20355 10021)) +;;;;;; "erc/erc-networks.el" (20355 10021 546955 0)) ;;; Generated autoloads from erc/erc-networks.el (autoload 'erc-determine-network "erc-networks" "\ @@ -9119,7 +9149,7 @@ Interactively select a server to connect to using `erc-server-alist'. ;;;*** ;;;### (autoloads (pcomplete/erc-mode/NOTIFY erc-cmd-NOTIFY) "erc-notify" -;;;;;; "erc/erc-notify.el" (20355 10021)) +;;;;;; "erc/erc-notify.el" (20355 10021 546955 0)) ;;; Generated autoloads from erc/erc-notify.el (autoload 'erc-notify-mode "erc-notify" nil t) @@ -9137,33 +9167,37 @@ with args, toggle notify status of people. ;;;*** -;;;### (autoloads nil "erc-page" "erc/erc-page.el" (20355 10021)) +;;;### (autoloads nil "erc-page" "erc/erc-page.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from erc/erc-page.el (autoload 'erc-page-mode "erc-page") ;;;*** ;;;### (autoloads nil "erc-pcomplete" "erc/erc-pcomplete.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from erc/erc-pcomplete.el (autoload 'erc-completion-mode "erc-pcomplete" nil t) ;;;*** -;;;### (autoloads nil "erc-replace" "erc/erc-replace.el" (20355 10021)) +;;;### (autoloads nil "erc-replace" "erc/erc-replace.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from erc/erc-replace.el (autoload 'erc-replace-mode "erc-replace") ;;;*** -;;;### (autoloads nil "erc-ring" "erc/erc-ring.el" (20355 10021)) +;;;### (autoloads nil "erc-ring" "erc/erc-ring.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from erc/erc-ring.el (autoload 'erc-ring-mode "erc-ring" nil t) ;;;*** ;;;### (autoloads (erc-nickserv-identify erc-nickserv-identify-mode) -;;;;;; "erc-services" "erc/erc-services.el" (20357 58785)) +;;;;;; "erc-services" "erc/erc-services.el" (20357 58785 834364 +;;;;;; 0)) ;;; Generated autoloads from erc/erc-services.el (autoload 'erc-services-mode "erc-services" nil t) @@ -9180,14 +9214,15 @@ When called interactively, read the password using `read-passwd'. ;;;*** -;;;### (autoloads nil "erc-sound" "erc/erc-sound.el" (20355 10021)) +;;;### (autoloads nil "erc-sound" "erc/erc-sound.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from erc/erc-sound.el (autoload 'erc-sound-mode "erc-sound") ;;;*** ;;;### (autoloads (erc-speedbar-browser) "erc-speedbar" "erc/erc-speedbar.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from erc/erc-speedbar.el (autoload 'erc-speedbar-browser "erc-speedbar" "\ @@ -9199,20 +9234,21 @@ This will add a speedbar major display mode. ;;;*** ;;;### (autoloads nil "erc-spelling" "erc/erc-spelling.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from erc/erc-spelling.el (autoload 'erc-spelling-mode "erc-spelling" nil t) ;;;*** -;;;### (autoloads nil "erc-stamp" "erc/erc-stamp.el" (20355 10021)) +;;;### (autoloads nil "erc-stamp" "erc/erc-stamp.el" (20434 17809 +;;;;;; 692608 0)) ;;; Generated autoloads from erc/erc-stamp.el (autoload 'erc-timestamp-mode "erc-stamp" nil t) ;;;*** ;;;### (autoloads (erc-track-minor-mode) "erc-track" "erc/erc-track.el" -;;;;;; (20355 10021)) +;;;;;; (20427 14766 970343 0)) ;;; Generated autoloads from erc/erc-track.el (defvar erc-track-minor-mode nil "\ @@ -9238,7 +9274,8 @@ keybindings will not do anything useful. ;;;*** ;;;### (autoloads (erc-truncate-buffer erc-truncate-buffer-to-size) -;;;;;; "erc-truncate" "erc/erc-truncate.el" (20355 10021)) +;;;;;; "erc-truncate" "erc/erc-truncate.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from erc/erc-truncate.el (autoload 'erc-truncate-mode "erc-truncate" nil t) @@ -9258,7 +9295,7 @@ Meant to be used in hooks, like `erc-insert-post-hook'. ;;;*** ;;;### (autoloads (erc-xdcc-add-file) "erc-xdcc" "erc/erc-xdcc.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from erc/erc-xdcc.el (autoload 'erc-xdcc-mode "erc-xdcc") @@ -9271,7 +9308,7 @@ Add a file to `erc-xdcc-files'. ;;;### (autoloads (ert-describe-test ert-run-tests-interactively ;;;;;; ert-run-tests-batch-and-exit ert-run-tests-batch ert-deftest) -;;;;;; "ert" "emacs-lisp/ert.el" (20355 10021)) +;;;;;; "ert" "emacs-lisp/ert.el" (20355 10021 546955 0)) ;;; Generated autoloads from emacs-lisp/ert.el (autoload 'ert-deftest "ert" "\ @@ -9291,10 +9328,6 @@ description of valid values for RESULT-TYPE. \(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags '(TAG...)] BODY...)" nil (quote macro)) -(put 'ert-deftest 'lisp-indent-function '2) - -(put 'ert-deftest 'doc-string-elt '3) - (put 'ert-deftest 'lisp-indent-function 2) (put 'ert-info 'lisp-indent-function 1) @@ -9341,7 +9374,7 @@ Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test). ;;;*** ;;;### (autoloads (ert-kill-all-test-buffers) "ert-x" "emacs-lisp/ert-x.el" -;;;;;; (20364 28960)) +;;;;;; (20364 28960 773408 688000)) ;;; Generated autoloads from emacs-lisp/ert-x.el (put 'ert-with-test-buffer 'lisp-indent-function 1) @@ -9353,8 +9386,8 @@ Kill all test buffers that are still live. ;;;*** -;;;### (autoloads (eshell-mode) "esh-mode" "eshell/esh-mode.el" (20355 -;;;;;; 10021)) +;;;### (autoloads (eshell-mode) "esh-mode" "eshell/esh-mode.el" (20427 +;;;;;; 14766 970343 0)) ;;; Generated autoloads from eshell/esh-mode.el (autoload 'eshell-mode "esh-mode" "\ @@ -9367,7 +9400,7 @@ Emacs shell interactive mode. ;;;*** ;;;### (autoloads (eshell-command-result eshell-command eshell) "eshell" -;;;;;; "eshell/eshell.el" (20373 11301)) +;;;;;; "eshell/eshell.el" (20458 56750 651721 0)) ;;; Generated autoloads from eshell/eshell.el (autoload 'eshell "eshell" "\ @@ -9408,7 +9441,7 @@ corresponding to a successful execution. ;;;;;; visit-tags-table tags-table-mode find-tag-default-function ;;;;;; find-tag-hook tags-add-tables tags-compression-info-list ;;;;;; tags-table-list tags-case-fold-search) "etags" "progmodes/etags.el" -;;;;;; (20388 65061)) +;;;;;; (20388 65061 302484 0)) ;;; Generated autoloads from progmodes/etags.el (defvar tags-file-name nil "\ @@ -9726,7 +9759,7 @@ for \\[find-tag] (which see). ;;;;;; ethio-fidel-to-sera-marker ethio-fidel-to-sera-region ethio-fidel-to-sera-buffer ;;;;;; ethio-sera-to-fidel-marker ethio-sera-to-fidel-region ethio-sera-to-fidel-buffer ;;;;;; setup-ethiopic-environment-internal) "ethio-util" "language/ethio-util.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from language/ethio-util.el (autoload 'setup-ethiopic-environment-internal "ethio-util" "\ @@ -9896,7 +9929,7 @@ With ARG, insert that many delimiters. ;;;### (autoloads (eudc-load-eudc eudc-query-form eudc-expand-inline ;;;;;; eudc-get-phone eudc-get-email eudc-set-server) "eudc" "net/eudc.el" -;;;;;; (20355 10021)) +;;;;;; (20427 14766 970343 0)) ;;; Generated autoloads from net/eudc.el (autoload 'eudc-set-server "eudc" "\ @@ -9952,7 +9985,7 @@ This does nothing except loading eudc by autoload side-effect. ;;;### (autoloads (eudc-display-jpeg-as-button eudc-display-jpeg-inline ;;;;;; eudc-display-sound eudc-display-mail eudc-display-url eudc-display-generic-binary) -;;;;;; "eudc-bob" "net/eudc-bob.el" (20355 10021)) +;;;;;; "eudc-bob" "net/eudc-bob.el" (20355 10021 546955 0)) ;;; Generated autoloads from net/eudc-bob.el (autoload 'eudc-display-generic-binary "eudc-bob" "\ @@ -9988,7 +10021,7 @@ Display a button for the JPEG DATA. ;;;*** ;;;### (autoloads (eudc-try-bbdb-insert eudc-insert-record-at-point-into-bbdb) -;;;;;; "eudc-export" "net/eudc-export.el" (20355 10021)) +;;;;;; "eudc-export" "net/eudc-export.el" (20355 10021 546955 0)) ;;; Generated autoloads from net/eudc-export.el (autoload 'eudc-insert-record-at-point-into-bbdb "eudc-export" "\ @@ -10005,7 +10038,7 @@ Call `eudc-insert-record-at-point-into-bbdb' if on a record. ;;;*** ;;;### (autoloads (eudc-edit-hotlist) "eudc-hotlist" "net/eudc-hotlist.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from net/eudc-hotlist.el (autoload 'eudc-edit-hotlist "eudc-hotlist" "\ @@ -10015,8 +10048,8 @@ Edit the hotlist of directory servers in a specialized buffer. ;;;*** -;;;### (autoloads (ewoc-create) "ewoc" "emacs-lisp/ewoc.el" (20378 -;;;;;; 29222)) +;;;### (autoloads (ewoc-create) "ewoc" "emacs-lisp/ewoc.el" (20453 +;;;;;; 5437 764254 0)) ;;; Generated autoloads from emacs-lisp/ewoc.el (autoload 'ewoc-create "ewoc" "\ @@ -10045,7 +10078,7 @@ fourth arg NOSEP non-nil inhibits this. ;;;### (autoloads (executable-make-buffer-file-executable-if-script-p ;;;;;; executable-self-display executable-set-magic executable-interpret ;;;;;; executable-command-find-posix-p) "executable" "progmodes/executable.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from progmodes/executable.el (autoload 'executable-command-find-posix-p "executable" "\ @@ -10088,7 +10121,7 @@ file modes. ;;;### (autoloads (expand-jump-to-next-slot expand-jump-to-previous-slot ;;;;;; expand-abbrev-hook expand-add-abbrevs) "expand" "expand.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from expand.el (autoload 'expand-add-abbrevs "expand" "\ @@ -10137,7 +10170,8 @@ This is used only in conjunction with `expand-add-abbrevs'. ;;;*** -;;;### (autoloads (f90-mode) "f90" "progmodes/f90.el" (20388 65061)) +;;;### (autoloads (f90-mode) "f90" "progmodes/f90.el" (20461 32935 +;;;;;; 300400 0)) ;;; Generated autoloads from progmodes/f90.el (autoload 'f90-mode "f90" "\ @@ -10207,8 +10241,8 @@ with no args, if that value is non-nil. ;;;### (autoloads (variable-pitch-mode buffer-face-toggle buffer-face-set ;;;;;; buffer-face-mode text-scale-adjust text-scale-decrease text-scale-increase ;;;;;; text-scale-set face-remap-set-base face-remap-reset-base -;;;;;; face-remap-add-relative) "face-remap" "face-remap.el" (20388 -;;;;;; 65061)) +;;;;;; face-remap-add-relative) "face-remap" "face-remap.el" (20445 +;;;;;; 44711 217937 0)) ;;; Generated autoloads from face-remap.el (autoload 'face-remap-add-relative "face-remap" "\ @@ -10216,14 +10250,19 @@ Add a face remapping entry of FACE to SPECS in the current buffer. Return a cookie which can be used to delete this remapping with `face-remap-remove-relative'. -The remaining arguments, SPECS, should be either a list of face -names, or a property list of face attribute/value pairs. The -remapping specified by SPECS takes effect alongside the -remappings from other calls to `face-remap-add-relative', as well -as the normal definition of FACE (at lowest priority). This -function tries to sort multiple remappings for the same face, so -that remappings specifying relative face attributes are applied -after remappings specifying absolute face attributes. +The remaining arguments, SPECS, should form a list of faces. +Each list element should be either a face name or a property list +of face attribute/value pairs. If more than one face is listed, +that specifies an aggregate face, in the same way as in a `face' +text property, except for possible priority changes noted below. + +The face remapping specified by SPECS takes effect alongside the +remappings from other calls to `face-remap-add-relative' for the +same FACE, as well as the normal definition of FACE (at lowest +priority). This function tries to sort multiple remappings for +the same face, so that remappings specifying relative face +attributes are applied after remappings specifying absolute face +attributes. The base (lowest priority) remapping may be set to something other than the normal definition of FACE via `face-remap-set-base'. @@ -10240,9 +10279,11 @@ to apply on top of the normal definition of FACE. (autoload 'face-remap-set-base "face-remap" "\ Set the base remapping of FACE in the current buffer to SPECS. This causes the remappings specified by `face-remap-add-relative' -to apply on top of the face specification given by SPECS. SPECS -should be either a list of face names, or a property list of face -attribute/value pairs. +to apply on top of the face specification given by SPECS. + +The remaining arguments, SPECS, should form a list of faces. +Each list element should be either a face name or a property list +of face attribute/value pairs, like in a `face' text property. If SPECS is empty, call `face-remap-reset-base' to use the normal definition of FACE as the base remapping; note that this is @@ -10321,19 +10362,23 @@ variable `buffer-face-mode-face' is used to display the buffer text. (autoload 'buffer-face-set "face-remap" "\ Enable `buffer-face-mode', using face specs SPECS. -SPECS can be any value suitable for the `face' text property, -including a face name, a list of face names, or a face-attribute -If SPECS is nil, then `buffer-face-mode' is disabled. +Each argument in SPECS should be a face, i.e. either a face name +or a property list of face attributes and values. If more than +one face is listed, that specifies an aggregate face, like in a +`face' text property. If SPECS is nil or omitted, disable +`buffer-face-mode'. -This function will make the variable `buffer-face-mode-face' -buffer local, and set it to FACE. +This function makes the variable `buffer-face-mode-face' buffer +local, and sets it to FACE. \(fn &rest SPECS)" t nil) (autoload 'buffer-face-toggle "face-remap" "\ Toggle `buffer-face-mode', using face specs SPECS. -SPECS can be any value suitable for the `face' text property, -including a face name, a list of face names, or a face-attribute +Each argument in SPECS should be a face, i.e. either a face name +or a property list of face attributes and values. If more than +one face is listed, that specifies an aggregate face, like in a +`face' text property. If `buffer-face-mode' is already enabled, and is currently using the face specs SPECS, then it is disabled; if buffer-face-mode is @@ -10356,7 +10401,8 @@ Besides the choice of face, it is the same as `buffer-face-mode'. ;;;### (autoloads (feedmail-queue-reminder feedmail-run-the-queue ;;;;;; feedmail-run-the-queue-global-prompt feedmail-run-the-queue-no-prompts -;;;;;; feedmail-send-it) "feedmail" "mail/feedmail.el" (20387 44199)) +;;;;;; feedmail-send-it) "feedmail" "mail/feedmail.el" (20387 44199 +;;;;;; 24128 0)) ;;; Generated autoloads from mail/feedmail.el (autoload 'feedmail-send-it "feedmail" "\ @@ -10411,7 +10457,7 @@ you can set `feedmail-queue-reminder-alist' to nil. ;;;### (autoloads (ffap-bindings ffap-guess-file-name-at-point dired-at-point ;;;;;; ffap-at-mouse ffap-menu find-file-at-point ffap-next) "ffap" -;;;;;; "ffap.el" (20395 38306)) +;;;;;; "ffap.el" (20395 38306 463596 0)) ;;; Generated autoloads from ffap.el (autoload 'ffap-next "ffap" "\ @@ -10477,7 +10523,7 @@ Evaluate the forms in variable `ffap-bindings'. ;;;### (autoloads (file-cache-minibuffer-complete file-cache-add-directory-recursively ;;;;;; file-cache-add-directory-using-locate file-cache-add-directory-using-find ;;;;;; file-cache-add-file file-cache-add-directory-list file-cache-add-directory) -;;;;;; "filecache" "filecache.el" (20355 10021)) +;;;;;; "filecache" "filecache.el" (20355 10021 546955 0)) ;;; Generated autoloads from filecache.el (autoload 'file-cache-add-directory "filecache" "\ @@ -10537,7 +10583,8 @@ the name is considered already unique; only the second substitution ;;;;;; copy-file-locals-to-dir-locals delete-dir-local-variable ;;;;;; add-dir-local-variable delete-file-local-variable-prop-line ;;;;;; add-file-local-variable-prop-line delete-file-local-variable -;;;;;; add-file-local-variable) "files-x" "files-x.el" (20355 10021)) +;;;;;; add-file-local-variable) "files-x" "files-x.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from files-x.el (autoload 'add-file-local-variable "files-x" "\ @@ -10603,7 +10650,7 @@ Copy directory-local variables to the -*- line. ;;;*** ;;;### (autoloads (filesets-init) "filesets" "filesets.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from filesets.el (autoload 'filesets-init "filesets" "\ @@ -10614,7 +10661,8 @@ Set up hooks, load the cache file -- if existing -- and build the menu. ;;;*** -;;;### (autoloads (find-cmd) "find-cmd" "find-cmd.el" (20355 10021)) +;;;### (autoloads (find-cmd) "find-cmd" "find-cmd.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from find-cmd.el (autoload 'find-cmd "find-cmd" "\ @@ -10634,7 +10682,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" (20355 10021)) +;;;;;; "find-dired.el" (20355 10021 546955 0)) ;;; Generated autoloads from find-dired.el (autoload 'find-dired "find-dired" "\ @@ -10674,7 +10722,7 @@ use in place of \"-ls\" as the final argument. ;;;### (autoloads (ff-mouse-find-other-file-other-window ff-mouse-find-other-file ;;;;;; ff-find-other-file ff-get-other-file ff-special-constructs) -;;;;;; "find-file" "find-file.el" (20387 44199)) +;;;;;; "find-file" "find-file.el" (20387 44199 24128 0)) ;;; Generated autoloads from find-file.el (defvar ff-special-constructs `((,(purecopy "^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") lambda nil (buffer-substring (match-beginning 2) (match-end 2)))) "\ @@ -10770,7 +10818,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" (20355 10021)) +;;;;;; "emacs-lisp/find-func.el" (20355 10021 546955 0)) ;;; Generated autoloads from emacs-lisp/find-func.el (autoload 'find-library "find-func" "\ @@ -10929,7 +10977,8 @@ Define some key bindings for the find-function family of functions. ;;;*** ;;;### (autoloads (find-lisp-find-dired-filter find-lisp-find-dired-subdirectories -;;;;;; find-lisp-find-dired) "find-lisp" "find-lisp.el" (20355 10021)) +;;;;;; find-lisp-find-dired) "find-lisp" "find-lisp.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from find-lisp.el (autoload 'find-lisp-find-dired "find-lisp" "\ @@ -10950,7 +10999,7 @@ Change the filter on a find-lisp-find-dired buffer to REGEXP. ;;;*** ;;;### (autoloads (finder-by-keyword finder-commentary finder-list-keywords) -;;;;;; "finder" "finder.el" (20355 10021)) +;;;;;; "finder" "finder.el" (20355 10021 546955 0)) ;;; Generated autoloads from finder.el (autoload 'finder-list-keywords "finder" "\ @@ -10972,7 +11021,7 @@ Find packages matching a given keyword. ;;;*** ;;;### (autoloads (enable-flow-control-on enable-flow-control) "flow-ctrl" -;;;;;; "flow-ctrl.el" (20355 10021)) +;;;;;; "flow-ctrl.el" (20355 10021 546955 0)) ;;; Generated autoloads from flow-ctrl.el (autoload 'enable-flow-control "flow-ctrl" "\ @@ -10994,7 +11043,7 @@ to get the effect of a C-q. ;;;*** ;;;### (autoloads (fill-flowed fill-flowed-encode) "flow-fill" "gnus/flow-fill.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/flow-fill.el (autoload 'fill-flowed-encode "flow-fill" "\ @@ -11010,7 +11059,8 @@ to get the effect of a C-q. ;;;*** ;;;### (autoloads (flymake-find-file-hook flymake-mode-off flymake-mode-on -;;;;;; flymake-mode) "flymake" "progmodes/flymake.el" (20373 11301)) +;;;;;; flymake-mode) "flymake" "progmodes/flymake.el" (20458 56750 +;;;;;; 651721 0)) ;;; Generated autoloads from progmodes/flymake.el (autoload 'flymake-mode "flymake" "\ @@ -11040,7 +11090,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" (20420 41510)) +;;;;;; "flyspell" "textmodes/flyspell.el" (20434 17809 692608 0)) ;;; Generated autoloads from textmodes/flyspell.el (autoload 'flyspell-prog-mode "flyspell" "\ @@ -11112,7 +11162,7 @@ Flyspell whole buffer. ;;;### (autoloads (follow-delete-other-windows-and-split follow-mode ;;;;;; turn-off-follow-mode turn-on-follow-mode) "follow" "follow.el" -;;;;;; (20387 44199)) +;;;;;; (20387 44199 24128 0)) ;;; Generated autoloads from follow.el (autoload 'turn-on-follow-mode "follow" "\ @@ -11181,7 +11231,7 @@ selected if the original window is the first one in the frame. ;;;*** ;;;### (autoloads (footnote-mode) "footnote" "mail/footnote.el" (20387 -;;;;;; 44199)) +;;;;;; 44199 24128 0)) ;;; Generated autoloads from mail/footnote.el (autoload 'footnote-mode "footnote" "\ @@ -11200,7 +11250,7 @@ play around with the following keys: ;;;*** ;;;### (autoloads (forms-find-file-other-window forms-find-file forms-mode) -;;;;;; "forms" "forms.el" (20392 20740)) +;;;;;; "forms" "forms.el" (20427 14766 970343 0)) ;;; Generated autoloads from forms.el (autoload 'forms-mode "forms" "\ @@ -11237,7 +11287,7 @@ Visit a file in Forms mode in other window. ;;;*** ;;;### (autoloads (fortran-mode) "fortran" "progmodes/fortran.el" -;;;;;; (20355 10021)) +;;;;;; (20438 24024 724594 589000)) ;;; Generated autoloads from progmodes/fortran.el (autoload 'fortran-mode "fortran" "\ @@ -11315,7 +11365,8 @@ with no args, if that value is non-nil. ;;;*** ;;;### (autoloads (fortune fortune-to-signature fortune-compile fortune-from-region -;;;;;; fortune-add-fortune) "fortune" "play/fortune.el" (20355 10021)) +;;;;;; fortune-add-fortune) "fortune" "play/fortune.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from play/fortune.el (autoload 'fortune-add-fortune "fortune" "\ @@ -11364,7 +11415,7 @@ and choose the directory as the fortune-file. ;;;*** ;;;### (autoloads (gdb gdb-enable-debug) "gdb-mi" "progmodes/gdb-mi.el" -;;;;;; (20415 53309)) +;;;;;; (20415 53309 822770 0)) ;;; Generated autoloads from progmodes/gdb-mi.el (defvar gdb-enable-debug nil "\ @@ -11443,7 +11494,7 @@ detailed description of this mode. ;;;### (autoloads (generic-make-keywords-list generic-mode generic-mode-internal ;;;;;; define-generic-mode) "generic" "emacs-lisp/generic.el" (20406 -;;;;;; 8611)) +;;;;;; 8611 875037 0)) ;;; Generated autoloads from emacs-lisp/generic.el (defvar generic-mode-list nil "\ @@ -11485,12 +11536,12 @@ mode hook `MODE-hook'. See the file generic-x.el for some examples of `define-generic-mode'. -\(fn MODE COMMENT-LIST KEYWORD-LIST FONT-LOCK-LIST AUTO-MODE-LIST FUNCTION-LIST &optional DOCSTRING)" nil (quote macro)) - -(put 'define-generic-mode 'doc-string-elt '7) +\(fn MODE COMMENT-LIST KEYWORD-LIST FONT-LOCK-LIST AUTO-MODE-LIST FUNCTION-LIST &optional DOCSTRING)" nil t) (put 'define-generic-mode 'lisp-indent-function '1) +(put 'define-generic-mode 'doc-string-elt '7) + (autoload 'generic-mode-internal "generic" "\ Go into the generic mode MODE. @@ -11522,7 +11573,7 @@ regular expression that can be used as an element of ;;;*** ;;;### (autoloads (glasses-mode) "glasses" "progmodes/glasses.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from progmodes/glasses.el (autoload 'glasses-mode "glasses" "\ @@ -11538,7 +11589,7 @@ add virtual separators (like underscores) at places they belong to. ;;;### (autoloads (gmm-tool-bar-from-list gmm-widget-p gmm-error ;;;;;; gmm-message gmm-regexp-concat) "gmm-utils" "gnus/gmm-utils.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/gmm-utils.el (autoload 'gmm-regexp-concat "gmm-utils" "\ @@ -11593,7 +11644,8 @@ 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" (20414 2727)) +;;;;;; gnus-slave-no-server) "gnus" "gnus/gnus.el" (20458 56750 +;;;;;; 651721 0)) ;;; Generated autoloads from gnus/gnus.el (when (fboundp 'custom-autoload) (custom-autoload 'gnus-select-method "gnus")) @@ -11646,7 +11698,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" (20355 10021)) +;;;;;; "gnus/gnus-agent.el" (20458 56750 651721 0)) ;;; Generated autoloads from gnus/gnus-agent.el (autoload 'gnus-unplugged "gnus-agent" "\ @@ -11737,7 +11789,7 @@ If CLEAN, obsolete (ignore). ;;;*** ;;;### (autoloads (gnus-article-prepare-display) "gnus-art" "gnus/gnus-art.el" -;;;;;; (20361 20134)) +;;;;;; (20458 56750 651721 0)) ;;; Generated autoloads from gnus/gnus-art.el (autoload 'gnus-article-prepare-display "gnus-art" "\ @@ -11748,7 +11800,8 @@ Make the current buffer look like a nice article. ;;;*** ;;;### (autoloads (gnus-bookmark-bmenu-list gnus-bookmark-jump gnus-bookmark-set) -;;;;;; "gnus-bookmark" "gnus/gnus-bookmark.el" (20355 10021)) +;;;;;; "gnus-bookmark" "gnus/gnus-bookmark.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from gnus/gnus-bookmark.el (autoload 'gnus-bookmark-set "gnus-bookmark" "\ @@ -11774,7 +11827,7 @@ deletion, or > if it is flagged for displaying. ;;;### (autoloads (gnus-cache-delete-group gnus-cache-rename-group ;;;;;; gnus-cache-generate-nov-databases gnus-cache-generate-active ;;;;;; gnus-jog-cache) "gnus-cache" "gnus/gnus-cache.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from gnus/gnus-cache.el (autoload 'gnus-jog-cache "gnus-cache" "\ @@ -11816,7 +11869,7 @@ supported. ;;;*** ;;;### (autoloads (gnus-delay-initialize gnus-delay-send-queue gnus-delay-article) -;;;;;; "gnus-delay" "gnus/gnus-delay.el" (20355 10021)) +;;;;;; "gnus-delay" "gnus/gnus-delay.el" (20355 10021 546955 0)) ;;; Generated autoloads from gnus/gnus-delay.el (autoload 'gnus-delay-article "gnus-delay" "\ @@ -11852,7 +11905,7 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil. ;;;*** ;;;### (autoloads (gnus-user-format-function-D gnus-user-format-function-d) -;;;;;; "gnus-diary" "gnus/gnus-diary.el" (20355 10021)) +;;;;;; "gnus-diary" "gnus/gnus-diary.el" (20355 10021 546955 0)) ;;; Generated autoloads from gnus/gnus-diary.el (autoload 'gnus-user-format-function-d "gnus-diary" "\ @@ -11868,7 +11921,7 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil. ;;;*** ;;;### (autoloads (turn-on-gnus-dired-mode) "gnus-dired" "gnus/gnus-dired.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/gnus-dired.el (autoload 'turn-on-gnus-dired-mode "gnus-dired" "\ @@ -11879,7 +11932,7 @@ Convenience method to turn on gnus-dired-mode. ;;;*** ;;;### (autoloads (gnus-draft-reminder) "gnus-draft" "gnus/gnus-draft.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/gnus-draft.el (autoload 'gnus-draft-reminder "gnus-draft" "\ @@ -11892,7 +11945,7 @@ 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" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from gnus/gnus-fun.el (autoload 'gnus-random-x-face "gnus-fun" "\ @@ -11937,7 +11990,8 @@ FILE should be a PNG file that's 48x48 and smaller than or equal to ;;;*** ;;;### (autoloads (gnus-treat-mail-gravatar gnus-treat-from-gravatar) -;;;;;; "gnus-gravatar" "gnus/gnus-gravatar.el" (20355 10021)) +;;;;;; "gnus-gravatar" "gnus/gnus-gravatar.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from gnus/gnus-gravatar.el (autoload 'gnus-treat-from-gravatar "gnus-gravatar" "\ @@ -11955,7 +12009,7 @@ If gravatars are already displayed, remove them. ;;;*** ;;;### (autoloads (gnus-fetch-group-other-frame gnus-fetch-group) -;;;;;; "gnus-group" "gnus/gnus-group.el" (20355 10021)) +;;;;;; "gnus-group" "gnus/gnus-group.el" (20458 56750 651721 0)) ;;; Generated autoloads from gnus/gnus-group.el (autoload 'gnus-fetch-group "gnus-group" "\ @@ -11973,7 +12027,7 @@ Pop up a frame and enter GROUP. ;;;*** ;;;### (autoloads (gnus-html-prefetch-images gnus-article-html) "gnus-html" -;;;;;; "gnus/gnus-html.el" (20355 10021)) +;;;;;; "gnus/gnus-html.el" (20355 10021 546955 0)) ;;; Generated autoloads from gnus/gnus-html.el (autoload 'gnus-article-html "gnus-html" "\ @@ -11989,7 +12043,7 @@ Pop up a frame and enter GROUP. ;;;*** ;;;### (autoloads (gnus-batch-score) "gnus-kill" "gnus/gnus-kill.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/gnus-kill.el (defalias 'gnus-batch-kill 'gnus-batch-score) @@ -12004,7 +12058,7 @@ Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score ;;;### (autoloads (gnus-mailing-list-mode gnus-mailing-list-insinuate ;;;;;; turn-on-gnus-mailing-list-mode) "gnus-ml" "gnus/gnus-ml.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/gnus-ml.el (autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" "\ @@ -12029,7 +12083,7 @@ Minor mode for providing mailing-list commands. ;;;### (autoloads (gnus-group-split-fancy gnus-group-split gnus-group-split-update ;;;;;; gnus-group-split-setup) "gnus-mlspl" "gnus/gnus-mlspl.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/gnus-mlspl.el (autoload 'gnus-group-split-setup "gnus-mlspl" "\ @@ -12130,7 +12184,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" (20417 65331)) +;;;;;; "gnus-msg" "gnus/gnus-msg.el" (20458 56750 651721 0)) ;;; Generated autoloads from gnus/gnus-msg.el (autoload 'gnus-msg-mail "gnus-msg" "\ @@ -12158,7 +12212,7 @@ Like `message-reply'. ;;;### (autoloads (gnus-treat-newsgroups-picon gnus-treat-mail-picon ;;;;;; gnus-treat-from-picon) "gnus-picon" "gnus/gnus-picon.el" -;;;;;; (20355 10021)) +;;;;;; (20458 56750 651721 0)) ;;; Generated autoloads from gnus/gnus-picon.el (autoload 'gnus-treat-from-picon "gnus-picon" "\ @@ -12185,7 +12239,7 @@ If picons are already displayed, remove them. ;;;;;; gnus-sorted-nintersection gnus-sorted-range-intersection ;;;;;; gnus-sorted-intersection gnus-intersection gnus-sorted-complement ;;;;;; gnus-sorted-ndifference gnus-sorted-difference) "gnus-range" -;;;;;; "gnus/gnus-range.el" (20355 10021)) +;;;;;; "gnus/gnus-range.el" (20355 10021 546955 0)) ;;; Generated autoloads from gnus/gnus-range.el (autoload 'gnus-sorted-difference "gnus-range" "\ @@ -12253,7 +12307,8 @@ Add NUM into sorted LIST by side effect. ;;;*** ;;;### (autoloads (gnus-registry-install-hooks gnus-registry-initialize) -;;;;;; "gnus-registry" "gnus/gnus-registry.el" (20415 53309)) +;;;;;; "gnus-registry" "gnus/gnus-registry.el" (20458 56750 651721 +;;;;;; 0)) ;;; Generated autoloads from gnus/gnus-registry.el (autoload 'gnus-registry-initialize "gnus-registry" "\ @@ -12270,7 +12325,7 @@ Install the registry hooks. ;;;### (autoloads (gnus-sieve-article-add-rule gnus-sieve-generate ;;;;;; gnus-sieve-update) "gnus-sieve" "gnus/gnus-sieve.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from gnus/gnus-sieve.el (autoload 'gnus-sieve-update "gnus-sieve" "\ @@ -12298,7 +12353,7 @@ See the documentation for these variables and functions for details. ;;;*** ;;;### (autoloads (gnus-update-format) "gnus-spec" "gnus/gnus-spec.el" -;;;;;; (20355 10021)) +;;;;;; (20458 56750 651721 0)) ;;; Generated autoloads from gnus/gnus-spec.el (autoload 'gnus-update-format "gnus-spec" "\ @@ -12309,7 +12364,7 @@ Update the format specification near point. ;;;*** ;;;### (autoloads (gnus-declare-backend) "gnus-start" "gnus/gnus-start.el" -;;;;;; (20361 20134)) +;;;;;; (20458 56750 651721 0)) ;;; Generated autoloads from gnus/gnus-start.el (autoload 'gnus-declare-backend "gnus-start" "\ @@ -12320,7 +12375,7 @@ Declare back end NAME with ABILITIES as a Gnus back end. ;;;*** ;;;### (autoloads (gnus-summary-bookmark-jump) "gnus-sum" "gnus/gnus-sum.el" -;;;;;; (20355 10021)) +;;;;;; (20458 56750 651721 0)) ;;; Generated autoloads from gnus/gnus-sum.el (autoload 'gnus-summary-bookmark-jump "gnus-sum" "\ @@ -12332,7 +12387,7 @@ BOOKMARK is a bookmark name or a bookmark record. ;;;*** ;;;### (autoloads (gnus-sync-install-hooks gnus-sync-initialize) -;;;;;; "gnus-sync" "gnus/gnus-sync.el" (20355 10021)) +;;;;;; "gnus-sync" "gnus/gnus-sync.el" (20458 56750 651721 0)) ;;; Generated autoloads from gnus/gnus-sync.el (autoload 'gnus-sync-initialize "gnus-sync" "\ @@ -12348,7 +12403,7 @@ Install the sync hooks. ;;;*** ;;;### (autoloads (gnus-add-configuration) "gnus-win" "gnus/gnus-win.el" -;;;;;; (20420 41510)) +;;;;;; (20447 49522 409090 0)) ;;; Generated autoloads from gnus/gnus-win.el (autoload 'gnus-add-configuration "gnus-win" "\ @@ -12359,7 +12414,7 @@ Add the window configuration CONF to `gnus-buffer-configuration'. ;;;*** ;;;### (autoloads (gnutls-min-prime-bits) "gnutls" "net/gnutls.el" -;;;;;; (20417 65331)) +;;;;;; (20417 65331 139825 0)) ;;; Generated autoloads from net/gnutls.el (defvar gnutls-min-prime-bits 256 "\ @@ -12375,7 +12430,8 @@ A value of nil says to use the default GnuTLS value.") ;;;*** -;;;### (autoloads (gomoku) "gomoku" "play/gomoku.el" (20355 10021)) +;;;### (autoloads (gomoku) "gomoku" "play/gomoku.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from play/gomoku.el (autoload 'gomoku "gomoku" "\ @@ -12403,7 +12459,7 @@ Use \\[describe-mode] for more info. ;;;### (autoloads (goto-address-prog-mode goto-address-mode goto-address ;;;;;; goto-address-at-point) "goto-addr" "net/goto-addr.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from net/goto-addr.el (define-obsolete-function-alias 'goto-address-at-mouse 'goto-address-at-point "22.1") @@ -12445,7 +12501,7 @@ Like `goto-address-mode', but only for comments and strings. ;;;*** ;;;### (autoloads (gravatar-retrieve-synchronously gravatar-retrieve) -;;;;;; "gravatar" "gnus/gravatar.el" (20355 10021)) +;;;;;; "gravatar" "gnus/gravatar.el" (20355 10021 546955 0)) ;;; Generated autoloads from gnus/gravatar.el (autoload 'gravatar-retrieve "gravatar" "\ @@ -12463,7 +12519,8 @@ 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" (20369 14251)) +;;;;;; grep-window-height) "grep" "progmodes/grep.el" (20369 14251 +;;;;;; 85829 0)) ;;; Generated autoloads from progmodes/grep.el (defvar grep-window-height nil "\ @@ -12626,7 +12683,8 @@ file name to `*.gz', and sets `grep-highlight-matches' to `always'. ;;;*** -;;;### (autoloads (gs-load-image) "gs" "gs.el" (20355 10021)) +;;;### (autoloads (gs-load-image) "gs" "gs.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from gs.el (autoload 'gs-load-image "gs" "\ @@ -12640,7 +12698,8 @@ the form \"WINDOW-ID PIXMAP-ID\". Value is non-nil if successful. ;;;*** ;;;### (autoloads (gud-tooltip-mode gdb-script-mode jdb pdb perldb -;;;;;; xdb dbx sdb gud-gdb) "gud" "progmodes/gud.el" (20373 11301)) +;;;;;; xdb dbx sdb gud-gdb) "gud" "progmodes/gud.el" (20458 56750 +;;;;;; 651721 0)) ;;; Generated autoloads from progmodes/gud.el (autoload 'gud-gdb "gud" "\ @@ -12726,10 +12785,100 @@ it if ARG is omitted or nil. \(fn &optional ARG)" t nil) +;;;*** + +;;;### (autoloads (setf gv-define-simple-setter gv-define-setter +;;;;;; gv--defun-declaration gv-define-expander gv-letplace gv-get) +;;;;;; "gv" "emacs-lisp/gv.el" (20453 5437 764254 0)) +;;; Generated autoloads from emacs-lisp/gv.el + +(autoload 'gv-get "gv" "\ +Build the code that applies DO to PLACE. +PLACE must be a valid generalized variable. +DO must be a function; it will be called with 2 arguments: GETTER and SETTER, +where GETTER is a (copyable) Elisp expression that returns the value of PLACE, +and SETTER is a function which returns the code to set PLACE when called +with a (not necessarily copyable) Elisp expression that returns the value to +set it to. +DO must return an Elisp expression. + +\(fn PLACE DO)" nil nil) + +(autoload 'gv-letplace "gv" "\ +Build the code manipulating the generalized variable PLACE. +GETTER will be bound to a copyable expression that returns the value +of PLACE. +SETTER will be bound to a function that takes an expression V and returns +and new expression that sets PLACE to V. +BODY should return some Elisp expression E manipulating PLACE via GETTER +and SETTER. +The returned value will then be an Elisp expression that first evaluates +all the parts of PLACE that can be evaluated and then runs E. + +\(fn (GETTER SETTER) PLACE &rest BODY)" nil t) + +(put 'gv-letplace 'lisp-indent-function '2) + +(autoload 'gv-define-expander "gv" "\ +Use HANDLER to handle NAME as a generalized var. +NAME is a symbol: the name of a function, macro, or special form. +HANDLER is a function which takes an argument DO followed by the same +arguments as NAME. DO is a function as defined in `gv-get'. + +\(fn NAME HANDLER)" nil t) + +(put 'gv-define-expander 'lisp-indent-function '1) + +(autoload 'gv--defun-declaration "gv" "\ + + +\(fn SYMBOL NAME ARGS HANDLER &optional FIX)" nil nil) + +(push `(gv-expander ,(apply-partially #'gv--defun-declaration 'gv-expander)) defun-declarations-alist) + +(push `(gv-setter ,(apply-partially #'gv--defun-declaration 'gv-setter)) defun-declarations-alist) + +(autoload 'gv-define-setter "gv" "\ +Define a setter method for generalized variable NAME. +This macro is an easy-to-use substitute for `gv-define-expander' that works +well for simple place forms. +Assignments of VAL to (NAME ARGS...) are expanded by binding the argument +forms (VAL ARGS...) according to ARGLIST, then executing BODY, which must +return a Lisp form that does the assignment. +Actually, ARGLIST may be bound to temporary variables which are introduced +automatically to preserve proper execution order of the arguments. Example: + (gv-define-setter aref (v a i) `(aset ,a ,i ,v)) + +\(fn NAME ARGLIST &rest BODY)" nil t) + +(put 'gv-define-setter 'lisp-indent-function '2) + +(autoload 'gv-define-simple-setter "gv" "\ +Define a simple setter method for generalized variable NAME. +This macro is an easy-to-use substitute for `gv-define-expander' that works +well for simple place forms. Assignments of VAL to (NAME ARGS...) are +turned into calls of the form (SETTER ARGS... VAL). +If FIX-RETURN is non-nil, then SETTER is not assumed to return VAL and +instead the assignment is turned into (prog1 VAL (SETTER ARGS... VAL)) +so as to preserve the semantics of `setf'. + +\(fn NAME SETTER &optional FIX-RETURN)" nil t) + +(autoload 'setf "gv" "\ +Set each PLACE to the value of its VAL. +This is a generalized version of `setq'; the PLACEs may be symbolic +references such as (car x) or (aref x i), as well as plain symbols. +For example, (setf (cadr x) y) is equivalent to (setcar (cdr x) y). +The return value is the last VAL in the list. + +\(fn PLACE VAL PLACE VAL ...)" nil t) + +(put 'gv-place 'edebug-form-spec 'edebug-match-form) + ;;;*** ;;;### (autoloads (handwrite) "handwrite" "play/handwrite.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from play/handwrite.el (autoload 'handwrite "handwrite" "\ @@ -12747,7 +12896,7 @@ Variables: `handwrite-linespace' (default 12) ;;;*** ;;;### (autoloads (hanoi-unix-64 hanoi-unix hanoi) "hanoi" "play/hanoi.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from play/hanoi.el (autoload 'hanoi "hanoi" "\ @@ -12776,7 +12925,7 @@ to be updated. ;;;### (autoloads (mail-check-payment mail-add-payment-async mail-add-payment ;;;;;; hashcash-verify-payment hashcash-insert-payment-async hashcash-insert-payment) -;;;;;; "hashcash" "mail/hashcash.el" (20355 10021)) +;;;;;; "hashcash" "mail/hashcash.el" (20355 10021 546955 0)) ;;; Generated autoloads from mail/hashcash.el (autoload 'hashcash-insert-payment "hashcash" "\ @@ -12821,7 +12970,8 @@ Prefix arg sets default accept amount temporarily. ;;;### (autoloads (scan-buf-previous-region scan-buf-next-region ;;;;;; scan-buf-move-to-region help-at-pt-display-when-idle help-at-pt-set-timer ;;;;;; help-at-pt-cancel-timer display-local-help help-at-pt-kbd-string -;;;;;; help-at-pt-string) "help-at-pt" "help-at-pt.el" (20355 10021)) +;;;;;; help-at-pt-string) "help-at-pt" "help-at-pt.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from help-at-pt.el (autoload 'help-at-pt-string "help-at-pt" "\ @@ -12951,7 +13101,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" (20355 10021)) +;;;;;; "help-fns" "help-fns.el" (20458 56750 651721 0)) ;;; Generated autoloads from help-fns.el (autoload 'describe-function "help-fns" "\ @@ -13031,7 +13181,7 @@ Produce a texinfo buffer with sorted doc-strings from the DOC file. ;;;*** ;;;### (autoloads (three-step-help) "help-macro" "help-macro.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from help-macro.el (defvar three-step-help nil "\ @@ -13045,10 +13195,10 @@ 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" (20355 -;;;;;; 10021)) +;;;### (autoloads (help-bookmark-jump 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" +;;;;;; (20459 40320 865360 0)) ;;; Generated autoloads from help-mode.el (autoload 'help-mode "help-mode" "\ @@ -13138,10 +13288,17 @@ Add xrefs for symbols in `pp's output between FROM and TO. \(fn FROM TO)" nil nil) +(autoload 'help-bookmark-jump "help-mode" "\ +Jump to help-mode bookmark BOOKMARK. +Handler function for record returned by `help-bookmark-make-record'. +BOOKMARK is a bookmark name or a bookmark record. + +\(fn BOOKMARK)" nil nil) + ;;;*** ;;;### (autoloads (Helper-help Helper-describe-bindings) "helper" -;;;;;; "emacs-lisp/helper.el" (20355 10021)) +;;;;;; "emacs-lisp/helper.el" (20355 10021 546955 0)) ;;; Generated autoloads from emacs-lisp/helper.el (autoload 'Helper-describe-bindings "helper" "\ @@ -13157,7 +13314,7 @@ Provide help for current mode. ;;;*** ;;;### (autoloads (hexlify-buffer hexl-find-file hexl-mode) "hexl" -;;;;;; "hexl.el" (20420 41510)) +;;;;;; "hexl.el" (20420 41510 996439 0)) ;;; Generated autoloads from hexl.el (autoload 'hexl-mode "hexl" "\ @@ -13254,7 +13411,7 @@ This discards the buffer's undo information. ;;;### (autoloads (hi-lock-write-interactive-patterns hi-lock-unface-buffer ;;;;;; hi-lock-face-phrase-buffer hi-lock-face-buffer hi-lock-line-face-buffer ;;;;;; global-hi-lock-mode hi-lock-mode) "hi-lock" "hi-lock.el" -;;;;;; (20410 5673)) +;;;;;; (20410 5673 834266 0)) ;;; Generated autoloads from hi-lock.el (autoload 'hi-lock-mode "hi-lock" "\ @@ -13393,7 +13550,7 @@ be found in variable `hi-lock-interactive-patterns'. ;;;*** ;;;### (autoloads (hide-ifdef-mode) "hideif" "progmodes/hideif.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from progmodes/hideif.el (autoload 'hide-ifdef-mode "hideif" "\ @@ -13437,7 +13594,7 @@ Several variables affect how the hiding is done: ;;;*** ;;;### (autoloads (turn-off-hideshow hs-minor-mode) "hideshow" "progmodes/hideshow.el" -;;;;;; (20356 55829)) +;;;;;; (20356 55829 180242 0)) ;;; Generated autoloads from progmodes/hideshow.el (defvar hs-special-modes-alist (mapcar 'purecopy '((c-mode "{" "}" "/[*/]" nil nil) (c++-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)" 1)) (java-mode "{" "}" "/[*/]" nil nil) (js-mode "{" "}" "/[*/]" nil))) "\ @@ -13504,7 +13661,7 @@ Unconditionally turn off `hs-minor-mode'. ;;;;;; highlight-changes-previous-change highlight-changes-next-change ;;;;;; highlight-changes-remove-highlight highlight-changes-visible-mode ;;;;;; highlight-changes-mode) "hilit-chg" "hilit-chg.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from hilit-chg.el (autoload 'highlight-changes-mode "hilit-chg" "\ @@ -13639,7 +13796,7 @@ See `highlight-changes-mode' for more information on Highlight-Changes mode. ;;;;;; hippie-expand-ignore-buffers hippie-expand-max-buffers hippie-expand-no-restriction ;;;;;; hippie-expand-dabbrev-as-symbol hippie-expand-dabbrev-skip-space ;;;;;; hippie-expand-verbose hippie-expand-try-functions-list) "hippie-exp" -;;;;;; "hippie-exp.el" (20355 10021)) +;;;;;; "hippie-exp.el" (20355 10021 546955 0)) ;;; Generated autoloads from hippie-exp.el (defvar hippie-expand-try-functions-list '(try-complete-file-name-partially try-complete-file-name try-expand-all-abbrevs try-expand-list try-expand-line try-expand-dabbrev try-expand-dabbrev-all-buffers try-expand-dabbrev-from-kill try-complete-lisp-symbol-partially try-complete-lisp-symbol) "\ @@ -13707,12 +13864,12 @@ Construct a function similar to `hippie-expand'. Make it use the expansion functions in TRY-LIST. An optional second argument VERBOSE non-nil makes the function verbose. -\(fn TRY-LIST &optional VERBOSE)" nil (quote macro)) +\(fn TRY-LIST &optional VERBOSE)" nil t) ;;;*** ;;;### (autoloads (global-hl-line-mode hl-line-mode) "hl-line" "hl-line.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from hl-line.el (autoload 'hl-line-mode "hl-line" "\ @@ -13765,7 +13922,7 @@ Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and ;;;;;; holiday-bahai-holidays holiday-islamic-holidays holiday-christian-holidays ;;;;;; holiday-hebrew-holidays holiday-other-holidays holiday-local-holidays ;;;;;; holiday-oriental-holidays holiday-general-holidays) "holidays" -;;;;;; "calendar/holidays.el" (20390 20388)) +;;;;;; "calendar/holidays.el" (20390 20388 254308 0)) ;;; Generated autoloads from calendar/holidays.el (define-obsolete-variable-alias 'general-holidays 'holiday-general-holidays "23.1") @@ -13914,7 +14071,7 @@ The optional LABEL is used to label the buffer created. ;;;*** ;;;### (autoloads (html2text) "html2text" "gnus/html2text.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from gnus/html2text.el (autoload 'html2text "html2text" "\ @@ -13925,7 +14082,7 @@ Convert HTML to plain text in the current buffer. ;;;*** ;;;### (autoloads (htmlfontify-copy-and-link-dir htmlfontify-buffer) -;;;;;; "htmlfontify" "htmlfontify.el" (20355 10021)) +;;;;;; "htmlfontify" "htmlfontify.el" (20355 10021 546955 0)) ;;; Generated autoloads from htmlfontify.el (autoload 'htmlfontify-buffer "htmlfontify" "\ @@ -13959,7 +14116,7 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'. ;;;### (autoloads (define-ibuffer-filter define-ibuffer-op define-ibuffer-sorter ;;;;;; define-ibuffer-column) "ibuf-macs" "ibuf-macs.el" (20406 -;;;;;; 8611)) +;;;;;; 8611 875037 0)) ;;; Generated autoloads from ibuf-macs.el (autoload 'define-ibuffer-column "ibuf-macs" "\ @@ -13987,8 +14144,6 @@ change its definition, you should explicitly call \(fn SYMBOL (&key NAME INLINE PROPS SUMMARIZER) &rest BODY)" nil (quote macro)) -(put 'define-ibuffer-column 'lisp-indent-function 'defun) - (autoload 'define-ibuffer-sorter "ibuf-macs" "\ Define a method of sorting named NAME. DOCUMENTATION is the documentation of the function, which will be called @@ -14001,10 +14156,6 @@ value if and only if `a' is \"less than\" `b'. \(fn NAME DOCUMENTATION (&key DESCRIPTION) &rest BODY)" nil (quote macro)) -(put 'define-ibuffer-sorter 'doc-string-elt '2) - -(put 'define-ibuffer-sorter 'lisp-indent-function '1) - (autoload 'define-ibuffer-op "ibuf-macs" "\ Generate a function which operates on a buffer. OP becomes the name of the function; if it doesn't begin with @@ -14038,10 +14189,6 @@ macro for exactly what it does. \(fn OP ARGS DOCUMENTATION (&key INTERACTIVE MARK MODIFIER-P DANGEROUS OPSTRING ACTIVE-OPSTRING COMPLEX) &rest BODY)" nil (quote macro)) -(put 'define-ibuffer-op 'doc-string-elt '3) - -(put 'define-ibuffer-op 'lisp-indent-function '2) - (autoload 'define-ibuffer-filter "ibuf-macs" "\ Define a filter named NAME. DOCUMENTATION is the documentation of the function. @@ -14055,14 +14202,10 @@ bound to the current value of the filter. \(fn NAME DOCUMENTATION (&key READER DESCRIPTION) &rest BODY)" nil (quote macro)) -(put 'define-ibuffer-filter 'doc-string-elt '2) - -(put 'define-ibuffer-filter 'lisp-indent-function '2) - ;;;*** ;;;### (autoloads (ibuffer ibuffer-other-window ibuffer-list-buffers) -;;;;;; "ibuffer" "ibuffer.el" (20383 47352)) +;;;;;; "ibuffer" "ibuffer.el" (20383 47352 714562 935000)) ;;; Generated autoloads from ibuffer.el (autoload 'ibuffer-list-buffers "ibuffer" "\ @@ -14103,7 +14246,7 @@ FORMATS is the value to use for `ibuffer-formats'. ;;;### (autoloads (icalendar-import-buffer icalendar-import-file ;;;;;; icalendar-export-region icalendar-export-file) "icalendar" -;;;;;; "calendar/icalendar.el" (20421 62373)) +;;;;;; "calendar/icalendar.el" (20434 17809 692608 0)) ;;; Generated autoloads from calendar/icalendar.el (autoload 'icalendar-export-file "icalendar" "\ @@ -14155,8 +14298,8 @@ buffer `*icalendar-errors*'. ;;;*** -;;;### (autoloads (icomplete-mode) "icomplete" "icomplete.el" (20355 -;;;;;; 10021)) +;;;### (autoloads (icomplete-mode) "icomplete" "icomplete.el" (20453 +;;;;;; 5437 764254 0)) ;;; Generated autoloads from icomplete.el (defvar icomplete-mode nil "\ @@ -14178,7 +14321,8 @@ the mode if ARG is omitted or nil. ;;;*** -;;;### (autoloads (icon-mode) "icon" "progmodes/icon.el" (20355 10021)) +;;;### (autoloads (icon-mode) "icon" "progmodes/icon.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from progmodes/icon.el (autoload 'icon-mode "icon" "\ @@ -14219,7 +14363,7 @@ with no args, if that value is non-nil. ;;;*** ;;;### (autoloads (idlwave-shell) "idlw-shell" "progmodes/idlw-shell.el" -;;;;;; (20394 17446)) +;;;;;; (20427 14766 970343 0)) ;;; Generated autoloads from progmodes/idlw-shell.el (autoload 'idlwave-shell "idlw-shell" "\ @@ -14245,7 +14389,7 @@ See also the variable `idlwave-shell-prompt-pattern'. ;;;*** ;;;### (autoloads (idlwave-mode) "idlwave" "progmodes/idlwave.el" -;;;;;; (20387 44199)) +;;;;;; (20458 56750 651721 0)) ;;; Generated autoloads from progmodes/idlwave.el (autoload 'idlwave-mode "idlwave" "\ @@ -14379,8 +14523,8 @@ The main features of this mode are ;;;;;; ido-find-alternate-file ido-find-file-other-window ido-find-file ;;;;;; ido-find-file-in-dir ido-switch-buffer-other-frame ido-insert-buffer ;;;;;; ido-kill-buffer ido-display-buffer ido-switch-buffer-other-window -;;;;;; ido-switch-buffer ido-mode ido-mode) "ido" "ido.el" (20387 -;;;;;; 44199)) +;;;;;; ido-switch-buffer ido-mode ido-mode) "ido" "ido.el" (20450 +;;;;;; 62630 628906 0)) ;;; Generated autoloads from ido.el (defvar ido-mode nil "\ @@ -14424,8 +14568,7 @@ their normal keybindings, except for the following: \\ RET Select the file at the front of the list of matches. If the list is empty, possibly prompt to create new file. -\\[ido-select-text] Select the current prompt as the buffer or file. -If no buffer or file is found, prompt for a new one. +\\[ido-select-text] Use the current input string verbatim. \\[ido-next-match] Put the first element at the end of the list. \\[ido-prev-match] Put the last element at the start of the list. @@ -14510,6 +14652,7 @@ If no buffer or file is found, prompt for a new one. matches all files. If there is only one match, select that file. If there is no common suffix, show a list of all matching files in a separate window. +\\[ido-magic-delete-char] Open the specified directory in Dired mode. \\[ido-edit-input] Edit input string (including directory). \\[ido-prev-work-directory] or \\[ido-next-work-directory] go to previous/next directory in work directory history. \\[ido-merge-work-directories] search for file in the work directory history. @@ -14640,7 +14783,7 @@ DEF, if non-nil, is the default value. ;;;*** -;;;### (autoloads (ielm) "ielm" "ielm.el" (20355 10021)) +;;;### (autoloads (ielm) "ielm" "ielm.el" (20355 10021 546955 0)) ;;; Generated autoloads from ielm.el (autoload 'ielm "ielm" "\ @@ -14651,7 +14794,8 @@ Switches to the buffer `*ielm*', or creates it if it does not exist. ;;;*** -;;;### (autoloads (iimage-mode) "iimage" "iimage.el" (20355 10021)) +;;;### (autoloads (iimage-mode) "iimage" "iimage.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from iimage.el (define-obsolete-function-alias 'turn-on-iimage-mode 'iimage-mode "24.1") @@ -14672,7 +14816,7 @@ the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. ;;;;;; 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" -;;;;;; (20423 43129)) +;;;;;; (20437 50597 545250 0)) ;;; Generated autoloads from image.el (autoload 'image-type-from-data "image" "\ @@ -14872,7 +15016,7 @@ If Emacs is compiled without ImageMagick support, this does nothing. ;;;;;; image-dired-jump-thumbnail-buffer image-dired-delete-tag ;;;;;; image-dired-tag-files image-dired-show-all-from-dir image-dired-display-thumbs ;;;;;; image-dired-dired-with-window-configuration image-dired-dired-toggle-marked-thumbs) -;;;;;; "image-dired" "image-dired.el" (20355 10021)) +;;;;;; "image-dired" "image-dired.el" (20458 56750 651721 0)) ;;; Generated autoloads from image-dired.el (autoload 'image-dired-dired-toggle-marked-thumbs "image-dired" "\ @@ -15010,7 +15154,7 @@ easy-to-use form. ;;;### (autoloads (auto-image-file-mode insert-image-file image-file-name-regexp ;;;;;; image-file-name-regexps image-file-name-extensions) "image-file" -;;;;;; "image-file.el" (20355 10021)) +;;;;;; "image-file.el" (20355 10021 546955 0)) ;;; Generated autoloads from image-file.el (defvar image-file-name-extensions (purecopy '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm" "svg")) "\ @@ -15073,7 +15217,8 @@ An image file is one whose name has an extension in ;;;*** ;;;### (autoloads (image-bookmark-jump image-mode-as-text image-minor-mode -;;;;;; image-mode) "image-mode" "image-mode.el" (20420 41510)) +;;;;;; image-mode) "image-mode" "image-mode.el" (20420 41510 996439 +;;;;;; 0)) ;;; Generated autoloads from image-mode.el (autoload 'image-mode "image-mode" "\ @@ -15118,7 +15263,8 @@ on these modes. ;;;*** ;;;### (autoloads (imenu imenu-add-menubar-index imenu-add-to-menubar -;;;;;; imenu-sort-function) "imenu" "imenu.el" (20393 22044)) +;;;;;; imenu-sort-function) "imenu" "imenu.el" (20393 22044 766544 +;;;;;; 0)) ;;; Generated autoloads from imenu.el (defvar imenu-sort-function nil "\ @@ -15235,7 +15381,7 @@ for more information. ;;;### (autoloads (indian-2-column-to-ucs-region in-is13194-pre-write-conversion ;;;;;; in-is13194-post-read-conversion indian-compose-string indian-compose-region) -;;;;;; "ind-util" "language/ind-util.el" (20355 10021)) +;;;;;; "ind-util" "language/ind-util.el" (20355 10021 546955 0)) ;;; Generated autoloads from language/ind-util.el (autoload 'indian-compose-region "ind-util" "\ @@ -15267,7 +15413,7 @@ Convert old Emacs Devanagari characters to UCS. ;;;### (autoloads (inferior-lisp inferior-lisp-prompt inferior-lisp-load-command ;;;;;; inferior-lisp-program inferior-lisp-filter-regexp) "inf-lisp" -;;;;;; "progmodes/inf-lisp.el" (20355 10021)) +;;;;;; "progmodes/inf-lisp.el" (20355 10021 546955 0)) ;;; Generated autoloads from progmodes/inf-lisp.el (defvar inferior-lisp-filter-regexp (purecopy "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'") "\ @@ -15334,9 +15480,29 @@ 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-bug info-emacs-manual -;;;;;; info info-other-window) "info" "info.el" (20420 41510)) +;;;;;; info info-other-window) "info" "info.el" (20458 56750 651721 +;;;;;; 0)) ;;; Generated autoloads from info.el +(defcustom Info-default-directory-list (let* ((config-dir (file-name-as-directory (or (and (featurep 'ns) (let ((dir (expand-file-name "../info" data-directory))) (if (file-directory-p dir) dir))) configure-info-directory))) (prefixes (prune-directory-list '("/usr/local/" "/usr/" "/opt/" "/"))) (suffixes '("share/" "" "gnu/" "gnu/lib/" "gnu/lib/emacs/" "emacs/" "lib/" "lib/emacs/")) (standard-info-dirs (apply #'nconc (mapcar (lambda (pfx) (let ((dirs (mapcar (lambda (sfx) (concat pfx sfx "info/")) suffixes))) (prune-directory-list dirs))) prefixes))) (dirs (if (member config-dir standard-info-dirs) (nconc standard-info-dirs (list config-dir)) (cons config-dir standard-info-dirs)))) (if (not (eq system-type 'windows-nt)) dirs (let* ((instdir (file-name-directory invocation-directory)) (dir1 (expand-file-name "../info/" instdir)) (dir2 (expand-file-name "../../../info/" instdir))) (cond ((file-exists-p dir1) (append dirs (list dir1))) ((file-exists-p dir2) (append dirs (list dir2))) (t dirs))))) "\ +Default list of directories to search for Info documentation files. +They are searched in the order they are given in the list. +Therefore, the directory of Info files that come with Emacs +normally should come last (so that local files override standard ones), +unless Emacs is installed into a non-standard directory. In the latter +case, the directory of Info files that come with Emacs should be +first in this list. + +Once Info is started, the list of directories to search +comes from the variable `Info-directory-list'. +This variable `Info-default-directory-list' is used as the default +for initializing `Info-directory-list' when Info is started, unless +the environment variable INFOPATH is set. + +Although this is a customizable variable, that is mainly for technical +reasons. Normally, you should either set INFOPATH or customize +`Info-additional-directory-list', rather than changing this variable." :initialize (quote custom-initialize-delay) :type (quote (repeat directory)) :group (quote info)) + (autoload 'info-other-window "info" "\ Like `info' but show the Info buffer in another window. @@ -15525,7 +15691,7 @@ Go to Info buffer that displays MANUAL, creating it if none already exists. ;;;### (autoloads (info-complete-file info-complete-symbol info-lookup-file ;;;;;; info-lookup-symbol info-lookup-reset) "info-look" "info-look.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from info-look.el (autoload 'info-lookup-reset "info-look" "\ @@ -15574,7 +15740,7 @@ Perform completion on file preceding point. ;;;### (autoloads (info-xref-docstrings info-xref-check-all-custom ;;;;;; info-xref-check-all info-xref-check) "info-xref" "info-xref.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from info-xref.el (autoload 'info-xref-check "info-xref" "\ @@ -15657,7 +15823,8 @@ the sources handy. ;;;*** ;;;### (autoloads (batch-info-validate Info-validate Info-split Info-split-threshold -;;;;;; Info-tagify) "informat" "informat.el" (20355 10021)) +;;;;;; Info-tagify) "informat" "informat.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from informat.el (autoload 'Info-tagify "informat" "\ @@ -15704,7 +15871,7 @@ For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\" ;;;### (autoloads (isearch-process-search-multibyte-characters isearch-toggle-input-method ;;;;;; isearch-toggle-specified-input-method) "isearch-x" "international/isearch-x.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from international/isearch-x.el (autoload 'isearch-toggle-specified-input-method "isearch-x" "\ @@ -15725,7 +15892,7 @@ Toggle input method in interactive search. ;;;*** ;;;### (autoloads (isearchb-activate) "isearchb" "isearchb.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from isearchb.el (autoload 'isearchb-activate "isearchb" "\ @@ -15741,7 +15908,7 @@ accessed via isearchb. ;;;### (autoloads (iso-cvt-define-menu iso-cvt-write-only iso-cvt-read-only ;;;;;; iso-sgml2iso iso-iso2sgml iso-iso2duden iso-iso2gtex iso-gtex2iso ;;;;;; iso-tex2iso iso-iso2tex iso-german iso-spanish) "iso-cvt" -;;;;;; "international/iso-cvt.el" (20355 10021)) +;;;;;; "international/iso-cvt.el" (20355 10021 546955 0)) ;;; Generated autoloads from international/iso-cvt.el (autoload 'iso-spanish "iso-cvt" "\ @@ -15832,7 +15999,7 @@ Add submenus to the File menu, to convert to and from various formats. ;;;*** ;;;### (autoloads nil "iso-transl" "international/iso-transl.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from international/iso-transl.el (or key-translation-map (setq key-translation-map (make-sparse-keymap))) (define-key key-translation-map "\C-x8" 'iso-transl-ctl-x-8-map) @@ -15844,7 +16011,7 @@ Add submenus to the File menu, to convert to and from various formats. ;;;;;; ispell-complete-word ispell-continue ispell-buffer ispell-comments-and-strings ;;;;;; ispell-region ispell-change-dictionary ispell-kill-ispell ;;;;;; ispell-help ispell-pdict-save ispell-word ispell-personal-dictionary) -;;;;;; "ispell" "textmodes/ispell.el" (20423 17700)) +;;;;;; "ispell" "textmodes/ispell.el" (20458 56750 651721 0)) ;;; Generated autoloads from textmodes/ispell.el (put 'ispell-check-comments 'safe-local-variable (lambda (a) (memq a '(nil t exclusive)))) @@ -16072,7 +16239,7 @@ You can bind this to the key C-c i in GNUS or mail by adding to ;;;*** ;;;### (autoloads (iswitchb-mode) "iswitchb" "iswitchb.el" (20387 -;;;;;; 44199)) +;;;;;; 44199 24128 0)) ;;; Generated autoloads from iswitchb.el (defvar iswitchb-mode nil "\ @@ -16100,7 +16267,8 @@ between buffers using substrings. See `iswitchb' for details. ;;;### (autoloads (read-hiragana-string japanese-zenkaku-region japanese-hankaku-region ;;;;;; japanese-hiragana-region japanese-katakana-region japanese-zenkaku ;;;;;; japanese-hankaku japanese-hiragana japanese-katakana setup-japanese-environment-internal) -;;;;;; "japan-util" "language/japan-util.el" (20355 10021)) +;;;;;; "japan-util" "language/japan-util.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from language/japan-util.el (autoload 'setup-japanese-environment-internal "japan-util" "\ @@ -16178,7 +16346,7 @@ If non-nil, second arg INITIAL-INPUT is a string to insert before reading. ;;;*** ;;;### (autoloads (jka-compr-uninstall jka-compr-handler) "jka-compr" -;;;;;; "jka-compr.el" (20355 10021)) +;;;;;; "jka-compr.el" (20355 10021 546955 0)) ;;; Generated autoloads from jka-compr.el (defvar jka-compr-inhibit nil "\ @@ -16201,7 +16369,8 @@ by `jka-compr-installed'. ;;;*** -;;;### (autoloads (js-mode) "js" "progmodes/js.el" (20415 53309)) +;;;### (autoloads (js-mode) "js" "progmodes/js.el" (20459 40320 865360 +;;;;;; 0)) ;;; Generated autoloads from progmodes/js.el (autoload 'js-mode "js" "\ @@ -16215,7 +16384,7 @@ Major mode for editing JavaScript. ;;;### (autoloads (keypad-setup keypad-numlock-shifted-setup keypad-shifted-setup ;;;;;; keypad-numlock-setup keypad-setup) "keypad" "emulation/keypad.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from emulation/keypad.el (defvar keypad-setup nil "\ @@ -16271,7 +16440,7 @@ the decimal key on the keypad is mapped to DECIMAL instead of `.' ;;;*** ;;;### (autoloads (kinsoku) "kinsoku" "international/kinsoku.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from international/kinsoku.el (autoload 'kinsoku "kinsoku" "\ @@ -16293,7 +16462,7 @@ the context of text formatting. ;;;*** ;;;### (autoloads (kkc-region) "kkc" "international/kkc.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from international/kkc.el (defvar kkc-after-update-conversion-functions nil "\ @@ -16318,7 +16487,7 @@ and the return value is the length of the conversion. ;;;### (autoloads (kmacro-end-call-mouse kmacro-end-and-call-macro ;;;;;; kmacro-end-or-call-macro kmacro-start-macro-or-insert-counter ;;;;;; kmacro-call-macro kmacro-end-macro kmacro-start-macro kmacro-exec-ring-item) -;;;;;; "kmacro" "kmacro.el" (20388 65061)) +;;;;;; "kmacro" "kmacro.el" (20388 65061 302484 0)) ;;; Generated autoloads from kmacro.el (global-set-key "\C-x(" 'kmacro-start-macro) (global-set-key "\C-x)" 'kmacro-end-macro) @@ -16429,7 +16598,7 @@ If kbd macro currently being defined end it before activating it. ;;;*** ;;;### (autoloads (setup-korean-environment-internal) "korea-util" -;;;;;; "language/korea-util.el" (20355 10021)) +;;;;;; "language/korea-util.el" (20355 10021 546955 0)) ;;; Generated autoloads from language/korea-util.el (defvar default-korean-keyboard (purecopy (if (string-match "3" (or (getenv "HANGUL_KEYBOARD_TYPE") "")) "3" "")) "\ @@ -16444,7 +16613,7 @@ The kind of Korean keyboard for Korean input method. ;;;*** ;;;### (autoloads (landmark landmark-test-run) "landmark" "play/landmark.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from play/landmark.el (defalias 'landmark-repeat 'landmark-test-run) @@ -16476,7 +16645,7 @@ Use \\[describe-mode] for more info. ;;;### (autoloads (lao-compose-region lao-composition-function lao-transcribe-roman-to-lao-string ;;;;;; lao-transcribe-single-roman-syllable-to-lao lao-compose-string) -;;;;;; "lao-util" "language/lao-util.el" (20355 10021)) +;;;;;; "lao-util" "language/lao-util.el" (20355 10021 546955 0)) ;;; Generated autoloads from language/lao-util.el (autoload 'lao-compose-string "lao-util" "\ @@ -16515,7 +16684,8 @@ Transcribe Romanized Lao string STR to Lao character string. ;;;### (autoloads (latexenc-find-file-coding-system latexenc-coding-system-to-inputenc ;;;;;; latexenc-inputenc-to-coding-system latex-inputenc-coding-alist) -;;;;;; "latexenc" "international/latexenc.el" (20355 10021)) +;;;;;; "latexenc" "international/latexenc.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from international/latexenc.el (defvar latex-inputenc-coding-alist (purecopy '(("ansinew" . windows-1252) ("applemac" . mac-roman) ("ascii" . us-ascii) ("cp1250" . windows-1250) ("cp1252" . windows-1252) ("cp1257" . cp1257) ("cp437de" . cp437) ("cp437" . cp437) ("cp850" . cp850) ("cp852" . cp852) ("cp858" . cp858) ("cp865" . cp865) ("latin1" . iso-8859-1) ("latin2" . iso-8859-2) ("latin3" . iso-8859-3) ("latin4" . iso-8859-4) ("latin5" . iso-8859-5) ("latin9" . iso-8859-15) ("next" . next) ("utf8" . utf-8) ("utf8x" . utf-8))) "\ @@ -16547,7 +16717,8 @@ coding system names is determined from `latex-inputenc-coding-alist'. ;;;*** ;;;### (autoloads (latin1-display-ucs-per-lynx latin1-display latin1-display) -;;;;;; "latin1-disp" "international/latin1-disp.el" (20355 10021)) +;;;;;; "latin1-disp" "international/latin1-disp.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from international/latin1-disp.el (defvar latin1-display nil "\ @@ -16589,7 +16760,7 @@ use either \\[customize] or the function `latin1-display'.") ;;;*** ;;;### (autoloads (ld-script-mode) "ld-script" "progmodes/ld-script.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from progmodes/ld-script.el (autoload 'ld-script-mode "ld-script" "\ @@ -16599,43 +16770,8 @@ A major mode to edit GNU ld script files ;;;*** -;;;### (autoloads (ledit-from-lisp-mode ledit-mode) "ledit" "ledit.el" -;;;;;; (20355 10021)) -;;; Generated autoloads from ledit.el - -(defconst ledit-save-files t "\ -*Non-nil means Ledit should save files before transferring to Lisp.") - -(defconst ledit-go-to-lisp-string "%?lisp" "\ -*Shell commands to execute to resume Lisp job.") - -(defconst ledit-go-to-liszt-string "%?liszt" "\ -*Shell commands to execute to resume Lisp compiler job.") - -(autoload 'ledit-mode "ledit" "\ -\\Major mode for editing text and stuffing it to a Lisp job. -Like Lisp mode, plus these special commands: - \\[ledit-save-defun] -- record defun at or after point - for later transmission to Lisp job. - \\[ledit-save-region] -- record region for later transmission to Lisp job. - \\[ledit-go-to-lisp] -- transfer to Lisp job and transmit saved text. - \\[ledit-go-to-liszt] -- transfer to Liszt (Lisp compiler) job - and transmit saved text. - -\\{ledit-mode-map} -To make Lisp mode automatically change to Ledit mode, -do (setq lisp-mode-hook 'ledit-from-lisp-mode) - -\(fn)" t nil) - -(autoload 'ledit-from-lisp-mode "ledit" "\ - - -\(fn)" nil nil) - -;;;*** - -;;;### (autoloads (life) "life" "play/life.el" (20355 10021)) +;;;### (autoloads (life) "life" "play/life.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from play/life.el (autoload 'life "life" "\ @@ -16649,7 +16785,7 @@ generations (this defaults to 1). ;;;*** ;;;### (autoloads (global-linum-mode linum-mode linum-format) "linum" -;;;;;; "linum.el" (20355 10021)) +;;;;;; "linum.el" (20355 10021 546955 0)) ;;; Generated autoloads from linum.el (defvar linum-format 'dynamic "\ @@ -16695,7 +16831,7 @@ See `linum-mode' for more information on Linum mode. ;;;*** ;;;### (autoloads (unload-feature) "loadhist" "loadhist.el" (20399 -;;;;;; 35365)) +;;;;;; 35365 4050 0)) ;;; Generated autoloads from loadhist.el (autoload 'unload-feature "loadhist" "\ @@ -16727,7 +16863,7 @@ something strange, such as redefining an Emacs function. ;;;*** ;;;### (autoloads (locate-with-filter locate locate-ls-subdir-switches) -;;;;;; "locate" "locate.el" (20355 10021)) +;;;;;; "locate" "locate.el" (20355 10021 546955 0)) ;;; Generated autoloads from locate.el (defvar locate-ls-subdir-switches (purecopy "-al") "\ @@ -16779,7 +16915,8 @@ except that FILTER is not optional. ;;;*** -;;;### (autoloads (log-edit) "log-edit" "vc/log-edit.el" (20399 35365)) +;;;### (autoloads (log-edit) "log-edit" "vc/log-edit.el" (20399 35365 +;;;;;; 4050 0)) ;;; Generated autoloads from vc/log-edit.el (autoload 'log-edit "log-edit" "\ @@ -16807,7 +16944,7 @@ uses the current buffer. ;;;*** ;;;### (autoloads (log-view-mode) "log-view" "vc/log-view.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from vc/log-view.el (autoload 'log-view-mode "log-view" "\ @@ -16818,7 +16955,7 @@ Major mode for browsing CVS log output. ;;;*** ;;;### (autoloads (longlines-mode) "longlines" "longlines.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from longlines.el (autoload 'longlines-mode "longlines" "\ @@ -16845,7 +16982,7 @@ newlines are indicated with a symbol. ;;;### (autoloads (print-region lpr-region print-buffer lpr-buffer ;;;;;; lpr-command lpr-switches printer-name) "lpr" "lpr.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from lpr.el (defvar lpr-windows-system (memq system-type '(ms-dos windows-nt)) "\ @@ -16941,7 +17078,7 @@ for further customization of the printer command. ;;;*** ;;;### (autoloads (ls-lisp-support-shell-wildcards) "ls-lisp" "ls-lisp.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from ls-lisp.el (defvar ls-lisp-support-shell-wildcards t "\ @@ -16953,7 +17090,7 @@ Otherwise they are treated as Emacs regexps (for backward compatibility).") ;;;*** ;;;### (autoloads (lunar-phases) "lunar" "calendar/lunar.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from calendar/lunar.el (autoload 'lunar-phases "lunar" "\ @@ -16968,7 +17105,7 @@ This function is suitable for execution in a .emacs file. ;;;*** ;;;### (autoloads (m4-mode) "m4-mode" "progmodes/m4-mode.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from progmodes/m4-mode.el (autoload 'm4-mode "m4-mode" "\ @@ -16979,7 +17116,7 @@ A major mode to edit m4 macro files. ;;;*** ;;;### (autoloads (macroexpand-all) "macroexp" "emacs-lisp/macroexp.el" -;;;;;; (20421 62373)) +;;;;;; (20454 59685 195070 0)) ;;; Generated autoloads from emacs-lisp/macroexp.el (autoload 'macroexpand-all "macroexp" "\ @@ -16993,7 +17130,8 @@ definitions to shadow the loaded ones for use in file byte-compilation. ;;;*** ;;;### (autoloads (apply-macro-to-region-lines kbd-macro-query insert-kbd-macro -;;;;;; name-last-kbd-macro) "macros" "macros.el" (20355 10021)) +;;;;;; name-last-kbd-macro) "macros" "macros.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from macros.el (autoload 'name-last-kbd-macro "macros" "\ @@ -17082,7 +17220,7 @@ and then select the region of un-tablified names and use ;;;*** ;;;### (autoloads (what-domain mail-extract-address-components) "mail-extr" -;;;;;; "mail/mail-extr.el" (20355 10021)) +;;;;;; "mail/mail-extr.el" (20355 10021 546955 0)) ;;; Generated autoloads from mail/mail-extr.el (autoload 'mail-extract-address-components "mail-extr" "\ @@ -17114,7 +17252,7 @@ Convert mail domain DOMAIN to the country it corresponds to. ;;;### (autoloads (mail-hist-put-headers-into-history mail-hist-keep-history ;;;;;; mail-hist-enable mail-hist-define-keys) "mail-hist" "mail/mail-hist.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from mail/mail-hist.el (autoload 'mail-hist-define-keys "mail-hist" "\ @@ -17146,7 +17284,7 @@ This function normally would be called when the message is sent. ;;;### (autoloads (mail-fetch-field mail-unquote-printable-region ;;;;;; mail-unquote-printable mail-quote-printable-region mail-quote-printable ;;;;;; mail-file-babyl-p mail-dont-reply-to-names mail-use-rfc822) -;;;;;; "mail-utils" "mail/mail-utils.el" (20355 10021)) +;;;;;; "mail-utils" "mail/mail-utils.el" (20355 10021 546955 0)) ;;; Generated autoloads from mail/mail-utils.el (defvar mail-use-rfc822 nil "\ @@ -17222,7 +17360,7 @@ 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" (20387 -;;;;;; 44199)) +;;;;;; 44199 24128 0)) ;;; Generated autoloads from mail/mailabbrev.el (defvar mail-abbrevs-mode nil "\ @@ -17273,7 +17411,7 @@ double-quotes. ;;;### (autoloads (mail-complete mail-completion-at-point-function ;;;;;; define-mail-alias expand-mail-aliases mail-complete-style) -;;;;;; "mailalias" "mail/mailalias.el" (20355 10021)) +;;;;;; "mailalias" "mail/mailalias.el" (20355 10021 546955 0)) ;;; Generated autoloads from mail/mailalias.el (defvar mail-complete-style 'angles "\ @@ -17325,7 +17463,7 @@ current header, calls `mail-complete-function' and passes prefix ARG if any. ;;;*** ;;;### (autoloads (mailclient-send-it) "mailclient" "mail/mailclient.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from mail/mailclient.el (autoload 'mailclient-send-it "mailclient" "\ @@ -17339,7 +17477,8 @@ 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" (20392 30149)) +;;;;;; "make-mode" "progmodes/make-mode.el" (20392 30149 675975 +;;;;;; 59000)) ;;; Generated autoloads from progmodes/make-mode.el (autoload 'makefile-mode "make-mode" "\ @@ -17457,7 +17596,7 @@ An adapted `makefile-mode' that knows about imake. ;;;*** ;;;### (autoloads (make-command-summary) "makesum" "makesum.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from makesum.el (autoload 'make-command-summary "makesum" "\ @@ -17469,7 +17608,7 @@ Previous contents of that buffer are killed first. ;;;*** ;;;### (autoloads (Man-bookmark-jump man-follow man) "man" "man.el" -;;;;;; (20390 20388)) +;;;;;; (20390 20388 254308 0)) ;;; Generated autoloads from man.el (defalias 'manual-entry 'man) @@ -17523,7 +17662,8 @@ Default bookmark handler for Man buffers. ;;;*** -;;;### (autoloads (master-mode) "master" "master.el" (20355 10021)) +;;;### (autoloads (master-mode) "master" "master.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from master.el (autoload 'master-mode "master" "\ @@ -17546,7 +17686,7 @@ yourself the value of `master-of' by calling `master-show-slave'. ;;;*** ;;;### (autoloads (minibuffer-depth-indicate-mode) "mb-depth" "mb-depth.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from mb-depth.el (defvar minibuffer-depth-indicate-mode nil "\ @@ -17579,7 +17719,7 @@ recursion depth in the minibuffer prompt. This is only useful if ;;;;;; 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" (20355 10021)) +;;;;;; "gnus/message.el" (20458 56750 651721 0)) ;;; 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) @@ -17745,7 +17885,7 @@ which specify the range to operate on. ;;;*** ;;;### (autoloads (metapost-mode metafont-mode) "meta-mode" "progmodes/meta-mode.el" -;;;;;; (20399 35365)) +;;;;;; (20399 35365 4050 0)) ;;; Generated autoloads from progmodes/meta-mode.el (autoload 'metafont-mode "meta-mode" "\ @@ -17762,7 +17902,7 @@ Major mode for editing MetaPost sources. ;;;### (autoloads (metamail-region metamail-buffer metamail-interpret-body ;;;;;; metamail-interpret-header) "metamail" "mail/metamail.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from mail/metamail.el (autoload 'metamail-interpret-header "metamail" "\ @@ -17807,7 +17947,7 @@ redisplayed as output is inserted. ;;;### (autoloads (mh-fully-kill-draft mh-send-letter mh-user-agent-compose ;;;;;; mh-smail-batch mh-smail-other-window mh-smail) "mh-comp" -;;;;;; "mh-e/mh-comp.el" (20355 10021)) +;;;;;; "mh-e/mh-comp.el" (20355 10021 546955 0)) ;;; Generated autoloads from mh-e/mh-comp.el (autoload 'mh-smail "mh-comp" "\ @@ -17897,7 +18037,8 @@ delete the draft message. ;;;*** -;;;### (autoloads (mh-version) "mh-e" "mh-e/mh-e.el" (20355 10021)) +;;;### (autoloads (mh-version) "mh-e" "mh-e/mh-e.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from mh-e/mh-e.el (put 'mh-progs 'risky-local-variable t) @@ -17914,7 +18055,7 @@ Display version information about MH-E and the MH mail handling system. ;;;*** ;;;### (autoloads (mh-folder-mode mh-nmail mh-rmail) "mh-folder" -;;;;;; "mh-e/mh-folder.el" (20371 55972)) +;;;;;; "mh-e/mh-folder.el" (20371 55972 331861 0)) ;;; Generated autoloads from mh-e/mh-folder.el (autoload 'mh-rmail "mh-folder" "\ @@ -17996,7 +18137,7 @@ perform the operation on all messages in that region. ;;;*** ;;;### (autoloads (midnight-delay-set clean-buffer-list) "midnight" -;;;;;; "midnight.el" (20355 10021)) +;;;;;; "midnight.el" (20355 10021 546955 0)) ;;; Generated autoloads from midnight.el (autoload 'clean-buffer-list "midnight" "\ @@ -18023,7 +18164,7 @@ to its second argument TM. ;;;*** ;;;### (autoloads (minibuffer-electric-default-mode) "minibuf-eldef" -;;;;;; "minibuf-eldef.el" (20355 10021)) +;;;;;; "minibuf-eldef.el" (20355 10021 546955 0)) ;;; Generated autoloads from minibuf-eldef.el (defvar minibuffer-electric-default-mode nil "\ @@ -18053,7 +18194,7 @@ is modified to remove the default indication. ;;;*** ;;;### (autoloads (list-dynamic-libraries butterfly) "misc" "misc.el" -;;;;;; (20356 27828)) +;;;;;; (20356 27828 24951 0)) ;;; Generated autoloads from misc.el (autoload 'butterfly "misc" "\ @@ -18083,7 +18224,7 @@ The return value is always nil. ;;;### (autoloads (multi-isearch-files-regexp multi-isearch-files ;;;;;; multi-isearch-buffers-regexp multi-isearch-buffers multi-isearch-setup) -;;;;;; "misearch" "misearch.el" (20420 41510)) +;;;;;; "misearch" "misearch.el" (20420 41510 996439 0)) ;;; Generated autoloads from misearch.el (add-hook 'isearch-mode-hook 'multi-isearch-setup) @@ -18165,7 +18306,7 @@ whose file names match the specified wildcard. ;;;*** ;;;### (autoloads (mixal-mode) "mixal-mode" "progmodes/mixal-mode.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from progmodes/mixal-mode.el (autoload 'mixal-mode "mixal-mode" "\ @@ -18176,7 +18317,7 @@ Major mode for the mixal asm language. ;;;*** ;;;### (autoloads (mm-default-file-encoding) "mm-encode" "gnus/mm-encode.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/mm-encode.el (autoload 'mm-default-file-encoding "mm-encode" "\ @@ -18187,7 +18328,7 @@ Return a default encoding for FILE. ;;;*** ;;;### (autoloads (mm-inline-external-body mm-extern-cache-contents) -;;;;;; "mm-extern" "gnus/mm-extern.el" (20355 10021)) +;;;;;; "mm-extern" "gnus/mm-extern.el" (20355 10021 546955 0)) ;;; Generated autoloads from gnus/mm-extern.el (autoload 'mm-extern-cache-contents "mm-extern" "\ @@ -18206,7 +18347,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing. ;;;*** ;;;### (autoloads (mm-inline-partial) "mm-partial" "gnus/mm-partial.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/mm-partial.el (autoload 'mm-inline-partial "mm-partial" "\ @@ -18220,7 +18361,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing. ;;;*** ;;;### (autoloads (mm-url-insert-file-contents-external mm-url-insert-file-contents) -;;;;;; "mm-url" "gnus/mm-url.el" (20355 10021)) +;;;;;; "mm-url" "gnus/mm-url.el" (20355 10021 546955 0)) ;;; Generated autoloads from gnus/mm-url.el (autoload 'mm-url-insert-file-contents "mm-url" "\ @@ -18237,7 +18378,7 @@ Insert file contents of URL using `mm-url-program'. ;;;*** ;;;### (autoloads (mm-uu-dissect-text-parts mm-uu-dissect) "mm-uu" -;;;;;; "gnus/mm-uu.el" (20355 10021)) +;;;;;; "gnus/mm-uu.el" (20355 10021 546955 0)) ;;; Generated autoloads from gnus/mm-uu.el (autoload 'mm-uu-dissect "mm-uu" "\ @@ -18257,7 +18398,7 @@ Assume text has been decoded if DECODED is non-nil. ;;;*** ;;;### (autoloads (mml-attach-file mml-to-mime) "mml" "gnus/mml.el" -;;;;;; (20355 10021)) +;;;;;; (20458 56750 651721 0)) ;;; Generated autoloads from gnus/mml.el (autoload 'mml-to-mime "mml" "\ @@ -18282,7 +18423,7 @@ body) or \"attachment\" (separate from the body). ;;;*** ;;;### (autoloads (mml1991-sign mml1991-encrypt) "mml1991" "gnus/mml1991.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/mml1991.el (autoload 'mml1991-encrypt "mml1991" "\ @@ -18299,7 +18440,7 @@ body) or \"attachment\" (separate from the body). ;;;### (autoloads (mml2015-self-encrypt mml2015-sign mml2015-encrypt ;;;;;; mml2015-verify-test mml2015-verify mml2015-decrypt-test mml2015-decrypt) -;;;;;; "mml2015" "gnus/mml2015.el" (20355 10021)) +;;;;;; "mml2015" "gnus/mml2015.el" (20355 10021 546955 0)) ;;; Generated autoloads from gnus/mml2015.el (autoload 'mml2015-decrypt "mml2015" "\ @@ -18339,7 +18480,8 @@ body) or \"attachment\" (separate from the body). ;;;*** -;;;### (autoloads nil "mode-local" "cedet/mode-local.el" (20406 8611)) +;;;### (autoloads nil "mode-local" "cedet/mode-local.el" (20406 8611 +;;;;;; 875037 0)) ;;; Generated autoloads from cedet/mode-local.el (put 'define-overloadable-function 'doc-string-elt 3) @@ -18347,7 +18489,7 @@ body) or \"attachment\" (separate from the body). ;;;*** ;;;### (autoloads (m2-mode) "modula2" "progmodes/modula2.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from progmodes/modula2.el (defalias 'modula-2-mode 'm2-mode) @@ -18381,7 +18523,7 @@ followed by the first character of the construct. ;;;*** ;;;### (autoloads (denato-region nato-region unmorse-region morse-region) -;;;;;; "morse" "play/morse.el" (20355 10021)) +;;;;;; "morse" "play/morse.el" (20355 10021 546955 0)) ;;; Generated autoloads from play/morse.el (autoload 'morse-region "morse" "\ @@ -18407,7 +18549,7 @@ Convert NATO phonetic alphabet in region to ordinary ASCII text. ;;;*** ;;;### (autoloads (mouse-drag-drag mouse-drag-throw) "mouse-drag" -;;;;;; "mouse-drag.el" (20355 10021)) +;;;;;; "mouse-drag.el" (20355 10021 546955 0)) ;;; Generated autoloads from mouse-drag.el (autoload 'mouse-drag-throw "mouse-drag" "\ @@ -18454,7 +18596,7 @@ To test this function, evaluate: ;;;*** -;;;### (autoloads (mpc) "mpc" "mpc.el" (20378 29222)) +;;;### (autoloads (mpc) "mpc" "mpc.el" (20378 29222 722320 0)) ;;; Generated autoloads from mpc.el (autoload 'mpc "mpc" "\ @@ -18464,7 +18606,8 @@ Main entry point for MPC. ;;;*** -;;;### (autoloads (mpuz) "mpuz" "play/mpuz.el" (20355 10021)) +;;;### (autoloads (mpuz) "mpuz" "play/mpuz.el" (20434 17809 692608 +;;;;;; 0)) ;;; Generated autoloads from play/mpuz.el (autoload 'mpuz "mpuz" "\ @@ -18474,7 +18617,7 @@ Multiplication puzzle with GNU Emacs. ;;;*** -;;;### (autoloads (msb-mode) "msb" "msb.el" (20355 10021)) +;;;### (autoloads (msb-mode) "msb" "msb.el" (20355 10021 546955 0)) ;;; Generated autoloads from msb.el (defvar msb-mode nil "\ @@ -18504,7 +18647,7 @@ different buffer menu using the function `msb'. ;;;;;; describe-current-coding-system describe-current-coding-system-briefly ;;;;;; describe-coding-system describe-character-set list-charset-chars ;;;;;; read-charset list-character-sets) "mule-diag" "international/mule-diag.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from international/mule-diag.el (autoload 'list-character-sets "mule-diag" "\ @@ -18641,7 +18784,8 @@ The default is 20. If LIMIT is negative, do not limit the listing. ;;;;;; coding-system-translation-table-for-decode coding-system-pre-write-conversion ;;;;;; coding-system-post-read-conversion lookup-nested-alist set-nested-alist ;;;;;; truncate-string-to-width store-substring string-to-sequence) -;;;;;; "mule-util" "international/mule-util.el" (20355 10021)) +;;;;;; "mule-util" "international/mule-util.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from international/mule-util.el (autoload 'string-to-sequence "mule-util" "\ @@ -18750,7 +18894,7 @@ CODING-SYSTEMS is a list of coding systems. See `set-coding-system-priority'. This affects the implicit sorting of lists of coding systems returned by operations such as `find-coding-systems-region'. -\(fn CODING-SYSTEMS &rest BODY)" nil (quote macro)) +\(fn CODING-SYSTEMS &rest BODY)" nil t) (put 'with-coding-priority 'lisp-indent-function 1) (autoload 'detect-coding-with-priority "mule-util" "\ @@ -18758,7 +18902,7 @@ Detect a coding system of the text between FROM and TO with PRIORITY-LIST. PRIORITY-LIST is an alist of coding categories vs the corresponding coding systems ordered by priority. -\(fn FROM TO PRIORITY-LIST)" nil (quote macro)) +\(fn FROM TO PRIORITY-LIST)" nil t) (autoload 'detect-coding-with-language-environment "mule-util" "\ Detect a coding system for the text between FROM and TO with LANG-ENV. @@ -18782,7 +18926,7 @@ per-character basis, this may not be accurate. ;;;;;; whois-reverse-lookup whois finger ftp run-dig dns-lookup-host ;;;;;; nslookup nslookup-host ping traceroute route arp netstat ;;;;;; iwconfig ifconfig) "net-utils" "net/net-utils.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from net/net-utils.el (autoload 'ifconfig "net-utils" "\ @@ -18877,7 +19021,7 @@ Open a network connection to HOST on PORT. ;;;*** ;;;### (autoloads (netrc-credentials) "netrc" "net/netrc.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from net/netrc.el (autoload 'netrc-credentials "netrc" "\ @@ -18890,7 +19034,7 @@ listed in the PORTS list. ;;;*** ;;;### (autoloads (open-network-stream) "network-stream" "net/network-stream.el" -;;;;;; (20369 14251)) +;;;;;; (20369 14251 85829 0)) ;;; Generated autoloads from net/network-stream.el (autoload 'open-network-stream "network-stream" "\ @@ -18981,7 +19125,7 @@ STARTTLS upgrades even if Emacs doesn't have built-in TLS functionality. ;;;*** ;;;### (autoloads (newsticker-start newsticker-running-p) "newst-backend" -;;;;;; "net/newst-backend.el" (20355 10021)) +;;;;;; "net/newst-backend.el" (20355 10021 546955 0)) ;;; Generated autoloads from net/newst-backend.el (autoload 'newsticker-running-p "newst-backend" "\ @@ -19003,7 +19147,7 @@ Run `newsticker-start-hook' if newsticker was not running already. ;;;*** ;;;### (autoloads (newsticker-plainview) "newst-plainview" "net/newst-plainview.el" -;;;;;; (20355 10021)) +;;;;;; (20434 17809 692608 0)) ;;; Generated autoloads from net/newst-plainview.el (autoload 'newsticker-plainview "newst-plainview" "\ @@ -19014,7 +19158,7 @@ Start newsticker plainview. ;;;*** ;;;### (autoloads (newsticker-show-news) "newst-reader" "net/newst-reader.el" -;;;;;; (20355 10021)) +;;;;;; (20434 17809 692608 0)) ;;; Generated autoloads from net/newst-reader.el (autoload 'newsticker-show-news "newst-reader" "\ @@ -19025,7 +19169,8 @@ Start reading news. You may want to bind this to a key. ;;;*** ;;;### (autoloads (newsticker-start-ticker newsticker-ticker-running-p) -;;;;;; "newst-ticker" "net/newst-ticker.el" (20355 10021)) +;;;;;; "newst-ticker" "net/newst-ticker.el" (20427 14766 970343 +;;;;;; 0)) ;;; Generated autoloads from net/newst-ticker.el (autoload 'newsticker-ticker-running-p "newst-ticker" "\ @@ -19046,7 +19191,7 @@ running already. ;;;*** ;;;### (autoloads (newsticker-treeview) "newst-treeview" "net/newst-treeview.el" -;;;;;; (20355 10021)) +;;;;;; (20434 17809 692608 0)) ;;; Generated autoloads from net/newst-treeview.el (autoload 'newsticker-treeview "newst-treeview" "\ @@ -19057,7 +19202,7 @@ Start newsticker treeview. ;;;*** ;;;### (autoloads (nndiary-generate-nov-databases) "nndiary" "gnus/nndiary.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/nndiary.el (autoload 'nndiary-generate-nov-databases "nndiary" "\ @@ -19068,7 +19213,7 @@ Generate NOV databases in all nndiary directories. ;;;*** ;;;### (autoloads (nndoc-add-type) "nndoc" "gnus/nndoc.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from gnus/nndoc.el (autoload 'nndoc-add-type "nndoc" "\ @@ -19083,7 +19228,7 @@ symbol in the alist. ;;;*** ;;;### (autoloads (nnfolder-generate-active-file) "nnfolder" "gnus/nnfolder.el" -;;;;;; (20355 10021)) +;;;;;; (20458 56750 651721 0)) ;;; Generated autoloads from gnus/nnfolder.el (autoload 'nnfolder-generate-active-file "nnfolder" "\ @@ -19095,7 +19240,7 @@ This command does not work if you use short group names. ;;;*** ;;;### (autoloads (nnml-generate-nov-databases) "nnml" "gnus/nnml.el" -;;;;;; (20355 10021)) +;;;;;; (20458 56750 651721 0)) ;;; Generated autoloads from gnus/nnml.el (autoload 'nnml-generate-nov-databases "nnml" "\ @@ -19106,7 +19251,7 @@ Generate NOV databases in all nnml directories. ;;;*** ;;;### (autoloads (disable-command enable-command disabled-command-function) -;;;;;; "novice" "novice.el" (20399 35365)) +;;;;;; "novice" "novice.el" (20399 35365 4050 0)) ;;; Generated autoloads from novice.el (define-obsolete-variable-alias 'disabled-command-hook 'disabled-command-function "22.1") @@ -19139,7 +19284,7 @@ to future sessions. ;;;*** ;;;### (autoloads (nroff-mode) "nroff-mode" "textmodes/nroff-mode.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from textmodes/nroff-mode.el (autoload 'nroff-mode "nroff-mode" "\ @@ -19154,7 +19299,7 @@ closing requests for requests that are used in matched pairs. ;;;*** ;;;### (autoloads (nxml-glyph-display-string) "nxml-glyph" "nxml/nxml-glyph.el" -;;;;;; (20355 10021)) +;;;;;; (20439 5925 915283 0)) ;;; Generated autoloads from nxml/nxml-glyph.el (autoload 'nxml-glyph-display-string "nxml-glyph" "\ @@ -19166,8 +19311,8 @@ Return nil if the face cannot display a glyph for N. ;;;*** -;;;### (autoloads (nxml-mode) "nxml-mode" "nxml/nxml-mode.el" (20369 -;;;;;; 14251)) +;;;### (autoloads (nxml-mode) "nxml-mode" "nxml/nxml-mode.el" (20439 +;;;;;; 5925 915283 0)) ;;; Generated autoloads from nxml/nxml-mode.el (autoload 'nxml-mode "nxml-mode" "\ @@ -19229,7 +19374,7 @@ Many aspects this mode can be customized using ;;;*** ;;;### (autoloads (nxml-enable-unicode-char-name-sets) "nxml-uchnm" -;;;;;; "nxml/nxml-uchnm.el" (20355 10021)) +;;;;;; "nxml/nxml-uchnm.el" (20355 10021 546955 0)) ;;; Generated autoloads from nxml/nxml-uchnm.el (autoload 'nxml-enable-unicode-char-name-sets "nxml-uchnm" "\ @@ -19253,7 +19398,7 @@ the variable `nxml-enabled-unicode-blocks'. ;;;;;; org-babel-pop-to-session-maybe org-babel-load-in-session-maybe ;;;;;; org-babel-expand-src-block-maybe org-babel-view-src-block-info ;;;;;; org-babel-execute-maybe org-babel-execute-safely-maybe) "ob" -;;;;;; "org/ob.el" (20417 65331)) +;;;;;; "org/ob.el" (20417 65331 139825 0)) ;;; Generated autoloads from org/ob.el (autoload 'org-babel-execute-safely-maybe "ob" "\ @@ -19388,7 +19533,7 @@ body ------------- string holding the body of the code block beg-body --------- point at the beginning of the body end-body --------- point at the end of the body -\(fn FILE &rest BODY)" nil (quote macro)) +\(fn FILE &rest BODY)" nil t) (put 'org-babel-map-src-blocks 'lisp-indent-function '1) @@ -19397,7 +19542,7 @@ Evaluate BODY forms on each inline source-block in FILE. If FILE is nil evaluate BODY forms on source blocks in current buffer. -\(fn FILE &rest BODY)" nil (quote macro)) +\(fn FILE &rest BODY)" nil t) (put 'org-babel-map-inline-src-blocks 'lisp-indent-function '1) @@ -19406,14 +19551,14 @@ Evaluate BODY forms on each call line in FILE. If FILE is nil evaluate BODY forms on source blocks in current buffer. -\(fn FILE &rest BODY)" nil (quote macro)) +\(fn FILE &rest BODY)" nil t) (put 'org-babel-map-call-lines 'lisp-indent-function '1) (autoload 'org-babel-map-executables "ob" "\ -\(fn FILE &rest BODY)" nil (quote macro)) +\(fn FILE &rest BODY)" nil t) (put 'org-babel-map-executables 'lisp-indent-function '1) @@ -19476,7 +19621,7 @@ Mark current src block ;;;*** ;;;### (autoloads (org-babel-describe-bindings) "ob-keys" "org/ob-keys.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from org/ob-keys.el (autoload 'org-babel-describe-bindings "ob-keys" "\ @@ -19487,7 +19632,8 @@ Describe all keybindings behind `org-babel-key-prefix'. ;;;*** ;;;### (autoloads (org-babel-lob-get-info org-babel-lob-execute-maybe -;;;;;; org-babel-lob-ingest) "ob-lob" "org/ob-lob.el" (20355 10021)) +;;;;;; org-babel-lob-ingest) "ob-lob" "org/ob-lob.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from org/ob-lob.el (autoload 'org-babel-lob-ingest "ob-lob" "\ @@ -19512,7 +19658,7 @@ Return a Library of Babel function call as a string. ;;;### (autoloads (org-babel-tangle org-babel-tangle-file org-babel-load-file ;;;;;; org-babel-tangle-lang-exts) "ob-tangle" "org/ob-tangle.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from org/ob-tangle.el (defvar org-babel-tangle-lang-exts '(("emacs-lisp" . "el")) "\ @@ -19554,7 +19700,7 @@ exported source code blocks by language. ;;;*** ;;;### (autoloads (inferior-octave) "octave-inf" "progmodes/octave-inf.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from progmodes/octave-inf.el (autoload 'inferior-octave "octave-inf" "\ @@ -19577,7 +19723,7 @@ startup file, `~/.emacs-octave'. ;;;*** ;;;### (autoloads (octave-mode) "octave-mod" "progmodes/octave-mod.el" -;;;;;; (20388 65061)) +;;;;;; (20388 65061 302484 0)) ;;; Generated autoloads from progmodes/octave-mod.el (autoload 'octave-mode "octave-mod" "\ @@ -19665,7 +19811,7 @@ including a reproducible test case and send the message. ;;;;;; org-insert-link-global org-store-link org-run-like-in-org-mode ;;;;;; turn-on-orgstruct++ turn-on-orgstruct orgstruct-mode org-global-cycle ;;;;;; org-mode org-version org-babel-do-load-languages) "org" "org/org.el" -;;;;;; (20420 41510)) +;;;;;; (20420 41510 996439 0)) ;;; Generated autoloads from org/org.el (autoload 'org-babel-do-load-languages "org" "\ @@ -19898,7 +20044,8 @@ Call the customize function with org as argument. ;;;;;; org-diary org-agenda-list-stuck-projects org-tags-view org-todo-list ;;;;;; org-search-view org-agenda-list org-batch-store-agenda-views ;;;;;; org-store-agenda-views org-batch-agenda-csv org-batch-agenda -;;;;;; org-agenda) "org-agenda" "org/org-agenda.el" (20420 41510)) +;;;;;; org-agenda) "org-agenda" "org/org-agenda.el" (20420 41510 +;;;;;; 996439 0)) ;;; Generated autoloads from org/org-agenda.el (autoload 'org-agenda "org-agenda" "\ @@ -19945,7 +20092,7 @@ longer string it is used as a tags/todo match string. Parameters are alternating variable names and values that will be bound before running the agenda command. -\(fn CMD-KEY &rest PARAMETERS)" nil (quote macro)) +\(fn CMD-KEY &rest PARAMETERS)" nil t) (autoload 'org-batch-agenda-csv "org-agenda" "\ Run an agenda command in batch mode and send the result to STDOUT. @@ -19982,7 +20129,7 @@ priority-l The priority letter if any was given priority-n The computed numerical priority agenda-day The day in the agenda where this is listed -\(fn CMD-KEY &rest PARAMETERS)" nil (quote macro)) +\(fn CMD-KEY &rest PARAMETERS)" nil t) (autoload 'org-store-agenda-views "org-agenda" "\ @@ -19992,7 +20139,7 @@ agenda-day The day in the agenda where this is listed (autoload 'org-batch-store-agenda-views "org-agenda" "\ Run all custom agenda commands that have a file argument. -\(fn &rest PARAMETERS)" nil (quote macro)) +\(fn &rest PARAMETERS)" nil t) (autoload 'org-agenda-list "org-agenda" "\ Produce a daily/weekly view from all files in variable `org-agenda-files'. @@ -20152,7 +20299,7 @@ details and examples. ;;;### (autoloads (org-archive-subtree-default-with-confirmation ;;;;;; org-archive-subtree-default) "org-archive" "org/org-archive.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from org/org-archive.el (autoload 'org-archive-subtree-default "org-archive" "\ @@ -20173,7 +20320,7 @@ This command is set with the variable `org-archive-default-command'. ;;;;;; org-replace-region-by-ascii org-export-as-ascii-to-buffer ;;;;;; org-export-as-utf8-to-buffer org-export-as-utf8 org-export-as-latin1-to-buffer ;;;;;; org-export-as-latin1) "org-ascii" "org/org-ascii.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from org/org-ascii.el (autoload 'org-export-as-latin1 "org-ascii" "\ @@ -20247,7 +20394,7 @@ publishing directory. ;;;*** ;;;### (autoloads (org-attach) "org-attach" "org/org-attach.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from org/org-attach.el (autoload 'org-attach "org-attach" "\ @@ -20259,7 +20406,7 @@ Shows a list of commands and prompts for another key to execute a command. ;;;*** ;;;### (autoloads (org-bbdb-anniversaries) "org-bbdb" "org/org-bbdb.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from org/org-bbdb.el (autoload 'org-bbdb-anniversaries "org-bbdb" "\ @@ -20270,7 +20417,8 @@ Extract anniversaries from BBDB for display in the agenda. ;;;*** ;;;### (autoloads (org-capture-import-remember-templates org-capture-insert-template-here -;;;;;; org-capture) "org-capture" "org/org-capture.el" (20355 10021)) +;;;;;; org-capture) "org-capture" "org/org-capture.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from org/org-capture.el (autoload 'org-capture "org-capture" "\ @@ -20308,7 +20456,7 @@ Set org-capture-templates to be similar to `org-remember-templates'. ;;;*** ;;;### (autoloads (org-clock-persistence-insinuate org-get-clocktable) -;;;;;; "org-clock" "org/org-clock.el" (20378 29222)) +;;;;;; "org-clock" "org/org-clock.el" (20427 14766 970343 0)) ;;; Generated autoloads from org/org-clock.el (autoload 'org-get-clocktable "org-clock" "\ @@ -20326,7 +20474,7 @@ Set up hooks for clock persistence. ;;;*** ;;;### (autoloads (org-datetree-find-date-create) "org-datetree" -;;;;;; "org/org-datetree.el" (20355 10021)) +;;;;;; "org/org-datetree.el" (20355 10021 546955 0)) ;;; Generated autoloads from org/org-datetree.el (autoload 'org-datetree-find-date-create "org-datetree" "\ @@ -20342,7 +20490,7 @@ tree can be found. ;;;### (autoloads (org-export-as-docbook org-export-as-docbook-pdf-and-open ;;;;;; org-export-as-docbook-pdf org-export-region-as-docbook org-replace-region-by-docbook ;;;;;; org-export-as-docbook-to-buffer org-export-as-docbook-batch) -;;;;;; "org-docbook" "org/org-docbook.el" (20355 10021)) +;;;;;; "org-docbook" "org/org-docbook.el" (20355 10021 546955 0)) ;;; Generated autoloads from org/org-docbook.el (autoload 'org-export-as-docbook-batch "org-docbook" "\ @@ -20419,7 +20567,7 @@ publishing directory. ;;;### (autoloads (org-insert-export-options-template org-export-as-org ;;;;;; org-export-visible org-export) "org-exp" "org/org-exp.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from org/org-exp.el (autoload 'org-export "org-exp" "\ @@ -20481,7 +20629,7 @@ Insert into the buffer a template with information for exporting. ;;;### (autoloads (org-feed-show-raw-feed org-feed-goto-inbox org-feed-update ;;;;;; org-feed-update-all) "org-feed" "org/org-feed.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from org/org-feed.el (autoload 'org-feed-update-all "org-feed" "\ @@ -20509,7 +20657,7 @@ Show the raw feed buffer of a feed. ;;;*** ;;;### (autoloads (org-footnote-normalize org-footnote-action) "org-footnote" -;;;;;; "org/org-footnote.el" (20378 29222)) +;;;;;; "org/org-footnote.el" (20378 29222 722320 0)) ;;; Generated autoloads from org/org-footnote.el (autoload 'org-footnote-action "org-footnote" "\ @@ -20560,7 +20708,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor': ;;;### (autoloads (org-freemind-to-org-mode org-freemind-from-org-sparse-tree ;;;;;; org-freemind-from-org-mode org-freemind-from-org-mode-node ;;;;;; org-freemind-show org-export-as-freemind) "org-freemind" -;;;;;; "org/org-freemind.el" (20355 10021)) +;;;;;; "org/org-freemind.el" (20355 10021 546955 0)) ;;; Generated autoloads from org/org-freemind.el (autoload 'org-export-as-freemind "org-freemind" "\ @@ -20621,7 +20769,7 @@ Convert FreeMind file MM-FILE to `org-mode' file ORG-FILE. ;;;### (autoloads (org-export-htmlize-generate-css org-export-as-html ;;;;;; org-export-region-as-html org-replace-region-by-html org-export-as-html-to-buffer ;;;;;; org-export-as-html-batch org-export-as-html-and-open) "org-html" -;;;;;; "org/org-html.el" (20355 10021)) +;;;;;; "org/org-html.el" (20355 10021 546955 0)) ;;; Generated autoloads from org/org-html.el (put 'org-export-html-style-include-default 'safe-local-variable 'booleanp) @@ -20715,7 +20863,7 @@ that uses these same face definitions. ;;;### (autoloads (org-export-icalendar-combine-agenda-files org-export-icalendar-all-agenda-files ;;;;;; org-export-icalendar-this-file) "org-icalendar" "org/org-icalendar.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from org/org-icalendar.el (autoload 'org-export-icalendar-this-file "org-icalendar" "\ @@ -20743,7 +20891,7 @@ The file is stored under the name `org-combined-agenda-icalendar-file'. ;;;### (autoloads (org-id-store-link org-id-find-id-file org-id-find ;;;;;; org-id-goto org-id-get-with-outline-drilling org-id-get-with-outline-path-completion ;;;;;; org-id-get org-id-copy org-id-get-create) "org-id" "org/org-id.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from org/org-id.el (autoload 'org-id-get-create "org-id" "\ @@ -20812,7 +20960,7 @@ Store a link to the current entry, using its ID. ;;;*** ;;;### (autoloads (org-indent-mode) "org-indent" "org/org-indent.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from org/org-indent.el (autoload 'org-indent-mode "org-indent" "\ @@ -20830,7 +20978,7 @@ during idle time. ;;;*** ;;;### (autoloads (org-irc-store-link) "org-irc" "org/org-irc.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from org/org-irc.el (autoload 'org-irc-store-link "org-irc" "\ @@ -20843,7 +20991,7 @@ Dispatch to the appropriate function to store a link to an IRC session. ;;;### (autoloads (org-export-as-pdf-and-open org-export-as-pdf org-export-as-latex ;;;;;; org-export-region-as-latex org-replace-region-by-latex org-export-as-latex-to-buffer ;;;;;; org-export-as-latex-batch) "org-latex" "org/org-latex.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from org/org-latex.el (autoload 'org-export-as-latex-batch "org-latex" "\ @@ -20924,7 +21072,7 @@ Export as LaTeX, then process through to PDF, and open. ;;;### (autoloads (org-lparse-region org-replace-region-by org-lparse-to-buffer ;;;;;; org-lparse-batch org-lparse-and-open) "org-lparse" "org/org-lparse.el" -;;;;;; (20417 65331)) +;;;;;; (20417 65331 139825 0)) ;;; Generated autoloads from org/org-lparse.el (autoload 'org-lparse-and-open "org-lparse" "\ @@ -20982,7 +21130,7 @@ in a window. A non-interactive call will only return the buffer. ;;;### (autoloads (org-mobile-create-sumo-agenda org-mobile-pull ;;;;;; org-mobile-push) "org-mobile" "org/org-mobile.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from org/org-mobile.el (autoload 'org-mobile-push "org-mobile" "\ @@ -21008,7 +21156,7 @@ Create a file that contains all custom agenda views. ;;;### (autoloads (org-export-as-odf-and-open org-export-as-odf org-export-odt-convert ;;;;;; org-export-as-odt org-export-as-odt-batch org-export-as-odt-and-open) -;;;;;; "org-odt" "org/org-odt.el" (20417 65331)) +;;;;;; "org-odt" "org/org-odt.el" (20417 65331 139825 0)) ;;; Generated autoloads from org/org-odt.el (autoload 'org-export-as-odt-and-open "org-odt" "\ @@ -21078,7 +21226,7 @@ formula file. ;;;*** ;;;### (autoloads (org-plot/gnuplot) "org-plot" "org/org-plot.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from org/org-plot.el (autoload 'org-plot/gnuplot "org-plot" "\ @@ -21092,7 +21240,7 @@ line directly before or after the table. ;;;### (autoloads (org-publish-current-project org-publish-current-file ;;;;;; org-publish-all org-publish) "org-publish" "org/org-publish.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from org/org-publish.el (defalias 'org-publish-project 'org-publish) @@ -21126,7 +21274,7 @@ the project. ;;;### (autoloads (org-remember-handler org-remember org-remember-apply-template ;;;;;; org-remember-annotation org-remember-insinuate) "org-remember" -;;;;;; "org/org-remember.el" (20420 41510)) +;;;;;; "org/org-remember.el" (20420 41510 996439 0)) ;;; Generated autoloads from org/org-remember.el (autoload 'org-remember-insinuate "org-remember" "\ @@ -21202,7 +21350,7 @@ See also the variable `org-reverse-note-order'. ;;;*** ;;;### (autoloads (org-table-to-lisp orgtbl-mode turn-on-orgtbl) -;;;;;; "org-table" "org/org-table.el" (20417 65331)) +;;;;;; "org-table" "org/org-table.el" (20417 65331 139825 0)) ;;; Generated autoloads from org/org-table.el (autoload 'turn-on-orgtbl "org-table" "\ @@ -21226,7 +21374,8 @@ The table is taken from the parameter TXT, or from the buffer at point. ;;;*** ;;;### (autoloads (org-export-as-taskjuggler-and-open org-export-as-taskjuggler) -;;;;;; "org-taskjuggler" "org/org-taskjuggler.el" (20355 10021)) +;;;;;; "org-taskjuggler" "org/org-taskjuggler.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from org/org-taskjuggler.el (autoload 'org-export-as-taskjuggler "org-taskjuggler" "\ @@ -21254,7 +21403,7 @@ with the TaskJuggler GUI. ;;;### (autoloads (org-timer-set-timer org-timer-item org-timer-change-times-in-region ;;;;;; org-timer org-timer-start) "org-timer" "org/org-timer.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from org/org-timer.el (autoload 'org-timer-start "org-timer" "\ @@ -21315,7 +21464,7 @@ replace any running timer. ;;;*** ;;;### (autoloads (org-export-as-xoxo) "org-xoxo" "org/org-xoxo.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from org/org-xoxo.el (autoload 'org-export-as-xoxo "org-xoxo" "\ @@ -21327,7 +21476,7 @@ The XOXO buffer is named *xoxo-* ;;;*** ;;;### (autoloads (outline-minor-mode outline-mode) "outline" "outline.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from outline.el (put 'outline-regexp 'safe-local-variable 'stringp) (put 'outline-heading-end-regexp 'safe-local-variable 'stringp) @@ -21391,7 +21540,7 @@ See the command `outline-mode' for more information on this mode. ;;;### (autoloads (list-packages describe-package package-initialize ;;;;;; package-refresh-contents package-install-file package-install-from-buffer ;;;;;; package-install package-enable-at-startup) "package" "emacs-lisp/package.el" -;;;;;; (20394 17446)) +;;;;;; (20440 26788 208175 0)) ;;; Generated autoloads from emacs-lisp/package.el (defvar package-enable-at-startup t "\ @@ -21461,7 +21610,8 @@ The list is displayed in a buffer named `*Packages*'. ;;;*** -;;;### (autoloads (show-paren-mode) "paren" "paren.el" (20355 10021)) +;;;### (autoloads (show-paren-mode) "paren" "paren.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from paren.el (defvar show-paren-mode nil "\ @@ -21488,7 +21638,7 @@ matching parenthesis is highlighted in `show-paren-style' after ;;;*** ;;;### (autoloads (parse-time-string) "parse-time" "calendar/parse-time.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from calendar/parse-time.el (put 'parse-time-rules 'risky-local-variable t) @@ -21501,8 +21651,8 @@ unknown are returned as nil. ;;;*** -;;;### (autoloads (pascal-mode) "pascal" "progmodes/pascal.el" (20378 -;;;;;; 29222)) +;;;### (autoloads (pascal-mode) "pascal" "progmodes/pascal.el" (20439 +;;;;;; 5925 915283 0)) ;;; Generated autoloads from progmodes/pascal.el (autoload 'pascal-mode "pascal" "\ @@ -21555,7 +21705,8 @@ no args, if that value is non-nil. ;;;*** ;;;### (autoloads (password-in-cache-p password-cache-expiry password-cache) -;;;;;; "password-cache" "password-cache.el" (20355 10021)) +;;;;;; "password-cache" "password-cache.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from password-cache.el (defvar password-cache t "\ @@ -21577,7 +21728,7 @@ Check if KEY is in the cache. ;;;*** ;;;### (autoloads (pcase-let pcase-let* pcase) "pcase" "emacs-lisp/pcase.el" -;;;;;; (20421 62373)) +;;;;;; (20453 5437 764254 0)) ;;; Generated autoloads from emacs-lisp/pcase.el (autoload 'pcase "pcase" "\ @@ -21612,7 +21763,7 @@ E.g. you can match pairs where the cdr is larger than the car with a pattern like `(,a . ,(pred (< a))) or, with more checks: `(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a)))) -\(fn EXP &rest CASES)" nil (quote macro)) +\(fn EXP &rest CASES)" nil t) (put 'pcase 'lisp-indent-function '1) @@ -21621,7 +21772,7 @@ Like `let*' but where you can use `pcase' patterns for bindings. BODY should be an expression, and BINDINGS should be a list of bindings of the form (UPAT EXP). -\(fn BINDINGS &rest BODY)" nil (quote macro)) +\(fn BINDINGS &rest BODY)" nil t) (put 'pcase-let* 'lisp-indent-function '1) @@ -21630,14 +21781,14 @@ Like `let' but where you can use `pcase' patterns for bindings. BODY should be a list of expressions, and BINDINGS should be a list of bindings of the form (UPAT EXP). -\(fn BINDINGS &rest BODY)" nil (quote macro)) +\(fn BINDINGS &rest BODY)" nil t) (put 'pcase-let 'lisp-indent-function '1) ;;;*** ;;;### (autoloads (pcomplete/cvs) "pcmpl-cvs" "pcmpl-cvs.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from pcmpl-cvs.el (autoload 'pcomplete/cvs "pcmpl-cvs" "\ @@ -21648,7 +21799,7 @@ Completion rules for the `cvs' command. ;;;*** ;;;### (autoloads (pcomplete/tar pcomplete/make pcomplete/bzip2 pcomplete/gzip) -;;;;;; "pcmpl-gnu" "pcmpl-gnu.el" (20355 10021)) +;;;;;; "pcmpl-gnu" "pcmpl-gnu.el" (20355 10021 546955 0)) ;;; Generated autoloads from pcmpl-gnu.el (autoload 'pcomplete/gzip "pcmpl-gnu" "\ @@ -21676,7 +21827,7 @@ Completion for the GNU tar utility. ;;;*** ;;;### (autoloads (pcomplete/mount pcomplete/umount pcomplete/kill) -;;;;;; "pcmpl-linux" "pcmpl-linux.el" (20355 10021)) +;;;;;; "pcmpl-linux" "pcmpl-linux.el" (20355 10021 546955 0)) ;;; Generated autoloads from pcmpl-linux.el (autoload 'pcomplete/kill "pcmpl-linux" "\ @@ -21696,8 +21847,8 @@ Completion for GNU/Linux `mount'. ;;;*** -;;;### (autoloads (pcomplete/rpm) "pcmpl-rpm" "pcmpl-rpm.el" (20361 -;;;;;; 20134)) +;;;### (autoloads (pcomplete/rpm) "pcmpl-rpm" "pcmpl-rpm.el" (20453 +;;;;;; 5408 87415 759000)) ;;; Generated autoloads from pcmpl-rpm.el (autoload 'pcomplete/rpm "pcmpl-rpm" "\ @@ -21709,7 +21860,8 @@ Completion for the `rpm' command. ;;;### (autoloads (pcomplete/scp pcomplete/ssh pcomplete/chgrp pcomplete/chown ;;;;;; pcomplete/which pcomplete/xargs pcomplete/rm pcomplete/rmdir -;;;;;; pcomplete/cd) "pcmpl-unix" "pcmpl-unix.el" (20376 40834)) +;;;;;; pcomplete/cd) "pcmpl-unix" "pcmpl-unix.el" (20376 40834 914217 +;;;;;; 0)) ;;; Generated autoloads from pcmpl-unix.el (autoload 'pcomplete/cd "pcmpl-unix" "\ @@ -21767,7 +21919,7 @@ 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" (20376 -;;;;;; 40834)) +;;;;;; 40834 914217 0)) ;;; Generated autoloads from pcomplete.el (autoload 'pcomplete "pcomplete" "\ @@ -21826,7 +21978,7 @@ Setup `shell-mode' to use pcomplete. ;;;### (autoloads (cvs-dired-use-hook cvs-dired-action cvs-status ;;;;;; cvs-update cvs-examine cvs-quickdir cvs-checkout) "pcvs" -;;;;;; "vc/pcvs.el" (20364 45187)) +;;;;;; "vc/pcvs.el" (20454 59685 195070 0)) ;;; Generated autoloads from vc/pcvs.el (autoload 'cvs-checkout "pcvs" "\ @@ -21901,7 +22053,8 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (when (stringp d ;;;*** -;;;### (autoloads nil "pcvs-defs" "vc/pcvs-defs.el" (20355 10021)) +;;;### (autoloads nil "pcvs-defs" "vc/pcvs-defs.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from vc/pcvs-defs.el (defvar cvs-global-menu (let ((m (make-sparse-keymap "PCL-CVS"))) (define-key m [status] `(menu-item ,(purecopy "Directory Status") cvs-status :help ,(purecopy "A more verbose status of a workarea"))) (define-key m [checkout] `(menu-item ,(purecopy "Checkout Module") cvs-checkout :help ,(purecopy "Check out a module from the repository"))) (define-key m [update] `(menu-item ,(purecopy "Update Directory") cvs-update :help ,(purecopy "Fetch updates from the repository"))) (define-key m [examine] `(menu-item ,(purecopy "Examine Directory") cvs-examine :help ,(purecopy "Examine the current state of a workarea"))) (fset 'cvs-global-menu m)) "\ @@ -21910,7 +22063,7 @@ Global menu used by PCL-CVS.") ;;;*** ;;;### (autoloads (perl-mode) "perl-mode" "progmodes/perl-mode.el" -;;;;;; (20365 17199)) +;;;;;; (20365 17199 85293 0)) ;;; Generated autoloads from progmodes/perl-mode.el (put 'perl-indent-level 'safe-local-variable 'integerp) (put 'perl-continued-statement-offset 'safe-local-variable 'integerp) @@ -21972,7 +22125,7 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'. ;;;*** ;;;### (autoloads (picture-mode) "picture" "textmodes/picture.el" -;;;;;; (20373 11301)) +;;;;;; (20373 11301 906925 0)) ;;; Generated autoloads from textmodes/picture.el (autoload 'picture-mode "picture" "\ @@ -22053,7 +22206,7 @@ they are not by default assigned to keys. ;;;*** ;;;### (autoloads (plstore-mode plstore-open) "plstore" "gnus/plstore.el" -;;;;;; (20378 29222)) +;;;;;; (20378 29222 722320 0)) ;;; Generated autoloads from gnus/plstore.el (autoload 'plstore-open "plstore" "\ @@ -22069,7 +22222,7 @@ Major mode for editing PLSTORE files. ;;;*** ;;;### (autoloads (po-find-file-coding-system) "po" "textmodes/po.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from textmodes/po.el (autoload 'po-find-file-coding-system "po" "\ @@ -22080,7 +22233,8 @@ Called through `file-coding-system-alist', before the file is visited for real. ;;;*** -;;;### (autoloads (pong) "pong" "play/pong.el" (20355 10021)) +;;;### (autoloads (pong) "pong" "play/pong.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from play/pong.el (autoload 'pong "pong" "\ @@ -22096,7 +22250,8 @@ pong-mode keybindings:\\ ;;;*** -;;;### (autoloads (pop3-movemail) "pop3" "gnus/pop3.el" (20355 10021)) +;;;### (autoloads (pop3-movemail) "pop3" "gnus/pop3.el" (20458 56750 +;;;;;; 651721 0)) ;;; Generated autoloads from gnus/pop3.el (autoload 'pop3-movemail "pop3" "\ @@ -22109,7 +22264,7 @@ Use streaming commands. ;;;### (autoloads (pp-macroexpand-last-sexp pp-eval-last-sexp pp-macroexpand-expression ;;;;;; pp-eval-expression pp pp-buffer pp-to-string) "pp" "emacs-lisp/pp.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from emacs-lisp/pp.el (autoload 'pp-to-string "pp" "\ @@ -22177,7 +22332,7 @@ Ignores leading comment characters. ;;;;;; pr-ps-buffer-print pr-ps-buffer-using-ghostscript pr-ps-buffer-preview ;;;;;; pr-ps-directory-ps-print pr-ps-directory-print pr-ps-directory-using-ghostscript ;;;;;; pr-ps-directory-preview pr-interface) "printing" "printing.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from printing.el (autoload 'pr-interface "printing" "\ @@ -22764,7 +22919,8 @@ are both set to t. ;;;*** -;;;### (autoloads (proced) "proced" "proced.el" (20355 10021)) +;;;### (autoloads (proced) "proced" "proced.el" (20453 5437 764254 +;;;;;; 0)) ;;; Generated autoloads from proced.el (autoload 'proced "proced" "\ @@ -22780,7 +22936,7 @@ See `proced-mode' for a description of features available in Proced buffers. ;;;*** ;;;### (autoloads (run-prolog mercury-mode prolog-mode) "prolog" -;;;;;; "progmodes/prolog.el" (20397 45851)) +;;;;;; "progmodes/prolog.el" (20397 45851 446679 0)) ;;; Generated autoloads from progmodes/prolog.el (autoload 'prolog-mode "prolog" "\ @@ -22816,7 +22972,7 @@ With prefix argument ARG, restart the Prolog process if running before. ;;;*** ;;;### (autoloads (bdf-directory-list) "ps-bdf" "ps-bdf.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from ps-bdf.el (defvar bdf-directory-list (if (memq system-type '(ms-dos windows-nt)) (list (expand-file-name "fonts/bdf" installation-directory)) '("/usr/local/share/emacs/fonts/bdf")) "\ @@ -22828,7 +22984,7 @@ The default value is '(\"/usr/local/share/emacs/fonts/bdf\").") ;;;*** ;;;### (autoloads (ps-mode) "ps-mode" "progmodes/ps-mode.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from progmodes/ps-mode.el (autoload 'ps-mode "ps-mode" "\ @@ -22880,7 +23036,7 @@ Typing \\\\[ps-run-goto-error] when the cursor is at the number ;;;;;; ps-print-region-with-faces ps-print-region ps-print-buffer-with-faces ;;;;;; ps-print-buffer ps-print-customize ps-print-color-p ps-paper-type ;;;;;; ps-page-dimensions-database) "ps-print" "ps-print.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from ps-print.el (defvar ps-page-dimensions-database (purecopy (list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4") (list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3") (list 'letter (* 72 8.5) (* 72 11.0) "Letter") (list 'legal (* 72 8.5) (* 72 14.0) "Legal") (list 'letter-small (* 72 7.68) (* 72 10.16) "LetterSmall") (list 'tabloid (* 72 11.0) (* 72 17.0) "Tabloid") (list 'ledger (* 72 17.0) (* 72 11.0) "Ledger") (list 'statement (* 72 5.5) (* 72 8.5) "Statement") (list 'executive (* 72 7.5) (* 72 10.0) "Executive") (list 'a4small (* 72 7.47) (* 72 10.85) "A4Small") (list 'b4 (* 72 10.125) (* 72 14.33) "B4") (list 'b5 (* 72 7.16) (* 72 10.125) "B5") '(addresslarge 236.0 99.0 "AddressLarge") '(addresssmall 236.0 68.0 "AddressSmall") '(cuthanging13 90.0 222.0 "CutHanging13") '(cuthanging15 90.0 114.0 "CutHanging15") '(diskette 181.0 136.0 "Diskette") '(eurofilefolder 139.0 112.0 "EuropeanFilefolder") '(eurofoldernarrow 526.0 107.0 "EuroFolderNarrow") '(eurofolderwide 526.0 136.0 "EuroFolderWide") '(euronamebadge 189.0 108.0 "EuroNameBadge") '(euronamebadgelarge 223.0 136.0 "EuroNameBadgeLarge") '(filefolder 230.0 37.0 "FileFolder") '(jewelry 76.0 136.0 "Jewelry") '(mediabadge 180.0 136.0 "MediaBadge") '(multipurpose 126.0 68.0 "MultiPurpose") '(retaillabel 90.0 104.0 "RetailLabel") '(shipping 271.0 136.0 "Shipping") '(slide35mm 26.0 104.0 "Slide35mm") '(spine8mm 187.0 26.0 "Spine8mm") '(topcoated 425.19685 136.0 "TopCoatedPaper") '(topcoatedpaper 396.0 136.0 "TopcoatedPaper150") '(vhsface 205.0 127.0 "VHSFace") '(vhsspine 400.0 50.0 "VHSSpine") '(zipdisk 156.0 136.0 "ZipDisk"))) "\ @@ -23076,94 +23232,27 @@ If EXTENSION is any other symbol, it is ignored. ;;;*** -;;;### (autoloads (jython-mode python-mode python-after-info-look -;;;;;; run-python) "python" "progmodes/python.el" (20376 40834)) +;;;### (autoloads (python-mode) "python" "progmodes/python.el" (20453 +;;;;;; 38823 158957 0)) ;;; Generated autoloads from progmodes/python.el -(add-to-list 'interpreter-mode-alist (cons (purecopy "jython") 'jython-mode)) - -(add-to-list 'interpreter-mode-alist (cons (purecopy "python") 'python-mode)) - (add-to-list 'auto-mode-alist (cons (purecopy "\\.py\\'") 'python-mode)) -(autoload 'run-python "python" "\ -Run an inferior Python process, input and output via buffer *Python*. -CMD is the Python command to run. NOSHOW non-nil means don't -show the buffer automatically. - -Interactively, a prefix arg means to prompt for the initial -Python command line (default is `python-command'). - -A new process is started if one isn't running attached to -`python-buffer', or if called from Lisp with non-nil arg NEW. -Otherwise, if a process is already running in `python-buffer', -switch to that buffer. - -This command runs the hook `inferior-python-mode-hook' after -running `comint-mode-hook'. Type \\[describe-mode] in the -process buffer for a list of commands. - -By default, Emacs inhibits the loading of Python modules from the -current working directory, for security reasons. To disable this -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) +(add-to-list 'interpreter-mode-alist (cons (purecopy "python") 'python-mode)) (autoload 'python-mode "python" "\ Major mode for editing Python files. -Turns on Font Lock mode unconditionally since it is currently required -for correct parsing of the source. -See also `jython-mode', which is actually invoked if the buffer appears to -contain Jython code. See also `run-python' and associated Python mode -commands for running Python under Emacs. - -The Emacs commands which work with `defun's, e.g. \\[beginning-of-defun], deal -with nested `def' and `class' blocks. They take the innermost one as -current without distinguishing method and class definitions. Used multiple -times, they move over others at the same indentation level until they reach -the end of definitions at that level, when they move up a level. -\\ -Colon is electric: it outdents the line if appropriate, e.g. for -an else statement. \\[python-backspace] at the beginning of an indented statement -deletes a level of indentation to close the current block; otherwise it -deletes a character backward. TAB indents the current line relative to -the preceding code. Successive TABs, with no intervening command, cycle -through the possibilities for indentation on the basis of enclosing blocks. - -\\[fill-paragraph] fills comments and multi-line strings appropriately, but has no -effect outside them. - -Supports Eldoc mode (only for functions, using a Python process), -Info-Look and Imenu. In Outline minor mode, `class' and `def' -lines count as headers. Symbol completion is available in the -same way as in the Python shell using the `rlcompleter' module -and this is added to the Hippie Expand functions locally if -Hippie Expand mode is turned on. Completion of symbols of the -form x.y only works if the components are literal -module/attribute names, not variables. An abbrev table is set up -with skeleton expansions for compound statement templates. \\{python-mode-map} - -\(fn)" t nil) - -(autoload 'jython-mode "python" "\ -Major mode for editing Jython files. -Like `python-mode', but sets up parameters for Jython subprocesses. -Runs `jython-mode-hook' after `python-mode-hook'. +Entry to this mode calls the value of `python-mode-hook' +if that value is non-nil. \(fn)" t nil) ;;;*** ;;;### (autoloads (quoted-printable-decode-region) "qp" "gnus/qp.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/qp.el (autoload 'quoted-printable-decode-region "qp" "\ @@ -23186,7 +23275,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" (20356 55829)) +;;;;;; "international/quail.el" (20356 55829 180242 0)) ;;; Generated autoloads from international/quail.el (autoload 'quail-title "quail" "\ @@ -23336,7 +23425,7 @@ the following annotation types are supported. no-decode-map --- the value non-nil means that decoding map is not generated for the following translations. -\(fn &rest RULES)" nil (quote macro)) +\(fn &rest RULES)" nil t) (autoload 'quail-install-map "quail" "\ Install the Quail map MAP in the current Quail package. @@ -23418,7 +23507,7 @@ of each directory. ;;;### (autoloads (quickurl-list quickurl-list-mode quickurl-edit-urls ;;;;;; quickurl-browse-url-ask quickurl-browse-url quickurl-add-url ;;;;;; quickurl-ask quickurl) "quickurl" "net/quickurl.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from net/quickurl.el (defconst quickurl-reread-hook-postfix "\n;; Local Variables:\n;; eval: (progn (require 'quickurl) (add-hook 'local-write-file-hooks (lambda () (quickurl-read) nil)))\n;; End:\n" "\ @@ -23490,7 +23579,7 @@ Display `quickurl-list' as a formatted list using `quickurl-list-mode'. ;;;*** ;;;### (autoloads (rcirc-track-minor-mode rcirc-connect rcirc) "rcirc" -;;;;;; "net/rcirc.el" (20371 55972)) +;;;;;; "net/rcirc.el" (20434 17809 692608 0)) ;;; Generated autoloads from net/rcirc.el (autoload 'rcirc "rcirc" "\ @@ -23529,7 +23618,7 @@ if ARG is omitted or nil. ;;;*** ;;;### (autoloads (remote-compile) "rcompile" "net/rcompile.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from net/rcompile.el (autoload 'remote-compile "rcompile" "\ @@ -23541,7 +23630,7 @@ See \\[compile]. ;;;*** ;;;### (autoloads (re-builder) "re-builder" "emacs-lisp/re-builder.el" -;;;;;; (20355 10021)) +;;;;;; (20427 14766 970343 0)) ;;; Generated autoloads from emacs-lisp/re-builder.el (defalias 'regexp-builder 're-builder) @@ -23559,7 +23648,8 @@ matching parts of the target buffer will be highlighted. ;;;*** -;;;### (autoloads (recentf-mode) "recentf" "recentf.el" (20356 2211)) +;;;### (autoloads (recentf-mode) "recentf" "recentf.el" (20356 2211 +;;;;;; 532900 0)) ;;; Generated autoloads from recentf.el (defvar recentf-mode nil "\ @@ -23589,7 +23679,7 @@ were operated on recently. ;;;;;; string-rectangle delete-whitespace-rectangle open-rectangle ;;;;;; insert-rectangle yank-rectangle kill-rectangle extract-rectangle ;;;;;; delete-extract-rectangle delete-rectangle) "rect" "rect.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from rect.el (define-key ctl-x-r-map "c" 'clear-rectangle) (define-key ctl-x-r-map "k" 'kill-rectangle) @@ -23726,7 +23816,7 @@ with a prefix argument, prompt for START-AT and FORMAT. ;;;*** ;;;### (autoloads (refill-mode) "refill" "textmodes/refill.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from textmodes/refill.el (autoload 'refill-mode "refill" "\ @@ -23747,7 +23837,8 @@ For true \"word wrap\" behavior, use `visual-line-mode' instead. ;;;*** ;;;### (autoloads (reftex-reset-scanning-information reftex-mode -;;;;;; turn-on-reftex) "reftex" "textmodes/reftex.el" (20355 10021)) +;;;;;; turn-on-reftex) "reftex" "textmodes/reftex.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from textmodes/reftex.el (autoload 'turn-on-reftex "reftex" "\ @@ -23803,7 +23894,7 @@ This enforces rescanning the buffer on next use. ;;;*** ;;;### (autoloads (reftex-citation) "reftex-cite" "textmodes/reftex-cite.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from textmodes/reftex-cite.el (autoload 'reftex-citation "reftex-cite" "\ @@ -23833,7 +23924,7 @@ While entering the regexp, completion on knows citation keys is possible. ;;;*** ;;;### (autoloads (reftex-isearch-minor-mode) "reftex-global" "textmodes/reftex-global.el" -;;;;;; (20420 41510)) +;;;;;; (20427 14766 970343 0)) ;;; Generated autoloads from textmodes/reftex-global.el (autoload 'reftex-isearch-minor-mode "reftex-global" "\ @@ -23850,7 +23941,7 @@ With no argument, this command toggles ;;;*** ;;;### (autoloads (reftex-index-phrases-mode) "reftex-index" "textmodes/reftex-index.el" -;;;;;; (20399 35365)) +;;;;;; (20399 35365 4050 0)) ;;; Generated autoloads from textmodes/reftex-index.el (autoload 'reftex-index-phrases-mode "reftex-index" "\ @@ -23883,7 +23974,7 @@ Here are all local bindings. ;;;*** ;;;### (autoloads (reftex-all-document-files) "reftex-parse" "textmodes/reftex-parse.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from textmodes/reftex-parse.el (autoload 'reftex-all-document-files "reftex-parse" "\ @@ -23896,7 +23987,7 @@ of master file. ;;;*** ;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from textmodes/reftex-vars.el (put 'reftex-vref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x)))) (put 'reftex-fref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x)))) @@ -23906,7 +23997,7 @@ of master file. ;;;*** ;;;### (autoloads (regexp-opt-depth regexp-opt) "regexp-opt" "emacs-lisp/regexp-opt.el" -;;;;;; (20363 61861)) +;;;;;; (20363 61861 222722 0)) ;;; Generated autoloads from emacs-lisp/regexp-opt.el (autoload 'regexp-opt "regexp-opt" "\ @@ -23937,7 +24028,7 @@ This means the number of non-shy regexp grouping constructs ;;;### (autoloads (remember-diary-extract-entries remember-clipboard ;;;;;; remember-other-frame remember) "remember" "textmodes/remember.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from textmodes/remember.el (autoload 'remember "remember" "\ @@ -23968,7 +24059,8 @@ Extract diary entries from the region. ;;;*** -;;;### (autoloads (repeat) "repeat" "repeat.el" (20388 65061)) +;;;### (autoloads (repeat) "repeat" "repeat.el" (20388 65061 302484 +;;;;;; 0)) ;;; Generated autoloads from repeat.el (autoload 'repeat "repeat" "\ @@ -23991,7 +24083,7 @@ recently executed command not bound to an input event\". ;;;*** ;;;### (autoloads (reporter-submit-bug-report) "reporter" "mail/reporter.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from mail/reporter.el (autoload 'reporter-submit-bug-report "reporter" "\ @@ -24023,7 +24115,7 @@ mail-sending package is used for editing and sending the message. ;;;*** ;;;### (autoloads (reposition-window) "reposition" "reposition.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from reposition.el (autoload 'reposition-window "reposition" "\ @@ -24050,7 +24142,7 @@ first comment line visible (if point is in a comment). ;;;*** ;;;### (autoloads (global-reveal-mode reveal-mode) "reveal" "reveal.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from reveal.el (autoload 'reveal-mode "reveal" "\ @@ -24086,7 +24178,7 @@ the mode if ARG is omitted or nil. ;;;*** ;;;### (autoloads (make-ring ring-p) "ring" "emacs-lisp/ring.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from emacs-lisp/ring.el (autoload 'ring-p "ring" "\ @@ -24101,7 +24193,8 @@ Make a ring that can contain SIZE elements. ;;;*** -;;;### (autoloads (rlogin) "rlogin" "net/rlogin.el" (20402 11562)) +;;;### (autoloads (rlogin) "rlogin" "net/rlogin.el" (20402 11562 +;;;;;; 85788 0)) ;;; Generated autoloads from net/rlogin.el (autoload 'rlogin "rlogin" "\ @@ -24150,7 +24243,8 @@ 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-spool-directory -;;;;;; rmail-file-name) "rmail" "mail/rmail.el" (20414 2727)) +;;;;;; rmail-file-name) "rmail" "mail/rmail.el" (20437 50597 545250 +;;;;;; 0)) ;;; Generated autoloads from mail/rmail.el (defvar rmail-file-name (purecopy "~/RMAIL") "\ @@ -24348,7 +24442,8 @@ Set PASSWORD to be used for retrieving mail from a POP or IMAP server. ;;;*** ;;;### (autoloads (rmail-output-body-to-file rmail-output-as-seen -;;;;;; rmail-output) "rmailout" "mail/rmailout.el" (20355 10021)) +;;;;;; rmail-output) "rmailout" "mail/rmailout.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from mail/rmailout.el (put 'rmail-output-file-alist 'risky-local-variable t) @@ -24413,7 +24508,7 @@ than appending to it. Deletes the message after writing if ;;;*** ;;;### (autoloads (rng-c-load-schema) "rng-cmpct" "nxml/rng-cmpct.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from nxml/rng-cmpct.el (autoload 'rng-c-load-schema "rng-cmpct" "\ @@ -24425,7 +24520,7 @@ Return a pattern. ;;;*** ;;;### (autoloads (rng-nxml-mode-init) "rng-nxml" "nxml/rng-nxml.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from nxml/rng-nxml.el (autoload 'rng-nxml-mode-init "rng-nxml" "\ @@ -24438,7 +24533,7 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil. ;;;*** ;;;### (autoloads (rng-validate-mode) "rng-valid" "nxml/rng-valid.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from nxml/rng-valid.el (autoload 'rng-validate-mode "rng-valid" "\ @@ -24469,7 +24564,7 @@ to use for finding the schema. ;;;*** ;;;### (autoloads (rng-xsd-compile) "rng-xsd" "nxml/rng-xsd.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from nxml/rng-xsd.el (put 'http://www\.w3\.org/2001/XMLSchema-datatypes 'rng-dt-compile 'rng-xsd-compile) @@ -24497,7 +24592,7 @@ must be equal. ;;;*** ;;;### (autoloads (robin-use-package robin-modify-package robin-define-package) -;;;;;; "robin" "international/robin.el" (20355 10021)) +;;;;;; "robin" "international/robin.el" (20427 14766 970343 0)) ;;; Generated autoloads from international/robin.el (autoload 'robin-define-package "robin" "\ @@ -24511,7 +24606,7 @@ OUTPUT is either a character or a string. RULES are not evaluated. If there already exists a robin package whose name is NAME, the new one replaces the old one. -\(fn NAME DOCSTRING &rest RULES)" nil (quote macro)) +\(fn NAME DOCSTRING &rest RULES)" nil t) (autoload 'robin-modify-package "robin" "\ Change a rule in an already defined robin package. @@ -24530,7 +24625,8 @@ Start using robin package NAME, which is a string. ;;;*** ;;;### (autoloads (toggle-rot13-mode rot13-other-window rot13-region -;;;;;; rot13-string rot13) "rot13" "rot13.el" (20355 10021)) +;;;;;; rot13-string rot13) "rot13" "rot13.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from rot13.el (autoload 'rot13 "rot13" "\ @@ -24568,7 +24664,7 @@ Toggle the use of ROT13 encoding for the current window. ;;;*** ;;;### (autoloads (rst-minor-mode rst-mode) "rst" "textmodes/rst.el" -;;;;;; (20421 62373)) +;;;;;; (20459 40320 865360 0)) ;;; Generated autoloads from textmodes/rst.el (add-to-list 'auto-mode-alist (purecopy '("\\.re?st\\'" . rst-mode))) @@ -24599,7 +24695,7 @@ for modes derived from Text mode, like Mail mode. ;;;*** ;;;### (autoloads (ruby-mode) "ruby-mode" "progmodes/ruby-mode.el" -;;;;;; (20375 53029)) +;;;;;; (20375 53029 572236 0)) ;;; Generated autoloads from progmodes/ruby-mode.el (autoload 'ruby-mode "ruby-mode" "\ @@ -24621,7 +24717,7 @@ The variable `ruby-indent-level' controls the amount of indentation. ;;;*** ;;;### (autoloads (ruler-mode) "ruler-mode" "ruler-mode.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from ruler-mode.el (defvar ruler-mode nil "\ @@ -24639,7 +24735,7 @@ if ARG is omitted or nil. ;;;*** ;;;### (autoloads (rx rx-to-string) "rx" "emacs-lisp/rx.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from emacs-lisp/rx.el (autoload 'rx-to-string "rx" "\ @@ -24946,12 +25042,12 @@ enclosed in `(and ...)'. `(regexp REGEXP)' include REGEXP in string notation in the result. -\(fn &rest REGEXPS)" nil (quote macro)) +\(fn &rest REGEXPS)" nil t) ;;;*** -;;;### (autoloads (savehist-mode) "savehist" "savehist.el" (20355 -;;;;;; 10021)) +;;;### (autoloads (savehist-mode) "savehist" "savehist.el" (20453 +;;;;;; 5437 764254 0)) ;;; Generated autoloads from savehist.el (defvar savehist-mode nil "\ @@ -24983,7 +25079,7 @@ histories, which is probably undesirable. ;;;*** ;;;### (autoloads (dsssl-mode scheme-mode) "scheme" "progmodes/scheme.el" -;;;;;; (20355 10021)) +;;;;;; (20427 14766 970343 0)) ;;; Generated autoloads from progmodes/scheme.el (autoload 'scheme-mode "scheme" "\ @@ -24993,7 +25089,7 @@ Editing commands are similar to those of `lisp-mode'. In addition, if an inferior Scheme process is running, some additional commands will be defined, for evaluating expressions and controlling the interpreter, and the state of the process will be displayed in the -modeline of all Scheme buffers. The names of commands that interact +mode line of all Scheme buffers. The names of commands that interact with the Scheme process start with \"xscheme-\" if you use the MIT Scheme-specific `xscheme' package; for more information see the documentation for `xscheme-interaction-mode'. Use \\[run-scheme] to @@ -25025,7 +25121,7 @@ that variable's value is a string. ;;;*** ;;;### (autoloads (gnus-score-mode) "score-mode" "gnus/score-mode.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/score-mode.el (autoload 'gnus-score-mode "score-mode" "\ @@ -25039,7 +25135,7 @@ This mode is an extended emacs-lisp mode. ;;;*** ;;;### (autoloads (scroll-all-mode) "scroll-all" "scroll-all.el" -;;;;;; (20363 61861)) +;;;;;; (20363 61861 222722 0)) ;;; Generated autoloads from scroll-all.el (defvar scroll-all-mode nil "\ @@ -25065,7 +25161,7 @@ one window apply to all visible windows in the same frame. ;;;*** ;;;### (autoloads (scroll-lock-mode) "scroll-lock" "scroll-lock.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from scroll-lock.el (autoload 'scroll-lock-mode "scroll-lock" "\ @@ -25081,7 +25177,8 @@ vertically fixed relative to window boundaries during scrolling. ;;;*** -;;;### (autoloads nil "secrets" "net/secrets.el" (20355 10021)) +;;;### (autoloads nil "secrets" "net/secrets.el" (20464 9124 585807 +;;;;;; 0)) ;;; Generated autoloads from net/secrets.el (when (featurep 'dbusbind) (autoload 'secrets-show-secrets "secrets" nil t)) @@ -25089,7 +25186,7 @@ vertically fixed relative to window boundaries during scrolling. ;;;*** ;;;### (autoloads (semantic-mode semantic-default-submodes) "semantic" -;;;;;; "cedet/semantic.el" (20355 10021)) +;;;;;; "cedet/semantic.el" (20355 10021 546955 0)) ;;; Generated autoloads from cedet/semantic.el (defvar semantic-default-submodes '(global-semantic-idle-scheduler-mode global-semanticdb-minor-mode) "\ @@ -25143,7 +25240,7 @@ Semantic mode. ;;;;;; 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" (20417 65331)) +;;;;;; "sendmail" "mail/sendmail.el" (20417 65331 139825 0)) ;;; Generated autoloads from mail/sendmail.el (defvar mail-from-style 'default "\ @@ -25425,8 +25522,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" (20370 -;;;;;; 35109)) +;;;;;; server-force-delete server-start) "server" "server.el" (20457 +;;;;;; 35879 688143 0)) ;;; Generated autoloads from server.el (put 'server-host 'risky-local-variable t) @@ -25493,7 +25590,7 @@ only these files will be asked to be saved. ;;;*** -;;;### (autoloads (ses-mode) "ses" "ses.el" (20373 11301)) +;;;### (autoloads (ses-mode) "ses" "ses.el" (20459 40320 865360 0)) ;;; Generated autoloads from ses.el (autoload 'ses-mode "ses" "\ @@ -25512,7 +25609,7 @@ These are active only in the minibuffer, when entering or editing a formula: ;;;*** ;;;### (autoloads (html-mode sgml-mode) "sgml-mode" "textmodes/sgml-mode.el" -;;;;;; (20355 10021)) +;;;;;; (20427 14766 970343 0)) ;;; Generated autoloads from textmodes/sgml-mode.el (autoload 'sgml-mode "sgml-mode" "\ @@ -25578,7 +25675,7 @@ To work around that, do: ;;;*** ;;;### (autoloads (sh-mode) "sh-script" "progmodes/sh-script.el" -;;;;;; (20397 18394)) +;;;;;; (20397 18394 841411 0)) ;;; Generated autoloads from progmodes/sh-script.el (put 'sh-shell 'safe-local-variable 'symbolp) @@ -25642,7 +25739,7 @@ with your script for an edit-interpret-debug cycle. ;;;*** ;;;### (autoloads (list-load-path-shadows) "shadow" "emacs-lisp/shadow.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from emacs-lisp/shadow.el (autoload 'list-load-path-shadows "shadow" "\ @@ -25693,7 +25790,7 @@ function, `load-path-shadows-find'. ;;;### (autoloads (shadow-initialize shadow-define-regexp-group shadow-define-literal-group ;;;;;; shadow-define-cluster) "shadowfile" "shadowfile.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from shadowfile.el (autoload 'shadow-define-cluster "shadowfile" "\ @@ -25732,7 +25829,7 @@ Set up file shadowing. ;;;*** ;;;### (autoloads (shell shell-dumb-shell-regexp) "shell" "shell.el" -;;;;;; (20402 36105)) +;;;;;; (20402 36105 904047 0)) ;;; Generated autoloads from shell.el (defvar shell-dumb-shell-regexp (purecopy "cmd\\(proxy\\)?\\.exe") "\ @@ -25780,8 +25877,8 @@ Otherwise, one argument `-i' is passed to the shell. ;;;*** -;;;### (autoloads (shr-insert-document) "shr" "gnus/shr.el" (20355 -;;;;;; 10021)) +;;;### (autoloads (shr-insert-document) "shr" "gnus/shr.el" (20459 +;;;;;; 40320 865360 0)) ;;; Generated autoloads from gnus/shr.el (autoload 'shr-insert-document "shr" "\ @@ -25794,7 +25891,7 @@ DOM should be a parse tree as generated by ;;;*** ;;;### (autoloads (sieve-upload-and-bury sieve-upload sieve-manage) -;;;;;; "sieve" "gnus/sieve.el" (20355 10021)) +;;;;;; "sieve" "gnus/sieve.el" (20355 10021 546955 0)) ;;; Generated autoloads from gnus/sieve.el (autoload 'sieve-manage "sieve" "\ @@ -25815,7 +25912,7 @@ DOM should be a parse tree as generated by ;;;*** ;;;### (autoloads (sieve-mode) "sieve-mode" "gnus/sieve-mode.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/sieve-mode.el (autoload 'sieve-mode "sieve-mode" "\ @@ -25831,7 +25928,7 @@ Turning on Sieve mode runs `sieve-mode-hook'. ;;;*** ;;;### (autoloads (simula-mode) "simula" "progmodes/simula.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from progmodes/simula.el (autoload 'simula-mode "simula" "\ @@ -25880,7 +25977,8 @@ with no arguments, if that value is non-nil. ;;;*** ;;;### (autoloads (skeleton-pair-insert-maybe skeleton-insert skeleton-proxy-new -;;;;;; define-skeleton) "skeleton" "skeleton.el" (20406 8611)) +;;;;;; define-skeleton) "skeleton" "skeleton.el" (20406 8611 875037 +;;;;;; 0)) ;;; Generated autoloads from skeleton.el (defvar skeleton-filter-function 'identity "\ @@ -25891,7 +25989,7 @@ Define a user-configurable COMMAND that enters a statement skeleton. DOCUMENTATION is that of the command. SKELETON is as defined under `skeleton-insert'. -\(fn COMMAND DOCUMENTATION &rest SKELETON)" nil (quote macro)) +\(fn COMMAND DOCUMENTATION &rest SKELETON)" nil t) (put 'define-skeleton 'doc-string-elt '2) @@ -25992,7 +26090,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" (20415 23587)) +;;;;;; "smerge-mode" "vc/smerge-mode.el" (20415 23587 118149 0)) ;;; Generated autoloads from vc/smerge-mode.el (autoload 'smerge-ediff "smerge-mode" "\ @@ -26020,7 +26118,7 @@ If no conflict maker is found, turn off `smerge-mode'. ;;;*** ;;;### (autoloads (smiley-buffer smiley-region) "smiley" "gnus/smiley.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/smiley.el (autoload 'smiley-region "smiley" "\ @@ -26038,7 +26136,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" (20402 11562)) +;;;;;; "mail/smtpmail.el" (20402 11562 85788 0)) ;;; Generated autoloads from mail/smtpmail.el (autoload 'smtpmail-send-it "smtpmail" "\ @@ -26053,7 +26151,8 @@ Send mail that was queued as a result of setting `smtpmail-queue-mail'. ;;;*** -;;;### (autoloads (snake) "snake" "play/snake.el" (20355 10021)) +;;;### (autoloads (snake) "snake" "play/snake.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from play/snake.el (autoload 'snake "snake" "\ @@ -26077,7 +26176,7 @@ Snake mode keybindings: ;;;*** ;;;### (autoloads (snmpv2-mode snmp-mode) "snmp-mode" "net/snmp-mode.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from net/snmp-mode.el (autoload 'snmp-mode "snmp-mode" "\ @@ -26107,7 +26206,7 @@ then `snmpv2-mode-hook'. ;;;*** ;;;### (autoloads (sunrise-sunset) "solar" "calendar/solar.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from calendar/solar.el (autoload 'sunrise-sunset "solar" "\ @@ -26122,8 +26221,8 @@ This function is suitable for execution in a .emacs file. ;;;*** -;;;### (autoloads (solitaire) "solitaire" "play/solitaire.el" (20355 -;;;;;; 10021)) +;;;### (autoloads (solitaire) "solitaire" "play/solitaire.el" (20427 +;;;;;; 14766 970343 0)) ;;; Generated autoloads from play/solitaire.el (autoload 'solitaire "solitaire" "\ @@ -26200,7 +26299,8 @@ Pick your favorite shortcuts: ;;;### (autoloads (reverse-region sort-columns sort-regexp-fields ;;;;;; sort-fields sort-numeric-fields sort-pages sort-paragraphs -;;;;;; sort-lines sort-subr) "sort" "sort.el" (20355 10021)) +;;;;;; sort-lines sort-subr) "sort" "sort.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from sort.el (put 'sort-fold-case 'safe-local-variable 'booleanp) @@ -26344,8 +26444,8 @@ From a program takes two point or marker arguments, BEG and END. ;;;*** -;;;### (autoloads (spam-initialize) "spam" "gnus/spam.el" (20355 -;;;;;; 10021)) +;;;### (autoloads (spam-initialize) "spam" "gnus/spam.el" (20458 +;;;;;; 56750 651721 0)) ;;; Generated autoloads from gnus/spam.el (autoload 'spam-initialize "spam" "\ @@ -26361,7 +26461,7 @@ installed through `spam-necessary-extra-headers'. ;;;### (autoloads (spam-report-deagentize spam-report-agentize spam-report-url-to-file ;;;;;; spam-report-url-ping-mm-url spam-report-process-queue) "spam-report" -;;;;;; "gnus/spam-report.el" (20355 10021)) +;;;;;; "gnus/spam-report.el" (20355 10021 546955 0)) ;;; Generated autoloads from gnus/spam-report.el (autoload 'spam-report-process-queue "spam-report" "\ @@ -26404,7 +26504,7 @@ Spam reports will be queued with the method used when ;;;*** ;;;### (autoloads (speedbar-get-focus speedbar-frame-mode) "speedbar" -;;;;;; "speedbar.el" (20399 35365)) +;;;;;; "speedbar.el" (20434 17809 692608 0)) ;;; Generated autoloads from speedbar.el (defalias 'speedbar 'speedbar-frame-mode) @@ -26429,7 +26529,7 @@ selected. If the speedbar frame is active, then select the attached frame. ;;;*** ;;;### (autoloads (snarf-spooks spook) "spook" "play/spook.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from play/spook.el (autoload 'spook "spook" "\ @@ -26448,7 +26548,7 @@ Return a vector containing the lines from `spook-phrases-file'. ;;;;;; sql-ms sql-ingres sql-solid sql-mysql sql-sqlite sql-informix ;;;;;; sql-sybase sql-oracle sql-product-interactive sql-connect ;;;;;; sql-mode sql-help sql-add-product-keywords) "sql" "progmodes/sql.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from progmodes/sql.el (autoload 'sql-add-product-keywords "sql" "\ @@ -26944,7 +27044,7 @@ buffer. ;;;*** ;;;### (autoloads (srecode-template-mode) "srecode/srt-mode" "cedet/srecode/srt-mode.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from cedet/srecode/srt-mode.el (autoload 'srecode-template-mode "srecode/srt-mode" "\ @@ -26957,7 +27057,7 @@ Major-mode for writing SRecode macros. ;;;*** ;;;### (autoloads (starttls-open-stream) "starttls" "gnus/starttls.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/starttls.el (autoload 'starttls-open-stream "starttls" "\ @@ -26984,8 +27084,8 @@ GnuTLS requires a port number. ;;;;;; strokes-mode strokes-list-strokes strokes-load-user-strokes ;;;;;; strokes-help strokes-describe-stroke strokes-do-complex-stroke ;;;;;; strokes-do-stroke strokes-read-complex-stroke strokes-read-stroke -;;;;;; strokes-global-set-stroke) "strokes" "strokes.el" (20355 -;;;;;; 10021)) +;;;;;; strokes-global-set-stroke) "strokes" "strokes.el" (20427 +;;;;;; 14766 970343 0)) ;;; Generated autoloads from strokes.el (autoload 'strokes-global-set-stroke "strokes" "\ @@ -27099,7 +27199,7 @@ Read a complex stroke and insert its glyph into the current buffer. ;;;*** ;;;### (autoloads (studlify-buffer studlify-word studlify-region) -;;;;;; "studly" "play/studly.el" (20355 10021)) +;;;;;; "studly" "play/studly.el" (20355 10021 546955 0)) ;;; Generated autoloads from play/studly.el (autoload 'studlify-region "studly" "\ @@ -27120,7 +27220,7 @@ Studlify-case the current buffer. ;;;*** ;;;### (autoloads (global-subword-mode subword-mode) "subword" "progmodes/subword.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from progmodes/subword.el (autoload 'subword-mode "subword" "\ @@ -27176,7 +27276,7 @@ See `subword-mode' for more information on Subword mode. ;;;*** ;;;### (autoloads (sc-cite-original) "supercite" "mail/supercite.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from mail/supercite.el (autoload 'sc-cite-original "supercite" "\ @@ -27209,7 +27309,7 @@ and `sc-post-hook' is run after the guts of this function. ;;;*** ;;;### (autoloads (gpm-mouse-mode) "t-mouse" "t-mouse.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from t-mouse.el (define-obsolete-function-alias 't-mouse-mode 'gpm-mouse-mode "23.1") @@ -27237,7 +27337,8 @@ It relies on the `gpm' daemon being activated. ;;;*** -;;;### (autoloads (tabify untabify) "tabify" "tabify.el" (20355 10021)) +;;;### (autoloads (tabify untabify) "tabify" "tabify.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from tabify.el (autoload 'untabify "tabify" "\ @@ -27272,7 +27373,7 @@ The variable `tab-width' controls the spacing of tab stops. ;;;;;; table-recognize table-insert-row-column table-insert-column ;;;;;; table-insert-row table-insert table-point-left-cell-hook ;;;;;; table-point-entered-cell-hook table-load-hook table-cell-map-hook) -;;;;;; "table" "textmodes/table.el" (20355 10021)) +;;;;;; "table" "textmodes/table.el" (20434 17809 692608 0)) ;;; Generated autoloads from textmodes/table.el (defvar table-cell-map-hook nil "\ @@ -27860,7 +27961,8 @@ converts a table into plain text without frames. It is a companion to ;;;*** -;;;### (autoloads (talk talk-connect) "talk" "talk.el" (20355 10021)) +;;;### (autoloads (talk talk-connect) "talk" "talk.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from talk.el (autoload 'talk-connect "talk" "\ @@ -27875,7 +27977,8 @@ Connect to the Emacs talk group from the current X display or tty frame. ;;;*** -;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (20387 44199)) +;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (20387 44199 +;;;;;; 24128 0)) ;;; Generated autoloads from tar-mode.el (autoload 'tar-mode "tar-mode" "\ @@ -27899,7 +28002,7 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. ;;;*** ;;;### (autoloads (tcl-help-on-word inferior-tcl tcl-mode) "tcl" -;;;;;; "progmodes/tcl.el" (20355 10021)) +;;;;;; "progmodes/tcl.el" (20355 10021 546955 0)) ;;; Generated autoloads from progmodes/tcl.el (autoload 'tcl-mode "tcl" "\ @@ -27947,7 +28050,8 @@ Prefix argument means invert sense of `tcl-use-smart-word-finder'. ;;;*** -;;;### (autoloads (rsh telnet) "telnet" "net/telnet.el" (20355 10021)) +;;;### (autoloads (rsh telnet) "telnet" "net/telnet.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from net/telnet.el (autoload 'telnet "telnet" "\ @@ -27973,7 +28077,7 @@ Normally input is edited in Emacs and sent a line at a time. ;;;*** ;;;### (autoloads (serial-term ansi-term term make-term) "term" "term.el" -;;;;;; (20397 18394)) +;;;;;; (20461 32935 300400 0)) ;;; Generated autoloads from term.el (autoload 'make-term "term" "\ @@ -28016,7 +28120,7 @@ use in that buffer. ;;;*** ;;;### (autoloads (terminal-emulator) "terminal" "terminal.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from terminal.el (autoload 'terminal-emulator "terminal" "\ @@ -28053,7 +28157,7 @@ subprocess started. ;;;*** ;;;### (autoloads (testcover-this-defun) "testcover" "emacs-lisp/testcover.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from emacs-lisp/testcover.el (autoload 'testcover-this-defun "testcover" "\ @@ -28063,7 +28167,8 @@ Start coverage on function under point. ;;;*** -;;;### (autoloads (tetris) "tetris" "play/tetris.el" (20355 10021)) +;;;### (autoloads (tetris) "tetris" "play/tetris.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from play/tetris.el (autoload 'tetris "tetris" "\ @@ -28094,7 +28199,7 @@ tetris-mode keybindings: ;;;;;; tex-start-commands tex-start-options slitex-run-command latex-run-command ;;;;;; tex-run-command tex-offer-save tex-main-file tex-first-line-header-regexp ;;;;;; tex-directory tex-shell-file-name) "tex-mode" "textmodes/tex-mode.el" -;;;;;; (20364 45187)) +;;;;;; (20458 56750 651721 0)) ;;; Generated autoloads from textmodes/tex-mode.el (defvar tex-shell-file-name nil "\ @@ -28396,7 +28501,7 @@ Major mode to edit DocTeX files. ;;;*** ;;;### (autoloads (texi2info texinfo-format-region texinfo-format-buffer) -;;;;;; "texinfmt" "textmodes/texinfmt.el" (20355 10021)) +;;;;;; "texinfmt" "textmodes/texinfmt.el" (20434 17809 692608 0)) ;;; Generated autoloads from textmodes/texinfmt.el (autoload 'texinfo-format-buffer "texinfmt" "\ @@ -28436,7 +28541,7 @@ if large. You can use `Info-split' to do this manually. ;;;*** ;;;### (autoloads (texinfo-mode texinfo-close-quote texinfo-open-quote) -;;;;;; "texinfo" "textmodes/texinfo.el" (20355 10021)) +;;;;;; "texinfo" "textmodes/texinfo.el" (20355 10021 546955 0)) ;;; Generated autoloads from textmodes/texinfo.el (defvar texinfo-open-quote (purecopy "``") "\ @@ -28522,7 +28627,7 @@ value of `texinfo-mode-hook'. ;;;### (autoloads (thai-composition-function thai-compose-buffer ;;;;;; thai-compose-string thai-compose-region) "thai-util" "language/thai-util.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from language/thai-util.el (autoload 'thai-compose-region "thai-util" "\ @@ -28551,7 +28656,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" (20416 44451)) +;;;;;; "thingatpt" "thingatpt.el" (20416 44451 205563 0)) ;;; Generated autoloads from thingatpt.el (autoload 'forward-thing "thingatpt" "\ @@ -28614,7 +28719,7 @@ Return the Lisp list at point, or nil if none is found. ;;;### (autoloads (thumbs-dired-setroot thumbs-dired-show thumbs-dired-show-marked ;;;;;; thumbs-show-from-dir thumbs-find-thumb) "thumbs" "thumbs.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from thumbs.el (autoload 'thumbs-find-thumb "thumbs" "\ @@ -28653,7 +28758,7 @@ In dired, call the setroot program on the image at point. ;;;;;; tibetan-decompose-string tibetan-decompose-region tibetan-compose-region ;;;;;; tibetan-compose-string tibetan-transcription-to-tibetan tibetan-tibetan-to-transcription ;;;;;; tibetan-char-p) "tibet-util" "language/tibet-util.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from language/tibet-util.el (autoload 'tibetan-char-p "tibet-util" "\ @@ -28727,7 +28832,7 @@ See also docstring of the function tibetan-compose-region. ;;;*** ;;;### (autoloads (tildify-buffer tildify-region) "tildify" "textmodes/tildify.el" -;;;;;; (20373 11301)) +;;;;;; (20373 11301 906925 0)) ;;; Generated autoloads from textmodes/tildify.el (autoload 'tildify-region "tildify" "\ @@ -28752,7 +28857,7 @@ This function performs no refilling of the changed text. ;;;### (autoloads (emacs-init-time emacs-uptime display-time-world ;;;;;; display-time-mode display-time display-time-day-and-date) -;;;;;; "time" "time.el" (20387 44199)) +;;;;;; "time" "time.el" (20387 44199 24128 0)) ;;; Generated autoloads from time.el (defvar display-time-day-and-date nil "\ @@ -28818,7 +28923,7 @@ Return a string giving the duration of the Emacs initialization. ;;;;;; time-to-day-in-year date-leap-year-p days-between date-to-day ;;;;;; time-add time-subtract time-since days-to-time time-less-p ;;;;;; seconds-to-time date-to-time) "time-date" "calendar/time-date.el" -;;;;;; (20355 10021)) +;;;;;; (20453 5437 764254 0)) ;;; Generated autoloads from calendar/time-date.el (autoload 'date-to-time "time-date" "\ @@ -28932,7 +29037,7 @@ This function does not work for SECONDS greater than `most-positive-fixnum'. ;;;*** ;;;### (autoloads (time-stamp-toggle-active time-stamp) "time-stamp" -;;;;;; "time-stamp.el" (20355 10021)) +;;;;;; "time-stamp.el" (20355 10021 546955 0)) ;;; Generated autoloads from time-stamp.el (put 'time-stamp-format 'safe-local-variable 'stringp) (put 'time-stamp-time-zone 'safe-local-variable 'string-or-null-p) @@ -28975,18 +29080,18 @@ With ARG, turn time stamping on if and only if arg is positive. ;;;### (autoloads (timeclock-when-to-leave-string timeclock-workday-elapsed-string ;;;;;; 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" -;;;;;; (20355 10021)) +;;;;;; timeclock-mode-line-display) "timeclock" "calendar/timeclock.el" +;;;;;; (20427 14766 970343 0)) ;;; Generated autoloads from calendar/timeclock.el -(autoload 'timeclock-modeline-display "timeclock" "\ -Toggle display of the amount of time left today in the modeline. +(autoload 'timeclock-mode-line-display "timeclock" "\ +Toggle display of the amount of time left today in the mode line. If `timeclock-use-display-time' is non-nil (the default), then -the function `display-time-mode' must be active, and the modeline +the function `display-time-mode' must be active, and the mode line will be updated whenever the time display is updated. Otherwise, the timeclock will use its own sixty second timer to do its -updating. With prefix ARG, turn modeline display on if and only -if ARG is positive. Returns the new status of timeclock modeline +updating. With prefix ARG, turn mode line display on if and only +if ARG is positive. Returns the new status of timeclock mode line display (non-nil means on). \(fn &optional ARG)" t nil) @@ -29076,7 +29181,7 @@ relative only to the time worked today, and not to past time. ;;;*** ;;;### (autoloads (batch-titdic-convert titdic-convert) "titdic-cnv" -;;;;;; "international/titdic-cnv.el" (20355 10021)) +;;;;;; "international/titdic-cnv.el" (20355 10021 546955 0)) ;;; Generated autoloads from international/titdic-cnv.el (autoload 'titdic-convert "titdic-cnv" "\ @@ -29099,7 +29204,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\". ;;;*** ;;;### (autoloads (tmm-prompt tmm-menubar-mouse tmm-menubar) "tmm" -;;;;;; "tmm.el" (20356 55829)) +;;;;;; "tmm.el" (20433 53542 563193 0)) ;;; Generated autoloads from tmm.el (define-key global-map "\M-`" 'tmm-menubar) (define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse) @@ -29139,7 +29244,7 @@ Its value should be an event that has a binding in MENU. ;;;### (autoloads (todo-show todo-cp todo-mode todo-print todo-top-priorities ;;;;;; todo-insert-item todo-add-item-non-interactively todo-add-category) -;;;;;; "todo-mode" "calendar/todo-mode.el" (20355 10021)) +;;;;;; "todo-mode" "calendar/todo-mode.el" (20355 10021 546955 0)) ;;; Generated autoloads from calendar/todo-mode.el (autoload 'todo-add-category "todo-mode" "\ @@ -29199,7 +29304,7 @@ Show TODO list. ;;;### (autoloads (tool-bar-local-item-from-menu tool-bar-add-item-from-menu ;;;;;; tool-bar-local-item tool-bar-add-item toggle-tool-bar-mode-from-frame) -;;;;;; "tool-bar" "tool-bar.el" (20355 10021)) +;;;;;; "tool-bar" "tool-bar.el" (20355 10021 546955 0)) ;;; Generated autoloads from tool-bar.el (autoload 'toggle-tool-bar-mode-from-frame "tool-bar" "\ @@ -29270,7 +29375,7 @@ holds a keymap. ;;;*** ;;;### (autoloads (tpu-edt-on tpu-edt-mode) "tpu-edt" "emulation/tpu-edt.el" -;;;;;; (20399 35365)) +;;;;;; (20399 35365 4050 0)) ;;; Generated autoloads from emulation/tpu-edt.el (defvar tpu-edt-mode nil "\ @@ -29300,7 +29405,7 @@ Turn on TPU/edt emulation. ;;;*** ;;;### (autoloads (tpu-mapper) "tpu-mapper" "emulation/tpu-mapper.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from emulation/tpu-mapper.el (autoload 'tpu-mapper "tpu-mapper" "\ @@ -29334,7 +29439,8 @@ your local X guru can try to figure out why the key is being ignored. ;;;*** -;;;### (autoloads (tq-create) "tq" "emacs-lisp/tq.el" (20355 10021)) +;;;### (autoloads (tq-create) "tq" "emacs-lisp/tq.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from emacs-lisp/tq.el (autoload 'tq-create "tq" "\ @@ -29348,7 +29454,7 @@ to a tcp server on another machine. ;;;*** ;;;### (autoloads (trace-function-background trace-function trace-buffer) -;;;;;; "trace" "emacs-lisp/trace.el" (20355 10021)) +;;;;;; "trace" "emacs-lisp/trace.el" (20355 10021 546955 0)) ;;; Generated autoloads from emacs-lisp/trace.el (defvar trace-buffer (purecopy "*trace-output*") "\ @@ -29385,7 +29491,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" (20373 11301)) +;;;;;; "net/tramp.el" (20447 37 83194 0)) ;;; Generated autoloads from net/tramp.el (defvar tramp-mode t "\ @@ -29405,7 +29511,7 @@ It can have the following values: (custom-autoload 'tramp-syntax "tramp" t) -(defconst tramp-file-name-regexp-unified (if (memq system-type '(cygwin windows-nt)) "\\`/\\([^[/:]\\{2,\\}\\|[^/]\\{2,\\}]\\):" "\\`/\\([^[/:]+\\|[^/]+]\\):") "\ +(defconst tramp-file-name-regexp-unified (if (memq system-type '(cygwin windows-nt)) "\\`/\\([^[/|:]\\{2,\\}\\|[^/|]\\{2,\\}]\\):" "\\`/\\([^[/|:]+\\|[^/|]+]\\):") "\ Value for `tramp-file-name-regexp' for unified remoting. Emacs (not XEmacs) uses a unified filename syntax for Ange-FTP and Tramp. See `tramp-file-name-structure' for more explanations. @@ -29417,7 +29523,7 @@ Value for `tramp-file-name-regexp' for separate remoting. XEmacs uses a separate filename syntax for Tramp and EFS. See `tramp-file-name-structure' for more explanations.") -(defconst tramp-file-name-regexp-url "\\`/[^/:]+://" "\ +(defconst tramp-file-name-regexp-url "\\`/[^/|:]+://" "\ Value for `tramp-file-name-regexp' for URL-like remoting. See `tramp-file-name-structure' for more explanations.") @@ -29518,7 +29624,7 @@ Discard Tramp from loading remote files. ;;;*** ;;;### (autoloads (tramp-ftp-enable-ange-ftp) "tramp-ftp" "net/tramp-ftp.el" -;;;;;; (20355 10021)) +;;;;;; (20438 24016 194668 0)) ;;; Generated autoloads from net/tramp-ftp.el (autoload 'tramp-ftp-enable-ange-ftp "tramp-ftp" "\ @@ -29529,7 +29635,7 @@ Discard Tramp from loading remote files. ;;;*** ;;;### (autoloads (help-with-tutorial) "tutorial" "tutorial.el" (20369 -;;;;;; 14251)) +;;;;;; 14251 85829 0)) ;;; Generated autoloads from tutorial.el (autoload 'help-with-tutorial "tutorial" "\ @@ -29554,7 +29660,7 @@ resumed later. ;;;*** ;;;### (autoloads (tai-viet-composition-function) "tv-util" "language/tv-util.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from language/tv-util.el (autoload 'tai-viet-composition-function "tv-util" "\ @@ -29565,7 +29671,7 @@ resumed later. ;;;*** ;;;### (autoloads (2C-split 2C-associate-buffer 2C-two-columns) "two-column" -;;;;;; "textmodes/two-column.el" (20364 31990)) +;;;;;; "textmodes/two-column.el" (20364 31990 752722 691000)) ;;; Generated autoloads from textmodes/two-column.el (autoload '2C-command "two-column" () t 'keymap) (global-set-key "\C-x6" '2C-command) @@ -29616,7 +29722,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" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from type-break.el (defvar type-break-mode nil "\ @@ -29798,7 +29904,8 @@ FRAC should be the inverse of the fractional value; for example, a value of ;;;*** -;;;### (autoloads (uce-reply-to-uce) "uce" "mail/uce.el" (20355 10021)) +;;;### (autoloads (uce-reply-to-uce) "uce" "mail/uce.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from mail/uce.el (autoload 'uce-reply-to-uce "uce" "\ @@ -29816,7 +29923,7 @@ You might need to set `uce-mail-reader' before using this. ;;;;;; ucs-normalize-NFKC-string ucs-normalize-NFKC-region ucs-normalize-NFKD-string ;;;;;; ucs-normalize-NFKD-region ucs-normalize-NFC-string ucs-normalize-NFC-region ;;;;;; ucs-normalize-NFD-string ucs-normalize-NFD-region) "ucs-normalize" -;;;;;; "international/ucs-normalize.el" (20355 10021)) +;;;;;; "international/ucs-normalize.el" (20355 10021 546955 0)) ;;; Generated autoloads from international/ucs-normalize.el (autoload 'ucs-normalize-NFD-region "ucs-normalize" "\ @@ -29882,7 +29989,7 @@ Normalize the string STR by the Unicode NFC and Mac OS's HFS Plus. ;;;*** ;;;### (autoloads (ununderline-region underline-region) "underline" -;;;;;; "textmodes/underline.el" (20355 10021)) +;;;;;; "textmodes/underline.el" (20355 10021 546955 0)) ;;; Generated autoloads from textmodes/underline.el (autoload 'underline-region "underline" "\ @@ -29903,7 +30010,7 @@ which specify the range to operate on. ;;;*** ;;;### (autoloads (unrmail batch-unrmail) "unrmail" "mail/unrmail.el" -;;;;;; (20369 14251)) +;;;;;; (20369 14251 85829 0)) ;;; Generated autoloads from mail/unrmail.el (autoload 'batch-unrmail "unrmail" "\ @@ -29923,7 +30030,7 @@ Convert old-style Rmail Babyl file FILE to system inbox format file TO-FILE. ;;;*** ;;;### (autoloads (unsafep) "unsafep" "emacs-lisp/unsafep.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from emacs-lisp/unsafep.el (autoload 'unsafep "unsafep" "\ @@ -29936,7 +30043,7 @@ UNSAFEP-VARS is a list of symbols with local bindings. ;;;*** ;;;### (autoloads (url-retrieve-synchronously url-retrieve) "url" -;;;;;; "url/url.el" (20394 17446)) +;;;;;; "url/url.el" (20450 62630 628906 0)) ;;; Generated autoloads from url/url.el (autoload 'url-retrieve "url" "\ @@ -29984,7 +30091,7 @@ no further processing). URL is either a string or a parsed URL. ;;;*** ;;;### (autoloads (url-register-auth-scheme url-get-authentication) -;;;;;; "url-auth" "url/url-auth.el" (20355 10021)) +;;;;;; "url-auth" "url/url-auth.el" (20355 10021 546955 0)) ;;; Generated autoloads from url/url-auth.el (autoload 'url-get-authentication "url-auth" "\ @@ -30026,7 +30133,7 @@ RATING a rating between 1 and 10 of the strength of the authentication. ;;;*** ;;;### (autoloads (url-cache-extract url-is-cached url-store-in-cache) -;;;;;; "url-cache" "url/url-cache.el" (20355 10021)) +;;;;;; "url-cache" "url/url-cache.el" (20355 10021 546955 0)) ;;; Generated autoloads from url/url-cache.el (autoload 'url-store-in-cache "url-cache" "\ @@ -30047,7 +30154,8 @@ Extract FNAM from the local disk cache. ;;;*** -;;;### (autoloads (url-cid) "url-cid" "url/url-cid.el" (20355 10021)) +;;;### (autoloads (url-cid) "url-cid" "url/url-cid.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from url/url-cid.el (autoload 'url-cid "url-cid" "\ @@ -30058,7 +30166,7 @@ Extract FNAM from the local disk cache. ;;;*** ;;;### (autoloads (url-dav-vc-registered url-dav-supported-p) "url-dav" -;;;;;; "url/url-dav.el" (20355 10021)) +;;;;;; "url/url-dav.el" (20355 10021 546955 0)) ;;; Generated autoloads from url/url-dav.el (autoload 'url-dav-supported-p "url-dav" "\ @@ -30074,7 +30182,7 @@ Extract FNAM from the local disk cache. ;;;*** ;;;### (autoloads (url-file) "url-file" "url/url-file.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from url/url-file.el (autoload 'url-file "url-file" "\ @@ -30085,7 +30193,7 @@ Handle file: and ftp: URLs. ;;;*** ;;;### (autoloads (url-open-stream url-gateway-nslookup-host) "url-gw" -;;;;;; "url/url-gw.el" (20355 10021)) +;;;;;; "url/url-gw.el" (20355 10021 546955 0)) ;;; Generated autoloads from url/url-gw.el (autoload 'url-gateway-nslookup-host "url-gw" "\ @@ -30105,7 +30213,7 @@ Might do a non-blocking connection; use `process-status' to check. ;;;### (autoloads (url-insert-file-contents url-file-local-copy url-copy-file ;;;;;; url-file-handler url-handler-mode) "url-handlers" "url/url-handlers.el" -;;;;;; (20355 10021)) +;;;;;; (20440 54677 388705 0)) ;;; Generated autoloads from url/url-handlers.el (defvar url-handler-mode nil "\ @@ -30160,7 +30268,8 @@ accessible. ;;;*** ;;;### (autoloads (url-http-options url-http-file-attributes url-http-file-exists-p -;;;;;; url-http) "url-http" "url/url-http.el" (20415 53309)) +;;;;;; url-http) "url-http" "url/url-http.el" (20415 53309 822770 +;;;;;; 0)) ;;; Generated autoloads from url/url-http.el (autoload 'url-http "url-http" "\ @@ -30229,7 +30338,8 @@ HTTPS retrievals are asynchronous.") ;;;*** -;;;### (autoloads (url-irc) "url-irc" "url/url-irc.el" (20355 10021)) +;;;### (autoloads (url-irc) "url-irc" "url/url-irc.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from url/url-irc.el (autoload 'url-irc "url-irc" "\ @@ -30240,7 +30350,7 @@ HTTPS retrievals are asynchronous.") ;;;*** ;;;### (autoloads (url-ldap) "url-ldap" "url/url-ldap.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from url/url-ldap.el (autoload 'url-ldap "url-ldap" "\ @@ -30254,7 +30364,7 @@ URL can be a URL string, or a URL vector of the type returned by ;;;*** ;;;### (autoloads (url-mailto url-mail) "url-mailto" "url/url-mailto.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from url/url-mailto.el (autoload 'url-mail "url-mailto" "\ @@ -30270,7 +30380,8 @@ Handle the mailto: URL syntax. ;;;*** ;;;### (autoloads (url-data url-generic-emulator-loader url-info -;;;;;; url-man) "url-misc" "url/url-misc.el" (20355 10021)) +;;;;;; url-man) "url-misc" "url/url-misc.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from url/url-misc.el (autoload 'url-man "url-misc" "\ @@ -30302,7 +30413,7 @@ Fetch a data URL (RFC 2397). ;;;*** ;;;### (autoloads (url-snews url-news) "url-news" "url/url-news.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from url/url-news.el (autoload 'url-news "url-news" "\ @@ -30319,7 +30430,7 @@ Fetch a data URL (RFC 2397). ;;;### (autoloads (url-ns-user-pref url-ns-prefs isInNet isResolvable ;;;;;; dnsResolve dnsDomainIs isPlainHostName) "url-ns" "url/url-ns.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from url/url-ns.el (autoload 'isPlainHostName "url-ns" "\ @@ -30360,7 +30471,7 @@ Fetch a data URL (RFC 2397). ;;;*** ;;;### (autoloads (url-generic-parse-url url-recreate-url) "url-parse" -;;;;;; "url/url-parse.el" (20395 38306)) +;;;;;; "url/url-parse.el" (20395 38306 463596 0)) ;;; Generated autoloads from url/url-parse.el (autoload 'url-recreate-url "url-parse" "\ @@ -30412,7 +30523,7 @@ parses to ;;;*** ;;;### (autoloads (url-setup-privacy-info) "url-privacy" "url/url-privacy.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from url/url-privacy.el (autoload 'url-setup-privacy-info "url-privacy" "\ @@ -30423,7 +30534,7 @@ Setup variables that expose info about you and your system. ;;;*** ;;;### (autoloads (url-queue-retrieve) "url-queue" "url/url-queue.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from url/url-queue.el (autoload 'url-queue-retrieve "url-queue" "\ @@ -30444,7 +30555,7 @@ The variable `url-queue-timeout' sets a timeout. ;;;;;; url-eat-trailing-space url-get-normalized-date url-lazy-message ;;;;;; url-normalize-url url-insert-entities-in-string url-parse-args ;;;;;; url-debug url-debug) "url-util" "url/url-util.el" (20402 -;;;;;; 11562)) +;;;;;; 11562 85788 0)) ;;; Generated autoloads from url/url-util.el (defvar url-debug nil "\ @@ -30606,7 +30717,7 @@ This uses `url-current-object', set locally to the buffer. ;;;*** ;;;### (autoloads (ask-user-about-supersession-threat ask-user-about-lock) -;;;;;; "userlock" "userlock.el" (20355 10021)) +;;;;;; "userlock" "userlock.el" (20355 10021 546955 0)) ;;; Generated autoloads from userlock.el (autoload 'ask-user-about-lock "userlock" "\ @@ -30636,7 +30747,7 @@ The buffer in question is current when this function is called. ;;;### (autoloads (utf-7-imap-pre-write-conversion utf-7-pre-write-conversion ;;;;;; utf-7-imap-post-read-conversion utf-7-post-read-conversion) -;;;;;; "utf-7" "international/utf-7.el" (20355 10021)) +;;;;;; "utf-7" "international/utf-7.el" (20355 10021 546955 0)) ;;; Generated autoloads from international/utf-7.el (autoload 'utf-7-post-read-conversion "utf-7" "\ @@ -30661,7 +30772,8 @@ The buffer in question is current when this function is called. ;;;*** -;;;### (autoloads (utf7-encode) "utf7" "gnus/utf7.el" (20355 10021)) +;;;### (autoloads (utf7-encode) "utf7" "gnus/utf7.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from gnus/utf7.el (autoload 'utf7-encode "utf7" "\ @@ -30673,7 +30785,7 @@ Encode UTF-7 STRING. Use IMAP modification if FOR-IMAP is non-nil. ;;;### (autoloads (uudecode-decode-region uudecode-decode-region-internal ;;;;;; uudecode-decode-region-external) "uudecode" "mail/uudecode.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from mail/uudecode.el (autoload 'uudecode-decode-region-external "uudecode" "\ @@ -30704,7 +30816,7 @@ If FILE-NAME is non-nil, save the result to FILE-NAME. ;;;;;; 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" (20421 -;;;;;; 62373)) +;;;;;; 62373 255269 0)) ;;; Generated autoloads from vc/vc.el (defvar vc-checkout-hook nil "\ @@ -30982,7 +31094,7 @@ Return the branch part of a revision number REV. ;;;*** ;;;### (autoloads (vc-annotate) "vc-annotate" "vc/vc-annotate.el" -;;;;;; (20356 55829)) +;;;;;; (20356 55829 180242 0)) ;;; Generated autoloads from vc/vc-annotate.el (autoload 'vc-annotate "vc-annotate" "\ @@ -31019,7 +31131,8 @@ mode-specific menu. `vc-annotate-color-map' and ;;;*** -;;;### (autoloads nil "vc-arch" "vc/vc-arch.el" (20377 8374)) +;;;### (autoloads nil "vc-arch" "vc/vc-arch.el" (20427 14766 970343 +;;;;;; 0)) ;;; Generated autoloads from vc/vc-arch.el (defun vc-arch-registered (file) (if (vc-find-root file "{arch}/=tagging-method") @@ -31029,7 +31142,8 @@ mode-specific menu. `vc-annotate-color-map' and ;;;*** -;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (20406 55122)) +;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (20406 55122 186927 +;;;;;; 0)) ;;; Generated autoloads from vc/vc-bzr.el (defconst vc-bzr-admin-dirname ".bzr" "\ @@ -31045,7 +31159,8 @@ Name of the format file in a .bzr directory.") ;;;*** -;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (20377 8374)) +;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (20427 14766 970343 +;;;;;; 0)) ;;; Generated autoloads from vc/vc-cvs.el (defun vc-cvs-registered (f) "Return non-nil if file F is registered with CVS." @@ -31056,7 +31171,8 @@ Name of the format file in a .bzr directory.") ;;;*** -;;;### (autoloads (vc-dir) "vc-dir" "vc/vc-dir.el" (20377 8374)) +;;;### (autoloads (vc-dir) "vc-dir" "vc/vc-dir.el" (20377 8374 887348 +;;;;;; 0)) ;;; Generated autoloads from vc/vc-dir.el (autoload 'vc-dir "vc-dir" "\ @@ -31081,7 +31197,7 @@ These are the commands available for use in the file status buffer: ;;;*** ;;;### (autoloads (vc-do-command) "vc-dispatcher" "vc/vc-dispatcher.el" -;;;;;; (20364 45187)) +;;;;;; (20364 45187 886974 270000)) ;;; Generated autoloads from vc/vc-dispatcher.el (autoload 'vc-do-command "vc-dispatcher" "\ @@ -31104,7 +31220,8 @@ case, and the process object in the asynchronous case. ;;;*** -;;;### (autoloads nil "vc-git" "vc/vc-git.el" (20378 29222)) +;;;### (autoloads nil "vc-git" "vc/vc-git.el" (20464 9124 585807 +;;;;;; 0)) ;;; Generated autoloads from vc/vc-git.el (defun vc-git-registered (file) "Return non-nil if FILE is registered with git." @@ -31115,7 +31232,7 @@ case, and the process object in the asynchronous case. ;;;*** -;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (20377 8374)) +;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (20377 8374 887348 0)) ;;; Generated autoloads from vc/vc-hg.el (defun vc-hg-registered (file) "Return non-nil if FILE is registered with hg." @@ -31126,7 +31243,8 @@ case, and the process object in the asynchronous case. ;;;*** -;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (20377 8374)) +;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (20427 14766 970343 +;;;;;; 0)) ;;; Generated autoloads from vc/vc-mtn.el (defconst vc-mtn-admin-dir "_MTN" "\ @@ -31143,7 +31261,7 @@ Name of the monotone directory's format file.") ;;;*** ;;;### (autoloads (vc-rcs-master-templates) "vc-rcs" "vc/vc-rcs.el" -;;;;;; (20355 10021)) +;;;;;; (20459 40320 865360 0)) ;;; Generated autoloads from vc/vc-rcs.el (defvar vc-rcs-master-templates (purecopy '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")) "\ @@ -31157,7 +31275,7 @@ For a description of possible values, see `vc-check-master-templates'.") ;;;*** ;;;### (autoloads (vc-sccs-master-templates) "vc-sccs" "vc/vc-sccs.el" -;;;;;; (20355 10021)) +;;;;;; (20430 41939 815258 390000)) ;;; Generated autoloads from vc/vc-sccs.el (defvar vc-sccs-master-templates (purecopy '("%sSCCS/s.%s" "%ss.%s" vc-sccs-search-project-dir)) "\ @@ -31174,7 +31292,8 @@ find any project directory." (let ((project-dir (getenv "PROJECTDIR")) dirs dir) ;;;*** -;;;### (autoloads nil "vc-svn" "vc/vc-svn.el" (20355 10021)) +;;;### (autoloads nil "vc-svn" "vc/vc-svn.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from vc/vc-svn.el (defun vc-svn-registered (f) (let ((admin-dir (cond ((and (eq system-type 'windows-nt) @@ -31188,7 +31307,7 @@ find any project directory." (let ((project-dir (getenv "PROJECTDIR")) dirs dir) ;;;*** ;;;### (autoloads (vera-mode) "vera-mode" "progmodes/vera-mode.el" -;;;;;; (20355 10021)) +;;;;;; (20434 17809 692608 0)) ;;; Generated autoloads from progmodes/vera-mode.el (add-to-list 'auto-mode-alist (cons (purecopy "\\.vr[hi]?\\'") 'vera-mode)) @@ -31246,7 +31365,7 @@ Key bindings: ;;;*** ;;;### (autoloads (verilog-mode) "verilog-mode" "progmodes/verilog-mode.el" -;;;;;; (20420 41510)) +;;;;;; (20420 41510 996439 0)) ;;; Generated autoloads from progmodes/verilog-mode.el (autoload 'verilog-mode "verilog-mode" "\ @@ -31385,7 +31504,7 @@ Key bindings specific to `verilog-mode-map' are: ;;;*** ;;;### (autoloads (vhdl-mode) "vhdl-mode" "progmodes/vhdl-mode.el" -;;;;;; (20419 20644)) +;;;;;; (20427 14766 970343 0)) ;;; Generated autoloads from progmodes/vhdl-mode.el (autoload 'vhdl-mode "vhdl-mode" "\ @@ -31402,7 +31521,7 @@ Usage: brackets and removed if the queried string is left empty. Prompts for mandatory arguments remain in the code if the queried string is left empty. They can be queried again by `C-c C-t C-q'. Enabled - electrification is indicated by `/e' in the modeline. + electrification is indicated by `/e' in the mode line. Typing `M-SPC' after a keyword inserts a space without calling the template generator. Automatic template generation (i.e. @@ -31429,7 +31548,7 @@ Usage: Double striking of some keys inserts cumbersome VHDL syntax elements. Stuttering can be disabled (enabled) by typing `C-c C-m C-s' or by option `vhdl-stutter-mode'. Enabled stuttering is indicated by `/s' in - the modeline. The stuttering keys and their effects are: + the mode line. The stuttering keys and their effects are: ;; --> \" : \" [ --> ( -- --> comment ;;; --> \" := \" [[ --> [ --CR --> comment-out code @@ -31939,7 +32058,8 @@ Key bindings: ;;;*** -;;;### (autoloads (vi-mode) "vi" "emulation/vi.el" (20355 10021)) +;;;### (autoloads (vi-mode) "vi" "emulation/vi.el" (20355 10021 546955 +;;;;;; 0)) ;;; Generated autoloads from emulation/vi.el (autoload 'vi-mode "vi" "\ @@ -31994,7 +32114,7 @@ Syntax table and abbrevs while in vi mode remain as they were in Emacs. ;;;### (autoloads (viqr-pre-write-conversion viqr-post-read-conversion ;;;;;; viet-encode-viqr-buffer viet-encode-viqr-region viet-decode-viqr-buffer ;;;;;; viet-decode-viqr-region viet-encode-viscii-char) "viet-util" -;;;;;; "language/viet-util.el" (20355 10021)) +;;;;;; "language/viet-util.el" (20355 10021 546955 0)) ;;; Generated autoloads from language/viet-util.el (autoload 'viet-encode-viscii-char "viet-util" "\ @@ -32042,7 +32162,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" (20355 10021)) +;;;;;; "view" "view.el" (20355 10021 546955 0)) ;;; Generated autoloads from view.el (defvar view-remove-frame-by-deleting t "\ @@ -32297,7 +32417,7 @@ Exit View mode and make the current buffer editable. ;;;*** ;;;### (autoloads (vip-mode vip-setup) "vip" "emulation/vip.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from emulation/vip.el (autoload 'vip-setup "vip" "\ @@ -32313,7 +32433,7 @@ Turn on VIP emulation of VI. ;;;*** ;;;### (autoloads (viper-mode toggle-viper-mode) "viper" "emulation/viper.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from emulation/viper.el (autoload 'toggle-viper-mode "viper" "\ @@ -32330,7 +32450,7 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'. ;;;*** ;;;### (autoloads (warn lwarn display-warning) "warnings" "emacs-lisp/warnings.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from emacs-lisp/warnings.el (defvar warning-prefix-function nil "\ @@ -32420,7 +32540,7 @@ this is equivalent to `display-warning', using ;;;*** ;;;### (autoloads (wdired-change-to-wdired-mode) "wdired" "wdired.el" -;;;;;; (20355 10021)) +;;;;;; (20452 17962 966427 0)) ;;; Generated autoloads from wdired.el (autoload 'wdired-change-to-wdired-mode "wdired" "\ @@ -32436,7 +32556,8 @@ See `wdired-mode'. ;;;*** -;;;### (autoloads (webjump) "webjump" "net/webjump.el" (20355 10021)) +;;;### (autoloads (webjump) "webjump" "net/webjump.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from net/webjump.el (autoload 'webjump "webjump" "\ @@ -32453,7 +32574,7 @@ Please submit bug reports and other feedback to the author, Neil W. Van Dyke ;;;*** ;;;### (autoloads (which-function-mode which-func-mode) "which-func" -;;;;;; "progmodes/which-func.el" (20412 47398)) +;;;;;; "progmodes/which-func.el" (20461 32935 300400 0)) ;;; Generated autoloads from progmodes/which-func.el (put 'which-func-format 'risky-local-variable t) (put 'which-func-current 'risky-local-variable t) @@ -32489,7 +32610,8 @@ in certain major modes. ;;;### (autoloads (whitespace-report-region whitespace-report whitespace-cleanup-region ;;;;;; whitespace-cleanup global-whitespace-toggle-options whitespace-toggle-options ;;;;;; global-whitespace-newline-mode global-whitespace-mode whitespace-newline-mode -;;;;;; whitespace-mode) "whitespace" "whitespace.el" (20421 62373)) +;;;;;; whitespace-mode) "whitespace" "whitespace.el" (20434 17809 +;;;;;; 692608 0)) ;;; Generated autoloads from whitespace.el (autoload 'whitespace-mode "whitespace" "\ @@ -32888,7 +33010,8 @@ cleaning up these problems. ;;;*** ;;;### (autoloads (widget-minor-mode widget-browse-other-window widget-browse -;;;;;; widget-browse-at) "wid-browse" "wid-browse.el" (20355 10021)) +;;;;;; widget-browse-at) "wid-browse" "wid-browse.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from wid-browse.el (autoload 'widget-browse-at "wid-browse" "\ @@ -32918,7 +33041,7 @@ if ARG is omitted or nil. ;;;### (autoloads (widget-setup widget-insert widget-delete widget-create ;;;;;; widget-prompt-value widgetp) "wid-edit" "wid-edit.el" (20373 -;;;;;; 11301)) +;;;;;; 11301 906925 0)) ;;; Generated autoloads from wid-edit.el (autoload 'widgetp "wid-edit" "\ @@ -32962,7 +33085,7 @@ Setup current buffer so editing string widgets works. ;;;### (autoloads (windmove-default-keybindings windmove-down windmove-right ;;;;;; windmove-up windmove-left) "windmove" "windmove.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from windmove.el (autoload 'windmove-left "windmove" "\ @@ -33015,7 +33138,7 @@ Default MODIFIER is 'shift. ;;;*** ;;;### (autoloads (winner-mode winner-mode) "winner" "winner.el" -;;;;;; (20355 10021)) +;;;;;; (20453 5437 764254 0)) ;;; Generated autoloads from winner.el (defvar winner-mode nil "\ @@ -33034,7 +33157,8 @@ 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" (20370 35109)) +;;;;;; woman woman-locale) "woman" "woman.el" (20458 56750 651721 +;;;;;; 0)) ;;; Generated autoloads from woman.el (defvar woman-locale nil "\ @@ -33083,7 +33207,7 @@ Default bookmark handler for Woman buffers. ;;;*** ;;;### (autoloads (wordstar-mode) "ws-mode" "emulation/ws-mode.el" -;;;;;; (20355 10021)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from emulation/ws-mode.el (autoload 'wordstar-mode "ws-mode" "\ @@ -33195,7 +33319,8 @@ The key bindings are: ;;;*** -;;;### (autoloads (xesam-search) "xesam" "net/xesam.el" (20374 32165)) +;;;### (autoloads (xesam-search) "xesam" "net/xesam.el" (20464 9124 +;;;;;; 585807 0)) ;;; Generated autoloads from net/xesam.el (autoload 'xesam-search "xesam" "\ @@ -33215,13 +33340,12 @@ Example: ;;;*** ;;;### (autoloads (xml-parse-region xml-parse-file) "xml" "xml.el" -;;;;;; (20378 29222)) +;;;;;; (20464 9124 585807 0)) ;;; Generated autoloads from xml.el (autoload 'xml-parse-file "xml" "\ Parse the well-formed XML file FILE. -If FILE is already visited, use its buffer and don't kill it. -Returns the top node with all its children. +Return the top node with all its children. If PARSE-DTD is non-nil, the DTD is parsed rather than skipped. If PARSE-NS is non-nil, then QNAMES are expanded. @@ -33241,7 +33365,7 @@ If PARSE-NS is non-nil, then QNAMES are expanded. ;;;*** ;;;### (autoloads (xmltok-get-declared-encoding-position) "xmltok" -;;;;;; "nxml/xmltok.el" (20355 10021)) +;;;;;; "nxml/xmltok.el" (20355 10021 546955 0)) ;;; Generated autoloads from nxml/xmltok.el (autoload 'xmltok-get-declared-encoding-position "xmltok" "\ @@ -33260,7 +33384,7 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT. ;;;*** ;;;### (autoloads (xterm-mouse-mode) "xt-mouse" "xt-mouse.el" (20355 -;;;;;; 10021)) +;;;;;; 10021 546955 0)) ;;; Generated autoloads from xt-mouse.el (defvar xterm-mouse-mode nil "\ @@ -33290,7 +33414,7 @@ down the SHIFT key while pressing the mouse button. ;;;*** ;;;### (autoloads (yenc-extract-filename yenc-decode-region) "yenc" -;;;;;; "gnus/yenc.el" (20355 10021)) +;;;;;; "gnus/yenc.el" (20355 10021 546955 0)) ;;; Generated autoloads from gnus/yenc.el (autoload 'yenc-decode-region "yenc" "\ @@ -33306,7 +33430,7 @@ Extract file name from an yenc header. ;;;*** ;;;### (autoloads (psychoanalyze-pinhead apropos-zippy insert-zippyism -;;;;;; yow) "yow" "play/yow.el" (20364 42504)) +;;;;;; yow) "yow" "play/yow.el" (20364 42504 244840 586000)) ;;; Generated autoloads from play/yow.el (autoload 'yow "yow" "\ @@ -33332,7 +33456,8 @@ Zippy goes to the analyst. ;;;*** -;;;### (autoloads (zone) "zone" "play/zone.el" (20392 31071)) +;;;### (autoloads (zone) "zone" "play/zone.el" (20427 14766 970343 +;;;;;; 0)) ;;; Generated autoloads from play/zone.el (autoload 'zone "zone" "\ @@ -33348,35 +33473,34 @@ Zone out, completely. ;;;;;; "calc/calc-fin.el" "calc/calc-forms.el" "calc/calc-frac.el" ;;;;;; "calc/calc-funcs.el" "calc/calc-graph.el" "calc/calc-help.el" ;;;;;; "calc/calc-incom.el" "calc/calc-keypd.el" "calc/calc-lang.el" -;;;;;; "calc/calc-loaddefs.el" "calc/calc-macs.el" "calc/calc-map.el" -;;;;;; "calc/calc-math.el" "calc/calc-menu.el" "calc/calc-misc.el" -;;;;;; "calc/calc-mode.el" "calc/calc-mtx.el" "calc/calc-nlfit.el" -;;;;;; "calc/calc-poly.el" "calc/calc-prog.el" "calc/calc-rewr.el" -;;;;;; "calc/calc-rules.el" "calc/calc-sel.el" "calc/calc-stat.el" -;;;;;; "calc/calc-store.el" "calc/calc-stuff.el" "calc/calc-trail.el" -;;;;;; "calc/calc-units.el" "calc/calc-vec.el" "calc/calc-yank.el" -;;;;;; "calc/calcalg2.el" "calc/calcalg3.el" "calc/calccomp.el" -;;;;;; "calc/calcsel2.el" "calendar/cal-bahai.el" "calendar/cal-coptic.el" -;;;;;; "calendar/cal-french.el" "calendar/cal-html.el" "calendar/cal-islam.el" -;;;;;; "calendar/cal-iso.el" "calendar/cal-julian.el" "calendar/cal-loaddefs.el" -;;;;;; "calendar/cal-mayan.el" "calendar/cal-menu.el" "calendar/cal-move.el" -;;;;;; "calendar/cal-persia.el" "calendar/cal-tex.el" "calendar/cal-x.el" -;;;;;; "calendar/diary-loaddefs.el" "calendar/hol-loaddefs.el" "cdl.el" -;;;;;; "cedet/cedet-cscope.el" "cedet/cedet-files.el" "cedet/cedet-global.el" -;;;;;; "cedet/cedet-idutils.el" "cedet/cedet.el" "cedet/ede/auto.el" -;;;;;; "cedet/ede/autoconf-edit.el" "cedet/ede/base.el" "cedet/ede/cpp-root.el" -;;;;;; "cedet/ede/custom.el" "cedet/ede/dired.el" "cedet/ede/emacs.el" -;;;;;; "cedet/ede/files.el" "cedet/ede/generic.el" "cedet/ede/linux.el" -;;;;;; "cedet/ede/loaddefs.el" "cedet/ede/locate.el" "cedet/ede/make.el" -;;;;;; "cedet/ede/makefile-edit.el" "cedet/ede/pconf.el" "cedet/ede/pmake.el" -;;;;;; "cedet/ede/proj-archive.el" "cedet/ede/proj-aux.el" "cedet/ede/proj-comp.el" -;;;;;; "cedet/ede/proj-elisp.el" "cedet/ede/proj-info.el" "cedet/ede/proj-misc.el" -;;;;;; "cedet/ede/proj-obj.el" "cedet/ede/proj-prog.el" "cedet/ede/proj-scheme.el" -;;;;;; "cedet/ede/proj-shared.el" "cedet/ede/proj.el" "cedet/ede/project-am.el" -;;;;;; "cedet/ede/shell.el" "cedet/ede/simple.el" "cedet/ede/source.el" -;;;;;; "cedet/ede/speedbar.el" "cedet/ede/srecode.el" "cedet/ede/system.el" -;;;;;; "cedet/ede/util.el" "cedet/inversion.el" "cedet/pulse.el" -;;;;;; "cedet/semantic/analyze.el" "cedet/semantic/analyze/complete.el" +;;;;;; "calc/calc-macs.el" "calc/calc-map.el" "calc/calc-math.el" +;;;;;; "calc/calc-menu.el" "calc/calc-misc.el" "calc/calc-mode.el" +;;;;;; "calc/calc-mtx.el" "calc/calc-nlfit.el" "calc/calc-poly.el" +;;;;;; "calc/calc-prog.el" "calc/calc-rewr.el" "calc/calc-rules.el" +;;;;;; "calc/calc-sel.el" "calc/calc-stat.el" "calc/calc-store.el" +;;;;;; "calc/calc-stuff.el" "calc/calc-trail.el" "calc/calc-units.el" +;;;;;; "calc/calc-vec.el" "calc/calc-yank.el" "calc/calcalg2.el" +;;;;;; "calc/calcalg3.el" "calc/calccomp.el" "calc/calcsel2.el" +;;;;;; "calendar/cal-bahai.el" "calendar/cal-coptic.el" "calendar/cal-french.el" +;;;;;; "calendar/cal-html.el" "calendar/cal-islam.el" "calendar/cal-iso.el" +;;;;;; "calendar/cal-julian.el" "calendar/cal-loaddefs.el" "calendar/cal-mayan.el" +;;;;;; "calendar/cal-menu.el" "calendar/cal-move.el" "calendar/cal-persia.el" +;;;;;; "calendar/cal-tex.el" "calendar/cal-x.el" "calendar/diary-loaddefs.el" +;;;;;; "calendar/hol-loaddefs.el" "cdl.el" "cedet/cedet-cscope.el" +;;;;;; "cedet/cedet-files.el" "cedet/cedet-global.el" "cedet/cedet-idutils.el" +;;;;;; "cedet/cedet.el" "cedet/ede/auto.el" "cedet/ede/autoconf-edit.el" +;;;;;; "cedet/ede/base.el" "cedet/ede/cpp-root.el" "cedet/ede/custom.el" +;;;;;; "cedet/ede/dired.el" "cedet/ede/emacs.el" "cedet/ede/files.el" +;;;;;; "cedet/ede/generic.el" "cedet/ede/linux.el" "cedet/ede/locate.el" +;;;;;; "cedet/ede/make.el" "cedet/ede/makefile-edit.el" "cedet/ede/pconf.el" +;;;;;; "cedet/ede/pmake.el" "cedet/ede/proj-archive.el" "cedet/ede/proj-aux.el" +;;;;;; "cedet/ede/proj-comp.el" "cedet/ede/proj-elisp.el" "cedet/ede/proj-info.el" +;;;;;; "cedet/ede/proj-misc.el" "cedet/ede/proj-obj.el" "cedet/ede/proj-prog.el" +;;;;;; "cedet/ede/proj-scheme.el" "cedet/ede/proj-shared.el" "cedet/ede/proj.el" +;;;;;; "cedet/ede/project-am.el" "cedet/ede/shell.el" "cedet/ede/simple.el" +;;;;;; "cedet/ede/source.el" "cedet/ede/speedbar.el" "cedet/ede/srecode.el" +;;;;;; "cedet/ede/system.el" "cedet/ede/util.el" "cedet/inversion.el" +;;;;;; "cedet/pulse.el" "cedet/semantic/analyze.el" "cedet/semantic/analyze/complete.el" ;;;;;; "cedet/semantic/analyze/debug.el" "cedet/semantic/analyze/fcn.el" ;;;;;; "cedet/semantic/analyze/refs.el" "cedet/semantic/bovine.el" ;;;;;; "cedet/semantic/bovine/c-by.el" "cedet/semantic/bovine/c.el" @@ -33396,13 +33520,13 @@ Zone out, completely. ;;;;;; "cedet/semantic/fw.el" "cedet/semantic/grammar-wy.el" "cedet/semantic/grammar.el" ;;;;;; "cedet/semantic/html.el" "cedet/semantic/ia-sb.el" "cedet/semantic/ia.el" ;;;;;; "cedet/semantic/idle.el" "cedet/semantic/imenu.el" "cedet/semantic/java.el" -;;;;;; "cedet/semantic/lex-spp.el" "cedet/semantic/lex.el" "cedet/semantic/loaddefs.el" -;;;;;; "cedet/semantic/mru-bookmark.el" "cedet/semantic/sb.el" "cedet/semantic/scope.el" -;;;;;; "cedet/semantic/senator.el" "cedet/semantic/sort.el" "cedet/semantic/symref.el" -;;;;;; "cedet/semantic/symref/cscope.el" "cedet/semantic/symref/filter.el" -;;;;;; "cedet/semantic/symref/global.el" "cedet/semantic/symref/grep.el" -;;;;;; "cedet/semantic/symref/idutils.el" "cedet/semantic/symref/list.el" -;;;;;; "cedet/semantic/tag-file.el" "cedet/semantic/tag-ls.el" "cedet/semantic/tag-write.el" +;;;;;; "cedet/semantic/lex-spp.el" "cedet/semantic/lex.el" "cedet/semantic/mru-bookmark.el" +;;;;;; "cedet/semantic/sb.el" "cedet/semantic/scope.el" "cedet/semantic/senator.el" +;;;;;; "cedet/semantic/sort.el" "cedet/semantic/symref.el" "cedet/semantic/symref/cscope.el" +;;;;;; "cedet/semantic/symref/filter.el" "cedet/semantic/symref/global.el" +;;;;;; "cedet/semantic/symref/grep.el" "cedet/semantic/symref/idutils.el" +;;;;;; "cedet/semantic/symref/list.el" "cedet/semantic/tag-file.el" +;;;;;; "cedet/semantic/tag-ls.el" "cedet/semantic/tag-write.el" ;;;;;; "cedet/semantic/tag.el" "cedet/semantic/texi.el" "cedet/semantic/util-modes.el" ;;;;;; "cedet/semantic/util.el" "cedet/semantic/wisent.el" "cedet/semantic/wisent/comp.el" ;;;;;; "cedet/semantic/wisent/java-tags.el" "cedet/semantic/wisent/javascript.el" @@ -33414,14 +33538,14 @@ Zone out, completely. ;;;;;; "cedet/srecode/el.el" "cedet/srecode/expandproto.el" "cedet/srecode/extract.el" ;;;;;; "cedet/srecode/fields.el" "cedet/srecode/filters.el" "cedet/srecode/find.el" ;;;;;; "cedet/srecode/getset.el" "cedet/srecode/insert.el" "cedet/srecode/java.el" -;;;;;; "cedet/srecode/loaddefs.el" "cedet/srecode/map.el" "cedet/srecode/mode.el" -;;;;;; "cedet/srecode/semantic.el" "cedet/srecode/srt-wy.el" "cedet/srecode/srt.el" -;;;;;; "cedet/srecode/table.el" "cedet/srecode/template.el" "cedet/srecode/texi.el" -;;;;;; "cus-dep.el" "dframe.el" "dired-aux.el" "dired-x.el" "dos-fns.el" -;;;;;; "dos-vars.el" "dos-w32.el" "dynamic-setting.el" "emacs-lisp/authors.el" +;;;;;; "cedet/srecode/map.el" "cedet/srecode/mode.el" "cedet/srecode/semantic.el" +;;;;;; "cedet/srecode/srt-wy.el" "cedet/srecode/srt.el" "cedet/srecode/table.el" +;;;;;; "cedet/srecode/template.el" "cedet/srecode/texi.el" "cus-dep.el" +;;;;;; "dframe.el" "dired-aux.el" "dired-x.el" "dos-fns.el" "dos-vars.el" +;;;;;; "dos-w32.el" "dynamic-setting.el" "emacs-lisp/authors.el" ;;;;;; "emacs-lisp/avl-tree.el" "emacs-lisp/bindat.el" "emacs-lisp/byte-opt.el" ;;;;;; "emacs-lisp/chart.el" "emacs-lisp/cl-extra.el" "emacs-lisp/cl-loaddefs.el" -;;;;;; "emacs-lisp/cl-macs.el" "emacs-lisp/cl-seq.el" "emacs-lisp/cust-print.el" +;;;;;; "emacs-lisp/cl-macs.el" "emacs-lisp/cl-seq.el" "emacs-lisp/cl.el" ;;;;;; "emacs-lisp/eieio-base.el" "emacs-lisp/eieio-custom.el" "emacs-lisp/eieio-datadebug.el" ;;;;;; "emacs-lisp/eieio-opt.el" "emacs-lisp/eieio-speedbar.el" ;;;;;; "emacs-lisp/eieio.el" "emacs-lisp/find-gc.el" "emacs-lisp/gulp.el" @@ -33439,19 +33563,19 @@ Zone out, completely. ;;;;;; "eshell/em-prompt.el" "eshell/em-rebind.el" "eshell/em-script.el" ;;;;;; "eshell/em-smart.el" "eshell/em-term.el" "eshell/em-unix.el" ;;;;;; "eshell/em-xtra.el" "eshell/esh-arg.el" "eshell/esh-cmd.el" -;;;;;; "eshell/esh-ext.el" "eshell/esh-groups.el" "eshell/esh-io.el" -;;;;;; "eshell/esh-module.el" "eshell/esh-opt.el" "eshell/esh-proc.el" -;;;;;; "eshell/esh-util.el" "eshell/esh-var.el" "ezimage.el" "foldout.el" -;;;;;; "format-spec.el" "fringe.el" "generic-x.el" "gnus/compface.el" -;;;;;; "gnus/gnus-async.el" "gnus/gnus-bcklg.el" "gnus/gnus-cite.el" -;;;;;; "gnus/gnus-cus.el" "gnus/gnus-demon.el" "gnus/gnus-dup.el" -;;;;;; "gnus/gnus-eform.el" "gnus/gnus-ems.el" "gnus/gnus-int.el" -;;;;;; "gnus/gnus-logic.el" "gnus/gnus-mh.el" "gnus/gnus-salt.el" -;;;;;; "gnus/gnus-score.el" "gnus/gnus-setup.el" "gnus/gnus-srvr.el" -;;;;;; "gnus/gnus-topic.el" "gnus/gnus-undo.el" "gnus/gnus-util.el" -;;;;;; "gnus/gnus-uu.el" "gnus/gnus-vm.el" "gnus/gssapi.el" "gnus/ietf-drums.el" -;;;;;; "gnus/legacy-gnus-agent.el" "gnus/mail-parse.el" "gnus/mail-prsvr.el" -;;;;;; "gnus/mail-source.el" "gnus/mailcap.el" "gnus/messcompat.el" +;;;;;; "eshell/esh-ext.el" "eshell/esh-io.el" "eshell/esh-module.el" +;;;;;; "eshell/esh-opt.el" "eshell/esh-proc.el" "eshell/esh-util.el" +;;;;;; "eshell/esh-var.el" "ezimage.el" "foldout.el" "format-spec.el" +;;;;;; "fringe.el" "generic-x.el" "gnus/compface.el" "gnus/gnus-async.el" +;;;;;; "gnus/gnus-bcklg.el" "gnus/gnus-cite.el" "gnus/gnus-cus.el" +;;;;;; "gnus/gnus-demon.el" "gnus/gnus-dup.el" "gnus/gnus-eform.el" +;;;;;; "gnus/gnus-ems.el" "gnus/gnus-int.el" "gnus/gnus-logic.el" +;;;;;; "gnus/gnus-mh.el" "gnus/gnus-salt.el" "gnus/gnus-score.el" +;;;;;; "gnus/gnus-setup.el" "gnus/gnus-srvr.el" "gnus/gnus-topic.el" +;;;;;; "gnus/gnus-undo.el" "gnus/gnus-util.el" "gnus/gnus-uu.el" +;;;;;; "gnus/gnus-vm.el" "gnus/gssapi.el" "gnus/ietf-drums.el" "gnus/legacy-gnus-agent.el" +;;;;;; "gnus/mail-parse.el" "gnus/mail-prsvr.el" "gnus/mail-source.el" +;;;;;; "gnus/mailcap.el" "gnus/messcompat.el" "gnus/mm-archive.el" ;;;;;; "gnus/mm-bodies.el" "gnus/mm-decode.el" "gnus/mm-util.el" ;;;;;; "gnus/mm-view.el" "gnus/mml-sec.el" "gnus/mml-smime.el" "gnus/nnagent.el" ;;;;;; "gnus/nnbabyl.el" "gnus/nndir.el" "gnus/nndraft.el" "gnus/nneething.el" @@ -33543,7 +33667,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") (20424 38645 32667)) +;;;;;; "w32-vars.el" "x-dnd.el") (20464 9462 647923 919000)) ;;;*** diff --git a/lisp/loadhist.el b/lisp/loadhist.el index d5099340a17..88aa9f53b75 100644 --- a/lisp/loadhist.el +++ b/lisp/loadhist.el @@ -29,8 +29,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - (defun feature-symbols (feature) "Return the file and list of definitions associated with FEATURE. The value is actually the element of `load-history' @@ -254,11 +252,11 @@ something strange, such as redefining an Emacs function." (dolist (x unload-function-defs-list) (if (consp x) - (case (car x) + (pcase (car x) ;; Remove any feature names that this file provided. - (provide + (`provide (setq features (delq (cdr x) features))) - ((defun autoload) + ((or `defun `autoload) (let ((fun (cdr x))) (when (fboundp fun) (when (fboundp 'ad-unadvise) @@ -270,9 +268,9 @@ something strange, such as redefining an Emacs function." ;; (t . SYMBOL) comes before (defun . SYMBOL) ;; and says we should restore SYMBOL's autoload ;; when we undefine it. - ((t) (setq restore-autoload (cdr x))) - ((require defface) nil) - (t (message "Unexpected element %s in load-history" x))) + (`t (setq restore-autoload (cdr x))) + ((or `require `defface) nil) + (_ (message "Unexpected element %s in load-history" x))) ;; Kill local values as much as possible. (dolist (buf (buffer-list)) (with-current-buffer buf diff --git a/lisp/loadup.el b/lisp/loadup.el index 3b2d4e34938..a460fcab339 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -44,6 +44,10 @@ ;; Add subdirectories to the load-path for files that might get ;; autoloaded when bootstrapping. +;; This is because PATH_DUMPLOADSEARCH is just "../lisp". +;; Note that we reset load-path below just before dumping, +;; since lread.c:init_lread checks for changes to load-path +;; in deciding whether to modify it. (if (or (equal (nth 3 command-line-args) "bootstrap") (equal (nth 4 command-line-args) "bootstrap") (equal (nth 3 command-line-args) "unidata-gen.el") @@ -61,7 +65,7 @@ (if (eq t purify-flag) ;; Hash consing saved around 11% of pure space in my tests. - (setq purify-flag (make-hash-table :test 'equal))) + (setq purify-flag (make-hash-table :test 'equal :size 70000))) (message "Using load-path %s" load-path) @@ -104,6 +108,17 @@ (load "button") (load "startup") +;; We don't want to store loaddefs.el in the repository because it is +;; a generated file; but it is required in order to compile the lisp files. +;; When bootstrapping, we cannot generate loaddefs.el until an +;; emacs binary has been built. We therefore compromise and keep +;; ldefs-boot.el in the repository. This does not need to be updated +;; as often as the real loaddefs.el would. Bootstrap should always +;; work with ldefs-boot.el. Therefore, Whenever a new autoload cookie +;; gets added that is necessary during bootstrapping, ldefs-boot.el +;; should be updated by overwriting it with an up-to-date copy of +;; loaddefs.el that is uncorrupted by local changes. +;; autogen/update_autogen can be used to periodically update ldefs-boot. (condition-case nil ;; Don't get confused if someone compiled this by mistake. (load "loaddefs.el") @@ -177,7 +192,6 @@ (load "rfn-eshadow") (load "menu-bar") -(load "paths") (load "emacs-lisp/lisp") (load "textmodes/page") (load "register") @@ -252,6 +266,21 @@ ;For other systems, you must edit ../src/Makefile.in. (load "site-load" t) +;; ¡¡¡ Big Ugly Hack !!! +;; src/bootstrap-emacs is mostly used to compile .el files, so it needs +;; macroexp, bytecomp, cconv, and byte-opt to be fast. Generally this is done +;; by compiling those files first, but this only makes a difference if those +;; files are not preloaded. As it so happens, macroexp.el tends to be +;; accidentally preloaded in src/bootstrap-emacs because cl.el and cl-macs.el +;; require it. So let's unload it here, if needed, to make sure the +;; byte-compiled version is used. +(if (or (not (fboundp 'macroexpand-all)) + (byte-code-function-p (symbol-function 'macroexpand-all))) + nil + (fmakunbound 'macroexpand-all) + (setq features (delq 'macroexp features)) + (autoload 'macroexpand-all "macroexp")) + ;; Determine which last version number to use ;; based on the executables that now exist. (if (and (or (equal (nth 3 command-line-args) "dump") @@ -345,9 +374,7 @@ (if (or (member (nth 3 command-line-args) '("dump" "bootstrap")) (member (nth 4 command-line-args) '("dump" "bootstrap"))) (progn - (if (memq system-type '(ms-dos windows-nt cygwin)) - (message "Dumping under the name emacs") - (message "Dumping under the name emacs")) + (message "Dumping under the name emacs") (condition-case () (delete-file "emacs") (file-error nil)) diff --git a/lisp/lpr.el b/lisp/lpr.el index 65295a7f860..b31d19b624f 100644 --- a/lisp/lpr.el +++ b/lisp/lpr.el @@ -29,8 +29,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - ;;;###autoload (defvar lpr-windows-system (memq system-type '(ms-dos windows-nt)) @@ -281,10 +279,10 @@ for further customization of the printer command." (if (markerp end) (set-marker end nil)) (message "Spooling%s...done%s%s" switch-string - (case (count-lines (point-min) (point-max)) + (pcase (count-lines (point-min) (point-max)) (0 "") (1 ": ") - (t ":\n")) + (_ ":\n")) (buffer-string))))))) ;; This function copies the text between start and end diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index 94c223556d1..8cc72e1afba 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -212,7 +212,7 @@ Prompts for bug subject. Leaves you in a mail buffer." (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. +to one day, you should receive an acknowledgment at that address. Please write in English if possible, as the Emacs maintainers usually do not have translators for other languages.\n\n"))) diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index df18abbc532..c6d1d228780 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -372,8 +372,7 @@ (require 'mail-utils) ; pick up mail-strip-quoted-names (eval-when-compile - (require 'smtpmail) - (require 'cl)) + (require 'smtpmail)) (autoload 'mail-do-fcc "sendmail") @@ -1951,9 +1950,6 @@ bail out with an appropriate answer to the global confirmation prompt." (feedmail-say-debug ">in-> feedmail-run-the-queue-global-prompts") (let ((feedmail-queue-runner-confirm-global t)) (feedmail-run-the-queue arg))) -;; letf fools the byte-compiler. -(defvar file-name-buffer-file-type-alist) - ;;;###autoload (defun feedmail-run-the-queue (&optional arg) "Visit each message in the feedmail queue directory and send it out. @@ -2392,8 +2388,10 @@ mapped to mostly alphanumerics for safety." (defun feedmail-send-it-immediately () "Handle immediate sending, including during a queue run." (feedmail-say-debug ">in-> feedmail-send-it-immediately") - (let ((feedmail-error-buffer (get-buffer-create " *FQM Outgoing Email Errors*")) - (feedmail-prepped-text-buffer (get-buffer-create " *FQM Outgoing Email Text*")) + (let ((feedmail-error-buffer + (get-buffer-create " *FQM Outgoing Email Errors*")) + (feedmail-prepped-text-buffer + (get-buffer-create " *FQM Outgoing Email Text*")) (feedmail-raw-text-buffer (current-buffer)) (feedmail-address-list) (eoh-marker) @@ -2405,7 +2403,7 @@ mapped to mostly alphanumerics for safety." (a-re-dtcb "^\\(To\\|Cc\\|Bcc\\):") (a-re-dtc "^\\(To\\|Cc\\):") (a-re-db "^Bcc:") - ;; to get a temporary changeable copy + ;; To get a temporary changeable copy. (mail-header-separator mail-header-separator) ) (unwind-protect @@ -2413,10 +2411,10 @@ mapped to mostly alphanumerics for safety." (set-buffer feedmail-error-buffer) (erase-buffer) (set-buffer feedmail-prepped-text-buffer) (erase-buffer) - ;; jam contents of user-supplied mail buffer into our scratch buffer + ;; Jam contents of user-supplied mail buffer into our scratch buffer. (insert-buffer-substring feedmail-raw-text-buffer) - ;; require one newline at the end. + ;; Require one newline at the end. (goto-char (point-max)) (or (= (preceding-char) ?\n) (insert ?\n)) @@ -2437,54 +2435,69 @@ mapped to mostly alphanumerics for safety." (and (fboundp 'expand-mail-aliases) mail-aliases)) (expand-mail-aliases (point-min) eoh-marker)) - ;; make it pretty + ;; Make it pretty. (if feedmail-fill-to-cc (feedmail-fill-to-cc-function eoh-marker)) - ;; ignore any blank lines in the header + ;; Ignore any blank lines in the header. (goto-char (point-min)) - (while (and (re-search-forward "\n\n\n*" eoh-marker t) (< (point) eoh-marker)) + (while (and (re-search-forward "\n\n\n*" eoh-marker t) + (< (point) eoh-marker)) (replace-match "\n")) (let ((case-fold-search t) (addr-regexp)) (goto-char (point-min)) - ;; there are some RFC-822 combinations/cases missed here, - ;; but probably good enough and what users expect + ;; There are some RFC-822 combinations/cases missed here, + ;; but probably good enough and what users expect. ;; - ;; use resent-* stuff only if there is at least one non-empty one + ;; Use resent-* stuff only if there is at least one non-empty one. (setq feedmail-is-a-resend (re-search-forward - ;; header name, followed by optional whitespace, followed by - ;; non-whitespace, followed by anything, followed by newline; - ;; the idea is empty Resent-* headers are ignored + ;; Header name, followed by optional whitespace, followed by + ;; non-whitespace, followed by anything, followed by + ;; newline; the idea is empty Resent-* headers are ignored. "^\\(Resent-To:\\|Resent-Cc:\\|Resent-Bcc:\\)\\s-*\\S-+.*$" eoh-marker t)) - ;; if we say so, gather the Bcc stuff before the main course - (if (eq feedmail-deduce-bcc-where 'first) - (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rb) (setq addr-regexp a-re-db)) - (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list)))) - ;; the main course - (if (or (eq feedmail-deduce-bcc-where 'first) (eq feedmail-deduce-bcc-where 'last)) - ;; handled by first or last cases, so don't get Bcc stuff - (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rtc) (setq addr-regexp a-re-dtc)) - (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))) - ;; not handled by first or last cases, so also get Bcc stuff - (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rtcb) (setq addr-regexp a-re-dtcb)) - (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list)))) - ;; if we say so, gather the Bcc stuff after the main course - (if (eq feedmail-deduce-bcc-where 'last) - (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rb) (setq addr-regexp a-re-db)) - (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list)))) - (if (not feedmail-address-list) (error "FQM: Sending...abandoned, no addressees")) - ;; not needed, but meets user expectations + ;; If we say so, gather the Bcc stuff before the main course. + (when (eq feedmail-deduce-bcc-where 'first) + (setq addr-regexp (if feedmail-is-a-resend a-re-rb a-re-db)) + (setq feedmail-address-list + (feedmail-deduce-address-list + feedmail-prepped-text-buffer (point-min) eoh-marker + addr-regexp feedmail-address-list))) + ;; The main course. + (setq addr-regexp + (if (memq feedmail-deduce-bcc-where '(first last)) + ;; Handled by first or last cases, so don't get + ;; Bcc stuff. + (if feedmail-is-a-resend a-re-rtc a-re-dtc) + ;; Not handled by first or last cases, so also get + ;; Bcc stuff. + (if feedmail-is-a-resend a-re-rtcb a-re-dtcb))) + (setq feedmail-address-list + (feedmail-deduce-address-list + feedmail-prepped-text-buffer (point-min) eoh-marker + addr-regexp feedmail-address-list)) + ;; If we say so, gather the Bcc stuff after the main course. + (when (eq feedmail-deduce-bcc-where 'last) + (setq addr-regexp (if feedmail-is-a-resend a-re-rb a-re-db)) + (setq feedmail-address-list + (feedmail-deduce-address-list + feedmail-prepped-text-buffer (point-min) eoh-marker + addr-regexp feedmail-address-list))) + (if (not feedmail-address-list) + (error "FQM: Sending...abandoned, no addressees")) + ;; Not needed, but meets user expectations. (setq feedmail-address-list (nreverse feedmail-address-list)) ;; Find and handle any Bcc fields. - (setq bcc-holder (feedmail-accume-n-nuke-header eoh-marker "^Bcc:")) - (setq resent-bcc-holder (feedmail-accume-n-nuke-header eoh-marker "^Resent-Bcc:")) - (if (and bcc-holder (not feedmail-nuke-bcc)) - (progn (goto-char (point-min)) - (insert bcc-holder))) - (if (and resent-bcc-holder (not feedmail-nuke-resent-bcc)) - (progn (goto-char (point-min)) - (insert resent-bcc-holder))) + (setq bcc-holder + (feedmail-accume-n-nuke-header eoh-marker "^Bcc:")) + (setq resent-bcc-holder + (feedmail-accume-n-nuke-header eoh-marker "^Resent-Bcc:")) + (when (and bcc-holder (not feedmail-nuke-bcc)) + (goto-char (point-min)) + (insert bcc-holder)) + (when (and resent-bcc-holder (not feedmail-nuke-resent-bcc)) + (goto-char (point-min)) + (insert resent-bcc-holder)) (goto-char (point-min)) ;; fiddle about, fiddle about, fiddle about.... @@ -2492,16 +2505,20 @@ mapped to mostly alphanumerics for safety." (feedmail-fiddle-sender) (feedmail-fiddle-x-mailer) (feedmail-fiddle-message-id - (or feedmail-queue-runner-is-active (buffer-file-name feedmail-raw-text-buffer))) + (or feedmail-queue-runner-is-active + (buffer-file-name feedmail-raw-text-buffer))) (feedmail-fiddle-date - (or feedmail-queue-runner-is-active (buffer-file-name feedmail-raw-text-buffer))) - (feedmail-fiddle-list-of-fiddle-plexes feedmail-fiddle-plex-user-list) + (or feedmail-queue-runner-is-active + (buffer-file-name feedmail-raw-text-buffer))) + (feedmail-fiddle-list-of-fiddle-plexes + feedmail-fiddle-plex-user-list) ;; don't send out a blank headers of various sorts ;; (this loses on continued line with a blank first line) (goto-char (point-min)) (and feedmail-nuke-empty-headers ; hey, who's an empty-header? - (while (re-search-forward "^[A-Za-z0-9-]+:[ \t]*\n" eoh-marker t) + (while (re-search-forward "^[A-Za-z0-9-]+:[ \t]*\n" + eoh-marker t) (replace-match "")))) (feedmail-say-debug "last chance hook: %s" feedmail-last-chance-hook) @@ -2513,79 +2530,90 @@ mapped to mostly alphanumerics for safety." (confirm (cond ((eq feedmail-confirm-outgoing 'immediate) (not feedmail-queue-runner-is-active)) - ((eq feedmail-confirm-outgoing 'queued) feedmail-queue-runner-is-active) + ((eq feedmail-confirm-outgoing 'queued) + feedmail-queue-runner-is-active) (t feedmail-confirm-outgoing))) (fullframe (cond ((eq feedmail-display-full-frame 'immediate) (not feedmail-queue-runner-is-active)) - ((eq feedmail-display-full-frame 'queued) feedmail-queue-runner-is-active) + ((eq feedmail-display-full-frame 'queued) + feedmail-queue-runner-is-active) (t feedmail-display-full-frame)))) (if fullframe (progn (switch-to-buffer feedmail-prepped-text-buffer t) (delete-other-windows))) - (if (or (not confirm) (feedmail-one-last-look feedmail-prepped-text-buffer)) - (let ((user-mail-address (feedmail-envelope-deducer eoh-marker))) + (if (or (not confirm) + (feedmail-one-last-look feedmail-prepped-text-buffer)) + (let ((user-mail-address + (feedmail-envelope-deducer eoh-marker))) (feedmail-say-debug "give it to buffer-eater") (feedmail-give-it-to-buffer-eater) (feedmail-say-debug "gave it to buffer-eater") - (if (and (not feedmail-queue-runner-is-active) (setq also-file (buffer-file-name feedmail-raw-text-buffer))) - (progn ; if a file but not running the queue, offer to delete it + (if (and (not feedmail-queue-runner-is-active) + (setq also-file + (buffer-file-name feedmail-raw-text-buffer))) + (progn + ;; If a file but not running the queue, + ;; offer to delete it (setq also-file (expand-file-name also-file)) (when (or feedmail-queue-auto-file-nuke (y-or-n-p (format "FQM: Delete message file %s? " also-file))) - ;; if we delete the affiliated file, get rid + ;; If we delete the affiliated file, get rid ;; of the file name association and make sure we - ;; don't annoy people with a prompt on exit + ;; don't annoy people with a prompt on exit. (delete-file also-file) (with-current-buffer feedmail-raw-text-buffer (setq buffer-offer-save nil) (setq buffer-file-name nil))))) (goto-char (point-min)) - ;; re-insert and handle any Fcc fields (and, optionally, any Bcc). - (if fcc (letf (((default-value 'buffer-file-type) - feedmail-force-binary-write)) - (insert fcc) - (if (not feedmail-nuke-bcc-in-fcc) - (progn (if bcc-holder (insert bcc-holder)) - (if resent-bcc-holder (insert resent-bcc-holder)))) - - (run-hooks 'feedmail-before-fcc-hook) - - (if feedmail-nuke-body-in-fcc - (progn (goto-char eoh-marker) - (if (natnump feedmail-nuke-body-in-fcc) - (forward-line feedmail-nuke-body-in-fcc)) - (delete-region (point) (point-max)) - )) - (mail-do-fcc eoh-marker) - ))) - ;; user bailed out of one-last-look + ;; Re-insert and handle any Fcc fields (and, optionally, + ;; any Bcc). + (when fcc + (let ((old (default-value 'buffer-file-type))) + (unwind-protect + (progn + (setq-default buffer-file-type + feedmail-force-binary-write) + (insert fcc) + (unless feedmail-nuke-bcc-in-fcc + (if bcc-holder (insert bcc-holder)) + (if resent-bcc-holder + (insert resent-bcc-holder))) + + (run-hooks 'feedmail-before-fcc-hook) + + (when feedmail-nuke-body-in-fcc + (goto-char eoh-marker) + (if (natnump feedmail-nuke-body-in-fcc) + (forward-line feedmail-nuke-body-in-fcc)) + (delete-region (point) (point-max))) + (mail-do-fcc eoh-marker)) + (setq-default buffer-file-type old))))) + ;; User bailed out of one-last-look. (if feedmail-queue-runner-is-active (throw 'skip-me-q 'skip-me-q) (throw 'skip-me-i 'skip-me-i)) )))) ; unwind-protect body (save-excursion) - ;; unwind-protect cleanup forms + ;; unwind-protect cleanup forms. (kill-buffer feedmail-prepped-text-buffer) (set-buffer feedmail-error-buffer) (if (zerop (buffer-size)) (kill-buffer feedmail-error-buffer) - (progn (display-buffer feedmail-error-buffer) - ;; read fast ... the meter is running - (if feedmail-queue-runner-is-active - (progn - (ding t) - (feedmail-say-chatter "Sending...failed"))) - (error "FQM: Sending...failed"))) + (display-buffer feedmail-error-buffer) + ;; Read fast ... the meter is running. + (if feedmail-queue-runner-is-active + (progn + (ding t) + (feedmail-say-chatter "Sending...failed"))) + (error "FQM: Sending...failed")) (set-buffer feedmail-raw-text-buffer)) ) ; let - (if (and feedmail-queue-chatty (not feedmail-queue-runner-is-active)) - (progn - (feedmail-queue-reminder 'after-immediate) - (sit-for feedmail-queue-chatty-sit-for))) - ) + (when (and feedmail-queue-chatty (not feedmail-queue-runner-is-active)) + (feedmail-queue-reminder 'after-immediate) + (sit-for feedmail-queue-chatty-sit-for))) (defun feedmail-fiddle-header (name value &optional action folding) diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el index f0c6b21513e..e342e0ae977 100644 --- a/lisp/mail/footnote.el +++ b/lisp/mail/footnote.el @@ -35,9 +35,8 @@ ;;; Code: -(eval-when-compile - (require 'cl) - (defvar filladapt-token-table)) +(eval-when-compile (require 'cl-lib)) +(defvar filladapt-token-table) (defgroup footnote nil "Support for footnotes in mail and news messages." @@ -644,12 +643,12 @@ If the variable `footnote-narrow-to-footnotes-when-editing' is set, the buffer is narrowed to the footnote body. The restriction is removed by using `Footnote-back-to-message'." (interactive "*P") - (let (num) - (if footnote-text-marker-alist - (if (< (point) (cadar (last footnote-pointer-marker-alist))) - (setq num (Footnote-make-hole)) - (setq num (1+ (caar (last footnote-text-marker-alist))))) - (setq num 1)) + (let ((num + (if footnote-text-marker-alist + (if (< (point) (cl-cadar (last footnote-pointer-marker-alist))) + (Footnote-make-hole) + (1+ (caar (last footnote-text-marker-alist)))) + 1))) (message "Adding footnote %d" num) (Footnote-insert-footnote num) (insert-before-markers (make-string footnote-body-tag-spacing ? )) diff --git a/lisp/mail/mailheader.el b/lisp/mail/mailheader.el index 1c917a05dfb..6adcb25904b 100644 --- a/lisp/mail/mailheader.el +++ b/lisp/mail/mailheader.el @@ -45,9 +45,6 @@ ;;; Code: -(eval-when-compile - (require 'cl)) - (defun mail-header-extract () "Extract headers from current buffer after point. Returns a header alist, where each element is a cons cell (name . value), @@ -110,6 +107,8 @@ If the value is a string, it is the original value of the header. If the value is a list, its first element is the original value of the header, with any subsequent elements being the result of parsing the value. If HEADER-ALIST is nil, the dynamically bound variable `headers' is used." + (declare (gv-setter (lambda (value) + `(mail-header-set ,header ,value ,header-alist)))) (cdr (assq header (or header-alist headers)))) (defun mail-header-set (header value &optional header-alist) @@ -123,9 +122,6 @@ See `mail-header' for the semantics of VALUE." (nconc alist (list (cons header value))))) value) -(defsetf mail-header (header &optional header-alist) (value) - `(mail-header-set ,header ,value ,header-alist)) - (defun mail-header-merge (merge-rules headers) "Return a new header alist with MERGE-RULES applied to HEADERS. MERGE-RULES is an alist whose keys are header names (symbols) and whose diff --git a/lisp/mail/mspools.el b/lisp/mail/mspools.el index 9f9c9c68285..6f8c444651c 100644 --- a/lisp/mail/mspools.el +++ b/lisp/mail/mspools.el @@ -83,7 +83,7 @@ ;; Useful settings for VM ;; vm-auto-get-new-mail should be t (the default). -;; Acknowledgements +;; Acknowledgments ;; Thanks to jond@mitre.org (Jonathan Doughty) for help with code for ;; setting up vm-spool-files. diff --git a/lisp/mail/rfc2368.el b/lisp/mail/rfc2368.el index dd10189d264..8b30e82804e 100644 --- a/lisp/mail/rfc2368.el +++ b/lisp/mail/rfc2368.el @@ -33,7 +33,7 @@ ;; ;; this is intended as a replacement for mailto.el ;; -;; acknowledgements: +;; acknowledgments: ;; ;; the functions that deal w/ unhexifying in this file were basically ;; taken from w3 -- i hope to replace them w/ something else soon OR diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in index 2137607281a..92d939af018 100644 --- a/lisp/makefile.w32-in +++ b/lisp/makefile.w32-in @@ -79,10 +79,10 @@ BYTE_COMPILE_FLAGS = $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) # speed up the bootstrap process. COMPILE_FIRST = \ - $(lisp)/emacs-lisp/bytecomp.el \ - $(lisp)/emacs-lisp/byte-opt.el \ $(lisp)/emacs-lisp/macroexp.el \ $(lisp)/emacs-lisp/cconv.el \ + $(lisp)/emacs-lisp/byte-opt.el \ + $(lisp)/emacs-lisp/bytecomp.el \ $(lisp)/emacs-lisp/autoload.el # The actual Emacs command run in the targets below. @@ -311,7 +311,7 @@ TAGS-LISP-CMD: $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsf # compiled find the right files. # Need separate version for sh and native cmd.exe -compile: $(lisp)/subdirs.el compile-$(SHELLTYPE) doit +compile: update-subdirs compile-$(SHELLTYPE) doit compile-CMD: autoloads # -for %%f in ($(lisp) $(WINS)) do for %%g in (%%f\*.elc) do @attrib -r %%g @@ -340,7 +340,7 @@ compile-SH: autoloads # unconditionally. Some files don't actually get compiled because they # set the local variable no-byte-compile. -compile-always: $(lisp)/subdirs.el compile-always-$(SHELLTYPE) doit +compile-always: update-subdirs compile-always-$(SHELLTYPE) doit compile-always-CMD: # -for %%f in ($(lisp) $(WINS)) do for %%g in (%%f\*.elc) do @attrib -r %%g @@ -393,7 +393,7 @@ compile-first: $(lisp)/emacs-lisp/bytecomp.elc $(lisp)/emacs-lisp/byte-opt.elc recompile: compile-first autoloads doit $(lisp)/progmodes/cc-mode.elc $(emacs) --eval $(ARGQUOTE)(batch-byte-recompile-directory 0)$(ARGQUOTE) $(lisp) -$(lisp)/calendar/cal-loaddefs.el: +$(lisp)/calendar/cal-loaddefs.el: update-subdirs "$(EMACS)" $(EMACSOPT) -l autoload \ --eval "(setq generate-autoload-cookie \";;;###cal-autoload\")" \ --eval "(setq find-file-suppress-same-file-warnings t)" \ @@ -401,7 +401,7 @@ $(lisp)/calendar/cal-loaddefs.el: -f w32-batch-update-autoloads "$(lisp)/calendar/cal-loaddefs.el" \ $(MAKE) ./calendar -$(lisp)/calendar/diary-loaddefs.el: +$(lisp)/calendar/diary-loaddefs.el: update-subdirs "$(EMACS)" $(EMACSOPT) -l autoload \ --eval "(setq generate-autoload-cookie \";;;###diary-autoload\")" \ --eval "(setq find-file-suppress-same-file-warnings t)" \ @@ -409,7 +409,7 @@ $(lisp)/calendar/diary-loaddefs.el: -f w32-batch-update-autoloads $(lisp)/calendar/diary-loaddefs.el \ $(MAKE) ./calendar -$(lisp)/calendar/hol-loaddefs.el: +$(lisp)/calendar/hol-loaddefs.el: update-subdirs "$(EMACS)" $(EMACSOPT) -l autoload \ --eval "(setq generate-autoload-cookie \";;;###holiday-autoload\")" \ --eval "(setq find-file-suppress-same-file-warnings t)" \ @@ -437,7 +437,7 @@ MH_E_SRC = $(lisp)/mh-e/mh-acros.el $(lisp)/mh-e/mh-alias.el \ # See the commentary for autoloads above for why we use ./mh-e below # instead of $(lisp)/mh-e. mh-autoloads: $(lisp)/mh-e/mh-loaddefs.el -$(lisp)/mh-e/mh-loaddefs.el: $(MH_E_SRC) +$(lisp)/mh-e/mh-loaddefs.el: $(MH_E_SRC) update-subdirs "$(EMACS)" $(EMACSOPT) \ -l autoload \ --eval $(ARGQUOTE)(setq generate-autoload-cookie $(DQUOTE);;;###mh-autoload$(DQUOTE))$(ARGQUOTE) \ @@ -456,7 +456,7 @@ TRAMP_SRC = $(lisp)/net/tramp.el $(lisp)/net/tramp-cache.el \ $(lisp)/net/tramp-smb.el $(lisp)/net/tramp-uu.el \ $(lisp)/net/trampver.el -$(lisp)/net/tramp-loaddefs.el: $(TRAMP_SRC) +$(lisp)/net/tramp-loaddefs.el: $(TRAMP_SRC) update-subdirs "$(EMACS)" $(EMACSOPT) \ -l autoload \ --eval $(ARGQUOTE)(setq generate-autoload-cookie $(DQUOTE);;;###tramp-autoload$(DQUOTE))$(ARGQUOTE) \ diff --git a/lisp/man.el b/lisp/man.el index ca7df4cd1a4..6f437c017b3 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -88,7 +88,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) (require 'button) ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv @@ -989,41 +988,41 @@ Return the buffer in which the manpage will appear." See the variable `Man-notify-method' for the different notification behaviors." (let ((saved-frame (with-current-buffer man-buffer Man-original-frame))) - (case Man-notify-method - (newframe - ;; Since we run asynchronously, perhaps while Emacs is waiting - ;; for input, we must not leave a different buffer current. We - ;; can't rely on the editor command loop to reselect the - ;; selected window's buffer. - (save-excursion - (let ((frame (make-frame Man-frame-parameters))) - (set-window-buffer (frame-selected-window frame) man-buffer) - (set-window-dedicated-p (frame-selected-window frame) t) - (or (display-multi-frame-p frame) - (select-frame frame))))) - (pushy - (switch-to-buffer man-buffer)) - (bully - (and (frame-live-p saved-frame) - (select-frame saved-frame)) - (pop-to-buffer man-buffer) - (delete-other-windows)) - (aggressive - (and (frame-live-p saved-frame) - (select-frame saved-frame)) - (pop-to-buffer man-buffer)) - (friendly - (and (frame-live-p saved-frame) - (select-frame saved-frame)) - (display-buffer man-buffer 'not-this-window)) - (polite - (beep) - (message "Manual buffer %s is ready" (buffer-name man-buffer))) - (quiet - (message "Manual buffer %s is ready" (buffer-name man-buffer))) - (t ;; meek - (message "")) - ))) + (pcase Man-notify-method + (`newframe + ;; Since we run asynchronously, perhaps while Emacs is waiting + ;; for input, we must not leave a different buffer current. We + ;; can't rely on the editor command loop to reselect the + ;; selected window's buffer. + (save-excursion + (let ((frame (make-frame Man-frame-parameters))) + (set-window-buffer (frame-selected-window frame) man-buffer) + (set-window-dedicated-p (frame-selected-window frame) t) + (or (display-multi-frame-p frame) + (select-frame frame))))) + (`pushy + (switch-to-buffer man-buffer)) + (`bully + (and (frame-live-p saved-frame) + (select-frame saved-frame)) + (pop-to-buffer man-buffer) + (delete-other-windows)) + (`aggressive + (and (frame-live-p saved-frame) + (select-frame saved-frame)) + (pop-to-buffer man-buffer)) + (`friendly + (and (frame-live-p saved-frame) + (select-frame saved-frame)) + (display-buffer man-buffer 'not-this-window)) + (`polite + (beep) + (message "Manual buffer %s is ready" (buffer-name man-buffer))) + (`quiet + (message "Manual buffer %s is ready" (buffer-name man-buffer))) + (_ ;; meek + (message "")) + ))) (defun Man-softhyphen-to-minus () ;; \255 is SOFT HYPHEN in Latin-N. Versions of Debian man, at @@ -1061,14 +1060,14 @@ Same for the ANSI bold and normal escape sequences." (setq faces (cond ((match-beginning 2) - (delq (case (char-after (match-beginning 2)) + (delq (pcase (char-after (match-beginning 2)) (?2 Man-overstrike-face) (?4 Man-underline-face) (?7 Man-reverse-face)) faces)) ((eq (char-after (match-beginning 1)) ?0) nil) (t - (cons (case (char-after (match-beginning 1)) + (cons (pcase (char-after (match-beginning 1)) (?1 Man-overstrike-face) (?4 Man-underline-face) (?7 Man-reverse-face)) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index ec6a4621a4e..619510e8833 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -49,14 +49,14 @@ (setq menu-bar-final-items '(buffer services help-menu)) (setq menu-bar-final-items '(buffer services hide-app quit)) ;; Add standard top-level items to GNUstep menu. - (define-key global-map [menu-bar quit] - `(menu-item ,(purecopy "Quit") save-buffers-kill-emacs - :help ,(purecopy "Save unsaved buffers, then exit"))) - (define-key global-map [menu-bar hide-app] - `(menu-item ,(purecopy "Hide") ns-do-hide-emacs - :help ,(purecopy "Hide Emacs")))) - (define-key global-map [menu-bar services] ; set-up in ns-win - (cons (purecopy "Services") (make-sparse-keymap "Services")))) + (bindings--define-key global-map [menu-bar quit] + '(menu-item "Quit" save-buffers-kill-emacs + :help "Save unsaved buffers, then exit")) + (bindings--define-key global-map [menu-bar hide-app] + '(menu-item "Hide" ns-do-hide-emacs + :help "Hide Emacs"))) + (bindings--define-key global-map [menu-bar services] ; Set-up in ns-win. + (cons "Services" (make-sparse-keymap "Services")))) ;; This definition is just to show what this looks like. ;; It gets modified in place when menu-bar-update-buffers is called. @@ -69,85 +69,84 @@ (let ((menu (make-sparse-keymap "File"))) ;; The "File" menu items - (define-key menu [exit-emacs] - `(menu-item ,(purecopy "Quit") save-buffers-kill-terminal - :help ,(purecopy "Save unsaved buffers, then exit"))) + (bindings--define-key menu [exit-emacs] + '(menu-item "Quit" save-buffers-kill-terminal + :help "Save unsaved buffers, then exit")) - (define-key menu [separator-exit] + (bindings--define-key menu [separator-exit] menu-bar-separator) ;; Don't use delete-frame as event name because that is a special ;; event. - (define-key menu [delete-this-frame] - `(menu-item ,(purecopy "Delete Frame") delete-frame + (bindings--define-key menu [delete-this-frame] + '(menu-item "Delete Frame" delete-frame :visible (fboundp 'delete-frame) :enable (delete-frame-enabled-p) - :help ,(purecopy "Delete currently selected frame"))) - (define-key menu [make-frame-on-display] - `(menu-item ,(purecopy "New Frame on Display...") make-frame-on-display + :help "Delete currently selected frame")) + (bindings--define-key menu [make-frame-on-display] + '(menu-item "New Frame on Display..." make-frame-on-display :visible (fboundp 'make-frame-on-display) - :help ,(purecopy "Open a new frame on another display"))) - (define-key menu [make-frame] - `(menu-item ,(purecopy "New Frame") make-frame-command + :help "Open a new frame on another display")) + (bindings--define-key menu [make-frame] + '(menu-item "New Frame" make-frame-command :visible (fboundp 'make-frame-command) - :help ,(purecopy "Open a new frame"))) + :help "Open a new frame")) - (define-key menu [separator-frame] + (bindings--define-key menu [separator-frame] menu-bar-separator) - (define-key menu [one-window] - `(menu-item ,(purecopy "Remove Other Windows") delete-other-windows + (bindings--define-key menu [one-window] + '(menu-item "Remove Other Windows" delete-other-windows :enable (not (one-window-p t nil)) - :help ,(purecopy "Make selected window fill whole frame"))) + :help "Make selected window fill whole frame")) - (define-key menu [new-window-on-right] - `(menu-item ,(purecopy "New Window on Right") split-window-right + (bindings--define-key menu [new-window-on-right] + '(menu-item "New Window on Right" split-window-right :enable (and (menu-bar-menu-frame-live-and-visible-p) (menu-bar-non-minibuffer-window-p)) - :help ,(purecopy "Make new window on right of selected one"))) + :help "Make new window on right of selected one")) - (define-key menu [new-window-below] - `(menu-item ,(purecopy "New Window Below") split-window-below + (bindings--define-key menu [new-window-below] + '(menu-item "New Window Below" split-window-below :enable (and (menu-bar-menu-frame-live-and-visible-p) (menu-bar-non-minibuffer-window-p)) - :help ,(purecopy "Make new window below selected one"))) + :help "Make new window below selected one")) - (define-key menu [separator-window] + (bindings--define-key menu [separator-window] menu-bar-separator) - (define-key menu [ps-print-region] - `(menu-item ,(purecopy "PostScript Print Region (B+W)") ps-print-region + (bindings--define-key menu [ps-print-region] + '(menu-item "PostScript Print Region (B+W)" ps-print-region :enable mark-active - :help ,(purecopy "Pretty-print marked region in black and white to PostScript printer"))) - (define-key menu [ps-print-buffer] - `(menu-item ,(purecopy "PostScript Print Buffer (B+W)") ps-print-buffer + :help "Pretty-print marked region in black and white to PostScript printer")) + (bindings--define-key menu [ps-print-buffer] + '(menu-item "PostScript Print Buffer (B+W)" ps-print-buffer :enable (menu-bar-menu-frame-live-and-visible-p) - :help ,(purecopy "Pretty-print current buffer in black and white to PostScript printer"))) - (define-key menu [ps-print-region-faces] - `(menu-item ,(purecopy "PostScript Print Region") + :help "Pretty-print current buffer in black and white to PostScript printer")) + (bindings--define-key menu [ps-print-region-faces] + '(menu-item "PostScript Print Region" ps-print-region-with-faces :enable mark-active - :help ,(purecopy - "Pretty-print marked region to PostScript printer"))) - (define-key menu [ps-print-buffer-faces] - `(menu-item ,(purecopy "PostScript Print Buffer") + :help "Pretty-print marked region to PostScript printer")) + (bindings--define-key menu [ps-print-buffer-faces] + '(menu-item "PostScript Print Buffer" ps-print-buffer-with-faces :enable (menu-bar-menu-frame-live-and-visible-p) - :help ,(purecopy "Pretty-print current buffer to PostScript printer"))) - (define-key menu [print-region] - `(menu-item ,(purecopy "Print Region") print-region + :help "Pretty-print current buffer to PostScript printer")) + (bindings--define-key menu [print-region] + '(menu-item "Print Region" print-region :enable mark-active - :help ,(purecopy "Print region between mark and current position"))) - (define-key menu [print-buffer] - `(menu-item ,(purecopy "Print Buffer") print-buffer + :help "Print region between mark and current position")) + (bindings--define-key menu [print-buffer] + '(menu-item "Print Buffer" print-buffer :enable (menu-bar-menu-frame-live-and-visible-p) - :help ,(purecopy "Print current buffer with page headings"))) + :help "Print current buffer with page headings")) - (define-key menu [separator-print] + (bindings--define-key menu [separator-print] menu-bar-separator) - (define-key menu [recover-session] - `(menu-item ,(purecopy "Recover Crashed Session") recover-session + (bindings--define-key menu [recover-session] + '(menu-item "Recover Crashed Session" recover-session :enable (and auto-save-list-file-prefix (file-directory-p @@ -160,55 +159,52 @@ (file-name-nondirectory auto-save-list-file-prefix))) t)) - :help ,(purecopy "Recover edits from a crashed session"))) - (define-key menu [revert-buffer] - `(menu-item ,(purecopy "Revert Buffer") revert-buffer + :help "Recover edits from a crashed session")) + (bindings--define-key menu [revert-buffer] + '(menu-item "Revert Buffer" revert-buffer :enable (or revert-buffer-function revert-buffer-insert-file-contents-function (and buffer-file-number (or (buffer-modified-p) (not (verify-visited-file-modtime (current-buffer)))))) - :help ,(purecopy "Re-read current buffer from its file"))) - (define-key menu [write-file] - `(menu-item ,(purecopy "Save As...") write-file + :help "Re-read current buffer from its file")) + (bindings--define-key menu [write-file] + '(menu-item "Save As..." write-file :enable (and (menu-bar-menu-frame-live-and-visible-p) (menu-bar-non-minibuffer-window-p)) - :help ,(purecopy "Write current buffer to another file"))) - (define-key menu [save-buffer] - `(menu-item ,(purecopy "Save") save-buffer + :help "Write current buffer to another file")) + (bindings--define-key menu [save-buffer] + '(menu-item "Save" save-buffer :enable (and (buffer-modified-p) (buffer-file-name) (menu-bar-non-minibuffer-window-p)) - :help ,(purecopy "Save current buffer to its file"))) + :help "Save current buffer to its file")) - (define-key menu [separator-save] + (bindings--define-key menu [separator-save] menu-bar-separator) - (define-key menu [kill-buffer] - `(menu-item ,(purecopy "Close") kill-this-buffer + (bindings--define-key menu [kill-buffer] + '(menu-item "Close" kill-this-buffer :enable (kill-this-buffer-enabled-p) - :help ,(purecopy "Discard (kill) current buffer"))) - (define-key menu [insert-file] - `(menu-item ,(purecopy "Insert File...") insert-file + :help "Discard (kill) current buffer")) + (bindings--define-key menu [insert-file] + '(menu-item "Insert File..." insert-file :enable (menu-bar-non-minibuffer-window-p) - :help ,(purecopy "Insert another file into current buffer"))) - (define-key menu [dired] - `(menu-item ,(purecopy "Open Directory...") dired + :help "Insert another file into current buffer")) + (bindings--define-key menu [dired] + '(menu-item "Open Directory..." dired :enable (menu-bar-non-minibuffer-window-p) - :help ,(purecopy - "Read a directory, to operate on its files"))) - (define-key menu [open-file] - `(menu-item ,(purecopy "Open File...") menu-find-file-existing + :help "Read a directory, to operate on its files")) + (bindings--define-key menu [open-file] + '(menu-item "Open File..." menu-find-file-existing :enable (menu-bar-non-minibuffer-window-p) - :help ,(purecopy - "Read an existing file into an Emacs buffer"))) - (define-key menu [new-file] - `(menu-item ,(purecopy "Visit New File...") find-file + :help "Read an existing file into an Emacs buffer")) + (bindings--define-key menu [new-file] + '(menu-item "Visit New File..." find-file :enable (menu-bar-non-minibuffer-window-p) - :help ,(purecopy - "Specify a new file's name, to edit the file"))) + :help "Specify a new file's name, to edit the file")) menu)) @@ -291,148 +287,143 @@ ;; The Edit->Search->Incremental Search menu (defvar menu-bar-i-search-menu (let ((menu (make-sparse-keymap "Incremental Search"))) - (define-key menu [isearch-backward-regexp] - `(menu-item ,(purecopy "Backward Regexp...") isearch-backward-regexp - :help ,(purecopy - "Search backwards for a regular expression as you type it"))) - (define-key menu [isearch-forward-regexp] - `(menu-item ,(purecopy "Forward Regexp...") isearch-forward-regexp - :help ,(purecopy - "Search forward for a regular expression as you type it"))) - (define-key menu [isearch-backward] - `(menu-item ,(purecopy "Backward String...") isearch-backward - :help ,(purecopy "Search backwards for a string as you type it"))) - (define-key menu [isearch-forward] - `(menu-item ,(purecopy "Forward String...") isearch-forward - :help ,(purecopy "Search forward for a string as you type it"))) + (bindings--define-key menu [isearch-backward-regexp] + '(menu-item "Backward Regexp..." isearch-backward-regexp + :help "Search backwards for a regular expression as you type it")) + (bindings--define-key menu [isearch-forward-regexp] + '(menu-item "Forward Regexp..." isearch-forward-regexp + :help "Search forward for a regular expression as you type it")) + (bindings--define-key menu [isearch-backward] + '(menu-item "Backward String..." isearch-backward + :help "Search backwards for a string as you type it")) + (bindings--define-key menu [isearch-forward] + '(menu-item "Forward String..." isearch-forward + :help "Search forward for a string as you type it")) menu)) (defvar menu-bar-search-menu (let ((menu (make-sparse-keymap "Search"))) - (define-key menu [i-search] - `(menu-item ,(purecopy "Incremental Search") ,menu-bar-i-search-menu)) - (define-key menu [separator-tag-isearch] + (bindings--define-key menu [i-search] + `(menu-item "Incremental Search" ,menu-bar-i-search-menu)) + (bindings--define-key menu [separator-tag-isearch] menu-bar-separator) - (define-key menu [tags-continue] - `(menu-item ,(purecopy "Continue Tags Search") tags-loop-continue - :help ,(purecopy "Continue last tags search operation"))) - (define-key menu [tags-srch] - `(menu-item ,(purecopy "Search Tagged Files...") tags-search - :help ,(purecopy "Search for a regexp in all tagged files"))) - (define-key menu [separator-tag-search] menu-bar-separator) + (bindings--define-key menu [tags-continue] + '(menu-item "Continue Tags Search" tags-loop-continue + :help "Continue last tags search operation")) + (bindings--define-key menu [tags-srch] + '(menu-item "Search Tagged Files..." tags-search + :help "Search for a regexp in all tagged files")) + (bindings--define-key menu [separator-tag-search] menu-bar-separator) - (define-key menu [repeat-search-back] - `(menu-item ,(purecopy "Repeat Backwards") + (bindings--define-key menu [repeat-search-back] + '(menu-item "Repeat Backwards" nonincremental-repeat-search-backward :enable (or (and (eq menu-bar-last-search-type 'string) search-ring) (and (eq menu-bar-last-search-type 'regexp) regexp-search-ring)) - :help ,(purecopy "Repeat last search backwards"))) - (define-key menu [repeat-search-fwd] - `(menu-item ,(purecopy "Repeat Forward") + :help "Repeat last search backwards")) + (bindings--define-key menu [repeat-search-fwd] + '(menu-item "Repeat Forward" nonincremental-repeat-search-forward :enable (or (and (eq menu-bar-last-search-type 'string) search-ring) (and (eq menu-bar-last-search-type 'regexp) regexp-search-ring)) - :help ,(purecopy "Repeat last search forward"))) - (define-key menu [separator-repeat-search] + :help "Repeat last search forward")) + (bindings--define-key menu [separator-repeat-search] menu-bar-separator) - (define-key menu [re-search-backward] - `(menu-item ,(purecopy "Regexp Backwards...") + (bindings--define-key menu [re-search-backward] + '(menu-item "Regexp Backwards..." nonincremental-re-search-backward - :help ,(purecopy - "Search backwards for a regular expression"))) - (define-key menu [re-search-forward] - `(menu-item ,(purecopy "Regexp Forward...") + :help "Search backwards for a regular expression")) + (bindings--define-key menu [re-search-forward] + '(menu-item "Regexp Forward..." nonincremental-re-search-forward - :help ,(purecopy "Search forward for a regular expression"))) + :help "Search forward for a regular expression")) - (define-key menu [search-backward] - `(menu-item ,(purecopy "String Backwards...") + (bindings--define-key menu [search-backward] + '(menu-item "String Backwards..." nonincremental-search-backward - :help ,(purecopy "Search backwards for a string"))) - (define-key menu [search-forward] - `(menu-item ,(purecopy "String Forward...") nonincremental-search-forward - :help ,(purecopy "Search forward for a string"))) + :help "Search backwards for a string")) + (bindings--define-key menu [search-forward] + '(menu-item "String Forward..." nonincremental-search-forward + :help "Search forward for a string")) menu)) ;; The Edit->Replace submenu (defvar menu-bar-replace-menu (let ((menu (make-sparse-keymap "Replace"))) - (define-key menu [tags-repl-continue] - `(menu-item ,(purecopy "Continue Replace") tags-loop-continue - :help ,(purecopy "Continue last tags replace operation"))) - (define-key menu [tags-repl] - `(menu-item ,(purecopy "Replace in Tagged Files...") tags-query-replace - :help ,(purecopy - "Interactively replace a regexp in all tagged files"))) - (define-key menu [separator-replace-tags] + (bindings--define-key menu [tags-repl-continue] + '(menu-item "Continue Replace" tags-loop-continue + :help "Continue last tags replace operation")) + (bindings--define-key menu [tags-repl] + '(menu-item "Replace in Tagged Files..." tags-query-replace + :help "Interactively replace a regexp in all tagged files")) + (bindings--define-key menu [separator-replace-tags] menu-bar-separator) - (define-key menu [query-replace-regexp] - `(menu-item ,(purecopy "Replace Regexp...") query-replace-regexp + (bindings--define-key menu [query-replace-regexp] + '(menu-item "Replace Regexp..." query-replace-regexp :enable (not buffer-read-only) - :help ,(purecopy "Replace regular expression interactively, ask about each occurrence"))) - (define-key menu [query-replace] - `(menu-item ,(purecopy "Replace String...") query-replace + :help "Replace regular expression interactively, ask about each occurrence")) + (bindings--define-key menu [query-replace] + '(menu-item "Replace String..." query-replace :enable (not buffer-read-only) - :help ,(purecopy - "Replace string interactively, ask about each occurrence"))) + :help "Replace string interactively, ask about each occurrence")) menu)) ;;; Assemble the top-level Edit menu items. (defvar menu-bar-goto-menu (let ((menu (make-sparse-keymap "Go To"))) - (define-key menu [set-tags-name] - `(menu-item ,(purecopy "Set Tags File Name...") visit-tags-table - :help ,(purecopy "Tell Tags commands which tag table file to use"))) + (bindings--define-key menu [set-tags-name] + '(menu-item "Set Tags File Name..." visit-tags-table + :help "Tell Tags commands which tag table file to use")) - (define-key menu [separator-tag-file] + (bindings--define-key menu [separator-tag-file] menu-bar-separator) - (define-key menu [apropos-tags] - `(menu-item ,(purecopy "Tags Apropos...") tags-apropos - :help ,(purecopy "Find function/variables whose names match regexp"))) - (define-key menu [next-tag-otherw] - `(menu-item ,(purecopy "Next Tag in Other Window") + (bindings--define-key menu [apropos-tags] + '(menu-item "Tags Apropos..." tags-apropos + :help "Find function/variables whose names match regexp")) + (bindings--define-key menu [next-tag-otherw] + '(menu-item "Next Tag in Other Window" menu-bar-next-tag-other-window :enable (and (boundp 'tags-location-ring) (not (ring-empty-p tags-location-ring))) - :help ,(purecopy "Find next function/variable matching last tag name in another window"))) + :help "Find next function/variable matching last tag name in another window")) - (define-key menu [next-tag] - `(menu-item ,(purecopy "Find Next Tag") + (bindings--define-key menu [next-tag] + '(menu-item "Find Next Tag" menu-bar-next-tag :enable (and (boundp 'tags-location-ring) (not (ring-empty-p tags-location-ring))) - :help ,(purecopy "Find next function/variable matching last tag name"))) - (define-key menu [find-tag-otherw] - `(menu-item ,(purecopy "Find Tag in Other Window...") find-tag-other-window - :help ,(purecopy "Find function/variable definition in another window"))) - (define-key menu [find-tag] - `(menu-item ,(purecopy "Find Tag...") find-tag - :help ,(purecopy "Find definition of function or variable"))) + :help "Find next function/variable matching last tag name")) + (bindings--define-key menu [find-tag-otherw] + '(menu-item "Find Tag in Other Window..." find-tag-other-window + :help "Find function/variable definition in another window")) + (bindings--define-key menu [find-tag] + '(menu-item "Find Tag..." find-tag + :help "Find definition of function or variable")) - (define-key menu [separator-tags] + (bindings--define-key menu [separator-tags] menu-bar-separator) - (define-key menu [end-of-buf] - `(menu-item ,(purecopy "Goto End of Buffer") end-of-buffer)) - (define-key menu [beg-of-buf] - `(menu-item ,(purecopy "Goto Beginning of Buffer") beginning-of-buffer)) - (define-key menu [go-to-pos] - `(menu-item ,(purecopy "Goto Buffer Position...") goto-char - :help ,(purecopy "Read a number N and go to buffer position N"))) - (define-key menu [go-to-line] - `(menu-item ,(purecopy "Goto Line...") goto-line - :help ,(purecopy "Read a line number and go to that line"))) + (bindings--define-key menu [end-of-buf] + '(menu-item "Goto End of Buffer" end-of-buffer)) + (bindings--define-key menu [beg-of-buf] + '(menu-item "Goto Beginning of Buffer" beginning-of-buffer)) + (bindings--define-key menu [go-to-pos] + '(menu-item "Goto Buffer Position..." goto-char + :help "Read a number N and go to buffer position N")) + (bindings--define-key menu [go-to-line] + '(menu-item "Goto Line..." goto-line + :help "Read a line number and go to that line")) menu)) @@ -442,59 +433,59 @@ (defvar menu-bar-edit-menu (let ((menu (make-sparse-keymap "Edit"))) - (define-key menu [props] - `(menu-item ,(purecopy "Text Properties") facemenu-menu)) + (bindings--define-key menu [props] + `(menu-item "Text Properties" facemenu-menu)) ;; ns-win.el said: Add spell for platform consistency. (if (featurep 'ns) - (define-key menu [spell] - `(menu-item ,(purecopy "Spell") ispell-menu-map))) + (bindings--define-key menu [spell] + `(menu-item "Spell" ispell-menu-map))) - (define-key menu [fill] - `(menu-item ,(purecopy "Fill") fill-region + (bindings--define-key menu [fill] + `(menu-item "Fill" fill-region :enable (and mark-active (not buffer-read-only)) :help - ,(purecopy "Fill text in region to fit between left and right margin"))) + "Fill text in region to fit between left and right margin")) - (define-key menu [separator-bookmark] + (bindings--define-key menu [separator-bookmark] menu-bar-separator) - (define-key menu [bookmark] - `(menu-item ,(purecopy "Bookmarks") menu-bar-bookmark-map)) + (bindings--define-key menu [bookmark] + `(menu-item "Bookmarks" menu-bar-bookmark-map)) - (define-key menu [goto] - `(menu-item ,(purecopy "Go To") ,menu-bar-goto-menu)) + (bindings--define-key menu [goto] + `(menu-item "Go To" ,menu-bar-goto-menu)) - (define-key menu [replace] - `(menu-item ,(purecopy "Replace") ,menu-bar-replace-menu)) + (bindings--define-key menu [replace] + `(menu-item "Replace" ,menu-bar-replace-menu)) - (define-key menu [search] - `(menu-item ,(purecopy "Search") ,menu-bar-search-menu)) + (bindings--define-key menu [search] + `(menu-item "Search" ,menu-bar-search-menu)) - (define-key menu [separator-search] + (bindings--define-key menu [separator-search] menu-bar-separator) - (define-key menu [mark-whole-buffer] - `(menu-item ,(purecopy "Select All") mark-whole-buffer - :help ,(purecopy "Mark the whole buffer for a subsequent cut/copy"))) - (define-key menu [clear] - `(menu-item ,(purecopy "Clear") delete-region + (bindings--define-key menu [mark-whole-buffer] + '(menu-item "Select All" mark-whole-buffer + :help "Mark the whole buffer for a subsequent cut/copy")) + (bindings--define-key menu [clear] + '(menu-item "Clear" delete-region :enable (and mark-active (not buffer-read-only)) :help - ,(purecopy "Delete the text in region between mark and current position"))) + "Delete the text in region between mark and current position")) - (define-key menu (if (featurep 'ns) [select-paste] + (bindings--define-key menu (if (featurep 'ns) [select-paste] [paste-from-menu]) ;; ns-win.el said: Change text to be more consistent with ;; surrounding menu items `paste', etc." - `(menu-item ,(purecopy (if (featurep 'ns) "Select and Paste" - "Paste from Kill Menu")) yank-menu - :enable (and (cdr yank-menu) (not buffer-read-only)) - :help ,(purecopy "Choose a string from the kill ring and paste it"))) - (define-key menu [paste] - `(menu-item ,(purecopy "Paste") yank + `(menu-item ,(if (featurep 'ns) "Select and Paste" + "Paste from Kill Menu") yank-menu + :enable (and (cdr yank-menu) (not buffer-read-only)) + :help "Choose a string from the kill ring and paste it")) + (bindings--define-key menu [paste] + '(menu-item "Paste" yank :enable (and (or ;; Emacs compiled --without-x (or --with-ns) ;; doesn't have x-selection-exists-p. @@ -504,35 +495,35 @@ (cdr yank-menu) kill-ring)) (not buffer-read-only)) - :help ,(purecopy "Paste (yank) text most recently cut/copied"))) - (define-key menu [copy] + :help "Paste (yank) text most recently cut/copied")) + (bindings--define-key menu [copy] ;; ns-win.el said: Substitute a Copy function that works better ;; under X (for GNUstep). - `(menu-item ,(purecopy "Copy") ,(if (featurep 'ns) - 'ns-copy-including-secondary - 'kill-ring-save) + `(menu-item "Copy" ,(if (featurep 'ns) + 'ns-copy-including-secondary + 'kill-ring-save) :enable mark-active - :help ,(purecopy "Copy text in region between mark and current position") - :keys ,(purecopy (if (featurep 'ns) - "\\[ns-copy-including-secondary]" - "\\[kill-ring-save]")))) - (define-key menu [cut] - `(menu-item ,(purecopy "Cut") kill-region + :help "Copy text in region between mark and current position" + :keys ,(if (featurep 'ns) + "\\[ns-copy-including-secondary]" + "\\[kill-ring-save]"))) + (bindings--define-key menu [cut] + '(menu-item "Cut" kill-region :enable (and mark-active (not buffer-read-only)) :help - ,(purecopy "Cut (kill) text in region between mark and current position"))) + "Cut (kill) text in region between mark and current position")) ;; ns-win.el said: Separate undo from cut/paste section. (if (featurep 'ns) - (define-key menu [separator-undo] menu-bar-separator)) + (bindings--define-key menu [separator-undo] menu-bar-separator)) - (define-key menu [undo] - `(menu-item ,(purecopy "Undo") undo + (bindings--define-key menu [undo] + '(menu-item "Undo" undo :enable (and (not buffer-read-only) (not (eq t buffer-undo-list)) (if (eq last-command 'undo) (listp pending-undo-list) (consp buffer-undo-list))) - :help ,(purecopy "Undo last operation"))) + :help "Undo last operation")) menu)) @@ -598,45 +589,45 @@ Do the same for the keys of the same name." (defvar menu-bar-custom-menu (let ((menu (make-sparse-keymap "Customize"))) - (define-key menu [customize-apropos-faces] - `(menu-item ,(purecopy "Faces Matching...") customize-apropos-faces - :help ,(purecopy "Browse faces matching a regexp or word list"))) - (define-key menu [customize-apropos-options] - `(menu-item ,(purecopy "Options Matching...") customize-apropos-options - :help ,(purecopy "Browse options matching a regexp or word list"))) - (define-key menu [customize-apropos] - `(menu-item ,(purecopy "All Settings Matching...") customize-apropos - :help ,(purecopy "Browse customizable settings matching a regexp or word list"))) - (define-key menu [separator-1] + (bindings--define-key menu [customize-apropos-faces] + '(menu-item "Faces Matching..." customize-apropos-faces + :help "Browse faces matching a regexp or word list")) + (bindings--define-key menu [customize-apropos-options] + '(menu-item "Options Matching..." customize-apropos-options + :help "Browse options matching a regexp or word list")) + (bindings--define-key menu [customize-apropos] + '(menu-item "All Settings Matching..." customize-apropos + :help "Browse customizable settings matching a regexp or word list")) + (bindings--define-key menu [separator-1] menu-bar-separator) - (define-key menu [customize-group] - `(menu-item ,(purecopy "Specific Group...") customize-group - :help ,(purecopy "Customize settings of specific group"))) - (define-key menu [customize-face] - `(menu-item ,(purecopy "Specific Face...") customize-face - :help ,(purecopy "Customize attributes of specific face"))) - (define-key menu [customize-option] - `(menu-item ,(purecopy "Specific Option...") customize-option - :help ,(purecopy "Customize value of specific option"))) - (define-key menu [separator-2] + (bindings--define-key menu [customize-group] + '(menu-item "Specific Group..." customize-group + :help "Customize settings of specific group")) + (bindings--define-key menu [customize-face] + '(menu-item "Specific Face..." customize-face + :help "Customize attributes of specific face")) + (bindings--define-key menu [customize-option] + '(menu-item "Specific Option..." customize-option + :help "Customize value of specific option")) + (bindings--define-key menu [separator-2] menu-bar-separator) - (define-key menu [customize-changed-options] - `(menu-item ,(purecopy "New Options...") customize-changed-options - :help ,(purecopy "Options added or changed in recent Emacs versions"))) - (define-key menu [customize-saved] - `(menu-item ,(purecopy "Saved Options") customize-saved - :help ,(purecopy "Customize previously saved options"))) - (define-key menu [separator-3] + (bindings--define-key menu [customize-changed-options] + '(menu-item "New Options..." customize-changed-options + :help "Options added or changed in recent Emacs versions")) + (bindings--define-key menu [customize-saved] + '(menu-item "Saved Options" customize-saved + :help "Customize previously saved options")) + (bindings--define-key menu [separator-3] menu-bar-separator) - (define-key menu [customize-browse] - `(menu-item ,(purecopy "Browse Customization Groups") customize-browse - :help ,(purecopy "Browse all customization groups"))) - (define-key menu [customize] - `(menu-item ,(purecopy "Top-level Customization Group") customize - :help ,(purecopy "The master group called `Emacs'"))) - (define-key menu [customize-themes] - `(menu-item ,(purecopy "Custom Themes") customize-themes - :help ,(purecopy "Choose a pre-defined customization theme"))) + (bindings--define-key menu [customize-browse] + '(menu-item "Browse Customization Groups" customize-browse + :help "Browse all customization groups")) + (bindings--define-key menu [customize] + '(menu-item "Top-level Customization Group" customize + :help "The master group called `Emacs'")) + (bindings--define-key menu [customize-themes] + '(menu-item "Custom Themes" customize-themes + :help "Choose a pre-defined customization theme")) menu)) ;(defvar menu-bar-preferences-menu (make-sparse-keymap "Preferences")) @@ -646,9 +637,9 @@ FNAME is the minor mode's name (variable and function). DOC is the text to use for the menu entry. HELP is the text to use for the tooltip. PROPS are additional properties." - `(list 'menu-item (purecopy ,doc) ',fname + `(list 'menu-item ,doc ',fname ,@(mapcar (lambda (p) (list 'quote p)) props) - :help (purecopy ,help) + :help ,help :button '(:toggle . (and (default-boundp ',fname) (default-value ',fname))))) @@ -673,8 +664,8 @@ by \"Save Options\" in Custom buffers.") ;; a candidate for "Save Options", and we do not want to save options ;; the user have already set explicitly in his init file. (if interactively (customize-mark-as-set ',variable))) - (list 'menu-item (purecopy ,doc) ',name - :help (purecopy ,help) + (list 'menu-item ,doc ',name + :help ,help :button '(:toggle . (and (default-boundp ',variable) (default-value ',variable)))))) @@ -775,46 +766,46 @@ by \"Save Options\" in Custom buffers.") (defvar menu-bar-showhide-fringe-ind-menu (let ((menu (make-sparse-keymap "Buffer boundaries"))) - (define-key menu [customize] - `(menu-item ,(purecopy "Other (Customize)") + (bindings--define-key menu [customize] + '(menu-item "Other (Customize)" menu-bar-showhide-fringe-ind-customize - :help ,(purecopy "Additional choices available through Custom buffer") + :help "Additional choices available through Custom buffer" :visible (display-graphic-p) :button (:radio . (not (member indicate-buffer-boundaries '(nil left right ((top . left) (bottom . right)) ((t . right) (top . left)))))))) - (define-key menu [mixed] - `(menu-item ,(purecopy "Opposite, Arrows Right") menu-bar-showhide-fringe-ind-mixed + (bindings--define-key menu [mixed] + '(menu-item "Opposite, Arrows Right" menu-bar-showhide-fringe-ind-mixed :help - ,(purecopy "Show top/bottom indicators in opposite fringes, arrows in right") + "Show top/bottom indicators in opposite fringes, arrows in right" :visible (display-graphic-p) :button (:radio . (equal indicate-buffer-boundaries '((t . right) (top . left)))))) - (define-key menu [box] - `(menu-item ,(purecopy "Opposite, No Arrows") menu-bar-showhide-fringe-ind-box - :help ,(purecopy "Show top/bottom indicators in opposite fringes, no arrows") + (bindings--define-key menu [box] + '(menu-item "Opposite, No Arrows" menu-bar-showhide-fringe-ind-box + :help "Show top/bottom indicators in opposite fringes, no arrows" :visible (display-graphic-p) :button (:radio . (equal indicate-buffer-boundaries '((top . left) (bottom . right)))))) - (define-key menu [right] - `(menu-item ,(purecopy "In Right Fringe") menu-bar-showhide-fringe-ind-right - :help ,(purecopy "Show buffer boundaries and arrows in right fringe") + (bindings--define-key menu [right] + '(menu-item "In Right Fringe" menu-bar-showhide-fringe-ind-right + :help "Show buffer boundaries and arrows in right fringe" :visible (display-graphic-p) :button (:radio . (eq indicate-buffer-boundaries 'right)))) - (define-key menu [left] - `(menu-item ,(purecopy "In Left Fringe") menu-bar-showhide-fringe-ind-left - :help ,(purecopy "Show buffer boundaries and arrows in left fringe") + (bindings--define-key menu [left] + '(menu-item "In Left Fringe" menu-bar-showhide-fringe-ind-left + :help "Show buffer boundaries and arrows in left fringe" :visible (display-graphic-p) :button (:radio . (eq indicate-buffer-boundaries 'left)))) - (define-key menu [none] - `(menu-item ,(purecopy "No Indicators") menu-bar-showhide-fringe-ind-none - :help ,(purecopy "Hide all buffer boundary indicators and arrows") + (bindings--define-key menu [none] + '(menu-item "No Indicators" menu-bar-showhide-fringe-ind-none + :help "Hide all buffer boundary indicators and arrows" :visible (display-graphic-p) :button (:radio . (eq indicate-buffer-boundaries nil)))) menu)) @@ -850,43 +841,43 @@ by \"Save Options\" in Custom buffers.") (defvar menu-bar-showhide-fringe-menu (let ((menu (make-sparse-keymap "Fringe"))) - (define-key menu [showhide-fringe-ind] - `(menu-item ,(purecopy "Buffer Boundaries") ,menu-bar-showhide-fringe-ind-menu + (bindings--define-key menu [showhide-fringe-ind] + `(menu-item "Buffer Boundaries" ,menu-bar-showhide-fringe-ind-menu :visible (display-graphic-p) - :help ,(purecopy "Indicate buffer boundaries in fringe"))) + :help "Indicate buffer boundaries in fringe")) - (define-key menu [indicate-empty-lines] + (bindings--define-key menu [indicate-empty-lines] (menu-bar-make-toggle toggle-indicate-empty-lines indicate-empty-lines "Empty Line Indicators" "Indicating of empty lines %s" "Indicate trailing empty lines in fringe, globally")) - (define-key menu [customize] - `(menu-item ,(purecopy "Customize Fringe") menu-bar-showhide-fringe-menu-customize - :help ,(purecopy "Detailed customization of fringe") + (bindings--define-key menu [customize] + '(menu-item "Customize Fringe" menu-bar-showhide-fringe-menu-customize + :help "Detailed customization of fringe" :visible (display-graphic-p))) - (define-key menu [default] - `(menu-item ,(purecopy "Default") menu-bar-showhide-fringe-menu-customize-reset - :help ,(purecopy "Default width fringe on both left and right side") + (bindings--define-key menu [default] + '(menu-item "Default" menu-bar-showhide-fringe-menu-customize-reset + :help "Default width fringe on both left and right side" :visible (display-graphic-p) :button (:radio . (eq fringe-mode nil)))) - (define-key menu [right] - `(menu-item ,(purecopy "On the Right") menu-bar-showhide-fringe-menu-customize-right - :help ,(purecopy "Fringe only on the right side") + (bindings--define-key menu [right] + '(menu-item "On the Right" menu-bar-showhide-fringe-menu-customize-right + :help "Fringe only on the right side" :visible (display-graphic-p) :button (:radio . (equal fringe-mode '(0 . nil))))) - (define-key menu [left] - `(menu-item ,(purecopy "On the Left") menu-bar-showhide-fringe-menu-customize-left - :help ,(purecopy "Fringe only on the left side") + (bindings--define-key menu [left] + '(menu-item "On the Left" menu-bar-showhide-fringe-menu-customize-left + :help "Fringe only on the left side" :visible (display-graphic-p) :button (:radio . (equal fringe-mode '(nil . 0))))) - (define-key menu [none] - `(menu-item ,(purecopy "None") menu-bar-showhide-fringe-menu-customize-disable - :help ,(purecopy "Turn off fringe") + (bindings--define-key menu [none] + '(menu-item "None" menu-bar-showhide-fringe-menu-customize-disable + :help "Turn off fringe" :visible (display-graphic-p) :button (:radio . (eq fringe-mode 0)))) menu)) @@ -909,26 +900,26 @@ by \"Save Options\" in Custom buffers.") (defvar menu-bar-showhide-scroll-bar-menu (let ((menu (make-sparse-keymap "Scroll-bar"))) - (define-key menu [right] - `(menu-item ,(purecopy "On the Right") + (bindings--define-key menu [right] + '(menu-item "On the Right" menu-bar-right-scroll-bar - :help ,(purecopy "Scroll-bar on the right side") + :help "Scroll-bar on the right side" :visible (display-graphic-p) :button (:radio . (eq (cdr (assq 'vertical-scroll-bars (frame-parameters))) 'right)))) - (define-key menu [left] - `(menu-item ,(purecopy "On the Left") + (bindings--define-key menu [left] + '(menu-item "On the Left" menu-bar-left-scroll-bar - :help ,(purecopy "Scroll-bar on the left side") + :help "Scroll-bar on the left side" :visible (display-graphic-p) :button (:radio . (eq (cdr (assq 'vertical-scroll-bars (frame-parameters))) 'left)))) - (define-key menu [none] - `(menu-item ,(purecopy "None") + (bindings--define-key menu [none] + '(menu-item "None" menu-bar-no-scroll-bar - :help ,(purecopy "Turn off scroll-bar") + :help "Turn off scroll-bar" :visible (display-graphic-p) :button (:radio . (eq (cdr (assq 'vertical-scroll-bars (frame-parameters))) nil)))) @@ -973,10 +964,10 @@ by \"Save Options\" in Custom buffers.") (defvar menu-bar-showhide-tool-bar-menu (let ((menu (make-sparse-keymap "Tool-bar"))) - (define-key menu [showhide-tool-bar-left] - `(menu-item ,(purecopy "On the Left") + (bindings--define-key menu [showhide-tool-bar-left] + '(menu-item "On the Left" menu-bar-showhide-tool-bar-menu-customize-enable-left - :help ,(purecopy "Tool-bar at the left side") + :help "Tool-bar at the left side" :visible (display-graphic-p) :button (:radio . (and tool-bar-mode @@ -985,10 +976,10 @@ by \"Save Options\" in Custom buffers.") 'tool-bar-position) 'left))))) - (define-key menu [showhide-tool-bar-right] - `(menu-item ,(purecopy "On the Right") + (bindings--define-key menu [showhide-tool-bar-right] + '(menu-item "On the Right" menu-bar-showhide-tool-bar-menu-customize-enable-right - :help ,(purecopy "Tool-bar at the right side") + :help "Tool-bar at the right side" :visible (display-graphic-p) :button (:radio . (and tool-bar-mode @@ -997,10 +988,10 @@ by \"Save Options\" in Custom buffers.") 'tool-bar-position) 'right))))) - (define-key menu [showhide-tool-bar-bottom] - `(menu-item ,(purecopy "On the Bottom") + (bindings--define-key menu [showhide-tool-bar-bottom] + '(menu-item "On the Bottom" menu-bar-showhide-tool-bar-menu-customize-enable-bottom - :help ,(purecopy "Tool-bar at the bottom") + :help "Tool-bar at the bottom" :visible (display-graphic-p) :button (:radio . (and tool-bar-mode @@ -1009,10 +1000,10 @@ by \"Save Options\" in Custom buffers.") 'tool-bar-position) 'bottom))))) - (define-key menu [showhide-tool-bar-top] - `(menu-item ,(purecopy "On the Top") + (bindings--define-key menu [showhide-tool-bar-top] + '(menu-item "On the Top" menu-bar-showhide-tool-bar-menu-customize-enable-top - :help ,(purecopy "Tool-bar at the top") + :help "Tool-bar at the top" :visible (display-graphic-p) :button (:radio . (and tool-bar-mode @@ -1021,10 +1012,10 @@ by \"Save Options\" in Custom buffers.") 'tool-bar-position) 'top))))) - (define-key menu [showhide-tool-bar-none] - `(menu-item ,(purecopy "None") + (bindings--define-key menu [showhide-tool-bar-none] + '(menu-item "None" menu-bar-showhide-tool-bar-menu-customize-disable - :help ,(purecopy "Turn tool-bar off") + :help "Turn tool-bar off" :visible (display-graphic-p) :button (:radio . (eq tool-bar-mode nil)))) menu))) @@ -1032,64 +1023,64 @@ by \"Save Options\" in Custom buffers.") (defvar menu-bar-showhide-menu (let ((menu (make-sparse-keymap "Show/Hide"))) - (define-key menu [column-number-mode] + (bindings--define-key menu [column-number-mode] (menu-bar-make-mm-toggle column-number-mode "Column Numbers" "Show the current column number in the mode line")) - (define-key menu [line-number-mode] + (bindings--define-key menu [line-number-mode] (menu-bar-make-mm-toggle line-number-mode "Line Numbers" "Show the current line number in the mode line")) - (define-key menu [size-indication-mode] + (bindings--define-key menu [size-indication-mode] (menu-bar-make-mm-toggle size-indication-mode "Size Indication" "Show the size of the buffer in the mode line")) - (define-key menu [linecolumn-separator] + (bindings--define-key menu [linecolumn-separator] menu-bar-separator) - (define-key menu [showhide-battery] + (bindings--define-key menu [showhide-battery] (menu-bar-make-mm-toggle display-battery-mode "Battery Status" "Display battery status information in mode line")) - (define-key menu [showhide-date-time] + (bindings--define-key menu [showhide-date-time] (menu-bar-make-mm-toggle display-time-mode "Time, Load and Mail" "Display time, system load averages and \ mail status in mode line")) - (define-key menu [datetime-separator] + (bindings--define-key menu [datetime-separator] menu-bar-separator) - (define-key menu [showhide-speedbar] - `(menu-item ,(purecopy "Speedbar") speedbar-frame-mode - :help ,(purecopy "Display a Speedbar quick-navigation frame") + (bindings--define-key menu [showhide-speedbar] + '(menu-item "Speedbar" speedbar-frame-mode + :help "Display a Speedbar quick-navigation frame" :button (:toggle . (and (boundp 'speedbar-frame) (frame-live-p (symbol-value 'speedbar-frame)) (frame-visible-p (symbol-value 'speedbar-frame)))))) - (define-key menu [showhide-fringe] - `(menu-item ,(purecopy "Fringe") ,menu-bar-showhide-fringe-menu + (bindings--define-key menu [showhide-fringe] + `(menu-item "Fringe" ,menu-bar-showhide-fringe-menu :visible (display-graphic-p))) - (define-key menu [showhide-scroll-bar] - `(menu-item ,(purecopy "Scroll-bar") ,menu-bar-showhide-scroll-bar-menu + (bindings--define-key menu [showhide-scroll-bar] + `(menu-item "Scroll-bar" ,menu-bar-showhide-scroll-bar-menu :visible (display-graphic-p))) - (define-key menu [showhide-tooltip-mode] - `(menu-item ,(purecopy "Tooltips") tooltip-mode - :help ,(purecopy "Turn tooltips on/off") + (bindings--define-key menu [showhide-tooltip-mode] + '(menu-item "Tooltips" tooltip-mode + :help "Turn tooltips on/off" :visible (and (display-graphic-p) (fboundp 'x-show-tip)) :button (:toggle . tooltip-mode))) - (define-key menu [menu-bar-mode] - `(menu-item ,(purecopy "Menu-bar") toggle-menu-bar-mode-from-frame - :help ,(purecopy "Turn menu-bar on/off") + (bindings--define-key menu [menu-bar-mode] + '(menu-item "Menu-bar" toggle-menu-bar-mode-from-frame + :help "Turn menu-bar on/off" :button (:toggle . (menu-bar-positive-p (frame-parameter (menu-bar-frame-for-menubar) @@ -1097,13 +1088,13 @@ mail status in mode line")) (if (and (boundp 'menu-bar-showhide-tool-bar-menu) (keymapp menu-bar-showhide-tool-bar-menu)) - (define-key menu [showhide-tool-bar] - `(menu-item ,(purecopy "Tool-bar") ,menu-bar-showhide-tool-bar-menu + (bindings--define-key menu [showhide-tool-bar] + `(menu-item "Tool-bar" ,menu-bar-showhide-tool-bar-menu :visible (display-graphic-p))) ;; else not tool bar that can move. - (define-key menu [showhide-tool-bar] - `(menu-item ,(purecopy "Tool-bar") toggle-tool-bar-mode-from-frame - :help ,(purecopy "Turn tool-bar on/off") + (bindings--define-key menu [showhide-tool-bar] + '(menu-item "Tool-bar" toggle-tool-bar-mode-from-frame + :help "Turn tool-bar on/off" :visible (display-graphic-p) :button (:toggle . (menu-bar-positive-p @@ -1123,119 +1114,120 @@ mail status in mode line")) (defvar menu-bar-line-wrapping-menu (let ((menu (make-sparse-keymap "Line Wrapping"))) - (define-key menu [word-wrap] - `(menu-item - ,(purecopy "Word Wrap (Visual Line mode)") - (lambda () - (interactive) - (unless visual-line-mode - (visual-line-mode 1)) - (message ,(purecopy "Visual-Line mode enabled"))) - :help ,(purecopy "Wrap long lines at word boundaries") - :button (:radio . (and (null truncate-lines) - (not (truncated-partial-width-window-p)) - word-wrap)) - :visible (menu-bar-menu-frame-live-and-visible-p))) + (bindings--define-key menu [word-wrap] + `(menu-item "Word Wrap (Visual Line mode)" + ,(lambda () + (interactive) + (unless visual-line-mode + (visual-line-mode 1)) + (message "Visual-Line mode enabled")) + :help "Wrap long lines at word boundaries" + :button (:radio + . (and (null truncate-lines) + (not (truncated-partial-width-window-p)) + word-wrap)) + :visible (menu-bar-menu-frame-live-and-visible-p))) - (define-key menu [truncate] - `(menu-item ,(purecopy "Truncate Long Lines") - (lambda () - (interactive) - (if visual-line-mode (visual-line-mode 0)) - (setq word-wrap nil) - (toggle-truncate-lines 1)) - :help ,(purecopy "Truncate long lines at window edge") + (bindings--define-key menu [truncate] + `(menu-item "Truncate Long Lines" + ,(lambda () + (interactive) + (if visual-line-mode (visual-line-mode 0)) + (setq word-wrap nil) + (toggle-truncate-lines 1)) + :help "Truncate long lines at window edge" :button (:radio . (or truncate-lines (truncated-partial-width-window-p))) :visible (menu-bar-menu-frame-live-and-visible-p) :enable (not (truncated-partial-width-window-p)))) - (define-key menu [window-wrap] - `(menu-item ,(purecopy "Wrap at Window Edge") - (lambda () (interactive) - (if visual-line-mode (visual-line-mode 0)) - (setq word-wrap nil) - (if truncate-lines (toggle-truncate-lines -1))) - :help ,(purecopy "Wrap long lines at window edge") - :button (:radio . (and (null truncate-lines) - (not (truncated-partial-width-window-p)) - (not word-wrap))) + (bindings--define-key menu [window-wrap] + `(menu-item "Wrap at Window Edge" + ,(lambda () (interactive) + (if visual-line-mode (visual-line-mode 0)) + (setq word-wrap nil) + (if truncate-lines (toggle-truncate-lines -1))) + :help "Wrap long lines at window edge" + :button (:radio + . (and (null truncate-lines) + (not (truncated-partial-width-window-p)) + (not word-wrap))) :visible (menu-bar-menu-frame-live-and-visible-p) :enable (not (truncated-partial-width-window-p)))) menu)) (defvar menu-bar-options-menu (let ((menu (make-sparse-keymap "Options"))) - (define-key menu [customize] - `(menu-item ,(purecopy "Customize Emacs") ,menu-bar-custom-menu)) + (bindings--define-key menu [customize] + `(menu-item "Customize Emacs" ,menu-bar-custom-menu)) - (define-key menu [package] + (bindings--define-key menu [package] '(menu-item "Manage Emacs Packages" package-list-packages :help "Install or uninstall additional Emacs packages")) - (define-key menu [save] - `(menu-item ,(purecopy "Save Options") menu-bar-options-save - :help ,(purecopy "Save options set from the menu above"))) + (bindings--define-key menu [save] + '(menu-item "Save Options" menu-bar-options-save + :help "Save options set from the menu above")) - (define-key menu [custom-separator] + (bindings--define-key menu [custom-separator] menu-bar-separator) - (define-key menu [menu-set-font] - `(menu-item ,(purecopy "Set Default Font...") menu-set-font + (bindings--define-key menu [menu-set-font] + '(menu-item "Set Default Font..." menu-set-font :visible (display-multi-font-p) - :help ,(purecopy "Select a default font"))) + :help "Select a default font")) (if (featurep 'system-font-setting) - (define-key menu [menu-system-font] + (bindings--define-key menu [menu-system-font] (menu-bar-make-toggle toggle-use-system-font font-use-system-font "Use System Font" "Use system font: %s" "Use the monospaced font defined by the system"))) - (define-key menu [showhide] - `(menu-item ,(purecopy "Show/Hide") ,menu-bar-showhide-menu)) + (bindings--define-key menu [showhide] + `(menu-item "Show/Hide" ,menu-bar-showhide-menu)) - (define-key menu [showhide-separator] + (bindings--define-key menu [showhide-separator] menu-bar-separator) - (define-key menu [mule] + (bindings--define-key menu [mule] ;; It is better not to use backquote here, ;; because that makes a bootstrapping problem ;; if you need to recompile all the Lisp files using interpreted code. - `(menu-item ,(purecopy "Multilingual Environment") ,mule-menu-keymap + `(menu-item "Multilingual Environment" ,mule-menu-keymap ;; Most of the MULE menu actually does make sense in ;; unibyte mode, e.g. language selection. ;; :visible '(default-value 'enable-multibyte-characters) )) ;;(setq menu-bar-final-items (cons 'mule menu-bar-final-items)) - ;;(define-key menu [preferences] - ;; `(menu-item ,(purecopy "Preferences") ,menu-bar-preferences-menu - ;; :help ,(purecopy "Toggle important global options"))) + ;;(bindings--define-key menu [preferences] + ;; `(menu-item "Preferences" ,menu-bar-preferences-menu + ;; :help "Toggle important global options")) - (define-key menu [mule-separator] + (bindings--define-key menu [mule-separator] menu-bar-separator) - (define-key menu [debug-on-quit] + (bindings--define-key menu [debug-on-quit] (menu-bar-make-toggle toggle-debug-on-quit debug-on-quit "Enter Debugger on Quit/C-g" "Debug on Quit %s" "Enter Lisp debugger when C-g is pressed")) - (define-key menu [debug-on-error] + (bindings--define-key menu [debug-on-error] (menu-bar-make-toggle toggle-debug-on-error debug-on-error "Enter Debugger on Error" "Debug on Error %s" "Enter Lisp debugger when an error is signaled")) - (define-key menu [debugger-separator] + (bindings--define-key menu [debugger-separator] menu-bar-separator) - (define-key menu [blink-cursor-mode] + (bindings--define-key menu [blink-cursor-mode] (menu-bar-make-mm-toggle blink-cursor-mode "Blink Cursor" "Whether the cursor blinks (Blink Cursor mode)")) - (define-key menu [cursor-separator] + (bindings--define-key menu [cursor-separator] menu-bar-separator) - (define-key menu [save-place] + (bindings--define-key menu [save-place] (menu-bar-make-toggle toggle-save-place-globally save-place "Save Place in Files between Sessions" @@ -1247,7 +1239,7 @@ mail status in mode line")) (set-default 'save-place (not (symbol-value 'save-place))))) - (define-key menu [uniquify] + (bindings--define-key menu [uniquify] (menu-bar-make-toggle toggle-uniquify-buffer-names uniquify-buffer-name-style "Use Directory Names in Buffer Names" @@ -1258,9 +1250,9 @@ mail status in mode line")) (if (not uniquify-buffer-name-style) 'forward)))) - (define-key menu [edit-options-separator] + (bindings--define-key menu [edit-options-separator] menu-bar-separator) - (define-key menu [cua-mode] + (bindings--define-key menu [cua-mode] (menu-bar-make-mm-toggle cua-mode "Use CUA Keys (Cut/Paste with C-x/C-c/C-v)" @@ -1268,7 +1260,7 @@ mail status in mode line")) (:visible (or (not (boundp 'cua-enable-cua-keys)) cua-enable-cua-keys)))) - (define-key menu [cua-emulation-mode] + (bindings--define-key menu [cua-emulation-mode] (menu-bar-make-mm-toggle cua-mode "Shift movement mark region (CUA)" @@ -1276,35 +1268,35 @@ mail status in mode line")) (:visible (and (boundp 'cua-enable-cua-keys) (not cua-enable-cua-keys))))) - (define-key menu [case-fold-search] + (bindings--define-key menu [case-fold-search] (menu-bar-make-toggle toggle-case-fold-search case-fold-search "Ignore Case for Search" "Case-Insensitive Search %s" "Ignore letter-case in search commands")) - (define-key menu [auto-fill-mode] - `(menu-item - ,(purecopy "Auto Fill in Text Modes") + (bindings--define-key menu [auto-fill-mode] + '(menu-item + "Auto Fill in Text Modes" menu-bar-text-mode-auto-fill - :help ,(purecopy "Automatically fill text while typing (Auto Fill mode)") + :help "Automatically fill text while typing (Auto Fill mode)" :button (:toggle . (if (listp text-mode-hook) (member 'turn-on-auto-fill text-mode-hook) (eq 'turn-on-auto-fill text-mode-hook))))) - (define-key menu [line-wrapping] - `(menu-item ,(purecopy "Line Wrapping in This Buffer") + (bindings--define-key menu [line-wrapping] + `(menu-item "Line Wrapping in This Buffer" ,menu-bar-line-wrapping-menu)) - (define-key menu [highlight-separator] + (bindings--define-key menu [highlight-separator] menu-bar-separator) - (define-key menu [highlight-paren-mode] + (bindings--define-key menu [highlight-paren-mode] (menu-bar-make-mm-toggle show-paren-mode "Highlight Matching Parentheses" "Highlight matching/mismatched parentheses at cursor (Show Paren mode)")) - (define-key menu [transient-mark-mode] + (bindings--define-key menu [transient-mark-mode] (menu-bar-make-mm-toggle transient-mark-mode "Highlight Active Region" @@ -1338,109 +1330,109 @@ mail status in mode line")) (defvar menu-bar-games-menu (let ((menu (make-sparse-keymap "Games"))) - (define-key menu [zone] - `(menu-item ,(purecopy "Zone Out") zone - :help ,(purecopy "Play tricks with Emacs display when Emacs is idle"))) - (define-key menu [tetris] - `(menu-item ,(purecopy "Tetris") tetris - :help ,(purecopy "Falling blocks game"))) - (define-key menu [solitaire] - `(menu-item ,(purecopy "Solitaire") solitaire - :help ,(purecopy "Get rid of all the stones"))) - (define-key menu [snake] - `(menu-item ,(purecopy "Snake") snake - :help ,(purecopy "Move snake around avoiding collisions"))) - (define-key menu [pong] - `(menu-item ,(purecopy "Pong") pong - :help ,(purecopy "Bounce the ball to your opponent"))) - (define-key menu [mult] - `(menu-item ,(purecopy "Multiplication Puzzle") mpuz - :help ,(purecopy "Exercise brain with multiplication"))) - (define-key menu [life] - `(menu-item ,(purecopy "Life") life - :help ,(purecopy "Watch how John Conway's cellular automaton evolves"))) - (define-key menu [land] - `(menu-item ,(purecopy "Landmark") landmark - :help ,(purecopy "Watch a neural-network robot learn landmarks"))) - (define-key menu [hanoi] - `(menu-item ,(purecopy "Towers of Hanoi") hanoi - :help ,(purecopy "Watch Towers-of-Hanoi puzzle solved by Emacs"))) - (define-key menu [gomoku] - `(menu-item ,(purecopy "Gomoku") gomoku - :help ,(purecopy "Mark 5 contiguous squares (like tic-tac-toe)"))) - (define-key menu [bubbles] - `(menu-item ,(purecopy "Bubbles") bubbles - :help ,(purecopy "Remove all bubbles using the fewest moves"))) - (define-key menu [black-box] - `(menu-item ,(purecopy "Blackbox") blackbox - :help ,(purecopy "Find balls in a black box by shooting rays"))) - (define-key menu [adventure] - `(menu-item ,(purecopy "Adventure") dunnet - :help ,(purecopy "Dunnet, a text Adventure game for Emacs"))) - (define-key menu [5x5] - `(menu-item ,(purecopy "5x5") 5x5 - :help ,(purecopy "Fill in all the squares on a 5x5 board"))) + (bindings--define-key menu [zone] + '(menu-item "Zone Out" zone + :help "Play tricks with Emacs display when Emacs is idle")) + (bindings--define-key menu [tetris] + '(menu-item "Tetris" tetris + :help "Falling blocks game")) + (bindings--define-key menu [solitaire] + '(menu-item "Solitaire" solitaire + :help "Get rid of all the stones")) + (bindings--define-key menu [snake] + '(menu-item "Snake" snake + :help "Move snake around avoiding collisions")) + (bindings--define-key menu [pong] + '(menu-item "Pong" pong + :help "Bounce the ball to your opponent")) + (bindings--define-key menu [mult] + '(menu-item "Multiplication Puzzle" mpuz + :help "Exercise brain with multiplication")) + (bindings--define-key menu [life] + '(menu-item "Life" life + :help "Watch how John Conway's cellular automaton evolves")) + (bindings--define-key menu [land] + '(menu-item "Landmark" landmark + :help "Watch a neural-network robot learn landmarks")) + (bindings--define-key menu [hanoi] + '(menu-item "Towers of Hanoi" hanoi + :help "Watch Towers-of-Hanoi puzzle solved by Emacs")) + (bindings--define-key menu [gomoku] + '(menu-item "Gomoku" gomoku + :help "Mark 5 contiguous squares (like tic-tac-toe)")) + (bindings--define-key menu [bubbles] + '(menu-item "Bubbles" bubbles + :help "Remove all bubbles using the fewest moves")) + (bindings--define-key menu [black-box] + '(menu-item "Blackbox" blackbox + :help "Find balls in a black box by shooting rays")) + (bindings--define-key menu [adventure] + '(menu-item "Adventure" dunnet + :help "Dunnet, a text Adventure game for Emacs")) + (bindings--define-key menu [5x5] + '(menu-item "5x5" 5x5 + :help "Fill in all the squares on a 5x5 board")) menu)) (defvar menu-bar-encryption-decryption-menu (let ((menu (make-sparse-keymap "Encryption/Decryption"))) - (define-key menu [insert-keys] - `(menu-item ,(purecopy "Insert Keys") epa-insert-keys - :help ,(purecopy "Insert public keys after the current point"))) + (bindings--define-key menu [insert-keys] + '(menu-item "Insert Keys" epa-insert-keys + :help "Insert public keys after the current point")) - (define-key menu [export-keys] - `(menu-item ,(purecopy "Export Keys") epa-export-keys - :help ,(purecopy "Export public keys to a file"))) + (bindings--define-key menu [export-keys] + '(menu-item "Export Keys" epa-export-keys + :help "Export public keys to a file")) - (define-key menu [import-keys-region] - `(menu-item ,(purecopy "Import Keys from Region") epa-import-keys-region - :help ,(purecopy "Import public keys from the current region"))) + (bindings--define-key menu [import-keys-region] + '(menu-item "Import Keys from Region" epa-import-keys-region + :help "Import public keys from the current region")) - (define-key menu [import-keys] - `(menu-item ,(purecopy "Import Keys from File...") epa-import-keys - :help ,(purecopy "Import public keys from a file"))) + (bindings--define-key menu [import-keys] + '(menu-item "Import Keys from File..." epa-import-keys + :help "Import public keys from a file")) - (define-key menu [list-keys] - `(menu-item ,(purecopy "List Keys") epa-list-keys - :help ,(purecopy "Browse your public keyring"))) + (bindings--define-key menu [list-keys] + '(menu-item "List Keys" epa-list-keys + :help "Browse your public keyring")) - (define-key menu [separator-keys] + (bindings--define-key menu [separator-keys] menu-bar-separator) - (define-key menu [sign-region] - `(menu-item ,(purecopy "Sign Region") epa-sign-region - :help ,(purecopy "Create digital signature of the current region"))) + (bindings--define-key menu [sign-region] + '(menu-item "Sign Region" epa-sign-region + :help "Create digital signature of the current region")) - (define-key menu [verify-region] - `(menu-item ,(purecopy "Verify Region") epa-verify-region - :help ,(purecopy "Verify digital signature of the current region"))) + (bindings--define-key menu [verify-region] + '(menu-item "Verify Region" epa-verify-region + :help "Verify digital signature of the current region")) - (define-key menu [encrypt-region] - `(menu-item ,(purecopy "Encrypt Region") epa-encrypt-region - :help ,(purecopy "Encrypt the current region"))) + (bindings--define-key menu [encrypt-region] + '(menu-item "Encrypt Region" epa-encrypt-region + :help "Encrypt the current region")) - (define-key menu [decrypt-region] - `(menu-item ,(purecopy "Decrypt Region") epa-decrypt-region - :help ,(purecopy "Decrypt the current region"))) + (bindings--define-key menu [decrypt-region] + '(menu-item "Decrypt Region" epa-decrypt-region + :help "Decrypt the current region")) - (define-key menu [separator-file] + (bindings--define-key menu [separator-file] menu-bar-separator) - (define-key menu [sign-file] - `(menu-item ,(purecopy "Sign File...") epa-sign-file - :help ,(purecopy "Create digital signature of a file"))) + (bindings--define-key menu [sign-file] + '(menu-item "Sign File..." epa-sign-file + :help "Create digital signature of a file")) - (define-key menu [verify-file] - `(menu-item ,(purecopy "Verify File...") epa-verify-file - :help ,(purecopy "Verify digital signature of a file"))) + (bindings--define-key menu [verify-file] + '(menu-item "Verify File..." epa-verify-file + :help "Verify digital signature of a file")) - (define-key menu [encrypt-file] - `(menu-item ,(purecopy "Encrypt File...") epa-encrypt-file - :help ,(purecopy "Encrypt a file"))) + (bindings--define-key menu [encrypt-file] + '(menu-item "Encrypt File..." epa-encrypt-file + :help "Encrypt a file")) - (define-key menu [decrypt-file] - `(menu-item ,(purecopy "Decrypt File...") epa-decrypt-file - :help ,(purecopy "Decrypt a file"))) + (bindings--define-key menu [decrypt-file] + '(menu-item "Decrypt File..." epa-decrypt-file + :help "Decrypt a file")) menu)) @@ -1452,102 +1444,103 @@ mail status in mode line")) (defvar menu-bar-tools-menu (let ((menu (make-sparse-keymap "Tools"))) - (define-key menu [games] - `(menu-item ,(purecopy "Games") ,menu-bar-games-menu)) + (bindings--define-key menu [games] + `(menu-item "Games" ,menu-bar-games-menu)) - (define-key menu [separator-games] + (bindings--define-key menu [separator-games] menu-bar-separator) - (define-key menu [encryption-decryption] - `(menu-item ,(purecopy "Encryption/Decryption") ,menu-bar-encryption-decryption-menu)) + (bindings--define-key menu [encryption-decryption] + `(menu-item "Encryption/Decryption" + ,menu-bar-encryption-decryption-menu)) - (define-key menu [separator-encryption-decryption] + (bindings--define-key menu [separator-encryption-decryption] menu-bar-separator) - (define-key menu [simple-calculator] - `(menu-item ,(purecopy "Simple Calculator") calculator - :help ,(purecopy "Invoke the Emacs built-in quick calculator"))) - (define-key menu [calc] - `(menu-item ,(purecopy "Programmable Calculator") calc - :help ,(purecopy "Invoke the Emacs built-in full scientific calculator"))) - (define-key menu [calendar] - `(menu-item ,(purecopy "Calendar") calendar - :help ,(purecopy "Invoke the Emacs built-in calendar"))) + (bindings--define-key menu [simple-calculator] + '(menu-item "Simple Calculator" calculator + :help "Invoke the Emacs built-in quick calculator")) + (bindings--define-key menu [calc] + '(menu-item "Programmable Calculator" calc + :help "Invoke the Emacs built-in full scientific calculator")) + (bindings--define-key menu [calendar] + '(menu-item "Calendar" calendar + :help "Invoke the Emacs built-in calendar")) - (define-key menu [separator-net] + (bindings--define-key menu [separator-net] menu-bar-separator) - (define-key menu [directory-search] - `(menu-item ,(purecopy "Directory Search") eudc-tools-menu)) - (define-key menu [compose-mail] - `(menu-item (format "Send Mail (with %s)" (send-mail-item-name)) compose-mail + (bindings--define-key menu [directory-search] + '(menu-item "Directory Search" eudc-tools-menu)) + (bindings--define-key menu [compose-mail] + '(menu-item (format "Send Mail (with %s)" (send-mail-item-name)) compose-mail :visible (and mail-user-agent (not (eq mail-user-agent 'ignore))) - :help ,(purecopy "Send a mail message"))) - (define-key menu [rmail] - `(menu-item (format "Read Mail (with %s)" (read-mail-item-name)) + :help "Send a mail message")) + (bindings--define-key menu [rmail] + '(menu-item (format "Read Mail (with %s)" (read-mail-item-name)) menu-bar-read-mail :visible (and read-mail-command (not (eq read-mail-command 'ignore))) - :help ,(purecopy "Read your mail and reply to it"))) + :help "Read your mail and reply to it")) - (define-key menu [gnus] - `(menu-item ,(purecopy "Read Net News (Gnus)") gnus - :help ,(purecopy "Read network news groups"))) + (bindings--define-key menu [gnus] + '(menu-item "Read Net News (Gnus)" gnus + :help "Read network news groups")) - (define-key menu [separator-vc] + (bindings--define-key menu [separator-vc] menu-bar-separator) - (define-key menu [pcl-cvs] - `(menu-item ,(purecopy "PCL-CVS") cvs-global-menu)) - (define-key menu [vc] nil) ;Create the place for the VC menu. + (bindings--define-key menu [pcl-cvs] + '(menu-item "PCL-CVS" cvs-global-menu)) + (bindings--define-key menu [vc] nil) ;Create the place for the VC menu. - (define-key menu [separator-compare] + (bindings--define-key menu [separator-compare] menu-bar-separator) - (define-key menu [epatch] - `(menu-item ,(purecopy "Apply Patch") menu-bar-epatch-menu)) - (define-key menu [ediff-merge] - `(menu-item ,(purecopy "Merge") menu-bar-ediff-merge-menu)) - (define-key menu [compare] - `(menu-item ,(purecopy "Compare (Ediff)") menu-bar-ediff-menu)) + (bindings--define-key menu [epatch] + '(menu-item "Apply Patch" menu-bar-epatch-menu)) + (bindings--define-key menu [ediff-merge] + '(menu-item "Merge" menu-bar-ediff-merge-menu)) + (bindings--define-key menu [compare] + '(menu-item "Compare (Ediff)" menu-bar-ediff-menu)) - (define-key menu [separator-spell] + (bindings--define-key menu [separator-spell] menu-bar-separator) - (define-key menu [spell] - `(menu-item ,(purecopy "Spell Checking") ispell-menu-map)) + (bindings--define-key menu [spell] + '(menu-item "Spell Checking" ispell-menu-map)) - (define-key menu [separator-prog] + (bindings--define-key menu [separator-prog] menu-bar-separator) - (define-key menu [semantic] - `(menu-item ,(purecopy "Source Code Parsers (Semantic)") + (bindings--define-key menu [semantic] + '(menu-item "Source Code Parsers (Semantic)" semantic-mode - :help ,(purecopy "Toggle automatic parsing in source code buffers (Semantic mode)") + :help "Toggle automatic parsing in source code buffers (Semantic mode)" :button (:toggle . (bound-and-true-p semantic-mode)))) - (define-key menu [ede] - `(menu-item ,(purecopy "Project support (EDE)") + (bindings--define-key menu [ede] + '(menu-item "Project support (EDE)" global-ede-mode - :help ,(purecopy "Toggle the Emacs Development Environment (Global EDE mode)") + :help "Toggle the Emacs Development Environment (Global EDE mode)" :button (:toggle . (bound-and-true-p global-ede-mode)))) - (define-key menu [gdb] - `(menu-item ,(purecopy "Debugger (GDB)...") gdb - :help ,(purecopy "Debug a program from within Emacs with GDB"))) - (define-key menu [shell-on-region] - `(menu-item ,(purecopy "Shell Command on Region...") shell-command-on-region + (bindings--define-key menu [gdb] + '(menu-item "Debugger (GDB)..." gdb + :help "Debug a program from within Emacs with GDB")) + (bindings--define-key menu [shell-on-region] + '(menu-item "Shell Command on Region..." shell-command-on-region :enable mark-active - :help ,(purecopy "Pass marked region to a shell command"))) - (define-key menu [shell] - `(menu-item ,(purecopy "Shell Command...") shell-command - :help ,(purecopy "Invoke a shell command and catch its output"))) - (define-key menu [compile] - `(menu-item ,(purecopy "Compile...") compile - :help ,(purecopy "Invoke compiler or Make, view compilation errors"))) - (define-key menu [grep] - `(menu-item ,(purecopy "Search Files (Grep)...") grep - :help ,(purecopy "Search files for strings or regexps (with Grep)"))) + :help "Pass marked region to a shell command")) + (bindings--define-key menu [shell] + '(menu-item "Shell Command..." shell-command + :help "Invoke a shell command and catch its output")) + (bindings--define-key menu [compile] + '(menu-item "Compile..." compile + :help "Invoke compiler or Make, view compilation errors")) + (bindings--define-key menu [grep] + '(menu-item "Search Files (Grep)..." grep + :help "Search files for strings or regexps (with Grep)")) menu)) ;; The "Help" menu items @@ -1555,54 +1548,54 @@ mail status in mode line")) (defvar menu-bar-describe-menu (let ((menu (make-sparse-keymap "Describe"))) - (define-key menu [mule-diag] - `(menu-item ,(purecopy "Show All of Mule Status") mule-diag + (bindings--define-key menu [mule-diag] + '(menu-item "Show All of Mule Status" mule-diag :visible (default-value 'enable-multibyte-characters) - :help ,(purecopy "Display multilingual environment settings"))) - (define-key menu [describe-coding-system-briefly] - `(menu-item ,(purecopy "Describe Coding System (Briefly)") + :help "Display multilingual environment settings")) + (bindings--define-key menu [describe-coding-system-briefly] + '(menu-item "Describe Coding System (Briefly)" describe-current-coding-system-briefly :visible (default-value 'enable-multibyte-characters))) - (define-key menu [describe-coding-system] - `(menu-item ,(purecopy "Describe Coding System...") describe-coding-system + (bindings--define-key menu [describe-coding-system] + '(menu-item "Describe Coding System..." describe-coding-system :visible (default-value 'enable-multibyte-characters))) - (define-key menu [describe-input-method] - `(menu-item ,(purecopy "Describe Input Method...") describe-input-method + (bindings--define-key menu [describe-input-method] + '(menu-item "Describe Input Method..." describe-input-method :visible (default-value 'enable-multibyte-characters) - :help ,(purecopy "Keyboard layout for specific input method"))) - (define-key menu [describe-language-environment] - `(menu-item ,(purecopy "Describe Language Environment") + :help "Keyboard layout for specific input method")) + (bindings--define-key menu [describe-language-environment] + `(menu-item "Describe Language Environment" ,describe-language-environment-map)) - (define-key menu [separator-desc-mule] + (bindings--define-key menu [separator-desc-mule] menu-bar-separator) - (define-key menu [list-keybindings] - `(menu-item ,(purecopy "List Key Bindings") describe-bindings - :help ,(purecopy "Display all current key bindings (keyboard shortcuts)"))) - (define-key menu [describe-current-display-table] - `(menu-item ,(purecopy "Describe Display Table") describe-current-display-table - :help ,(purecopy "Describe the current display table"))) - (define-key menu [describe-package] - `(menu-item ,(purecopy "Describe Package...") describe-package - :help ,(purecopy "Display documentation of a Lisp package"))) - (define-key menu [describe-face] - `(menu-item ,(purecopy "Describe Face...") describe-face - :help ,(purecopy "Display the properties of a face"))) - (define-key menu [describe-variable] - `(menu-item ,(purecopy "Describe Variable...") describe-variable - :help ,(purecopy "Display documentation of variable/option"))) - (define-key menu [describe-function] - `(menu-item ,(purecopy "Describe Function...") describe-function - :help ,(purecopy "Display documentation of function/command"))) - (define-key menu [describe-key-1] - `(menu-item ,(purecopy "Describe Key or Mouse Operation...") describe-key + (bindings--define-key menu [list-keybindings] + '(menu-item "List Key Bindings" describe-bindings + :help "Display all current key bindings (keyboard shortcuts)")) + (bindings--define-key menu [describe-current-display-table] + '(menu-item "Describe Display Table" describe-current-display-table + :help "Describe the current display table")) + (bindings--define-key menu [describe-package] + '(menu-item "Describe Package..." describe-package + :help "Display documentation of a Lisp package")) + (bindings--define-key menu [describe-face] + '(menu-item "Describe Face..." describe-face + :help "Display the properties of a face")) + (bindings--define-key menu [describe-variable] + '(menu-item "Describe Variable..." describe-variable + :help "Display documentation of variable/option")) + (bindings--define-key menu [describe-function] + '(menu-item "Describe Function..." describe-function + :help "Display documentation of function/command")) + (bindings--define-key menu [describe-key-1] + '(menu-item "Describe Key or Mouse Operation..." describe-key ;; Users typically don't identify keys and menu items... - :help ,(purecopy "Display documentation of command bound to a \ -key, a click, or a menu-item"))) - (define-key menu [describe-mode] - `(menu-item ,(purecopy "Describe Buffer Modes") describe-mode - :help ,(purecopy "Describe this buffer's major and minor mode"))) + :help "Display documentation of command bound to a \ +key, a click, or a menu-item")) + (bindings--define-key menu [describe-mode] + '(menu-item "Describe Buffer Modes" describe-mode + :help "Describe this buffer's major and minor mode")) menu)) (defun menu-bar-read-lispref () @@ -1635,64 +1628,64 @@ key, a click, or a menu-item"))) (defvar menu-bar-search-documentation-menu (let ((menu (make-sparse-keymap "Search Documentation"))) - (define-key menu [search-documentation-strings] - `(menu-item ,(purecopy "Search Documentation Strings...") apropos-documentation + (bindings--define-key menu [search-documentation-strings] + '(menu-item "Search Documentation Strings..." apropos-documentation :help - ,(purecopy "Find functions and variables whose doc strings match a regexp"))) - (define-key menu [find-any-object-by-name] - `(menu-item ,(purecopy "Find Any Object by Name...") apropos - :help ,(purecopy "Find symbols of any kind whose names match a regexp"))) - (define-key menu [find-option-by-value] - `(menu-item ,(purecopy "Find Options by Value...") apropos-value - :help ,(purecopy "Find variables whose values match a regexp"))) - (define-key menu [find-options-by-name] - `(menu-item ,(purecopy "Find Options by Name...") apropos-variable - :help ,(purecopy "Find variables whose names match a regexp"))) - (define-key menu [find-commands-by-name] - `(menu-item ,(purecopy "Find Commands by Name...") apropos-command - :help ,(purecopy "Find commands whose names match a regexp"))) - (define-key menu [sep1] + "Find functions and variables whose doc strings match a regexp")) + (bindings--define-key menu [find-any-object-by-name] + '(menu-item "Find Any Object by Name..." apropos + :help "Find symbols of any kind whose names match a regexp")) + (bindings--define-key menu [find-option-by-value] + '(menu-item "Find Options by Value..." apropos-value + :help "Find variables whose values match a regexp")) + (bindings--define-key menu [find-options-by-name] + '(menu-item "Find Options by Name..." apropos-variable + :help "Find variables whose names match a regexp")) + (bindings--define-key menu [find-commands-by-name] + '(menu-item "Find Commands by Name..." apropos-command + :help "Find commands whose names match a regexp")) + (bindings--define-key menu [sep1] menu-bar-separator) - (define-key menu [lookup-command-in-manual] - `(menu-item ,(purecopy "Look Up Command in User Manual...") Info-goto-emacs-command-node - :help ,(purecopy "Display manual section that describes a command"))) - (define-key menu [lookup-key-in-manual] - `(menu-item ,(purecopy "Look Up Key in User Manual...") Info-goto-emacs-key-command-node - :help ,(purecopy "Display manual section that describes a key"))) - (define-key menu [lookup-subject-in-elisp-manual] - `(menu-item ,(purecopy "Look Up Subject in ELisp Manual...") elisp-index-search - :help ,(purecopy "Find description of a subject in Emacs Lisp manual"))) - (define-key menu [lookup-subject-in-emacs-manual] - `(menu-item ,(purecopy "Look Up Subject in User Manual...") emacs-index-search - :help ,(purecopy "Find description of a subject in Emacs User manual"))) - (define-key menu [emacs-terminology] - `(menu-item ,(purecopy "Emacs Terminology") search-emacs-glossary - :help ,(purecopy "Display the Glossary section of the Emacs manual"))) + (bindings--define-key menu [lookup-command-in-manual] + '(menu-item "Look Up Command in User Manual..." Info-goto-emacs-command-node + :help "Display manual section that describes a command")) + (bindings--define-key menu [lookup-key-in-manual] + '(menu-item "Look Up Key in User Manual..." Info-goto-emacs-key-command-node + :help "Display manual section that describes a key")) + (bindings--define-key menu [lookup-subject-in-elisp-manual] + '(menu-item "Look Up Subject in ELisp Manual..." elisp-index-search + :help "Find description of a subject in Emacs Lisp manual")) + (bindings--define-key menu [lookup-subject-in-emacs-manual] + '(menu-item "Look Up Subject in User Manual..." emacs-index-search + :help "Find description of a subject in Emacs User manual")) + (bindings--define-key menu [emacs-terminology] + '(menu-item "Emacs Terminology" search-emacs-glossary + :help "Display the Glossary section of the Emacs manual")) menu)) (defvar menu-bar-manuals-menu (let ((menu (make-sparse-keymap "More Manuals"))) - (define-key menu [man] - `(menu-item ,(purecopy "Read Man Page...") manual-entry - :help ,(purecopy "Man-page docs for external commands and libraries"))) - (define-key menu [sep2] + (bindings--define-key menu [man] + '(menu-item "Read Man Page..." manual-entry + :help "Man-page docs for external commands and libraries")) + (bindings--define-key menu [sep2] menu-bar-separator) - (define-key menu [order-emacs-manuals] - `(menu-item ,(purecopy "Ordering Manuals") view-order-manuals - :help ,(purecopy "How to order manuals from the Free Software Foundation"))) - (define-key menu [lookup-subject-in-all-manuals] - `(menu-item ,(purecopy "Lookup Subject in all Manuals...") info-apropos - :help ,(purecopy "Find description of a subject in all installed manuals"))) - (define-key menu [other-manuals] - `(menu-item ,(purecopy "All Other Manuals (Info)") Info-directory - :help ,(purecopy "Read any of the installed manuals"))) - (define-key menu [emacs-lisp-reference] - `(menu-item ,(purecopy "Emacs Lisp Reference") menu-bar-read-lispref - :help ,(purecopy "Read the Emacs Lisp Reference manual"))) - (define-key menu [emacs-lisp-intro] - `(menu-item ,(purecopy "Introduction to Emacs Lisp") menu-bar-read-lispintro - :help ,(purecopy "Read the Introduction to Emacs Lisp Programming"))) + (bindings--define-key menu [order-emacs-manuals] + '(menu-item "Ordering Manuals" view-order-manuals + :help "How to order manuals from the Free Software Foundation")) + (bindings--define-key menu [lookup-subject-in-all-manuals] + '(menu-item "Lookup Subject in all Manuals..." info-apropos + :help "Find description of a subject in all installed manuals")) + (bindings--define-key menu [other-manuals] + '(menu-item "All Other Manuals (Info)" Info-directory + :help "Read any of the installed manuals")) + (bindings--define-key menu [emacs-lisp-reference] + '(menu-item "Emacs Lisp Reference" menu-bar-read-lispref + :help "Read the Emacs Lisp Reference manual")) + (bindings--define-key menu [emacs-lisp-intro] + '(menu-item "Introduction to Emacs Lisp" menu-bar-read-lispintro + :help "Read the Introduction to Emacs Lisp Programming")) menu)) (defun menu-bar-help-extra-packages () @@ -1710,94 +1703,94 @@ key, a click, or a menu-item"))) (defvar menu-bar-help-menu (let ((menu (make-sparse-keymap "Help"))) - (define-key menu [about-gnu-project] - `(menu-item ,(purecopy "About GNU") describe-gnu-project - :help ,(purecopy "About the GNU System, GNU Project, and GNU/Linux"))) - (define-key menu [about-emacs] - `(menu-item ,(purecopy "About Emacs") about-emacs - :help ,(purecopy "Display version number, copyright info, and basic help"))) - (define-key menu [sep4] + (bindings--define-key menu [about-gnu-project] + '(menu-item "About GNU" describe-gnu-project + :help "About the GNU System, GNU Project, and GNU/Linux")) + (bindings--define-key menu [about-emacs] + '(menu-item "About Emacs" about-emacs + :help "Display version number, copyright info, and basic help")) + (bindings--define-key menu [sep4] menu-bar-separator) - (define-key menu [describe-no-warranty] - `(menu-item ,(purecopy "(Non)Warranty") describe-no-warranty - :help ,(purecopy "Explain that Emacs has NO WARRANTY"))) - (define-key menu [describe-copying] - `(menu-item ,(purecopy "Copying Conditions") describe-copying - :help ,(purecopy "Show the Emacs license (GPL)"))) - (define-key menu [getting-new-versions] - `(menu-item ,(purecopy "Getting New Versions") describe-distribution - :help ,(purecopy "How to get the latest version of Emacs"))) - (define-key menu [sep2] + (bindings--define-key menu [describe-no-warranty] + '(menu-item "(Non)Warranty" describe-no-warranty + :help "Explain that Emacs has NO WARRANTY")) + (bindings--define-key menu [describe-copying] + '(menu-item "Copying Conditions" describe-copying + :help "Show the Emacs license (GPL)")) + (bindings--define-key menu [getting-new-versions] + '(menu-item "Getting New Versions" describe-distribution + :help "How to get the latest version of Emacs")) + (bindings--define-key menu [sep2] menu-bar-separator) - (define-key menu [external-packages] - `(menu-item ,(purecopy "Finding Extra Packages") menu-bar-help-extra-packages - :help ,(purecopy "Lisp packages distributed separately for use in Emacs"))) - (define-key menu [find-emacs-packages] - `(menu-item ,(purecopy "Search Built-in Packages") finder-by-keyword - :help ,(purecopy "Find built-in packages and features by keyword"))) - (define-key menu [more-manuals] - `(menu-item ,(purecopy "More Manuals") ,menu-bar-manuals-menu)) - (define-key menu [emacs-manual] - `(menu-item ,(purecopy "Read the Emacs Manual") info-emacs-manual - :help ,(purecopy "Full documentation of Emacs features"))) - (define-key menu [describe] - `(menu-item ,(purecopy "Describe") ,menu-bar-describe-menu)) - (define-key menu [search-documentation] - `(menu-item ,(purecopy "Search Documentation") ,menu-bar-search-documentation-menu)) - (define-key menu [sep1] + (bindings--define-key menu [external-packages] + '(menu-item "Finding Extra Packages" menu-bar-help-extra-packages + :help "Lisp packages distributed separately for use in Emacs")) + (bindings--define-key menu [find-emacs-packages] + '(menu-item "Search Built-in Packages" finder-by-keyword + :help "Find built-in packages and features by keyword")) + (bindings--define-key menu [more-manuals] + `(menu-item "More Manuals" ,menu-bar-manuals-menu)) + (bindings--define-key menu [emacs-manual] + '(menu-item "Read the Emacs Manual" info-emacs-manual + :help "Full documentation of Emacs features")) + (bindings--define-key menu [describe] + `(menu-item "Describe" ,menu-bar-describe-menu)) + (bindings--define-key menu [search-documentation] + `(menu-item "Search Documentation" ,menu-bar-search-documentation-menu)) + (bindings--define-key menu [sep1] menu-bar-separator) - (define-key menu [emacs-psychotherapist] - `(menu-item ,(purecopy "Emacs Psychotherapist") doctor - :help ,(purecopy "Our doctor will help you feel better"))) - (define-key menu [send-emacs-bug-report] - `(menu-item ,(purecopy "Send Bug Report...") report-emacs-bug - :help ,(purecopy "Send e-mail to Emacs maintainers"))) - (define-key menu [emacs-manual-bug] - `(menu-item ,(purecopy "How to Report a Bug") info-emacs-bug - :help ,(purecopy "Read about how to report an Emacs bug"))) - (define-key menu [emacs-known-problems] - `(menu-item ,(purecopy "Emacs Known Problems") view-emacs-problems - :help ,(purecopy "Read about known problems with Emacs"))) - (define-key menu [emacs-news] - `(menu-item ,(purecopy "Emacs News") view-emacs-news - :help ,(purecopy "New features of this version"))) - (define-key menu [emacs-faq] - `(menu-item ,(purecopy "Emacs FAQ") view-emacs-FAQ - :help ,(purecopy "Frequently asked (and answered) questions about Emacs"))) + (bindings--define-key menu [emacs-psychotherapist] + '(menu-item "Emacs Psychotherapist" doctor + :help "Our doctor will help you feel better")) + (bindings--define-key menu [send-emacs-bug-report] + '(menu-item "Send Bug Report..." report-emacs-bug + :help "Send e-mail to Emacs maintainers")) + (bindings--define-key menu [emacs-manual-bug] + '(menu-item "How to Report a Bug" info-emacs-bug + :help "Read about how to report an Emacs bug")) + (bindings--define-key menu [emacs-known-problems] + '(menu-item "Emacs Known Problems" view-emacs-problems + :help "Read about known problems with Emacs")) + (bindings--define-key menu [emacs-news] + '(menu-item "Emacs News" view-emacs-news + :help "New features of this version")) + (bindings--define-key menu [emacs-faq] + '(menu-item "Emacs FAQ" view-emacs-FAQ + :help "Frequently asked (and answered) questions about Emacs")) - (define-key menu [emacs-tutorial-language-specific] - `(menu-item ,(purecopy "Emacs Tutorial (choose language)...") + (bindings--define-key menu [emacs-tutorial-language-specific] + '(menu-item "Emacs Tutorial (choose language)..." help-with-tutorial-spec-language - :help ,(purecopy "Learn how to use Emacs (choose a language)"))) - (define-key menu [emacs-tutorial] - `(menu-item ,(purecopy "Emacs Tutorial") help-with-tutorial - :help ,(purecopy "Learn how to use Emacs"))) + :help "Learn how to use Emacs (choose a language)")) + (bindings--define-key menu [emacs-tutorial] + '(menu-item "Emacs Tutorial" help-with-tutorial + :help "Learn how to use Emacs")) ;; In OS X it's in the app menu already. ;; FIXME? There already is an "About Emacs" (sans ...) entry in the Help menu. (and (featurep 'ns) (not (eq system-type 'darwin)) - (define-key menu [info-panel] - `(menu-item ,(purecopy "About Emacs...") ns-do-emacs-info-panel))) + (bindings--define-key menu [info-panel] + '(menu-item "About Emacs..." ns-do-emacs-info-panel))) menu)) -(define-key global-map [menu-bar tools] - (cons (purecopy "Tools") menu-bar-tools-menu)) -(define-key global-map [menu-bar buffer] - (cons (purecopy "Buffers") global-buffers-menu-map)) -(define-key global-map [menu-bar options] - (cons (purecopy "Options") menu-bar-options-menu)) -(define-key global-map [menu-bar edit] - (cons (purecopy "Edit") menu-bar-edit-menu)) -(define-key global-map [menu-bar file] - (cons (purecopy "File") menu-bar-file-menu)) +(bindings--define-key global-map [menu-bar tools] + (cons "Tools" menu-bar-tools-menu)) +(bindings--define-key global-map [menu-bar buffer] + (cons "Buffers" global-buffers-menu-map)) +(bindings--define-key global-map [menu-bar options] + (cons "Options" menu-bar-options-menu)) +(bindings--define-key global-map [menu-bar edit] + (cons "Edit" menu-bar-edit-menu)) +(bindings--define-key global-map [menu-bar file] + (cons "File" menu-bar-file-menu)) ;; Put "Help" menu at the end, or Info at the front. ;; If running under GNUstep, "Help" is moved and renamed "Info" (see below). (if (and (featurep 'ns) (not (eq system-type 'darwin))) - (define-key global-map [menu-bar help-menu] - (cons (purecopy "Info") menu-bar-help-menu)) + (bindings--define-key global-map [menu-bar help-menu] + (cons "Info" menu-bar-help-menu)) (define-key-after global-map [menu-bar help-menu] (cons (purecopy "Help") menu-bar-help-menu))) @@ -2117,40 +2110,40 @@ It must accept a buffer as its only required argument.") ;; This shouldn't be necessary, but there's a funny ;; bug in keymap.c that I don't understand yet. -stef minibuffer-local-completion-map)) - (define-key map [menu-bar minibuf] - (cons (purecopy "Minibuf") (make-sparse-keymap "Minibuf")))) + (bindings--define-key map [menu-bar minibuf] + (cons "Minibuf" (make-sparse-keymap "Minibuf")))) (let ((map minibuffer-local-completion-map)) - (define-key map [menu-bar minibuf ?\?] - `(menu-item ,(purecopy "List Completions") minibuffer-completion-help - :help ,(purecopy "Display all possible completions"))) - (define-key map [menu-bar minibuf space] - `(menu-item ,(purecopy "Complete Word") minibuffer-complete-word - :help ,(purecopy "Complete at most one word"))) - (define-key map [menu-bar minibuf tab] - `(menu-item ,(purecopy "Complete") minibuffer-complete - :help ,(purecopy "Complete as far as possible")))) + (bindings--define-key map [menu-bar minibuf ?\?] + '(menu-item "List Completions" minibuffer-completion-help + :help "Display all possible completions")) + (bindings--define-key map [menu-bar minibuf space] + '(menu-item "Complete Word" minibuffer-complete-word + :help "Complete at most one word")) + (bindings--define-key map [menu-bar minibuf tab] + '(menu-item "Complete" minibuffer-complete + :help "Complete as far as possible"))) (let ((map minibuffer-local-map)) - (define-key map [menu-bar minibuf quit] - `(menu-item ,(purecopy "Quit") abort-recursive-edit - :help ,(purecopy "Abort input and exit minibuffer"))) - (define-key map [menu-bar minibuf return] - `(menu-item ,(purecopy "Enter") exit-minibuffer - :key-sequence ,(purecopy "\r") - :help ,(purecopy "Terminate input and exit minibuffer"))) - (define-key map [menu-bar minibuf isearch-forward] - `(menu-item ,(purecopy "Isearch History Forward") isearch-forward - :help ,(purecopy "Incrementally search minibuffer history forward"))) - (define-key map [menu-bar minibuf isearch-backward] - `(menu-item ,(purecopy "Isearch History Backward") isearch-backward - :help ,(purecopy "Incrementally search minibuffer history backward"))) - (define-key map [menu-bar minibuf next] - `(menu-item ,(purecopy "Next History Item") next-history-element - :help ,(purecopy "Put next minibuffer history element in the minibuffer"))) - (define-key map [menu-bar minibuf previous] - `(menu-item ,(purecopy "Previous History Item") previous-history-element - :help ,(purecopy "Put previous minibuffer history element in the minibuffer")))) + (bindings--define-key map [menu-bar minibuf quit] + '(menu-item "Quit" abort-recursive-edit + :help "Abort input and exit minibuffer")) + (bindings--define-key map [menu-bar minibuf return] + '(menu-item "Enter" exit-minibuffer + :key-sequence "\r" + :help "Terminate input and exit minibuffer")) + (bindings--define-key map [menu-bar minibuf isearch-forward] + '(menu-item "Isearch History Forward" isearch-forward + :help "Incrementally search minibuffer history forward")) + (bindings--define-key map [menu-bar minibuf isearch-backward] + '(menu-item "Isearch History Backward" isearch-backward + :help "Incrementally search minibuffer history backward")) + (bindings--define-key map [menu-bar minibuf next] + '(menu-item "Next History Item" next-history-element + :help "Put next minibuffer history element in the minibuffer")) + (bindings--define-key map [menu-bar minibuf previous] + '(menu-item "Previous History Item" previous-history-element + :help "Put previous minibuffer history element in the minibuffer"))) (define-minor-mode menu-bar-mode "Toggle display of a menu bar on each frame (Menu Bar mode). diff --git a/lisp/midnight.el b/lisp/midnight.el index 3c0923d7e58..40e66b8ce9b 100644 --- a/lisp/midnight.el +++ b/lisp/midnight.el @@ -36,8 +36,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defgroup midnight nil "Run something every day at midnight." @@ -138,9 +137,9 @@ two lists will NOT be killed if it also matches anything in this list." (defun midnight-find (el ls test &optional key) "A stopgap solution to the absence of `find' in ELisp." - (dolist (rr ls) + (cl-dolist (rr ls) (when (funcall test (if key (funcall key rr) rr) el) - (return rr)))) + (cl-return rr)))) (defun clean-buffer-list-delay (name) "Return the delay, in seconds, before killing a buffer named NAME. @@ -196,8 +195,7 @@ The default value is `clean-buffer-list'." (defun midnight-next () "Return the number of seconds till the next midnight." - (multiple-value-bind (sec min hrs) - (values-list (decode-time)) + (pcase-let ((`(,sec ,min ,hrs) (decode-time))) (- (* 24 60 60) (* 60 60 hrs) (* 60 min) sec))) ;;;###autoload @@ -205,8 +203,8 @@ The default value is `clean-buffer-list'." "Modify `midnight-timer' according to `midnight-delay'. Sets the first argument SYMB (which must be symbol `midnight-delay') to its second argument TM." - (assert (eq symb 'midnight-delay) t - "Invalid argument to `midnight-delay-set': `%s'") + (cl-assert (eq symb 'midnight-delay) t + "Invalid argument to `midnight-delay-set': `%s'") (set symb tm) (when (timerp midnight-timer) (cancel-timer midnight-timer)) (setq midnight-timer diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index a084ed9fb4d..5c2c14d1fdb 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -81,7 +81,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;;; Completion table manipulation @@ -224,10 +224,10 @@ the form (concat S2 S)." (cond ((eq (car-safe action) 'boundaries) (let ((beg (or (and (eq (car-safe res) 'boundaries) (cadr res)) 0))) - (list* 'boundaries - (max (length s1) - (+ beg (- (length s1) (length s2)))) - (and (eq (car-safe res) 'boundaries) (cddr res))))) + `(boundaries + ,(max (length s1) + (+ beg (- (length s1) (length s2)))) + . ,(and (eq (car-safe res) 'boundaries) (cddr res))))) ((stringp res) (if (eq t (compare-strings res 0 (length s2) s2 nil nil completion-ignore-case)) @@ -267,7 +267,7 @@ the form (concat S2 S)." (if (eq (car-safe action) 'boundaries) (let* ((len (length prefix)) (bound (completion-boundaries string table pred (cdr action)))) - (list* 'boundaries (+ (car bound) len) (cdr bound))) + `(boundaries ,(+ (car bound) len) . ,(cdr bound))) (let ((comp (complete-with-action action table string pred))) (cond ;; In case of try-completion, add the prefix. @@ -300,8 +300,8 @@ instead of a string, a function that takes the completion and returns the (cdr terminator) (regexp-quote terminator))) (max (and terminator-regexp (string-match terminator-regexp suffix)))) - (list* 'boundaries (car bounds) - (min (cdr bounds) (or max (length suffix)))))) + `(boundaries ,(car bounds) + . ,(min (cdr bounds) (or max (length suffix)))))) ((eq action nil) (let ((comp (try-completion string table pred))) (if (consp terminator) (setq terminator (car terminator))) @@ -408,7 +408,7 @@ for use at QPOS." (qsuffix (cdr action)) (ufull (if (zerop (length qsuffix)) ustring (funcall unquote (concat string qsuffix)))) - (_ (assert (string-prefix-p ustring ufull))) + (_ (cl-assert (string-prefix-p ustring ufull))) (usuffix (substring ufull (length ustring))) (boundaries (completion-boundaries ustring table pred usuffix)) (qlboundary (car (funcall requote (car boundaries) string))) @@ -418,7 +418,7 @@ for use at QPOS." (- (car (funcall requote urfullboundary (concat string qsuffix))) (length string)))))) - (list* 'boundaries qlboundary qrboundary))) + `(boundaries ,qlboundary . ,qrboundary))) ;; In "normal" use a c-t-with-quoting completion table should never be ;; called with action in (t nil) because `completion--unquote' should have @@ -466,18 +466,18 @@ for use at QPOS." (let ((ustring (funcall unquote string)) (uprefix (funcall unquote (substring string 0 pred)))) ;; We presume (more or less) that `concat' and `unquote' commute. - (assert (string-prefix-p uprefix ustring)) + (cl-assert (string-prefix-p uprefix ustring)) (list ustring table (length uprefix) (lambda (unquoted-result op) (pcase op - (`1 ;;try + (1 ;;try (if (not (stringp (car-safe unquoted-result))) unquoted-result (completion--twq-try string ustring (car unquoted-result) (cdr unquoted-result) unquote requote))) - (`2 ;;all + (2 ;;all (let* ((last (last unquoted-result)) (base (or (cdr last) 0))) (when last @@ -488,7 +488,7 @@ for use at QPOS." (defun completion--twq-try (string ustring completion point unquote requote) - ;; Basically two case: either the new result is + ;; Basically two cases: either the new result is ;; - commonprefix1 morecommonprefix suffix ;; - commonprefix newprefix suffix (pcase-let* @@ -505,8 +505,13 @@ for use at QPOS." ((> point (length prefix)) (+ qpos (length qstr1))) (t (car (funcall requote point string)))))) ;; Make sure `requote' worked. - (assert (equal (funcall unquote qstring) completion)) - (cons qstring qpoint))) + (if (equal (funcall unquote qstring) completion) + (cons qstring qpoint) + ;; If requote failed (e.g. because sifn-requote did not handle + ;; Tramp's "/foo:/bar//baz -> /foo:/baz" truncation), then at least + ;; try requote properly. + (let ((qstr (funcall qfun completion))) + (cons qstr (length qstr)))))) (defun completion--string-equal-p (s1 s2) (eq t (compare-strings s1 nil nil s2 nil nil 'ignore-case))) @@ -522,12 +527,12 @@ for use at QPOS." (`(,qfullpos . ,qfun) (funcall requote (+ boundary (length prefix)) string)) (qfullprefix (substring string 0 qfullpos)) - (_ (assert (completion--string-equal-p - (funcall unquote qfullprefix) - (concat (substring ustring 0 boundary) prefix)) - t)) + (_ (cl-assert (completion--string-equal-p + (funcall unquote qfullprefix) + (concat (substring ustring 0 boundary) prefix)) + t)) (qboundary (car (funcall requote boundary string))) - (_ (assert (<= qboundary qfullpos))) + (_ (cl-assert (<= qboundary qfullpos))) ;; FIXME: this split/quote/concat business messes up the carefully ;; placed completions-common-part and completions-first-difference ;; faces. We could try within the mapcar loop to search for the @@ -550,11 +555,11 @@ for use at QPOS." ;; which only get quoted when needed by choose-completion. (nconc (mapcar (lambda (completion) - (assert (string-prefix-p prefix completion 'ignore-case) t) + (cl-assert (string-prefix-p prefix completion 'ignore-case) t) (let* ((new (substring completion (length prefix))) (qnew (funcall qfun new)) (qcompletion (concat qprefix qnew))) - (assert + (cl-assert (completion--string-equal-p (funcall unquote (concat (substring string 0 qboundary) @@ -989,9 +994,9 @@ when the buffer's text is already an exact match." 'exact 'unknown)))) ;; Show the completion table, if requested. ((not exact) - (if (case completion-auto-help - (lazy (eq this-command last-command)) - (t completion-auto-help)) + (if (pcase completion-auto-help + (`lazy (eq this-command last-command)) + (_ completion-auto-help)) (minibuffer-completion-help) (completion--message "Next char not unique"))) ;; If the last exact completion and this one were the same, it @@ -1036,9 +1041,9 @@ scroll the window of possible completions." ((and completion-cycling completion-all-sorted-completions) (minibuffer-force-complete) t) - (t (case (completion--do-completion) + (t (pcase (completion--do-completion) (#b000 nil) - (t t))))) + (_ t))))) (defun completion--cache-all-sorted-completions (comps) (add-hook 'after-change-functions @@ -1131,7 +1136,8 @@ Repeated uses step through the possible completions." (completion--cache-all-sorted-completions (cdr all))))))) (defvar minibuffer-confirm-exit-commands - '(minibuffer-complete minibuffer-complete-word PC-complete PC-complete-word) + '(completion-at-point minibuffer-complete + minibuffer-complete-word PC-complete PC-complete-word) "A list of commands which cause an immediately following `minibuffer-complete-and-exit' to ask for extra confirmation.") @@ -1197,15 +1203,15 @@ If `minibuffer-completion-confirm' is `confirm-after-completion', (t ;; Call do-completion, but ignore errors. - (case (condition-case nil + (pcase (condition-case nil (completion--do-completion nil 'expect-exact) (error 1)) - ((#b001 #b011) (exit-minibuffer)) + ((or #b001 #b011) (exit-minibuffer)) (#b111 (if (not minibuffer-completion-confirm) (exit-minibuffer) (minibuffer-message "Confirm") nil)) - (t nil)))))) + (_ nil)))))) (defun completion--try-word-completion (string table predicate point md) (let ((comp (completion-try-completion string table predicate point md))) @@ -1300,9 +1306,9 @@ After one word is completed as much as possible, a space or hyphen is added, provided that matches some possible completion. Return nil if there is no valid completion, else t." (interactive) - (case (completion--do-completion 'completion--try-word-completion) + (pcase (completion--do-completion 'completion--try-word-completion) (#b000 nil) - (t t))) + (_ t))) (defface completions-annotations '((t :inherit italic)) "Face to use for annotations in the *Completions* buffer.") @@ -1549,7 +1555,7 @@ variables.") (defun completion--done (string &optional finished message) (let* ((exit-fun (plist-get completion-extra-properties :exit-function)) (pre-msg (and exit-fun (current-message)))) - (assert (memq finished '(exact sole finished unknown))) + (cl-assert (memq finished '(exact sole finished unknown))) ;; FIXME: exit-fun should receive `finished' as a parameter. (when exit-fun (when (eq finished 'unknown) @@ -1721,7 +1727,7 @@ Return nil if there is no valid completion, else t. 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)) + (cl-assert (<= start (point)) (<= (point) end)) (with-wrapper-hook ;; FIXME: Maybe we should use this hook to provide a "display ;; completions" operation as well. @@ -1788,7 +1794,7 @@ the mode if ARG is omitted or nil." (unless (equal "*Completions*" (buffer-name (window-buffer))) (minibuffer-hide-completions)) ;; (add-hook 'pre-command-hook #'completion-in-region--prech) - (assert completion-in-region-mode-predicate) + (cl-assert completion-in-region-mode-predicate) (setq completion-in-region-mode--predicate completion-in-region-mode-predicate) (add-hook 'post-command-hook #'completion-in-region--postch) @@ -1831,10 +1837,10 @@ a completion function or god knows what else.") ;; always return the same kind of data, but this breaks down with functions ;; like comint-completion-at-point or mh-letter-completion-at-point, which ;; could be sometimes safe and sometimes misbehaving (and sometimes neither). - (if (case which - (all t) - (safe (member fun completion--capf-safe-funs)) - (optimist (not (member fun completion--capf-misbehave-funs)))) + (if (pcase which + (`all t) + (`safe (member fun completion--capf-safe-funs)) + (`optimist (not (member fun completion--capf-misbehave-funs)))) (let ((res (funcall fun))) (cond ((and (consp res) (not (functionp res))) @@ -2040,10 +2046,10 @@ same as `substitute-in-file-name'." (if (eq action 'metadata) '(metadata (category . environment-variable)) (let ((suffix (cdr action))) - (list* 'boundaries - (or (match-beginning 2) (match-beginning 1)) - (when (string-match "[^[:alnum:]_]" suffix) - (match-beginning 0))))))) + `(boundaries + ,(or (match-beginning 2) (match-beginning 1)) + . ,(when (string-match "[^[:alnum:]_]" suffix) + (match-beginning 0))))))) (t (if (eq (aref string (1- beg)) ?{) (setq table (apply-partially 'completion-table-with-terminator @@ -2068,14 +2074,14 @@ same as `substitute-in-file-name'." ((eq (car-safe action) 'boundaries) (let ((start (length (file-name-directory string))) (end (string-match-p "/" (cdr action)))) - (list* 'boundaries - ;; if `string' is "C:" in w32, (file-name-directory string) - ;; returns "C:/", so `start' is 3 rather than 2. - ;; Not quite sure what is The Right Fix, but clipping it - ;; back to 2 will work for this particular case. We'll - ;; see if we can come up with a better fix when we bump - ;; into more such problematic cases. - (min start (length string)) end))) + `(boundaries + ;; if `string' is "C:" in w32, (file-name-directory string) + ;; returns "C:/", so `start' is 3 rather than 2. + ;; Not quite sure what is The Right Fix, but clipping it + ;; back to 2 will work for this particular case. We'll + ;; see if we can come up with a better fix when we bump + ;; into more such problematic cases. + ,(min start (length string)) . ,end))) ((eq action 'lambda) (if (zerop (length string)) @@ -2130,6 +2136,12 @@ same as `substitute-in-file-name'." ;; find the position corresponding to UPOS in QSTR, but ;; substitute-in-file-name can do anything, depending on file-name-handlers. ;; Kind of like in rfn-eshadow-update-overlay, only worse. + ;; FIXME: example of thing we do not handle: Tramp's makes + ;; (substitute-in-file-name "/foo:~/bar//baz") -> "/scpc:foo:/baz". + ;; FIXME: One way to try and handle "all" cases is to require + ;; substitute-in-file-name to preserve text-properties, so we could + ;; apply text-properties to the input string and then look for them in + ;; the output to understand what comes from where. (let ((qpos 0)) ;; Handle substitute-in-file-name's truncation behavior. (let (tpos) @@ -2651,7 +2663,7 @@ or a symbol, see `completion-pcm--merge-completions'." (setq p0 (1+ p))) (push 'any pattern) (setq p0 p)) - (incf p)) + (cl-incf p)) ;; An empty string might be erroneously added at the beginning. ;; It should be avoided properly, but it's so easy to remove it here. @@ -2676,7 +2688,7 @@ or a symbol, see `completion-pcm--merge-completions'." (defun completion-pcm--all-completions (prefix pattern table pred) "Find all completions for PATTERN in TABLE obeying PRED. PATTERN is as returned by `completion-pcm--string->pattern'." - ;; (assert (= (car (completion-boundaries prefix table pred "")) + ;; (cl-assert (= (car (completion-boundaries prefix table pred "")) ;; (length prefix))) ;; Find an initial list of possible completions. (if (completion-pcm--pattern-trivial-p pattern) @@ -2750,9 +2762,9 @@ filter out additional entries (because TABLE might not obey PRED)." ;; The prefix has no completions at all, so we should try and fix ;; that first. (let ((substring (substring prefix 0 -1))) - (destructuring-bind (subpat suball subprefix _subsuffix) - (completion-pcm--find-all-completions - substring table pred (length substring) filter) + (pcase-let ((`(,subpat ,suball ,subprefix ,_subsuffix) + (completion-pcm--find-all-completions + substring table pred (length substring) filter))) (let ((sep (aref prefix (1- (length prefix)))) ;; Text that goes between the new submatches and the ;; completion substring. @@ -2816,22 +2828,22 @@ filter out additional entries (because TABLE might not obey PRED)." (list pattern all prefix suffix))))) (defun completion-pcm-all-completions (string table pred point) - (destructuring-bind (pattern all &optional prefix _suffix) - (completion-pcm--find-all-completions string table pred point) + (pcase-let ((`(,pattern ,all ,prefix ,_suffix) + (completion-pcm--find-all-completions string table pred point))) (when all (nconc (completion-pcm--hilit-commonality pattern all) (length prefix))))) (defun completion--sreverse (str) "Like `reverse' but for a string STR rather than a list." - (apply 'string (nreverse (mapcar 'identity str)))) + (apply #'string (nreverse (mapcar 'identity str)))) (defun completion--common-suffix (strs) "Return the common suffix of the strings STRS." (completion--sreverse (try-completion "" - (mapcar 'completion--sreverse strs)))) + (mapcar #'completion--sreverse strs)))) (defun completion-pcm--merge-completions (strs pattern) "Extract the commonality in STRS, with the help of PATTERN. @@ -2916,7 +2928,7 @@ the same set of elements." ;; `any' it could lead to a merged completion that ;; doesn't itself match the candidates. (let ((suffix (completion--common-suffix comps))) - (assert (stringp suffix)) + (cl-assert (stringp suffix)) (unless (equal suffix "") (push suffix res))))) (setq fixed ""))))) @@ -2980,11 +2992,11 @@ the same set of elements." (cons (concat prefix merged suffix) (+ newpos (length prefix))))))) (defun completion-pcm-try-completion (string table pred point) - (destructuring-bind (pattern all prefix suffix) - (completion-pcm--find-all-completions - string table pred point - (if minibuffer-completing-file-name - 'completion-pcm--filename-try-filter)) + (pcase-let ((`(,pattern ,all ,prefix ,suffix) + (completion-pcm--find-all-completions + string table pred point + (if minibuffer-completing-file-name + 'completion-pcm--filename-try-filter)))) (completion-pcm--merge-try pattern all prefix suffix))) ;;; Substring completion @@ -3005,15 +3017,17 @@ the same set of elements." (list all pattern prefix suffix (car bounds)))) (defun completion-substring-try-completion (string table pred point) - (destructuring-bind (all pattern prefix suffix _carbounds) - (completion-substring--all-completions string table pred point) + (pcase-let ((`(,all ,pattern ,prefix ,suffix ,_carbounds) + (completion-substring--all-completions + string table pred point))) (if minibuffer-completing-file-name (setq all (completion-pcm--filename-try-filter all))) (completion-pcm--merge-try pattern all prefix suffix))) (defun completion-substring-all-completions (string table pred point) - (destructuring-bind (all pattern prefix _suffix _carbounds) - (completion-substring--all-completions string table pred point) + (pcase-let ((`(,all ,pattern ,prefix ,_suffix ,_carbounds) + (completion-substring--all-completions + string table pred point))) (when all (nconc (completion-pcm--hilit-commonality pattern all) (length prefix))))) diff --git a/lisp/misearch.el b/lisp/misearch.el index 4848b6691bc..502de52a05f 100644 --- a/lisp/misearch.el +++ b/lisp/misearch.el @@ -373,5 +373,5 @@ whose file names match the specified wildcard." (provide 'multi-isearch) - +(provide 'misearch) ;;; misearch.el ends here diff --git a/lisp/mouse.el b/lisp/mouse.el index fb2e67408bd..71336c08ee3 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -101,8 +101,11 @@ point at the click position." "Popup the given menu and call the selected option. MENU can be a keymap, an easymenu-style menu or a list of keymaps as for `x-popup-menu'. -POSITION can be a click event or ((XOFFSET YOFFSET) WINDOW) and defaults to - the current mouse position. + +POSITION can be a click event or ((XOFFSET YOFFSET) WINDOW) and +defaults to the current mouse position. If POSITION is the +symbol `point', the current point position is used. + PREFIX is the prefix argument (if any) to pass to the command." (let* ((map (cond ((keymapp menu) menu) @@ -112,9 +115,17 @@ PREFIX is the prefix argument (if any) to pass to the command." (plist-get (get map 'menu-prop) :filter)))) (if filter (funcall filter (symbol-function map)) map))))) event cmd) - (unless position - (let ((mp (mouse-pixel-position))) - (setq position (list (list (cadr mp) (cddr mp)) (car mp))))) + (setq position + (cond + ((eq position 'point) + (let* ((pp (posn-at-point)) + (xy (posn-x-y pp))) + (list (list (car xy) (cdr xy)) (posn-window pp)))) + ((not position) + (let ((mp (mouse-pixel-position))) + (list (list (cadr mp) (cddr mp)) (car mp)))) + (t + position))) ;; The looping behavior was taken from lmenu's popup-menu-popup (while (and map (setq event ;; map could be a prefix key, in which case @@ -132,7 +143,7 @@ PREFIX is the prefix argument (if any) to pass to the command." binding) (while (and map (null binding)) (setq binding (lookup-key (car map) mouse-click)) - (if (numberp binding) ; `too long' + (if (numberp binding) ; `too long' (setq binding nil)) (setq map (cdr map))) binding) @@ -388,10 +399,11 @@ This command must be bound to a mouse click." ;; Note that `window-in-direction' replaces `mouse-drag-window-above' ;; and `mouse-drag-vertical-line-rightward-window' with Emacs 24.1. + (defun mouse-drag-line (start-event line) - "Drag some line with the mouse. + "Drag a mode line, header line, or vertical line with the mouse. START-EVENT is the starting mouse-event of the drag action. LINE -must be one of the symbols header, mode, or vertical." +must be one of the symbols `header', `mode', or `vertical'." ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) (let* ((echo-keystrokes 0) @@ -400,66 +412,60 @@ must be one of the symbols header, mode, or vertical." (frame (window-frame window)) (minibuffer-window (minibuffer-window frame)) (on-link (and mouse-1-click-follows-link - (or mouse-1-click-in-non-selected-windows - (eq window (selected-window))) (mouse-on-link-p start))) - (resize-minibuffer - ;; Resize the minibuffer window if it's on the same frame as - ;; and immediately below the position window and it's either - ;; active or `resize-mini-windows' is nil. - (and (eq line 'mode) - (eq (window-frame minibuffer-window) frame) - (= (nth 1 (window-edges minibuffer-window)) - (nth 3 (window-edges window))) - (or (not resize-mini-windows) - (eq minibuffer-window (active-minibuffer-window))))) - (which-side - (and (eq line 'vertical) - (or (cdr (assq 'vertical-scroll-bars (frame-parameters frame))) - 'right))) - done event mouse growth dragged) + (side (and (eq line 'vertical) + (or (cdr (assq 'vertical-scroll-bars + (frame-parameters frame))) + 'right))) + (draggable t) + event position growth dragged) (cond ((eq line 'header) ;; Check whether header-line can be dragged at all. (if (window-at-side-p window 'top) - (setq done t) + (setq draggable nil) (setq window (window-in-direction 'above window t)))) ((eq line 'mode) ;; Check whether mode-line can be dragged at all. - (when (and (window-at-side-p window 'bottom) - (not resize-minibuffer)) - (setq done t))) + (and (window-at-side-p window 'bottom) + ;; Allow resizing the minibuffer window if it's on the same + ;; frame as and immediately below the clicked window, and + ;; it's active or `resize-mini-windows' is nil. + (not (and (eq (window-frame minibuffer-window) frame) + (= (nth 1 (window-edges minibuffer-window)) + (nth 3 (window-edges window))) + (or (not resize-mini-windows) + (eq minibuffer-window + (active-minibuffer-window))))) + (setq draggable nil))) ((eq line 'vertical) - ;; Get the window to adjust for the vertical case. - (setq window - (if (eq which-side 'right) - ;; If the scroll bar is on the window's right or there's - ;; no scroll bar at all, adjust the window where the - ;; start-event occurred. - window - ;; If the scroll bar is on the start-event window's left, - ;; adjust the window on the left of it. - (window-in-direction 'left window t))))) + ;; Get the window to adjust for the vertical case. If the + ;; scroll bar is on the window's right or there's no scroll bar + ;; at all, adjust the window where the start-event occurred. If + ;; the scroll bar is on the start-event window's left, adjust + ;; the window on the left of it. + (unless (eq side 'right) + (setq window (window-in-direction 'left window t))))) ;; Start tracking. (track-mouse ;; Loop reading events and sampling the position of the mouse. - (while (not done) + (while draggable (setq event (read-event)) - (setq mouse (mouse-position)) + (setq position (mouse-position)) ;; Do nothing if ;; - there is a switch-frame event. ;; - the mouse isn't in the frame that we started in ;; - the mouse isn't in any Emacs frame ;; Drag if ;; - there is a mouse-movement event - ;; - there is a scroll-bar-movement event (??) + ;; - there is a scroll-bar-movement event (Why? -- cyd) ;; (same as mouse movement for our purposes) ;; Quit if ;; - there is a keyboard event or some other unknown event. (cond ((not (consp event)) - (setq done t)) + (setq draggable nil)) ((memq (car event) '(switch-frame select-window)) nil) ((not (memq (car event) '(mouse-movement scroll-bar-movement))) @@ -473,49 +479,39 @@ must be one of the symbols header, mode, or vertical." (memq (car event) '(drag-mouse-1 mouse-1)) (eq (car event) 'drag-mouse-1))) (push event unread-command-events))) - (setq done t)) - ((or (not (eq (car mouse) frame)) (null (car (cdr mouse)))) + (setq draggable nil)) + ((or (not (eq (car position) frame)) + (null (car (cdr position)))) nil) ((eq line 'vertical) - ;; Drag vertical divider (the calculations below are those - ;; from Emacs 23). - (setq growth - (- (- (cadr mouse) - (if (eq which-side 'right) 0 2)) - (nth 2 (window-edges window)) - -1)) + ;; Drag vertical divider. + (setq growth (- (cadr position) + (if (eq side 'right) 0 2) + (nth 2 (window-edges window)) + -1)) (unless (zerop growth) - ;; Remember that we dragged. (setq dragged t)) (adjust-window-trailing-edge window growth t)) - (t - ;; Drag horizontal divider (the calculations below are those - ;; from Emacs 23). + (draggable + ;; Drag horizontal divider. (setq growth (if (eq line 'mode) - (- (cddr mouse) (nth 3 (window-edges window)) -1) + (- (cddr position) (nth 3 (window-edges window)) -1) ;; The window's top includes the header line! - (- (nth 3 (window-edges window)) (cddr mouse)))) - + (- (nth 3 (window-edges window)) (cddr position)))) (unless (zerop growth) - ;; Remember that we dragged. (setq dragged t)) - - (if (eq line 'mode) - (adjust-window-trailing-edge window growth) - (adjust-window-trailing-edge window (- growth)))))) - - ;; Presumably, if this was just a click, the last event should be - ;; `mouse-1', whereas if this did move the mouse, it should be a - ;; `drag-mouse-1'. `dragged' nil tells us that we never dragged - ;; and `on-link' tells us that there is a link to follow. - (when (and on-link (not dragged) - (eq 'mouse-1 (car-safe (car unread-command-events)))) - ;; If mouse-2 has never been done by the user, it doesn't - ;; have the necessary property to be interpreted correctly. - (put 'mouse-2 'event-kind 'mouse-click) - (setcar unread-command-events - (cons 'mouse-2 (cdar unread-command-events))))))) + (adjust-window-trailing-edge window (if (eq line 'mode) + growth + (- growth))))))) + ;; Process the terminating event. + (when (and (mouse-event-p event) on-link (not dragged) + (mouse--remap-link-click-p start-event event)) + ;; If mouse-2 has never been done by the user, it doesn't have + ;; the necessary property to be interpreted correctly. + (put 'mouse-2 'event-kind 'mouse-click) + (setcar event 'mouse-2)) + (push event unread-command-events))) (defun mouse-drag-mode-line (start-event) "Change the height of a window by dragging on the mode line." @@ -791,10 +787,8 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by ;; Don't count the mode line. (1- (nth 3 bounds)))) (on-link (and mouse-1-click-follows-link - (or mouse-1-click-in-non-selected-windows - (eq start-window original-window)) ;; Use start-point before the intangibility - ;; treatment, in case we click on a link inside an + ;; treatment, in case we click on a link inside ;; intangible text. (mouse-on-link-p start-posn))) (click-count (1- (event-click-count start-event))) @@ -884,10 +878,12 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by (copy-region-as-kill (mark) (point))))) ;; Otherwise, run binding of terminating up-event. - (cond - (do-multi-click (goto-char start-point)) - (moved-off-start (deactivate-mark)) - (t (pop-mark))) + (if do-multi-click + (goto-char start-point) + (deactivate-mark) + (unless moved-off-start + (pop-mark))) + (when (and (functionp fun) (= start-hscroll (window-hscroll start-window)) ;; Don't run the up-event handler if the window diff --git a/lisp/mpc.el b/lisp/mpc.el index a908e4bedac..ff5ce801c63 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -92,7 +92,7 @@ ;; UI-commands : mpc- ;; internal : mpc-- -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defgroup mpc () "Client for the Music Player Daemon (mpd)." @@ -292,7 +292,7 @@ and HOST defaults to localhost." (defconst mpc--proc-alist-to-alists-starters '(file directory)) (defun mpc--proc-alist-to-alists (alist) - (assert (or (null alist) + (cl-assert (or (null alist) (memq (caar alist) mpc--proc-alist-to-alists-starters))) (let ((starter (caar alist)) (alists ()) @@ -457,7 +457,7 @@ to call FUN for any change whatsoever.") (let ((old-status mpc-status)) ;; Update the alist. (setq mpc-status (mpc-proc-buf-to-alist)) - (assert mpc-status) + (cl-assert mpc-status) (unless (equal old-status mpc-status) ;; Run the relevant refresher functions. (dolist (pair mpc-status-callbacks) @@ -544,7 +544,7 @@ Any call to `mpc-status-refresh' may cause it to be restarted." ;; (defun mpc--queue-pop () ;; (when mpc-queue ;Can be nil if out of sync. ;; (let ((song (car mpc-queue))) -;; (assert song) +;; (cl-assert song) ;; (push (if (and (consp song) (cddr song)) ;; ;; The queue's first element is itself a list of ;; ;; songs, where the first element isn't itself a song @@ -553,7 +553,7 @@ Any call to `mpc-status-refresh' may cause it to be restarted." ;; (prog1 (if (consp song) (cadr song) song) ;; (setq mpc-queue (cdr mpc-queue)))) ;; mpc-queue-back) -;; (assert (stringp (car mpc-queue-back)))))) +;; (cl-assert (stringp (car mpc-queue-back)))))) ;; (defun mpc--queue-refresh () ;; ;; Maintain the queue. @@ -611,7 +611,7 @@ The songs are returned as alists." (i 0)) (mapcar (lambda (s) (prog1 (cons (cons 'Pos (number-to-string i)) s) - (incf i))) + (cl-incf i))) l))) ((eq tag 'Search) (mpc-proc-buf-to-alists @@ -827,8 +827,8 @@ If PLAYLIST is t or nil or missing, use the main playlist." (list "move" song-pos dest-pos)) (if (< song-pos dest-pos) ;; This move has shifted dest-pos by 1. - (decf dest-pos)) - (incf i))) + (cl-decf dest-pos)) + (cl-incf i))) ;; Sort them from last to first, so the renumbering ;; caused by the earlier deletions affect ;; later ones a bit less. @@ -972,8 +972,8 @@ If PLAYLIST is t or nil or missing, use the main playlist." (right-align (match-end 1)) (text (if (eq info 'self) (symbol-name tag) - (case tag - ((Time Duration) + (pcase tag + ((or `Time `Duration) (let ((time (cdr (or (assq 'time info) (assq 'Time info))))) (setq pred (list nil)) ;Just assume it's never eq. (when time @@ -981,7 +981,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." (string-match ":" time)) (substring time (match-end 0)) time))))) - (Cover + (`Cover (let* ((dir (file-name-directory (cdr (assq 'file info)))) (cover (concat dir "cover.jpg")) (file (condition-case err @@ -1004,7 +1004,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." (mpc-tempfiles-add image tempfile))) (setq size nil) (propertize dir 'display image)))) - (t (let ((val (cdr (assq tag info)))) + (_ (let ((val (cdr (assq tag info)))) ;; For Streaming URLs, there's no other info ;; than the URL in `file'. Pretend it's in `Title'. (when (and (null val) (eq tag 'Title)) @@ -1222,7 +1222,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." (beginning-of-line)) (defun mpc-select-make-overlay () - (assert (not (get-char-property (point) 'mpc-select))) + (cl-assert (not (get-char-property (point) 'mpc-select))) (let ((ol (make-overlay (line-beginning-position) (line-beginning-position 2)))) (overlay-put ol 'mpc-select t) @@ -1258,7 +1258,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." (> (overlay-end ol) (point))) (delete-overlay ol) (push ol ols))) - (assert (= (1+ (length ols)) (length mpc-select))) + (cl-assert (= (1+ (length ols)) (length mpc-select))) (setq mpc-select ols))) ;; We're trying to select *ALL* additionally to others. ((mpc-tagbrowser-all-p) nil) @@ -1286,12 +1286,12 @@ If PLAYLIST is t or nil or missing, use the main playlist." (while (and (zerop (forward-line 1)) (get-char-property (point) 'mpc-select)) (setq end (1+ (point))) - (incf after)) + (cl-incf after)) (goto-char mid) (while (and (zerop (forward-line -1)) (get-char-property (point) 'mpc-select)) (setq start (point)) - (incf before)) + (cl-incf before)) (if (and (= after 0) (= before 0)) ;; Shortening an already minimum-size region: do nothing. nil @@ -1315,13 +1315,13 @@ If PLAYLIST is t or nil or missing, use the main playlist." (start (line-beginning-position))) (while (and (zerop (forward-line 1)) (not (get-char-property (point) 'mpc-select))) - (incf count)) + (cl-incf count)) (unless (get-char-property (point) 'mpc-select) (setq count nil)) (goto-char start) (while (and (zerop (forward-line -1)) (not (get-char-property (point) 'mpc-select))) - (incf before)) + (cl-incf before)) (unless (get-char-property (point) 'mpc-select) (setq before nil)) (when (and before (or (null count) (< before count))) @@ -1430,7 +1430,7 @@ when constructing the set of constraints." (mpc-select-save (widen) (goto-char (point-min)) - (assert (looking-at (regexp-quote mpc-tagbrowser-all-name))) + (cl-assert (looking-at (regexp-quote mpc-tagbrowser-all-name))) (forward-line 1) (let ((inhibit-read-only t)) (delete-region (point) (point-max)) @@ -1916,7 +1916,7 @@ This is used so that they can be compared with `eq', which is needed for (cdr (assq 'file song1)) (cdr (assq 'file song2))))) (and (integerp cmp) (< cmp 0))))))) - (incf totaltime (string-to-number (or (cdr (assq 'Time song)) "0"))) + (cl-incf totaltime (string-to-number (or (cdr (assq 'Time song)) "0"))) (mpc-format mpc-songs-format song) (delete-char (- (skip-chars-backward " "))) ;Remove trailing space. (insert "\n") @@ -2040,7 +2040,7 @@ This is used so that they can be compared with `eq', which is needed for (- (point) (car prev))) next prev) (or next prev))))) - (assert sn) + (cl-assert sn) (mpc-proc-cmd (concat "play " sn)))))))))) (define-derived-mode mpc-songs-mode mpc-mode "MPC-song" @@ -2155,12 +2155,12 @@ This is used so that they can be compared with `eq', which is needed for (dolist (song (car context)) (and (zerop (forward-line -1)) (eq (get-text-property (point) 'mpc-file) song) - (incf count))) + (cl-incf count))) (goto-char pos) (dolist (song (cdr context)) (and (zerop (forward-line 1)) (eq (get-text-property (point) 'mpc-file) song) - (incf count))) + (cl-incf count))) count)) (defun mpc-songpointer-refresh-hairy () @@ -2201,13 +2201,13 @@ This is used so that they can be compared with `eq', which is needed for ((< score context-size) nil) (t ;; Score is equal and increasing context might help: try it. - (incf context-size) + (cl-incf context-size) (let ((new-context (mpc-songpointer-context context-size plbuf))) (if (null new-context) ;; There isn't more context: choose one arbitrarily ;; and keep looking for a better match elsewhere. - (decf context-size) + (cl-decf context-size) (setq context new-context) (setq score (mpc-songpointer-score context pos)) (save-excursion diff --git a/lisp/msb.el b/lisp/msb.el index 760ff61a876..d9fb2c55d87 100644 --- a/lisp/msb.el +++ b/lisp/msb.el @@ -77,13 +77,13 @@ ;; hacked on by Dave Love. ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) -;;; -;;; Some example constants to be used for `msb-menu-cond'. See that -;;; variable for more information. Please note that if the condition -;;; returns `multi', then the buffer can appear in several menus. -;;; +;; +;; Some example constants to be used for `msb-menu-cond'. See that +;; variable for more information. Please note that if the condition +;; returns `multi', then the buffer can appear in several menus. +;; (defconst msb--few-menus '(((and (boundp 'server-buffer-clients) server-buffer-clients @@ -702,18 +702,18 @@ See `msb-menu-cond' for a description of its elements." (multi-flag nil) function-info-list) (setq function-info-list - (loop for fi - across function-info-vector - if (and (setq result - (eval (aref fi 1))) ;Test CONDITION - (not (and (eq result 'no-multi) - multi-flag)) - (progn (when (eq result 'multi) - (setq multi-flag t)) - t)) - collect fi - until (and result - (not (eq result 'multi))))) + (cl-loop for fi + across function-info-vector + if (and (setq result + (eval (aref fi 1))) ;Test CONDITION + (not (and (eq result 'no-multi) + multi-flag)) + (progn (when (eq result 'multi) + (setq multi-flag t)) + t)) + collect fi + until (and result + (not (eq result 'multi))))) (when (and (not function-info-list) (not result)) (error "No catch-all in msb-menu-cond!")) @@ -817,7 +817,7 @@ results in (defun msb--mode-menu-cond () (let ((key msb-modes-key)) (mapcar (lambda (item) - (incf key) + (cl-incf key) (list `( eq major-mode (quote ,(car item))) key (concat (cdr item) " (%d)"))) @@ -841,18 +841,18 @@ It takes the form ((TITLE . BUFFER-LIST)...)." (> msb-display-most-recently-used 0)) (let* ((buffers (cdr (buffer-list))) (most-recently-used - (loop with n = 0 - for buffer in buffers - if (with-current-buffer buffer - (and (not (msb-invisible-buffer-p)) - (not (eq major-mode 'dired-mode)))) - collect (with-current-buffer buffer - (cons (funcall msb-item-handling-function - buffer - max-buffer-name-length) - buffer)) - and do (incf n) - until (>= n msb-display-most-recently-used)))) + (cl-loop with n = 0 + for buffer in buffers + if (with-current-buffer buffer + (and (not (msb-invisible-buffer-p)) + (not (eq major-mode 'dired-mode)))) + collect (with-current-buffer buffer + (cons (funcall msb-item-handling-function + buffer + max-buffer-name-length) + buffer)) + and do (cl-incf n) + until (>= n msb-display-most-recently-used)))) (cons (if (stringp msb-most-recently-used-title) (format msb-most-recently-used-title (length most-recently-used)) @@ -899,29 +899,29 @@ It takes the form ((TITLE . BUFFER-LIST)...)." (when file-buffers (setq file-buffers (mapcar (lambda (buffer-list) - (list* msb-files-by-directory-sort-key - (car buffer-list) - (sort - (mapcar (lambda (buffer) - (cons (with-current-buffer buffer - (funcall - msb-item-handling-function - buffer - max-buffer-name-length)) - buffer)) - (cdr buffer-list)) - (lambda (item1 item2) - (string< (car item1) (car item2)))))) + `(,msb-files-by-directory-sort-key + ,(car buffer-list) + ,@(sort + (mapcar (lambda (buffer) + (cons (with-current-buffer buffer + (funcall + msb-item-handling-function + buffer + max-buffer-name-length)) + buffer)) + (cdr buffer-list)) + (lambda (item1 item2) + (string< (car item1) (car item2)))))) (msb--choose-file-menu file-buffers)))) ;; Now make the menu - a list of (TITLE . BUFFER-LIST) (let* (menu (most-recently-used (msb--most-recently-used-menu max-buffer-name-length)) (others (nconc file-buffers - (loop for elt - across function-info-vector - for value = (msb--create-sort-item elt) - if value collect value)))) + (cl-loop for elt + across function-info-vector + for value = (msb--create-sort-item elt) + if value collect value)))) (setq menu (mapcar 'cdr ;Remove the SORT-KEY ;; Sort the menus - not the items. @@ -1039,7 +1039,7 @@ variable `msb-menu-cond'." (tmp-list nil)) (while (< count msb-max-menu-items) (push (pop list) tmp-list) - (incf count)) + (cl-incf count)) (setq tmp-list (nreverse tmp-list)) (setq sub-name (concat (car (car tmp-list)) "...")) (push (nconc (list mcount sub-name @@ -1076,7 +1076,7 @@ variable `msb-menu-cond'." (cons (buffer-name (cdr item)) (cons (car item) end))) (cdr sub-menu)))) - (nconc (list (incf mcount) (car sub-menu) + (nconc (list (cl-incf mcount) (car sub-menu) 'keymap (car sub-menu)) (msb--split-menus buffers)))))) raw-menu))) diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 4ca40fdabef..dd695c29c78 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -1200,6 +1200,11 @@ only return the directory part of FILE." (defun ange-ftp-get-passwd (host user) "Return the password for specified HOST and USER, asking user if necessary." + ;; If `non-essential' is non-nil, don't ask for a password. It will + ;; be caught in Tramp. + (when non-essential + (throw 'non-essential 'non-essential)) + (ange-ftp-parse-netrc) ;; look up password in the hash table first; user might have overridden the @@ -1230,7 +1235,8 @@ only return the directory part of FILE." ;; see if same user has logged in to other hosts; if so then prompt ;; with the password that was used there. (t - (let* ((other (ange-ftp-get-host-with-passwd user)) + (let* ((enable-recursive-minibuffers t) + (other (ange-ftp-get-host-with-passwd user)) (passwd (if other ;; found another machine with the same user. @@ -1775,7 +1781,7 @@ good, skip, fatal, or unknown." (defun ange-ftp-gwp-start (host user name args) "Login to the gateway machine and fire up an FTP process." ;; If `non-essential' is non-nil, don't reopen a new connection. It - ;; will be catched in Tramp. + ;; will be caught in Tramp. (when non-essential (throw 'non-essential 'non-essential)) (let (;; It would be nice to make process-connection-type nil, @@ -1910,7 +1916,7 @@ been queued with no result. CONT will still be called, however." If HOST is only FTP-able through a gateway machine then spawn a shell on the gateway machine to do the FTP instead." ;; If `non-essential' is non-nil, don't reopen a new connection. It - ;; will be catched in Tramp. + ;; will be caught in Tramp. (when non-essential (throw 'non-essential 'non-essential)) (let* ((use-gateway (ange-ftp-use-gateway-p host)) @@ -2131,6 +2137,11 @@ Create a new process if needed." (proc (get-process name))) (if (and proc (memq (process-status proc) '(run open))) proc + ;; If `non-essential' is non-nil, don't reopen a new connection. It + ;; will be caught in Tramp. + (when non-essential + (throw 'non-essential 'non-essential)) + ;; Must delete dead process so that new process can reuse the name. (if proc (delete-process proc)) (let ((pass (ange-ftp-quote-string @@ -3132,21 +3143,15 @@ logged in as user USER and cd'd to directory DIR." "Documented as `expand-file-name'." (save-match-data (setq default (or default default-directory)) - (cond ((eq (string-to-char name) ?~) - (ange-ftp-real-expand-file-name name)) - ((eq (string-to-char name) ?/) - (ange-ftp-canonize-filename name)) - ((and (eq system-type 'windows-nt) - (eq (string-to-char name) ?\\)) - (ange-ftp-canonize-filename name)) - ((and (eq system-type 'windows-nt) - (or (string-match "\\`[a-zA-Z]:" name) - (string-match "\\`[a-zA-Z]:" default))) - (ange-ftp-real-expand-file-name name default)) - ((zerop (length name)) - (ange-ftp-canonize-filename default)) - ((ange-ftp-canonize-filename - (concat (file-name-as-directory default) name)))))) + (cond + ((ange-ftp-ftp-name name) + ;; `default' is irrelevant. + (ange-ftp-canonize-filename name)) + ((file-name-absolute-p name) + ;; `name' is absolute but is not an ange-ftp name => not ange-ftp. + (ange-ftp-real-expand-file-name name "/")) + ((ange-ftp-canonize-filename + (concat (file-name-as-directory default) name)))))) ;;; These are problems--they are currently not enabled. @@ -3379,7 +3384,7 @@ system TYPE.") (if (ange-ftp-file-entry-p name) (let ((file-ent (ange-ftp-get-file-entry name))) (if (stringp file-ent) - (file-exists-p + (ange-ftp-file-exists-p (ange-ftp-expand-symlink file-ent (file-name-directory (directory-file-name name)))) @@ -3788,7 +3793,8 @@ so return the size on the remote host exactly. See RFC 3659." (format "Copying %s to %s" f-abbr t-abbr))) (list 'ange-ftp-cf2 newname t-host t-user binary temp1 temp2 cont) - nowait)) + nowait) + (ange-ftp-add-file-entry newname)) ;; newname wasn't remote. (ange-ftp-cf2 t nil newname t-host t-user binary temp1 temp2 cont)) @@ -3963,10 +3969,15 @@ E.g., (string-match "\\`[a-zA-Z]:[/\\]\\'" dir)) (string-equal "/" dir))) +(defmacro ange-ftp-ignore-errors-if-non-essential (&rest body) + `(if non-essential + (ignore-errors ,@body) + (progn ,@body))) + (defun ange-ftp-file-name-all-completions (file dir) (let ((ange-ftp-this-dir (expand-file-name dir))) (if (ange-ftp-ftp-name ange-ftp-this-dir) - (progn + (ange-ftp-ignore-errors-if-non-essential (ange-ftp-barf-if-not-directory ange-ftp-this-dir) (setq ange-ftp-this-dir (ange-ftp-real-file-name-as-directory ange-ftp-this-dir)) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index a57b7cc0c7c..f7aa5f8ed52 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -205,8 +205,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Variables -(eval-when-compile (require 'cl)) - (defgroup browse-url nil "Use a web browser to look at a URL." :prefix "browse-url-" @@ -1630,22 +1628,21 @@ from `browse-url-elinks-wrapper'." (defun browse-url-elinks-sentinel (process url) "Determines if Elinks is running or a new one has to be started." - (let ((exit-status (process-exit-status process))) - ;; Try to determine if an instance is running or if we have to - ;; create a new one. - (case exit-status - (5 - ;; No instance, start a new one. - (browse-url-elinks-new-window url)) - (0 - ;; Found an instance, open URL in new tab. - (let ((process-environment (browse-url-process-environment))) - (start-process (concat "elinks:" url) nil - "elinks" "-remote" - (concat "openURL(\"" url "\",new-tab)")))) - (otherwise - (error "Unrecognized exit-code %d of process `elinks'" - exit-status))))) + ;; Try to determine if an instance is running or if we have to + ;; create a new one. + (pcase (process-exit-status process) + (5 + ;; No instance, start a new one. + (browse-url-elinks-new-window url)) + (0 + ;; Found an instance, open URL in new tab. + (let ((process-environment (browse-url-process-environment))) + (start-process (concat "elinks:" url) nil + "elinks" "-remote" + (concat "openURL(\"" url "\",new-tab)")))) + (exit-status + (error "Unrecognized exit-code %d of process `elinks'" + exit-status)))) (provide 'browse-url) diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 7d6dcf37a01..d0200f4cb9d 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -45,8 +45,7 @@ (defvar dbus-registered-objects-table) ;; Pacify byte compiler. -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'xml) @@ -494,20 +493,20 @@ placed in the queue. (dolist (flag flags) (setq arg (+ arg - (case flag + (pcase flag (:allow-replacement 1) (:replace-existing 2) (:do-not-queue 4) - (t (signal 'wrong-type-argument (list flag))))))) + (_ (signal 'wrong-type-argument (list flag))))))) (setq reply (dbus-call-method bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "RequestName" service arg)) - (case reply + (pcase reply (1 :primary-owner) (2 :in-queue) (3 :exists) (4 :already-owner) - (t (signal 'dbus-error (list "Could not register service" service)))))) + (_ (signal 'dbus-error (list "Could not register service" service)))))) (defun dbus-unregister-service (bus service) "Unregister all objects related to SERVICE from D-Bus BUS. @@ -536,11 +535,11 @@ queue of this service." (let ((reply (dbus-call-method bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ReleaseName" service))) - (case reply + (pcase reply (1 :released) (2 :non-existent) (3 :not-owner) - (t (signal 'dbus-error (list "Could not unregister service" service)))))) + (_ (signal 'dbus-error (list "Could not unregister service" service)))))) (defun dbus-register-signal (bus service path interface signal handler &rest args) @@ -803,7 +802,7 @@ association to the service from D-Bus." ;; Service. (string-equal service (cadr e)) ;; Non-empty object path. - (caddr e) + (cl-caddr e) (throw :found t))))) dbus-registered-objects-table) nil)))) @@ -1383,7 +1382,7 @@ name of the property, and its value. If there are no properties, bus service path dbus-interface-properties "GetAll" :timeout 500 interface) result) - (add-to-list 'result (cons (car dict) (caadr dict)) 'append))))) + (add-to-list 'result (cons (car dict) (cl-caadr dict)) 'append))))) (defun dbus-register-property (bus service path interface property access value @@ -1581,7 +1580,7 @@ and \"org.freedesktop.DBus.Properties.GetAll\", which is slow." (if (cadr entry2) ;; "sv". (dolist (entry3 (cadr entry2)) - (setcdr entry3 (caadr entry3))) + (setcdr entry3 (cl-caadr entry3))) (setcdr entry2 nil))))) ;; Fallback: collect the information. Slooow! diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 9bd01806d24..0e9707e57f3 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -48,9 +48,7 @@ (eval-and-compile (if (not (fboundp 'make-overlay)) - (require 'overlay)) - (if (not (fboundp 'unless)) - (require 'cl))) + (require 'overlay))) (unless (fboundp 'custom-menu-create) (autoload 'custom-menu-create "cus-edit")) diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index a306384c775..d33480afb28 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -35,7 +35,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defgroup gnutls nil "Emacs interface to the GnuTLS library." @@ -120,7 +120,7 @@ trust and key files, and priority string." (declare-function gnutls-boot "gnutls.c" (proc type proplist)) (declare-function gnutls-errorp "gnutls.c" (error)) -(defun* gnutls-negotiate +(cl-defun gnutls-negotiate (&rest spec &key process type hostname priority-string trustfiles crlfiles keylist min-prime-bits diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index 941b6d7787c..eb696798b6f 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -34,7 +34,6 @@ ;;; Code: (require 'custom) -(eval-when-compile (require 'cl)) (autoload 'auth-source-search "auth-source") @@ -465,12 +464,12 @@ Additional search parameters can be specified through (error "No LDAP host specified")) (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) result) - (setq result (ldap-search-internal (list* 'host host - 'filter filter - 'attributes attributes - 'attrsonly attrsonly - 'withdn withdn - host-plist))) + (setq result (ldap-search-internal `(host ,host + filter ,filter + attributes ,attributes + attrsonly ,attrsonly + withdn ,withdn + ,@host-plist))) (if ldap-ignore-attribute-codings result (mapcar (lambda (record) diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el index a8e969a18c5..f85983e6e9f 100644 --- a/lisp/net/mairix.el +++ b/lisp/net/mairix.el @@ -70,8 +70,6 @@ (require 'widget) (require 'cus-edit) -(eval-when-compile - (require 'cl)) ;;; Keymappings diff --git a/lisp/net/netrc.el b/lisp/net/netrc.el index 16d9203ba04..b01b8697825 100644 --- a/lisp/net/netrc.el +++ b/lisp/net/netrc.el @@ -215,26 +215,6 @@ MODE can be \"login\" or \"password\", suitable for passing to (eq type (car (cddr service))))))) (car service))) -(defun netrc-find-service-number (name &optional type) - (let ((services (netrc-parse-services)) - service) - (setq type (or type 'tcp)) - (while (and (setq service (pop services)) - (not (and (string= name (car service)) - (eq type (car (cddr service))))))) - (cadr service))) - -(defun netrc-store-data (file host port user password) - (with-temp-buffer - (when (file-exists-p file) - (insert-file-contents file)) - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (insert (format "machine %s login %s password %s port %s\n" - host user password port)) - (write-region (point-min) (point-max) file nil 'silent))) - ;;;###autoload (defun netrc-credentials (machine &rest ports) "Return a user name/password pair. diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el index b0bfe5b271c..f3b0e372de4 100644 --- a/lisp/net/quickurl.el +++ b/lisp/net/quickurl.el @@ -81,8 +81,7 @@ ;; Things we need: -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'thingatpt) (require 'pp) (require 'browse-url) @@ -206,47 +205,40 @@ in your ~/.emacs (after loading/requiring quickurl).") (list keyword url comment) (cons keyword url))) -(defun quickurl-url-keyword (url) +(defalias 'quickurl-url-keyword #'car "Return the keyword for the URL. - -Note that this function is a setfable place." - (car url)) - -(defsetf quickurl-url-keyword (url) (store) - `(setf (car ,url) ,store)) +\n\(fn URL)") (defun quickurl-url-url (url) "Return the actual URL of the URL. Note that this function is a setfable place." + (declare (gv-setter (lambda (store) + `(setf (if (quickurl-url-commented-p ,url) + (cadr ,url) + (cdr ,url)) + ,store)))) (if (quickurl-url-commented-p url) (cadr url) (cdr url))) -(defsetf quickurl-url-url (url) (store) - ` - (if (quickurl-url-commented-p ,url) - (setf (cadr ,url) ,store) - (setf (cdr ,url) ,store))) - (defun quickurl-url-comment (url) "Get the comment from a URL. If the URL has no comment an empty string is returned. Also note that this function is a setfable place." + (declare + (gv-setter (lambda (store) + `(if (quickurl-url-commented-p ,url) + (if (zerop (length ,store)) + (setf (cdr ,url) (cadr ,url)) + (setf (nth 2 ,url) ,store)) + (unless (zerop (length ,store)) + (setf (cdr ,url) (list (cdr ,url) ,store))))))) (if (quickurl-url-commented-p url) (nth 2 url) "")) -(defsetf quickurl-url-comment (url) (store) - ` - (if (quickurl-url-commented-p ,url) - (if (zerop (length ,store)) - (setf (cdr ,url) (cadr ,url)) - (setf (nth 2 ,url) ,store)) - (unless (zerop (length ,store)) - (setf (cdr ,url) (list (cdr ,url) ,store))))) - (defun quickurl-url-description (url) "Return a description for the URL. @@ -259,14 +251,14 @@ returned." ;; Main code: -(defun* quickurl-read (&optional buffer) +(cl-defun quickurl-read (&optional buffer) "`read' the URL list from BUFFER into `quickurl-urls'. BUFFER, if nil, defaults to current buffer. Note that this function moves point to `point-min' before doing the `read' It also restores point after the `read'." (save-excursion - (setf (point) (point-min)) + (goto-char (point-min)) (setq quickurl-urls (funcall quickurl-sort-function (read (or buffer (current-buffer))))))) @@ -303,7 +295,7 @@ Also display a `message' saying what the URL was unless SILENT is non-nil." (message "Found %s" (quickurl-url-url url)))) ;;;###autoload -(defun* quickurl (&optional lookup) +(cl-defun quickurl (&optional lookup) "Insert a URL based on LOOKUP. If not supplied LOOKUP is taken to be the word at point in the current @@ -464,20 +456,21 @@ The key bindings for `quickurl-list-mode' are: (defun quickurl-list-populate-buffer () "Populate the `quickurl-list' buffer." (with-current-buffer (get-buffer quickurl-list-buffer-name) - (let ((buffer-read-only nil) - (fmt (format "%%-%ds %%s\n" - (apply #'max (or (loop for url in quickurl-urls - collect (length (quickurl-url-description url))) - (list 20)))))) - (setf (buffer-string) "") - (loop for url in quickurl-urls - do (let ((start (point))) - (insert (format fmt (quickurl-url-description url) - (quickurl-url-url url))) - (add-text-properties start (1- (point)) - '(mouse-face highlight - help-echo "mouse-2: insert this URL")))) - (setf (point) (point-min))))) + (let* ((sizes (or (cl-loop for url in quickurl-urls + collect (length (quickurl-url-description url))) + (list 20))) + (fmt (format "%%-%ds %%s\n" (apply #'max sizes))) + (inhibit-read-only t)) + (erase-buffer) + (cl-loop for url in quickurl-urls + do (let ((start (point))) + (insert (format fmt (quickurl-url-description url) + (quickurl-url-url url))) + (add-text-properties + start (1- (point)) + '(mouse-face highlight + help-echo "mouse-2: insert this URL")))) + (goto-char (point-min))))) (defun quickurl-list-add-url (word url comment) "Wrapper for `quickurl-add-url' that doesn't guess the parameters." @@ -494,7 +487,7 @@ The key bindings for `quickurl-list-mode' are: (defun quickurl-list-mouse-select (event) "Select the URL under the mouse click." (interactive "e") - (setf (point) (posn-point (event-end event))) + (goto-char (posn-point (event-end event))) (quickurl-list-insert-url)) (defun quickurl-list-insert (type) @@ -510,16 +503,16 @@ TYPE dictates what will be inserted, options are: (if url (with-current-buffer quickurl-list-last-buffer (insert - (case type - (url (funcall quickurl-format-function url)) - (naked-url (quickurl-url-url url)) - (with-lookup (format "%s " + (pcase type + (`url (funcall quickurl-format-function url)) + (`naked-url (quickurl-url-url url)) + (`with-lookup (format "%s " (quickurl-url-keyword url) (quickurl-url-url url))) - (with-desc (format "%S " + (`with-desc (format "%S " (quickurl-url-description url) (quickurl-url-url url))) - (lookup (quickurl-url-keyword url))))) + (`lookup (quickurl-url-keyword url))))) (error "No URL details on that line")) url)) diff --git a/lisp/net/secrets.el b/lisp/net/secrets.el index a79defed295..96b74b2f8e2 100644 --- a/lisp/net/secrets.el +++ b/lisp/net/secrets.el @@ -142,11 +142,8 @@ ;; Pacify byte-compiler. D-Bus support in the Emacs core can be ;; disabled with configuration option "--without-dbus". Declare used ;; subroutines and variables of `dbus' therefore. -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) -(declare-function dbus-call-method "dbusbind.c") -(declare-function dbus-register-signal "dbusbind.c") (defvar dbus-debug) (require 'dbus) @@ -650,7 +647,7 @@ If there is no such item, return nil." (let ((item-path (secrets-item-path collection item))) (unless (secrets-empty-path item-path) (dbus-byte-array-to-string - (caddr + (cl-caddr (dbus-call-method :session secrets-service item-path secrets-interface-item "GetSecret" :object-path secrets-session-path)))))) diff --git a/lisp/net/snmp-mode.el b/lisp/net/snmp-mode.el index d3e5759d2fb..c155d53b6d0 100644 --- a/lisp/net/snmp-mode.el +++ b/lisp/net/snmp-mode.el @@ -85,7 +85,6 @@ ;;; Code: (eval-when-compile - (require 'cl) (require 'imenu) ; Need this stuff when compiling for imenu macros, etc. (require 'tempo)) diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 042e51d5c9e..06aae1f6af2 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -295,8 +295,9 @@ buffer in your bug report. ;; Dump load-path shadows. (insert "\nload-path shadows:\n==================\n") (ignore-errors - (mapc (lambda (x) (when (string-match "tramp" x) (insert x "\n"))) - (split-string (list-load-path-shadows t) "\n"))) + (mapc + (lambda (x) (when (string-match "tramp" x) (insert x "\n"))) + (split-string (tramp-compat-funcall 'list-load-path-shadows t) "\n"))) ;; Append buffers only when we are in message mode. (when (and diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 9984195627c..c3552ae023b 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -29,8 +29,6 @@ ;;; Code: -(require 'tramp-loaddefs) - (eval-when-compile ;; Pacify byte-compiler. @@ -38,11 +36,24 @@ (eval-and-compile + ;; Some packages must be required for XEmacs, because we compile + ;; with -no-autoloads. + (when (featurep 'xemacs) + (require 'cus-edit) + (require 'env) + (require 'executable) + (require 'outline) + (require 'passwd) + (require 'pp) + (require 'regexp-opt)) + (require 'advice) (require 'custom) (require 'format-spec) (require 'shell) + (require 'tramp-loaddefs) + ;; As long as password.el is not part of (X)Emacs, it shouldn't be ;; mandatory. (if (featurep 'xemacs) @@ -61,7 +72,8 @@ (require 'timer)) ;; We check whether `start-file-process' is bound. - (unless (fboundp 'start-file-process) + ;; Note: we deactivate this. There are problems, at least in SXEmacs. + (unless t;(fboundp 'start-file-process) ;; tramp-util offers integration into other (X)Emacs packages like ;; compile.el, gud.el etc. Not necessary in Emacs 23. @@ -127,7 +139,8 @@ (defalias 'file-remote-p (lambda (file &optional identification connected) (when (tramp-tramp-file-p file) - (tramp-file-name-handler + (tramp-compat-funcall + 'tramp-file-name-handler 'file-remote-p file identification connected))))) ;; `process-file' does not exist in XEmacs. @@ -153,8 +166,8 @@ (defalias 'set-file-times (lambda (filename &optional time) (when (tramp-tramp-file-p filename) - (tramp-file-name-handler - 'set-file-times filename time))))) + (tramp-compat-funcall + 'tramp-file-name-handler 'set-file-times filename time))))) ;; We currently use "[" and "]" in the filename format for IPv6 ;; hosts of GNU Emacs. This means that Emacs wants to expand @@ -221,11 +234,11 @@ For Emacs, this is the variable `temporary-file-directory', for XEmacs this is the function `temp-directory'." (let (file-name-handler-alist) + ;; We must return a local directory. If it is remote, we could + ;; run into an infloop. (cond - ;; We must return a local directory. If it is remote, we could - ;; run into an infloop. - ((boundp 'temporary-file-directory) - (eval (car (get 'temporary-file-directory 'standard-value)))) + ((and (boundp 'temporary-file-directory) + (eval (car (get 'temporary-file-directory 'standard-value))))) ((fboundp 'temp-directory) (tramp-compat-funcall 'temp-directory)) ((let ((d (getenv "TEMP"))) (and d (file-directory-p d))) (file-name-as-directory (getenv "TEMP"))) @@ -302,7 +315,8 @@ Not actually used. Use `(format \"%o\" i)' instead?" ((or (null id-format) (eq id-format 'integer)) (file-attributes filename)) ((tramp-tramp-file-p filename) - (tramp-file-name-handler 'file-attributes filename id-format)) + (tramp-compat-funcall + 'tramp-file-name-handler 'file-attributes filename id-format)) (t (condition-case nil (tramp-compat-funcall 'file-attributes filename id-format) (wrong-number-of-arguments (file-attributes filename)))))) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index b7a68465f94..f78122ec704 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -91,11 +91,7 @@ ;; D-Bus support in the Emacs core can be disabled with configuration ;; option "--without-dbus". Declare used subroutines and variables. -(declare-function dbus-call-method "dbusbind.c") -(declare-function dbus-call-method-asynchronously "dbusbind.c") (declare-function dbus-get-unique-name "dbusbind.c") -(declare-function dbus-register-method "dbusbind.c") -(declare-function dbus-register-signal "dbusbind.c") ;; Pacify byte-compiler (eval-when-compile diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 1ef602cf6da..afb25509e4f 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1692,9 +1692,10 @@ and gid of the corresponding user is taken. Both parameters must be integers." ;; "-"; this would confuse xargs. "ls -aQ" might be a solution, ;; but it does not work on all remote systems. Therefore, we ;; quote the filenames via sed. - "cd %s; echo \"(\"; (%s -a | sed -e s/\\$/\\\"/g -e s/^/\\\"/g | xargs " - "%s -c '(\"%%n\" (\"%%N\") %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 \"%%A\" t %%ie0 -1)'); " - "echo \")\"") + "cd %s; echo \"(\"; (%s -a | sed -e s/\\$/\\\"/g -e s/^/\\\"/g | " + "xargs %s -c " + "'(\"%%n\" (\"%%N\") %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 \"%%A\" t %%ie0 -1)'" + " 2>/dev/null); echo \")\"") (tramp-shell-quote-argument localname) (tramp-get-ls-command vec) (tramp-get-remote-stat vec) @@ -3284,14 +3285,14 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." (let (last-coding-system-used (need-chown t)) ;; Set file modification time. (when (or (eq visit t) (stringp visit)) - (let ((file-attr (file-attributes filename))) + (let ((file-attr (tramp-compat-file-attributes filename 'integer))) (set-visited-file-modtime ;; We must pass modtime explicitly, because filename can ;; be different from (buffer-file-name), f.e. if ;; `file-precious-flag' is set. (nth 5 file-attr)) - (when (and (eq (nth 2 file-attr) uid) - (eq (nth 3 file-attr) gid)) + (when (and (= (nth 2 file-attr) uid) + (= (nth 3 file-attr) gid)) (setq need-chown nil)))) ;; Set the ownership. @@ -3332,7 +3333,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." `((,tramp-file-name-regexp . tramp-vc-file-name-handler)))) ;; Here we collect only file names, which need an operation. - (tramp-run-real-handler 'vc-registered (list file)) + (ignore-errors (tramp-run-real-handler 'vc-registered (list file))) (tramp-message v 10 "\n%s" tramp-vc-registered-file-names) ;; Send just one command, in order to fill the cache. @@ -3400,10 +3401,12 @@ Fall back to normal file name handler if no Tramp handler exists." ((and fn (memq operation '(file-exists-p file-readable-p))) (add-to-list 'tramp-vc-registered-file-names localname 'append) nil) + ;; `process-file' and `start-file-process' shall be ignored. + ((and fn (eq operation 'process-file) 0)) + ((and fn (eq operation 'start-file-process) nil)) ;; Tramp file name handlers like `expand-file-name'. They ;; must still work. - (fn - (save-match-data (apply (cdr fn) args))) + (fn (save-match-data (apply (cdr fn) args))) ;; Default file name handlers, we don't care. (t (tramp-run-real-handler operation args))))))) @@ -4294,7 +4297,7 @@ connection if a previous connection has died for some reason." (tramp-get-buffer vec) ;; If `non-essential' is non-nil, don't reopen a new connection. - (when non-essential + (when (and (boundp 'non-essential) (symbol-value 'non-essential)) (throw 'non-essential 'non-essential)) (tramp-with-progress-reporter @@ -4337,7 +4340,8 @@ connection if a previous connection has died for some reason." (set-process-sentinel p 'tramp-process-sentinel) (tramp-compat-set-process-query-on-exit-flag p nil) (setq tramp-current-connection - (cons (butlast (append vec nil)) (current-time))) + (cons (butlast (append vec nil)) (current-time)) + tramp-current-host (system-name)) (tramp-message vec 6 "%s" (mapconcat 'identity (process-command p) " ")) @@ -4384,7 +4388,7 @@ connection if a previous connection has died for some reason." (expand-file-name tramp-temp-name-prefix (tramp-compat-temporary-file-directory))))) - spec) + spec r-shell) ;; Add arguments for asynchronous processes. (when (and process-name async-args) @@ -4400,6 +4404,11 @@ connection if a previous connection has died for some reason." (setq l-port (match-string 2 l-host) l-host (match-string 1 l-host))) + ;; Check, whether there is a restricted shell. + (dolist (elt tramp-restricted-shell-hosts-alist) + (when (string-match elt tramp-current-host) + (setq r-shell t))) + ;; Set variables for computing the prompt for ;; reading password. They can also be derived ;; from a gateway. @@ -4418,7 +4427,7 @@ connection if a previous connection has died for some reason." (concat ;; We do not want to see the trailing local ;; prompt in `start-file-process'. - (unless (memq system-type '(windows-nt)) "exec ") + (unless r-shell "exec ") command " " (mapconcat (lambda (x) @@ -4427,9 +4436,10 @@ connection if a previous connection has died for some reason." login-args " ") ;; Local shell could be a Windows COMSPEC. It ;; doesn't know the ";" syntax, but we must exit - ;; always for `start-file-process'. "exec" does - ;; not work either. - (if (memq system-type '(windows-nt)) " && exit || exit"))) + ;; always for `start-file-process'. It could + ;; also be a restricted shell, which does not + ;; allow "exec". + (when r-shell " && exit || exit"))) ;; Send the command. (tramp-message vec 3 "Sending command `%s'" command) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index d0e8b35d6ca..58506ce82f7 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -405,6 +405,18 @@ interpreted as a regular expression which always matches." :group 'tramp :type 'boolean) +(defcustom tramp-restricted-shell-hosts-alist + (when (memq system-type '(windows-nt)) + (list (concat "\\`" (regexp-quote (system-name)) "\\'"))) + "List of hosts, which run a restricted shell. +This is a list of regular expressions, which denote hosts running +a registered shell like \"rbash\". Those hosts can be used as +proxies only, see `tramp-default-proxies-alist'. If the local +host runs a registered shell, it shall be added to this list, too." + :version "24.2" + :group 'tramp + :type '(repeat (regexp :tag "Host regexp"))) + ;;;###tramp-autoload (defconst tramp-local-host-regexp (concat @@ -1531,6 +1543,9 @@ letter into the file name. This function removes it." 'identity)) +(if (featurep 'xemacs) + (defalias 'tramp-drop-volume-letter 'identity)) + (defun tramp-cleanup (vec) "Cleanup connection VEC, but keep the debug buffer." (with-current-buffer (tramp-get-debug-buffer vec) diff --git a/lisp/net/xesam.el b/lisp/net/xesam.el index b901c041863..585e5eed52d 100644 --- a/lisp/net/xesam.el +++ b/lisp/net/xesam.el @@ -127,17 +127,8 @@ ;;; Code: -;; D-Bus support in the Emacs core can be disabled with configuration -;; option "--without-dbus". Declare used subroutines and variables. -(declare-function dbus-call-method "dbusbind.c") -(declare-function dbus-register-signal "dbusbind.c") - (require 'dbus) -;; Pacify byte compiler. -(eval-when-compile - (require 'cl)) - ;; Widgets are used to highlight the search results. (require 'widget) (require 'wid-edit) @@ -414,24 +405,24 @@ If there is no registered search engine at all, the function returns `nil'." ;; That is not the case now, so we set it ourselves. ;; Hopefully, this will change later. (setq hit-fields - (case (intern vendor-id) - (Beagle + (pcase (intern vendor-id) + (`Beagle '("xesam:mimeType" "xesam:url")) - (Strigi + (`Strigi '("xesam:author" "xesam:cc" "xesam:charset" "xesam:contentType" "xesam:fileExtension" "xesam:id" "xesam:lineCount" "xesam:links" "xesam:mimeType" "xesam:name" "xesam:size" "xesam:sourceModified" "xesam:subject" "xesam:to" "xesam:url")) - (TrackerXesamSession + (`TrackerXesamSession '("xesam:relevancyRating" "xesam:url")) - (Debbugs + (`Debbugs '("xesam:keyword" "xesam:owner" "xesam:title" "xesam:url" "xesam:sourceModified" "xesam:mimeType" "debbugs:key")) ;; xesam-tools yahoo service. - (t '("xesam:contentModified" "xesam:mimeType" "xesam:summary" + (_ '("xesam:contentModified" "xesam:mimeType" "xesam:summary" "xesam:title" "xesam:url" "yahoo:displayUrl")))) (xesam-set-property engine "hit.fields" hit-fields) diff --git a/lisp/net/zeroconf.el b/lisp/net/zeroconf.el index b994cdeaa68..6a1a009410b 100644 --- a/lisp/net/zeroconf.el +++ b/lisp/net/zeroconf.el @@ -102,11 +102,6 @@ ;; Pacify byte-compiler. D-Bus support in the Emacs core can be ;; disabled with configuration option "--without-dbus". Declare used ;; subroutines and variables of `dbus' therefore. -(eval-when-compile - (require 'cl)) - -(declare-function dbus-call-method "dbusbind.c") -(declare-function dbus-register-signal "dbusbind.c") (defvar dbus-debug) (require 'dbus) @@ -548,7 +543,7 @@ DOMAIN is nil, the local domain is used." ((string-equal (dbus-event-member-name last-input-event) "ItemNew") ;; Parameters: (interface protocol type domain flags) ;; Register a service browser. - (let ((object-path (zeroconf-register-service-browser (nth-value 2 val)))) + (let ((object-path (zeroconf-register-service-browser (nth 2 val)))) ;; Register the signals. (dolist (member '("ItemNew" "ItemRemove" "Failure")) (dbus-register-signal diff --git a/lisp/notifications.el b/lisp/notifications.el index 7a79d5f6754..c762bb104ee 100644 --- a/lisp/notifications.el +++ b/lisp/notifications.el @@ -34,9 +34,6 @@ ;; active D-Bus session bus. ;;; Code: -(eval-when-compile - (require 'cl)) - (require 'dbus) (defconst notifications-specification-version "1.2" @@ -226,10 +223,10 @@ of another `notifications-notify' call." (when urgency (add-to-list 'hints `(:dict-entry "urgency" - (:variant :byte ,(case urgency - (low 0) - (critical 2) - (t 1)))) t)) + (:variant :byte ,(pcase urgency + (`low 0) + (`critical 2) + (_ 1)))) t)) (when category (add-to-list 'hints `(:dict-entry "category" diff --git a/lisp/novice.el b/lisp/novice.el index fa41b2bbc1e..bcc94c86c9d 100644 --- a/lisp/novice.el +++ b/lisp/novice.el @@ -33,8 +33,6 @@ ;; The command is found in this-command ;; and the keys are returned by (this-command-keys). -(eval-when-compile (require 'cl)) - ;;;###autoload (define-obsolete-variable-alias 'disabled-command-hook 'disabled-command-function "22.1") @@ -101,7 +99,7 @@ SPC to try the command just this once, but leave it disabled. (ding) (message "Please type y, n, ! or SPC (the space bar): ")))) (setq char (downcase char)) - (case char + (pcase char (?\C-g (setq quit-flag t)) (?! (setq disabled-command-function nil)) (?y diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el index 934dabee90d..1e0e692be26 100644 --- a/lisp/nxml/nxml-mode.el +++ b/lisp/nxml/nxml-mode.el @@ -29,7 +29,7 @@ (when (featurep 'mucs) (error "nxml-mode is not compatible with Mule-UCS")) -(eval-when-compile (require 'cl)) ; for assert +(eval-when-compile (require 'cl-lib)) (require 'xmltok) (require 'nxml-enc) @@ -930,16 +930,16 @@ Called with `font-lock-beg' and `font-lock-end' dynamically bound." (nxml-debug-change "nxml-fontify-matcher" (point) bound) (when (< (point) nxml-prolog-end) - ;; prolog needs to be fontified in one go, and + ;; Prolog needs to be fontified in one go, and ;; nxml-extend-region makes sure we start at BOB. - (assert (bobp)) + (cl-assert (bobp)) (nxml-fontify-prolog) (goto-char nxml-prolog-end)) (let (xmltok-dependent-regions xmltok-errors) (while (and (nxml-tokenize-forward) - (<= (point) bound)) ; intervals are open-ended + (<= (point) bound)) ; Intervals are open-ended. (nxml-apply-fontify-rule))) (setq nxml-last-fontify-end (point))) diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog index b98fd272b38..eae83f044a0 100644 --- a/lisp/org/ChangeLog +++ b/lisp/org/ChangeLog @@ -4,7 +4,7 @@ (org-clock-modeline-total, org-clock-task-overrun-text) (org-clock-mode-line-entry): Doc fix, "modeline" -> "mode line". -2012-05-27 Mark Shoulson (tiny change) +2012-05-27 Mark Shoulson (tiny change) * org.el (org-fontify-entities): Fix bug: The entities \sup[123] and \there4 were not "prettified" when org-pretty-entities was enabled. @@ -362,7 +362,7 @@ 2012-04-01 Ilya Shlyakhter (tiny change) * org-colview.el (org-columns-cleanup-item): Handle case of empty - headline + headline. 2012-04-01 Nicolas Goaziou @@ -400,7 +400,7 @@ 2012-04-01 Ilya Shlyakhter - * org-clock.el: (org-clock-get-table-data): Make sure todo-only + * org-clock.el (org-clock-get-table-data): Make sure todo-only does not leak when it is set by make-org-tags-macher. 2012-04-01 Bastien Guerry @@ -688,7 +688,7 @@ 2012-04-01 Bernt Hansen * org.el (org-clone-subtree-with-time-shift): Fix task cloning for - repeating tasks using .+n and ++n syntax + repeating tasks using .+n and ++n syntax. 2012-04-01 Karl Fogel (tiny change) @@ -863,7 +863,7 @@ 2012-04-01 Toby S. Cubitt (tiny change) - * org.el (org-goto): call org-refile-get-location with NO-EXCLUDE + * org.el (org-goto): Call org-refile-get-location with NO-EXCLUDE argument set, otherwise not only are headlines in the current subtree excluded, but it throws an error if point happens not to be within a subtree (e.g. at start of buffer). @@ -877,7 +877,7 @@ * org-clock.el (org-in-clocktable-p): Moved to org.el. * org.el (org-in-clocktable-p): New function. Moved from - org-clock.el + org-clock.el. 2012-04-01 David Maus @@ -1011,7 +1011,7 @@ 2012-04-01 Toby S. Cubitt (tiny change) - * org.el (org-goto): call org-refile-get-location with NO-EXCLUDE + * org.el (org-goto): Call org-refile-get-location with NO-EXCLUDE argument set, otherwise not only are headlines in the current subtree excluded, but it throws an error if point happens not to be within a subtree (e.g. at start of buffer). @@ -1031,7 +1031,7 @@ 2012-04-01 Bernt Hansen * org-clock.el (org-clock-out): Do not delete the current clocking - task when org-clock-out-hook clocks in another task + task when org-clock-out-hook clocks in another task. 2012-04-01 David Maus @@ -1052,7 +1052,7 @@ * org-clock.el (org-in-clocktable-p): Moved to org.el. - * org.el (org-in-clocktable-p): New function. Moved from org-clock.el + * org.el (org-in-clocktable-p): New function. Moved from org-clock.el. 2012-04-01 David Maus @@ -1389,7 +1389,7 @@ 2012-04-01 Jambunathan K * org-odt.el (org-odt-label-styles): Add a new style. - (org-odt-category-map-alist): Use it. + (org-odt-category-map-alist): Use it. 2012-04-01 Jambunathan K @@ -1573,16 +1573,17 @@ 2012-04-01 Bernt Hansen - * org-agenda.el (org-agenda-switch-to): Widen org buffer only if point is - outside the current restriction + * org-agenda.el (org-agenda-switch-to): Widen org buffer only if point + is outside the current restriction. 2012-04-01 Bernt Hansen - * org-agenda.el (org-agenda-clock-in): Save restriction when clocking in from the agenda + * org-agenda.el (org-agenda-clock-in): Save restriction when clocking + in from the agenda. 2012-04-01 Bernt Hansen - * org.el: Honour existing restrictions when regenerating the agenda + * org.el: Honour existing restrictions when regenerating the agenda. 2012-04-01 Bastien Guerry @@ -1611,8 +1612,8 @@ 2012-04-01 Martyn Jago * ob-emacs-lisp.el: A comment on the last line of an emacs-lisp - code block would cause an error when the block is was executed. This - fix cures this behaviour. + code block would cause an error when the block is was executed. + This fix cures this behaviour. 2012-04-01 Eric Schulte @@ -2018,7 +2019,7 @@ 2012-01-03 Litvinov Sergey - * ob-octave.el: add graphical output to png file + * ob-octave.el: Add graphical output to png file. 2012-01-03 Eric Schulte @@ -2107,7 +2108,7 @@ 2012-01-03 Michael Brand - * org.el (Key bindings): remap the Outline functions from + * org.el (Key bindings): Remap the Outline functions from `outline-mode-prefix-map' where possible. 2012-01-03 Christian Moe (tiny change) @@ -2186,7 +2187,7 @@ * org-special-blocks.el (org-special-blocks-convert-html-special-cookies): Close paragraph before opening or closing the
, and open - paragraph after. Also changed newline placement to be the same + paragraph after. Also changed newline placement to be the same as for other blocks. 2012-01-03 Roberto Huelga @@ -3344,9 +3345,9 @@ * ob-asymptote.el (org-babel-asymptote-table-to-array): Require a new argument TYPE specifying the detected type of array. If it's a string array, make sure every element is - returned as a string. Also improve doc-string. - (org-babel-asymptote-var-to-asymptote): Fill new argument. Small - refactoring. + returned as a string. Also improve doc-string. + (org-babel-asymptote-var-to-asymptote): Fill new argument. + Small refactoring. (org-babel-asymptote-define-type): Rewrite to avoid stopping search at first float found, as strings have precedence over floats. @@ -3376,7 +3377,7 @@ * org-footnote.el (org-footnote-get-definition): The function has to widen buffer if definition has not been found in the current - narrowed part. Be sure to restore that restriction once the + narrowed part. Be sure to restore that restriction once the definition is found. 2012-01-03 Michal Sojka (tiny change) @@ -3419,7 +3420,7 @@ 2012-01-03 Suvayu Ali (tiny change) * org-inlinetask.el (org-inlinetask): New customizable face - for inlinetasks + for inlinetasks. 2012-01-03 Bastien Guerry @@ -3518,7 +3519,7 @@ (org-indent-agent-resume-delay): Change value. (org-indent-initialize-buffer): Change argument name. (org-indent-add-properties): Change argument name and type - expected. It must be a time value now. + expected. It must be a time value now. 2012-01-03 Bastien Guerry @@ -3573,8 +3574,8 @@ (org-indent-initialize-agent): New function. (org-indent-initialize-buffer): Now requires a mandatory buffer argument. - (org-indent-add-properties): Reflect changes to variables. The resume - timer is now global. + (org-indent-add-properties): Reflect changes to variables. + The resume timer is now global. 2012-01-03 Nicolas Goaziou @@ -3620,7 +3621,7 @@ * org-indent.el (org-indent-modified-headline-flag): Renamed from `org-indent-deleted-headline-flag' (org-indent-notify-modified-headline): Renamed from - `org-indent-notify-deleted-headline'. Handle situations when + `org-indent-notify-deleted-headline'. Handle situations when the stars of an headline are modified. (org-indent-refresh-maybe): Remove case now handled by previous function. @@ -3643,7 +3644,7 @@ (org-indent-initial-timer, org-indent-initial-lock): New variables. (org-indent-mode): At initialization, start an idle timer to indent - the whole buffer. When the user is asking for control, interrupt the + the whole buffer. When the user is asking for control, interrupt the process, and resume at the same point when idle again. (org-indent-initialize-buffer): New function. (org-indent-add-properties): Throw an interrupt when indentation of @@ -3690,7 +3691,7 @@ 2012-01-03 Nicolas Goaziou * org-indent.el (org-indent-mode): Completely refresh buffer - before starting org-indent-mode. Also set idle timer to refresh + before starting org-indent-mode. Also set idle timer to refresh only visible portion of buffer, and refresh the subtree instead of section when promoting or demoting it. (org-indent-add-properties): Rewrite function to proceed line by @@ -3797,7 +3798,7 @@ template for html so that the exported file is valid xhtml. Added template for odt. (org-inlinetask-export-handler): Fix typo in the regexp that - trims content. Make sure that the content is flanked by + trims content. Make sure that the content is flanked by paragraph boundaries on either side. 2012-01-03 Bastien Guerry @@ -4065,7 +4066,7 @@ 2012-01-03 Nicolas Goaziou * org.el (org-in-regexps-block-p): Return an useful value when - point is between START-RE and END-RE. No incomplete block is + point is between START-RE and END-RE. No incomplete block is allowed anymore. Add another optional argument to bound the bottom part of the search. (org-narrow-to-block, org-in-block-p): Apply modifications. @@ -4451,7 +4452,7 @@ 2011-07-28 Matt Lundin * org-bibtex.el (org-bibtex-create, org-bibtex-write): Change - argument of `org-toggle-tag' to 'on. (Other arguments, e.g., t, + argument of `org-toggle-tag' to 'on. (Other arguments, e.g., t, have no effect). 2011-07-28 Eric Schulte @@ -4835,7 +4836,7 @@ * ob-haskell.el (org-babel-haskell-export-to-lhs): Call `kill-buffer' with argument indiciating to kill current - buffer. Emacs 22 compatibility. + buffer. Emacs 22 compatibility. 2011-07-28 David Maus @@ -5027,7 +5028,7 @@ * org-exp.el (org-export-preprocess-string): If the last subtree is commented, footnotes inserted during normalizing at the end of - the buffer may get deleted. This patch ensures deletion comes + the buffer may get deleted. This patch ensures deletion comes first, normalization second. 2011-07-28 Nicolas Goaziou @@ -5108,7 +5109,7 @@ * org-footnote.el (org-footnote-goto-definition): Now, determining if point is at a footnote reference is entirely determined by - `org-footnote-at-reference-p'. No need to check if pattern isn't + `org-footnote-at-reference-p'. No need to check if pattern isn't at beginning of the line elsewhere. 2011-07-28 Nicolas Goaziou @@ -5360,7 +5361,7 @@ * org-exp.el (org-export-backends): New variable. (org-export-select-backend-specific-text): Use above - variable. Also mark text between #+BACKEND and + variable. Also mark text between #+BACKEND and #+BEGIN_BACKEND...#+END_BACKEND with org-native-text property. This text property is currently used only by the new line-oriented generic exporter (which is not yet part of the repo). @@ -5787,7 +5788,7 @@ * org-exp.el (org-export): Use new compatibility function `org-activate-mark'. - * org-compat.el (org-activate-mark): New function. Provide + * org-compat.el (org-activate-mark): New function. Provide `activate-mark' if not present (e.g. Emacs 22). 2011-07-28 David Maus @@ -5957,14 +5958,14 @@ * org-html.el (org-export-as-html): Don't expand non-data lines of table.el tables. (org-html-expand): Removed the (buggy) test for non-data lines - in table.el tables. The test is now done as part of + in table.el tables. The test is now done as part of org-export-as-html. (org-format-table-table-html-using-table-generate-source): Added test for spanning of cells in table.el tables using - table.el's own library routine. Optionlly Suppress export of + table.el's own library routine. Optionally suppress export of simple table.el tables. (org-format-table-html): Removed the (buggy) test for spanned - table.el tables. The test is now done as part of + table.el tables. The test is now done as part of org-format-table-table-html-using-table-generate-source. 2011-07-28 Carsten Dominik @@ -6338,7 +6339,7 @@ function would not pay attention to drawers or blocks indentation. Thus, such constructs couldn't consistently end an item or a list. This patch ensures line indentation is stored (if applicable) - before skipping them. Also fixed doc-string and comments. + before skipping them. Also fixed doc-string and comments. 2011-07-28 Carsten Dominik @@ -6676,7 +6677,7 @@ 2011-07-28 Julien Danjou * org-latex.el (org-export-latex-date-format): Change default date - format to \today. This has the same result but respects the + format to \today. This has the same result but respects the language set in the document by default. 2011-07-28 Nicolas Goaziou @@ -6892,7 +6893,7 @@ (org-agenda-change-all-lines): Stop using prefix-length. * org-colview.el (org-columns-display-here): Stop using - prefix-length. Always return claned items. + prefix-length. Always return claned items. * org-mobile.el (org-mobile-write-agenda-for-mobile): Stop using prefix-length. @@ -6996,7 +6997,7 @@ 2011-07-28 Bastien Guerry - * org-html.el (org-export-as-html): bugfix: insert email + * org-html.el (org-export-as-html): Bugfix: insert email correctly. 2011-07-28 Bastien Guerry @@ -7437,7 +7438,7 @@ 2011-07-28 Julien Danjou * org-macs.el (org-with-point-at): Store evaluated version of - pom. This fixes a potential bug when using (org-with-point-at + pom. This fixes a potential bug when using (org-with-point-at (func) …), where (func) would be evaluated multiple times, therefore might return different results if a marker was returned and different each time. @@ -7706,7 +7707,7 @@ 2011-07-28 Nicolas Goaziou - * org.el (org-toggle-item): Now accepts a prefix argument. When + * org.el (org-toggle-item): Now accepts a prefix argument. When used without argument on normal text, it will make the whole region one item. With an argument, it defaults to old behavior: change each line in region into an item. @@ -7865,7 +7866,7 @@ * org-inlinetask.el (org-inlinetask-export-templates): Slightly modify templates so environment boundaries don't interfere with content of task. Unprotect content of task so it might benefit - from further transformations. Set original-indentation property to + from further transformations. Set original-indentation property to a high value to ensure that task is always in the last item of the list. Also, apply templates later in export process. @@ -7896,7 +7897,7 @@ * org-exp.el (org-export-preprocess-string): Mark list endings before babel blocks preprocessing starts, so blank lines that may be inserted do not break list's structure. Then, mark list with - special properties required by exporters. Thus output from babel + special properties required by exporters. Thus output from babel can easily be included in lists. (org-export-mark-list-end): New function. (org-export-mark-list-properties): New function. @@ -8001,7 +8002,7 @@ helper function is not optional anymore. (org-list-get-all-items): Shorten code with the help of cl.el. (org-list-get-children): Now returns all children of item, even if - they do not belong to the same list. Renamed from + they do not belong to the same list. Renamed from `org-list-get-all-children'. (org-list-get-list-begin): Function wasn't return value when item was already the first item of the list at point. @@ -10143,10 +10144,9 @@ 2010-11-11 Carsten Dominik * org-capture.el (org-capture-templates): New capture property - `:kill-buffer'. (org-capture-finalize): Kill target buffer if that - is desired. - (org-capture-target-buffer): Remember if we have to make the - buffer. + `:kill-buffer'. + (org-capture-finalize): Kill target buffer if that is desired. + (org-capture-target-buffer): Remember if we have to make the buffer. 2010-11-11 Carsten Dominik @@ -11671,7 +11671,7 @@ 2010-11-11 Dan Davison * org.el (org-src-fontify-natively): Set to nil by default. - Supply cutomize interface. + Supply customize interface. 2010-11-11 Bastien Guerry @@ -12235,7 +12235,7 @@ * org-list.el (org-insert-item-internal): New function to handle positioning and contents of an item being inserted at a specific - pos. It is not possible anymore to split a term in a description + pos. It is not possible anymore to split a term in a description list or a checkbox when inserting a new item. * org-list.el (org-insert-item): Refactored by using the new @@ -16332,9 +16332,8 @@ 2009-11-13 John Wiegley - * org-clock.el - (org-clock-auto-clock-resolution): Now takes three values: nil, t - and `when-no-clock-is-running'. + * org-clock.el (org-clock-auto-clock-resolution): Now takes three + values: nil, t and `when-no-clock-is-running'. (org-clock-in): Use `org-clock-auto-clock-resolution' to determine whether or not to resolve Org buffers on clock in. diff --git a/lisp/paths.el b/lisp/paths.el deleted file mode 100644 index ffb4077b0c2..00000000000 --- a/lisp/paths.el +++ /dev/null @@ -1,108 +0,0 @@ -;;; paths.el --- define pathnames for use by various Emacs commands - -;; Copyright (C) 1986, 1988, 1994, 1999-2012 Free Software Foundation, Inc. - -;; Maintainer: FSF -;; Keywords: internal -;; Package: emacs - -;; 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 . - -;;; Commentary: - -;; These are default settings for names of certain files and directories -;; that Emacs needs to refer to from time to time. - -;; If these settings are not right, override them with `setq' -;; in site-init.el. Do not change this file. - -;;; Code: - -;; This is a defcustom largely so that we can get the benefit -;; of custom-initialize-delay. Perhaps it would work to make it a -;; defvar and explicitly give it a standard-value property, and -;; call custom-initialize-delay on it. -(defcustom Info-default-directory-list - (let* ((config-dir - (file-name-as-directory - ;; Self-contained NS build with info/ in the app-bundle. - (or (and (featurep 'ns) - (let ((dir (expand-file-name "../info" data-directory))) - (if (file-directory-p dir) dir))) - configure-info-directory))) - (prefixes - ;; Directory trees in which to look for info subdirectories - (prune-directory-list '("/usr/local/" "/usr/" "/opt/" "/"))) - (suffixes - ;; Subdirectories in each directory tree that may contain info - ;; directories. Most of these are rather outdated. - ;; It ought to be fine to stop checking the "emacs" ones now, - ;; since this is Emacs and we have not installed info files - ;; into such directories for a looong time... - '("share/" "" "gnu/" "gnu/lib/" "gnu/lib/emacs/" - "emacs/" "lib/" "lib/emacs/")) - (standard-info-dirs - (apply #'nconc - (mapcar (lambda (pfx) - (let ((dirs - (mapcar (lambda (sfx) - (concat pfx sfx "info/")) - suffixes))) - (prune-directory-list dirs))) - prefixes))) - ;; If $(prefix)/share/info is not one of the standard info - ;; directories, they are probably installing an experimental - ;; version of Emacs, so make sure that experimental version's Info - ;; files override the ones in standard directories. - (dirs - (if (member config-dir standard-info-dirs) - ;; FIXME? What is the point of adding it again at the end - ;; when it is already present earlier in the list? - (nconc standard-info-dirs (list config-dir)) - (cons config-dir standard-info-dirs)))) - (if (not (eq system-type 'windows-nt)) - dirs - ;; Include the info directory near where Emacs executable was installed. - (let* ((instdir (file-name-directory invocation-directory)) - (dir1 (expand-file-name "../info/" instdir)) - (dir2 (expand-file-name "../../../info/" instdir))) - (cond ((file-exists-p dir1) (append dirs (list dir1))) - ((file-exists-p dir2) (append dirs (list dir2))) - (t dirs))))) - - "Default list of directories to search for Info documentation files. -They are searched in the order they are given in the list. -Therefore, the directory of Info files that come with Emacs -normally should come last (so that local files override standard ones), -unless Emacs is installed into a non-standard directory. In the latter -case, the directory of Info files that come with Emacs should be -first in this list. - -Once Info is started, the list of directories to search -comes from the variable `Info-directory-list'. -This variable `Info-default-directory-list' is used as the default -for initializing `Info-directory-list' when Info is started, unless -the environment variable INFOPATH is set. - -Although this is a customizable variable, that is mainly for technical -reasons. Normally, you should either set INFOPATH or customize -`Info-additional-directory-list', rather than changing this variable." - :initialize 'custom-initialize-delay - :type '(repeat directory) - :group 'info) - - -;;; paths.el ends here diff --git a/lisp/pcmpl-rpm.el b/lisp/pcmpl-rpm.el index f28469d791b..e637c3407f0 100644 --- a/lisp/pcmpl-rpm.el +++ b/lisp/pcmpl-rpm.el @@ -27,18 +27,66 @@ (require 'pcomplete) +(defgroup pcmpl-rpm nil + "Options for rpm completion." + :group 'pcomplete + :prefix "pcmpl-rpm-") + +;; rpm -qa can be slow. Adding --nodigest --nosignature is MUCH faster. +(defcustom pcmpl-rpm-query-options + (let (opts) + (with-temp-buffer + (when (ignore-errors (call-process "rpm" nil t nil "--help")) + (if (search-backward "--nodigest " nil 'move) + (setq opts '("--nodigest"))) + (goto-char (point-min)) + (if (search-forward "--nosignature " nil t) + (push "--nosignature" opts)))) + opts) + "String, or list of strings, with extra options for an rpm query command." + :version "24.2" + :type '(choice (const :tag "No options" nil) + (string :tag "Single option") + (repeat :tag "List of options" string)) + :group 'pcmpl-rpm) + +(defcustom pcmpl-rpm-cache t + "Whether to cache the list of installed packages." + :version "24.2" + :type 'boolean + :group 'pcmpl-rpm) + +(defconst pcmpl-rpm-cache-stamp-file "/var/lib/rpm/Packages" + "File used to check that the list of installed packages is up-to-date.") + +(defvar pcmpl-rpm-cache-time nil + "Time at which the list of installed packages was updated.") + +(defvar pcmpl-rpm-packages nil + "List of installed packages.") + ;; Functions: -;; FIXME rpm -qa can be slow, so: -;; Adding --nodigest --nosignature is MUCH faster. -;; (Probably need to test --help for those options though.) -;; Consider caching the result (cf woman). -;; Consider printing an explanatory message before running -qa. -;; -;; Seems pointless for this to be a defsubst. -(defsubst pcmpl-rpm-packages () - (split-string (pcomplete-process-result "rpm" "-q" "-a"))) +(defun pcmpl-rpm-packages () + "Return a list of all installed rpm packages." + (if (and pcmpl-rpm-cache + pcmpl-rpm-cache-time + (let ((mtime (nth 5 (file-attributes pcmpl-rpm-cache-stamp-file)))) + (and mtime (not (time-less-p pcmpl-rpm-cache-time mtime))))) + pcmpl-rpm-packages + (message "Getting list of installed rpms...") + (setq pcmpl-rpm-cache-time (current-time) + pcmpl-rpm-packages + (split-string (apply 'pcomplete-process-result "rpm" + (append '("-q" "-a") + (if (stringp pcmpl-rpm-query-options) + (list pcmpl-rpm-query-options) + pcmpl-rpm-query-options))))) + (message "Getting list of installed rpms...done") + pcmpl-rpm-packages)) +;; Should this use pcmpl-rpm-query-options? +;; I don't think it would speed it up at all (?). (defun pcmpl-rpm-all-query (flag) (message "Querying all packages with `%s'..." flag) (let ((pkgs (pcmpl-rpm-packages)) diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index c9961a67f3d..b71bfb202db 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -118,7 +118,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) (require 'comint) (defgroup pcomplete nil @@ -875,9 +874,9 @@ component, `default-directory' is used as the basis for completion." ;; The env-var is "out of bounds". (if (eq action t) (complete-with-action action table newstring pred) - (list* 'boundaries - (+ (car bounds) (- orig-length (length newstring))) - (cdr bounds))) + `(boundaries + ,(+ (car bounds) (- orig-length (length newstring))) + . ,(cdr bounds))) ;; The env-var is in the file bounds. (if (eq action t) (let ((comps (complete-with-action @@ -886,9 +885,9 @@ component, `default-directory' is used as the basis for completion." ;; Strip the part of each completion that's actually ;; coming from the env-var. (mapcar (lambda (s) (substring s len)) comps)) - (list* 'boundaries - (+ envpos (- orig-length (length newstring))) - (cdr bounds)))))))))) + `(boundaries + ,(+ envpos (- orig-length (length newstring))) + . ,(cdr bounds)))))))))) (defsubst pcomplete-all-entries (&optional regexp predicate) "Like `pcomplete-entries', but doesn't ignore any entries." diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el index b2fffb49840..e6df0df8282 100644 --- a/lisp/play/5x5.el +++ b/lisp/play/5x5.el @@ -50,8 +50,7 @@ ;; Things we need. -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;; Customize options. @@ -260,8 +259,8 @@ Quit current game \\[5x5-quit-game]" (defun 5x5-make-new-grid () "Create and return a new `5x5' grid structure." (let ((grid (make-vector 5x5-grid-size nil))) - (loop for y from 0 to (1- 5x5-grid-size) do - (aset grid y (make-vector 5x5-grid-size nil))) + (dotimes (y 5x5-grid-size) + (aset grid y (make-vector 5x5-grid-size nil))) grid)) (defun 5x5-cell (grid y x) @@ -279,9 +278,9 @@ Quit current game \\[5x5-quit-game]" (defun 5x5-copy-grid (grid) "Make a new copy of GRID." (let ((copy (5x5-make-new-grid))) - (loop for y from 0 to (1- 5x5-grid-size) do - (loop for x from 0 to (1- 5x5-grid-size) do - (5x5-set-cell copy y x (5x5-cell grid y x)))) + (dotimes (y 5x5-grid-size) + (dotimes (x 5x5-grid-size) + (5x5-set-cell copy y x (5x5-cell grid y x)))) copy)) (defun 5x5-make-move (grid row col) @@ -299,45 +298,46 @@ Quit current game \\[5x5-quit-game]" (defun 5x5-row-value (row) "Get the \"on-value\" for grid row ROW." - (loop for y from 0 to (1- 5x5-grid-size) sum (if (aref row y) 1 0))) + (cl-loop for y from 0 to (1- 5x5-grid-size) sum (if (aref row y) 1 0))) (defun 5x5-grid-value (grid) "Get the \"on-value\" for grid GRID." - (loop for y from 0 to (1- 5x5-grid-size) sum (5x5-row-value (aref grid y)))) + (cl-loop for y from 0 to (1- 5x5-grid-size) + sum (5x5-row-value (aref grid y)))) (defun 5x5-draw-grid-end () "Draw the top/bottom of the grid." (insert "+") - (loop for x from 0 to (1- 5x5-grid-size) do - (insert "-" (make-string 5x5-x-scale ?-))) + (dotimes (x 5x5-grid-size) + (insert "-" (make-string 5x5-x-scale ?-))) (insert "-+ ")) (defun 5x5-draw-grid (grids) "Draw the grids GRIDS into the current buffer." (let ((inhibit-read-only t) grid-org) (erase-buffer) - (loop for grid in grids do (5x5-draw-grid-end)) + (dolist (grid grids) (5x5-draw-grid-end)) (insert "\n") (setq grid-org (point)) - (loop for y from 0 to (1- 5x5-grid-size) do - (loop for lines from 0 to (1- 5x5-y-scale) do - (loop for grid in grids do - (loop for x from 0 to (1- 5x5-grid-size) do - (insert (if (zerop x) "| " " ") - (make-string 5x5-x-scale - (if (5x5-cell grid y x) ?# ?.)))) - (insert " | ")) - (insert "\n"))) + (dotimes (y 5x5-grid-size) + (dotimes (lines 5x5-y-scale) + (dolist (grid grids) + (dotimes (x 5x5-grid-size) + (insert (if (zerop x) "| " " ") + (make-string 5x5-x-scale + (if (5x5-cell grid y x) ?# ?.)))) + (insert " | ")) + (insert "\n"))) (when 5x5-solver-output (if (= (car 5x5-solver-output) 5x5-moves) (save-excursion (goto-char grid-org) (beginning-of-line (+ 1 (/ 5x5-y-scale 2))) - (let ((solution-grid (cdadr 5x5-solver-output))) - (dotimes (y 5x5-grid-size) + (let ((solution-grid (cl-cdadr 5x5-solver-output))) + (dotimes (y 5x5-grid-size) (save-excursion (forward-char (+ 1 (/ (1+ 5x5-x-scale) 2))) - (dotimes (x 5x5-grid-size) + (dotimes (x 5x5-grid-size) (when (5x5-cell solution-grid y x) (if (= 0 (mod 5x5-x-scale 2)) (progn @@ -350,7 +350,7 @@ Quit current game \\[5x5-quit-game]" (forward-char (1+ 5x5-x-scale)))) (forward-line 5x5-y-scale)))) (setq 5x5-solver-output nil))) - (loop for grid in grids do (5x5-draw-grid-end)) + (dolist (grid grids) (5x5-draw-grid-end)) (insert "\n") (insert (format "On: %d Moves: %d" (5x5-grid-value (car grids)) 5x5-moves)))) @@ -362,16 +362,16 @@ Quit current game \\[5x5-quit-game]" (defun 5x5-made-move () "Keep track of how many moves have been made." - (incf 5x5-moves)) + (cl-incf 5x5-moves)) (defun 5x5-make-random-grid (&optional move) "Make a random grid." (setq move (or move (symbol-function '5x5-flip-cell))) (let ((grid (5x5-make-new-grid))) - (loop for y from 0 to (1- 5x5-grid-size) do - (loop for x from 0 to (1- 5x5-grid-size) do - (if (zerop (random 2)) - (funcall move grid y x)))) + (dotimes (y 5x5-grid-size) + (dotimes (x 5x5-grid-size) + (if (zerop (random 2)) + (funcall move grid y x)))) grid)) ;; Cracker functions. @@ -444,20 +444,20 @@ should return a grid vector array that is the new solution." (defun 5x5-make-xor-with-mutation (current best) "Xor current and best solution then mutate the result." (let ((xored (5x5-make-new-grid))) - (loop for y from 0 to (1- 5x5-grid-size) do - (loop for x from 0 to (1- 5x5-grid-size) do - (5x5-set-cell xored y x - (5x5-xor (5x5-cell current y x) - (5x5-cell best y x))))) + (dotimes (y 5x5-grid-size) + (dotimes (x 5x5-grid-size) + (5x5-set-cell xored y x + (5x5-xor (5x5-cell current y x) + (5x5-cell best y x))))) (5x5-mutate-solution xored))) (defun 5x5-mutate-solution (solution) "Randomly flip bits in the solution." - (loop for y from 0 to (1- 5x5-grid-size) do - (loop for x from 0 to (1- 5x5-grid-size) do - (if (= (random (/ (* 5x5-grid-size 5x5-grid-size) 2)) - (/ (/ (* 5x5-grid-size 5x5-grid-size) 2) 2)) - (5x5-flip-cell solution y x)))) + (dotimes (y 5x5-grid-size) + (dotimes (x 5x5-grid-size) + (if (= (random (/ (* 5x5-grid-size 5x5-grid-size) 2)) + (/ (/ (* 5x5-grid-size 5x5-grid-size) 2) 2)) + (5x5-flip-cell solution y x)))) solution) (defun 5x5-play-solution (solution best) @@ -465,15 +465,15 @@ should return a grid vector array that is the new solution." in progress because it is an animated attempt." (5x5-new-game) (let ((inhibit-quit t)) - (loop for y from 0 to (1- 5x5-grid-size) do - (loop for x from 0 to (1- 5x5-grid-size) do - (setq 5x5-y-pos y - 5x5-x-pos x) - (if (5x5-cell solution y x) - (5x5-flip-current)) - (5x5-draw-grid (list 5x5-grid solution best)) - (5x5-position-cursor) - (sit-for 5x5-animate-delay)))) + (dotimes (y 5x5-grid-size) + (dotimes (x 5x5-grid-size) + (setq 5x5-y-pos y + 5x5-x-pos x) + (if (5x5-cell solution y x) + (5x5-flip-current)) + (5x5-draw-grid (list 5x5-grid solution best)) + (5x5-position-cursor) + (sit-for 5x5-animate-delay)))) 5x5-grid) ;; Arithmetic solver @@ -568,14 +568,14 @@ to complete the 5x5. Solutions are sorted from least to greatest Hamming weight." (require 'calc-ext) - (flet ((5x5-mat-mode-2 - (a) - (math-map-vec - (lambda (y) - (math-map-vec - (lambda (x) `(mod ,x 2)) - y)) - a))) + (cl-flet ((5x5-mat-mode-2 + (a) + (math-map-vec + (lambda (y) + (math-map-vec + (lambda (x) `(mod ,x 2)) + y)) + a))) (let* (calc-command-flags (grid-size-squared (* 5x5-grid-size 5x5-grid-size)) @@ -658,8 +658,8 @@ Solutions are sorted from least to greatest Hamming weight." (cdr (5x5-mat-mode-2 '(vec (vec 0 1 1 1 0 1 0 1 0 1 1 1 0 1 1 1 0 1 0 1 0 1 1 1 0) - (vec 1 1 0 1 1 0 0 0 0 0 1 1 0 1 - 1 0 0 0 0 0 1 1 0 1 1))))) + (vec 1 1 0 1 1 0 0 0 0 0 1 1 0 1 + 1 0 0 0 0 0 1 1 0 1 1))))) (calcFunc-trn id)))) (inv-base-change @@ -758,9 +758,9 @@ Solutions are sorted from least to greatest Hamming weight." ;; The Hamming Weight is computed by matrix reduction ;; with an ad-hoc operator. (math-reduce-vec - ;; (cadadr '(vec (mod x 2))) => x - (lambda (r x) (+ (if (integerp r) r (cadadr r)) - (cadadr x))) + ;; (cl-cadadr '(vec (mod x 2))) => x + (lambda (r x) (+ (if (integerp r) r (cl-cadadr r)) + (cl-cadadr x))) solution); car (5x5-vec-to-grid (calcFunc-arrange solution 5x5-grid-size));cdr @@ -878,28 +878,28 @@ lest." "Move up." (interactive) (unless (zerop 5x5-y-pos) - (decf 5x5-y-pos) + (cl-decf 5x5-y-pos) (5x5-position-cursor))) (defun 5x5-down () "Move down." (interactive) (unless (= 5x5-y-pos (1- 5x5-grid-size)) - (incf 5x5-y-pos) + (cl-incf 5x5-y-pos) (5x5-position-cursor))) (defun 5x5-left () "Move left." (interactive) (unless (zerop 5x5-x-pos) - (decf 5x5-x-pos) + (cl-decf 5x5-x-pos) (5x5-position-cursor))) (defun 5x5-right () "Move right." (interactive) (unless (= 5x5-x-pos (1- 5x5-grid-size)) - (incf 5x5-x-pos) + (cl-incf 5x5-x-pos) (5x5-position-cursor))) (defun 5x5-bol () diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el index a786f687124..1f04099a6ae 100644 --- a/lisp/play/bubbles.el +++ b/lisp/play/bubbles.el @@ -82,7 +82,6 @@ (defconst bubbles-version "0.5" "Version number of bubbles.el.") (require 'gamegrid) -(eval-when-compile (require 'cl)) ; for 'case ;; User options @@ -718,58 +717,58 @@ static char * dot3d_xpm[] = { (defsubst bubbles--grid-width () "Return the grid width for the current game theme." - (car (case bubbles-game-theme - (easy + (car (pcase bubbles-game-theme + (`easy bubbles--grid-small) - (medium + (`medium bubbles--grid-medium) - (difficult + (`difficult bubbles--grid-large) - (hard + (`hard bubbles--grid-huge) - (user-defined + (`user-defined bubbles-grid-size)))) (defsubst bubbles--grid-height () "Return the grid height for the current game theme." - (cdr (case bubbles-game-theme - (easy + (cdr (pcase bubbles-game-theme + (`easy bubbles--grid-small) - (medium + (`medium bubbles--grid-medium) - (difficult + (`difficult bubbles--grid-large) - (hard + (`hard bubbles--grid-huge) - (user-defined + (`user-defined bubbles-grid-size)))) (defsubst bubbles--colors () "Return the color list for the current game theme." - (case bubbles-game-theme - (easy + (pcase bubbles-game-theme + (`easy bubbles--colors-2) - (medium + (`medium bubbles--colors-3) - (difficult + (`difficult bubbles--colors-4) - (hard + (`hard bubbles--colors-5) - (user-defined + (`user-defined bubbles-colors))) (defsubst bubbles--shift-mode () "Return the shift mode for the current game theme." - (case bubbles-game-theme - (easy + (pcase bubbles-game-theme + (`easy 'default) - (medium + (`medium 'default) - (difficult + (`difficult 'always) - (hard + (`hard 'always) - (user-defined + (`user-defined bubbles-shift-mode))) (defun bubbles-save-settings () @@ -1345,12 +1344,12 @@ Return t if new char is non-empty." "Prepare images for playing `bubbles'." (when (and (display-images-p) (not (eq bubbles-graphics-theme 'ascii))) - (let ((template (case bubbles-graphics-theme - (circles bubbles--image-template-circle) - (balls bubbles--image-template-ball) - (squares bubbles--image-template-square) - (diamonds bubbles--image-template-diamond) - (emacs bubbles--image-template-emacs)))) + (let ((template (pcase bubbles-graphics-theme + (`circles bubbles--image-template-circle) + (`balls bubbles--image-template-ball) + (`squares bubbles--image-template-square) + (`diamonds bubbles--image-template-diamond) + (`emacs bubbles--image-template-emacs)))) (setq bubbles--empty-image (create-image (replace-regexp-in-string "^\"\\(.*\\)\t.*c .*\",$" diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el index 438fae4383d..8d9506a1614 100644 --- a/lisp/play/decipher.el +++ b/lisp/play/decipher.el @@ -88,8 +88,7 @@ ;;; Variables: ;;;=================================================================== -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defgroup decipher nil "Cryptanalyze monoalphabetic substitution ciphers." @@ -170,7 +169,7 @@ in your `.emacs' file.") (let ((key ?a)) (while (<= key ?z) (define-key map (vector key) 'decipher-keypress) - (incf key))) + (cl-incf key))) map) "Keymap for Decipher mode.") @@ -194,7 +193,7 @@ in your `.emacs' file.") (c ?0)) (while (<= c ?9) (modify-syntax-entry c "_" table) ;Digits are not part of words - (incf c)) + (cl-incf c)) (setq decipher-mode-syntax-table table))) (defvar decipher-alphabet nil) @@ -414,7 +413,7 @@ The most useful commands are: (if undo-rec (progn (push undo-rec decipher-undo-list) - (incf decipher-undo-list-size) + (cl-incf decipher-undo-list-size) (if (> decipher-undo-list-size decipher-undo-limit) (let ((new-size (- decipher-undo-limit 100))) ;; Truncate undo list to NEW-SIZE elements: @@ -588,7 +587,7 @@ you have determined the keyword." (progn (while (rassoc cipher-char decipher-alphabet) ;; Find the next unused letter - (incf cipher-char)) + (cl-incf cipher-char)) (push (cons ?\s cipher-char) undo-rec) (decipher-set-map cipher-char (car plain-map) t)))) (decipher-add-undo undo-rec))) @@ -644,7 +643,7 @@ You should use this if you edit the ciphertext." (while (>= plain-char ?a) (backward-char) (push (cons plain-char (following-char)) decipher-alphabet) - (decf plain-char))))) + (cl-decf plain-char))))) ;;;=================================================================== ;;; Analyzing ciphertext: @@ -805,8 +804,8 @@ TOTAL is the total number of letters in the ciphertext." (while temp-list (insert (caar temp-list) (format "%4d%3d%% " - (cadar temp-list) - (/ (* 100 (cadar temp-list)) total))) + (cl-cadar temp-list) + (/ (* 100 (cl-cadar temp-list)) total))) (setq temp-list (nthcdr 4 temp-list))) (insert ?\n) (setq freq-list (cdr freq-list) @@ -838,17 +837,17 @@ TOTAL is the total number of letters in the ciphertext." ;; A vector of 26 integers, counting the number of occurrences ;; of the corresponding characters. (setq decipher--digram (format "%c%c" decipher--prev-char decipher-char)) - (incf (cdr (or (assoc decipher--digram decipher--digram-list) + (cl-incf (cdr (or (assoc decipher--digram decipher--digram-list) (car (push (cons decipher--digram 0) decipher--digram-list))))) (and (>= decipher--prev-char ?A) - (incf (aref (aref decipher--before (- decipher--prev-char ?A)) + (cl-incf (aref (aref decipher--before (- decipher--prev-char ?A)) (if (equal decipher-char ?\s) 26 (- decipher-char ?A))))) (and (>= decipher-char ?A) - (incf (aref decipher--freqs (- decipher-char ?A))) - (incf (aref (aref decipher--after (- decipher-char ?A)) + (cl-incf (aref decipher--freqs (- decipher-char ?A))) + (cl-incf (aref (aref decipher--after (- decipher-char ?A)) (if (equal decipher--prev-char ?\s) 26 (- decipher--prev-char ?A))))) @@ -859,8 +858,8 @@ TOTAL is the total number of letters in the ciphertext." (let ((total 0)) (concat (mapconcat (lambda (x) - (cond ((> x 99) (incf total) "XX") - ((> x 0) (incf total) (format "%2d" x)) + (cond ((> x 99) (cl-incf total) "XX") + ((> x 0) (cl-incf total) (format "%2d" x)) (t " "))) counts "") @@ -873,10 +872,10 @@ TOTAL is the total number of letters in the ciphertext." ;; We do not include spaces (word divisions) in this count. (let ((total 0) (i 26)) - (while (>= (decf i) 0) + (while (>= (cl-decf i) 0) (if (or (> (aref before-count i) 0) (> (aref after-count i) 0)) - (incf total))) + (cl-incf total))) total)) (defun decipher-analyze-buffer () @@ -890,7 +889,7 @@ Creates the statistics buffer if it doesn't exist." decipher--digram decipher--digram-list freq-list) (message "Scanning buffer...") (let ((i 26)) - (while (>= (decf i) 0) + (while (>= (cl-decf i) 0) (aset decipher--before i (make-vector 27 0)) (aset decipher--after i (make-vector 27 0)))) (if decipher-ignore-spaces @@ -898,7 +897,7 @@ Creates the statistics buffer if it doesn't exist." (decipher-loop-no-breaks 'decipher--analyze) ;; The first character of ciphertext was marked as following a space: (let ((i 26)) - (while (>= (decf i) 0) + (while (>= (cl-decf i) 0) (aset (aref decipher--after i) 26 0)))) (decipher-loop-with-breaks 'decipher--analyze)) (message "Processing results...") @@ -913,7 +912,7 @@ Creates the statistics buffer if it doesn't exist." ;; of times it occurs, and DIFFERENT is the number of different ;; letters it appears next to. (let ((i 26)) - (while (>= (decf i) 0) + (while (>= (cl-decf i) 0) (setq freq-list (cons (list (+ i ?A) (aref decipher--freqs i) @@ -933,7 +932,7 @@ Creates the statistics buffer if it doesn't exist." (insert ?\n) ;; Display frequency counts for letters in order of frequency: (setq freq-list (sort freq-list - (lambda (a b) (> (second a) (second b))))) + (lambda (a b) (> (cl-second a) (cl-second b))))) (decipher-insert-frequency-counts freq-list total-chars) ;; Display letters in order of frequency: (insert ?\n (mapconcat (lambda (a) (char-to-string (car a))) @@ -957,11 +956,11 @@ Creates the statistics buffer if it doesn't exist." ;; Display adjacency list for each letter, sorted in descending ;; order of the number of adjacent letters: (setq freq-list (sort freq-list - (lambda (a b) (> (third a) (third b))))) + (lambda (a b) (> (cl-third a) (cl-third b))))) (let ((temp-list freq-list) entry i) (while (setq entry (pop temp-list)) - (if (equal 0 (second entry)) + (if (equal 0 (cl-second entry)) nil ;This letter was not used (setq i (- (car entry) ?A)) (insert ?\n " " @@ -969,8 +968,8 @@ Creates the statistics buffer if it doesn't exist." (car entry) ": A B C D E F G H I J K L M N O P Q R S T U V W X Y Z *" (format "%4d %4d %3d%%\n " - (third entry) (second entry) - (/ (* 100 (second entry)) total-chars)) + (cl-third entry) (cl-second entry) + (/ (* 100 (cl-second entry)) total-chars)) (decipher--digram-counts (aref decipher--after i)) ?\n)))) (setq buffer-read-only t) (set-buffer-modified-p nil) diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index 3b2e6c196f6..f3e277e338c 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -26,9 +26,6 @@ ;;; Code: -(eval-when-compile - (require 'cl)) - ;; ;;;;;;;;;;;;; buffer-local variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar gamegrid-use-glyphs t @@ -212,20 +209,20 @@ static unsigned char gamegrid_bits[] = { (defun gamegrid-make-face (data-spec-list color-spec-list) (let ((data (gamegrid-match-spec-list data-spec-list)) (color (gamegrid-match-spec-list color-spec-list))) - (case data - (color-x + (pcase data + (`color-x (gamegrid-make-color-x-face color)) - (grid-x + (`grid-x (unless gamegrid-grid-x-face (setq gamegrid-grid-x-face (gamegrid-make-grid-x-face))) gamegrid-grid-x-face) - (mono-x + (`mono-x (unless gamegrid-mono-x-face (setq gamegrid-mono-x-face (gamegrid-make-mono-x-face))) gamegrid-mono-x-face) - (color-tty + (`color-tty (gamegrid-make-color-tty-face color)) - (mono-tty + (`mono-tty (unless gamegrid-mono-tty-face (setq gamegrid-mono-tty-face (gamegrid-make-mono-tty-face))) gamegrid-mono-tty-face)))) @@ -311,13 +308,13 @@ static unsigned char gamegrid_bits[] = { (intern (concat "gamegrid-face-" (buffer-name))))) (when (eq gamegrid-display-mode 'glyph) (let ((max-height nil)) - (loop for c from 0 to 255 do - (let ((glyph (aref gamegrid-display-table c))) - (when (and (listp glyph) (eq (car glyph) 'image)) - (let ((height (cdr (image-size glyph)))) - (if (or (null max-height) - (< max-height height)) - (setq max-height height)))))) + (dotimes (c 256) + (let ((glyph (aref gamegrid-display-table c))) + (when (and (listp glyph) (eq (car glyph) 'image)) + (let ((height (cdr (image-size glyph)))) + (if (or (null max-height) + (< max-height height)) + (setq max-height height)))))) (when (and max-height (< max-height 1)) (let ((default-font-height (face-attribute 'default :height)) (resy (/ (display-pixel-height) (/ (display-mm-height) 25.4))) @@ -332,10 +329,10 @@ static unsigned char gamegrid_bits[] = { (setq gamegrid-display-mode (gamegrid-display-type)) (setq gamegrid-display-table (make-display-table)) (setq gamegrid-face-table (make-vector 256 nil)) - (loop for c from 0 to 255 do + (dotimes (c 256) (let* ((spec (aref gamegrid-display-options c)) - (glyph (gamegrid-make-glyph (car spec) (caddr spec))) - (face (gamegrid-make-face (cadr spec) (caddr spec)))) + (glyph (gamegrid-make-glyph (car spec) (nth 2 spec))) + (face (gamegrid-make-face (cadr spec) (nth 2 spec)))) (aset gamegrid-face-table c face) (aset gamegrid-display-table c glyph))) (gamegrid-setup-default-font) @@ -451,10 +448,10 @@ group. You probably need special user privileges to do this. On non-POSIX systems Emacs searches for FILE in the directory specified by the variable `temporary-file-directory'. If necessary, FILE is created there." - (case system-type - ((ms-dos windows-nt) + (pcase system-type + ((or `ms-dos `windows-nt) (gamegrid-add-score-insecure file score)) - (t + (_ (gamegrid-add-score-with-update-game-score file score)))) diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el index 31a6d6f425b..9e8b6ff97eb 100644 --- a/lisp/play/hanoi.el +++ b/lisp/play/hanoi.el @@ -56,15 +56,14 @@ ;;; Code: -(eval-when-compile - (require 'cl) - ;; dynamic bondage: - (defvar baseward-step) - (defvar fly-step) - (defvar fly-row-start) - (defvar pole-width) - (defvar pole-char) - (defvar line-offset)) +(eval-when-compile (require 'cl-lib)) +;; dynamic bondage: +(defvar baseward-step) +(defvar fly-step) +(defvar fly-row-start) +(defvar pole-width) +(defvar pole-char) +(defvar line-offset) (defgroup hanoi nil "The Towers of Hanoi." @@ -124,9 +123,9 @@ second since 1970-01-01 00:00:00 GMT. Repent before ring 31 moves." (interactive) (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)))) + (bits (cl-loop repeat 32 + for x = (/ start (expt 2.0 31)) then (* x 2.0) + collect (truncate (mod x 2.0)))) (hanoi-move-period 1.0)) (hanoi-internal 32 bits start))) @@ -138,9 +137,9 @@ current-time interface is made s2G-compliant, hanoi.el will need to be updated." (interactive) (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)))) + (bits (cl-loop repeat 64 + for x = (/ start (expt 2.0 63)) then (* x 2.0) + collect (truncate (mod x 2.0)))) (hanoi-move-period 1.0)) (hanoi-internal 64 bits start))) @@ -197,22 +196,22 @@ BITS must be of length nrings. Start at START-TIME." (setq fly-row-start (1- line-offset)) (setq fly-step line-offset) (setq baseward-step -1) - (loop repeat base-len do - (unless (zerop base-lines) - (insert-char ?\ (1- base-lines)) - (insert base-char) - (hanoi-put-face (1- (point)) (point) hanoi-base-face)) - (insert-char ?\ (+ 2 nrings)) - (insert ?\n)) + (cl-loop repeat base-len do + (unless (zerop base-lines) + (insert-char ?\ (1- base-lines)) + (insert base-char) + (hanoi-put-face (1- (point)) (point) hanoi-base-face)) + (insert-char ?\ (+ 2 nrings)) + (insert ?\n)) (delete-char -1) - (loop for coord in pole-coords do - (loop for row from (- coord (/ pole-width 2)) - for start = (+ (* row line-offset) base-lines 1) - repeat pole-width do - (subst-char-in-region start (+ start nrings 1) - ?\ pole-char) - (hanoi-put-face start (+ start nrings 1) - hanoi-pole-face)))) + (dolist (coord pole-coords) + (cl-loop for row from (- coord (/ pole-width 2)) + for start = (+ (* row line-offset) base-lines 1) + repeat pole-width do + (subst-char-in-region start (+ start nrings 1) + ?\ pole-char) + (hanoi-put-face start (+ start nrings 1) + hanoi-pole-face)))) ;; vertical (setq line-offset (1+ base-len)) (setq fly-step 1) @@ -222,17 +221,17 @@ BITS must be of length nrings. Start at START-TIME." (setq fly-row-start (point)) (insert-char ?\ base-len) (insert ?\n) - (loop repeat (1+ nrings) - with pole-line = - (loop with line = (make-string base-len ?\ ) - for coord in pole-coords - for start = (- coord (/ pole-width 2)) - for end = (+ start pole-width) do - (hanoi-put-face start end hanoi-pole-face line) - (loop for i from start below end do - (aset line i pole-char)) - finally return line) - do (insert pole-line ?\n)) + (cl-loop repeat (1+ nrings) + with pole-line = + (cl-loop with line = (make-string base-len ?\ ) + for coord in pole-coords + for start = (- coord (/ pole-width 2)) + for end = (+ start pole-width) do + (hanoi-put-face start end hanoi-pole-face line) + (cl-loop for i from start below end do + (aset line i pole-char)) + finally return line) + do (insert pole-line ?\n)) (insert-char base-char base-len) (hanoi-put-face (- (point) base-len) (point) hanoi-base-face) (set-window-start (selected-window) @@ -244,40 +243,41 @@ BITS must be of length nrings. Start at START-TIME." ;; the car is the position of the top ring currently on the pole, ;; (or the base of the pole if it is empty). ;; the cdr is in the fly-row just above the pole. - (poles (loop for coord in pole-coords - for fly-pos = (+ fly-row-start (* fly-step coord)) - for base = (+ fly-pos (* baseward-step (+ 2 nrings))) - collect (cons base fly-pos))) + (poles + (cl-loop for coord in pole-coords + for fly-pos = (+ fly-row-start (* fly-step coord)) + for base = (+ fly-pos (* baseward-step (+ 2 nrings))) + collect (cons base fly-pos))) ;; compute the string for each ring and make the list of ;; ring pairs. Each ring pair is initially (str . diameter). ;; Once placed in buffer it is changed to (center-pos . diameter). (rings - (loop - ;; radii are measured from the edge of the pole out. - ;; So diameter = 2 * radius + pole-width. When - ;; there's room, we make each ring's radius = - ;; pole-number + 1. If there isn't room, we step - ;; evenly from the max radius down to 1. - with max-radius = (min nrings - (/ (- max-ring-diameter pole-width) 2)) - for n from (1- nrings) downto 0 - for radius = (1+ (/ (* n max-radius) nrings)) - for diameter = (+ pole-width (* 2 radius)) - with format-str = (format "%%0%dd" pole-width) - for str = (concat (if vert "<" "^") - (make-string (1- radius) (if vert ?\- ?\|)) - (format format-str n) - (make-string (1- radius) (if vert ?\- ?\|)) - (if vert ">" "v")) - for face = - (if (eq (logand n 1) 1) ; oddp would require cl at runtime - hanoi-odd-ring-face hanoi-even-ring-face) - do (hanoi-put-face 0 (length str) face str) - collect (cons str diameter))) + (cl-loop + ;; radii are measured from the edge of the pole out. + ;; So diameter = 2 * radius + pole-width. When + ;; there's room, we make each ring's radius = + ;; pole-number + 1. If there isn't room, we step + ;; evenly from the max radius down to 1. + with max-radius = (min nrings + (/ (- max-ring-diameter pole-width) 2)) + for n from (1- nrings) downto 0 + for radius = (1+ (/ (* n max-radius) nrings)) + for diameter = (+ pole-width (* 2 radius)) + with format-str = (format "%%0%dd" pole-width) + for str = (concat (if vert "<" "^") + (make-string (1- radius) (if vert ?\- ?\|)) + (format format-str n) + (make-string (1- radius) (if vert ?\- ?\|)) + (if vert ">" "v")) + for face = + (if (eq (logand n 1) 1) ; oddp would require cl at runtime + hanoi-odd-ring-face hanoi-even-ring-face) + do (hanoi-put-face 0 (length str) face str) + collect (cons str diameter))) ;; Disable display of line and column numbers, for speed. (line-number-mode nil) (column-number-mode nil)) ;; do it! - (hanoi-n bits rings (car poles) (cadr poles) (caddr poles) + (hanoi-n bits rings (car poles) (cadr poles) (cl-caddr poles) start-time)) (message "Done")) (setq buffer-read-only t) @@ -322,14 +322,14 @@ BITS must be of length nrings. Start at START-TIME." ;; put never-before-placed RING on POLE and update their cars. (defun hanoi-insert-ring (ring pole) - (decf (car pole) baseward-step) + (cl-decf (car pole) baseward-step) (let ((str (car ring)) (start (- (car pole) (* (/ (cdr ring) 2) fly-step)))) (setcar ring (car pole)) - (loop for pos upfrom start by fly-step - for i below (cdr ring) do - (subst-char-in-region pos (1+ pos) (char-after pos) (aref str i)) - (set-text-properties pos (1+ pos) (text-properties-at i str))) + (cl-loop for pos upfrom start by fly-step + for i below (cdr ring) do + (subst-char-in-region pos (1+ pos) (char-after pos) (aref str i)) + (set-text-properties pos (1+ pos) (text-properties-at i str))) (hanoi-goto-char (car pole)))) ;; like goto-char, but if position is outside the window, then move to @@ -341,8 +341,8 @@ BITS must be of length nrings. Start at START-TIME." ;; do one pole-to-pole move and update the ring and pole pairs. (defun hanoi-move-ring (ring from to start-time) - (incf (car from) baseward-step) - (decf (car to) baseward-step) + (cl-incf (car from) baseward-step) + (cl-decf (car to) baseward-step) (let* ;; We move flywards-steps steps up the pole to the fly row, ;; then fly fly-steps steps across the fly row, then go ;; baseward-steps steps down the new pole. @@ -378,15 +378,15 @@ 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 = (- (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 - (hanoi-ring-to-pos ring (funcall tick-to-pos tick)) - (hanoi-sit-for (- (* tick tick-period) elapsed))) - (loop for tick from 1 to total-ticks by 2 do - (hanoi-ring-to-pos ring (funcall tick-to-pos tick)) - (hanoi-sit-for 0))) + (cl-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 + (hanoi-ring-to-pos ring (funcall tick-to-pos tick)) + (hanoi-sit-for (- (* tick tick-period) elapsed))) + (cl-loop for tick from 1 to total-ticks by 2 do + (hanoi-ring-to-pos ring (funcall tick-to-pos tick)) + (hanoi-sit-for 0))) ;; Always make last move to keep pole and ring data consistent (hanoi-ring-to-pos ring (car to)) (if hanoi-move-period (+ start-time hanoi-move-period)))) @@ -403,11 +403,12 @@ BITS must be of length nrings. Start at START-TIME." (let* ((start (- (car ring) (* (/ (cdr ring) 2) fly-step))) (new-start (- pos (- (car ring) start)))) (if hanoi-horizontal-flag - (loop for i below (cdr ring) - for j = (if (< new-start start) i (- (cdr ring) i 1)) - for old-pos = (+ start (* j fly-step)) - for new-pos = (+ new-start (* j fly-step)) do - (transpose-regions old-pos (1+ old-pos) new-pos (1+ new-pos))) + (cl-loop for i below (cdr ring) + for j = (if (< new-start start) i (- (cdr ring) i 1)) + for old-pos = (+ start (* j fly-step)) + for new-pos = (+ new-start (* j fly-step)) do + (transpose-regions old-pos (1+ old-pos) + new-pos (1+ new-pos))) (let ((end (+ start (cdr ring))) (new-end (+ new-start (cdr ring)))) (if (< (abs (- new-start start)) (- end start)) @@ -425,9 +426,9 @@ BITS must be of length nrings. Start at START-TIME." (curr-char (if on-pole ?\ pole-char)) (face (if on-pole hanoi-pole-face nil))) (if hanoi-horizontal-flag - (loop for pos from pole-start below pole-end by line-offset do - (subst-char-in-region pos (1+ pos) curr-char new-char) - (hanoi-put-face pos (1+ pos) face)) + (cl-loop for pos from pole-start below pole-end by line-offset do + (subst-char-in-region pos (1+ pos) curr-char new-char) + (hanoi-put-face pos (1+ pos) face)) (subst-char-in-region pole-start pole-end curr-char new-char) (hanoi-put-face pole-start pole-end face)))) (setcar ring pos)) diff --git a/lisp/play/landmark.el b/lisp/play/landmark.el index 9ffc308928a..e9f555093db 100644 --- a/lisp/play/landmark.el +++ b/lisp/play/landmark.el @@ -56,7 +56,7 @@ ;; concise problem description. ;;;_* Require -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;;;_* From Gomoku @@ -1417,7 +1417,7 @@ After this limit is reached, landmark-random-move is called to push him out of i (put 'z 't-1 (get 'z 't)) (put 'z 't (calc-smell-internal 'landmark-tree)) (if (= (- (get 'z 't) (get 'z 't-1)) 0.0) - (incf landmark-no-payoff) + (cl-incf landmark-no-payoff) (setf landmark-no-payoff 0))) (defun landmark-store-old-y_t () @@ -1464,7 +1464,7 @@ After this limit is reached, landmark-random-move is called to push him out of i (landmark-e forward-char) (landmark-w backward-char))) (landmark-plot-square (landmark-point-square) 1) - (incf landmark-number-of-moves) + (cl-incf landmark-number-of-moves) (if landmark-output-moves (message "Moves made: %d" landmark-number-of-moves))) @@ -1591,11 +1591,11 @@ If the game is finished, this command requests for another game." ; this a worka! ; (eval (cons '+ list)) ;;;_ - landmark-set-landmark-signal-strengths () -;;; on a screen higher than wide, I noticed that the robot would amble -;;; left and right and not move forward. examining *landmark-blackbox* -;;; revealed that there was no scent from the north and south -;;; landmarks, hence, they need less factoring down of the effect of -;;; distance on scent. +;; on a screen higher than wide, I noticed that the robot would amble +;; left and right and not move forward. examining *landmark-blackbox* +;; revealed that there was no scent from the north and south +;; landmarks, hence, they need less factoring down of the effect of +;; distance on scent. (defun landmark-set-landmark-signal-strengths () (setq landmark-tree-r (* (sqrt (+ (square landmark-cx) (square landmark-cy))) 1.5)) diff --git a/lisp/play/pong.el b/lisp/play/pong.el index 5742a5c7849..cb165cdf31e 100644 --- a/lisp/play/pong.el +++ b/lisp/play/pong.el @@ -26,7 +26,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'gamegrid) @@ -214,18 +214,18 @@ (defun pong-display-options () "Computes display options (required by gamegrid for colors)." (let ((options (make-vector 256 nil))) - (loop for c from 0 to 255 do + (dotimes (c 256) (aset options c - (cond ((= c pong-blank) - pong-blank-options) + (cond ((= c pong-blank) + pong-blank-options) ((= c pong-bat) - pong-bat-options) + pong-bat-options) ((= c pong-ball) - pong-ball-options) + pong-ball-options) ((= c pong-border) - pong-border-options) + pong-border-options) (t - '(nil nil nil))))) + '(nil nil nil))))) options)) @@ -246,18 +246,19 @@ ?\s) (let ((buffer-read-only nil)) - (loop for y from 0 to (1- pong-height) do - (loop for x from 0 to (1- pong-width) do - (gamegrid-set-cell x y pong-border))) - (loop for y from 1 to (- pong-height 2) do - (loop for x from 1 to (- pong-width 2) do - (gamegrid-set-cell x y pong-blank)))) - - (loop for y from pong-bat-player1 to (1- (+ pong-bat-player1 pong-bat-width)) do - (gamegrid-set-cell 2 y pong-bat)) - (loop for y from pong-bat-player2 to (1- (+ pong-bat-player2 pong-bat-width)) do - (gamegrid-set-cell (- pong-width 3) y pong-bat))) + (dotimes (y pong-height) + (dotimes (x pong-width) + (gamegrid-set-cell x y pong-border))) + (cl-loop for y from 1 to (- pong-height 2) do + (cl-loop for x from 1 to (- pong-width 2) do + (gamegrid-set-cell x y pong-blank)))) + (cl-loop for y from pong-bat-player1 + to (1- (+ pong-bat-player1 pong-bat-width)) + do (gamegrid-set-cell 2 y pong-bat)) + (cl-loop for y from pong-bat-player2 + to (1- (+ pong-bat-player2 pong-bat-width)) + do (gamegrid-set-cell (- pong-width 3) y pong-bat))) (defun pong-move-left () @@ -401,13 +402,12 @@ detection and checks if a player scores." (defun pong-update-score () "Update score and print it on bottom of the game grid." - (let* ((string (format "Score: %d / %d" pong-score-player1 pong-score-player2)) + (let* ((string (format "Score: %d / %d" + pong-score-player1 pong-score-player2)) (len (length string))) - (loop for x from 0 to (1- len) do - (if (string-equal (buffer-name (current-buffer)) pong-buffer-name) - (gamegrid-set-cell x - pong-height - (aref string x)))))) + (dotimes (x len) + (if (string-equal (buffer-name (current-buffer)) pong-buffer-name) + (gamegrid-set-cell x pong-height (aref string x)))))) diff --git a/lisp/play/snake.el b/lisp/play/snake.el index db54039c237..a3480d0b0fa 100644 --- a/lisp/play/snake.el +++ b/lisp/play/snake.el @@ -25,8 +25,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'gamegrid) @@ -195,7 +194,7 @@ and then start moving it leftwards.") (defun snake-display-options () (let ((options (make-vector 256 nil))) - (loop for c from 0 to 255 do + (dotimes (c 256) (aset options c (cond ((= c snake-blank) snake-blank-options) @@ -214,7 +213,7 @@ and then start moving it leftwards.") (defun snake-update-score () (let* ((string (format "Score: %05d" snake-score)) (len (length string))) - (loop for x from 0 to (1- len) do + (dotimes (x len) (gamegrid-set-cell (+ snake-score-x x) snake-score-y (aref string x))))) @@ -224,12 +223,12 @@ and then start moving it leftwards.") snake-buffer-height snake-space) (let ((buffer-read-only nil)) - (loop for y from 0 to (1- snake-height) do - (loop for x from 0 to (1- snake-width) do - (gamegrid-set-cell x y snake-border))) - (loop for y from 1 to (- snake-height 2) do - (loop for x from 1 to (- snake-width 2) do - (gamegrid-set-cell x y snake-blank))))) + (dotimes (y snake-height) + (dotimes (x snake-width) + (gamegrid-set-cell x y snake-border))) + (cl-loop for y from 1 to (- snake-height 2) do + (cl-loop for x from 1 to (- snake-width 2) do + (gamegrid-set-cell x y snake-blank))))) (defun snake-reset-game () (gamegrid-kill-timer) @@ -248,8 +247,8 @@ and then start moving it leftwards.") (dotimes (i snake-length) (gamegrid-set-cell x y snake-snake) (setq snake-positions (cons (vector x y) snake-positions)) - (incf x snake-velocity-x) - (incf y snake-velocity-y))) + (cl-incf x snake-velocity-x) + (cl-incf y snake-velocity-y))) (snake-update-score)) (defun snake-update-game (snake-buffer) @@ -267,8 +266,8 @@ Argument SNAKE-BUFFER is the name of the buffer." (= c snake-snake)) (snake-end-game) (cond ((= c snake-dot) - (incf snake-length) - (incf snake-score) + (cl-incf snake-length) + (cl-incf snake-score) (snake-update-score)) (t (let* ((last-cons (nthcdr (- snake-length 2) @@ -280,7 +279,7 @@ Argument SNAKE-BUFFER is the name of the buffer." (if (= (% snake-cycle 5) 0) snake-dot snake-blank)) - (incf snake-cycle) + (cl-incf snake-cycle) (setcdr last-cons nil)))) (gamegrid-set-cell x y snake-snake) (setq snake-positions diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el index 24d1c3f2417..b811a21605b 100644 --- a/lisp/play/tetris.el +++ b/lisp/play/tetris.el @@ -26,8 +26,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'gamegrid) @@ -285,20 +284,20 @@ each one of its four blocks.") (defun tetris-display-options () (let ((options (make-vector 256 nil))) - (loop for c from 0 to 255 do + (dotimes (c 256) (aset options c (cond ((= c tetris-blank) - tetris-blank-options) + tetris-blank-options) ((and (>= c 0) (<= c 6)) (append tetris-cell-options `((((glyph color-x) ,(aref tetris-x-colors c)) (color-tty ,(aref tetris-tty-colors c)) (t nil))))) - ((= c tetris-border) - tetris-border-options) - ((= c tetris-space) - tetris-space-options) + ((= c tetris-border) + tetris-border-options) + ((= c tetris-space) + tetris-space-options) (t '(nil nil nil))))) options)) @@ -325,13 +324,13 @@ each one of its four blocks.") (let ((strings (vector (format "Shapes: %05d" tetris-n-shapes) (format "Rows: %05d" tetris-n-rows) (format "Score: %05d" tetris-score)))) - (loop for y from 0 to 2 do - (let* ((string (aref strings y)) - (len (length string))) - (loop for x from 0 to (1- len) do - (gamegrid-set-cell (+ tetris-score-x x) - (+ tetris-score-y y) - (aref string x))))))) + (dotimes (y 3) + (let* ((string (aref strings y)) + (len (length string))) + (dotimes (x len) + (gamegrid-set-cell (+ tetris-score-x x) + (+ tetris-score-y y) + (aref string x))))))) (defun tetris-update-score () (tetris-draw-score) @@ -351,88 +350,88 @@ each one of its four blocks.") (tetris-update-score))) (defun tetris-draw-next-shape () - (loop for x from 0 to 3 do - (loop for y from 0 to 3 do - (gamegrid-set-cell (+ tetris-next-x x) - (+ tetris-next-y y) - tetris-blank))) - (loop for i from 0 to 3 do - (let ((tetris-shape tetris-next-shape) - (tetris-rot 0)) - (gamegrid-set-cell (+ tetris-next-x - (aref (tetris-get-shape-cell i) 0)) - (+ tetris-next-y - (aref (tetris-get-shape-cell i) 1)) - tetris-shape)))) + (dotimes (x 4) + (dotimes (y 4) + (gamegrid-set-cell (+ tetris-next-x x) + (+ tetris-next-y y) + tetris-blank))) + (dotimes (i 4) + (let ((tetris-shape tetris-next-shape) + (tetris-rot 0)) + (gamegrid-set-cell (+ tetris-next-x + (aref (tetris-get-shape-cell i) 0)) + (+ tetris-next-y + (aref (tetris-get-shape-cell i) 1)) + tetris-shape)))) (defun tetris-draw-shape () - (loop for i from 0 to 3 do - (let ((c (tetris-get-shape-cell i))) - (gamegrid-set-cell (+ tetris-top-left-x - tetris-pos-x - (aref c 0)) - (+ tetris-top-left-y - tetris-pos-y - (aref c 1)) - tetris-shape)))) + (dotimes (i 4) + (let ((c (tetris-get-shape-cell i))) + (gamegrid-set-cell (+ tetris-top-left-x + tetris-pos-x + (aref c 0)) + (+ tetris-top-left-y + tetris-pos-y + (aref c 1)) + tetris-shape)))) (defun tetris-erase-shape () - (loop for i from 0 to 3 do - (let ((c (tetris-get-shape-cell i))) - (gamegrid-set-cell (+ tetris-top-left-x - tetris-pos-x - (aref c 0)) - (+ tetris-top-left-y - tetris-pos-y - (aref c 1)) - tetris-blank)))) + (dotimes (i 4) + (let ((c (tetris-get-shape-cell i))) + (gamegrid-set-cell (+ tetris-top-left-x + tetris-pos-x + (aref c 0)) + (+ tetris-top-left-y + tetris-pos-y + (aref c 1)) + tetris-blank)))) (defun tetris-test-shape () (let ((hit nil)) - (loop for i from 0 to 3 do - (unless hit - (setq hit - (let* ((c (tetris-get-shape-cell i)) - (xx (+ tetris-pos-x - (aref c 0))) - (yy (+ tetris-pos-y - (aref c 1)))) - (or (>= xx tetris-width) - (>= yy tetris-height) - (/= (gamegrid-get-cell - (+ xx tetris-top-left-x) - (+ yy tetris-top-left-y)) - tetris-blank)))))) + (dotimes (i 4) + (unless hit + (setq hit + (let* ((c (tetris-get-shape-cell i)) + (xx (+ tetris-pos-x + (aref c 0))) + (yy (+ tetris-pos-y + (aref c 1)))) + (or (>= xx tetris-width) + (>= yy tetris-height) + (/= (gamegrid-get-cell + (+ xx tetris-top-left-x) + (+ yy tetris-top-left-y)) + tetris-blank)))))) hit)) (defun tetris-full-row (y) (let ((full t)) - (loop for x from 0 to (1- tetris-width) do - (if (= (gamegrid-get-cell (+ tetris-top-left-x x) - (+ tetris-top-left-y y)) - tetris-blank) - (setq full nil))) + (dotimes (x tetris-width) + (if (= (gamegrid-get-cell (+ tetris-top-left-x x) + (+ tetris-top-left-y y)) + tetris-blank) + (setq full nil))) full)) (defun tetris-shift-row (y) (if (= y 0) - (loop for x from 0 to (1- tetris-width) do + (dotimes (x tetris-width) (gamegrid-set-cell (+ tetris-top-left-x x) (+ tetris-top-left-y y) tetris-blank)) - (loop for x from 0 to (1- tetris-width) do - (let ((c (gamegrid-get-cell (+ tetris-top-left-x x) - (+ tetris-top-left-y y -1)))) - (gamegrid-set-cell (+ tetris-top-left-x x) - (+ tetris-top-left-y y) + (dotimes (x tetris-width) + (let ((c (gamegrid-get-cell (+ tetris-top-left-x x) + (+ tetris-top-left-y y -1)))) + (gamegrid-set-cell (+ tetris-top-left-x x) + (+ tetris-top-left-y y) c))))) (defun tetris-shift-down () - (loop for y0 from 0 to (1- tetris-height) do - (if (tetris-full-row y0) - (progn (setq tetris-n-rows (1+ tetris-n-rows)) - (loop for y from y0 downto 0 do - (tetris-shift-row y)))))) + (dotimes (y0 tetris-height) + (when (tetris-full-row y0) + (setq tetris-n-rows (1+ tetris-n-rows)) + (cl-loop for y from y0 downto 0 do + (tetris-shift-row y))))) (defun tetris-draw-border-p () (or (not (eq gamegrid-display-mode 'glyph)) @@ -444,22 +443,22 @@ each one of its four blocks.") tetris-space) (let ((buffer-read-only nil)) (if (tetris-draw-border-p) - (loop for y from -1 to tetris-height do - (loop for x from -1 to tetris-width do - (gamegrid-set-cell (+ tetris-top-left-x x) - (+ tetris-top-left-y y) - tetris-border)))) - (loop for y from 0 to (1- tetris-height) do - (loop for x from 0 to (1- tetris-width) do - (gamegrid-set-cell (+ tetris-top-left-x x) - (+ tetris-top-left-y y) - tetris-blank))) + (cl-loop for y from -1 to tetris-height do + (cl-loop for x from -1 to tetris-width do + (gamegrid-set-cell (+ tetris-top-left-x x) + (+ tetris-top-left-y y) + tetris-border)))) + (dotimes (y tetris-height) + (dotimes (x tetris-width) + (gamegrid-set-cell (+ tetris-top-left-x x) + (+ tetris-top-left-y y) + tetris-blank))) (if (tetris-draw-border-p) - (loop for y from -1 to 4 do - (loop for x from -1 to 4 do - (gamegrid-set-cell (+ tetris-next-x x) - (+ tetris-next-y y) - tetris-border)))))) + (cl-loop for y from -1 to 4 do + (cl-loop for x from -1 to 4 do + (gamegrid-set-cell (+ tetris-next-x x) + (+ tetris-next-y y) + tetris-border)))))) (defun tetris-reset-game () (gamegrid-kill-timer) diff --git a/lisp/proced.el b/lisp/proced.el index 930f7d99f9e..78afcac9f50 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -1170,14 +1170,16 @@ Return nil otherwise." (defun proced-time-lessp (t1 t2) "Return t if time value T1 is less than time value T2. Return `equal' if T1 equals T2. Return nil otherwise." - (with-decoded-time-value ((high1 low1 micro1 t1) - (high2 low2 micro2 t2)) + (with-decoded-time-value ((high1 low1 micro1 pico1 type1 t1) + (high2 low2 micro2 pico2 type2 t2)) (cond ((< high1 high2)) ((< high2 high1) nil) ((< low1 low2)) ((< low2 low1) nil) ((< micro1 micro2)) ((< micro2 micro1) nil) + ((< pico1 pico2)) + ((< pico2 pico1) nil) (t 'equal)))) ;;; Sorting diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el index 146cc703e1a..1bee783bb17 100644 --- a/lisp/progmodes/ada-xref.el +++ b/lisp/progmodes/ada-xref.el @@ -1544,9 +1544,7 @@ the project file." ;; also a separate. (with-current-buffer (get-file-buffer file) - (let ((short-ali-file-name - (concat (file-name-sans-extension (file-name-nondirectory file)) - ".ali")) + (let ((short-ali-file-name (concat (file-name-base file) ".ali")) ali-file-name is-spec) @@ -1566,10 +1564,7 @@ the project file." (if is-spec (set 'ali-file-name (ada-find-ali-file-in-dir - (concat (file-name-sans-extension - (file-name-nondirectory - (ada-other-file-name))) - ".ali")))) + (concat (file-name-base (ada-other-file-name)) ".ali")))) (setq ali-file-name @@ -1584,15 +1579,12 @@ the project file." ;; file_s.ada and file_b.ada), try to go to the other file ;; and look for its ali file (ada-find-ali-file-in-dir - (concat (file-name-sans-extension - (file-name-nondirectory (ada-other-file-name))) - ".ali")) + (concat (file-name-base (ada-other-file-name)) ".ali")) ;; If we still don't have an ali file, try to get the one ;; from the parent unit, in case we have a separate entity. - (let ((parent-name (file-name-sans-extension - (file-name-nondirectory file)))) + (let ((parent-name (file-name-base file))) (while (and (not ali-file-name) (string-match "^\\(.*\\)[.-][^.-]*" parent-name)) diff --git a/lisp/progmodes/autoconf.el b/lisp/progmodes/autoconf.el index a7242f6c232..3225fef2dfa 100644 --- a/lisp/progmodes/autoconf.el +++ b/lisp/progmodes/autoconf.el @@ -1,4 +1,4 @@ -;;; autoconf.el --- mode for editing Autoconf configure.in files +;;; autoconf.el --- mode for editing Autoconf configure.ac files ;; Copyright (C) 2000-2012 Free Software Foundation, Inc. @@ -23,15 +23,15 @@ ;;; Commentary: ;; Provides fairly minimal font-lock, imenu and indentation support -;; for editing configure.in files. Only Autoconf syntax is processed. +;; for editing configure.ac files. Only Autoconf syntax is processed. ;; There is no attempt to deal with shell text -- probably that will ;; always lose. -;; This is specialized for configure.in files. It doesn't inherit the +;; This is specialized for configure.ac files. It doesn't inherit the ;; general M4 stuff from M4 mode. ;; There is also an autoconf-mode.el in existence. That appears to be -;; for editing the Autoconf M4 source, rather than configure.in files. +;; for editing the Autoconf M4 source, rather than configure.ac files. ;;; Code: @@ -49,7 +49,7 @@ `(("\\_ syslog_opt_flags (match-string-no-properties 1)) + ;; Objc selectors. + ((assq 'objc-method-intro (c-guess-basic-syntax)) + (let ((bound (save-excursion (c-end-of-statement) (point))) + (kw-re (concat "\\(?:" c-symbol-key "\\)?:")) + (stretches)) + (when (c-syntactic-re-search-forward c-symbol-key bound t t t) + (push (match-string-no-properties 0) stretches) + (while (c-syntactic-re-search-forward kw-re bound t t t) + (push (match-string-no-properties 0) stretches))) + (apply 'concat (nreverse stretches)))) + (t ;; Normal function or initializer. (when (c-syntactic-re-search-forward "[{(]" nil t) diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 5d758b53b56..8bccb44f308 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -1818,9 +1818,7 @@ system." (t ;; Being evaluated interactively. (buffer-file-name))))) - (and file - (file-name-sans-extension - (file-name-nondirectory file))))) + (and file (file-name-base file)))) (defmacro c-lang-defconst-eval-immediately (form) "Can be used inside a VAL in `c-lang-defconst' to evaluate FORM diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 82aee7bdbb9..142ec4cdd66 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -1688,6 +1688,7 @@ comment at the start of cc-engine.el for more info." ;; high as possible. (setq rung-pos (point))) + (with-silent-modifications (while (progn (while @@ -1843,7 +1844,7 @@ comment at the start of cc-engine.el for more info." (1- last-put-in-sws-pos)) (c-remove-is-and-in-sws (1- last-put-in-sws-pos) last-put-in-sws-pos)))) - ))) + )))) (defun c-backward-sws () ;; Used by `c-backward-syntactic-ws' to implement the unbounded search. @@ -1881,6 +1882,7 @@ comment at the start of cc-engine.el for more info." (goto-char (setq rung-pos rung-is-marked)) (goto-char simple-ws-beg)) + (with-silent-modifications (while (progn (while @@ -2066,7 +2068,7 @@ comment at the start of cc-engine.el for more info." last-put-in-sws-pos) (c-remove-is-and-in-sws last-put-in-sws-pos (1+ last-put-in-sws-pos))))) - ))) + )))) ;; Other whitespace tools diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 493f3db0961..78be8ac2cc4 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -578,7 +578,7 @@ keyword. It's unspecified how far it matches. Does not contain a \\| operator at the top level." t (concat "[" c-alpha "_]") java (concat "[" c-alpha "_@]") - objc (concat "[" c-alpha "@]") + objc (concat "[" c-alpha "_@]") pike (concat "[" c-alpha "_`]")) (c-lang-defvar c-symbol-start (c-lang-const c-symbol-start)) diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el index 0feefd99715..943b5c6a067 100644 --- a/lisp/progmodes/cmacexp.el +++ b/lisp/progmodes/cmacexp.el @@ -80,7 +80,7 @@ ;; making comments visible in the expansion. ;; - All work is done in core memory, no need for temporary files. -;; ACKNOWLEDGEMENTS ================================================== +;; ACKNOWLEDGMENTS =================================================== ;; A lot of thanks to Don Maszle who did a great work of testing, bug ;; reporting and suggestion of new features. This work has been diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 61dc371c087..c008e1c4da3 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -30,7 +30,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'tool-bar) (require 'comint) @@ -791,7 +791,7 @@ info, are considered errors." 3))) (setq compilation-skip-threshold level) (message "Skipping %s" - (case compilation-skip-threshold + (pcase compilation-skip-threshold (0 "Nothing") (1 "Info messages") (2 "Warnings and info")))) @@ -826,7 +826,7 @@ from a different message." ;; modified using the same *compilation* buffer. this necessitates ;; re-parsing markers. -;; (defstruct (compilation--loc +;; (cl-defstruct (compilation--loc ;; (:constructor nil) ;; (:copier nil) ;; (:constructor compilation--make-loc @@ -875,7 +875,7 @@ from a different message." ;; These are the value of the `compilation-message' text-properties in the ;; compilation buffer. -(defstruct (compilation--message +(cl-defstruct (compilation--message (:constructor nil) (:copier nil) ;; (:type list) ;Old representation. @@ -1212,7 +1212,7 @@ FMTS is a list of format specs for transforming the file name. (goto-char end) (unless (bolp) ;; We generally don't like to parse partial lines. - (assert (eobp)) + (cl-assert (eobp)) (when (let ((proc (get-buffer-process (current-buffer)))) (and proc (memq (process-status proc) '(run open)))) (setq end (line-beginning-position)))) @@ -2415,7 +2415,7 @@ region and the first line of the next region." (push fs compilation-gcpro) (let ((loc (compilation-assq (or line 1) (cdr fs)))) (setq loc (compilation-assq col loc)) - (assert (null (cdr loc))) + (cl-assert (null (cdr loc))) (setcdr loc (compilation--make-cdrloc line fs marker)) loc))) @@ -2685,8 +2685,8 @@ The file-structure looks like this: (defun compilation--flush-file-structure (file) (or (consp file) (setq file (list file))) (let ((fs (compilation-get-file-structure file))) - (assert (eq fs (gethash file compilation-locs))) - (assert (eq fs (gethash (cons (caar fs) (cadr (car fs))) + (cl-assert (eq fs (gethash file compilation-locs))) + (cl-assert (eq fs (gethash (cons (caar fs) (cadr (car fs))) compilation-locs))) (maphash (lambda (k v) (if (eq v fs) (remhash k compilation-locs))) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 9ea42db2a8c..d9b50ea3cc3 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -2322,8 +2322,7 @@ to nil." nil t)))) ; Only one (progn (forward-word 1) - (setq name (file-name-sans-extension - (file-name-nondirectory (buffer-file-name))) + (setq name (file-name-base) p (point)) (insert " NAME\n\n" name " - \n\n=head1 SYNOPSIS\n\n\n\n" @@ -3498,7 +3497,8 @@ Works before syntax recognition is done." (if end ;; Do the same for end, going small steps (save-excursion - (while (and end (get-text-property end 'syntax-type)) + (while (and end (< end (point-max)) + (get-text-property end 'syntax-type)) (setq pos end end (next-single-property-change end 'syntax-type nil (point-max))) (if end (progn (goto-char end) @@ -8951,14 +8951,15 @@ do extra unwind via `cperl-unwind-to-safe'." (setq cperl-syntax-done-to (min cperl-syntax-done-to beg)))) (defun cperl-update-syntaxification (from to) - (if (and cperl-use-syntax-table-text-property - cperl-syntaxify-by-font-lock - (or (null cperl-syntax-done-to) - (< cperl-syntax-done-to to))) - (progn - (save-excursion - (goto-char from) - (cperl-fontify-syntaxically to))))) + (cond + ((not cperl-use-syntax-table-text-property) nil) + ((fboundp 'syntax-propertize) (syntax-propertize to)) + ((and cperl-syntaxify-by-font-lock + (or (null cperl-syntax-done-to) + (< cperl-syntax-done-to to))) + (save-excursion + (goto-char from) + (cperl-fontify-syntaxically to))))) (defvar cperl-version (let ((v "Revision: 6.2")) diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el index 09c7e908806..9ea71ad36f5 100644 --- a/lisp/progmodes/cwarn.el +++ b/lisp/progmodes/cwarn.el @@ -105,8 +105,6 @@ ;;{{{ Dependencies -(eval-when-compile (require 'cl)) - (require 'custom) (require 'font-lock) (require 'cc-mode) diff --git a/lisp/progmodes/ebnf-yac.el b/lisp/progmodes/ebnf-yac.el index 56c8dc57e96..8e0ca260928 100644 --- a/lisp/progmodes/ebnf-yac.el +++ b/lisp/progmodes/ebnf-yac.el @@ -73,8 +73,8 @@ ;; example: this_is_a_valid.name, Another_EXAMPLE, mIxEd.CaSe. ;; ;; -;; Acknowledgements -;; ---------------- +;; Acknowledgments +;; --------------- ;; ;; Thanks to Matthew K. Junker for the suggestion to deal ;; with %right, %left and %prec pragmas. His suggestion was extended to deal diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el index b7cbdcc7018..cdbaf4708a7 100644 --- a/lisp/progmodes/ebnf2ps.el +++ b/lisp/progmodes/ebnf2ps.el @@ -1128,8 +1128,8 @@ Please send all bug fixes and enhancements to ;; . Optimizations... ;; ;; -;; Acknowledgements -;; ---------------- +;; Acknowledgments +;; --------------- ;; ;; Thanks to Eli Zaretskii for some doc fixes. ;; diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index 5c2ba080d31..1d29011762e 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -38,7 +38,7 @@ (require 'ebuff-menu) (eval-when-compile - (require 'cl) + (require 'cl-lib) (require 'helper)) @@ -249,6 +249,7 @@ This is a destructive operation." (defmacro ebrowse-output (&rest body) "Eval BODY with a writable current buffer. Preserve buffer's modified state." + (declare (indent 0) (debug t)) (let ((modified (make-symbol "--ebrowse-output--"))) `(let (buffer-read-only (,modified (buffer-modified-p))) (unwind-protect @@ -258,35 +259,30 @@ Preserve buffer's modified state." (defmacro ebrowse-ignoring-completion-case (&rest body) "Eval BODY with `completion-ignore-case' bound to t." + (declare (indent 0) (debug t)) `(let ((completion-ignore-case t)) ,@body)) - (defmacro ebrowse-save-selective (&rest body) "Eval BODY with `selective-display' restored at the end." - (let ((var (make-symbol "var"))) - `(let ((,var selective-display)) - (unwind-protect - (progn ,@body) - (setq selective-display ,var))))) - + (declare (indent 0) (debug t)) + ;; FIXME: Don't use selective-display. + `(let ((selective-display selective-display)) + ,@body)) (defmacro ebrowse-for-all-trees (spec &rest body) "For all trees in SPEC, eval BODY." + (declare (indent 1) (debug ((sexp form) body))) (let ((var (make-symbol "var")) (spec-var (car spec)) (array (cadr spec))) - `(loop for ,var being the symbols of ,array - as ,spec-var = (get ,var 'ebrowse-root) do - (when (vectorp ,spec-var) - ,@body)))) + `(cl-loop for ,var being the symbols of ,array + as ,spec-var = (get ,var 'ebrowse-root) do + (when (vectorp ,spec-var) + ,@body)))) ;;; Set indentation for macros above. -(put 'ebrowse-output 'lisp-indent-hook 0) -(put 'ebrowse-ignoring-completion-case 'lisp-indent-hook 0) -(put 'ebrowse-save-selective 'lisp-indent-hook 0) -(put 'ebrowse-for-all-trees 'lisp-indent-hook 1) (defsubst ebrowse-set-face (start end face) @@ -307,17 +303,6 @@ is STRING, but point is placed POSITION characters into the string." (ebrowse-ignoring-completion-case (completing-read prompt table nil t initial-input))) - -(defun ebrowse-value-in-buffer (sym buffer) - "Return the value of SYM in BUFFER." - (let ((old-buffer (current-buffer))) - (unwind-protect - (progn - (set-buffer buffer) - (symbol-value sym)) - (set-buffer old-buffer)))) - - (defun ebrowse-rename-buffer (new-name) "Rename current buffer to NEW-NAME. If a buffer with name NEW-NAME already exists, delete it first." @@ -333,9 +318,9 @@ If a buffer with name NEW-NAME already exists, delete it first." Replace sequences of newlines with a single space." (when (string-match "^[ \t\n\r]+" string) (setq string (substring string (match-end 0)))) - (loop while (string-match "[\n]+" string) - finally return string do - (setq string (replace-match " " nil t string)))) + (cl-loop while (string-match "[\n]+" string) + finally return string do + (setq string (replace-match " " nil t string)))) (defun ebrowse-width-of-drawable-area () @@ -350,7 +335,7 @@ otherwise use the current frame's width." ;;; Structure definitions -(defstruct (ebrowse-hs (:type vector) :named) +(cl-defstruct (ebrowse-hs (:type vector) :named) "Header structure found at the head of BROWSE files." ;; A version string that is compared against the version number of ;; the Lisp package when the file is loaded. This is done to @@ -367,7 +352,7 @@ otherwise use the current frame's width." member-table) -(defstruct (ebrowse-ts (:type vector) :named) +(cl-defstruct (ebrowse-ts (:type vector) :named) "Tree structure. Following the header structure, a BROWSE file contains a number of `ebrowse-ts' structures, each one describing one root class of @@ -387,7 +372,7 @@ the class hierarchy with all its subclasses." mark) -(defstruct (ebrowse-bs (:type vector) :named) +(cl-defstruct (ebrowse-bs (:type vector) :named) "Common sub-structure. A common structure defining an occurrence of some name in the source files." @@ -414,14 +399,14 @@ source files." point) -(defstruct (ebrowse-cs (:include ebrowse-bs) (:type vector) :named) +(cl-defstruct (ebrowse-cs (:include ebrowse-bs) (:type vector) :named) "Class structure. This is the structure stored in the CLASS slot of a `ebrowse-ts' structure. It describes the location of the class declaration." source-file) -(defstruct (ebrowse-ms (:include ebrowse-bs) (:type vector) :named) +(cl-defstruct (ebrowse-ms (:include ebrowse-bs) (:type vector) :named) "Member structure. This is the structure describing a single member. The `ebrowse-ts' structure contains various lists for the different types of @@ -691,7 +676,7 @@ MARKED-ONLY non-nil means include marked classes only." (ebrowse-for-all-trees (tree ebrowse--tree-obarray) (when (or (not marked-only) (ebrowse-ts-mark tree)) (let ((class (ebrowse-ts-class tree))) - (when (zerop (% (incf i) 20)) + (when (zerop (% (cl-incf i) 20)) (ebrowse-show-progress "Preparing file list" (zerop i))) ;; Add files mentioned in class description (let ((source-file (ebrowse-cs-source-file class)) @@ -701,14 +686,14 @@ MARKED-ONLY non-nil means include marked classes only." (when file (puthash file file files)) ;; For all member lists in this class - (loop for accessor in ebrowse-member-list-accessors do - (loop for m in (funcall accessor tree) - for file = (ebrowse-ms-file m) - for def-file = (ebrowse-ms-definition-file m) do - (when file - (puthash file file files)) - (when def-file - (puthash def-file def-file files)))))))) + (dolist (accessor ebrowse-member-list-accessors) + (cl-loop for m in (funcall accessor tree) + for file = (ebrowse-ms-file m) + for def-file = (ebrowse-ms-definition-file m) do + (when file + (puthash file file files)) + (when def-file + (puthash def-file def-file files)))))))) files)) @@ -721,11 +706,11 @@ MARKED-ONLY non-nil means include marked classes only." list)) -(defun* ebrowse-marked-classes-p () +(cl-defun ebrowse-marked-classes-p () "Value is non-nil if any class in the current class tree is marked." (ebrowse-for-all-trees (tree ebrowse--tree-obarray) (when (ebrowse-ts-mark tree) - (return-from ebrowse-marked-classes-p tree)))) + (cl-return-from ebrowse-marked-classes-p tree)))) (defsubst ebrowse-globals-tree-p (tree) @@ -752,12 +737,13 @@ The class tree is found in the buffer-local variable `ebrowse--tree-obarray'." (if qualified-names-p (ebrowse-for-all-trees (tree ebrowse--tree-obarray) (setq alist - (acons (ebrowse-qualified-class-name (ebrowse-ts-class tree)) - tree alist))) + (cl-acons (ebrowse-qualified-class-name + (ebrowse-ts-class tree)) + tree alist))) (ebrowse-for-all-trees (tree ebrowse--tree-obarray) (setq alist - (acons (ebrowse-cs-name (ebrowse-ts-class tree)) - tree alist)))) + (cl-acons (ebrowse-cs-name (ebrowse-ts-class tree)) + tree alist)))) alist)) @@ -792,15 +778,15 @@ This function must be used instead of the struct slot computes this information lazily." (or (ebrowse-ts-base-classes tree) (setf (ebrowse-ts-base-classes tree) - (loop with to-search = (list tree) - with result = nil - as search = (pop to-search) - while search finally return result - do (ebrowse-for-all-trees (ti ebrowse--tree-obarray) - (when (memq search (ebrowse-ts-subclasses ti)) - (unless (memq ti result) - (setq result (nconc result (list ti)))) - (push ti to-search))))))) + (cl-loop with to-search = (list tree) + with result = nil + as search = (pop to-search) + while search finally return result + do (ebrowse-for-all-trees (ti ebrowse--tree-obarray) + (when (memq search (ebrowse-ts-subclasses ti)) + (unless (memq ti result) + (setq result (nconc result (list ti)))) + (push ti to-search))))))) (defun ebrowse-direct-base-classes (tree) @@ -820,8 +806,8 @@ computes this information lazily." ACCESSOR is the accessor function for the member list. Elements of the result have the form (NAME . ACCESSOR), where NAME is the member name." - (loop for member in (funcall accessor tree) - collect (cons (ebrowse-ms-name member) accessor))) + (cl-loop for member in (funcall accessor tree) + collect (cons (ebrowse-ms-name member) accessor))) (defun ebrowse-name/accessor-alist-for-visible-members () @@ -834,10 +820,10 @@ structure. The list includes inherited members if these are visible." ebrowse--accessor))) (if ebrowse--show-inherited-flag (nconc list - (loop for tree in (ebrowse-base-classes - ebrowse--displayed-class) - nconc (ebrowse-name/accessor-alist - tree ebrowse--accessor))) + (cl-loop for tree in (ebrowse-base-classes + ebrowse--displayed-class) + nconc (ebrowse-name/accessor-alist + tree ebrowse--accessor))) list))) @@ -908,8 +894,7 @@ and TREE is a list of `ebrowse-ts' structures forming the class tree." See that variable's documentation for the meaning of IGNORE-AUTO-SAVE and NOCONFIRM." (when (or noconfirm (yes-or-no-p "Revert tree from disk? ")) - (loop for member-buffer in (ebrowse-same-tree-member-buffer-list) - do (kill-buffer member-buffer)) + (mapc #'kill-buffer (ebrowse-same-tree-member-buffer-list)) (erase-buffer) (with-no-warnings (insert-file (or buffer-file-name ebrowse--tags-file-name))) @@ -934,9 +919,9 @@ Return the buffer created." ebrowse--frozen-flag nil) (ebrowse-redraw-tree) (set-buffer-modified-p nil) - (case pop - (switch (switch-to-buffer name)) - (pop (pop-to-buffer name))) + (pcase pop + (`switch (switch-to-buffer name)) + (`pop (pop-to-buffer name))) (current-buffer))) @@ -962,14 +947,14 @@ type `ebrowse-hs' is set to the resulting obarray." (garbage-collect) ;; For all classes... (ebrowse-for-all-trees (c ebrowse--tree-obarray) - (when (zerop (% (incf i) 10)) + (when (zerop (% (cl-incf i) 10)) (ebrowse-show-progress "Preparing member lookup" (zerop i))) - (loop for f in ebrowse-member-list-accessors do - (loop for m in (funcall f c) do - (let* ((member-name (ebrowse-ms-name m)) - (value (gethash member-name members))) - (push (list c f m) value) - (puthash member-name value members))))) + (dolist (f ebrowse-member-list-accessors) + (dolist (m (funcall f c)) + (let* ((member-name (ebrowse-ms-name m)) + (value (gethash member-name members))) + (push (list c f m) value) + (puthash member-name value members))))) (setf (ebrowse-hs-member-table ebrowse--header) members))) @@ -977,11 +962,11 @@ type `ebrowse-hs' is set to the resulting obarray." "Return the member obarray. Build it if it hasn't been set up yet. HEADER is the tree header structure of the class tree." (when (null (ebrowse-hs-member-table header)) - (loop for buffer in (ebrowse-browser-buffer-list) - until (eq header (ebrowse-value-in-buffer 'ebrowse--header buffer)) - finally do - (with-current-buffer buffer - (ebrowse-fill-member-table)))) + (cl-loop for buffer in (ebrowse-browser-buffer-list) + until (eq header (buffer-local-value 'ebrowse--header buffer)) + finally do + (with-current-buffer buffer + (ebrowse-fill-member-table)))) (ebrowse-hs-member-table header)) @@ -993,11 +978,12 @@ HEADER is the tree header structure of the class tree." Build obarray of all classes in TREE." (let ((classes (make-vector 127 0))) ;; Add root classes... - (loop for root in tree - as sym = - (intern (ebrowse-qualified-class-name (ebrowse-ts-class root)) classes) - do (unless (get sym 'ebrowse-root) - (setf (get sym 'ebrowse-root) root))) + (cl-loop for root in tree + as sym = + (intern (ebrowse-qualified-class-name (ebrowse-ts-class root)) + classes) + do (unless (get sym 'ebrowse-root) + (setf (get sym 'ebrowse-root) root))) ;; Process subclasses (ebrowse-insert-supers tree classes) classes)) @@ -1015,29 +1001,30 @@ beginning of the base-class list. We have to be cautious here not to end up in an infinite recursion if for some reason a circle is in the inheritance graph." - (loop for class in tree - as subclasses = (ebrowse-ts-subclasses class) do - ;; Make sure every class is represented by a unique object - (loop for subclass on subclasses - as sym = (intern - (ebrowse-qualified-class-name (ebrowse-ts-class (car subclass))) - classes) - as next = nil - do - ;; Replace the subclass tree with the one found in - ;; CLASSES if there is already an entry for that class - ;; in it. Otherwise make a new entry. - ;; - ;; CAVEAT: If by some means (e.g., use of the - ;; preprocessor in class declarations, a name is marked - ;; as a subclass of itself on some path, we would end up - ;; in an endless loop. We have to omit subclasses from - ;; the recursion that already have been processed. - (if (get sym 'ebrowse-root) - (setf (car subclass) (get sym 'ebrowse-root)) - (setf (get sym 'ebrowse-root) (car subclass)))) - ;; Process subclasses - (ebrowse-insert-supers subclasses classes))) + (cl-loop for class in tree + as subclasses = (ebrowse-ts-subclasses class) do + ;; Make sure every class is represented by a unique object + (cl-loop for subclass on subclasses + as sym = (intern + (ebrowse-qualified-class-name + (ebrowse-ts-class (car subclass))) + classes) + as next = nil + do + ;; Replace the subclass tree with the one found in + ;; CLASSES if there is already an entry for that class + ;; in it. Otherwise make a new entry. + ;; + ;; CAVEAT: If by some means (e.g., use of the + ;; preprocessor in class declarations, a name is marked + ;; as a subclass of itself on some path, we would end up + ;; in an endless loop. We have to omit subclasses from + ;; the recursion that already have been processed. + (if (get sym 'ebrowse-root) + (setf (car subclass) (get sym 'ebrowse-root)) + (setf (get sym 'ebrowse-root) (car subclass)))) + ;; Process subclasses + (ebrowse-insert-supers subclasses classes))) ;;; Tree buffers @@ -1111,7 +1098,7 @@ Tree mode key bindings: (unless (zerop (buffer-size)) (goto-char (point-min)) - (multiple-value-setq (header tree) (values-list (ebrowse-read))) + (cl-multiple-value-setq (header tree) (cl-values-list (ebrowse-read))) (message "Sorting. Please be patient...") (setq tree (ebrowse-sort-tree-list tree)) (erase-buffer) @@ -1199,32 +1186,32 @@ If given a numeric N-TIMES argument, mark that many classes." ;; Get the classes whose mark must be toggled. Note that ;; ebrowse-tree-at-point might issue an error. (ignore-errors - (loop repeat (or n-times 1) - as tree = (ebrowse-tree-at-point) - do (progn - (setf (ebrowse-ts-mark tree) (not (ebrowse-ts-mark tree))) - (forward-line 1) - (push tree to-change)))) + (cl-loop repeat (or n-times 1) + as tree = (ebrowse-tree-at-point) + do (progn + (setf (ebrowse-ts-mark tree) (not (ebrowse-ts-mark tree))) + (forward-line 1) + (push tree to-change)))) (save-excursion ;; For all these classes, reverse the mark char in the display ;; by a regexp replace over the whole buffer. The reason for this ;; is that classes might have multiple base classes. If this is ;; the case, they are displayed more than once in the tree. (ebrowse-output - (loop for tree in to-change - as regexp = (concat "^.*\\b" - (regexp-quote - (ebrowse-cs-name (ebrowse-ts-class tree))) - "\\b") - do - (goto-char (point-min)) - (loop while (re-search-forward regexp nil t) - do (progn - (goto-char (match-beginning 0)) - (delete-char 1) - (insert-char (if (ebrowse-ts-mark tree) ?> ? ) 1) - (ebrowse-set-mark-props (1- (point)) (point) tree) - (goto-char (match-end 0))))))))) + (cl-loop + for tree in to-change + as regexp = (concat "^.*\\b" + (regexp-quote + (ebrowse-cs-name (ebrowse-ts-class tree))) + "\\b") + do + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (goto-char (match-beginning 0)) + (delete-char 1) + (insert-char (if (ebrowse-ts-mark tree) ?> ? ) 1) + (ebrowse-set-mark-props (1- (point)) (point) tree) + (goto-char (match-end 0)))))))) (defun ebrowse-mark-all-classes (prefix) @@ -1345,7 +1332,7 @@ one buffer. Prefer tree buffers over member buffers." (set (make-hash-table)) result) (dolist (buffer buffers) - (let ((tree (ebrowse-value-in-buffer 'ebrowse--tree buffer))) + (let ((tree (buffer-local-value 'ebrowse--tree buffer))) (unless (gethash tree set) (push buffer result)) (puthash tree t set))) @@ -1356,7 +1343,7 @@ one buffer. Prefer tree buffers over member buffers." "Return a list of members buffers with same tree as current buffer." (ebrowse-delete-if-not (lambda (buffer) - (eq (ebrowse-value-in-buffer 'ebrowse--tree buffer) + (eq (buffer-local-value 'ebrowse--tree buffer) ebrowse--tree)) (ebrowse-member-buffer-list))) @@ -1367,7 +1354,7 @@ one buffer. Prefer tree buffers over member buffers." Switch to buffer if prefix ARG. If no member buffer exists, make one." (interactive "P") - (let ((buf (or (first (ebrowse-same-tree-member-buffer-list)) + (let ((buf (or (cl-first (ebrowse-same-tree-member-buffer-list)) (get-buffer ebrowse-member-buffer-name) (ebrowse-tree-command:show-member-functions)))) (when buf @@ -1391,9 +1378,9 @@ If no member buffer exists, make one." (defun ebrowse-kill-member-buffers-displaying (tree) "Kill all member buffers displaying TREE." - (loop for buffer in (ebrowse-member-buffer-list) - as class = (ebrowse-value-in-buffer 'ebrowse--displayed-class buffer) - when (eq class tree) do (kill-buffer buffer))) + (cl-loop for buffer in (ebrowse-member-buffer-list) + as class = (buffer-local-value 'ebrowse--displayed-class buffer) + when (eq class tree) do (kill-buffer buffer))) (defun ebrowse-frozen-tree-buffer-name (tags-file) @@ -1429,7 +1416,7 @@ Pop to member buffer if no prefix ARG, to tree buffer otherwise." (int-to-string ebrowse--indentation) "): ") nil nil ebrowse--indentation)))) - (when (plusp width) + (when (cl-plusp width) (set (make-local-variable 'ebrowse--indentation) width) (ebrowse-redraw-tree)))) @@ -1504,7 +1491,7 @@ Read a class name from the minibuffer if CLASS is nil." (error "Not on a class"))) -(defun* ebrowse-view/find-class-declaration (&key view where) +(cl-defun ebrowse-view/find-class-declaration (&key view where) "View or find the declarator of the class point is on. VIEW non-nil means view it. WHERE is additional position info." (let* ((class (ebrowse-ts-class (ebrowse-tree-at-point))) @@ -1583,9 +1570,9 @@ and possibly kill the viewed buffer." exit-action ebrowse--view-exit-action)) ;; Delete the frame in which we viewed. (mapc 'delete-frame - (loop for frame in (frame-list) - when (not (assq frame original-frame-configuration)) - collect frame)) + (cl-loop for frame in (frame-list) + when (not (assq frame original-frame-configuration)) + collect frame)) (when exit-action (funcall exit-action buffer)))) @@ -1639,15 +1626,15 @@ specifies where to find/view the result." (unless (boundp 'view-mode-hook) (setq view-mode-hook nil)) (push 'ebrowse-find-pattern view-mode-hook) - (case where - (other-window (view-file-other-window file)) - (other-frame (ebrowse-view-file-other-frame file)) - (t (view-file file)))) + (pcase where + (`other-window (view-file-other-window file)) + (`other-frame (ebrowse-view-file-other-frame file)) + (_ (view-file file)))) (t - (case where - (other-window (find-file-other-window file)) - (other-frame (find-file-other-frame file)) - (t (find-file file))) + (pcase where + (`other-window (find-file-other-window file)) + (`other-frame (find-file-other-frame file)) + (_ (find-file file))) (ebrowse-find-pattern struc info)))) @@ -1657,14 +1644,14 @@ This is `regexp-quote' for most symbols, except for operator names which may contain whitespace. For these symbols, replace white space in the symbol name (generated by BROWSE) with a regular expression matching any number of whitespace characters." - (loop with regexp = (regexp-quote name) - with start = 0 - finally return regexp - while (string-match "[ \t]+" regexp start) - do (setq regexp (concat (substring regexp 0 (match-beginning 0)) - "[ \t]*" - (substring regexp (match-end 0))) - start (+ (match-beginning 0) 5)))) + (cl-loop with regexp = (regexp-quote name) + with start = 0 + finally return regexp + while (string-match "[ \t]+" regexp start) + do (setq regexp (concat (substring regexp 0 (match-beginning 0)) + "[ \t]*" + (substring regexp (match-end 0))) + start (+ (match-beginning 0) 5)))) (defun ebrowse-class-declaration-regexp (name) @@ -1692,7 +1679,7 @@ expression matching any number of whitespace characters." (concat "^[ \t]*#[ \t]*define[ \t]+" (regexp-quote name))) -(defun* ebrowse-find-pattern (&optional position info &aux viewing) +(cl-defun ebrowse-find-pattern (&optional position info &aux viewing) "Find a pattern. This is a kluge: Ebrowse allows you to find or view a file containing @@ -1711,25 +1698,26 @@ INFO is a list (TREE-HEADER TREE-OR-MEMBER MEMBER-LIST)." (start (ebrowse-bs-point position)) (offset 100) found) - (destructuring-bind (header class-or-member member-list) info + (pcase-let ((`(,header ,class-or-member ,member-list) info)) ;; If no pattern is specified, construct one from the member name. (when (stringp pattern) (setq pattern (concat "^.*" (regexp-quote pattern)))) ;; Construct a regular expression if none given. (unless pattern - (typecase class-or-member + (cl-typecase class-or-member (ebrowse-ms - (case member-list - ((ebrowse-ts-member-variables - ebrowse-ts-static-variables - ebrowse-ts-types) - (setf pattern (ebrowse-variable-declaration-regexp - (ebrowse-bs-name position)))) - (otherwise - (if (ebrowse-define-p class-or-member) - (setf pattern (ebrowse-pp-define-regexp (ebrowse-bs-name position))) - (setf pattern (ebrowse-function-declaration/definition-regexp - (ebrowse-bs-name position))))))) + (setf pattern + (pcase member-list + ((or `ebrowse-ts-member-variables + `ebrowse-ts-static-variables + `ebrowse-ts-types) + (ebrowse-variable-declaration-regexp + (ebrowse-bs-name position))) + (_ + (if (ebrowse-define-p class-or-member) + (ebrowse-pp-define-regexp (ebrowse-bs-name position)) + (ebrowse-function-declaration/definition-regexp + (ebrowse-bs-name position))))))) (ebrowse-cs (setf pattern (ebrowse-class-declaration-regexp (ebrowse-bs-name position)))))) @@ -1743,10 +1731,11 @@ INFO is a list (TREE-HEADER TREE-OR-MEMBER MEMBER-LIST)." (y-or-n-p (format "start = %d? " start)) (y-or-n-p pattern)) (setf found - (loop do (goto-char (max (point-min) (- start offset))) - when (re-search-forward pattern (+ start offset) t) return t - never (bobp) - do (incf offset offset))) + (cl-loop do (goto-char (max (point-min) (- start offset))) + when (re-search-forward pattern (+ start offset) t) + return t + never (bobp) + do (cl-incf offset offset))) (cond (found (beginning-of-line) (run-hooks 'ebrowse-view/find-hook)) @@ -1790,57 +1779,57 @@ TREE denotes the class shown." (ebrowse-set-face start end 'ebrowse-tree-mark)) -(defun* ebrowse-draw-tree-fn (&aux stack1 stack2 start) +(cl-defun ebrowse-draw-tree-fn (&aux stack1 stack2 start) "Display a single class and recursively its subclasses. This function may look weird, but this is faster than recursion." (setq stack1 (make-list (length ebrowse--tree) 0) stack2 (copy-sequence ebrowse--tree)) - (loop while stack2 - as level = (pop stack1) - as tree = (pop stack2) - as class = (ebrowse-ts-class tree) do - (let ((start-of-line (point)) - start-of-class-name end-of-class-name) - ;; Insert mark - (insert (if (ebrowse-ts-mark tree) ">" " ")) + (cl-loop while stack2 + as level = (pop stack1) + as tree = (pop stack2) + as class = (ebrowse-ts-class tree) do + (let ((start-of-line (point)) + start-of-class-name end-of-class-name) + ;; Insert mark + (insert (if (ebrowse-ts-mark tree) ">" " ")) - ;; Indent and insert class name - (indent-to (+ (* level ebrowse--indentation) - ebrowse-tree-left-margin)) - (setq start (point)) - (insert (ebrowse-qualified-class-name class)) + ;; Indent and insert class name + (indent-to (+ (* level ebrowse--indentation) + ebrowse-tree-left-margin)) + (setq start (point)) + (insert (ebrowse-qualified-class-name class)) - ;; If template class, add <> - (when (ebrowse-template-p class) - (insert "<>")) - (ebrowse-set-face start (point) (if (zerop level) - 'ebrowse-root-class - 'ebrowse-default)) - (setf start-of-class-name start - end-of-class-name (point)) - ;; If filenames are to be displayed... - (when ebrowse--show-file-names-flag - (indent-to ebrowse-source-file-column) - (setq start (point)) - (insert "(" - (or (ebrowse-cs-file class) - "unknown") - ")") - (ebrowse-set-face start (point) 'ebrowse-file-name)) - (ebrowse-set-mark-props start-of-line (1+ start-of-line) tree) - (add-text-properties - start-of-class-name end-of-class-name - `(mouse-face highlight ebrowse-what class-name - ebrowse-tree ,tree - help-echo "double-mouse-1: (un)expand tree; mouse-2: member functions, mouse-3: menu")) - (insert "\n")) - ;; Push subclasses, if any. - (when (ebrowse-ts-subclasses tree) - (setq stack2 - (nconc (copy-sequence (ebrowse-ts-subclasses tree)) stack2) - stack1 - (nconc (make-list (length (ebrowse-ts-subclasses tree)) - (1+ level)) stack1))))) + ;; If template class, add <> + (when (ebrowse-template-p class) + (insert "<>")) + (ebrowse-set-face start (point) (if (zerop level) + 'ebrowse-root-class + 'ebrowse-default)) + (setf start-of-class-name start + end-of-class-name (point)) + ;; If filenames are to be displayed... + (when ebrowse--show-file-names-flag + (indent-to ebrowse-source-file-column) + (setq start (point)) + (insert "(" + (or (ebrowse-cs-file class) + "unknown") + ")") + (ebrowse-set-face start (point) 'ebrowse-file-name)) + (ebrowse-set-mark-props start-of-line (1+ start-of-line) tree) + (add-text-properties + start-of-class-name end-of-class-name + `(mouse-face highlight ebrowse-what class-name + ebrowse-tree ,tree + help-echo "double-mouse-1: (un)expand tree; mouse-2: member functions, mouse-3: menu")) + (insert "\n")) + ;; Push subclasses, if any. + (when (ebrowse-ts-subclasses tree) + (setq stack2 + (nconc (copy-sequence (ebrowse-ts-subclasses tree)) stack2) + stack1 + (nconc (make-list (length (ebrowse-ts-subclasses tree)) + (1+ level)) stack1))))) @@ -2096,8 +2085,8 @@ See 'Electric-command-loop' for a description of STATE and CONDITION." "Read a browser buffer name from the minibuffer and return that buffer." (let* ((buffers (ebrowse-known-class-trees-buffer-list))) (if buffers - (if (not (second buffers)) - (first buffers) + (if (not (cl-second buffers)) + (cl-first buffers) (or (ebrowse-electric-choose-tree) (error "No tree buffer"))) (let* ((insert-default-directory t) (file (read-file-name "Find tree: " nil nil t))) @@ -2283,7 +2272,7 @@ The new width is read from the minibuffer." ebrowse--decl-column ebrowse--column-width)) "): "))))) - (when (plusp width) + (when (cl-plusp width) (if ebrowse--long-display-flag (setq ebrowse--decl-column width) (setq ebrowse--column-width width)) @@ -2323,15 +2312,15 @@ make one." (let ((index (ebrowse-position ebrowse--accessor ebrowse-member-list-accessors))) (setf ebrowse--accessor - (cond ((plusp incr) + (cond ((cl-plusp incr) (or (nth (1+ index) ebrowse-member-list-accessors) - (first ebrowse-member-list-accessors))) - ((minusp incr) - (or (and (>= (decf index) 0) + (cl-first ebrowse-member-list-accessors))) + ((cl-minusp incr) + (or (and (>= (cl-decf index) 0) (nth index ebrowse-member-list-accessors)) - (first (last ebrowse-member-list-accessors)))))) + (cl-first (last ebrowse-member-list-accessors)))))) (ebrowse-display-member-list-for-accessor ebrowse--accessor))) @@ -2516,7 +2505,7 @@ find file in another frame." (ebrowse-view/find-member-declaration/definition prefix t)) -(defun* ebrowse-view/find-member-declaration/definition +(cl-defun ebrowse-view/find-member-declaration/definition (prefix view &optional definition info header tags-file) "Find or view a member declaration or definition. With PREFIX 4. find file in another window, with prefix 5 @@ -2536,15 +2525,15 @@ TAGS-FILE is the file name of the BROWSE file." ;; If not given as parameters, get the necessary information ;; out of the member buffer. (if info - (setq tree (first info) - accessor (second info) - member (third info)) - (multiple-value-setq (tree member on-class) - (values-list (ebrowse-member-info-from-point))) + (setq tree (cl-first info) + accessor (cl-second info) + member (cl-third info)) + (cl-multiple-value-setq (tree member on-class) + (cl-values-list (ebrowse-member-info-from-point))) (setq accessor ebrowse--accessor)) ;; View/find class if on a line containing a class name. (when on-class - (return-from ebrowse-view/find-member-declaration/definition + (cl-return-from ebrowse-view/find-member-declaration/definition (ebrowse-view/find-file-and-search-pattern (ebrowse-ts-class tree) (list ebrowse--header (ebrowse-ts-class tree) nil) @@ -2802,11 +2791,11 @@ TREE is the class tree in which the members are found." mouse-face highlight ebrowse-tree ,tree help-echo "mouse-2: view definition; mouse-3: menu")) - (incf i) + (cl-incf i) (when (>= i ebrowse--n-columns) (setf i 0) (insert "\n"))))) - (when (plusp i) + (when (cl-plusp i) (insert "\n")) (goto-char (point-min)))) @@ -2884,7 +2873,7 @@ REPEAT, if specified, says repeat the search REPEAT times." (error "Not found")))) -(defun* ebrowse-move-point-to-member (name &optional count &aux member) +(cl-defun ebrowse-move-point-to-member (name &optional count &aux member) "Set point on member NAME in the member buffer COUNT, if specified, says search the COUNT'th member with the same name." (goto-char (point-min)) @@ -2905,8 +2894,8 @@ COUNT, if specified, says search the COUNT'th member with the same name." "Switch member buffer to a class read from the minibuffer. Use TITLE as minibuffer prompt. COMPL-LIST is a completion list to use." - (let* ((initial (unless (second compl-list) - (first (first compl-list)))) + (let* ((initial (unless (cl-second compl-list) + (cl-first (cl-first compl-list)))) (class (or (ebrowse-completing-read-value title compl-list initial) (error "Not found")))) (setf ebrowse--displayed-class class @@ -2926,14 +2915,14 @@ COMPL-LIST is a completion list to use." (interactive "P") (let ((supers (or (ebrowse-direct-base-classes ebrowse--displayed-class) (error "No base classes")))) - (if (and arg (second supers)) - (let ((alist (loop for s in supers - collect (cons (ebrowse-qualified-class-name - (ebrowse-ts-class s)) - s)))) + (if (and arg (cl-second supers)) + (let ((alist (cl-loop for s in supers + collect (cons (ebrowse-qualified-class-name + (ebrowse-ts-class s)) + s)))) (ebrowse-switch-member-buffer-to-other-class "Goto base class: " alist)) - (setq ebrowse--displayed-class (first supers) + (setq ebrowse--displayed-class (cl-first supers) ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class)) (ebrowse-redisplay-member-buffer)))) @@ -2957,21 +2946,22 @@ Prefix arg INC specifies which one." (let ((containing-list ebrowse--tree) index cls (supers (ebrowse-direct-base-classes ebrowse--displayed-class))) - (flet ((trees-alist (trees) - (loop for tr in trees - collect (cons (ebrowse-cs-name - (ebrowse-ts-class tr)) tr)))) + (cl-flet ((trees-alist (trees) + (cl-loop for tr in trees + collect (cons (ebrowse-cs-name + (ebrowse-ts-class tr)) + tr)))) (when supers - (let ((tree (if (second supers) + (let ((tree (if (cl-second supers) (ebrowse-completing-read-value "Relative to base class: " (trees-alist supers) nil) - (first supers)))) + (cl-first supers)))) (unless tree (error "Not found")) (setq containing-list (ebrowse-ts-subclasses tree))))) (setq index (+ inc (ebrowse-position ebrowse--displayed-class containing-list))) - (cond ((minusp index) (message "No previous class")) + (cond ((cl-minusp index) (message "No previous class")) ((null (nth index containing-list)) (message "No next class"))) (setq index (max 0 (min index (1- (length containing-list))))) (setq cls (nth index containing-list)) @@ -2985,17 +2975,17 @@ Prefix arg INC specifies which one." Prefix arg ARG says which class should be displayed. Default is the first derived class." (interactive "P") - (flet ((ebrowse-tree-obarray-as-alist () - (loop for s in (ebrowse-ts-subclasses - ebrowse--displayed-class) - collect (cons (ebrowse-cs-name - (ebrowse-ts-class s)) s)))) + (cl-flet ((ebrowse-tree-obarray-as-alist () + (cl-loop for s in (ebrowse-ts-subclasses + ebrowse--displayed-class) + collect (cons (ebrowse-cs-name + (ebrowse-ts-class s)) s)))) (let ((subs (or (ebrowse-ts-subclasses ebrowse--displayed-class) (error "No derived classes")))) - (if (and arg (second subs)) + (if (and arg (cl-second subs)) (ebrowse-switch-member-buffer-to-other-class "Goto derived class: " (ebrowse-tree-obarray-as-alist)) - (setq ebrowse--displayed-class (first subs) + (setq ebrowse--displayed-class (cl-first subs) ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class)) (ebrowse-redisplay-member-buffer))))) @@ -3191,15 +3181,15 @@ the first derived class." EVENT is the mouse event." (interactive "e") (mouse-set-point event) - (case (event-click-count event) + (pcase (event-click-count event) (2 (ebrowse-find-member-definition)) - (1 (case (get-text-property (posn-point (event-start event)) - 'ebrowse-what) - (member-name + (1 (pcase (get-text-property (posn-point (event-start event)) + 'ebrowse-what) + (`member-name (ebrowse-popup-menu ebrowse-member-name-object-menu event)) - (class-name + (`class-name (ebrowse-popup-menu ebrowse-member-class-name-object-menu event)) - (t + (_ (ebrowse-popup-menu ebrowse-member-buffer-object-menu event)))))) @@ -3208,11 +3198,11 @@ EVENT is the mouse event." EVENT is the mouse event." (interactive "e") (mouse-set-point event) - (case (event-click-count event) + (pcase (event-click-count event) (2 (ebrowse-find-member-definition)) - (1 (case (get-text-property (posn-point (event-start event)) + (1 (pcase (get-text-property (posn-point (event-start event)) 'ebrowse-what) - (member-name + (`member-name (ebrowse-view-member-definition 0)))))) @@ -3233,11 +3223,11 @@ member was found. The CDR of the acons is described in function alist) (when name (dolist (info (gethash name table) alist) - (unless (memq (first info) known-classes) - (setf alist (acons (ebrowse-qualified-class-name - (ebrowse-ts-class (first info))) - info alist) - known-classes (cons (first info) known-classes))))))) + (unless (memq (cl-first info) known-classes) + (setf alist (cl-acons (ebrowse-qualified-class-name + (ebrowse-ts-class (cl-first info))) + info alist) + known-classes (cons (cl-first info) known-classes))))))) (defun ebrowse-choose-tree () @@ -3247,8 +3237,8 @@ the one he wants. Value is (TREE HEADER BUFFER), with TREE being the class tree, HEADER the header structure of the tree, and BUFFER being the tree or member buffer containing the tree." (let* ((buffer (ebrowse-choose-from-browser-buffers))) - (if buffer (list (ebrowse-value-in-buffer 'ebrowse--tree buffer) - (ebrowse-value-in-buffer 'ebrowse--header buffer) + (if buffer (list (buffer-local-value 'ebrowse--tree buffer) + (buffer-local-value 'ebrowse--header buffer) buffer)))) @@ -3259,8 +3249,8 @@ Prompt with PROMPT. Insert into the minibuffer a C++ identifier read from point as default. Value is a list (CLASS-NAME MEMBER-NAME)." (save-excursion (let ((members (ebrowse-member-table header))) - (multiple-value-bind (class-name member-name) - (values-list (ebrowse-tags-read-member+class-name)) + (cl-multiple-value-bind (class-name member-name) + (cl-values-list (ebrowse-tags-read-member+class-name)) (unless member-name (error "No member name at point")) (if members @@ -3272,7 +3262,7 @@ from point as default. Value is a list (CLASS-NAME MEMBER-NAME)." (unless (gethash name members) (if (y-or-n-p "No exact match found. Try substrings? ") (setq name - (or (first (ebrowse-list-of-matching-members + (or (cl-first (ebrowse-list-of-matching-members members (regexp-quote name) name)) (error "Sorry, nothing found"))) (error "Canceled"))) @@ -3305,15 +3295,15 @@ Value is a list (TREE ACCESSOR MEMBER) for the member." (let ((alist (or (ebrowse-class-alist-for-member header name) (error "No classes with member `%s' found" name)))) (ebrowse-ignoring-completion-case - (if (null (second alist)) - (cdr (first alist)) + (if (null (cl-second alist)) + (cdr (cl-first alist)) (push ?\? unread-command-events) (cdr (assoc (completing-read "In class: " alist nil t initial-class-name) alist)))))) -(defun* ebrowse-tags-view/find-member-decl/defn +(cl-defun ebrowse-tags-view/find-member-decl/defn (prefix &key view definition member-name) "If VIEW is t, view, else find an occurrence of MEMBER-NAME. @@ -3324,16 +3314,16 @@ of all classes containing a member with the given name and lets the user choose the class to use. As a last step, a tags search is performed that positions point on the member declaration or definition." - (multiple-value-bind - (tree header tree-buffer) (values-list (ebrowse-choose-tree)) + (cl-multiple-value-bind + (tree header tree-buffer) (cl-values-list (ebrowse-choose-tree)) (unless tree (error "No class tree")) (let* ((marker (point-marker)) class-name (name member-name) info) (unless name - (multiple-value-setq (class-name name) - (values-list + (cl-multiple-value-setq (class-name name) + (cl-values-list (ebrowse-tags-read-name header (concat (if view "View" "Find") " member " @@ -3344,7 +3334,7 @@ definition." (ebrowse-view/find-member-declaration/definition prefix view definition info header - (ebrowse-value-in-buffer 'ebrowse--tags-file-name tree-buffer)) + (buffer-local-value 'ebrowse--tags-file-name tree-buffer)) ;; Record position jumped to (ebrowse-push-position (point-marker) info t)))) @@ -3439,14 +3429,14 @@ It is a list (TREE ACCESSOR MEMBER)." (cond ((null buffer) (set-buffer tree-buffer) (switch-to-buffer (ebrowse-display-member-buffer - (second info) nil (first info)))) + (cl-second info) nil (cl-first info)))) (t (switch-to-buffer buffer) - (setq ebrowse--displayed-class (first info) - ebrowse--accessor (second info) + (setq ebrowse--displayed-class (cl-first info) + ebrowse--accessor (cl-second info) ebrowse--member-list (funcall ebrowse--accessor ebrowse--displayed-class)) (ebrowse-redisplay-member-buffer))) - (ebrowse-move-point-to-member (ebrowse-ms-name (third info))))) + (ebrowse-move-point-to-member (ebrowse-ms-name (cl-third info))))) (defun ebrowse-tags-display-member-buffer (&optional fix-name) @@ -3454,13 +3444,13 @@ It is a list (TREE ACCESSOR MEMBER)." FIX-NAME non-nil means display the buffer for that member. Otherwise read a member name from point." (interactive) - (multiple-value-bind - (tree header tree-buffer) (values-list (ebrowse-choose-tree)) + (cl-multiple-value-bind + (tree header tree-buffer) (cl-values-list (ebrowse-choose-tree)) (unless tree (error "No class tree")) (let* ((marker (point-marker)) class-name (name fix-name) info) (unless name - (multiple-value-setq (class-name name) - (values-list + (cl-multiple-value-setq (class-name name) + (cl-values-list (ebrowse-tags-read-name header (concat "Find member list of: "))))) (setq info (ebrowse-tags-choose-class tree header name class-name)) @@ -3487,7 +3477,7 @@ are not performed." (interactive) (let* ((buffer (or (ebrowse-choose-from-browser-buffers) (error "No tree buffer"))) - (header (ebrowse-value-in-buffer 'ebrowse--header buffer)) + (header (buffer-local-value 'ebrowse--header buffer)) (members (ebrowse-member-table header)) temp-buffer-setup-hook (regexp (read-from-minibuffer "List members matching regexp: "))) @@ -3495,9 +3485,9 @@ are not performed." (set-buffer standard-output) (erase-buffer) (insert "Members matching `" regexp "'\n\n") - (loop for s in (ebrowse-list-of-matching-members members regexp) do - (loop for info in (gethash s members) do - (ebrowse-draw-file-member-info info)))))) + (cl-loop for s in (ebrowse-list-of-matching-members members regexp) do + (cl-loop for info in (gethash s members) do + (ebrowse-draw-file-member-info info)))))) (defun ebrowse-tags-list-members-in-file () @@ -3508,50 +3498,50 @@ The file name is read from the minibuffer." (error "No tree buffer"))) (files (with-current-buffer buffer (ebrowse-files-table))) (file (completing-read "List members in file: " files nil t)) - (header (ebrowse-value-in-buffer 'ebrowse--header buffer)) + (header (buffer-local-value 'ebrowse--header buffer)) temp-buffer-setup-hook (members (ebrowse-member-table header))) (with-output-to-temp-buffer (concat "*Members in file " file "*") (set-buffer standard-output) (maphash (lambda (_member-name list) - (loop for info in list - as member = (third info) - as class = (ebrowse-ts-class (first info)) - when (or (and (null (ebrowse-ms-file member)) - (string= (ebrowse-cs-file class) file)) - (string= file (ebrowse-ms-file member))) - do (ebrowse-draw-file-member-info info "decl.") - when (or (and (null (ebrowse-ms-definition-file member)) - (string= (ebrowse-cs-source-file class) file)) - (string= file (ebrowse-ms-definition-file member))) - do (ebrowse-draw-file-member-info info "defn."))) + (cl-loop for info in list + as member = (cl-third info) + as class = (ebrowse-ts-class (cl-first info)) + when (or (and (null (ebrowse-ms-file member)) + (string= (ebrowse-cs-file class) file)) + (string= file (ebrowse-ms-file member))) + do (ebrowse-draw-file-member-info info "decl.") + when (or (and (null (ebrowse-ms-definition-file member)) + (string= (ebrowse-cs-source-file class) file)) + (string= file (ebrowse-ms-definition-file member))) + do (ebrowse-draw-file-member-info info "defn."))) members)))) -(defun* ebrowse-draw-file-member-info (info &optional (kind "")) +(cl-defun ebrowse-draw-file-member-info (info &optional (kind "")) "Display a line in the members info buffer. INFO describes the member. It has the form (TREE ACCESSOR MEMBER). TREE is the class of the member to display. ACCESSOR is the accessor symbol of its member list. MEMBER is the member structure. KIND is an additional string printed in the buffer." - (let* ((tree (first info)) + (let* ((tree (cl-first info)) (globals-p (ebrowse-globals-tree-p tree))) (unless globals-p (insert (ebrowse-cs-name (ebrowse-ts-class tree)))) - (insert "::" (ebrowse-ms-name (third info))) + (insert "::" (ebrowse-ms-name (cl-third info))) (indent-to 40) (insert kind) (indent-to 50) - (insert (case (second info) - (ebrowse-ts-member-functions "member function") - (ebrowse-ts-member-variables "member variable") - (ebrowse-ts-static-functions "static function") - (ebrowse-ts-static-variables "static variable") - (ebrowse-ts-friends (if globals-p "define" "friend")) - (ebrowse-ts-types "type") - (t "unknown")) + (insert (pcase (cl-second info) + (`ebrowse-ts-member-functions "member function") + (`ebrowse-ts-member-variables "member variable") + (`ebrowse-ts-static-functions "static function") + (`ebrowse-ts-static-variables "static variable") + (`ebrowse-ts-friends (if globals-p "define" "friend")) + (`ebrowse-ts-types "type") + (_ "unknown")) "\n"))) (defvar ebrowse-last-completion nil @@ -3582,11 +3572,11 @@ KIND is an additional string printed in the buffer." If there's only one tree loaded, use that. Otherwise let the use choose a tree." (let* ((buffers (ebrowse-known-class-trees-buffer-list)) - (buffer (cond ((and (first buffers) (not (second buffers))) - (first buffers)) + (buffer (cond ((and (cl-first buffers) (not (cl-second buffers))) + (cl-first buffers)) (t (or (ebrowse-electric-choose-tree) (error "No tree buffer"))))) - (header (ebrowse-value-in-buffer 'ebrowse--header buffer))) + (header (buffer-local-value 'ebrowse--header buffer))) (ebrowse-member-table header))) @@ -3594,13 +3584,13 @@ use choose a tree." "Return the item following STRING in LIST. If STRING is the last element, return the first element as successor." (or (nth (1+ (ebrowse-position string list 'string=)) list) - (first list))) + (cl-first list))) ;;; Symbol completion ;;;###autoload -(defun* ebrowse-tags-complete-symbol (prefix) +(cl-defun ebrowse-tags-complete-symbol (prefix) "Perform completion on the C++ symbol preceding point. A second call of this function without changing point inserts the next match. A call with prefix PREFIX reads the symbol to insert from the minibuffer with @@ -3640,7 +3630,7 @@ completion." ;; buffer: Start new completion. (t (let* ((members (ebrowse-some-member-table)) - (completion (first (all-completions pattern members nil)))) + (completion (cl-first (all-completions pattern members nil)))) (cond ((eq completion t)) ((null completion) (error "Can't find completion for `%s'" pattern)) @@ -3766,15 +3756,15 @@ Searches in all files mentioned in a class tree for something that looks like a function call to the member." (interactive) ;; Choose the tree to use if there is more than one. - (multiple-value-bind (tree header tree-buffer) - (values-list (ebrowse-choose-tree)) + (cl-multiple-value-bind (tree header tree-buffer) + (cl-values-list (ebrowse-choose-tree)) (unless tree (error "No class tree")) ;; Get the member name NAME (class-name is ignored). (let ((name fix-name) class-name regexp) (unless name - (multiple-value-setq (class-name name) - (values-list (ebrowse-tags-read-name header "Find calls of: ")))) + (cl-multiple-value-setq (class-name name) + (cl-values-list (ebrowse-tags-read-name header "Find calls of: ")))) ;; Set tags loop form to search for member and begin loop. (setq regexp (concat "\\<" name "[ \t]*(") ebrowse-tags-loop-form (list 're-search-forward regexp nil t)) @@ -3786,7 +3776,7 @@ looks like a function call to the member." ;;; Structures of this kind are the elements of the position stack. -(defstruct (ebrowse-position (:type vector) :named) +(cl-defstruct (ebrowse-position (:type vector) :named) file-name ; in which file point ; point in file target ; t if target of a jump @@ -3806,8 +3796,8 @@ looks like a function call to the member." The string is printed in the electric position list buffer." (let ((info (ebrowse-position-info position))) (concat (if (ebrowse-position-target position) "at " "to ") - (ebrowse-cs-name (ebrowse-ts-class (first info))) - "::" (ebrowse-ms-name (third info))))) + (ebrowse-cs-name (ebrowse-ts-class (cl-first info))) + "::" (ebrowse-ms-name (cl-third info))))) (defun ebrowse-view/find-position (position &optional view) @@ -3837,7 +3827,7 @@ Positions in buffers that have no file names are not saved." (let ((too-much (- (length ebrowse-position-stack) ebrowse-max-positions))) ;; Do not let the stack grow to infinity. - (when (plusp too-much) + (when (cl-plusp too-much) (setq ebrowse-position-stack (butlast ebrowse-position-stack too-much))) ;; Push the position. @@ -4108,9 +4098,9 @@ Otherwise, FILE-NAME specifies the file to save the tree in." (let ((tree-file (buffer-file-name)) temp-buffer-setup-hook) (with-output-to-temp-buffer "*Tree Statistics*" - (multiple-value-bind (classes member-functions member-variables + (cl-multiple-value-bind (classes member-functions member-variables static-functions static-variables) - (values-list (ebrowse-gather-statistics)) + (cl-values-list (ebrowse-gather-statistics)) (set-buffer standard-output) (erase-buffer) (insert "STATISTICS FOR TREE " (or tree-file "unknown") ":\n\n") @@ -4142,11 +4132,11 @@ NUMBER-OF-STATIC-VARIABLES:" (let ((classes 0) (member-functions 0) (member-variables 0) (static-functions 0) (static-variables 0)) (ebrowse-for-all-trees (tree ebrowse--tree-obarray) - (incf classes) - (incf member-functions (length (ebrowse-ts-member-functions tree))) - (incf member-variables (length (ebrowse-ts-member-variables tree))) - (incf static-functions (length (ebrowse-ts-static-functions tree))) - (incf static-variables (length (ebrowse-ts-static-variables tree)))) + (cl-incf classes) + (cl-incf member-functions (length (ebrowse-ts-member-functions tree))) + (cl-incf member-variables (length (ebrowse-ts-member-variables tree))) + (cl-incf static-functions (length (ebrowse-ts-static-functions tree))) + (cl-incf static-variables (length (ebrowse-ts-static-variables tree)))) (list classes member-functions member-variables static-functions static-variables))) @@ -4390,12 +4380,12 @@ EVENT is the mouse event." (mouse-set-point event) (let* ((where (posn-point (event-start event))) (property (get-text-property where 'ebrowse-what))) - (case (event-click-count event) + (pcase (event-click-count event) (1 - (case property - (class-name + (pcase property + (`class-name (ebrowse-popup-menu ebrowse-tree-buffer-class-object-menu event)) - (t + (_ (ebrowse-popup-menu ebrowse-tree-buffer-object-menu event))))))) @@ -4406,9 +4396,9 @@ EVENT is the mouse event." (mouse-set-point event) (let* ((where (posn-point (event-start event))) (property (get-text-property where 'ebrowse-what))) - (case (event-click-count event) - (1 (case property - (class-name + (pcase (event-click-count event) + (1 (pcase property + (`class-name (ebrowse-tree-command:show-member-functions))))))) @@ -4419,13 +4409,13 @@ EVENT is the mouse event." (mouse-set-point event) (let* ((where (posn-point (event-start event))) (property (get-text-property where 'ebrowse-what))) - (case (event-click-count event) - (2 (case property - (class-name + (pcase (event-click-count event) + (2 (pcase property + (`class-name (let ((collapsed (save-excursion (skip-chars-forward "^\r\n") (looking-at "\r")))) (ebrowse-collapse-fn (not collapsed)))) - (mark + (`mark (ebrowse-toggle-mark-at-point 1))))))) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 2664b51eea9..071a0fb6037 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -26,8 +26,6 @@ ;;; Code: -(eval-when-compile - (require 'cl)) (require 'ring) (require 'button) diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index 712725ffaf0..cc1251f6a75 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -233,6 +233,7 @@ :safe 'stringp :group 'f90-indent) +;; Should we add ^# to this? That's not really a comment. (defcustom f90-directive-comment-re "!hpf\\$" "Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented." :type 'regexp @@ -627,7 +628,14 @@ logical\\|double[ \t]*precision\\|type[ \t]*(\\sw+)\\|none\\)[ \t]*" '("\\<\\(do\\|go[ \t]*to\\)\\>[ \t]*\\([0-9]+\\)" (1 font-lock-keyword-face) (2 font-lock-constant-face)) ;; Line numbers (lines whose first character after number is letter). - '("^[ \t]*\\([0-9]+\\)[ \t]*[a-z]+" (1 font-lock-constant-face t)))) + '("^[ \t]*\\([0-9]+\\)[ \t]*[a-z]+" (1 font-lock-constant-face t)) + ;; Override eg for "#include". + '("^#[ \t]*\\w+" (0 font-lock-preprocessor-face t) + ("\\" nil nil (0 font-lock-preprocessor-face))) + '("^#" ("\\(&&\\|||\\)" nil nil (0 font-lock-constant-face t))) + '("^#[ \t]*define[ \t]+\\(\\w+\\)(" (1 font-lock-function-name-face)) + '("^#[ \t]*define[ \t]+\\(\\w+\\)" (1 font-lock-variable-name-face)) + '("^#[ \t]*include[ \t]+\\(<.+>\\)" (1 font-lock-string-face)))) "Highlights declarations, do-loops and other constructs.") (defvar f90-font-lock-keywords-3 diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 654fd3dba8d..ad285274928 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -35,7 +35,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (if (featurep 'xemacs) (require 'overlay)) (defvar flymake-is-running nil @@ -408,7 +408,7 @@ File contents are not checked." This function is used in sort to move most possible file names to the beginning of the list (File.h -> File.cpp moved to top)." (and (equal (file-name-sans-extension flymake-included-file-name) - (file-name-sans-extension (file-name-nondirectory file-one))) + (file-name-base file-one)) (not (equal file-one file-two)))) (defcustom flymake-check-file-limit 8192 @@ -684,7 +684,7 @@ It's flymake process filter." (defun flymake-er-get-line-err-info-list (err-info) (nth 1 err-info)) -(defstruct (flymake-ler +(cl-defstruct (flymake-ler (:constructor nil) (:constructor flymake-ler-make-ler (file line type text &optional full-file))) file line type text full-file) @@ -763,15 +763,46 @@ line number outside the file being compiled." "Determine whether overlay OV was created by flymake." (and (overlayp ov) (overlay-get ov 'flymake-overlay))) -(defun flymake-make-overlay (beg end tooltip-text face mouse-face) +(defcustom flymake-error-bitmap '(exclamation-mark error) + "Bitmap used in the fringe for indicating errors. +The value may also be a list of two elements where the second +element specifies the face for the bitmap." + :group 'flymake + :type 'symbol) + +(defcustom flymake-warning-bitmap 'question-mark + "Bitmap used in the fringe for indicating warnings. +The value may also be a list of two elements where the second +element specifies the face for the bitmap." + :group 'flymake + :type 'symbol) + +(defcustom flymake-fringe-indicator-position 'left-fringe + "The position to put flymake fringe indicator. +The value can be nil, left-fringe or right-fringe. +Fringe indicators are disabled if nil." + :group 'flymake + :type '(choice (const left-fringe) + (const right-fringe) + (const :tag "No fringe indicators" nil))) + +(defun flymake-make-overlay (beg end tooltip-text face bitmap mouse-face) "Allocate a flymake overlay in range BEG and END." (when (not (flymake-region-has-flymake-overlays beg end)) - (let ((ov (make-overlay beg end nil t t))) + (let ((ov (make-overlay beg end nil t t)) + (fringe (and flymake-fringe-indicator-position + (propertize "!" 'display + (cons flymake-fringe-indicator-position + (if (listp bitmap) + bitmap + (list bitmap))))))) (overlay-put ov 'face face) (overlay-put ov 'mouse-face mouse-face) (overlay-put ov 'help-echo tooltip-text) (overlay-put ov 'flymake-overlay t) (overlay-put ov 'priority 100) + (overlay-put ov 'evaporate t) + (overlay-put ov 'before-string fringe) ;;+(flymake-log 3 "created overlay %s" ov) ov) (flymake-log 3 "created an overlay at (%d-%d)" beg end))) @@ -815,7 +846,8 @@ Perhaps use text from LINE-ERR-INFO-LIST to enhance highlighting." (beg line-beg) (end line-end) (tooltip-text (flymake-ler-text (nth 0 line-err-info-list))) - (face nil)) + (face nil) + (bitmap nil)) (goto-char line-beg) (while (looking-at "[ \t]") @@ -839,10 +871,12 @@ Perhaps use text from LINE-ERR-INFO-LIST to enhance highlighting." (setq end (point))) (if (> (flymake-get-line-err-count line-err-info-list "e") 0) - (setq face 'flymake-errline) - (setq face 'flymake-warnline)) + (setq face 'flymake-errline + bitmap flymake-error-bitmap) + (setq face 'flymake-warnline + bitmap flymake-warning-bitmap)) - (flymake-make-overlay beg end tooltip-text face nil))) + (flymake-make-overlay beg end tooltip-text face bitmap nil))) (defun flymake-parse-err-lines (err-info-list lines) "Parse err LINES, store info in ERR-INFO-LIST." diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 5ea0f6a3fd2..23a34b85194 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -91,7 +91,7 @@ (require 'gud) (require 'json) (require 'bindat) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (declare-function speedbar-change-initial-expansion-list "speedbar" (new-default)) @@ -2269,8 +2269,7 @@ Return position where LINE begins." ;; gdb-table struct is a way to programmatically construct simple ;; tables. It help to reliably align columns of data in GDB buffers ;; and provides -(defstruct - gdb-table +(cl-defstruct gdb-table (column-sizes nil) (rows nil) (row-properties nil) @@ -2757,9 +2756,9 @@ corresponding to the mode line clicked." (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)) + (cl-incf (if running + gdb-running-threads-count + gdb-stopped-threads-count)) (gdb-table-add-row table (list diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el index 7c131dd316c..a5ac7b43057 100644 --- a/lisp/progmodes/glasses.el +++ b/lisp/progmodes/glasses.el @@ -51,10 +51,6 @@ ;;; Code: -(eval-when-compile - (require 'cl)) - - ;;; User variables diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 7123a8dd7fc..8912e67d603 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -37,8 +37,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) ; for case macro - (require 'comint) (defvar gdb-active-process) @@ -528,10 +526,10 @@ required by the caller." nil 'gdb-edit-value) nil (if gdb-show-changed-values - (or parent (case status - (changed 'font-lock-warning-face) - (out-of-scope 'shadow) - (t t))) + (or parent (pcase status + (`changed 'font-lock-warning-face) + (`out-of-scope 'shadow) + (_ t))) t) depth) (if (eq status 'out-of-scope) (setq parent 'shadow)) @@ -549,10 +547,10 @@ required by the caller." nil 'gdb-edit-value) nil (if gdb-show-changed-values - (or parent (case status - (changed 'font-lock-warning-face) - (out-of-scope 'shadow) - (t t))) + (or parent (pcase status + (`changed 'font-lock-warning-face) + (`out-of-scope 'shadow) + (_ t))) t) depth) (speedbar-make-tag-line @@ -2763,10 +2761,9 @@ Obeying it means displaying in another window the specified file and line." (buffer-file-name) (car frame))))) ((eq key ?F) - (setq subst (file-name-sans-extension - (file-name-nondirectory (if insource - (buffer-file-name) - (car frame)))))) + (setq subst (file-name-base (if insource + (buffer-file-name) + (car frame))))) ((eq key ?d) (setq subst (file-name-directory (if insource (buffer-file-name) @@ -3413,11 +3410,11 @@ With arg, dereference expr if ARG is positive, otherwise do not dereference." (defun gud-tooltip-print-command (expr) "Return a suitable command to print the expression EXPR." - (case gud-minor-mode - (gdbmi (concat "-data-evaluate-expression " expr)) - (dbx (concat "print " expr)) - ((xdb pdb) (concat "p " expr)) - (sdb (concat expr "/")))) + (pcase gud-minor-mode + (`gdbmi (concat "-data-evaluate-expression " expr)) + (`dbx (concat "print " expr)) + ((or `xdb `pdb) (concat "p " expr)) + (`sdb (concat expr "/")))) (declare-function gdb-input "gdb-mi" (command handler)) (declare-function tooltip-expr-to-print "tooltip" (event)) diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 015f58df3fb..a35ffd3e45d 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -5235,9 +5235,7 @@ Can run from `after-save-hook'." class (cond ((not (boundp 'idlwave-scanning-lib)) (list 'buffer (buffer-file-name))) -; ((string= (downcase -; (file-name-sans-extension -; (file-name-nondirectory (buffer-file-name)))) +; ((string= (downcase (file-name-base)) ; (downcase name)) ; (list 'lib)) ; (t (cons 'lib (file-name-nondirectory (buffer-file-name)))) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index cdc3ef1c2e0..519e5aef2bc 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -54,7 +54,7 @@ (require 'json nil t) (eval-when-compile - (require 'cl) + (require 'cl-lib) (require 'comint) (require 'ido)) @@ -240,12 +240,11 @@ name as matched contains ") (defconst js--available-frameworks - (loop with available-frameworks - for style in js--class-styles - for framework = (plist-get style :framework) - unless (memq framework available-frameworks) - collect framework into available-frameworks - finally return available-frameworks) + (cl-loop for style in js--class-styles + for framework = (plist-get style :framework) + unless (memq framework available-frameworks) + collect framework into available-frameworks + finally return available-frameworks) "List of available JavaScript frameworks symbols.") (defconst js--function-heading-1-re @@ -374,7 +373,7 @@ Match group 1 is the name of the macro.") ;; (The exception for b-end and its caveats is described below.) ;; -(defstruct (js--pitem (:type list)) +(cl-defstruct (js--pitem (:type list)) ;; IMPORTANT: Do not alter the position of fields within the list. ;; Various bits of code depend on their positions, particularly ;; anything that manipulates the list of children. @@ -555,10 +554,10 @@ getting timeout messages." (make-variable-buffer-local 'js--state-at-last-parse-pos) (defun js--flatten-list (list) - (loop for item in list - nconc (cond ((consp item) - (js--flatten-list item)) - (item (list item))))) + (cl-loop for item in list + nconc (cond ((consp item) + (js--flatten-list item)) + (item (list item))))) (defun js--maybe-join (prefix separator suffix &rest list) "Helper function for `js--update-quick-match-re'. @@ -768,13 +767,13 @@ If invoked while inside a macro, treat the macro as normal text." "Move forward over a whole JavaScript expression. This function doesn't move over expressions continued across lines." - (loop + (cl-loop ;; non-continued case; simplistic, but good enough? - do (loop until (or (eolp) - (progn - (forward-comment most-positive-fixnum) - (memq (char-after) '(?\, ?\; ?\] ?\) ?\})))) - do (forward-sexp)) + do (cl-loop until (or (eolp) + (progn + (forward-comment most-positive-fixnum) + (memq (char-after) '(?\, ?\; ?\] ?\) ?\})))) + do (forward-sexp)) while (and (eq (char-after) ?\n) (save-excursion @@ -788,7 +787,7 @@ This puts point at the 'function' keyword. If this is a syntactically-correct non-expression function, return the name of the function, or t if the name could not be determined. Otherwise, return nil." - (assert (looking-at "\\_")) + (cl-assert (looking-at "\\_")) (let ((name t)) (forward-word) (forward-comment most-positive-fixnum) @@ -847,32 +846,32 @@ anything." "Helper function for `js--beginning-of-defun-nested'. If PSTATE represents a non-empty top-level defun, return the top-most pitem. Otherwise, return nil." - (loop for pitem in pstate - with func-depth = 0 - with func-pitem - if (eq 'function (js--pitem-type pitem)) - do (incf func-depth) - and do (setq func-pitem pitem) - finally return (if (eq func-depth 1) func-pitem))) + (cl-loop for pitem in pstate + with func-depth = 0 + with func-pitem + if (eq 'function (js--pitem-type pitem)) + do (cl-incf func-depth) + and do (setq func-pitem pitem) + finally return (if (eq func-depth 1) func-pitem))) (defun js--beginning-of-defun-nested () "Helper function for `js--beginning-of-defun'. Return the pitem of the function we went to the beginning of." (or ;; Look for the smallest function that encloses point... - (loop for pitem in (js--parse-state-at-point) - if (and (eq 'function (js--pitem-type pitem)) - (js--inside-pitem-p pitem)) - do (goto-char (js--pitem-h-begin pitem)) - and return pitem) + (cl-loop for pitem in (js--parse-state-at-point) + if (and (eq 'function (js--pitem-type pitem)) + (js--inside-pitem-p pitem)) + do (goto-char (js--pitem-h-begin pitem)) + and return pitem) ;; ...and if that isn't found, look for the previous top-level ;; defun - (loop for pstate = (js--backward-pstate) - while pstate - if (js--pstate-is-toplevel-defun pstate) - do (goto-char (js--pitem-h-begin it)) - and return it))) + (cl-loop for pstate = (js--backward-pstate) + while pstate + if (js--pstate-is-toplevel-defun pstate) + do (goto-char (js--pitem-h-begin it)) + and return it))) (defun js--beginning-of-defun-flat () "Helper function for `js-beginning-of-defun'." @@ -884,7 +883,7 @@ Return the pitem of the function we went to the beginning of." "Value of `beginning-of-defun-function' for `js-mode'." (setq arg (or arg 1)) (while (and (not (eobp)) (< arg 0)) - (incf arg) + (cl-incf arg) (when (and (not js-flat-functions) (or (eq (js-syntactic-context) 'function) (js--function-prologue-beginning))) @@ -896,7 +895,7 @@ Return the pitem of the function we went to the beginning of." (goto-char (point-max)))) (while (> arg 0) - (decf arg) + (cl-decf arg) ;; If we're just past the end of a function, the user probably wants ;; to go to the beginning of *that* function (when (eq (char-before) ?}) @@ -925,14 +924,14 @@ BEG defaults to `point-min', meaning to flush the entire cache." (defun js--ensure-cache--pop-if-ended (open-items paren-depth) (let ((top-item (car open-items))) (when (<= paren-depth (js--pitem-paren-depth top-item)) - (assert (not (get-text-property (1- (point)) 'js-pend))) + (cl-assert (not (get-text-property (1- (point)) 'js-pend))) (put-text-property (1- (point)) (point) 'js--pend top-item) (setf (js--pitem-b-end top-item) (point)) (setq open-items ;; open-items must contain at least two items for this to ;; work, but because we push a dummy item to start with, ;; that assumption holds. - (cons (js--pitem-add-child (second open-items) top-item) + (cons (js--pitem-add-child (cl-second open-items) top-item) (cddr open-items))))) open-items) @@ -950,7 +949,7 @@ the body of `js--ensure-cache'." ;; Make sure parse-partial-sexp doesn't stop because we *entered* ;; the given depth -- i.e., make sure we're deeper than the target ;; depth. - (assert (> (nth 0 parse) + (cl-assert (> (nth 0 parse) (js--pitem-paren-depth (car open-items)))) (setq parse (parse-partial-sexp prev-parse-point goal-point @@ -1045,10 +1044,10 @@ LIMIT defaults to point." ;; Figure out which class styles we need to look for (setq filtered-class-styles - (loop for style in js--class-styles - if (memq (plist-get style :framework) - js-enabled-frameworks) - collect style)) + (cl-loop for style in js--class-styles + if (memq (plist-get style :framework) + js-enabled-frameworks) + collect style)) (save-excursion (save-restriction @@ -1067,7 +1066,7 @@ LIMIT defaults to point." (unless (bobp) (setq open-items (get-text-property (1- (point)) 'js--pstate)) - (assert open-items)))) + (cl-assert open-items)))) (unless open-items ;; Make a placeholder for the top-level definition @@ -1080,97 +1079,98 @@ LIMIT defaults to point." (narrow-to-region (point-min) limit) - (loop while (re-search-forward js--quick-match-re-func nil t) - for orig-match-start = (goto-char (match-beginning 0)) - for orig-match-end = (match-end 0) - do (js--ensure-cache--update-parse) - for orig-depth = (nth 0 parse) + (cl-loop while (re-search-forward js--quick-match-re-func nil t) + for orig-match-start = (goto-char (match-beginning 0)) + for orig-match-end = (match-end 0) + do (js--ensure-cache--update-parse) + for orig-depth = (nth 0 parse) - ;; Each of these conditions should return non-nil if - ;; we should add a new item and leave point at the end - ;; of the new item's header (h-end in the - ;; js--pitem diagram). This point is the one - ;; after the last character we need to unambiguously - ;; detect this construct. If one of these evaluates to - ;; nil, the location of the point is ignored. - if (cond - ;; In comment or string - ((nth 8 parse) nil) + ;; Each of these conditions should return non-nil if + ;; we should add a new item and leave point at the end + ;; of the new item's header (h-end in the + ;; js--pitem diagram). This point is the one + ;; after the last character we need to unambiguously + ;; detect this construct. If one of these evaluates to + ;; nil, the location of the point is ignored. + if (cond + ;; In comment or string + ((nth 8 parse) nil) - ;; Regular function declaration - ((and (looking-at "\\_") - (setq name (js--forward-function-decl))) + ;; Regular function declaration + ((and (looking-at "\\_") + (setq name (js--forward-function-decl))) - (when (eq name t) - (setq name (js--guess-function-name orig-match-end)) - (if name - (when js--guess-function-name-start - (setq orig-match-start - js--guess-function-name-start)) + (when (eq name t) + (setq name (js--guess-function-name orig-match-end)) + (if name + (when js--guess-function-name-start + (setq orig-match-start + js--guess-function-name-start)) - (setq name t))) + (setq name t))) - (assert (eq (char-after) ?{)) - (forward-char) - (make-js--pitem - :paren-depth orig-depth - :h-begin orig-match-start - :type 'function - :name (if (eq name t) - name - (js--split-name name)))) + (cl-assert (eq (char-after) ?{)) + (forward-char) + (make-js--pitem + :paren-depth orig-depth + :h-begin orig-match-start + :type 'function + :name (if (eq name t) + name + (js--split-name name)))) - ;; Macro - ((looking-at js--macro-decl-re) + ;; Macro + ((looking-at js--macro-decl-re) - ;; Macros often contain unbalanced parentheses. - ;; Make sure that h-end is at the textual end of - ;; the macro no matter what the parenthesis say. - (c-end-of-macro) - (js--ensure-cache--update-parse) + ;; Macros often contain unbalanced parentheses. + ;; Make sure that h-end is at the textual end of + ;; the macro no matter what the parenthesis say. + (c-end-of-macro) + (js--ensure-cache--update-parse) - (make-js--pitem - :paren-depth (nth 0 parse) - :h-begin orig-match-start - :type 'macro - :name (list (match-string-no-properties 1)))) + (make-js--pitem + :paren-depth (nth 0 parse) + :h-begin orig-match-start + :type 'macro + :name (list (match-string-no-properties 1)))) - ;; "Prototype function" declaration - ((looking-at js--plain-method-re) - (goto-char (match-beginning 3)) - (when (save-match-data - (js--forward-function-decl)) - (forward-char) - (make-js--pitem - :paren-depth orig-depth - :h-begin orig-match-start - :type 'function - :name (nconc (js--split-name - (match-string-no-properties 1)) - (list (match-string-no-properties 2)))))) + ;; "Prototype function" declaration + ((looking-at js--plain-method-re) + (goto-char (match-beginning 3)) + (when (save-match-data + (js--forward-function-decl)) + (forward-char) + (make-js--pitem + :paren-depth orig-depth + :h-begin orig-match-start + :type 'function + :name (nconc (js--split-name + (match-string-no-properties 1)) + (list (match-string-no-properties 2)))))) - ;; Class definition - ((loop with syntactic-context = - (js--syntactic-context-from-pstate open-items) - for class-style in filtered-class-styles - if (and (memq syntactic-context - (plist-get class-style :contexts)) - (looking-at (plist-get class-style - :class-decl))) - do (goto-char (match-end 0)) - and return - (make-js--pitem - :paren-depth orig-depth - :h-begin orig-match-start - :type class-style - :name (js--split-name - (match-string-no-properties 1)))))) + ;; Class definition + ((cl-loop + with syntactic-context = + (js--syntactic-context-from-pstate open-items) + for class-style in filtered-class-styles + if (and (memq syntactic-context + (plist-get class-style :contexts)) + (looking-at (plist-get class-style + :class-decl))) + do (goto-char (match-end 0)) + and return + (make-js--pitem + :paren-depth orig-depth + :h-begin orig-match-start + :type class-style + :name (js--split-name + (match-string-no-properties 1)))))) - do (js--ensure-cache--update-parse) - and do (push it open-items) - and do (put-text-property - (1- (point)) (point) 'js--pstate open-items) - else do (goto-char orig-match-end)) + do (js--ensure-cache--update-parse) + and do (push it open-items) + and do (put-text-property + (1- (point)) (point) 'js--pstate open-items) + else do (goto-char orig-match-end)) (goto-char limit) (js--ensure-cache--update-parse) @@ -1181,12 +1181,12 @@ LIMIT defaults to point." (defun js--end-of-defun-flat () "Helper function for `js-end-of-defun'." - (loop while (js--re-search-forward "}" nil t) - do (js--ensure-cache) - if (get-text-property (1- (point)) 'js--pend) - if (eq 'function (js--pitem-type it)) - return t - finally do (goto-char (point-max)))) + (cl-loop while (js--re-search-forward "}" nil t) + do (js--ensure-cache) + if (get-text-property (1- (point)) 'js--pend) + if (eq 'function (js--pitem-type it)) + return t + finally do (goto-char (point-max)))) (defun js--end-of-defun-nested () "Helper function for `js-end-of-defun'." @@ -1218,14 +1218,14 @@ LIMIT defaults to point." "Value of `end-of-defun-function' for `js-mode'." (setq arg (or arg 1)) (while (and (not (bobp)) (< arg 0)) - (incf arg) + (cl-incf arg) (js-beginning-of-defun) (js-beginning-of-defun) (unless (bobp) (js-end-of-defun))) (while (> arg 0) - (decf arg) + (cl-decf arg) ;; look for function backward. if we're inside it, go to that ;; function's end. otherwise, search for the next function's end and ;; go there @@ -1349,7 +1349,7 @@ REGEXPS, but only if FRAMEWORK is in `js-enabled-frameworks'." If FUNC is supplied, call it with no arguments before every variable name in the spec. Return true iff this was actually a spec. FUNC must preserve the match data." - (case (char-after) + (pcase (char-after) (?\[ (forward-char) (while @@ -1554,8 +1554,8 @@ point of view of font-lock. It applies highlighting directly with (defun js--inside-pitem-p (pitem) "Return whether point is inside the given pitem's header or body." (js--ensure-cache) - (assert (js--pitem-h-begin pitem)) - (assert (js--pitem-paren-depth pitem)) + (cl-assert (js--pitem-h-begin pitem)) + (cl-assert (js--pitem-paren-depth pitem)) (and (> (point) (js--pitem-h-begin pitem)) (or (null (js--pitem-b-end pitem)) @@ -1576,11 +1576,11 @@ will be returned." ;; Loop until we either hit a pitem at BOB or pitem ends after ;; point (or at point if we're at eob) - (loop for pitem = (car pstate) - until (or (eq (js--pitem-type pitem) - 'toplevel) - (js--inside-pitem-p pitem)) - do (pop pstate)) + (cl-loop for pitem = (car pstate) + until (or (eq (js--pitem-type pitem) + 'toplevel) + (js--inside-pitem-p pitem)) + do (pop pstate)) pstate)))) @@ -1609,22 +1609,22 @@ context." (defun js--class-decl-matcher (limit) "Font lock function used by `js-mode'. This performs fontification according to `js--class-styles'." - (loop initially (js--ensure-cache limit) - while (re-search-forward js--quick-match-re limit t) - for orig-end = (match-end 0) - do (goto-char (match-beginning 0)) - if (loop for style in js--class-styles - for decl-re = (plist-get style :class-decl) - if (and (memq (plist-get style :framework) - js-enabled-frameworks) - (memq (js-syntactic-context) - (plist-get style :contexts)) - decl-re - (looking-at decl-re)) - do (goto-char (match-end 0)) - and return t) - return t - else do (goto-char orig-end))) + (cl-loop initially (js--ensure-cache limit) + while (re-search-forward js--quick-match-re limit t) + for orig-end = (match-end 0) + do (goto-char (match-beginning 0)) + if (cl-loop for style in js--class-styles + for decl-re = (plist-get style :class-decl) + if (and (memq (plist-get style :framework) + js-enabled-frameworks) + (memq (js-syntactic-context) + (plist-get style :contexts)) + decl-re + (looking-at decl-re)) + do (goto-char (match-end 0)) + and return t) + return t + else do (goto-char orig-end))) (defconst js--font-lock-keywords '(js--font-lock-keywords-3 js--font-lock-keywords-1 @@ -1789,7 +1789,7 @@ nil." js-expr-indent-offset)) (t (+ (current-column) js-indent-level - (case (char-after (nth 1 parse-status)) + (pcase (char-after (nth 1 parse-status)) (?\( js-paren-indent-offset) (?\[ js-square-indent-offset) (?\{ js-curly-indent-offset)))))) @@ -1821,15 +1821,17 @@ nil." (defun js-c-fill-paragraph (&optional justify) "Fill the paragraph with `c-fill-paragraph'." (interactive "*P") - (flet ((c-forward-sws - (&optional limit) - (js--forward-syntactic-ws limit)) - (c-backward-sws - (&optional limit) - (js--backward-syntactic-ws limit)) - (c-beginning-of-macro - (&optional limit) - (js--beginning-of-macro limit))) + ;; FIXME: Such redefinitions are bad style. We should try and use some other + ;; way to get the same result. + (cl-letf (((symbol-function 'c-forward-sws) + (lambda (&optional limit) + (js--forward-syntactic-ws limit))) + ((symbol-function 'c-backward-sws) + (lambda (&optional limit) + (js--backward-syntactic-ws limit))) + ((symbol-function 'c-beginning-of-macro) + (lambda (&optional limit) + (js--beginning-of-macro limit)))) (let ((fill-paragraph-function 'c-fill-paragraph)) (c-fill-paragraph justify)))) @@ -1924,8 +1926,8 @@ the broken-down class name of the item to insert." name-parts (mapcar #'js--pitem-name items)) - (assert (stringp top-name)) - (assert (> (length top-name) 0)) + (cl-assert (stringp top-name)) + (cl-assert (> (length top-name) 0)) ;; If top-name isn't found in items, then we build a copy of items ;; and throw it away. But that's okay, since most of the time, we @@ -1990,10 +1992,10 @@ the broken-down class name of the item to insert." (defun js--pitem-add-child (pitem child) "Copy `js--pitem' PITEM, and push CHILD onto its list of children." - (assert (integerp (js--pitem-h-begin child))) - (assert (if (consp (js--pitem-name child)) - (loop for part in (js--pitem-name child) - always (stringp part)) + (cl-assert (integerp (js--pitem-h-begin child))) + (cl-assert (if (consp (js--pitem-name child)) + (cl-loop for part in (js--pitem-name child) + always (stringp part)) t)) ;; This trick works because we know (based on our defstructs) that @@ -2015,7 +2017,7 @@ the broken-down class name of the item to insert." ;; name is a list here because down in ;; `js--ensure-cache', we made sure to only add ;; class entries with lists for :name - (assert (consp name)) + (cl-assert (consp name)) (js--splice-into-items (car pitem) child name)) (t @@ -2040,11 +2042,11 @@ the broken-down class name of the item to insert." (setq pitem-name (js--pitem-strname pitem)) (when (eq pitem-name t) (setq pitem-name (format "[unknown %s]" - (incf (car unknown-ctr))))) + (cl-incf (car unknown-ctr))))) (cond ((memq pitem-type '(function macro)) - (assert (integerp (js--pitem-h-begin pitem))) + (cl-assert (integerp (js--pitem-h-begin pitem))) (push (cons pitem-name (js--maybe-make-marker (js--pitem-h-begin pitem))) @@ -2059,7 +2061,7 @@ the broken-down class name of the item to insert." imenu-items)) ((js--pitem-h-begin pitem) - (assert (integerp (js--pitem-h-begin pitem))) + (cl-assert (integerp (js--pitem-h-begin pitem))) (setq subitems (list (cons "[empty]" (js--maybe-make-marker @@ -2078,7 +2080,7 @@ the broken-down class name of the item to insert." (widen) (goto-char (point-max)) (js--ensure-cache) - (assert (or (= (point-min) (point-max)) + (cl-assert (or (= (point-min) (point-max)) (eq js--last-parse-pos (point)))) (when js--last-parse-pos (let ((state js--state-at-last-parse-pos) @@ -2087,10 +2089,10 @@ the broken-down class name of the item to insert." ;; Make sure everything is closed (while (cdr state) (setq state - (cons (js--pitem-add-child (second state) (car state)) + (cons (js--pitem-add-child (cl-second state) (car state)) (cddr state)))) - (assert (= (length state) 1)) + (cl-assert (= (length state) 1)) ;; Convert the new-finalized state into what imenu expects (js--pitems-to-imenu @@ -2104,34 +2106,34 @@ the broken-down class name of the item to insert." (mapconcat #'identity parts ".")) (defun js--imenu-to-flat (items prefix symbols) - (loop for item in items - if (imenu--subalist-p item) - do (js--imenu-to-flat - (cdr item) (concat prefix (car item) ".") - symbols) - else - do (let* ((name (concat prefix (car item))) - (name2 name) - (ctr 0)) + (cl-loop for item in items + if (imenu--subalist-p item) + do (js--imenu-to-flat + (cdr item) (concat prefix (car item) ".") + symbols) + else + do (let* ((name (concat prefix (car item))) + (name2 name) + (ctr 0)) - (while (gethash name2 symbols) - (setq name2 (format "%s<%d>" name (incf ctr)))) + (while (gethash name2 symbols) + (setq name2 (format "%s<%d>" name (cl-incf ctr)))) - (puthash name2 (cdr item) symbols)))) + (puthash name2 (cdr item) symbols)))) (defun js--get-all-known-symbols () "Return a hash table of all JavaScript symbols. This searches all existing `js-mode' buffers. Each key is the name of a symbol (possibly disambiguated with , where N > 1), and each value is a marker giving the location of that symbol." - (loop with symbols = (make-hash-table :test 'equal) - with imenu-use-markers = t - for buffer being the buffers - for imenu-index = (with-current-buffer buffer - (when (derived-mode-p 'js-mode) - (js--imenu-create-index))) - do (js--imenu-to-flat imenu-index "" symbols) - finally return symbols)) + (cl-loop with symbols = (make-hash-table :test 'equal) + with imenu-use-markers = t + for buffer being the buffers + for imenu-index = (with-current-buffer buffer + (when (derived-mode-p 'js-mode) + (js--imenu-create-index))) + do (js--imenu-to-flat imenu-index "" symbols) + finally return symbols)) (defvar js--symbol-history nil "History of entered JavaScript symbols.") @@ -2149,8 +2151,8 @@ marker." (let ((choice (ido-completing-read prompt - (loop for key being the hash-keys of symbols-table - collect key) + (cl-loop for key being the hash-keys of symbols-table + collect key) nil t initial-input 'js--symbol-history))) (cons choice (gethash choice symbols-table)))) @@ -2204,20 +2206,20 @@ On timeout, return nil. On success, return t with match data set. If START is non-nil, look for output starting from START. Otherwise, use the current value of `process-mark'." (with-current-buffer (process-buffer process) - (loop with start-pos = (or start - (marker-position (process-mark process))) - with end-time = (+ (float-time) timeout) - for time-left = (- end-time (float-time)) - do (goto-char (point-max)) - if (looking-back regexp start-pos) return t - while (> time-left 0) - do (accept-process-output process time-left nil t) - do (goto-char (process-mark process)) - finally do (signal - 'js-moz-bad-rpc - (list (format "Timed out waiting for output matching %S" regexp)))))) + (cl-loop with start-pos = (or start + (marker-position (process-mark process))) + with end-time = (+ (float-time) timeout) + for time-left = (- end-time (float-time)) + do (goto-char (point-max)) + if (looking-back regexp start-pos) return t + while (> time-left 0) + do (accept-process-output process time-left nil t) + do (goto-char (process-mark process)) + finally do (signal + 'js-moz-bad-rpc + (list (format "Timed out waiting for output matching %S" regexp)))))) -(defstruct js--js-handle +(cl-defstruct js--js-handle ;; Integer, mirrors the value we see in JS (id nil :read-only t) @@ -2626,11 +2628,11 @@ with `js--js-encode-value'." (inferior-moz-process) js--js-repl-prompt-regexp js-js-timeout)) - (incf js--js-repl-depth))) + (cl-incf js--js-repl-depth))) (defun js--js-leave-repl () - (assert (> js--js-repl-depth 0)) - (when (= 0 (decf js--js-repl-depth)) + (cl-assert (> js--js-repl-depth 0)) + (when (= 0 (cl-decf js--js-repl-depth)) (with-current-buffer inferior-moz-buffer (goto-char (point-max)) (js--js-wait-for-eval-prompt) @@ -2649,33 +2651,33 @@ with `js--js-encode-value'." (eval-and-compile (defun js--optimize-arglist (arglist) "Convert immediate js< and js! references to deferred ones." - (loop for item in arglist - if (eq (car-safe item) 'js<) - collect (append (list 'list ''js--funcall - '(list 'interactor "_getProp")) - (js--optimize-arglist (cdr item))) - else if (eq (car-safe item) 'js>) - collect (append (list 'list ''js--funcall - '(list 'interactor "_putProp")) + (cl-loop for item in arglist + if (eq (car-safe item) 'js<) + collect (append (list 'list ''js--funcall + '(list 'interactor "_getProp")) + (js--optimize-arglist (cdr item))) + else if (eq (car-safe item) 'js>) + collect (append (list 'list ''js--funcall + '(list 'interactor "_putProp")) - (if (atom (cadr item)) - (list (cadr item)) - (list - (append - (list 'list ''js--funcall - '(list 'interactor "_mkArray")) - (js--optimize-arglist (cadr item))))) - (js--optimize-arglist (cddr item))) - else if (eq (car-safe item) 'js!) - collect (destructuring-bind (ignored function &rest body) item - (append (list 'list ''js--funcall - (if (consp function) - (cons 'list - (js--optimize-arglist function)) - function)) - (js--optimize-arglist body))) - else - collect item))) + (if (atom (cadr item)) + (list (cadr item)) + (list + (append + (list 'list ''js--funcall + '(list 'interactor "_mkArray")) + (js--optimize-arglist (cadr item))))) + (js--optimize-arglist (cddr item))) + else if (eq (car-safe item) 'js!) + collect (pcase-let ((`(,_ ,function . ,body) item)) + (append (list 'list ''js--funcall + (if (consp function) + (cons 'list + (js--optimize-arglist function)) + function)) + (js--optimize-arglist body))) + else + collect item))) (defmacro js--js-get-service (class-name interface-name) `(js! ("Components" "classes" ,class-name "getService") @@ -2698,56 +2700,56 @@ Inside the lexical scope of `with-js', `js?', `js!', `(progn (js--js-enter-repl) (unwind-protect - (macrolet ((js? (&rest body) `(js--js-true ,@body)) - (js! (function &rest body) - `(js--js-funcall - ,(if (consp function) - (cons 'list - (js--optimize-arglist function)) - function) - ,@(js--optimize-arglist body))) - - (js-new (function &rest body) - `(js--js-new + (cl-macrolet ((js? (&rest body) `(js--js-true ,@body)) + (js! (function &rest body) + `(js--js-funcall ,(if (consp function) (cons 'list (js--optimize-arglist function)) function) - ,@body)) + ,@(js--optimize-arglist body))) - (js-eval (thisobj js) - `(js--js-eval - ,@(js--optimize-arglist - (list thisobj js)))) + (js-new (function &rest body) + `(js--js-new + ,(if (consp function) + (cons 'list + (js--optimize-arglist function)) + function) + ,@body)) - (js-list (&rest args) - `(js--js-list - ,@(js--optimize-arglist args))) + (js-eval (thisobj js) + `(js--js-eval + ,@(js--optimize-arglist + (list thisobj js)))) - (js-get-service (&rest args) - `(js--js-get-service - ,@(js--optimize-arglist args))) + (js-list (&rest args) + `(js--js-list + ,@(js--optimize-arglist args))) - (js-create-instance (&rest args) - `(js--js-create-instance - ,@(js--optimize-arglist args))) + (js-get-service (&rest args) + `(js--js-get-service + ,@(js--optimize-arglist args))) - (js-qi (&rest args) - `(js--js-qi - ,@(js--optimize-arglist args))) + (js-create-instance (&rest args) + `(js--js-create-instance + ,@(js--optimize-arglist args))) - (js< (&rest body) `(js--js-get - ,@(js--optimize-arglist body))) - (js> (props value) - `(js--js-funcall - '(interactor "_putProp") - ,(if (consp props) - (cons 'list - (js--optimize-arglist props)) - props) - ,@(js--optimize-arglist (list value)) - )) - (js-handle? (arg) `(js--js-handle-p ,arg))) + (js-qi (&rest args) + `(js--js-qi + ,@(js--optimize-arglist args))) + + (js< (&rest body) `(js--js-get + ,@(js--optimize-arglist body))) + (js> (props value) + `(js--js-funcall + '(interactor "_putProp") + ,(if (consp props) + (cons 'list + (js--optimize-arglist props)) + props) + ,@(js--optimize-arglist (list value)) + )) + (js-handle? (arg) `(js--js-handle-p ,arg))) ,@forms) (js--js-leave-repl)))) @@ -2756,21 +2758,22 @@ Inside the lexical scope of `with-js', `js?', `js!', If nil, the whole Array is treated as a JS symbol.") (defun js--js-decode-retval (result) - (ecase (intern (first result)) - (atom (second result)) - (special (intern (second result))) - (array - (mapcar #'js--js-decode-retval (second result))) - (objid - (or (gethash (second result) - js--js-references) - (puthash (second result) - (make-js--js-handle - :id (second result) - :process (inferior-moz-process)) - js--js-references))) + (pcase (intern (cl-first result)) + (`atom (cl-second result)) + (`special (intern (cl-second result))) + (`array + (mapcar #'js--js-decode-retval (cl-second result))) + (`objid + (or (gethash (cl-second result) + js--js-references) + (puthash (cl-second result) + (make-js--js-handle + :id (cl-second result) + :process (inferior-moz-process)) + js--js-references))) - (error (signal 'js-js-error (list (second result)))))) + (`error (signal 'js-js-error (list (cl-second result)))) + (x (error "Unmatched case in js--js-decode-retval: %S" x)))) (defun js--js-funcall (function &rest arguments) "Call the Mozilla function FUNCTION with arguments ARGUMENTS. @@ -2853,9 +2856,9 @@ With argument, run even if no intervening GC has happened." (looking-back js--js-prompt-regexp (save-excursion (forward-line 0) (point)))))) - (setq keys (loop for x being the hash-keys - of js--js-references - collect x)) + (setq keys (cl-loop for x being the hash-keys + of js--js-references + collect x)) (setq num (js--js-funcall '(repl "_jsGC") (or keys []))) (setq js--js-last-gcs-done this-gcs-done) @@ -2889,58 +2892,58 @@ left-to-right." (with-js (let (windows) - (loop with window-mediator = (js! ("Components" "classes" - "@mozilla.org/appshell/window-mediator;1" - "getService") - (js< "Components" "interfaces" - "nsIWindowMediator")) - with enumerator = (js! (window-mediator "getEnumerator") nil) + (cl-loop with window-mediator = (js! ("Components" "classes" + "@mozilla.org/appshell/window-mediator;1" + "getService") + (js< "Components" "interfaces" + "nsIWindowMediator")) + with enumerator = (js! (window-mediator "getEnumerator") nil) - while (js? (js! (enumerator "hasMoreElements"))) - for window = (js! (enumerator "getNext")) - for window-info = (js-list window - (js< window "document" "title") - (js! (window "location" "toString")) - (js< window "closed") - (js< window "windowState")) + while (js? (js! (enumerator "hasMoreElements"))) + for window = (js! (enumerator "getNext")) + for window-info = (js-list window + (js< window "document" "title") + (js! (window "location" "toString")) + (js< window "closed") + (js< window "windowState")) - unless (or (js? (fourth window-info)) - (eq (fifth window-info) 2)) - do (push window-info windows)) + unless (or (js? (cl-fourth window-info)) + (eq (cl-fifth window-info) 2)) + do (push window-info windows)) - (loop for window-info in windows - for window = (first window-info) - collect (list (second window-info) - (third window-info) - window) + (cl-loop for window-info in windows + for window = (cl-first window-info) + collect (list (cl-second window-info) + (cl-third window-info) + window) - for gbrowser = (js< window "gBrowser") - if (js-handle? gbrowser) - nconc (loop - for x below (js< gbrowser "browsers" "length") - collect (js-list (js< gbrowser - "browsers" - x - "contentDocument" - "title") + for gbrowser = (js< window "gBrowser") + if (js-handle? gbrowser) + nconc (cl-loop + for x below (js< gbrowser "browsers" "length") + collect (js-list (js< gbrowser + "browsers" + x + "contentDocument" + "title") - (js! (gbrowser - "browsers" - x - "contentWindow" - "location" - "toString")) - (js< gbrowser - "browsers" - x) + (js! (gbrowser + "browsers" + x + "contentWindow" + "location" + "toString")) + (js< gbrowser + "browsers" + x) - (js! (gbrowser - "tabContainer" - "childNodes" - "item") - x) + (js! (gbrowser + "tabContainer" + "childNodes" + "item") + x) - gbrowser)))))) + gbrowser)))))) (defvar js-read-tab-history nil) @@ -2960,106 +2963,110 @@ browser, respectively." selected-tab prev-hitab) ;; Disambiguate names - (setq tabs (loop with tab-names = (make-hash-table :test 'equal) - for tab in tabs - for cname = (format "%s (%s)" (second tab) (first tab)) - for num = (incf (gethash cname tab-names -1)) - if (> num 0) - do (setq cname (format "%s <%d>" cname num)) - collect (cons cname tab))) + (setq tabs + (cl-loop with tab-names = (make-hash-table :test 'equal) + for tab in tabs + for cname = (format "%s (%s)" + (cl-second tab) (cl-first tab)) + for num = (cl-incf (gethash cname tab-names -1)) + if (> num 0) + do (setq cname (format "%s <%d>" cname num)) + collect (cons cname tab))) - (labels ((find-tab-by-cname - (cname) - (loop for tab in tabs - if (equal (car tab) cname) - return (cdr tab))) + (cl-labels + ((find-tab-by-cname + (cname) + (cl-loop for tab in tabs + if (equal (car tab) cname) + return (cdr tab))) - (mogrify-highlighting - (hitab unhitab) + (mogrify-highlighting + (hitab unhitab) - ;; Hack to reduce the number of - ;; round-trips to mozilla - (let (cmds) - (cond - ;; Highlighting tab - ((fourth hitab) - (push '(js! ((fourth hitab) "setAttribute") - "style" - "color: red; font-weight: bold") - cmds) + ;; Hack to reduce the number of + ;; round-trips to mozilla + (let (cmds) + (cond + ;; Highlighting tab + ((cl-fourth hitab) + (push '(js! ((cl-fourth hitab) "setAttribute") + "style" + "color: red; font-weight: bold") + cmds) - ;; Highlight window proper - (push '(js! ((third hitab) - "setAttribute") - "style" - "border: 8px solid red") - cmds) + ;; Highlight window proper + (push '(js! ((cl-third hitab) + "setAttribute") + "style" + "border: 8px solid red") + cmds) - ;; Select tab, when appropriate - (when js-js-switch-tabs - (push - '(js> ((fifth hitab) "selectedTab") (fourth hitab)) - cmds))) + ;; Select tab, when appropriate + (when js-js-switch-tabs + (push + '(js> ((cl-fifth hitab) "selectedTab") (cl-fourth hitab)) + cmds))) - ;; Highlighting whole window - ((third hitab) - (push '(js! ((third hitab) "document" - "documentElement" "setAttribute") - "style" - (concat "-moz-appearance: none;" - "border: 8px solid red;")) - cmds))) + ;; Highlighting whole window + ((cl-third hitab) + (push '(js! ((cl-third hitab) "document" + "documentElement" "setAttribute") + "style" + (concat "-moz-appearance: none;" + "border: 8px solid red;")) + cmds))) - (cond - ;; Unhighlighting tab - ((fourth unhitab) - (push '(js! ((fourth unhitab) "setAttribute") "style" "") - cmds) - (push '(js! ((third unhitab) "setAttribute") "style" "") - cmds)) + (cond + ;; Unhighlighting tab + ((cl-fourth unhitab) + (push '(js! ((cl-fourth unhitab) "setAttribute") "style" "") + cmds) + (push '(js! ((cl-third unhitab) "setAttribute") "style" "") + cmds)) - ;; Unhighlighting window - ((third unhitab) - (push '(js! ((third unhitab) "document" - "documentElement" "setAttribute") - "style" "") - cmds))) + ;; Unhighlighting window + ((cl-third unhitab) + (push '(js! ((cl-third unhitab) "document" + "documentElement" "setAttribute") + "style" "") + cmds))) - (eval (list 'with-js - (cons 'js-list (nreverse cmds)))))) + (eval (list 'with-js + (cons 'js-list (nreverse cmds)))))) - (command-hook - () - (let* ((tab (find-tab-by-cname (car ido-matches)))) - (mogrify-highlighting tab prev-hitab) - (setq prev-hitab tab))) + (command-hook + () + (let* ((tab (find-tab-by-cname (car ido-matches)))) + (mogrify-highlighting tab prev-hitab) + (setq prev-hitab tab))) - (setup-hook - () - ;; Fiddle with the match list a bit: if our first match - ;; is a tabbrowser window, rotate the match list until - ;; the active tab comes up - (let ((matched-tab (find-tab-by-cname (car ido-matches)))) - (when (and matched-tab - (null (fourth matched-tab)) - (equal "navigator:browser" - (js! ((third matched-tab) - "document" - "documentElement" - "getAttribute") - "windowtype"))) + (setup-hook + () + ;; Fiddle with the match list a bit: if our first match + ;; is a tabbrowser window, rotate the match list until + ;; the active tab comes up + (let ((matched-tab (find-tab-by-cname (car ido-matches)))) + (when (and matched-tab + (null (cl-fourth matched-tab)) + (equal "navigator:browser" + (js! ((cl-third matched-tab) + "document" + "documentElement" + "getAttribute") + "windowtype"))) - (loop with tab-to-match = (js< (third matched-tab) - "gBrowser" - "selectedTab") + (cl-loop with tab-to-match = (js< (cl-third matched-tab) + "gBrowser" + "selectedTab") - for match in ido-matches - for candidate-tab = (find-tab-by-cname match) - if (eq (fourth candidate-tab) tab-to-match) - do (setq ido-cur-list (ido-chop ido-cur-list match)) - and return t))) + for match in ido-matches + for candidate-tab = (find-tab-by-cname match) + if (eq (cl-fourth candidate-tab) tab-to-match) + do (setq ido-cur-list + (ido-chop ido-cur-list match)) + and return t))) - (add-hook 'post-command-hook #'command-hook t t))) + (add-hook 'post-command-hook #'command-hook t t))) (unwind-protect @@ -3078,13 +3085,12 @@ browser, respectively." (add-to-history 'js-read-tab-history selected-tab-cname) - (setq selected-tab (loop for tab in tabs - if (equal (car tab) selected-tab-cname) - return (cdr tab))) + (setq selected-tab (cl-loop for tab in tabs + if (equal (car tab) selected-tab-cname) + return (cdr tab))) - (if (fourth selected-tab) - (cons 'browser (third selected-tab)) - (cons 'window (third selected-tab))))))) + (cons (if (cl-fourth selected-tab) 'browser 'window) + (cl-third selected-tab)))))) (defun js--guess-eval-defun-info (pstate) "Helper function for `js-eval-defun'. @@ -3092,19 +3098,19 @@ Return a list (NAME . CLASSPARTS), where CLASSPARTS is a list of strings making up the class name and NAME is the name of the function part." (cond ((and (= (length pstate) 3) - (eq (js--pitem-type (first pstate)) 'function) - (= (length (js--pitem-name (first pstate))) 1) - (consp (js--pitem-type (second pstate)))) + (eq (js--pitem-type (cl-first pstate)) 'function) + (= (length (js--pitem-name (cl-first pstate))) 1) + (consp (js--pitem-type (cl-second pstate)))) - (append (js--pitem-name (second pstate)) - (list (first (js--pitem-name (first pstate)))))) + (append (js--pitem-name (cl-second pstate)) + (list (cl-first (js--pitem-name (cl-first pstate)))))) ((and (= (length pstate) 2) - (eq (js--pitem-type (first pstate)) 'function)) + (eq (js--pitem-type (cl-first pstate)) 'function)) (append - (butlast (js--pitem-name (first pstate))) - (list (car (last (js--pitem-name (first pstate))))))) + (butlast (js--pitem-name (cl-first pstate))) + (list (car (last (js--pitem-name (cl-first pstate))))))) (t (error "Function not a toplevel defun or class member")))) @@ -3148,19 +3154,21 @@ If one hasn't been set, or if it's stale, prompt for a new one." (with-js (when (or (null js--js-context) (js--js-handle-expired-p (cdr js--js-context)) - (ecase (car js--js-context) - (window (js? (js< (cdr js--js-context) "closed"))) - (browser (not (js? (js< (cdr js--js-context) - "contentDocument")))))) + (pcase (car js--js-context) + (`window (js? (js< (cdr js--js-context) "closed"))) + (`browser (not (js? (js< (cdr js--js-context) + "contentDocument")))) + (x (error "Unmatched case in js--get-js-context: %S" x)))) (setq js--js-context (js--read-tab "Javascript Context: "))) js--js-context)) (defun js--js-content-window (context) (with-js - (ecase (car context) - (window (cdr context)) - (browser (js< (cdr context) - "contentWindow" "wrappedJSObject"))))) + (pcase (car context) + (`window (cdr context)) + (`browser (js< (cdr context) + "contentWindow" "wrappedJSObject")) + (x (error "Unmatched case in js--js-content-window: %S" x))))) (defun js--make-nsilocalfile (path) (with-js @@ -3179,7 +3187,7 @@ If one hasn't been set, or if it's stale, prompt for a new one." (path-uri (js! (io-service "newFileURI") path-file))) (js! (res-prot "setSubstitution") alias path-uri)))) -(defun* js-eval-defun () +(cl-defun js-eval-defun () "Update a Mozilla tab using the JavaScript defun at point." (interactive) @@ -3215,7 +3223,7 @@ If one hasn't been set, or if it's stale, prompt for a new one." (unless (y-or-n-p (format "Send %s to Mozilla? " (mapconcat #'identity defun-info "."))) (message "") ; question message lingers until next command - (return-from js-eval-defun)) + (cl-return-from js-eval-defun)) (delete-overlay overlay))) (setq defun-body (buffer-substring-no-properties begin end)) diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el index ce37fc2c571..b313fd4aee6 100644 --- a/lisp/progmodes/pascal.el +++ b/lisp/progmodes/pascal.el @@ -57,7 +57,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) (defgroup pascal nil "Major mode for editing Pascal source in Emacs." diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index 9df9943cc00..848b92868e7 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -102,7 +102,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) (defvar font-lock-comment-face) (defvar font-lock-doc-face) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index a43dc1eb1d3..132951aedc8 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1,4 +1,4 @@ -;;; python.el --- Python's flying circus support for Emacs -*- coding: utf-8 -*- +;;; python.el --- Python's flying circus support for Emacs ;; Copyright (C) 2003-2012 Free Software Foundation, Inc. @@ -46,13 +46,16 @@ ;; Movement: `beginning-of-defun' and `end-of-defun' functions are ;; properly implemented. There are also specialized -;; `forward-sentence' and `backward-sentence' replacements -;; (`python-nav-forward-sentence', `python-nav-backward-sentence' -;; respectively). Extra functions `python-nav-sentence-start' and -;; `python-nav-sentence-end' are included to move to the beginning and -;; to the end of a sentence while taking care of multiline definitions. -;; `python-nav-jump-to-defun' is provided and allows jumping to a -;; function or class definition quickly in the current buffer. +;; `forward-sentence' and `backward-sentence' replacements called +;; `python-nav-forward-block', `python-nav-backward-block' +;; respectively which navigate between beginning of blocks of code. +;; Extra functions `python-nav-forward-statement', +;; `python-nav-backward-statement', +;; `python-nav-beginning-of-statement', `python-nav-end-of-statement', +;; `python-nav-beginning-of-block' and `python-nav-end-of-block' are +;; included but no bound to any key. At last but not least the +;; specialized `python-nav-forward-sexp-function' allows easy +;; navigation between code blocks. ;; Shell interaction: is provided and allows you to execute easily any ;; block of code of your current buffer in an inferior Python process. @@ -166,10 +169,10 @@ ;; might guessed you should run `python-shell-send-buffer' from time ;; to time to get better results too. -;; imenu: This mode supports imenu. It builds a plain or tree menu -;; depending on the value of `python-imenu-make-tree'. Also you can -;; customize if menu items should include its type using -;; `python-imenu-include-defun-type'. +;; imenu: This mode supports imenu in its most basic form, letting it +;; build the necessary alist via `imenu-default-create-index-function' +;; by having set `imenu-extract-index-name-function' to +;; `python-info-current-defun'. ;; If you used python-mode.el you probably will miss auto-indentation ;; when inserting newlines. To achieve the same behavior you have @@ -227,12 +230,12 @@ (let ((map (make-sparse-keymap))) ;; Movement (substitute-key-definition 'backward-sentence - 'python-nav-backward-sentence + 'python-nav-backward-block map global-map) (substitute-key-definition 'forward-sentence - 'python-nav-forward-sentence + 'python-nav-forward-block map global-map) - (define-key map "\C-c\C-j" 'python-nav-jump-to-defun) + (define-key map "\C-c\C-j" 'imenu) ;; Indent specific (define-key map "\177" 'python-indent-dedent-line-backspace) (define-key map (kbd "") 'python-indent-dedent-line) @@ -273,7 +276,7 @@ :help "Go to end of definition around point"] ["Mark def/class" mark-defun :help "Mark outermost definition around point"] - ["Jump to def/class" python-nav-jump-to-defun + ["Jump to def/class" imenu :help "Jump to a class or function definition"] "--" ("Skeletons") @@ -653,9 +656,7 @@ START is the buffer position where the sexp starts." (while (and (re-search-backward (python-rx block-start) nil t) (or - (python-info-ppss-context 'string) - (python-info-ppss-context 'comment) - (python-info-ppss-context 'paren) + (python-info-ppss-context-type) (python-info-continuation-line-p)))) (when (looking-at (python-rx block-start)) (point-marker))))) @@ -664,7 +665,7 @@ START is the buffer position where the sexp starts." ((setq start (save-excursion (back-to-indentation) (python-util-forward-comment -1) - (python-nav-sentence-start) + (python-nav-beginning-of-statement) (point-marker))) 'after-line) ;; Do not indent @@ -723,13 +724,9 @@ START is the buffer position where the sexp starts." (goto-char (line-end-position)) (while (and (re-search-backward "\\." (line-beginning-position) t) - (or (python-info-ppss-context 'comment) - (python-info-ppss-context 'string) - (python-info-ppss-context 'paren)))) + (python-info-ppss-context-type))) (if (and (looking-at "\\.") - (not (or (python-info-ppss-context 'comment) - (python-info-ppss-context 'string) - (python-info-ppss-context 'paren)))) + (not (python-info-ppss-context-type))) ;; The indentation is the same column of the ;; first matching dot that's not inside a ;; comment, a string or a paren @@ -885,8 +882,7 @@ See `python-indent-line' for details." (defun python-indent-dedent-line () "De-indent current line." (interactive "*") - (when (and (not (or (python-info-ppss-context 'string) - (python-info-ppss-context 'comment))) + (when (and (not (python-info-ppss-comment-or-string-p)) (<= (point-marker) (save-excursion (back-to-indentation) (point-marker))) @@ -977,8 +973,7 @@ With numeric ARG, just insert that many colons. With (when (and (not arg) (eolp) (not (equal ?: (char-after (- (point-marker) 2)))) - (not (or (python-info-ppss-context 'string) - (python-info-ppss-context 'comment)))) + (not (python-info-ppss-comment-or-string-p))) (let ((indentation (current-indentation)) (calculated-indentation (python-indent-calculate-indentation))) (python-info-closing-block-message) @@ -1097,10 +1092,10 @@ Returns nil if point is not in a def or class." (python-info-ppss-context-type)) (forward-line 1))))))) -(defun python-nav-sentence-start () - "Move to start of current sentence." +(defun python-nav-beginning-of-statement () + "Move to start of current statement." (interactive "^") - (while (and (not (back-to-indentation)) + (while (and (or (back-to-indentation) t) (not (bobp)) (when (or (save-excursion @@ -1110,8 +1105,8 @@ Returns nil if point is not in a def or class." (python-info-ppss-context 'paren)) (forward-line -1))))) -(defun python-nav-sentence-end () - "Move to end of current sentence." +(defun python-nav-end-of-statement () + "Move to end of current statement." (interactive "^") (while (and (goto-char (line-end-position)) (not (eobp)) @@ -1121,85 +1116,182 @@ Returns nil if point is not in a def or class." (python-info-ppss-context 'paren)) (forward-line 1))))) -(defun python-nav-backward-sentence (&optional arg) - "Move backward to start of sentence. With ARG, do it arg times. -See `python-nav-forward-sentence' for more information." +(defun python-nav-backward-statement (&optional arg) + "Move backward to previous statement. +With ARG, repeat. See `python-nav-forward-statement'." (interactive "^p") (or arg (setq arg 1)) - (python-nav-forward-sentence (- arg))) + (python-nav-forward-statement (- arg))) -(defun python-nav-forward-sentence (&optional arg) - "Move forward to next end of sentence. With ARG, repeat. -With negative argument, move backward repeatedly to start of sentence." +(defun python-nav-forward-statement (&optional arg) + "Move forward to next statement. +With ARG, repeat. With negative argument, move ARG times +backward to previous statement." (interactive "^p") (or arg (setq arg 1)) (while (> arg 0) + (python-nav-end-of-statement) (python-util-forward-comment) - (python-nav-sentence-end) - (forward-line 1) + (python-nav-beginning-of-statement) (setq arg (1- arg))) (while (< arg 0) - (python-nav-sentence-end) + (python-nav-beginning-of-statement) (python-util-forward-comment -1) - (python-nav-sentence-start) - (forward-line -1) + (python-nav-beginning-of-statement) (setq arg (1+ arg)))) -(defvar python-nav-list-defun-positions-cache nil) -(make-variable-buffer-local 'python-nav-list-defun-positions-cache) +(defun python-nav-beginning-of-block () + "Move to start of current block." + (interactive "^") + (let ((starting-pos (point)) + (block-regexp (python-rx + line-start (* whitespace) block-start))) + (if (progn + (python-nav-beginning-of-statement) + (looking-at (python-rx block-start))) + (point-marker) + ;; Go to first line beginning a statement + (while (and (not (bobp)) + (or (and (python-nav-beginning-of-statement) nil) + (python-info-current-line-comment-p) + (python-info-current-line-empty-p))) + (forward-line -1)) + (let ((block-matching-indent + (- (current-indentation) python-indent-offset))) + (while + (and (python-nav-backward-block) + (> (current-indentation) block-matching-indent))) + (if (and (looking-at (python-rx block-start)) + (= (current-indentation) block-matching-indent)) + (point-marker) + (and (goto-char starting-pos) nil)))))) -(defun python-nav-list-defun-positions (&optional include-type rescan) - "Make an Alist of defun names and point markers for current buffer. -When optional argument INCLUDE-TYPE is non-nil the type is -included the defun name. With optional argument RESCAN the -`python-nav-list-defun-positions-cache' is invalidated and the -list of defun is regenerated again." - (if (and python-nav-list-defun-positions-cache (not rescan)) - python-nav-list-defun-positions-cache - (let ((defs)) - (save-restriction - (widen) - (save-excursion - (goto-char (point-max)) - (while (re-search-backward python-nav-beginning-of-defun-regexp nil t) - (when (and (not (python-info-ppss-context 'string)) - (not (python-info-ppss-context 'comment)) - (not (python-info-ppss-context 'parent))) - (add-to-list - 'defs (cons - (python-info-current-defun include-type) - (point-marker))))) - (setq python-nav-list-defun-positions-cache defs)))))) +(defun python-nav-end-of-block () + "Move to end of current block." + (interactive "^") + (when (python-nav-beginning-of-block) + (let ((block-indentation (current-indentation))) + (python-nav-end-of-statement) + (while (and (forward-line 1) + (not (eobp)) + (or (and (> (current-indentation) block-indentation) + (or (python-nav-end-of-statement) t)) + (python-info-current-line-comment-p) + (python-info-current-line-empty-p)))) + (python-util-forward-comment -1) + (point-marker)))) -(defun python-nav-read-defun (&optional rescan) - "Read a defun name of current buffer and return its point marker. -A cons cell with the form (DEFUN-NAME . POINT-MARKER) is returned -when defun is completed, else nil. With optional argument RESCAN -forces `python-nav-list-defun-positions' to invalidate its -cache." - (let ((defs (python-nav-list-defun-positions nil rescan))) - (minibuffer-with-setup-hook - (lambda () - (setq minibuffer-completion-table (mapcar 'car defs))) - (let ((stringdef - (read-from-minibuffer - "Jump to definition: " nil - minibuffer-local-must-match-map))) - (when (not (string= stringdef "")) - (assoc-string stringdef defs)))))) +(defun python-nav-backward-block (&optional arg) + "Move backward to previous block of code. +With ARG, repeat. See `python-nav-forward-block'." + (interactive "^p") + (or arg (setq arg 1)) + (python-nav-forward-block (- arg))) -(defun python-nav-jump-to-defun (def) - "Jump to the definition of DEF in current file. -Locations are cached; use a `C-u' prefix argument to force a -rescan." - (interactive - (list (python-nav-read-defun current-prefix-arg))) - (when (not (called-interactively-p 'interactive)) - (setq def (assoc-string def (python-nav-list-defun-positions)))) - (let ((def-marker (cdr def))) - (when (markerp def-marker) - (goto-char (marker-position def-marker)) - (back-to-indentation)))) +(defun python-nav-forward-block (&optional arg) + "Move forward to next block of code. +With ARG, repeat. With negative argument, move ARG times +backward to previous block." + (interactive "^p") + (or arg (setq arg 1)) + (let ((block-start-regexp + (python-rx line-start (* whitespace) block-start)) + (starting-pos (point))) + (while (> arg 0) + (python-nav-end-of-statement) + (while (and + (re-search-forward block-start-regexp nil t) + (python-info-ppss-context-type))) + (setq arg (1- arg))) + (while (< arg 0) + (python-nav-beginning-of-statement) + (while (and + (re-search-backward block-start-regexp nil t) + (python-info-ppss-context-type))) + (setq arg (1+ arg))) + (python-nav-beginning-of-statement) + (if (not (looking-at (python-rx block-start))) + (and (goto-char starting-pos) nil) + (and (not (= (point) starting-pos)) (point-marker))))) + +(defun python-nav-forward-sexp-function (&optional arg) + "Move forward across one block of code. +With ARG, do it that many times. Negative arg -N means +move backward N times." + (interactive "^p") + (or arg (setq arg 1)) + (while (> arg 0) + (let ((block-starting-pos + (save-excursion (python-nav-beginning-of-block))) + (block-ending-pos + (save-excursion (python-nav-end-of-block))) + (next-block-starting-pos + (save-excursion (python-nav-forward-block)))) + (cond ((not block-starting-pos) + (python-nav-forward-block)) + ((= (point) block-starting-pos) + (if (or (not next-block-starting-pos) + (< block-ending-pos next-block-starting-pos)) + (python-nav-end-of-block) + (python-nav-forward-block))) + ((= block-ending-pos (point)) + (let ((parent-block-end-pos + (save-excursion + (python-util-forward-comment) + (python-nav-beginning-of-block) + (python-nav-end-of-block)))) + (if (and parent-block-end-pos + (or (not next-block-starting-pos) + (> next-block-starting-pos parent-block-end-pos))) + (goto-char parent-block-end-pos) + (python-nav-forward-block)))) + (t (python-nav-end-of-block)))) + (setq arg (1- arg))) + (while (< arg 0) + (let* ((block-starting-pos + (save-excursion (python-nav-beginning-of-block))) + (block-ending-pos + (save-excursion (python-nav-end-of-block))) + (prev-block-ending-pos + (save-excursion (when (python-nav-backward-block) + (python-nav-end-of-block)))) + (prev-block-parent-ending-pos + (save-excursion + (when prev-block-ending-pos + (goto-char prev-block-ending-pos) + (python-util-forward-comment) + (python-nav-beginning-of-block) + (python-nav-end-of-block))))) + (cond ((not block-ending-pos) + (and (python-nav-backward-block) + (python-nav-end-of-block))) + ((= (point) block-ending-pos) + (let ((candidates)) + (dolist (name + '(prev-block-parent-ending-pos + prev-block-ending-pos + block-ending-pos + block-starting-pos)) + (when (and (symbol-value name) + (< (symbol-value name) (point))) + (add-to-list 'candidates (symbol-value name)))) + (goto-char (apply 'max candidates)))) + ((> (point) block-ending-pos) + (python-nav-end-of-block)) + ((= (point) block-starting-pos) + (if (not (> (point) (or prev-block-ending-pos (point)))) + (python-nav-backward-block) + (goto-char prev-block-ending-pos) + (let ((parent-block-ending-pos + (save-excursion + (python-nav-forward-sexp-function) + (and (not (looking-at (python-rx block-start))) + (point))))) + (when (and parent-block-ending-pos + (> parent-block-ending-pos prev-block-ending-pos)) + (goto-char parent-block-ending-pos))))) + (t (python-nav-beginning-of-block)))) + (setq arg (1+ arg)))) ;;; Shell integration @@ -1600,24 +1692,29 @@ When MSG is non-nil messages the first line of STRING." "Send STRING to PROCESS and inhibit output. When MSG is non-nil messages the first line of STRING. Return the output." - (let* ((output-buffer) + (let* ((output-buffer "") (process (or process (python-shell-get-or-create-process))) (comint-preoutput-filter-functions (append comint-preoutput-filter-functions '(ansi-color-filter-apply (lambda (string) (setq output-buffer (concat output-buffer string)) - ""))))) - (python-shell-send-string string process msg) - (accept-process-output process) - (replace-regexp-in-string - (if (> (length python-shell-prompt-output-regexp) 0) - (format "\n*%s$\\|^%s\\|\n$" - python-shell-prompt-regexp - (or python-shell-prompt-output-regexp "")) - (format "\n*$\\|^%s\\|\n$" - python-shell-prompt-regexp)) - "" output-buffer))) + "")))) + (inhibit-quit t)) + (or + (with-local-quit + (python-shell-send-string string process msg) + (accept-process-output process) + (replace-regexp-in-string + (if (> (length python-shell-prompt-output-regexp) 0) + (format "\n*%s$\\|^%s\\|\n$" + python-shell-prompt-regexp + (or python-shell-prompt-output-regexp "")) + (format "\n*$\\|^%s\\|\n$" + python-shell-prompt-regexp)) + "" output-buffer)) + (with-current-buffer (process-buffer process) + (comint-interrupt-subjob))))) (defun python-shell-internal-send-string (string) "Send STRING to the Internal Python interpreter. @@ -2140,8 +2237,7 @@ the if condition." ;; Only expand in code. :enable-function (lambda () (and - (not (or (python-info-ppss-context 'string) - (python-info-ppss-context 'comment))) + (not (python-info-ppss-comment-or-string-p)) python-skeleton-autoinsert))) (defmacro python-skeleton-define (name doc &rest skel) @@ -2152,7 +2248,8 @@ be added to `python-mode-abbrev-table'." (let* ((name (symbol-name name)) (function-name (intern (concat "python-skeleton-" name)))) `(progn - (define-abbrev python-mode-abbrev-table ,name "" ',function-name) + (define-abbrev python-mode-abbrev-table ,name "" ',function-name + :system t) (setq python-skeleton-available (cons ',function-name python-skeleton-available)) (define-skeleton ,function-name @@ -2377,46 +2474,19 @@ Runs COMMAND, a shell command, as if by `compile'. See (defun python-eldoc--get-doc-at-point (&optional force-input force-process) "Internal implementation to get documentation at point. -If not FORCE-INPUT is passed then what `current-word' returns -will be used. If not FORCE-PROCESS is passed what -`python-shell-get-process' returns is used." +If not FORCE-INPUT is passed then what +`python-info-current-symbol' returns will be used. If not +FORCE-PROCESS is passed what `python-shell-get-process' returns +is used." (let ((process (or force-process (python-shell-get-process)))) (if (not process) - "Eldoc needs an inferior Python process running." - (let* ((current-defun (python-info-current-defun)) - (input (or force-input - (with-syntax-table python-dotty-syntax-table - (if (not current-defun) - (current-word) - (concat current-defun "." (current-word)))))) - (ppss (syntax-ppss)) - (help (when (and - input - (not (string= input (concat current-defun "."))) - (not (or (python-info-ppss-context 'string ppss) - (python-info-ppss-context 'comment ppss)))) - (when (string-match - (concat - (regexp-quote (concat current-defun ".")) - "self\\.") input) - (with-temp-buffer - (insert input) - (goto-char (point-min)) - (forward-word) - (forward-char) - (delete-region - (point-marker) (search-forward "self.")) - (setq input (buffer-substring - (point-min) (point-max))))) - (python-shell-send-string-no-output - (format python-eldoc-string-code input) process)))) - (with-current-buffer (process-buffer process) - (when comint-last-prompt-overlay - (delete-region comint-last-input-end - (overlay-start comint-last-prompt-overlay)))) - (when (and help - (not (string= help "\n"))) - help))))) + (error "Eldoc needs an inferior Python process running") + (let ((input (or force-input + (python-info-current-symbol t)))) + (and input + (python-shell-send-string-no-output + (format python-eldoc-string-code input) + process)))))) (defun python-eldoc-function () "`eldoc-documentation-function' for Python. @@ -2429,130 +2499,16 @@ inferior python process is updated properly." "Get help on SYMBOL using `help'. Interactively, prompt for symbol." (interactive - (let ((symbol (with-syntax-table python-dotty-syntax-table - (current-word))) + (let ((symbol (python-info-current-symbol t)) (enable-recursive-minibuffers t)) (list (read-string (if symbol (format "Describe symbol (default %s): " symbol) "Describe symbol: ") nil nil symbol)))) - (let ((process (python-shell-get-process))) - (if (not process) - (message "Eldoc needs an inferior Python process running.") - (message (python-eldoc--get-doc-at-point symbol process))))) + (message (python-eldoc--get-doc-at-point symbol))) - -;;; Imenu - -(defcustom python-imenu-include-defun-type t - "Non-nil make imenu items to include its type." - :type 'boolean - :group 'python - :safe 'booleanp) - -(defcustom python-imenu-make-tree t - "Non-nil make imenu to build a tree menu. -Set to nil for speed." - :type 'boolean - :group 'python - :safe 'booleanp) - -(defcustom python-imenu-subtree-root-label "" - "Label displayed to navigate to root from a subtree. -It can contain a \"%s\" which will be replaced with the root name." - :type 'string - :group 'python - :safe 'stringp) - -(defvar python-imenu-index-alist nil - "Calculated index tree for imenu.") - -(defun python-imenu-tree-assoc (keylist tree) - "Using KEYLIST traverse TREE." - (if keylist - (python-imenu-tree-assoc (cdr keylist) - (ignore-errors (assoc (car keylist) tree))) - tree)) - -(defun python-imenu-make-element-tree (element-list full-element plain-index) - "Make a tree from plain alist of module names. -ELEMENT-LIST is the defun name split by \".\" and FULL-ELEMENT -is the same thing, the difference is that FULL-ELEMENT remains -untouched in all recursive calls. -Argument PLAIN-INDEX is the calculated plain index used to build the tree." - (when (not (python-imenu-tree-assoc full-element python-imenu-index-alist)) - (when element-list - (let* ((subelement-point (cdr (assoc - (mapconcat #'identity full-element ".") - plain-index))) - (subelement-name (car element-list)) - (subelement-position (python-util-position - subelement-name full-element)) - (subelement-path (when subelement-position - (butlast - full-element - (- (length full-element) - subelement-position))))) - (let ((path-ref (python-imenu-tree-assoc subelement-path - python-imenu-index-alist))) - (if (not path-ref) - (push (cons subelement-name subelement-point) - python-imenu-index-alist) - (when (not (listp (cdr path-ref))) - ;; Modify root cdr to be a list. - (setcdr path-ref - (list (cons (format python-imenu-subtree-root-label - (car path-ref)) - (cdr (assoc - (mapconcat #'identity - subelement-path ".") - plain-index)))))) - (when (not (assoc subelement-name path-ref)) - (push (cons subelement-name subelement-point) (cdr path-ref)))))) - (python-imenu-make-element-tree (cdr element-list) - full-element plain-index)))) - -(defun python-imenu-make-tree (index) - "Build the imenu alist tree from plain INDEX. - -The idea of this function is that given the alist: - - '((\"Test\" . 100) - (\"Test.__init__\" . 200) - (\"Test.some_method\" . 300) - (\"Test.some_method.another\" . 400) - (\"Test.something_else\" . 500) - (\"test\" . 600) - (\"test.reprint\" . 700) - (\"test.reprint\" . 800)) - -This tree gets built: - - '((\"Test\" . ((\"jump to...\" . 100) - (\"__init__\" . 200) - (\"some_method\" . ((\"jump to...\" . 300) - (\"another\" . 400))) - (\"something_else\" . 500))) - (\"test\" . ((\"jump to...\" . 600) - (\"reprint\" . 700) - (\"reprint\" . 800)))) - -Internally it uses `python-imenu-make-element-tree' to create all -branches for each element." - (setq python-imenu-index-alist nil) - (mapc (lambda (element) - (python-imenu-make-element-tree element element index)) - (mapcar (lambda (element) - (split-string (car element) "\\." t)) index)) - python-imenu-index-alist) - -(defun python-imenu-create-index () - "`imenu-create-index-function' for Python." - (let ((index - (python-nav-list-defun-positions python-imenu-include-defun-type))) - (if python-imenu-make-tree - (python-imenu-make-tree index) - index))) +(add-to-list 'debug-ignored-errors + "^Eldoc needs an inferior Python process running.") ;;; Misc helpers @@ -2564,18 +2520,27 @@ This function is compatible to be used as `add-log-current-defun-function' since it returns nil if point is not inside a defun." (let ((names '()) - (min-indent) + (starting-indentation) + (starting-point) (first-run t)) (save-restriction (widen) (save-excursion + (setq starting-point (point-marker)) + (setq starting-indentation (save-excursion + (python-nav-beginning-of-statement) + (current-indentation))) (end-of-line 1) - (setq min-indent (current-indentation)) (while (python-beginning-of-defun-function 1) - (when (or (< (current-indentation) min-indent) - first-run) + (when (or (< (current-indentation) starting-indentation) + (and first-run + (< + starting-point + (save-excursion + (python-end-of-defun-function) + (point-marker))))) (setq first-run nil) - (setq min-indent (current-indentation)) + (setq starting-indentation (current-indentation)) (looking-at python-nav-beginning-of-defun-regexp) (setq names (cons (if (not include-type) @@ -2587,6 +2552,36 @@ not inside a defun." (when names (mapconcat (lambda (string) string) names ".")))) +(defun python-info-current-symbol (&optional replace-self) + "Return current symbol using dotty syntax. +With optional argument REPLACE-SELF convert \"self\" to current +parent defun name." + (let ((name + (and (not (python-info-ppss-comment-or-string-p)) + (with-syntax-table python-dotty-syntax-table + (let ((sym (symbol-at-point))) + (and sym + (substring-no-properties (symbol-name sym)))))))) + (when name + (if (not replace-self) + name + (let ((current-defun (python-info-current-defun))) + (if (not current-defun) + name + (replace-regexp-in-string + (python-rx line-start word-start "self" word-end ?.) + (concat + (mapconcat 'identity + (butlast (split-string current-defun "\\.")) + ".") ".") + name))))))) + +(defsubst python-info-beginning-of-block-statement-p () + "Return non-nil if current statement opens a block." + (save-excursion + (python-nav-beginning-of-statement) + (looking-at (python-rx block-start)))) + (defun python-info-closing-block () "Return the point of the block the current line closes." (let ((closing-word (save-excursion @@ -2678,24 +2673,20 @@ where the continued line ends." (cond ((equal context-type 'paren) ;; Lines inside a paren are always a continuation line ;; (except the first one). - (when (equal (python-info-ppss-context-type) 'paren) - (python-util-forward-comment -1) - (python-util-forward-comment -1) - (point-marker))) - ((or (equal context-type 'comment) - (equal context-type 'string)) + (python-util-forward-comment -1) + (point-marker)) + ((member context-type '(string comment)) ;; move forward an roll again (goto-char context-start) (python-util-forward-comment) (python-info-continuation-line-p)) (t - ;; Not within a paren, string or comment, the only way we are - ;; dealing with a continuation line is that previous line - ;; contains a backslash, and this can only be the previous line - ;; from current + ;; Not within a paren, string or comment, the only way + ;; we are dealing with a continuation line is that + ;; previous line contains a backslash, and this can + ;; only be the previous line from current (back-to-indentation) (python-util-forward-comment -1) - (python-util-forward-comment -1) (when (and (equal (1- line-start) (line-number-at-pos)) (python-info-line-ends-backslash-p)) (point-marker)))))))) @@ -2723,40 +2714,37 @@ operator." assignment-operator not-simple-operator) (line-end-position) t) - (not (or (python-info-ppss-context 'string) - (python-info-ppss-context 'paren) - (python-info-ppss-context 'comment))))) + (not (python-info-ppss-context-type)))) (skip-syntax-forward "\s") (point-marker))))) (defun python-info-ppss-context (type &optional syntax-ppss) "Return non-nil if point is on TYPE using SYNTAX-PPSS. -TYPE can be 'comment, 'string or 'paren. It returns the start +TYPE can be `comment', `string' or `paren'. It returns the start character address of the specified TYPE." (let ((ppss (or syntax-ppss (syntax-ppss)))) (case type - ('comment + (comment (and (nth 4 ppss) (nth 8 ppss))) - ('string - (nth 8 ppss)) - ('paren + (string + (and (not (nth 4 ppss)) + (nth 8 ppss))) + (paren (nth 1 ppss)) (t nil)))) (defun python-info-ppss-context-type (&optional syntax-ppss) "Return the context type using SYNTAX-PPSS. -The type returned can be 'comment, 'string or 'paren." +The type returned can be `comment', `string' or `paren'." (let ((ppss (or syntax-ppss (syntax-ppss)))) (cond - ((and (nth 4 ppss) - (nth 8 ppss)) - 'comment) - ((nth 8 ppss) - 'string) - ((nth 1 ppss) - 'paren) - (t nil)))) + ((nth 8 ppss) (if (nth 4 ppss) 'comment 'string)) + ((nth 1 ppss) 'paren)))) + +(defsubst python-info-ppss-comment-or-string-p () + "Return non-nil if point is inside 'comment or 'string." + (nth 8 (syntax-ppss))) (defun python-info-looking-at-beginning-of-defun (&optional syntax-ppss) "Check if point is at `beginning-of-defun' using SYNTAX-PPSS." @@ -2765,6 +2753,20 @@ The type returned can be 'comment, 'string or 'paren." (beginning-of-line 1) (looking-at python-nav-beginning-of-defun-regexp)))) +(defun python-info-current-line-comment-p () + "Check if current line is a comment line." + (char-equal (or (char-after (+ (point) (current-indentation))) ?_) ?#)) + +(defun python-info-current-line-empty-p () + "Check if current line is empty, ignoring whitespace." + (save-excursion + (beginning-of-line 1) + (looking-at + (python-rx line-start (* whitespace) + (group (* not-newline)) + (* whitespace) line-end)) + (string-equal "" (match-string-no-properties 1)))) + ;;; Utility functions @@ -2817,6 +2819,9 @@ if that value is non-nil." (set (make-local-variable 'parse-sexp-lookup-properties) t) (set (make-local-variable 'parse-sexp-ignore-comments) t) + (set (make-local-variable 'forward-sexp-function) + 'python-nav-forward-sexp-function) + (set (make-local-variable 'font-lock-defaults) '(python-font-lock-keywords nil nil nil nil)) @@ -2842,7 +2847,8 @@ if that value is non-nil." (add-hook 'post-self-insert-hook 'python-indent-post-self-insert-function nil 'local) - (setq imenu-create-index-function #'python-imenu-create-index) + (set (make-local-variable 'imenu-extract-index-name-function) + #'python-info-current-defun) (set (make-local-variable 'add-log-current-defun-function) #'python-info-current-defun) @@ -2880,4 +2886,10 @@ if that value is non-nil." (provide 'python) + +;; Local Variables: +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + ;;; python.el ends here diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 5d79437c3c2..091a7b74df2 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -594,7 +594,7 @@ and `\\' when preceded by `?'." (goto-char pnt)) ((looking-at ":\\(['\"]\\)") (goto-char (match-beginning 1)) - (ruby-forward-string (buffer-substring (match-beginning 1) (match-end 1)) end)) + (ruby-forward-string (match-string 1) end t)) ((looking-at ":\\([-,.+*/%&|^~<>]=?\\|===?\\|<=>\\|![~=]?\\)") (goto-char (match-end 0))) ((looking-at ":\\([a-zA-Z_][a-zA-Z_0-9]*[!?=]?\\)?") diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index a07ecfcb3a4..a713539cd8e 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -198,7 +198,7 @@ (eval-when-compile (require 'skeleton) - (require 'cl) + (require 'cl-lib) (require 'comint)) (require 'executable) @@ -327,8 +327,15 @@ shell it really is." (defcustom sh-imenu-generic-expression `((sh . ((nil - "^\\s-*\\(function\\s-+\\)?\\([[:alpha:]_][[:alnum:]_]+\\)\\s-*()" - 2)))) + ;; function FOO + ;; function FOO() + "^\\s-*function\\s-+\\\([[:alpha:]_][[:alnum:]_]+\\)\\s-*\\(?:()\\)?" + 1) + ;; FOO() + (nil + "^\\s-*\\([[:alpha:]_][[:alnum:]_]+\\)\\s-*()" + 1) + ))) "Alist of regular expressions for recognizing shell function definitions. See `sh-feature' and `imenu-generic-expression'." :type '(alist :key-type (symbol :tag "Shell") @@ -987,31 +994,31 @@ subshells can nest." (while (and state (progn (skip-chars-forward "^'\\\\\"`$()" limit) (< (point) limit))) ;; unescape " inside a $( ... ) construct. - (case (char-after) - (?\' (case state - (double-quote nil) - (t (forward-char 1) (skip-chars-forward "^'" limit)))) + (pcase (char-after) + (?\' (pcase state + (`double-quote nil) + (_ (forward-char 1) (skip-chars-forward "^'" limit)))) (?\\ (forward-char 1)) - (?\" (case state - (double-quote (setq state (pop states))) - (t (push state states) (setq state 'double-quote))) + (?\" (pcase state + (`double-quote (setq state (pop states))) + (_ (push state states) (setq state 'double-quote))) (if state (put-text-property (point) (1+ (point)) 'syntax-table '(1)))) - (?\` (case state - (backquote (setq state (pop states))) - (t (push state states) (setq state 'backquote)))) + (?\` (pcase state + (`backquote (setq state (pop states))) + (_ (push state states) (setq state 'backquote)))) (?\$ (if (not (eq (char-after (1+ (point))) ?\()) nil (forward-char 1) - (case state - (t (push state states) (setq state 'code))))) - (?\( (case state - (double-quote nil) - (t (push state states) (setq state 'code)))) - (?\) (case state - (double-quote nil) - (t (setq state (pop states))))) - (t (error "Internal error in sh-font-lock-quoted-subshell"))) + (pcase state + (_ (push state states) (setq state 'code))))) + (?\( (pcase state + (`double-quote nil) + (_ (push state states) (setq state 'code)))) + (?\) (pcase state + (`double-quote nil) + (_ (setq state (pop states))))) + (_ (error "Internal error in sh-font-lock-quoted-subshell"))) (forward-char 1))))) @@ -1087,7 +1094,7 @@ subshells can nest." ;; metacharacters. The list of special chars is taken from ;; the single-unix spec of the shell command language (under ;; `quoting') but with `$' removed. - ("[^|&;<>()`\\\"' \t\n]\\(#+\\)" (1 "_")) + ("\\(?:[^|&;<>()`\\\"' \t\n]\\|\\${\\)\\(#+\\)" (1 "_")) ;; In a '...' the backslash is not escaping. ("\\(\\\\\\)'" (1 (sh-font-lock-backslash-quote))) ;; Make sure $@ and $? are correctly recognized as sexps. @@ -1096,16 +1103,15 @@ subshells can nest." (")" (0 (sh-font-lock-paren (match-beginning 0)))) ;; Highlight (possibly nested) subshells inside "" quoted ;; regions correctly. - ("\"\\(?:\\(?:[^\\\"]\\|\\)*?[^\\]\\(?:\\\\\\\\\\)*\\)??\\(\\$(\\|`\\)" + ("\"\\(?:\\(?:[^\\\"]\\|\\\\.\\)*?\\)??\\(\\$(\\|`\\)" (1 (ignore - ;; Save excursion because we want to also apply other - ;; syntax-propertize rules within the affected region. - (if (nth 8 (syntax-ppss)) + (if (nth 8 (save-excursion (syntax-ppss (match-beginning 0)))) (goto-char (1+ (match-beginning 0))) + ;; Save excursion because we want to also apply other + ;; syntax-propertize rules within the affected region. (save-excursion (sh-font-lock-quoted-subshell end))))))) (point) end)) - (defun sh-font-lock-syntactic-face-function (state) (let ((q (nth 3 state))) (if q @@ -1649,7 +1655,7 @@ Does not preserve point." (cond ((zerop (length prev)) (if newline - (progn (assert words) (setq res 'word)) + (progn (cl-assert words) (setq res 'word)) (setq words t) (condition-case nil (forward-sexp -1) @@ -1661,7 +1667,7 @@ Does not preserve point." ((assoc prev smie-grammar) (setq res 'word)) (t (if newline - (progn (assert words) (setq res 'word)) + (progn (cl-assert words) (setq res 'word)) (setq words t))))) (eq res 'keyword))) diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 56f42e31cf1..030cc02f3f4 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -2856,7 +2856,7 @@ appended to the SQLi buffer without disturbing your SQL buffer." (defun sql-get-login-ext (symbol prompt history-var plist) "Prompt user with extended login parameters. -The global value of SYMBOL is the last value and the global value +The global value of SYMBOL is the last value and the global value of the SYMBOL is set based on the user's input. If PLIST is nil, then the user is simply prompted for a string @@ -2871,7 +2871,7 @@ regexp pattern specified in its value. The `:completion' property prompts for a string specified by its value. (The property value is used as the PREDICATE argument to `completing-read'.)" - (set-default + (set-default symbol (let* ((default (plist-get plist :default)) (last-value (default-value symbol)) @@ -4146,10 +4146,12 @@ PRODUCT is the SQL product. PARAMS is a list of strings which are passed as command line arguments." (let ((program (sql-get-product-feature product :sqli-program)) (buf-name "SQL")) - ;; make sure we can find the program - (unless (executable-find program) + ;; Make sure we can find the program. `executable-find' does not + ;; work for remote hosts; we suppress the check there. + (unless (or (file-remote-p default-directory) + (executable-find program)) (error "Unable to locate SQL program \'%s\'" program)) - ;; Make sure buffer name is unique + ;; Make sure buffer name is unique. (when (sql-buffer-live-p (format "*%s*" buf-name)) (setq buf-name (format "SQL-%s" product)) (when (sql-buffer-live-p (format "*%s*" buf-name)) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 5177bc6d9f5..607ccd8b7e7 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -102,7 +102,7 @@ ;; VHDL Mode distribution. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Acknowledgements +;; Acknowledgments ;; Electrification ideas by Bob Pack ;; and Steve Grout. @@ -4499,7 +4499,7 @@ Usage: (mra) architecture is selected. If another architecture is desired, it can be marked as most-recently-analyzed (speedbar menu) before generating the configuration. - + Note: Configurations of subcomponents (i.e. hierarchical configuration declarations) are currently not considered when displaying configurations in speedbar. @@ -6979,7 +6979,7 @@ is not moved." (save-excursion (goto-char new) (eq new (progn (back-to-indentation) (point))))) - (setq placeholder new))) + (setq placeholder new))) (vhdl-add-syntax 'statement-cont placeholder) (if begin-after-ip (vhdl-add-syntax 'block-open))) diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index d5c8a1c6792..02948b35fe0 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -144,12 +144,13 @@ Zero means compute the Imenu menu regardless of size." (:propertize which-func-current local-map ,which-func-keymap face which-func - ;;mouse-face highlight ; currently not evaluated :-( + mouse-face mode-line-highlight help-echo "mouse-1: go to beginning\n\ mouse-2: toggle rest visibility\n\ mouse-3: go to end") "]") "Format for displaying the function in the mode line." + :version "24.2" ; added mouse-face :group 'which-func :type 'sexp) ;;;###autoload (put 'which-func-format 'risky-local-variable t) diff --git a/lisp/ps-samp.el b/lisp/ps-samp.el index f719b087277..5e7fbb2ca9a 100644 --- a/lisp/ps-samp.el +++ b/lisp/ps-samp.el @@ -251,8 +251,6 @@ ;; * CUPS has enabled the option "Share published printers connected ;; to this system" (see ). -(eval-when-compile - (require 'cl)) (require 'printing) (require 'zeroconf) diff --git a/lisp/rect.el b/lisp/rect.el index 574d96a8c10..1bf7364e20d 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -29,16 +29,6 @@ ;; ### NOTE: this file was almost completely rewritten by Didier Verna ;; in July 1999. -;;; Global key bindings - -;;;###autoload (define-key ctl-x-r-map "c" 'clear-rectangle) -;;;###autoload (define-key ctl-x-r-map "k" 'kill-rectangle) -;;;###autoload (define-key ctl-x-r-map "d" 'delete-rectangle) -;;;###autoload (define-key ctl-x-r-map "y" 'yank-rectangle) -;;;###autoload (define-key ctl-x-r-map "o" 'open-rectangle) -;;;###autoload (define-key ctl-x-r-map "t" 'string-rectangle) -;;;###autoload (define-key ctl-x-r-map "N" 'rectangle-number-lines) - ;;; Code: ;; FIXME: this function should be replaced by `apply-on-rectangle' @@ -235,6 +225,13 @@ even beep.)" (barf-if-buffer-read-only) (signal 'text-read-only (list (current-buffer))))))) +;;;###autoload +(defun copy-rectangle-as-kill (start end) + "Copy the region-rectangle and save it as the last killed one." + (interactive "r") + (setq killed-rectangle (extract-rectangle start end)) + (setq deactivate-mark t)) + ;;;###autoload (defun yank-rectangle () "Yank the last killed rectangle with upper left corner at point." diff --git a/lisp/register.el b/lisp/register.el index 44f15e4a69c..52c236e49be 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -28,31 +28,15 @@ ;; pieces of buffer state to named variables. The entry points are ;; documented in the Emacs user's manual. -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (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)) -;;; Global key bindings - -(define-key ctl-x-r-map "\C-@" 'point-to-register) -(define-key ctl-x-r-map [?\C-\ ] 'point-to-register) -(define-key ctl-x-r-map " " 'point-to-register) -(define-key ctl-x-r-map "j" 'jump-to-register) -(define-key ctl-x-r-map "s" 'copy-to-register) -(define-key ctl-x-r-map "x" 'copy-to-register) -(define-key ctl-x-r-map "i" 'insert-register) -(define-key ctl-x-r-map "g" 'insert-register) -(define-key ctl-x-r-map "r" 'copy-rectangle-to-register) -(define-key ctl-x-r-map "n" 'number-to-register) -(define-key ctl-x-r-map "+" 'increment-register) -(define-key ctl-x-r-map "w" 'window-configuration-to-register) -(define-key ctl-x-r-map "f" 'frame-configuration-to-register) - ;;; Code: -(defstruct +(cl-defstruct (registerv (:constructor nil) (:constructor registerv--make (&optional data print-func jump-func insert-func)) @@ -64,7 +48,7 @@ (jump-func nil :read-only t) (insert-func nil :read-only t)) -(defun* registerv-make (data &key print-func jump-func insert-func) +(cl-defun registerv-make (data &key print-func jump-func insert-func) "Create a register value object. DATA can be any value. @@ -150,7 +134,7 @@ delete any existing frames that the frame configuration doesn't mention. (let ((val (get-register register))) (cond ((registerv-p val) - (assert (registerv-jump-func val) nil + (cl-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))) @@ -325,7 +309,7 @@ Interactively, second arg is non-nil if prefix arg is supplied." (let ((val (get-register register))) (cond ((registerv-p val) - (assert (registerv-insert-func val) nil + (cl-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))) diff --git a/lisp/replace.el b/lisp/replace.el index ad87d474b8b..5baf68224c4 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -763,48 +763,47 @@ a previously found match." (defvar occur-menu-map (let ((map (make-sparse-keymap))) - (define-key map [next-error-follow-minor-mode] - `(menu-item ,(purecopy "Auto Occurrence Display") + (bindings--define-key map [next-error-follow-minor-mode] + '(menu-item "Auto Occurrence Display" next-error-follow-minor-mode - :help ,(purecopy - "Display another occurrence when moving the cursor") + :help "Display another occurrence when moving the cursor" :button (:toggle . (and (boundp 'next-error-follow-minor-mode) next-error-follow-minor-mode)))) - (define-key map [separator-1] menu-bar-separator) - (define-key map [kill-this-buffer] - `(menu-item ,(purecopy "Kill Occur Buffer") kill-this-buffer - :help ,(purecopy "Kill the current *Occur* buffer"))) - (define-key map [quit-window] - `(menu-item ,(purecopy "Quit Occur Window") quit-window - :help ,(purecopy "Quit the current *Occur* buffer. Bury it, and maybe delete the selected frame"))) - (define-key map [revert-buffer] - `(menu-item ,(purecopy "Revert Occur Buffer") revert-buffer - :help ,(purecopy "Replace the text in the *Occur* buffer with the results of rerunning occur"))) - (define-key map [clone-buffer] - `(menu-item ,(purecopy "Clone Occur Buffer") clone-buffer - :help ,(purecopy "Create and return a twin copy of the current *Occur* buffer"))) - (define-key map [occur-rename-buffer] - `(menu-item ,(purecopy "Rename Occur Buffer") occur-rename-buffer - :help ,(purecopy "Rename the current *Occur* buffer to *Occur: original-buffer-name*."))) - (define-key map [occur-edit-buffer] - `(menu-item ,(purecopy "Edit Occur Buffer") occur-edit-mode - :help ,(purecopy "Edit the *Occur* buffer and apply changes to the original buffers."))) - (define-key map [separator-2] menu-bar-separator) - (define-key map [occur-mode-goto-occurrence-other-window] - `(menu-item ,(purecopy "Go To Occurrence Other Window") occur-mode-goto-occurrence-other-window - :help ,(purecopy "Go to the occurrence the current line describes, in another window"))) - (define-key map [occur-mode-goto-occurrence] - `(menu-item ,(purecopy "Go To Occurrence") occur-mode-goto-occurrence - :help ,(purecopy "Go to the occurrence the current line describes"))) - (define-key map [occur-mode-display-occurrence] - `(menu-item ,(purecopy "Display Occurrence") occur-mode-display-occurrence - :help ,(purecopy "Display in another window the occurrence the current line describes"))) - (define-key map [occur-next] - `(menu-item ,(purecopy "Move to Next Match") occur-next - :help ,(purecopy "Move to the Nth (default 1) next match in an Occur mode buffer"))) - (define-key map [occur-prev] - `(menu-item ,(purecopy "Move to Previous Match") occur-prev - :help ,(purecopy "Move to the Nth (default 1) previous match in an Occur mode buffer"))) + (bindings--define-key map [separator-1] menu-bar-separator) + (bindings--define-key map [kill-this-buffer] + '(menu-item "Kill Occur Buffer" kill-this-buffer + :help "Kill the current *Occur* buffer")) + (bindings--define-key map [quit-window] + '(menu-item "Quit Occur Window" quit-window + :help "Quit the current *Occur* buffer. Bury it, and maybe delete the selected frame")) + (bindings--define-key map [revert-buffer] + '(menu-item "Revert Occur Buffer" revert-buffer + :help "Replace the text in the *Occur* buffer with the results of rerunning occur")) + (bindings--define-key map [clone-buffer] + '(menu-item "Clone Occur Buffer" clone-buffer + :help "Create and return a twin copy of the current *Occur* buffer")) + (bindings--define-key map [occur-rename-buffer] + '(menu-item "Rename Occur Buffer" occur-rename-buffer + :help "Rename the current *Occur* buffer to *Occur: original-buffer-name*.")) + (bindings--define-key map [occur-edit-buffer] + '(menu-item "Edit Occur Buffer" occur-edit-mode + :help "Edit the *Occur* buffer and apply changes to the original buffers.")) + (bindings--define-key map [separator-2] menu-bar-separator) + (bindings--define-key map [occur-mode-goto-occurrence-other-window] + '(menu-item "Go To Occurrence Other Window" occur-mode-goto-occurrence-other-window + :help "Go to the occurrence the current line describes, in another window")) + (bindings--define-key map [occur-mode-goto-occurrence] + '(menu-item "Go To Occurrence" occur-mode-goto-occurrence + :help "Go to the occurrence the current line describes")) + (bindings--define-key map [occur-mode-display-occurrence] + '(menu-item "Display Occurrence" occur-mode-display-occurrence + :help "Display in another window the occurrence the current line describes")) + (bindings--define-key map [occur-next] + '(menu-item "Move to Next Match" occur-next + :help "Move to the Nth (default 1) next match in an Occur mode buffer")) + (bindings--define-key map [occur-prev] + '(menu-item "Move to Previous Match" occur-prev + :help "Move to the Nth (default 1) previous match in an Occur mode buffer")) map) "Menu keymap for `occur-mode'.") @@ -822,7 +821,7 @@ a previously found match." (define-key map "r" 'occur-rename-buffer) (define-key map "c" 'clone-buffer) (define-key map "\C-c\C-f" 'next-error-follow-minor-mode) - (define-key map [menu-bar occur] (cons (purecopy "Occur") occur-menu-map)) + (bindings--define-key map [menu-bar occur] (cons "Occur" occur-menu-map)) map) "Keymap for `occur-mode'.") @@ -870,7 +869,7 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. (define-key map "\C-c\C-c" 'occur-cease-edit) (define-key map "\C-o" 'occur-mode-display-occurrence) (define-key map "\C-c\C-f" 'next-error-follow-minor-mode) - (define-key map [menu-bar occur] (cons (purecopy "Occur") occur-menu-map)) + (bindings--define-key map [menu-bar occur] (cons "Occur" occur-menu-map)) map) "Keymap for `occur-edit-mode'.") diff --git a/lisp/savehist.el b/lisp/savehist.el index a65906a1676..6310190b4fe 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -278,6 +278,13 @@ If AUTO-SAVE is non-nil, compare the saved contents to the one last saved, (print-level nil) (print-readably t) (print-quoted t)) + ;; During the 24.2 development, read-passwd had a bug which resulted in + ;; the passwords being saved by savehist. Trim them, retroactively. + ;; This code can be removed after the 24.2 release. + (dolist (sym savehist-minibuffer-history-variables) + (if (and (symbolp sym) (equal (symbol-name sym) "forget-history")) + (setq savehist-minibuffer-history-variables + (delq sym savehist-minibuffer-history-variables)))) ;; Save the minibuffer histories, along with the value of ;; savehist-minibuffer-history-variables itself. (when savehist-save-minibuffer-history diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el index 058d83a97bc..0d693c52c81 100644 --- a/lisp/scroll-bar.el +++ b/lisp/scroll-bar.el @@ -29,7 +29,7 @@ ;;; Code: (require 'mouse) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;;;; Utilities. @@ -112,8 +112,9 @@ Setting the variable with a customization buffer also takes effect." ;; If it is set again, that is for real. (setq scroll-bar-mode-explicit t) -(defun get-scroll-bar-mode () scroll-bar-mode) -(defsetf get-scroll-bar-mode set-scroll-bar-mode) +(defun get-scroll-bar-mode () + (declare (gv-setter set-scroll-bar-mode)) + scroll-bar-mode) (define-minor-mode scroll-bar-mode "Toggle vertical scroll bars on all frames (Scroll Bar mode). @@ -123,9 +124,10 @@ the mode if ARG is omitted or nil. This command applies to all frames that exist and frames to be created in the future." - :variable (eq (get-scroll-bar-mode) - (or previous-scroll-bar-mode - default-frame-scroll-bars))) + :variable ((get-scroll-bar-mode) + . (lambda (v) (set-scroll-bar-mode + (if v (or previous-scroll-bar-mode + default-frame-scroll-bars)))))) (defun toggle-scroll-bar (arg) "Toggle whether or not the selected frame has vertical scroll bars. diff --git a/lisp/server.el b/lisp/server.el index 1e2f458ac9c..a25da406571 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -81,7 +81,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defgroup server nil "Emacs running as a server process." @@ -478,11 +478,11 @@ If CLIENT is non-nil, add a description of it to the logged message." See `server-quote-arg' and `server-process-filter'." (replace-regexp-in-string "&." (lambda (s) - (case (aref s 1) + (pcase (aref s 1) (?& "&") (?- "-") (?n "\n") - (t " "))) + (_ " "))) arg t t)) (defun server-quote-arg (arg) @@ -493,7 +493,7 @@ contains a space. See `server-unquote-arg' and `server-process-filter'." (replace-regexp-in-string "[-&\n ]" (lambda (s) - (case (aref s 0) + (pcase (aref s 0) (?& "&&") (?- "&-") (?\n "&n") @@ -514,7 +514,7 @@ Creates the directory if necessary and makes sure: (setq dir (directory-file-name dir)) (let ((attrs (file-attributes dir 'integer))) (unless attrs - (letf (((default-file-modes) ?\700)) (make-directory dir t)) + (cl-letf (((default-file-modes) ?\700)) (make-directory dir t)) (setq attrs (file-attributes dir 'integer))) ;; Check that it's safe for use. @@ -550,9 +550,9 @@ The key is a 64-byte string of random chars in the range `!'..`~'. If called interactively, also inserts it into current buffer." (interactive) (let ((auth-key - (loop repeat 64 - collect (+ 33 (random 94)) into auth - finally return (concat auth)))) + (cl-loop repeat 64 + collect (+ 33 (random 94)) into auth + finally return (concat auth)))) (if (called-interactively-p 'interactive) (insert auth-key)) auth-key)) @@ -632,11 +632,13 @@ server or call `M-x server-force-delete' to forcibly disconnect it.") (server-ensure-safe-dir server-dir) (when server-process (server-log (message "Restarting server"))) - (letf (((default-file-modes) ?\700)) + (cl-letf (((default-file-modes) ?\700)) (add-hook 'suspend-tty-functions 'server-handle-suspend-tty) (add-hook 'delete-frame-functions 'server-handle-delete-frame) - (add-hook 'kill-buffer-query-functions 'server-kill-buffer-query-function) - (add-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function) + (add-hook 'kill-buffer-query-functions + 'server-kill-buffer-query-function) + (add-hook 'kill-emacs-query-functions + 'server-kill-emacs-query-function) (add-hook 'kill-emacs-hook 'server-force-stop) ;Cleanup upon exit. (setq server-process (apply #'make-network-process @@ -886,7 +888,7 @@ This handles splitting the command if it would be bigger than (process-put proc 'continuation nil) (if continuation (ignore-errors (funcall continuation))))) -(defun* server-process-filter (proc string) +(cl-defun server-process-filter (proc string) "Process a request from the server to edit some files. PROC is the server process. STRING consists of a sequence of commands prefixed by a dash. Some commands have arguments; @@ -1001,8 +1003,8 @@ The following commands are accepted by the client: ;; receive the error string and shut down on its own. (sit-for 1) (delete-process proc) - ;; We return immediately - (return-from server-process-filter))) + ;; We return immediately. + (cl-return-from server-process-filter))) (let ((prev (process-get proc 'previous-string))) (when prev (setq string (concat prev string)) @@ -1021,7 +1023,7 @@ The following commands are accepted by the client: ;; In earlier versions of server.el (where we used an `emacsserver' ;; process), there could be multiple lines. Nowadays this is not ;; supported any more. - (assert (eq (match-end 0) (length string))) + (cl-assert (eq (match-end 0) (length string))) (let ((request (substring string 0 (match-beginning 0))) (coding-system (and (default-value 'enable-multibyte-characters) (or file-name-coding-system @@ -1164,7 +1166,8 @@ The following commands are accepted by the client: (setq dir (pop args-left)) (if coding-system (setq dir (decode-coding-string dir coding-system))) - (setq dir (command-line-normalize-file-name dir))) + (setq dir (command-line-normalize-file-name dir)) + (process-put proc 'server-client-directory dir)) ;; Unknown command. (arg (error "Unknown command: %s" arg)))) diff --git a/lisp/ses.el b/lisp/ses.el index a6a6aa91b5c..8add16a6996 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -56,7 +56,7 @@ ;;; Code: (require 'unsafep) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;;---------------------------------------------------------------------------- @@ -362,6 +362,10 @@ when to emit a progress message.") "From a CELL or a pair (ROW,COL), get the function that computes its value." `(aref ,(if col `(ses-get-cell ,row ,col) row) 1)) +(defmacro ses-cell-formula-aset (cell formula) + "From a CELL set the function that computes its value." + `(aset ,cell 1 ,formula)) + (defmacro ses-cell-printer (row &optional col) "From a CELL or a pair (ROW,COL), get the function that prints its value." `(aref ,(if col `(ses-get-cell ,row ,col) row) 2)) @@ -371,6 +375,19 @@ when to emit a progress message.") functions refer to its value." `(aref ,(if col `(ses-get-cell ,row ,col) row) 3)) +(defmacro ses-cell-references-aset (cell references) + "From a CELL set the list REFERENCES of symbols for cells the +function of which refer to its value." + `(aset ,cell 3 ,references)) + +(defun ses-cell-p (cell) + "Return non `nil' is CELL is a cell of current buffer." + (and (vectorp cell) + (= (length cell) 5) + (eq cell (let ((rowcol (ses-sym-rowcol (ses-cell-symbol cell)))) + (and (consp rowcol) + (ses-get-cell (car rowcol) (cdr rowcol))))))) + (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 @@ -1520,7 +1537,7 @@ if the range was altered." (funcall field (ses-sym-rowcol min)))) ;; This range has changed size. (setq ses-relocate-return 'range)) - `(ses-range ,min ,max ,@(cdddr range))))) + `(ses-range ,min ,max ,@(cl-cdddr range))))) (defun ses-relocate-all (minrow mincol rowincr colincr) "Alter all cell values, symbols, formulas, and reference-lists to relocate @@ -3193,39 +3210,52 @@ highlighted range in the spreadsheet." (setq formula (cdr formula)))) new-formula)) -(defun ses-rename-cell (new-name) +(defun ses-rename-cell (new-name &optional cell) "Rename current cell." (interactive "*SEnter new name: ") - (ses-check-curcell) - (or - (and (local-variable-p new-name) - (ses-sym-rowcol new-name) - ;; this test is needed because ses-cell property of deleted cells - ;; is not deleted in case of subsequent undo - (memq new-name ses--renamed-cell-symb-list) - (error "Already a cell name")) - (and (boundp new-name) - (null (yes-or-no-p (format "`%S' is already bound outside this buffer, continue? " - new-name))) - (error "Already a bound cell name"))) - (let* ((rowcol (ses-sym-rowcol ses--curcell)) - (cell (ses-get-cell (car rowcol) (cdr rowcol)))) + (and (local-variable-p new-name) + (ses-sym-rowcol new-name) + ;; this test is needed because ses-cell property of deleted cells + ;; is not deleted in case of subsequent undo + (memq new-name ses--renamed-cell-symb-list) + (error "Already a cell name")) + (and (boundp new-name) + (null (yes-or-no-p (format "`%S' is already bound outside this buffer, continue? " + new-name))) + (error "Already a bound cell name")) + (let* ((sym (if (ses-cell-p cell) + (ses-cell-symbol cell) + (setq cell nil) + (ses-check-curcell) + ses--curcell)) + (rowcol (ses-sym-rowcol sym)) + (row (car rowcol)) + (col (cdr rowcol))) + (setq cell (or cell (ses-get-cell row col))) + (push `(ses-rename-cell ,(ses-cell-symbol cell) ,cell) buffer-undo-list) (put new-name 'ses-cell rowcol) - (dolist (reference (ses-cell-references (car rowcol) (cdr rowcol))) - (let* ((rowcol (ses-sym-rowcol reference)) - (cell (ses-get-cell (car rowcol) (cdr rowcol)))) - (ses-cell-set-formula (car rowcol) - (cdr rowcol) - (ses-replace-name-in-formula - (ses-cell-formula cell) - ses--curcell - new-name)))) + ;; replace name by new name in formula of cells refering to renamed cell + (dolist (ref (ses-cell-references cell)) + (let* ((x (ses-sym-rowcol ref)) + (xcell (ses-get-cell (car x) (cdr x)))) + (ses-cell-formula-aset xcell + (ses-replace-name-in-formula + (ses-cell-formula xcell) + sym + new-name)))) + ;; replace name by new name in reference list of cells to which renamed cell refers to + (dolist (ref (ses-formula-references (ses-cell-formula cell))) + (let* ((x (ses-sym-rowcol ref)) + (xcell (ses-get-cell (car x) (cdr x)))) + (ses-cell-references-aset xcell + (cons new-name (delq sym + (ses-cell-references xcell)))))) (push new-name ses--renamed-cell-symb-list) - (set new-name (symbol-value ses--curcell)) + (set new-name (symbol-value sym)) (aset cell 0 new-name) - (put ses--curcell 'ses-cell nil) - (makunbound ses--curcell) - (setq ses--curcell new-name) + (put sym 'ses-cell nil) + (makunbound sym) + (setq sym new-name) (let* ((pos (point)) (inhibit-read-only t) (col (current-column)) @@ -3234,7 +3264,11 @@ highlighted range in the spreadsheet." (if (eolp) (+ pos (ses-col-width col) 1) (point))))) - (put-text-property pos end 'intangible new-name))) ) + (put-text-property pos end 'intangible new-name)) + ;; update mode line + (setq mode-line-process (list " cell " + (symbol-name sym))) + (force-mode-line-update))) ;;---------------------------------------------------------------------------- ;; Checking formulas for safety @@ -3345,19 +3379,20 @@ Use `math-format-value' as a printer for Calc objects." (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)) - (()(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 + (pcase 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)) + (` (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)) + ((or `* `*2 `*1) (setq vectorize x)) + (`! (setq clean 'ses--clean-!)) + (`_ (setq clean `(lambda (&rest x) + (ses--clean-_ x ,(if rest (pop rest) 0))))) + (_ (cond ; shorthands one row ((and (null (cddr result)) (memq x '(> <))) @@ -3380,21 +3415,23 @@ Use `math-format-value' as a printer for Calc objects." (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))))))) + (cl-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))))) + (pcase vectorize + (`nil (cons clean (apply 'append result))) + (`*1 (vectorize-*1 clean result)) + (`*2 (vectorize-*2 clean result)) + (`* (funcall (if (cdr result) + #'vectorize-*2 + #'vectorize-*1) + clean result)))))) (defun ses-delete-blanks (&rest args) "Return ARGS reversed, with the blank elements (nil and *skip*) removed." diff --git a/lisp/shell.el b/lisp/shell.el index ca238a443f3..b98efceefbf 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -96,7 +96,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) (require 'comint) (require 'pcomplete) @@ -1243,7 +1242,7 @@ Returns non-nil if successful." (variables (mapcar (lambda (x) (substring x 0 (string-match "=" x))) process-environment)) - (suffix (case (char-before start) (?\{ "}") (?\( ")") (t "")))) + (suffix (pcase (char-before start) (?\{ "}") (?\( ")") (_ "")))) (list start end variables :exit-function (lambda (s finished) diff --git a/lisp/simple.el b/lisp/simple.el index 655298e4fea..3240ede0299 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -28,8 +28,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) ;For define-minor-mode. - (declare-function widget-convert "wid-edit" (type &rest args)) (declare-function shell-mode "shell" ()) @@ -988,7 +986,11 @@ END, without printing any message." ((use-region-p) (call-interactively 'count-words-region)) (t - (count-words--message "Buffer" (point-min) (point-max))))) + (count-words--message + (if (= (point-max) (1+ (buffer-size))) + "Buffer" + "Narrowed part of buffer") + (point-min) (point-max))))) (defun count-words--message (str start end) (let ((lines (count-lines start end)) @@ -2249,9 +2251,11 @@ to `shell-command-history'." (defun async-shell-command (command &optional output-buffer error-buffer) "Execute string COMMAND asynchronously in background. -Like `shell-command' but if COMMAND doesn't end in ampersand, adds `&' -surrounded by whitespace and executes the command asynchronously. +Like `shell-command', but adds `&' at the end of COMMAND +to execute it asynchronously. + The output appears in the buffer `*Async Shell Command*'. +That buffer is in shell mode. In Elisp, you will often be better served by calling `start-process' directly, since it offers more control and does not impose the use of a @@ -2259,8 +2263,12 @@ shell (with its need to quote arguments)." (interactive (list (read-shell-command "Async shell command: " nil nil - (and buffer-file-name - (file-relative-name buffer-file-name))) + (let ((filename + (cond + (buffer-file-name) + ((eq major-mode 'dired-mode) + (dired-get-filename nil t))))) + (and filename (file-relative-name filename)))) current-prefix-arg shell-command-default-error-buffer)) (unless (string-match "&[ \t]*\\'" command) @@ -2271,9 +2279,10 @@ shell (with its need to quote arguments)." "Execute string COMMAND in inferior shell; display output, if any. With prefix argument, insert the COMMAND's output at point. -If COMMAND ends in ampersand, execute it asynchronously. +If COMMAND ends in `&', execute it asynchronously. The output appears in the buffer `*Async Shell Command*'. -That buffer is in shell mode. +That buffer is in shell mode. You can also use +`async-shell-command' that automatically adds `&'. Otherwise, COMMAND is executed synchronously. The output appears in the buffer `*Shell Command Output*'. If the output is short enough to @@ -3044,41 +3053,43 @@ be copied into other buffers." (defvar interprogram-cut-function nil "Function to call to make a killed region available to other programs. +Most window systems provide a facility for cutting and pasting +text between different programs, such as the clipboard on X and +MS-Windows, or the pasteboard on Nextstep/Mac OS. -Most window systems provide some sort of facility for cutting and -pasting text between the windows of different programs. -This variable holds a function that Emacs calls whenever text -is put in the kill ring, to make the new kill available to other -programs. - -The function takes one argument, TEXT, which is a string containing -the text which should be made available.") +This variable holds a function that Emacs calls whenever text is +put in the kill ring, to make the new kill available to other +programs. The function takes one argument, TEXT, which is a +string containing the text which should be made available.") (defvar interprogram-paste-function nil "Function to call to get text cut from other programs. +Most window systems provide a facility for cutting and pasting +text between different programs, such as the clipboard on X and +MS-Windows, or the pasteboard on Nextstep/Mac OS. -Most window systems provide some sort of facility for cutting and -pasting text between the windows of different programs. -This variable holds a function that Emacs calls to obtain -text that other programs have provided for pasting. +This variable holds a function that Emacs calls to obtain text +that other programs have provided for pasting. The function is +called with no arguments. If no other program has provided text +to paste, the function should return nil (in which case the +caller, usually `current-kill', should use the top of the Emacs +kill ring). If another program has provided text to paste, the +function should return that text as a string (in which case the +caller should put this string in the kill ring as the latest +kill). -The function should be called with no arguments. If the function -returns nil, then no other program has provided such text, and the top -of the Emacs kill ring should be used. If the function returns a -string, then the caller of the function \(usually `current-kill') -should put this string in the kill ring as the latest kill. - -This function may also return a list of strings if the window +The function may also return a list of strings if the window system supports multiple selections. The first string will be -used as the pasted text, but the other will be placed in the -kill ring for easy access via `yank-pop'. +used as the pasted text, but the other will be placed in the kill +ring for easy access via `yank-pop'. -Note that the function should return a string only if a program other -than Emacs has provided a string for pasting; if Emacs provided the -most recent string, the function should return nil. If it is -difficult to tell whether Emacs or some other program provided the -current string, it is probably good enough to return nil if the string -is equal (according to `string=') to the last text Emacs provided.") +Note that the function should return a string only if a program +other than Emacs has provided a string for pasting; if Emacs +provided the most recent string, the function should return nil. +If it is difficult to tell whether Emacs or some other program +provided the current string, it is probably good enough to return +nil if the string is equal (according to `string=') to the last +text Emacs provided.") @@ -3184,7 +3195,10 @@ If `interprogram-cut-function' is set, pass the resulting kill to it." (set-advertised-calling-convention 'kill-append '(string before-p) "23.3") (defcustom yank-pop-change-selection nil - "If non-nil, rotating the kill ring changes the window system selection." + "Whether rotating the kill ring changes the window system selection. +If non-nil, whenever the kill ring is rotated (usually via the +`yank-pop' command), Emacs also calls `interprogram-cut-function' +to copy the new kill to the window system selection." :type 'boolean :group 'killing :version "23.1") @@ -3541,7 +3555,7 @@ Goes backward if ARG is negative; error if CHAR not found." ;; kill-line and its subroutines. (defcustom kill-whole-line nil - "If non-nil, `kill-line' with no arg at beg of line kills the whole line." + "If non-nil, `kill-line' with no arg at start of line kills the whole line." :type 'boolean :group 'killing) @@ -3858,7 +3872,11 @@ run `deactivate-mark-hook'." (cond (saved-region-selection (x-set-selection 'PRIMARY saved-region-selection) (setq saved-region-selection nil)) - ((/= (region-beginning) (region-end)) + ;; If another program has acquired the selection, region + ;; deactivation should not clobber it (Bug#11772). + ((and (/= (region-beginning) (region-end)) + (or (x-selection-owner-p 'PRIMARY) + (null (x-selection-exists-p 'PRIMARY)))) (x-set-selection 'PRIMARY (buffer-substring-no-properties (region-beginning) @@ -5425,7 +5443,9 @@ non-`nil'. The value of `normal-auto-fill-function' specifies the function to use for `auto-fill-function' when turning Auto Fill mode on." - :variable (eq auto-fill-function normal-auto-fill-function)) + :variable (auto-fill-function + . (lambda (v) (setq auto-fill-function + (if v normal-auto-fill-function))))) ;; This holds a document string used to document auto-fill-mode. (defun auto-fill-function () @@ -5538,7 +5558,8 @@ the line. Before a tab, such characters insert until the tab is filled in. \\[quoted-insert] still inserts characters in overwrite mode; this is supposed to make it easier to insert characters when necessary." - :variable (eq overwrite-mode 'overwrite-mode-textual)) + :variable (overwrite-mode + . (lambda (v) (setq overwrite-mode (if v 'overwrite-mode-textual))))) (define-minor-mode binary-overwrite-mode "Toggle Binary Overwrite mode. @@ -5557,7 +5578,8 @@ ordinary typing characters do. Note that Binary Overwrite mode is not its own minor mode; it is a specialization of overwrite mode, entered by setting the `overwrite-mode' variable to `overwrite-mode-binary'." - :variable (eq overwrite-mode 'overwrite-mode-binary)) + :variable (overwrite-mode + . (lambda (v) (setq overwrite-mode (if v 'overwrite-mode-binary))))) (define-minor-mode line-number-mode "Toggle line number display in the mode line (Line Number mode). @@ -6343,7 +6365,7 @@ Use \\\\[mouse-choose-completion] to select one\ "Finish setup of the completions buffer. Called from `temp-buffer-show-hook'." (when (eq major-mode 'completion-list-mode) - (toggle-read-only 1))) + (setq buffer-read-only t))) (add-hook 'temp-buffer-show-hook 'completion-list-mode-finish) @@ -6780,8 +6802,10 @@ probably not turn on this mode on a text-only terminal if you don't have both Backspace, Delete and F1 keys. See also `normal-erase-is-backspace'." - :variable (eq (terminal-parameter - nil 'normal-erase-is-backspace) 1) + :variable ((eq (terminal-parameter nil 'normal-erase-is-backspace) 1) + . (lambda (v) + (setf (terminal-parameter nil 'normal-erase-is-backspace) + (if v 1 0)))) (let ((enabled (eq 1 (terminal-parameter nil 'normal-erase-is-backspace)))) diff --git a/lisp/speedbar.el b/lisp/speedbar.el index d8c8c4a56be..16993ce1891 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -1864,9 +1864,7 @@ of the special mode functions." ;; If it is autoloaded, we need to load it now so that ;; we have access to the variable -speedbar-menu-items. ;; Is this XEmacs safe? - (let ((sf (symbol-function v))) - (if (and (listp sf) (eq (car sf) 'autoload)) - (load-library (car (cdr sf))))) + (autoload-do-load (symbol-function v) v) (setq speedbar-special-mode-expansion-list (list v)) (setq v (intern-soft (concat ms "-speedbar-key-map"))) (if (not v) diff --git a/lisp/startup.el b/lisp/startup.el index e71fe323066..348e653dd28 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -123,8 +123,8 @@ altering `command-line-args-left' to remove them.") "Default directory to use for command line arguments. This is normally copied from `default-directory' when Emacs starts.") -;;; This is here, rather than in x-win.el, so that we can ignore these -;;; options when we are not using X. +;; This is here, rather than in x-win.el, so that we can ignore these +;; options when we are not using X. (defconst command-line-x-option-alist '(("-bw" 1 x-handle-numeric-switch border-width) ("-d" 1 x-handle-display) @@ -1001,7 +1001,9 @@ Amongst another things, it parses the command-line arguments." nil (display-warning 'initialization (format "User %s has no home directory" - init-file-user) + (if (equal init-file-user "") + (user-real-login-name) + init-file-user)) :error)))) ;; Load that user's init file, or the default one, or none. @@ -1311,7 +1313,15 @@ If this is nil, no message will be displayed." (title (with-temp-buffer (insert-file-contents (expand-file-name tut tutorial-directory) - nil 0 256) + ;; We used to read only the first 256 bytes of + ;; the tutorial, but that prevents the coding: + ;; setting, if any, in file-local variables + ;; section to be seen by insert-file-contents, + ;; and results in gibberish when the language + ;; environment's preferred encoding is + ;; different from what the file-local variable + ;; says. One case in point is Hebrew. + nil) (search-forward ".") (buffer-substring (point-min) (1- (point)))))) ;; If there is a specific tutorial for the current language diff --git a/lisp/strokes.el b/lisp/strokes.el index 1ae2300559d..302e441d282 100644 --- a/lisp/strokes.el +++ b/lisp/strokes.el @@ -180,7 +180,7 @@ ;;; Requirements and provisions... (autoload 'mail-position-on-field "sendmail") -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;;; Constants... @@ -542,10 +542,10 @@ The return value is a list ((XMIN . YMIN) (XMAX . YMAX))." (defun strokes-eliminate-consecutive-redundancies (entries) "Return a list with no consecutive redundant entries." ;; defun a grande vitesse grace a Dave G. - (loop for element on entries - if (not (equal (car element) (cadr element))) - collect (car element))) -;; (loop for element on entries + (cl-loop for element on entries + if (not (equal (car element) (cadr element))) + collect (car element))) +;; (cl-loop for element on entries ;; nconc (if (not (equal (car el) (cadr el))) ;; (list (car el))))) ;; yet another (orig) way of doing it... @@ -584,68 +584,70 @@ NOTE: This is where the global variable `strokes-last-stroke' is set." (if (and (strokes-click-p unfilled-stroke) (not force)) unfilled-stroke - (loop for grid-locs on unfilled-stroke - nconc (let* ((current (car grid-locs)) - (current-is-a-point-p (consp current)) - (next (cadr grid-locs)) - (next-is-a-point-p (consp next)) - (both-are-points-p (and current-is-a-point-p - next-is-a-point-p)) - (x1 (and current-is-a-point-p - (car current))) - (y1 (and current-is-a-point-p - (cdr current))) - (x2 (and next-is-a-point-p - (car next))) - (y2 (and next-is-a-point-p - (cdr next))) - (delta-x (and both-are-points-p - (- x2 x1))) - (delta-y (and both-are-points-p - (- y2 y1))) - (slope (and both-are-points-p - (if (zerop delta-x) - nil ; undefined vertical slope - (/ (float delta-y) - delta-x))))) - (cond ((not both-are-points-p) - (list current)) - ((null slope) ; undefined vertical slope - (if (>= delta-y 0) - (loop for y from y1 below y2 - collect (cons x1 y)) - (loop for y from y1 above y2 - collect (cons x1 y)))) - ((zerop slope) ; (= y1 y2) - (if (>= delta-x 0) - (loop for x from x1 below x2 - collect (cons x y1)) - (loop for x from x1 above x2 - collect (cons x y1)))) - ((>= (abs delta-x) (abs delta-y)) - (if (> delta-x 0) - (loop for x from x1 below x2 - collect (cons x - (+ y1 - (round (* slope - (- x x1)))))) - (loop for x from x1 above x2 - collect (cons x - (+ y1 - (round (* slope - (- x x1)))))))) - (t ; (< (abs delta-x) (abs delta-y)) - (if (> delta-y 0) - (loop for y from y1 below y2 - collect (cons (+ x1 - (round (/ (- y y1) - slope))) - y)) - (loop for y from y1 above y2 - collect (cons (+ x1 - (round (/ (- y y1) - slope))) - y)))))))))) + (cl-loop + for grid-locs on unfilled-stroke + nconc (let* ((current (car grid-locs)) + (current-is-a-point-p (consp current)) + (next (cadr grid-locs)) + (next-is-a-point-p (consp next)) + (both-are-points-p (and current-is-a-point-p + next-is-a-point-p)) + (x1 (and current-is-a-point-p + (car current))) + (y1 (and current-is-a-point-p + (cdr current))) + (x2 (and next-is-a-point-p + (car next))) + (y2 (and next-is-a-point-p + (cdr next))) + (delta-x (and both-are-points-p + (- x2 x1))) + (delta-y (and both-are-points-p + (- y2 y1))) + (slope (and both-are-points-p + (if (zerop delta-x) + nil ; undefined vertical slope + (/ (float delta-y) + delta-x))))) + (cond ((not both-are-points-p) + (list current)) + ((null slope) ; undefined vertical slope + (if (>= delta-y 0) + (cl-loop for y from y1 below y2 + collect (cons x1 y)) + (cl-loop for y from y1 above y2 + collect (cons x1 y)))) + ((zerop slope) ; (= y1 y2) + (if (>= delta-x 0) + (cl-loop for x from x1 below x2 + collect (cons x y1)) + (cl-loop for x from x1 above x2 + collect (cons x y1)))) + ((>= (abs delta-x) (abs delta-y)) + (if (> delta-x 0) + (cl-loop for x from x1 below x2 + collect (cons x + (+ y1 + (round (* slope + (- x x1)))))) + (cl-loop for x from x1 above x2 + collect (cons x + (+ y1 + (round (* slope + (- x x1)))))))) + (t ; (< (abs delta-x) (abs delta-y)) + (if (> delta-y 0) + ;; FIXME: Reduce redundancy between branches. + (cl-loop for y from y1 below y2 + collect (cons (+ x1 + (round (/ (- y y1) + slope))) + y)) + (cl-loop for y from y1 above y2 + collect (cons (+ x1 + (round (/ (- y y1) + slope))) + y)))))))))) (defun strokes-rate-stroke (stroke1 stroke2) "Rates STROKE1 with STROKE2 and return a score based on a distance metric. @@ -723,9 +725,9 @@ Returns the corresponding match as (COMMAND . SCORE)." (defsubst strokes-fill-current-buffer-with-whitespace () "Erase the contents of the current buffer and fill it with whitespace." (erase-buffer) - (loop repeat (frame-height) do - (insert-char ?\s (1- (frame-width))) - (newline)) + (cl-loop repeat (frame-height) do + (insert-char ?\s (1- (frame-width))) + (newline)) (goto-char (point-min))) ;;;###autoload @@ -1173,40 +1175,40 @@ the stroke as a character in some language." (set-buffer buf) (erase-buffer) (insert strokes-xpm-header) - (loop repeat 33 do - (insert ?\") - (insert-char ?\s 33) - (insert "\",") - (newline) - finally - (forward-line -1) - (end-of-line) - (insert "}\n")) - (loop for point in stroke - for x = (car-safe point) - for y = (cdr-safe point) do - (cond ((consp point) - ;; draw a point, and possibly a starting-point - (if (and lift-flag (not b/w-only)) - ;; mark starting point with the appropriate color - (let ((char (or (car rainbow-chars) ?\.))) - (loop for i from 0 to 2 do - (loop for j from 0 to 2 do - (goto-char (point-min)) - (forward-line (+ 15 i y)) - (forward-char (+ 1 j x)) - (delete-char 1) - (insert char))) - (setq rainbow-chars (cdr rainbow-chars) - lift-flag nil)) - ;; Otherwise, just plot the point... - (goto-char (point-min)) - (forward-line (+ 16 y)) - (forward-char (+ 2 x)) - (subst-char-in-region (point) (1+ (point)) ?\s ?\*))) - ((strokes-lift-p point) - ;; a lift--tell the loop to X out the next point... - (setq lift-flag t)))) + (cl-loop repeat 33 do + (insert ?\") + (insert-char ?\s 33) + (insert "\",") + (newline) + finally + (forward-line -1) + (end-of-line) + (insert "}\n")) + (cl-loop for point in stroke + for x = (car-safe point) + for y = (cdr-safe point) do + (cond ((consp point) + ;; draw a point, and possibly a starting-point + (if (and lift-flag (not b/w-only)) + ;; mark starting point with the appropriate color + (let ((char (or (car rainbow-chars) ?\.))) + (cl-loop for i from 0 to 2 do + (cl-loop for j from 0 to 2 do + (goto-char (point-min)) + (forward-line (+ 15 i y)) + (forward-char (+ 1 j x)) + (delete-char 1) + (insert char))) + (setq rainbow-chars (cdr rainbow-chars) + lift-flag nil)) + ;; Otherwise, just plot the point... + (goto-char (point-min)) + (forward-line (+ 16 y)) + (forward-char (+ 2 x)) + (subst-char-in-region (point) (1+ (point)) ?\s ?\*))) + ((strokes-lift-p point) + ;; a lift--tell the loop to X out the next point... + (setq lift-flag t)))) (when (called-interactively-p 'interactive) (pop-to-buffer " *strokes-xpm*") ;; (xpm-mode 1) @@ -1288,7 +1290,7 @@ the stroke as a character in some language." ;; (insert ;; "Command Stroke\n" ;; "------- ------") -;; (loop for def in strokes-map +;; (cl-loop for def in strokes-map ;; for i from 0 to (1- (length strokes-map)) do ;; (let ((stroke (car def)) ;; (command-name (symbol-name (cdr def)))) @@ -1343,27 +1345,28 @@ If STROKES-MAP is not given, `strokes-global-map' will be used instead." (insert "Command Stroke\n" "------- ------") - (loop for def in strokes-map do - (let ((stroke (car def)) - (command-name (if (symbolp (cdr def)) - (symbol-name (cdr def)) - (prin1-to-string (cdr def))))) - (strokes-xpm-for-stroke stroke " *strokes-xpm*") - (newline 2) - (insert-char ?\s 45) - (beginning-of-line) - (insert command-name) - (beginning-of-line) - (forward-char 45) - (insert-image - (create-image (with-current-buffer " *strokes-xpm*" - (buffer-string)) - 'xpm t - :color-symbols - `(("foreground" - . ,(frame-parameter nil 'foreground-color)))))) - finally do (unless (eobp) - (kill-region (1+ (point)) (point-max)))) + (cl-loop + for def in strokes-map do + (let ((stroke (car def)) + (command-name (if (symbolp (cdr def)) + (symbol-name (cdr def)) + (prin1-to-string (cdr def))))) + (strokes-xpm-for-stroke stroke " *strokes-xpm*") + (newline 2) + (insert-char ?\s 45) + (beginning-of-line) + (insert command-name) + (beginning-of-line) + (forward-char 45) + (insert-image + (create-image (with-current-buffer " *strokes-xpm*" + (buffer-string)) + 'xpm t + :color-symbols + `(("foreground" + . ,(frame-parameter nil 'foreground-color)))))) + finally do (unless (eobp) + (kill-region (1+ (point)) (point-max)))) (view-buffer "*Strokes List*" nil) (set (make-local-variable 'view-mode-map) (let ((map (copy-keymap view-mode-map))) @@ -1588,7 +1591,7 @@ XPM-BUFFER defaults to ` *strokes-xpm*'." ;; yet another of the same bit-type, so we continue ;; counting... (progn - (incf count) + (cl-incf count) (forward-char 1)) ;; otherwise, it's the opposite bit-type, so we do a ;; write and then restart count ### NOTE (for myself @@ -1727,10 +1730,10 @@ Store XPM in buffer BUFNAME if supplied \(default is ` *strokes-xpm*'\)" (delete-char 1) (setq current-char-is-on-p (not current-char-is-on-p))) (goto-char (point-min)) - (loop repeat 33 do - (insert ?\") - (forward-char 33) - (insert "\",\n")) + (cl-loop repeat 33 do + (insert ?\") + (forward-char 33) + (insert "\",\n")) (goto-char (point-min)) (insert strokes-xpm-header)))) diff --git a/lisp/subr.el b/lisp/subr.el index ba9b06d495b..76fec5dd5ac 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -26,6 +26,9 @@ ;;; Code: +;; Beware: while this file has tag `utf-8', before it's compiled, it gets +;; loaded as "raw-text", so non-ASCII chars won't work right during bootstrap. + (defvar custom-declare-variable-list nil "Record `defcustom' calls made before `custom.el' is loaded to handle them. Each element of this list holds the arguments to one call to `defcustom'.") @@ -144,29 +147,33 @@ was called." `(closure (t) (&rest args) (apply ',fun ,@(mapcar (lambda (arg) `',arg) args) args))) -(if (null (featurep 'cl)) - (progn - ;; If we reload subr.el after having loaded CL, be careful not to - ;; overwrite CL's extended definition of `dolist', `dotimes', - ;; `declare', `push' and `pop'. -(defmacro push (newelt listname) - "Add NEWELT to the list stored in the symbol LISTNAME. -This is equivalent to (setq LISTNAME (cons NEWELT LISTNAME)). -LISTNAME must be a symbol." - (declare (debug (form sexp))) - (list 'setq listname - (list 'cons newelt listname))) +(defmacro push (newelt place) + "Add NEWELT to the list stored in the generalized variable PLACE. +This is morally equivalent to (setf PLACE (cons NEWELT PLACE)), +except that PLACE is only evaluated once (after NEWELT)." + (declare (debug (form gv-place))) + (if (symbolp place) + ;; Important special case, to avoid triggering GV too early in + ;; the bootstrap. + (list 'setq place + (list 'cons newelt place)) + (require 'macroexp) + (macroexp-let2 macroexp-copyable-p v newelt + (gv-letplace (getter setter) place + (funcall setter `(cons ,v ,getter)))))) -(defmacro pop (listname) - "Return the first element of LISTNAME's value, and remove it from the list. -LISTNAME must be a symbol whose value is a list. +(defmacro pop (place) + "Return the first element of PLACE's value, and remove it from the list. +PLACE must be a generalized variable whose value is a list. If the value is nil, `pop' returns nil but does not actually change the list." - (declare (debug (sexp))) + (declare (debug (gv-place))) (list 'car - (list 'prog1 listname - (list 'setq listname (list 'cdr listname))))) -)) + (if (symbolp place) + ;; So we can use `pop' in the bootstrap before `gv' can be used. + (list 'prog1 place (list 'setq place (list 'cdr place))) + (gv-letplace (getter setter) place + `(prog1 ,getter ,(funcall setter `(cdr ,getter))))))) (defmacro when (cond &rest body) "If COND yields non-nil, do BODY, else return nil. @@ -189,8 +196,7 @@ value of last one, or nil if there are none. (if (null (featurep 'cl)) (progn ;; If we reload subr.el after having loaded CL, be careful not to - ;; overwrite CL's extended definition of `dolist', `dotimes', - ;; `declare', `push' and `pop'. + ;; overwrite CL's extended definition of `dolist', `dotimes', `declare'. (defmacro dolist (spec &rest body) "Loop over a list. @@ -266,6 +272,7 @@ the return value (nil if RESULT is omitted). "Do not evaluate any arguments and return nil. Treated as a declaration when used at the right place in a `defmacro' form. \(See Info anchor `(elisp)Definition of declare'.)" + ;; FIXME: edebug spec should pay attention to defun-declarations-alist. nil) )) @@ -725,7 +732,7 @@ Subkeymaps may be modified but are not canonicalized." (put 'keyboard-translate-table 'char-table-extra-slots 0) (defun keyboard-translate (from to) - "Translate character FROM to TO at a low level. + "Translate character FROM to TO on the current terminal. This function creates a `keyboard-translate-table' if necessary and then modifies one entry in it." (or (char-table-p keyboard-translate-table) @@ -902,17 +909,9 @@ The normal global definition of the character C-x indirects to this keymap.") (defsubst eventp (obj) "True if the argument is an event object." - (or (and (integerp obj) - ;; FIXME: Why bother? - ;; Filter out integers too large to be events. - ;; M is the biggest modifier. - (zerop (logand obj (lognot (1- (lsh ?\M-\^@ 1))))) - (characterp (event-basic-type obj))) - (and (symbolp obj) - (get obj 'event-symbol-elements)) - (and (consp obj) - (symbolp (car obj)) - (get (car obj) 'event-symbol-elements)))) + (or (integerp obj) + (and (symbolp obj) obj (not (keywordp obj))) + (and (consp obj) (symbolp (car obj))))) (defun event-modifiers (event) "Return a list of symbols representing the modifier keys in event EVENT. @@ -1185,6 +1184,7 @@ is converted into a string by expressing it in decimal." (set-advertised-calling-convention 'all-completions '(string collection &optional predicate) "23.1") (set-advertised-calling-convention 'unintern '(name obarray) "23.3") +(set-advertised-calling-convention 'redirect-frame-focus '(frame focus-frame) "24.2") ;;;; Obsolescence declarations for variables, and aliases. @@ -1264,16 +1264,6 @@ to reread, so it now uses nil to mean `no event', instead of -1." (make-obsolete-variable 'translation-table-for-input nil "23.1") (defvaralias 'messages-buffer-max-lines 'message-log-max) - -;; These aliases exist in Emacs 19.34, and probably before, but were -;; only marked as obsolete in 23.1. -;; The lisp manual (since at least Emacs 21) describes them as -;; existing "for compatibility with Emacs version 18". -(define-obsolete-variable-alias 'last-input-char 'last-input-event - "at least 19.34") -(define-obsolete-variable-alias 'last-command-char 'last-command-event - "at least 19.34") - ;;;; Alternate names for functions - these are not being phased out. @@ -1701,6 +1691,23 @@ If TOGGLE has a `:menu-tag', that is used for the menu item's label." ;;; Load history +(defsubst autoloadp (object) + "Non-nil if OBJECT is an autoload." + (eq 'autoload (car-safe object))) + +;; (defun autoload-type (object) +;; "Returns the type of OBJECT or `function' or `command' if the type is nil. +;; OBJECT should be an autoload object." +;; (when (autoloadp object) +;; (let ((type (nth 3 object))) +;; (cond ((null type) (if (nth 2 object) 'command 'function)) +;; ((eq 'keymap t) 'macro) +;; (type))))) + +;; (defalias 'autoload-file #'cadr +;; "Return the name of the file from which AUTOLOAD will be loaded. +;; \n\(fn AUTOLOAD)") + (defun symbol-file (symbol &optional type) "Return the name of the file that defined SYMBOL. The value is normally an absolute file name. It can also be nil, @@ -1713,7 +1720,7 @@ TYPE is `defun', `defvar', or `defface', that specifies function definition, variable definition, or face definition only." (if (and (or (null type) (eq type 'defun)) (symbolp symbol) (fboundp symbol) - (eq 'autoload (car-safe (symbol-function symbol)))) + (autoloadp (symbol-function symbol))) (nth 1 (symbol-function symbol)) (let ((files load-history) file) @@ -2165,11 +2172,7 @@ by doing (clear-string STRING)." (set (make-local-variable 'post-self-insert-hook) nil) (add-hook 'after-change-functions hide-chars-fun nil 'local)) (unwind-protect - (read-string prompt nil - (let ((sym (make-symbol "forget-history"))) - (set sym nil) - sym) - default) + (read-string prompt nil t default) ; t = "no history" (when (buffer-live-p minibuf) (with-current-buffer minibuf ;; Not sure why but it seems that there might be cases where the @@ -2766,6 +2769,20 @@ computing the hash. If BINARY is non-nil, return a string in binary form." (secure-hash 'sha1 object start end binary)) +(defun function-get (f prop &optional autoload) + "Return the value of property PROP of function F. +If AUTOLOAD is non-nil and F is an autoloaded macro, try to autoload +the macro in the hope that it will set PROP." + (let ((val nil)) + (while (and (symbolp f) + (null (setq val (get f prop))) + (fboundp f)) + (let ((fundef (symbol-function f))) + (if (and autoload (autoloadp fundef) + (not (equal fundef (autoload-do-load fundef f 'macro)))) + nil ;Re-try `get' on the same `f'. + (setq f fundef)))) + val)) ;;;; Support for yanking and text properties. diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 82329677643..0e818e0be14 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -97,7 +97,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defgroup tar nil "Simple editing of tar files." @@ -168,7 +168,7 @@ This information is useful, but it takes screen space away from file names." ;; state correctly: the raw data is expected to be always larger than ;; the summary. (progn - (assert (or (= (buffer-size tar-data-buffer) (buffer-size)) + (cl-assert (or (= (buffer-size tar-data-buffer) (buffer-size)) (eq tar-data-swapped (> (buffer-size tar-data-buffer) (buffer-size))))) tar-data-swapped))) @@ -186,7 +186,7 @@ Preserve the modified states of the buffers and set `buffer-swapped-with'." ;;; down to business. -(defstruct (tar-header +(cl-defstruct (tar-header (:constructor nil) (:type vector) :named @@ -226,8 +226,8 @@ Preserve the modified states of the buffers and set `buffer-swapped-with'." This is a list of name, mode, uid, gid, size, write-date, checksum, link-type, and link-name." (if (> (+ pos 512) (point-max)) (error "Malformed Tar header")) - (assert (zerop (mod (- pos (point-min)) 512))) - (assert (not enable-multibyte-characters)) + (cl-assert (zerop (mod (- pos (point-min)) 512))) + (cl-assert (not enable-multibyte-characters)) (let ((string (buffer-substring pos (setq pos (+ pos 512))))) (when ;(some 'plusp string) ; <-- oops, massive cycle hog! (or (not (= 0 (aref string 0))) ; This will do. @@ -373,7 +373,7 @@ write-date, checksum, link-type, and link-name." (defun tar-header-block-checksum (string) "Compute and return a tar-acceptable checksum for this block." - (assert (not (multibyte-string-p string))) + (cl-assert (not (multibyte-string-p string))) (let* ((chk-field-start tar-chk-offset) (chk-field-end (+ chk-field-start 8)) (sum 0) @@ -486,7 +486,7 @@ MODE should be an integer which is a file mode value." (defun tar-summarize-buffer () "Parse the contents of the tar file in the current buffer." - (assert (tar-data-swapped-p)) + (cl-assert (tar-data-swapped-p)) (let* ((modified (buffer-modified-p)) (result '()) (pos (point-min)) @@ -654,7 +654,7 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. (widen) ;; Now move the Tar data into an auxiliary buffer, so we can use the main ;; buffer for the summary. - (assert (not (tar-data-swapped-p))) + (cl-assert (not (tar-data-swapped-p))) (set (make-local-variable 'revert-buffer-function) 'tar-mode-revert) ;; We started using write-contents-functions, but this hook is not ;; used during auto-save, so we now use @@ -1119,15 +1119,15 @@ for this to be permanent." (insert (tar-header-block-summarize descriptor) "\n"))) (forward-line -1) (move-to-column col)) - (assert (tar-data-swapped-p)) + (cl-assert (tar-data-swapped-p)) (with-current-buffer tar-data-buffer (let* ((start (- (tar-header-data-start descriptor) 512))) ;; ;; delete the old field and insert a new one. (goto-char (+ start data-position)) (delete-region (point) (+ (point) (length new-data-string))) ; <-- - (assert (not (or enable-multibyte-characters - (multibyte-string-p new-data-string)))) + (cl-assert (not (or enable-multibyte-characters + (multibyte-string-p new-data-string)))) (insert new-data-string) ;; ;; compute a new checksum and insert it. diff --git a/lisp/term.el b/lisp/term.el index 06bdd21a409..014adb610b4 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -108,11 +108,6 @@ ;; ;; Blink, is not supported. Currently it's mapped as bold. ;; -;; Important caveat: -;; ----------------- -;; if you want custom colors in term.el redefine term-default-fg-color -;; and term-default-bg-color BEFORE loading it. -;; ;; ---------------------------------------- ;; ;; If you'd like to check out my complete configuration, you can download @@ -398,9 +393,7 @@ ;; so it is important to increase it if there are protocol-relevant changes. (defconst term-protocol-version "0.96") -(eval-when-compile - (require 'ange-ftp) - (require 'cl)) +(eval-when-compile (require 'ange-ftp)) (require 'ring) (require 'ehelp) @@ -459,7 +452,7 @@ state 4: term-terminal-parameter contains pending output.") "A queue of strings whose echo we want suppressed.") (defvar term-terminal-parameter) (defvar term-terminal-previous-parameter) -(defvar term-current-face 'default) +(defvar term-current-face 'term-face) (defvar term-scroll-start 0 "Top-most line (inclusive) of scrolling region.") (defvar term-scroll-end) ; Number of line (zero-based) after scrolling region. (defvar term-pager-count nil @@ -795,28 +788,87 @@ Buffer local variable.") (defvar term-terminal-previous-parameter-3 -1) (defvar term-terminal-previous-parameter-4 -1) -;;; faces -mm - -(defcustom term-default-fg-color - ;; FIXME: This depends on the current frame, so depending on when - ;; it's loaded, the result may be different. - (face-foreground term-current-face) - "Default color for foreground in `term'." - :group 'term - :type 'string) - -(defcustom term-default-bg-color - ;; FIXME: This depends on the current frame, so depending on when - ;; it's loaded, the result may be different. - (face-background term-current-face) - "Default color for background in `term'." - :group 'term - :type 'string) - -;; Use the same colors that xterm uses, see `xterm-standard-colors'. +;;; Faces (defvar ansi-term-color-vector - [unspecified "black" "red3" "green3" "yellow3" "blue2" - "magenta3" "cyan3" "white"]) + [term-face + term-color-black + term-color-red + term-color-green + term-color-yellow + term-color-blue + term-color-magenta + term-color-cyan + term-color-white]) + +(defcustom term-default-fg-color nil + "If non-nil, default color for foreground in Term mode. +This is deprecated in favor of customizing the `term-face' face." + :group 'term + :type 'string) + +(defcustom term-default-bg-color nil + "If non-nil, default color for foreground in Term mode. +This is deprecated in favor of customizing the `term-face' face." + :group 'term + :type 'string) + +(defface term-face + `((t + :foreground ,term-default-fg-color + :background ,term-default-bg-color + :inherit default)) + "Default face to use in Term mode." + :group 'term) + +(defface term-bold + '((t :bold t)) + "Default face to use for bold text." + :group 'term) + +(defface term-underline + '((t :underline t)) + "Default face to use for underlined text." + :group 'term) + +(defface term-color-black + '((t :foreground "black" :background "black")) + "Face used to render black color code." + :group 'term) + +(defface term-color-red + '((t :foreground "red3" :background "red3")) + "Face used to render red color code." + :group 'term) + +(defface term-color-green + '((t :foreground "green3" :background "green3")) + "Face used to render green color code." + :group 'term) + +(defface term-color-yellow + '((t :foreground "yellow3" :background "yellow3")) + "Face used to render yellow color code." + :group 'term) + +(defface term-color-blue + '((t :foreground "blue2" :background "blue2")) + "Face used to render blue color code." + :group 'term) + +(defface term-color-magenta + '((t :foreground "magenta3" :background "magenta3")) + "Face used to render magenta color code." + :group 'term) + +(defface term-color-cyan + '((t :foreground "cyan3" :background "cyan3")) + "Face used to render cyan color code." + :group 'term) + +(defface term-color-white + '((t :foreground "white" :background "white")) + "Face used to render white color code." + :group 'term) ;; Inspiration came from comint.el -mm (defcustom term-buffer-maximum-size 2048 @@ -919,11 +971,12 @@ is buffer-local." (defvar overflow-newline-into-fringe) (defun term-window-width () - (if (featurep 'xemacs) - (1- (window-width)) - (if (and window-system overflow-newline-into-fringe) - (window-width) - (1- (window-width))))) + (if (and (not (featurep 'xemacs)) + (display-graphic-p) + overflow-newline-into-fringe + (/= (frame-parameter nil 'right-fringe) 0)) + (window-width) + (1- (window-width)))) (put 'term-mode 'mode-class 'special) @@ -950,11 +1003,7 @@ is buffer-local." dt)) (defun term-ansi-reset () - (setq term-current-face (nconc - (if term-default-bg-color - (list :background term-default-bg-color)) - (if term-default-fg-color - (list :foreground term-default-fg-color)))) + (setq term-current-face 'term-face) (setq term-ansi-current-underline nil) (setq term-ansi-current-bold nil) (setq term-ansi-current-reverse nil) @@ -963,7 +1012,7 @@ is buffer-local." (setq term-ansi-face-already-done t) (setq term-ansi-current-bg-color 0)) -(defun term-mode () +(define-derived-mode term-mode fundamental-mode "Term" "Major mode for interacting with an inferior interpreter. The interpreter name is same as buffer name, sans the asterisks. @@ -1007,56 +1056,38 @@ Commands in line mode: \\{term-mode-map} Entry to this mode runs the hooks on `term-mode-hook'." - (interactive) - ;; Do not remove this. All major modes must do this. - (kill-all-local-variables) - (setq major-mode 'term-mode) - (setq mode-name "Term") - (use-local-map term-mode-map) ;; we do not want indent to sneak in any tabs (setq indent-tabs-mode nil) (setq buffer-display-table term-display-table) - (make-local-variable 'term-home-marker) - (setq term-home-marker (copy-marker 0)) + (set (make-local-variable 'term-home-marker) (copy-marker 0)) + (set (make-local-variable 'term-height) (1- (window-height))) + (set (make-local-variable 'term-width) (term-window-width)) + (set (make-local-variable 'term-last-input-start) (make-marker)) + (set (make-local-variable 'term-last-input-end) (make-marker)) + (set (make-local-variable 'term-last-input-match) "") + (set (make-local-variable 'term-command-hook) + (symbol-function 'term-command-hook)) + + ;; These local variables are set to their local values: (make-local-variable 'term-saved-home-marker) - (make-local-variable 'term-height) - (make-local-variable 'term-width) - (setq term-width (term-window-width)) - (setq term-height (1- (window-height))) (make-local-variable 'term-terminal-parameter) (make-local-variable 'term-saved-cursor) - (make-local-variable 'term-last-input-start) - (setq term-last-input-start (make-marker)) - (make-local-variable 'term-last-input-end) - (setq term-last-input-end (make-marker)) - (make-local-variable 'term-last-input-match) - (setq term-last-input-match "") - (make-local-variable 'term-prompt-regexp) ; Don't set; default - (make-local-variable 'term-input-ring-size) ; ...to global val. + (make-local-variable 'term-prompt-regexp) + (make-local-variable 'term-input-ring-size) (make-local-variable 'term-input-ring) (make-local-variable 'term-input-ring-file-name) - (or (and (boundp 'term-input-ring) term-input-ring) - (setq term-input-ring (make-ring term-input-ring-size))) (make-local-variable 'term-input-ring-index) - (or (and (boundp 'term-input-ring-index) term-input-ring-index) - (setq term-input-ring-index nil)) - - (make-local-variable 'term-command-hook) - (setq term-command-hook (symbol-function 'term-command-hook)) + (unless term-input-ring + (setq term-input-ring (make-ring term-input-ring-size))) ;; I'm not sure these saves are necessary but, since I ;; haven't tested the whole thing on a net connected machine with ;; a properly configured ange-ftp, I've decided to be conservative ;; and put them in. -mm - (make-local-variable 'term-ansi-at-host) - (setq term-ansi-at-host (system-name)) - - (make-local-variable 'term-ansi-at-dir) - (setq term-ansi-at-dir default-directory) - - (make-local-variable 'term-ansi-at-message) - (setq term-ansi-at-message nil) + (set (make-local-variable 'term-ansi-at-host) (system-name)) + (set (make-local-variable 'term-ansi-at-dir) default-directory) + (set (make-local-variable 'term-ansi-at-message) nil) ;; For user tracking purposes -mm (make-local-variable 'ange-ftp-default-user) @@ -1089,8 +1120,7 @@ Entry to this mode runs the hooks on `term-mode-hook'." (make-local-variable 'term-current-row) (make-local-variable 'term-log-buffer) (make-local-variable 'term-scroll-start) - (make-local-variable 'term-scroll-end) - (setq term-scroll-end term-height) + (set (make-local-variable 'term-scroll-end) term-height) (make-local-variable 'term-scroll-with-delete) (make-local-variable 'term-pager-count) (make-local-variable 'term-pager-old-local-map) @@ -1112,15 +1142,15 @@ Entry to this mode runs the hooks on `term-mode-hook'." (make-local-variable 'term-ptyp) (make-local-variable 'term-exec-hook) (make-local-variable 'term-vertical-motion) - (make-local-variable 'term-pending-delete-marker) - (setq term-pending-delete-marker (make-marker)) + (set (make-local-variable 'term-pending-delete-marker) (make-marker)) (make-local-variable 'term-current-face) (term-ansi-reset) - (make-local-variable 'term-pending-frame) - (setq term-pending-frame nil) + (set (make-local-variable 'term-pending-frame) nil) ;; Cua-mode's keybindings interfere with the term keybindings, disable it. (set (make-local-variable 'cua-mode) nil) - (run-mode-hooks 'term-mode-hook) + + (set (make-local-variable 'font-lock-defaults) '(nil t)) + (when (featurep 'xemacs) (set-buffer-menubar (append current-menubar (list term-terminal-menu)))) @@ -1165,9 +1195,9 @@ Entry to this mode runs the hooks on `term-mode-hook'." found)) (defun term-check-size (process) - (when (or (/= term-height (1- (window-height))) + (when (or (/= term-height (window-text-height)) (/= term-width (term-window-width))) - (term-reset-size (1- (window-height)) (term-window-width)) + (term-reset-size (window-text-height) (term-window-width)) (set-process-window-size process term-height term-width))) (defun term-send-raw-string (chars) @@ -1192,21 +1222,21 @@ without any interpretation." (defun term-send-raw-meta () (interactive) (let ((char last-input-event)) - (when (symbolp last-input-event) + (when (symbolp char) ;; Convert `return' to C-m, etc. (let ((tmp (get char 'event-symbol-elements))) - (when tmp - (setq char (car tmp))) - (when (symbolp char) - (setq tmp (get char 'ascii-character)) - (when tmp - (setq char tmp))))) - (setq char (event-basic-type char)) - (term-send-raw-string (if (and (numberp char) - (> char 127) - (< char 256)) - (make-string 1 char) - (format "\e%c" char))))) + (if tmp (setq char (car tmp))) + (and (symbolp char) + (setq tmp (get char 'ascii-character)) + (setq char tmp)))) + (when (numberp char) + (let ((base (event-basic-type char)) + (mods (delq 'meta (event-modifiers char)))) + (if (memq 'control mods) + (setq mods (delq 'shift mods))) + (term-send-raw-string + (format "\e%c" + (event-convert-list (append mods (list base))))))))) (defun term-mouse-paste (click) "Insert the primary selection at the position clicked on." @@ -2603,13 +2633,13 @@ See `term-prompt-regexp'." ;; from the last character on the line, set the face for the chars ;; to default. (when (> (point) point-at-eol) - (put-text-property point-at-eol (point) 'face 'default)))) + (put-text-property point-at-eol (point) 'font-lock-face 'default)))) ;; Insert COUNT copies of CHAR in the default face. (defun term-insert-char (char count) (let ((old-point (point))) (insert-char char count) - (put-text-property old-point (point) 'face 'default))) + (put-text-property old-point (point) 'font-lock-face 'default))) (defun term-current-row () (cond (term-current-row) @@ -2833,7 +2863,7 @@ See `term-prompt-regexp'." (setq term-current-column nil) (put-text-property old-point (point) - 'face term-current-face) + 'font-lock-face term-current-face) ;; If the last char was written in last column, ;; back up one column, but remember we did so. ;; Thus we emulate xterm/vt100-style line-wrapping. @@ -3106,10 +3136,6 @@ See `term-prompt-regexp'." ;; New function to deal with ansi colorized output, as you can see you can ;; have any bold/underline/fg/bg/reverse combination. -mm -(defvar term-bold-attribute '(:weight bold) - "Attribute to use for the bold terminal attribute. -Set it to nil to disable bold.") - (defun term-handle-colors-array (parameter) (cond @@ -3171,46 +3197,32 @@ Set it to nil to disable bold.") ;; term-ansi-current-color ;; term-ansi-current-bg-color) - (unless term-ansi-face-already-done (if term-ansi-current-invisible (let ((color (if term-ansi-current-reverse - (if (= term-ansi-current-color 0) - term-default-fg-color - (elt ansi-term-color-vector term-ansi-current-color)) - (if (= term-ansi-current-bg-color 0) - term-default-bg-color - (elt ansi-term-color-vector term-ansi-current-bg-color))))) + (face-foreground + (elt ansi-term-color-vector term-ansi-current-color)) + (face-background + (elt ansi-term-color-vector term-ansi-current-bg-color))))) (setq term-current-face (list :background color :foreground color)) ) ;; No need to bother with anything else if it's invisible. - (setq term-current-face - (if term-ansi-current-reverse - (if (= term-ansi-current-color 0) - (list :background term-default-fg-color - :foreground term-default-bg-color) - (list :background - (elt ansi-term-color-vector term-ansi-current-color) - :foreground - (elt ansi-term-color-vector term-ansi-current-bg-color))) - - (if (= term-ansi-current-color 0) - (list :foreground term-default-fg-color - :background term-default-bg-color) - (list :foreground - (elt ansi-term-color-vector term-ansi-current-color) - :background - (elt ansi-term-color-vector term-ansi-current-bg-color))))) + (list :foreground + (face-foreground (elt ansi-term-color-vector term-ansi-current-color)) + :background + (face-background (elt ansi-term-color-vector term-ansi-current-bg-color)) + :inverse-video term-ansi-current-reverse)) (when term-ansi-current-bold (setq term-current-face - (append term-bold-attribute term-current-face))) + `(,term-current-face :inherit term-bold))) + (when term-ansi-current-underline (setq term-current-face - (list* :underline t term-current-face))))) + `(,term-current-face :inherit term-underline))))) ;; (message "Debug %S" term-current-face) ;; FIXME: shouldn't we set term-ansi-face-already-done to t here? --Stef @@ -3733,7 +3745,7 @@ all pending output has been dealt with.")) (when wrapped (insert ? )) (insert ?\n) - (put-text-property saved-point (point) 'face 'default) + (put-text-property saved-point (point) 'font-lock-face 'default) (goto-char saved-point)))) (defun term-erase-in-display (kind) @@ -3781,7 +3793,7 @@ if KIND is 1, erase from home to point; else erase from home to point-max." ;; from the last character on the line, set the face for the chars ;; to default. (when (>= (point) pnt-at-eol) - (put-text-property pnt-at-eol (point) 'face 'default)) + (put-text-property pnt-at-eol (point) 'font-lock-face 'default)) (when (> save-eol (point)) (delete-region (point) save-eol)) (goto-char save-point) diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 344c3d434d2..06b67475c1d 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -44,8 +44,6 @@ (error "%s: Loading ns-win.el but not compiled for GNUstep/MacOS" (invocation-name))) -(eval-when-compile (require 'cl)) - ;; Documentation-purposes only: actually loaded in loadup.el. (require 'frame) (require 'mouse) diff --git a/lisp/term/tvi970.el b/lisp/term/tvi970.el index 161e6222df2..b02d39c1e0f 100644 --- a/lisp/term/tvi970.el +++ b/lisp/term/tvi970.el @@ -27,8 +27,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - (defvar tvi970-terminal-map (let ((map (make-sparse-keymap))) diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 498cc01fe22..fb7389b856c 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1305,12 +1305,18 @@ Request data types in the order specified by `x-select-request-type'." (declare-function accelerate-menu "xmenu.c" (&optional frame) t) (defun x-menu-bar-open (&optional frame) - "Open the menu bar if `menu-bar-mode' is on, otherwise call `tmm-menubar'." + "Open the menu bar if it is shown. +`popup-menu' is used if it is off " (interactive "i") - (if (and menu-bar-mode - (fboundp 'accelerate-menu)) - (accelerate-menu frame) - (tmm-menubar))) + (cond + ((and (not (zerop (or (frame-parameter nil 'menu-bar-lines) 0))) + (fboundp 'accelerate-menu)) + (accelerate-menu frame)) + (t + (popup-menu (mouse-menu-bar-map) + (if (listp last-nonmenu-event) + nil + 'point))))) ;;; Window system initialization. diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index b9e4da59e18..d50aadef25b 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -37,7 +37,6 @@ "Cascading Style Sheets (CSS) editing mode." :group 'languages) -(eval-when-compile (require 'cl)) (defun css-extract-keyword-list (res) (with-temp-buffer diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index 68a99b0efe4..a28fcfc7e4b 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el @@ -437,7 +437,7 @@ Return value is \(begin end name positive-p), or nil if none was found." (progn (goto-char (match-beginning 0)) (not (looking-at enriched-annotation-regexp)))) (forward-char 1) - (if (= ?< (char-after (point))) + (if (eq ?< (char-after (point))) (delete-char 1) ;; A single < that does not start an annotation is an error, ;; which we note and then ignore. diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index fc2155893a9..0c7966f22d3 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1064,8 +1064,7 @@ Return the new dictionary alist." (insert-file-contents alias-file) ;; Look for a line "add FOO.multi", extract FOO (when (search-forward-regexp "^add \\([^.]+\\)\\.multi" nil t) - (let* ((aliasname (file-name-sans-extension - (file-name-nondirectory alias-file))) + (let* ((aliasname (file-name-base alias-file)) (already-exists-p (assoc aliasname alist)) (realname (match-string 1)) (realdict (assoc realname alist))) diff --git a/lisp/textmodes/refill.el b/lisp/textmodes/refill.el index cb7e9ff0b88..d6b355bdd0d 100644 --- a/lisp/textmodes/refill.el +++ b/lisp/textmodes/refill.el @@ -83,8 +83,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - (defgroup refill nil "Refilling paragraphs on changes." :group 'fill) @@ -169,8 +167,8 @@ complex processing.") "Post-command function to do refilling (conditionally)." (when refill-doit ; there was a change ;; There's probably scope for more special cases here... - (case this-command - (self-insert-command + (pcase this-command + (`self-insert-command ;; Treat self-insertion commands specially, since they don't ;; always reset `refill-doit' -- for self-insertion commands that ;; *don't* cause a refill, we want to leave it turned on so that @@ -180,9 +178,9 @@ complex processing.") ;; newline, covered below). (refill-fill-paragraph-at refill-doit) (setq refill-doit nil))) - ((quoted-insert fill-paragraph fill-region) nil) - ((newline newline-and-indent open-line indent-new-comment-line - reindent-then-newline-and-indent) + ((or `quoted-insert `fill-paragraph `fill-region) nil) + ((or `newline `newline-and-indent `open-line `indent-new-comment-line + `reindent-then-newline-and-indent) ;; Don't zap what was just inserted. (save-excursion (beginning-of-line) ; for newline-and-indent @@ -196,7 +194,7 @@ complex processing.") (save-restriction (narrow-to-region (line-beginning-position) (point-max)) (refill-fill-paragraph-at refill-doit)))) - (t + (_ (refill-fill-paragraph-at refill-doit))) (setq refill-doit nil))) diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el index 03690f65281..1882e7dde56 100644 --- a/lisp/textmodes/reftex-ref.el +++ b/lisp/textmodes/reftex-ref.el @@ -313,8 +313,7 @@ also applies `reftex-translate-to-ascii-function' to the string." (save-match-data (cond ((equal letter "f") - (file-name-sans-extension - (file-name-nondirectory (buffer-file-name)))) + (file-name-base)) ((equal letter "F") (let ((masterdir (file-name-directory (reftex-TeX-master-file))) (file (file-name-sans-extension (buffer-file-name)))) @@ -323,8 +322,7 @@ also applies `reftex-translate-to-ascii-function' to the string." (substring file (length masterdir)) file))) ((equal letter "m") - (file-name-sans-extension - (file-name-nondirectory (reftex-TeX-master-file)))) + (file-name-base (reftex-TeX-master-file))) ((equal letter "M") (file-name-nondirectory (substring (file-name-directory (reftex-TeX-master-file)) diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 8ad7a8e1c16..6e0562f4a4b 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -3416,10 +3416,11 @@ This color is used as background for section title text on level (defcustom rst-adornment-faces-alist ;; FIXME LEVEL-FACE: Must be redone if `rst-level-face-max' is changed - (let ((alist (copy-list '((t . rst-transition) - (nil . rst-adornment)))) + (let ((alist (copy-sequence '((t . rst-transition) + (nil . rst-adornment)))) (i 1)) (while (<= i rst-level-face-max) + ;; FIXME: why not `push'? (nconc alist (list (cons i (intern (format "rst-level-%d-face" i))))) (setq i (1+ i))) alist) diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index aed4ecb4e3e..5bcd87ede68 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -35,7 +35,7 @@ (eval-when-compile (require 'skeleton) (require 'outline) - (require 'cl)) + (require 'cl-lib)) (defgroup sgml nil "SGML editing mode." @@ -1192,7 +1192,7 @@ You might want to turn on `auto-fill-mode' to get better results." ;; Parsing -(defstruct (sgml-tag +(cl-defstruct (sgml-tag (:constructor sgml-make-tag (type start end name))) type start end name) @@ -1272,7 +1272,7 @@ Leave point at the beginning of the tag." (throw 'found (sgml-parse-tag-backward limit)))) (point)))) (goto-char (1+ tag-start)) - (case (char-after) + (pcase (char-after) (?! (setq tag-type 'decl)) ; declaration (?? (setq tag-type 'pi)) ; processing-instruction (?% (setq tag-type 'jsp)) ; JSP tags @@ -1280,7 +1280,7 @@ Leave point at the beginning of the tag." (forward-char 1) (setq tag-type 'close name (sgml-parse-tag-name))) - (t ; open or empty tag + (_ ; open or empty tag (setq tag-type 'open name (sgml-parse-tag-name)) (if (or (eq ?/ (char-before (- tag-end 1))) @@ -1405,19 +1405,19 @@ If FULL is non-nil, parse back to the beginning of the buffer." Depending on context, inserts a matching close-tag, or closes the current start-tag or the current comment or the current cdata, ..." (interactive) - (case (car (sgml-lexical-context)) - (comment (insert " -->")) - (cdata (insert "]]>")) - (pi (insert " ?>")) - (jsp (insert " %>")) - (tag (insert " />")) - (text + (pcase (car (sgml-lexical-context)) + (`comment (insert " -->")) + (`cdata (insert "]]>")) + (`pi (insert " ?>")) + (`jsp (insert " %>")) + (`tag (insert " />")) + (`text (let ((context (save-excursion (sgml-get-context)))) (if context (progn (insert "") (indent-according-to-mode))))) - (otherwise + (_ (error "Nothing to close")))) (defun sgml-empty-tag-p (tag-name) @@ -1442,9 +1442,9 @@ LCON is the lexical context, if any." (save-excursion (goto-char (cdr lcon)) (looking-at "") + ;; FIXME: This loses the skipped-over spaces. (skip-syntax-forward " ") (unless (eobp) - (xml-parse-tag parse-dtd xml-ns))) - ;; end tag + (let ((xml-sub-parser t)) + (xml-parse-tag-1 parse-dtd xml-ns)))) + ;; end tag ((looking-at "[:space:]]+\\)") + ;; opening tag + ((looking-at (eval-when-compile (concat "<\\(" xml-name-re "\\)"))) (goto-char (match-end 1)) - ;; Parse this node (let* ((node-name (match-string-no-properties 1)) ;; Parse the attribute list. (attrs (xml-parse-attlist xml-ns)) children) - ;; add the xmlns:* attrs to our cache (when (consp xml-ns) (dolist (attr attrs) @@ -446,70 +476,114 @@ Returns one of: (caar attr))) (push (cons (cdar attr) (cdr attr)) xml-ns)))) - (setq children (list attrs (xml-maybe-do-ns node-name "" xml-ns))) + (cond + ;; is this an empty element ? + ((looking-at "/>") + (forward-char 2) + (nreverse children)) + ;; is this a valid start tag ? + ((eq (char-after) ?>) + (forward-char 1) + ;; Now check that we have the right end-tag. + (let ((end (concat ""))) + (while (not (looking-at end)) + (cond + ((eobp) + (error "XML: (Not Well-Formed) End of document while reading element `%s'" + node-name)) + ((looking-at "" nil t) + (match-beginning 0) + (point-max)))) + node-name)) + ;; Read a sub-element and push it onto CHILDREN. + ((= (char-after) ?<) + (let ((tag (xml-parse-tag-1 nil xml-ns))) + (when tag + (push tag children)))) + ;; Read some character data. + (t + (let ((expansion (xml-parse-string))) + (push (if (stringp (car children)) + ;; If two strings were separated by a + ;; comment, concat them. + (concat (pop children) expansion) + expansion) + children))))) + ;; Move point past the end-tag. + (goto-char (match-end 0)) + (nreverse children))) + ;; Otherwise this was an invalid start tag (expected ">" not found.) + (t + (error "XML: (Well-Formed) Couldn't parse tag: %s" + (buffer-substring-no-properties (- (point) 10) (+ (point) 1))))))) - ;; is this an empty element ? - (if (looking-at "/>") - (progn - (forward-char 2) - (nreverse children)) - - ;; is this a valid start tag ? - (if (eq (char-after) ?>) - (progn - (forward-char 1) - ;; Now check that we have the right end-tag. Note that this - ;; one might contain spaces after the tag name - (let ((end (concat ""))) - (while (not (looking-at end)) - (cond - ((looking-at "", but didn't see it.) - (error "XML: (Well-Formed) Couldn't parse tag: %s" - (buffer-substring-no-properties (- (point) 10) (+ (point) 1))))))) - (t ;; (Not one of PI, CDATA, Comment, End tag, or Start tag) - (unless xml-sub-parser ; Usually, we error out. + ;; (Not one of PI, CDATA, Comment, End tag, or Start tag) + (t + (unless xml-sub-parser ; Usually, we error out. (error "XML: (Well-Formed) Invalid character")) - ;; However, if we're parsing incrementally, then we need to deal ;; with stray CDATA. (xml-parse-string))))) (defun xml-parse-string () - "Parse the next whatever. Could be a string, or an element." - (let* ((pos (point)) - (string (progn (skip-chars-forward "^<") - (buffer-substring-no-properties pos (point))))) - ;; Clean up the string. As per XML specifications, the XML - ;; processor should always pass the whole string to the - ;; application. But \r's should be replaced: - ;; http://www.w3.org/TR/2000/REC-xml-20001006#sec-line-ends - (setq pos 0) - (while (string-match "\r\n?" string pos) - (setq string (replace-match "\n" t t string)) - (setq pos (1+ (match-beginning 0)))) - - (xml-substitute-special string))) + "Parse character data at point, and return it as a string. +Leave point at the start of the next thing to parse. This +function can modify the buffer by expanding entity and character +references." + (let ((start (point)) + ;; Keep track of the size of the rest of the buffer: + (old-remaining-size (- (buffer-size) (point))) + ref val) + (while (and (not (eobp)) + (not (looking-at "<"))) + ;; Find the next < or & character. + (skip-chars-forward "^<&") + (when (eq (char-after) ?&) + ;; If we find an entity or character reference, expand it. + (unless (looking-at xml-entity-or-char-ref-re) + (error "XML: (Not Well-Formed) Invalid entity reference")) + ;; For a character reference, the next entity or character + ;; reference must be after the replacement. [4.6] "Numerical + ;; character references are expanded immediately when + ;; recognized and MUST be treated as character data." + (if (setq ref (match-string 2)) + (progn ; Numeric char reference + (setq val (save-match-data + (decode-char 'ucs (string-to-number + ref (if (match-string 1) 16))))) + (and (null val) + xml-validating-parser + (error "XML: (Validity) Invalid character reference `%s'" + (match-string 0))) + (replace-match (or (string val) xml-undefined-entity) t t)) + ;; For an entity reference, search again from the start of + ;; the replaced text, since the replacement can contain + ;; entity or character references, or markup. + (setq ref (match-string 3) + val (assoc ref xml-entity-alist)) + (and (null val) + xml-validating-parser + (error "XML: (Validity) Undefined entity `%s'" ref)) + (replace-match (cdr val) t t) + (goto-char (match-beginning 0))) + ;; Check for XML bombs. + (and xml-entity-expansion-limit + (> (- (buffer-size) (point)) + (+ old-remaining-size xml-entity-expansion-limit)) + (error "XML: Entity reference expansion \ +surpassed `xml-entity-expansion-limit'")))) + ;; [2.11] Clean up line breaks. + (let ((end-marker (point-marker))) + (goto-char start) + (while (re-search-forward "\r\n?" end-marker t) + (replace-match "\n" t t)) + (goto-char end-marker) + (buffer-substring start (point))))) (defun xml-parse-attlist (&optional xml-ns) "Return the attribute-list after point. @@ -518,7 +592,7 @@ Leave point at the first non-blank character after the tag." end-pos name) (skip-syntax-forward " ") (while (looking-at (eval-when-compile - (concat "\\(" xml-name-regexp "\\)\\s-*=\\s-*"))) + (concat "\\(" xml-name-re "\\)\\s-*=\\s-*"))) (setq end-pos (match-end 0)) (setq name (xml-maybe-do-ns (match-string-no-properties 1) nil xml-ns)) (goto-char end-pos) @@ -543,8 +617,9 @@ Leave point at the first non-blank character after the tag." (replace-regexp-in-string "\\s-\\{2,\\}" " " string) (let ((expansion (xml-substitute-special string))) (unless (stringp expansion) - ; We say this is the constraint. It is actually that neither - ; external entities nor "<" can be in an attribute value. + ;; We say this is the constraint. It is actually that + ;; neither external entities nor "<" can be in an + ;; attribute value. (error "XML: (Not Well-Formed) Entities in attributes cannot expand into elements")) (push (cons name expansion) attlist))) @@ -552,15 +627,11 @@ Leave point at the first non-blank character after the tag." (skip-syntax-forward " ")) (nreverse attlist))) -;;******************************************************************* -;;** -;;** The DTD (document type declaration) -;;** The following functions know how to skip or parse the DTD of -;;** a document -;;** -;;******************************************************************* +;;; DTD (document type declaration) -;; Fixme: This fails at least if the DTD contains conditional sections. +;; The following functions know how to skip or parse the DTD of a +;; document. FIXME: it fails at least if the DTD contains conditional +;; sections. (defun xml-skip-dtd () "Skip the DTD at point. @@ -577,13 +648,14 @@ This follows the rule [28] in the XML specifications." (error "XML: (Validity) Invalid DTD (expecting name of the document)")) ;; Get the name of the document - (looking-at xml-name-regexp) + (looking-at xml-name-re) (let ((dtd (list (match-string-no-properties 0) 'dtd)) - type element end-pos) + (xml-parameter-entity-alist xml-parameter-entity-alist) + next-parameter-entity) (goto-char (match-end 0)) - (skip-syntax-forward " ") - ;; XML [75] + + ;; External subset (XML [75]) (cond ((looking-at "PUBLIC\\s-+") (goto-char (match-end 0)) (unless (or (re-search-forward @@ -606,119 +678,185 @@ This follows the rule [28] in the XML specifications." (error "XML: Missing System ID")) (push (list (match-string-no-properties 1) 'system) dtd))) (skip-syntax-forward " ") - (if (eq ?> (char-after)) + + (if (eq (char-after) ?>) + + ;; No internal subset (forward-char) - (if (not (eq (char-after) ?\[)) - (error "XML: Bad DTD") - (forward-char) - ;; Parse the rest of the DTD - ;; Fixme: Deal with NOTATION, PIs. - (while (not (looking-at "\\s-*\\]")) - (skip-syntax-forward " ") - (cond - ;; Translation of rule [45] of XML specifications - ((looking-at - "]+\\)>") + ;; Internal subset (XML [28b]) + (unless (eq (char-after) ?\[) + (error "XML: Bad DTD")) + (forward-char) - (setq element (match-string-no-properties 1) - type (match-string-no-properties 2)) - (setq end-pos (match-end 0)) + ;; [2.8]: "markup declarations may be made up in whole or in + ;; part of the replacement text of parameter entities." - ;; Translation of rule [46] of XML specifications + ;; Since parameter entities are valid only within the DTD, we + ;; first search for the position of the next possible parameter + ;; entity. Then, search for the next DTD element; if it ends + ;; before the next parameter entity, expand the parameter entity + ;; and try again. + (setq next-parameter-entity + (save-excursion + (if (re-search-forward xml-pe-reference-re nil t) + (match-beginning 0)))) + + ;; Parse the rest of the DTD + ;; Fixme: Deal with NOTATION, PIs. + (while (not (looking-at "\\s-*\\]")) + (skip-syntax-forward " ") + (cond + ((eobp) + (error "XML: (Well-Formed) End of document while reading DTD")) + ;; Element declaration [45]: + ((and (looking-at (eval-when-compile + (concat "]+\\)>"))) + (or (null next-parameter-entity) + (<= (match-end 0) next-parameter-entity))) + (let ((element (match-string-no-properties 1)) + (type (match-string-no-properties 2)) + (end-pos (match-end 0))) + ;; Translation of rule [46] of XML specifications (cond - ((string-match "^EMPTY[ \t\n\r]*$" type) ;; empty declaration + ((string-match "\\`EMPTY\\s-*\\'" type) ; empty declaration (setq type 'empty)) - ((string-match "^ANY[ \t\n\r]*$" type) ;; any type of contents + ((string-match "\\`ANY\\s-*$" type) ; any type of contents (setq type 'any)) - ((string-match "^(\\(.*\\))[ \t\n\r]*$" type) ;; children ([47]) - (setq type (xml-parse-elem-type (match-string-no-properties 1 type)))) - ((string-match "^%[^;]+;[ \t\n\r]*$" type) ;; substitution + ((string-match "\\`(\\(.*\\))\\s-*\\'" type) ; children ([47]) + (setq type (xml-parse-elem-type + (match-string-no-properties 1 type)))) + ((string-match "^%[^;]+;[ \t\n\r]*\\'" type) ; substitution nil) - (t - (if xml-validating-parser - (error "XML: (Validity) Invalid element type in the DTD")))) + (xml-validating-parser + (error "XML: (Validity) Invalid element type in the DTD"))) - ;; rule [45]: the element declaration must be unique - (if (and (assoc element dtd) - xml-validating-parser) - (error "XML: (Validity) Element declarations must be unique in a DTD (<%s>)" - element)) + ;; rule [45]: the element declaration must be unique + (and (assoc element dtd) + xml-validating-parser + (error "XML: (Validity) DTD element declarations must be unique (<%s>)" + element)) ;; Store the element in the DTD (push (list element type) dtd) - (goto-char end-pos)) + (goto-char end-pos))) - ;; Translation of rule [52] of XML specifications - ((looking-at (concat "")) + ;; Attribute-list declaration [52] (currently unsupported): + ((and (looking-at (eval-when-compile + (concat ""))) + (or (null next-parameter-entity) + (<= (match-end 0) next-parameter-entity))) + (goto-char (match-end 0))) - ;; We don't do anything with ATTLIST currently - (goto-char (match-end 0))) + ;; Comments (skip to end, ignoring parameter entity): + ((looking-at "") + (and next-parameter-entity + (> (point) next-parameter-entity) + (setq next-parameter-entity + (save-excursion + (if (re-search-forward xml-pe-reference-re nil t) + (match-beginning 0)))))) + + ;; Internal entity declarations: + ((and (looking-at (eval-when-compile + (concat ""))) + (or (null next-parameter-entity) + (<= (match-end 0) next-parameter-entity))) + (let* ((name (prog1 (match-string-no-properties 2) + (goto-char (match-end 0)))) + (alist (if (match-string 1) + 'xml-parameter-entity-alist + 'xml-entity-alist)) + ;; Retrieve the deplacement text: + (value (xml--entity-replacement-text + ;; Entity value, sans quotation marks: + (substring (match-string-no-properties 3) 1 -1)))) + ;; If the same entity is declared more than once, the + ;; first declaration is binding. + (unless (assoc name (symbol-value alist)) + (set alist (cons (cons name value) (symbol-value alist)))))) + + ;; External entity declarations (currently unsupported): + ((and (or (looking-at (eval-when-compile + (concat ""))) + (looking-at (eval-when-compile + (concat "")))) + (or (null next-parameter-entity) + (<= (match-end 0) next-parameter-entity))) + (goto-char (match-end 0))) + + ;; If a parameter entity is in the way, expand it. + (next-parameter-entity + (save-excursion + (goto-char next-parameter-entity) + (unless (looking-at xml-pe-reference-re) + (error "XML: Internal error")) + (let* ((entity (match-string 1)) + (beg (point-marker)) + (elt (assoc entity xml-parameter-entity-alist))) + (if elt + (progn + (replace-match (cdr elt) t t) + ;; The replacement can itself be a parameter entity. + (goto-char next-parameter-entity)) + (goto-char (match-end 0)))) + (setq next-parameter-entity + (if (re-search-forward xml-pe-reference-re nil t) + (match-beginning 0))))) + + ;; Anything else is garbage (ignored if not validating). + (xml-validating-parser + (error "XML: (Validity) Invalid DTD item")) + (t + (skip-chars-forward "^]")))) - ((looking-at "")) - ((looking-at (concat "")) - (let ((name (match-string-no-properties 1)) - (value (substring (match-string-no-properties 2) 1 - (- (length (match-string-no-properties 2)) 1)))) - (goto-char (match-end 0)) - (setq xml-entity-alist - (append xml-entity-alist - (list (cons name - (with-temp-buffer - (insert value) - (goto-char (point-min)) - (xml-parse-fragment - xml-validating-parser - parse-ns)))))))) - ((or (looking-at (concat "")) - (looking-at (concat ""))) - (let ((name (match-string-no-properties 1)) - (file (substring (match-string-no-properties 2) 1 - (- (length (match-string-no-properties 2)) 1)))) - (goto-char (match-end 0)) - (setq xml-entity-alist - (append xml-entity-alist - (list (cons name (with-temp-buffer - (insert-file-contents file) - (goto-char (point-min)) - (xml-parse-fragment - xml-validating-parser - parse-ns)))))))) - ;; skip parameter entity declarations - ((or (looking-at (concat "")) - (looking-at (concat ""))) - (goto-char (match-end 0))) - ;; skip parameter entities - ((looking-at (concat "%" xml-name-re ";")) - (goto-char (match-end 0))) - (t - (when xml-validating-parser - (error "XML: (Validity) Invalid DTD item")))))) (if (looking-at "\\s-*]>") (goto-char (match-end 0)))) (nreverse dtd))) +(defun xml--entity-replacement-text (string) + "Return the replacement text for the entity value STRING. +The replacement text is obtained by replacing character +references and parameter-entity references." + (let ((ref-re (eval-when-compile + (concat "\\(?:&#\\([0-9]+\\)\\|&#x\\([0-9a-fA-F]+\\)\\|%\\(" + xml-name-re "\\)\\);"))) + children) + (while (string-match ref-re string) + (push (substring string 0 (match-beginning 0)) children) + (let ((remainder (substring string (match-end 0))) + ref val) + (cond ((setq ref (match-string 1 string)) + ;; Decimal character reference + (setq val (decode-char 'ucs (string-to-number ref))) + (if val (push (string val) children))) + ;; Hexadecimal character reference + ((setq ref (match-string 2 string)) + (setq val (decode-char 'ucs (string-to-number ref 16))) + (if val (push (string val) children))) + ;; Parameter entity reference + ((setq ref (match-string 3 string)) + (setq val (assoc ref xml-parameter-entity-alist)) + (and (null val) + xml-validating-parser + (error "XML: (Validity) Undefined parameter entity `%s'" ref)) + (push (or (cdr val) xml-undefined-entity) children))) + (setq string remainder))) + (mapconcat 'identity (nreverse (cons string children)) ""))) + (defun xml-parse-elem-type (string) "Convert element type STRING into a Lisp structure." @@ -752,79 +890,43 @@ This follows the rule [28] in the XML specifications." (t elem)))) -;;******************************************************************* -;;** -;;** Substituting special XML sequences -;;** -;;******************************************************************* +;;; Substituting special XML sequences (defun xml-substitute-special (string) - "Return STRING, after substituting entity references." - ;; This originally made repeated passes through the string from the - ;; beginning, which isn't correct, since then either "&amp;" or - ;; "&amp;" won't DTRT. - - (let ((point 0) - children end-point) - (while (string-match "&\\([^;]*\\);" string point) - (setq end-point (match-end 0)) - (let* ((this-part (match-string-no-properties 1 string)) - (prev-part (substring string point (match-beginning 0))) - (entity (assoc this-part xml-entity-alist)) - (expansion - (cond ((string-match "#\\([0-9]+\\)" this-part) - (let ((c (decode-char - 'ucs - (string-to-number (match-string-no-properties 1 this-part))))) - (if c (string c)))) - ((string-match "#x\\([[:xdigit:]]+\\)" this-part) - (let ((c (decode-char - 'ucs - (string-to-number (match-string-no-properties 1 this-part) 16)))) - (if c (string c)))) - (entity - (cdr entity)) - ((eq (length this-part) 0) - (error "XML: (Not Well-Formed) No entity given")) - (t - (if xml-validating-parser - (error "XML: (Validity) Undefined entity `%s'" - this-part) - xml-undefined-entity))))) - - (cond ((null children) - ;; FIXME: If we have an entity that expands into XML, this won't work. - (setq children - (concat prev-part expansion))) - ((stringp children) - (if (stringp expansion) - (setq children (concat children prev-part expansion)) - (setq children (list expansion (concat prev-part children))))) - ((and (stringp expansion) - (stringp (car children))) - (setcar children (concat prev-part expansion (car children)))) - ((stringp expansion) - (setq children (append (concat prev-part expansion) - children))) - ((stringp (car children)) - (setcar children (concat (car children) prev-part)) - (setq children (append expansion children))) - (t - (setq children (list expansion - prev-part - children)))) - (setq point end-point))) - (cond ((stringp children) - (concat children (substring string point))) - ((stringp (car (last children))) - (concat (car (last children)) (substring string point))) - ((null children) - string) - (t - (concat (mapconcat 'identity - (nreverse children) - "") - (substring string point)))))) + "Return STRING, after substituting entity and character references. +STRING is assumed to occur in an XML attribute value." + (let ((strlen (length string)) + children) + (while (string-match xml-entity-or-char-ref-re string) + (push (substring string 0 (match-beginning 0)) children) + (let* ((remainder (substring string (match-end 0))) + (is-hex (match-string 1 string)) ; Is it a hex numeric reference? + (ref (match-string 2 string))) ; Numeric part of reference + (if ref + ;; [4.6] Character references are included as + ;; character data. + (let ((val (decode-char 'ucs (string-to-number ref (if is-hex 16))))) + (push (cond (val (string val)) + (xml-validating-parser + (error "XML: (Validity) Undefined character `x%s'" ref)) + (t xml-undefined-entity)) + children) + (setq string remainder + strlen (length string))) + ;; [4.4.5] Entity references are "included in literal". + ;; Note that we don't need do anything special to treat + ;; quotes as normal data characters. + (setq ref (match-string 3 string)) ; entity name + (let ((val (or (cdr (assoc ref xml-entity-alist)) + (if xml-validating-parser + (error "XML: (Validity) Undefined entity `%s'" ref) + xml-undefined-entity)))) + (setq string (concat val remainder))) + (and xml-entity-expansion-limit + (> (length string) (+ strlen xml-entity-expansion-limit)) + (error "XML: Passed `xml-entity-expansion-limit' while expanding `&%s;'" + ref))))) + (mapconcat 'identity (nreverse (cons string children)) ""))) (defun xml-substitute-numeric-entities (string) "Substitute SGML numeric entities by their respective utf characters. @@ -845,12 +947,7 @@ by \"*\"." string) nil)) -;;******************************************************************* -;;** -;;** Printing a tree. -;;** This function is intended mainly for debugging purposes. -;;** -;;******************************************************************* +;;; Printing a parse tree (mainly for debugging). (defun xml-debug-print (xml &optional indent-string) "Outputs the XML in the current buffer. @@ -863,15 +960,12 @@ The first line is indented with the optional INDENT-STRING." (defalias 'xml-print 'xml-debug-print) (defun xml-escape-string (string) - "Return the string with entity substitutions made from -xml-entity-alist." + "Return STRING with entity substitutions made from `xml-entity-alist'." (mapconcat (lambda (byte) (let ((char (char-to-string byte))) (if (rassoc char xml-entity-alist) (concat "&" (car (rassoc char xml-entity-alist)) ";") char))) - ;; This differs from the non-unicode branch. Just - ;; grabbing the string works here. string "")) (defun xml-debug-print-internal (xml indent-string) diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 06d82870f8c..76c78b84b42 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -47,33 +47,49 @@ ;; Mouse events symbols must have an 'event-kind property with ;; the value 'mouse-click. (dolist (event-type '(mouse-1 mouse-2 mouse-3 - M-down-mouse-1 M-down-mouse-2 M-down-mouse-3)) + M-down-mouse-1 M-down-mouse-2 M-down-mouse-3)) (put event-type 'event-kind 'mouse-click)) (defun xterm-mouse-translate (_event) "Read a click and release event from XTerm." + (xterm-mouse-translate-1)) + +(defun xterm-mouse-translate-extended (_event) + "Read a click and release event from XTerm. +Similar to `xterm-mouse-translate', but using the \"1006\" +extension, which supports coordinates >= 231 (see +http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)." + (xterm-mouse-translate-1 1006)) + +(defun xterm-mouse-translate-1 (&optional extension) (save-excursion (save-window-excursion (deactivate-mark) - (let* ((xterm-mouse-last) - (down (xterm-mouse-event)) + (let* ((xterm-mouse-last nil) + (down (xterm-mouse-event extension)) (down-command (nth 0 down)) - (down-data (nth 1 down)) - (down-where (nth 1 down-data)) + (down-data (nth 1 down)) + (down-where (nth 1 down-data)) (down-binding (key-binding (if (symbolp down-where) (vector down-where down-command) (vector down-command)))) (is-click (string-match "^mouse" (symbol-name (car down))))) + ;; Retrieve the expected preface for the up-event. (unless is-click - (unless (and (eq (read-char) ?\e) - (eq (read-char) ?\[) - (eq (read-char) ?M)) + (unless (cond ((null extension) + (and (eq (read-event) ?\e) + (eq (read-event) ?\[) + (eq (read-event) ?M))) + ((eq extension 1006) + (and (eq (read-event) ?\e) + (eq (read-event) ?\[) + (eq (read-event) ?<)))) (error "Unexpected escape sequence from XTerm"))) - (let* ((click (if is-click down (xterm-mouse-event))) - ;; (click-command (nth 0 click)) - (click-data (nth 1 click)) + ;; Process the up-event. + (let* ((click (if is-click down (xterm-mouse-event extension))) + (click-data (nth 1 click)) (click-where (nth 1 click-data))) (if (memq down-binding '(nil ignore)) (if (and (symbolp click-where) @@ -81,17 +97,18 @@ (vector (list click-where click-data) click) (vector click)) (setq unread-command-events - (if (eq down-where click-where) - (list click) - (list - ;; Cheat `mouse-drag-region' with move event. - (list 'mouse-movement click-data) - ;; Generate a drag event. - (if (symbolp down-where) - 0 - (list (intern (format "drag-mouse-%d" - (+ 1 xterm-mouse-last))) - down-data click-data))))) + (append (if (eq down-where click-where) + (list click) + (list + ;; Cheat `mouse-drag-region' with move event. + (list 'mouse-movement click-data) + ;; Generate a drag event. + (if (symbolp down-where) + 0 + (list (intern (format "drag-mouse-%d" + (1+ xterm-mouse-last))) + down-data click-data)))) + unread-command-events)) (if xterm-mouse-debug-buffer (print unread-command-events xterm-mouse-debug-buffer)) (if (and (symbolp down-where) @@ -118,11 +135,11 @@ (terminal-parameter nil 'xterm-mouse-y)))) pos) -;; read xterm sequences above ascii 127 (#x7f) +;; Read XTerm sequences above ASCII 127 (#x7f) (defun xterm-mouse-event-read () ;; We get the characters decoded by the keyboard coding system. Try ;; to recover the raw character. - (let ((c (read-char))) + (let ((c (read-event))) (cond ;; If meta-flag is t we get a meta character ((>= c ?\M-\^@) (- c (- ?\M-\^@ 128))) @@ -147,11 +164,82 @@ (fdiff (- f (* 1.0 maxwrap dbig)))) (+ (truncate fdiff) (* maxwrap dbig)))))) -(defun xterm-mouse-event () - "Convert XTerm mouse event to Emacs mouse event." - (let* ((type (- (xterm-mouse-event-read) #o40)) - (x (- (xterm-mouse-event-read) #o40 1)) - (y (- (xterm-mouse-event-read) #o40 1)) +;; Normal terminal mouse click reporting: expect three bytes, of the +;; form . Return a list (EVENT-TYPE X Y). +(defun xterm-mouse--read-event-sequence-1000 () + (list (let ((code (- (xterm-mouse-event-read) 32))) + (intern + ;; For buttons > 3, the release-event looks differently + ;; (see xc/programs/xterm/button.c, function EditorButton), + ;; and come in a release-event only, no down-event. + (cond ((>= code 64) + (format "mouse-%d" (- code 60))) + ((memq code '(8 9 10)) + (setq xterm-mouse-last code) + (format "M-down-mouse-%d" (- code 7))) + ((= code 11) + (format "M-mouse-%d" (- xterm-mouse-last 7))) + ((= code 3) + ;; For buttons > 5 xterm only reports a + ;; button-release event. Avoid error by mapping + ;; them all to mouse-1. + (format "mouse-%d" (+ 1 (or xterm-mouse-last 0)))) + (t + (setq xterm-mouse-last code) + (format "down-mouse-%d" (+ 1 code)))))) + ;; x and y coordinates + (- (xterm-mouse-event-read) 33) + (- (xterm-mouse-event-read) 33))) + +;; XTerm's 1006-mode terminal mouse click reporting has the form +;;