diff options
192 files changed, 6159 insertions, 3290 deletions
diff --git a/ChangeLog b/ChangeLog index 967284b485d..61a3131d02c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,29 @@ +2013-07-25 Glenn Morris <rgm@gnu.org> + + * info/dir: Add ido. + + * make-dist: Add a --tests option, to include test/. + +2013-07-24 Glenn Morris <rgm@gnu.org> + + * configure.ac: Use self-descriptive tags for AC_CONFIG_COMMANDS. + +2013-07-23 Glenn Morris <rgm@gnu.org> + + * configure.ac (etc, lisp): No need to create specially. + Configure already creates lisp, src/Makefile now creates etc. + +2013-07-23 Paul Eggert <eggert@cs.ucla.edu> + + Port to GNU/Linux systems with tinfo but not ncurses. + * configure.ac (USE_NCURSES): New symbol. + +2013-07-20 Paul Eggert <eggert@cs.ucla.edu> + + Fix array bounds violation when pty allocation fails. + * configure.ac (PTY_TTY_NAME_SPRINTF): Use PTY_NAME_SIZE, + not sizeof pty_name, since pty_name is now a pointer to the array. + 2013-07-13 Paul Eggert <eggert@cs.ucla.edu> * configure.ac: Simplify --with-file-notification handling. @@ -35,7 +61,7 @@ * lib/ignore-value.h: Remove this gnulib-imported file. * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. -2013-07-08 Magnus Henoch <magnus.henoch@gmail.com> (tiny change) +2013-07-08 Magnus Henoch <magnus.henoch@gmail.com> (tiny change) * configure.ac (HAVE_IMAGEMAGICK): Check on NS also (Bug#14798). @@ -2001,7 +2027,7 @@ * Makefile.in (install-arch-indep, install-doc, install-info) (uninstall): Scrap superfluous subshells. -2012-05-19 Ulrich Mueller <ulm@gentoo.org> +2012-05-19 Ulrich Müller <ulm@gentoo.org> * Makefile.in (install-etc): Respect DESTDIR. (Bug#11518) @@ -3777,7 +3803,7 @@ * Makefile.in (install-arch-indep, info): Replace MAKEINFO = off with HAVE_MAKEINFO = no. -2010-12-29 Ulrich Mueller <ulm@gentoo.org> +2010-12-29 Ulrich Müller <ulm@gentoo.org> * configure.in: Make gameuser configurable (Bug#7717). @@ -4987,7 +5013,7 @@ * info/dir: Untabify. -2008-11-28 Ulrich Mueller <ulm@gentoo.org> +2008-11-28 Ulrich Müller <ulm@gentoo.org> * configure.in: Fix last change. @@ -5050,7 +5076,7 @@ * configure (*-sunos5*, *-solaris*): Use the new file sol2-10.h. Use sol2-6.h for Solaris 7-9. -2008-10-18 Ulrich Mueller <ulm@gentoo.org> +2008-10-18 Ulrich Müller <ulm@gentoo.org> * configure.in: Add support for GNU/Linux on SuperH. @@ -5134,7 +5160,7 @@ * configure.in (COCOA_EXPERIMENTAL_CTRL_G): Fix 2008-08-04 change. -2008-08-05 Ulrich Mueller <ulm@gentoo.org> +2008-08-05 Ulrich Müller <ulm@gentoo.org> * configure.in: Add checks for krb5_error.text and krb5_error.e_text struct members. @@ -5502,7 +5528,7 @@ * configure.in (--with-gcc): Remove. * INSTALL (DETAILED BUILDING AND INSTALLATION): Remove --with-gcc. -2008-02-05 Ulrich Mueller <ulm@gentoo.org> +2008-02-05 Ulrich Müller <ulm@gentoo.org> * INSTALL: Recommend giflib, not libungif. @@ -5524,7 +5550,7 @@ * configure.in: For libotf and m17n-flt checks, set shell vars HAVE_LIBOTF and HAVE_M17N_FLT instead of pkg_check_libotf and pkg_check_m17n_flt, respectively, for the sake of the summary output. - Reported by Ulrich Mueller. + Reported by Ulrich Müller. 2008-02-02 Eli Zaretskii <eliz@gnu.org> @@ -5838,7 +5864,7 @@ * configure.in: Put quotes around nested macro calls. -2007-08-31 Ulrich Mueller <ulm@gentoo.org> (tiny change) +2007-08-31 Ulrich Müller <ulm@gentoo.org> (tiny change) * configure.in: Fix typo. * configure: Regenerate. @@ -70,24 +70,17 @@ sections if you need to. you, but there are no obvious errors, assume that `configure' did its job and proceed. - 4. If you need to run the `configure' script more than once (e.g., - with some non-default options), always clean the source - directories before running `configure' again: - - make distclean - ./configure - - 5. Invoke the `make' program: + 4. Invoke the `make' program: make - 6. If `make' succeeds, it will build an executable program `emacs' + 5. If `make' succeeds, it will build an executable program `emacs' in the `src' directory. You can try this program, to make sure it works: src/emacs -Q - 7. Assuming that the program `src/emacs' starts and displays its + 6. Assuming that the program `src/emacs' starts and displays its opening screen, you can install the program and its auxiliary files into their installation directories: @@ -101,6 +94,11 @@ sections if you need to. You can delete the entire build directory if you do not plan to build Emacs again, but it can be useful to keep for debugging. + If you want to build Emacs again with different configure options, + first clean the source directories: + + make distclean + ./configure Note that the install automatically saves space by compressing (provided you have the `gzip' program) those installed Lisp source (.el) diff --git a/Makefile.in b/Makefile.in index a5accbf04a9..dad0a571075 100644 --- a/Makefile.in +++ b/Makefile.in @@ -1,6 +1,4 @@ -# DIST: This is the distribution Makefile for Emacs. configure can -# DIST: make most of the changes to this file you might want, so try -# DIST: that first. +### @configure_input@ # Copyright (C) 1992-2013 Free Software Foundation, Inc. diff --git a/admin/unidata/Makefile.in b/admin/unidata/Makefile.in index 49cd9bb6d3a..c759079a49a 100644 --- a/admin/unidata/Makefile.in +++ b/admin/unidata/Makefile.in @@ -1,4 +1,4 @@ -# Makefile -- Makefile to generate character property tables. +### @configure_input@ # Copyright (C) 2012-2013 Free Software Foundation, Inc. diff --git a/autogen/config.in b/autogen/config.in index 3fe82ce0f92..5c5b2dfdbca 100644 --- a/autogen/config.in +++ b/autogen/config.in @@ -1468,6 +1468,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define to 1 if using the Motif X toolkit. */ #undef USE_MOTIF +/* Define to 1 if you use ncurses. */ +#undef USE_NCURSES + /* Enable extensions on AIX 3, Interix. */ #ifndef _ALL_SOURCE # undef _ALL_SOURCE diff --git a/autogen/configure b/autogen/configure index faa09d0e9c3..fc0463a4a8d 100755 --- a/autogen/configure +++ b/autogen/configure @@ -4351,7 +4351,8 @@ if test "${with_file_notification+set}" = set; then : w | w3 | w32 ) val=w32 ;; * ) as_fn_error "\`--with-file-notification=$withval' is invalid; this option's value should be \`yes', \`no', \`gfile', \`inotify' or \`w32'. -\`yes' is a synonym for \`w32' on MS-Windows, and for \`gfile' otherwise." "$LINENO" 5 +\`yes' is a synonym for \`w32' on MS-Windows, for \`no' on Nextstep, +otherwise for the first of \`gfile' or \`inotify' that is usable." "$LINENO" 5 ;; esac with_file_notification=$val @@ -12000,17 +12001,29 @@ fi NOTIFY_OBJ= NOTIFY_SUMMARY=no -if test "${with_file_notification}" = "yes"; then - if test "${opsys}" = "mingw32"; then - with_file_notification=w32 - else - if test "${with_ns}" != yes; then - with_file_notification=gfile - fi - fi +if test "${with_ns}" = yes && test ${with_file_notification} = yes; then + with_file_notification=no +fi + +case $with_file_notification,$opsys in + w32,* | yes,mingw32) + ac_fn_c_check_header_mongrel "$LINENO" "windows.h" "ac_cv_header_windows_h" "$ac_includes_default" +if test "x$ac_cv_header_windows_h" = x""yes; then : + fi -if test "${with_file_notification}" = "gfile"; then + + if test "$ac_cv_header_windows_h" = yes ; then + +$as_echo "#define HAVE_W32NOTIFY 1" >>confdefs.h + + NOTIFY_OBJ=w32notify.o + NOTIFY_SUMMARY="yes (w32)" + fi ;; +esac + +case $with_file_notification,$NOTIFY_OBJ in + gfile, | yes,) succeeded=no @@ -12062,51 +12075,44 @@ $as_echo "no" >&6; } HAVE_GFILENOTIFY=no fi - if test "$HAVE_GFILENOTIFY" = "yes"; then + if test "$HAVE_GFILENOTIFY" = "yes"; then $as_echo "#define HAVE_GFILENOTIFY 1" >>confdefs.h - NOTIFY_OBJ=gfilenotify.o - NOTIFY_SUMMARY="yes -lgio (gfile)" - fi -fi -if test "${with_file_notification}" = "inotify"; then - ac_fn_c_check_header_mongrel "$LINENO" "sys/inotify.h" "ac_cv_header_sys_inotify_h" "$ac_includes_default" + NOTIFY_OBJ=gfilenotify.o + NOTIFY_SUMMARY="yes -lgio (gfile)" + fi ;; +esac + +case $with_file_notification,$NOTIFY_OBJ in + inotify, | yes,) + ac_fn_c_check_header_mongrel "$LINENO" "sys/inotify.h" "ac_cv_header_sys_inotify_h" "$ac_includes_default" if test "x$ac_cv_header_sys_inotify_h" = x""yes; then : fi - if test "$ac_cv_header_sys_inotify_h" = yes ; then - ac_fn_c_check_func "$LINENO" "inotify_init1" "ac_cv_func_inotify_init1" + if test "$ac_cv_header_sys_inotify_h" = yes ; then + ac_fn_c_check_func "$LINENO" "inotify_init1" "ac_cv_func_inotify_init1" if test "x$ac_cv_func_inotify_init1" = x""yes; then : fi - if test "$ac_cv_func_inotify_init1" = yes; then + if test "$ac_cv_func_inotify_init1" = yes; then $as_echo "#define HAVE_INOTIFY 1" >>confdefs.h - NOTIFY_OBJ=inotify.o - NOTIFY_SUMMARY="yes -lglibc (inotify)" - fi - fi -fi -if test "${with_file_notification}" = "w32"; then - ac_fn_c_check_header_mongrel "$LINENO" "windows.h" "ac_cv_header_windows_h" "$ac_includes_default" -if test "x$ac_cv_header_windows_h" = x""yes; then : - -fi - - - if test "$ac_cv_header_windows_h" = yes ; then + NOTIFY_OBJ=inotify.o + NOTIFY_SUMMARY="yes -lglibc (inotify)" + fi + fi ;; +esac -$as_echo "#define HAVE_W32NOTIFY 1" >>confdefs.h +case $with_file_notification,$NOTIFY_OBJ in + yes,* | no,* | *,?*) ;; + *) as_fn_error "File notification \`$with_file_notification' requested but requirements not found." "$LINENO" 5 ;; +esac - NOTIFY_OBJ=w32notify.o - NOTIFY_SUMMARY="yes (w32)" - fi -fi if test -n "$NOTIFY_OBJ"; then $as_echo "#define USE_FILE_NOTIFY 1" >>confdefs.h @@ -15016,6 +15022,11 @@ $as_echo "#define TERMINFO 1" >>confdefs.h TERMCAP_OBJ=terminfo.o fi +if test "X$LIBS_TERMCAP" = "X-lncurses"; then + +$as_echo "#define USE_NCURSES 1" >>confdefs.h + +fi @@ -16436,7 +16447,7 @@ $as_echo "#define UNIX98_PTYS 1" >>confdefs.h $as_echo "#define PTY_ITERATION int i; for (i = 0; i < 1; i++)" >>confdefs.h - $as_echo "#define PTY_TTY_NAME_SPRINTF { char *ptyname = 0; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); if (grantpt (fd) != -1 && unlockpt (fd) != -1) ptyname = ptsname(fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (!ptyname) { emacs_close (fd); return -1; } snprintf (pty_name, sizeof pty_name, \"%s\", ptyname); }" >>confdefs.h + $as_echo "#define PTY_TTY_NAME_SPRINTF { char *ptyname = 0; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); if (grantpt (fd) != -1 && unlockpt (fd) != -1) ptyname = ptsname(fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (!ptyname) { emacs_close (fd); return -1; } snprintf (pty_name, PTY_NAME_SIZE, \"%s\", ptyname); }" >>confdefs.h if test "x$ac_cv_func_posix_openpt" = xyes; then $as_echo "#define PTY_OPEN fd = posix_openpt (O_RDWR | O_CLOEXEC | O_NOCTTY)" >>confdefs.h @@ -16481,12 +16492,12 @@ $as_echo "#define UNIX98_PTYS 1" >>confdefs.h ;; sol2* ) - $as_echo "#define PTY_TTY_NAME_SPRINTF { char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1 || unlockpt (fd) == -1 || !(ptyname = ptsname (fd))) { emacs_close (fd); return -1; } snprintf (pty_name, sizeof pty_name, \"%s\", ptyname); }" >>confdefs.h + $as_echo "#define PTY_TTY_NAME_SPRINTF { char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1 || unlockpt (fd) == -1 || !(ptyname = ptsname (fd))) { emacs_close (fd); return -1; } snprintf (pty_name, PTY_NAME_SIZE, \"%s\", ptyname); }" >>confdefs.h ;; unixware ) - $as_echo "#define PTY_TTY_NAME_SPRINTF { char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1) fatal(\"could not grant slave pty\"); 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); }" >>confdefs.h + $as_echo "#define PTY_TTY_NAME_SPRINTF { char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1) fatal(\"could not grant slave pty\"); if (unlockpt(fd) == -1) fatal(\"could not unlock slave pty\"); if (!(ptyname = ptsname(fd))) fatal (\"could not enable slave pty\"); snprintf (pty_name, PTY_NAME_SIZE, \"%s\", ptyname); }" >>confdefs.h ;; esac @@ -28762,13 +28773,10 @@ SUBDIR_MAKEFILES_IN=`echo " ${SUBDIR_MAKEFILES}" | sed -e 's| | $(srcdir)/|g' -e -ac_config_commands="$ac_config_commands mkdirs" +ac_config_commands="$ac_config_commands src/epaths.h" -ac_config_commands="$ac_config_commands epaths" - - -ac_config_commands="$ac_config_commands gdbinit" +ac_config_commands="$ac_config_commands src/.gdbinit" cat >confcache <<\_ACEOF @@ -29633,9 +29641,8 @@ do "nt/Makefile") CONFIG_FILES="$CONFIG_FILES nt/Makefile" ;; "test/automated/Makefile") CONFIG_FILES="$CONFIG_FILES test/automated/Makefile" ;; "admin/unidata/Makefile") CONFIG_FILES="$CONFIG_FILES admin/unidata/Makefile" ;; - "mkdirs") CONFIG_COMMANDS="$CONFIG_COMMANDS mkdirs" ;; - "epaths") CONFIG_COMMANDS="$CONFIG_COMMANDS epaths" ;; - "gdbinit") CONFIG_COMMANDS="$CONFIG_COMMANDS gdbinit" ;; + "src/epaths.h") CONFIG_COMMANDS="$CONFIG_COMMANDS src/epaths.h" ;; + "src/.gdbinit") CONFIG_COMMANDS="$CONFIG_COMMANDS src/.gdbinit" ;; *) as_fn_error "invalid argument: \`$ac_config_target'" "$LINENO" 5;; esac @@ -30354,22 +30361,15 @@ $as_echo X"$file" | done } ;; - "mkdirs":C) -for dir in etc lisp ; do - test -d ${dir} || mkdir ${dir} -done - ;; - "epaths":C) -echo creating src/epaths.h + "src/epaths.h":C) if test "${opsys}" = "mingw32"; then ${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force-w32 else ${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force fi ;; - "gdbinit":C) + "src/.gdbinit":C) if test ! -f src/.gdbinit && test -f "$srcdir/src/.gdbinit"; then - echo creating src/.gdbinit echo "source $srcdir/src/.gdbinit" > src/.gdbinit fi ;; diff --git a/configure.ac b/configure.ac index 73dcdb06bee..910416b4aa7 100644 --- a/configure.ac +++ b/configure.ac @@ -3406,6 +3406,9 @@ if test $TERMINFO = yes; then AC_DEFINE(TERMINFO, 1, [Define to 1 if you use terminfo instead of termcap.]) TERMCAP_OBJ=terminfo.o fi +if test "X$LIBS_TERMCAP" = "X-lncurses"; then + AC_DEFINE(USE_NCURSES, 1, [Define to 1 if you use ncurses.]) +fi AC_SUBST(LIBS_TERMCAP) AC_SUBST(TERMCAP_OBJ) @@ -3938,7 +3941,7 @@ case $opsys in 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 = 0; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); if (grantpt (fd) != -1 && unlockpt (fd) != -1) ptyname = ptsname(fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (!ptyname) { emacs_close (fd); return -1; } snprintf (pty_name, sizeof pty_name, "%s", ptyname); }]) + AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptyname = 0; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); if (grantpt (fd) != -1 && unlockpt (fd) != -1) ptyname = ptsname(fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (!ptyname) { emacs_close (fd); return -1; } snprintf (pty_name, PTY_NAME_SIZE, "%s", ptyname); }]) dnl if HAVE_POSIX_OPENPT if test "x$ac_cv_func_posix_openpt" = xyes; then AC_DEFINE(PTY_OPEN, [fd = posix_openpt (O_RDWR | O_CLOEXEC | O_NOCTTY)]) @@ -3986,12 +3989,12 @@ case $opsys in 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; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1 || unlockpt (fd) == -1 || !(ptyname = ptsname (fd))) { emacs_close (fd); return -1; } snprintf (pty_name, sizeof pty_name, "%s", ptyname); }]) + AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1 || unlockpt (fd) == -1 || !(ptyname = ptsname (fd))) { emacs_close (fd); return -1; } snprintf (pty_name, PTY_NAME_SIZE, "%s", ptyname); }]) ;; unixware ) dnl Comments are as per sol2*. - AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1) fatal("could not grant slave pty"); 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); }]) + AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1) fatal("could not grant slave pty"); if (unlockpt(fd) == -1) fatal("could not unlock slave pty"); if (!(ptyname = ptsname(fd))) fatal ("could not enable slave pty"); snprintf (pty_name, PTY_NAME_SIZE, "%s", ptyname); }]) ;; esac @@ -4851,13 +4854,6 @@ SUBDIR_MAKEFILES_IN=`echo " ${SUBDIR_MAKEFILES}" | sed -e 's| | $(srcdir)/|g' -e AC_SUBST(SUBDIR_MAKEFILES_IN) -dnl Make the necessary directories, if they don't exist. -AC_CONFIG_COMMANDS([mkdirs], [ -for dir in etc lisp ; do - test -d ${dir} || mkdir ${dir} -done -]) - dnl You might wonder (I did) why epaths.h is generated by running make, dnl rather than just letting configure generate it from epaths.in. dnl One reason is that the various paths are not fully expanded (see above); @@ -4866,8 +4862,7 @@ dnl Secondly, the GNU Coding standards require that one should be able dnl to run `make prefix=/some/where/else' and override the values set dnl by configure. This also explains the `move-if-change' test and dnl the use of force in the `epaths-force' rule in Makefile.in. -AC_CONFIG_COMMANDS([epaths], [ -echo creating src/epaths.h +AC_CONFIG_COMMANDS([src/epaths.h], [ if test "${opsys}" = "mingw32"; then ${MAKE-make} MAKEFILE_NAME=do-not-make-Makefile epaths-force-w32 else @@ -4875,9 +4870,8 @@ else fi ], [GCC="$GCC" CPPFLAGS="$CPPFLAGS" opsys="$opsys"]) -AC_CONFIG_COMMANDS([gdbinit], [ +AC_CONFIG_COMMANDS([src/.gdbinit], [ if test ! -f src/.gdbinit && test -f "$srcdir/src/.gdbinit"; then - echo creating src/.gdbinit echo "source $srcdir/src/.gdbinit" > src/.gdbinit fi ]) diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index e634117f89c..ad2f091f27f 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,3 +1,8 @@ +2013-07-26 Eli Zaretskii <eliz@gnu.org> + + * display.texi (Fringes): Document the variable fringe-mode. + (Bug#14946) + 2013-07-03 Glenn Morris <rgm@gnu.org> * maintaining.texi (EDE): Fix cross-reference. diff --git a/doc/emacs/Makefile.in b/doc/emacs/Makefile.in index 2fec57f838b..32bb39b127a 100644 --- a/doc/emacs/Makefile.in +++ b/doc/emacs/Makefile.in @@ -1,4 +1,4 @@ -#### Makefile for the Emacs Manual +### @configure_input@ # Copyright (C) 1994, 1996-2013 Free Software Foundation, Inc. diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 482d7e7741a..aa9977a52e5 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1017,12 +1017,15 @@ mode's symbol is a member of the list @code{hi-lock-exclude-modes}. @findex set-fringe-style @findex fringe-mode +@vindex fringe-mode @r{(variable)} On graphical displays, each Emacs window normally has narrow @dfn{fringes} on the left and right edges. The fringes are used to display symbols that provide information about the text in the window. You can type @kbd{M-x fringe-mode} to disable the fringes, or modify their width. This command affects fringes in all frames; to modify fringes on the selected frame only, use @kbd{M-x set-fringe-style}. +You can make your changes to the fringes permanent by customizing the +variable @code{fringe-mode}. The most common use of the fringes is to indicate a continuation line (@pxref{Continuation Lines}). When one line of text is split diff --git a/doc/lispintro/Makefile.in b/doc/lispintro/Makefile.in index b60c752e92b..d5462f9e70f 100644 --- a/doc/lispintro/Makefile.in +++ b/doc/lispintro/Makefile.in @@ -1,4 +1,4 @@ -#### Makefile for the Emacs Lisp Introduction manual +### @configure_input@ # Copyright (C) 1994-1999, 2001-2013 Free Software Foundation, Inc. diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index f8b7406c427..32717946b04 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,38 @@ +2013-07-24 Michael Albinus <michael.albinus@gmx.de> + + * errors.texi (Standard Errors): Fix typo. + + * files.texi (Magic File Names): + * os.texi (File Notifications): Remove file-notify-supported-p. + +2013-07-24 Paul Eggert <eggert@cs.ucla.edu> + + * eval.texi (Special Forms): Mention 'lambda'. Also, say that + non-well-formed expressions result in unspecified behavior, though + Emacs will not crash. + +2013-07-22 Michael Albinus <michael.albinus@gmx.de> + + * files.texi (Magic File Names): Add file-notify-add-watch, + file-notify-rm-watch and file-notify-supported-p. Move + file-remote-p down. + + * errors.texi (Standard Errors): Add file-notify-error. + + * os.texi (Desktop Notifications): Rename from Notifications. + (File Notifications): New node. + + * elisp.texi (Top): Update menu for these changes. + +2013-07-19 Xue Fuqiao <xfq.free@gmail.com> + + * windows.texi (Display Action Functions): Mention next-window. + +2013-07-16 Xue Fuqiao <xfq.free@gmail.com> + + * windows.texi (Selecting Windows): Fix the introduction of + `set-frame-selected-window''s arguments. + 2013-07-10 Paul Eggert <eggert@cs.ucla.edu> Timestamp fixes for undo (Bug#14824). @@ -1045,7 +1080,7 @@ * display.texi (Face Attributes): Copyedits. Add a few cindex entries. Overlining no longer behaves exactly like underlining. -2012-06-16 Aurelien Aptel <aurelien.aptel@gmail.com> +2012-06-16 Aurélien Aptel <aurelien.aptel@gmail.com> * display.texi (Face Attributes): Document wave-style underline face attribute. diff --git a/doc/lispref/Makefile.in b/doc/lispref/Makefile.in index c548b67d4ca..4c1d63ab5c8 100644 --- a/doc/lispref/Makefile.in +++ b/doc/lispref/Makefile.in @@ -1,4 +1,4 @@ -# Makefile for the GNU Emacs Lisp Reference Manual. +### @configure_input@ # Copyright (C) 1990-1996, 1998-2013 Free Software Foundation, Inc. diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 0d9432d5e01..9c013140999 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -1489,7 +1489,8 @@ Operating System Interface * Batch Mode:: Running Emacs without terminal interaction. * Session Management:: Saving and restoring state with X Session Management. -* Notifications:: Desktop notifications. +* Desktop Notifications:: Desktop notifications. +* File Notifications:: File notifications. * Dynamic Libraries:: On-demand loading of support libraries. Starting Up Emacs diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi index 3f3984e40d2..87cfcfa532c 100644 --- a/doc/lispref/errors.texi +++ b/doc/lispref/errors.texi @@ -123,6 +123,11 @@ This is a subcategory of @code{file-error}. @xref{File Locks}. @item file-supersession This is a subcategory of @code{file-error}. @xref{Modification Time}. +@c filenotify.el +@item file-notify-error +This is a subcategory of @code{file-error}. It happens, when a file +could not be watched for changes. @xref{File Notifications}. + @c net/ange-ftp.el @item ftp-error This is a subcategory of @code{file-error}, which results from diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi index 4b5ef187383..4b83d575fef 100644 --- a/doc/lispref/eval.texi +++ b/doc/lispref/eval.texi @@ -432,6 +432,14 @@ do. and which are used without evaluation. Whether a particular argument is evaluated may depend on the results of evaluating other arguments. + If an expression's first symbol is that of a special form, the +expression should follow the rules of that special form; otherwise, +Emacs's behavior is not well-defined (though it will not crash). For +example, @code{((lambda (x) x . 3) 4)} contains a subexpression that +begins with @code{lambda} but is not a well-formed @code{lambda} +expression, so Emacs may signal an error, or may return 3 or 4 or +@code{nil}, or may behave in other ways. + Here is a list, in alphabetical order, of all of the special forms in Emacs Lisp with a reference to where each is described. @@ -463,6 +471,9 @@ Emacs Lisp with a reference to where each is described. @item interactive @pxref{Interactive Call} +@item lambda +@pxref{Lambda Expressions} + @item let @itemx let* @pxref{Local Variables} diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 951d55ac90f..77b097ae90a 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2772,16 +2772,17 @@ first, before handlers for jobs such as remote file access. @code{file-equal-p}, @code{file-executable-p}, @code{file-exists-p}, @code{file-in-directory-p}, -@code{file-local-copy}, @code{file-remote-p}, +@code{file-local-copy}, @code{file-modes}, @code{file-name-all-completions}, @code{file-name-as-directory}, @code{file-name-completion}, @code{file-name-directory}, @code{file-name-nondirectory}, @code{file-name-sans-versions}, @code{file-newer-than-file-p}, +@code{file-notify-add-watch}, @code{file-notify-rm-watch}, @code{file-ownership-preserved-p}, @code{file-readable-p}, @code{file-regular-p}, -@code{file-selinux-context}, +@code{file-remote-p}, @code{file-selinux-context}, @code{file-symlink-p}, @code{file-truename}, @code{file-writable-p}, @code{find-backup-file-name}, @c Not sure why it was here: @code{find-file-noselect},@* @@ -2820,20 +2821,21 @@ first, before handlers for jobs such as remote file access. @code{file-accessible-direc@discretionary{}{}{}tory-p}, @code{file-acl}, @code{file-attributes}, -@code{file-direct@discretionary{}{}{}ory-p}, +@code{file-direc@discretionary{}{}{}tory-p}, @code{file-equal-p}, @code{file-executable-p}, @code{file-exists-p}, @code{file-in-directory-p}, -@code{file-local-copy}, @code{file-remote-p}, +@code{file-local-copy}, @code{file-modes}, @code{file-name-all-completions}, @code{file-name-as-directory}, @code{file-name-completion}, @code{file-name-directory}, @code{file-name-nondirec@discretionary{}{}{}tory}, @code{file-name-sans-versions}, @code{file-newer-than-file-p}, +@code{file-notify-add-watch}, @code{file-notify-rm-watch}, @code{file-ownership-pre@discretionary{}{}{}served-p}, @code{file-readable-p}, @code{file-regular-p}, -@code{file-selinux-context}, +@code{file-remote-p}, @code{file-selinux-context}, @code{file-symlink-p}, @code{file-truename}, @code{file-writable-p}, @code{find-backup-file-name}, @c Not sure why it was here: @code{find-file-noselect}, diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index b481c330f9f..071fcf526da 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -34,7 +34,8 @@ terminal and the screen. * X11 Keysyms:: Operating on key symbols for X Windows. * Batch Mode:: Running Emacs without terminal interaction. * Session Management:: Saving and restoring state with X Session Management. -* Notifications:: Desktop notifications. +* Desktop Notifications:: Desktop notifications. +* File Notifications:: File notifications. * Dynamic Libraries:: On-demand loading of support libraries. @end menu @@ -2270,7 +2271,7 @@ Emacs is restarted by the session manager. @end group @end example -@node Notifications +@node Desktop Notifications @section Desktop Notifications @cindex desktop notifications @@ -2510,6 +2511,156 @@ If @var{SPEC_VERSION} is @code{nil}, the server supports a specification prior to @samp{"1.0"}. @end defun +@node File Notifications +@section Notifications on File Changes +@cindex file notifications + +Several operating systems support watching of filesystems for changes +of files. If configured properly, Emacs links a respective library +like @file{gfilenotify}, @file{inotify}, or @file{w32notify} +statically. These libraries enable watching of filesystems on the +local machine. + +It is also possible to watch filesystems on remote machines, +@pxref{Remote Files,, Remote Files, emacs, The GNU Emacs Manual} +This does not depend on one of the libraries linked to Emacs. + +Since all these libraries emit different events on notified file +changes, there is the Emacs library @code{filenotify} which provides a +unique interface. + +@defun file-notify-add-watch file flags callback +Add a watch for filesystem events pertaining to @var{file}. This +arranges for filesystem events pertaining to @var{file} to be reported +to Emacs. + +The returned value is a descriptor for the added watch. Its type +depends on the underlying library, it cannot be assumed to be an +integer as in the example below. It should be used for comparison by +@code{equal} only. + +If the @var{file} cannot be watched for some reason, this function +signals a @code{file-notify-error} error. + +Sometimes, mounted filesystems cannot be watched for file changes. +This is not detected by this function, a non-@code{nil} return value +does not guarantee that changes on @var{file} will be notified. + +@var{flags} is a list of conditions to set what will be watched for. +It can include the following symbols: + +@table @code +@item change +watch for file changes +@item attribute-change +watch for file attribute changes, like permissions or modification +time +@end table + +If @var{file} is a directory, changes for all files in that directory +will be notified. This does not work recursively. + +When any event happens, Emacs will call the @var{callback} function +passing it a single argument @var{event}, which is of the form + +@lisp +(@var{descriptor} @var{action} @var{file} [@var{file1}]) +@end lisp + +@var{descriptor} is the same object as the one returned by this +function. @var{action} is the description of the event. It could be +any one of the following symbols: + +@table @code +@item created +@var{file} was created +@item deleted +@var{file} was deleted +@item changed +@var{file} has changed +@item renamed +@var{file} has been renamed to @var{file1} +@item attribute-changed +a @var{file} attribute was changed +@end table + +@var{file} and @var{file1} are the name of the file(s) whose event is +being reported. For example: + +@example +@group +(require 'filenotify) + @result{} filenotify +@end group + +@group +(defun my-notify-callback (event) + (message "Event %S" event)) + @result{} my-notify-callback +@end group + +@group +(file-notify-add-watch + "/tmp" '(change attribute-change) 'my-notify-callback) + @result{} 35025468 +@end group + +@group +(write-region "foo" nil "/tmp/foo") + @result{} Event (35025468 created "/tmp/.#foo") + Event (35025468 created "/tmp/foo") + Event (35025468 changed "/tmp/foo") + Event (35025468 deleted "/tmp/.#foo") +@end group + +@group +(write-region "bla" nil "/tmp/foo") + @result{} Event (35025468 created "/tmp/.#foo") + Event (35025468 changed "/tmp/foo") [2 times] + Event (35025468 deleted "/tmp/.#foo") +@end group + +@group +(set-file-modes "/tmp/foo" (default-file-modes)) + @result{} Event (35025468 attribute-changed "/tmp/foo") +@end group +@end example + +Whether the action @code{renamed} is returned, depends on the used +watch library. It can be expected, when a directory is watched, and +both @var{file} and @var{file1} belong to this directory. Otherwise, +the actions @code{deleted} and @code{created} could be returned in a +random order. + +@example +@group +(rename-file "/tmp/foo" "/tmp/bla") + @result{} Event (35025468 renamed "/tmp/foo" "/tmp/bla") +@end group + +@group +(file-notify-add-watch + "/var/tmp" '(change attribute-change) 'my-notify-callback) + @result{} 35025504 +@end group + +@group +(rename-file "/tmp/bla" "/var/tmp/bla") + @result{} ;; gfilenotify + Event (35025468 renamed "/tmp/bla" "/var/tmp/bla") + + @result{} ;; inotify + Event (35025504 created "/var/tmp/bla") + Event (35025468 deleted "/tmp/bla") +@end group +@end example +@end defun + +@defun file-notify-rm-watch descriptor +Removes an existing file watch specified by its @var{descriptor}. +@var{descriptor} should be an object returned by +@code{file-notify-add-watch}. +@end defun @node Dynamic Libraries @section Dynamically Loaded Libraries diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index f2a4b3849dd..1f65f687014 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -1355,10 +1355,9 @@ within that frame. @var{frame} should be a live frame; if omitted or @defun set-frame-selected-window frame window &optional norecord This function makes @var{window} the window selected within the frame -@var{frame}. @var{frame} should be a live frame; if omitted or -@code{nil}, it defaults to the selected frame. @var{window} should be -a live window; if omitted or @code{nil}, it defaults to the selected -window. +@var{frame}. @var{frame} should be a live frame; if @code{nil}, it +defaults to the selected frame. @var{window} should be a live window; +if @code{nil}, it defaults to the selected window. If @var{frame} is the selected frame, this makes @var{window} the selected window. @@ -1925,6 +1924,10 @@ frames to search for a reusable window: A frame means consider windows on that frame only. @end itemize +Note that these meanings differ slightly from those of the +@var{all-frames} argument to @code{next-window} (@pxref{Cyclic Window +Ordering}). + If @var{alist} contains no @code{reusable-frames} entry, this function normally searches just the selected frame; however, if the variable @code{pop-up-frames} is non-@code{nil}, it searches all frames on the diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 2fe1914f926..da2491cb94a 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,37 @@ +2013-07-25 Glenn Morris <rgm@gnu.org> + + * Makefile.in (INFO_TARGETS, DVI_TARGETS, PDF_TARGETS): Add ido. + (ido, $(buildinfodir)/ido$(INFO_EXT), ido.dvi, ido.pdf): New rules. + + * erc.texi (Special Features): Update contact information. + (History): Avoid using @email. + + * eshell.texi (Bugs and ideas): Minor updates. + + * faq.texi (Reporting bugs, Origin of the term Emacs) + (Setting up a customization file) + (Using an already running Emacs process, Turning off beeping) + (Packages that do not come with Emacs) + (Replying to the sender of a message): Avoid using @email. + + * pcl-cvs.texi (Contributors, Bugs): Avoid using @email. + + * reftex.texi (Imprint): Avoid using @email. + + * ses.texi (Top): Update bug reporting instructions. + (Acknowledgments): Avoid using @email. + + * woman.texi (Introduction, Background): Remove outdated information. + (Bugs, Acknowledgments): Avoid using @email. + +2013-07-24 Xue Fuqiao <xfq.free@gmail.com> + + * ido.texi: New file. + +2013-07-19 Geoff Kuenning <geoff@cs.hmc.edu> (tiny change) + + * gnus.texi (Customizing Articles): Document function predicates. + 2013-07-08 Tassilo Horn <tsdh@gnu.org> * gnus.texi (lines): Correct description of @@ -1088,7 +1122,7 @@ corresponding function names, according to `org-agenda-view-mode-dispatch'. -2012-09-30 Jan Bäcker <jan.boecker@jboecker.de> +2012-09-30 Jan Böcker <jan.boecker@jboecker.de> * org.texi (The spreadsheet): Fix typo. diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in index 4fb4865b8a4..67a899af8ce 100644 --- a/doc/misc/Makefile.in +++ b/doc/misc/Makefile.in @@ -1,4 +1,4 @@ -#### Makefile for documentation other than the Emacs manual. +### @configure_input@ # Copyright (C) 1994, 1996-2013 Free Software Foundation, Inc. @@ -45,7 +45,7 @@ MAKEINFO_OPTS = --force -I$(emacsdir) INFO_TARGETS = ada-mode auth autotype bovine calc ccmode cl \ dbus dired-x ebrowse ede ediff edt eieio \ emacs-mime epa erc ert eshell eudc efaq \ - flymake forms gnus emacs-gnutls htmlfontify idlwave info.info \ + flymake forms gnus emacs-gnutls htmlfontify idlwave ido info.info \ mairix-el message mh-e newsticker nxml-mode \ org pcl-cvs pgg rcirc remember reftex sasl \ sc semantic ses sieve smtpmail speedbar srecode tramp \ @@ -79,6 +79,7 @@ DVI_TARGETS = \ emacs-gnutls.dvi \ htmlfontify.dvi \ idlwave.dvi \ + ido.dvi \ info.dvi \ mairix-el.dvi \ message.dvi \ @@ -135,6 +136,7 @@ PDF_TARGETS = \ htmlfontify.pdf \ emacs-gnutls.pdf \ idlwave.pdf \ + ido.pdf \ info.pdf \ mairix-el.pdf \ message.pdf \ @@ -452,6 +454,15 @@ idlwave.dvi: ${srcdir}/idlwave.texi ${gfdl} idlwave.pdf: ${srcdir}/idlwave.texi ${gfdl} $(ENVADD) $(TEXI2PDF) ${srcdir}/idlwave.texi +ido : $(buildinfodir)/ido$(INFO_EXT) +$(buildinfodir)/ido$(INFO_EXT): ${srcdir}/ido.texi $(emacsdir)/emacsver.texi ${gfdl} + $(mkinfodir) + $(MAKEINFO) $(MAKEINFO_OPTS) $(INFO_OPTS) -o $@ ${srcdir}/ido.texi +ido.dvi: ${srcdir}/ido.texi $(emacsdir)/emacsver.texi ${gfdl} + $(ENVADD) $(TEXI2DVI) ${srcdir}/ido.texi +ido.pdf: ${srcdir}/ido.texi $(emacsdir)/emacsver.texi ${gfdl} + $(ENVADD) $(TEXI2PDF) ${srcdir}/ido.texi + # NB this one needs --no-split even without a .info extension. # Avoid name clash with overall "info" target. info.info : $(buildinfodir)/info$(INFO_EXT) diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 33686fd79fd..abf0766ee8f 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -234,9 +234,8 @@ forwards. Different channels and servers may have different language encodings. -In addition, it is possible to translate the messages that ERC uses -into multiple languages. Please contact the developers of Emacs at -@email{emacs-devel@@gnu.org} if you are interested in helping with the +multiple languages. Please contact the Emacs developers +if you are interested in helping with the translation effort. @item user scripting @@ -784,9 +783,9 @@ To report a bug in ERC, use @kbd{M-x report-emacs-bug}. @chapter History @cindex history, of ERC -ERC was originally written by Alexander L. Belikoff -@email{abel@@bfr.co.il} and Sergey Berezin -@email{sergey.berezin@@cs.cmu.edu}. They stopped development around +@c abel@@bfr.co.il, sergey.berezin@@cs.cmu.edu +ERC was originally written by Alexander L. Belikoff and Sergey Berezin. +They stopped development around December 1999. Their last released version was ERC 2.0. P.S.: If one of the original developers of ERC reads this, we'd like to @@ -796,8 +795,9 @@ general. @itemize @item 2001 -In June 2001, Mario Lang @email{mlang@@delysid.org} and Alex Schroeder -@email{alex@@gnu.org} took over development and created a ERC Project at +@c mlang@@delysid.org, alex@@gnu.org +In June 2001, Mario Lang and Alex Schroeder +took over development and created a ERC Project at @uref{http://sourceforge.net/projects/erc}. In reaction to a mail about the new ERC development effort, Sergey @@ -825,7 +825,8 @@ ERC 4.0 was released. @item 2005 -ERC 5.0 was released. Michael Olson @email{mwolson@@gnu.org} became +@c mwolson@@gnu.org +ERC 5.0 was released. Michael Olson became the release manager and eventually the maintainer. After some discussion between him and the Emacs developers, it was diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index bd0ac0828cc..4604b262e72 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -819,16 +819,18 @@ Eshell module.} You also need to load the following as shown: @cindex known bugs @cindex bugs, known -If you find a bug or misfeature, don't hesitate to let me know! Send -email to @email{johnw@@gnu.org}. Feature requests should also be sent -there. I prefer discussing one thing at a time. If you find several +If you find a bug or misfeature, don't hesitate to report it, by +using @kbd{M-x report-emacs-bug}. The same applies to feature requests. +It is best to discuss one thing at a time. If you find several unrelated bugs, please report them separately. +@ignore If you have ideas for improvements, or if you have written some extensions to this package, I would like to hear from you. I hope you find this package useful! +@end ignore -Below is a complete list of known problems with Eshell version 2.4.2, +Below is a list of some known problems with Eshell version 2.4.2, which is the version included with Emacs 22. @table @asis diff --git a/doc/misc/faq.texi b/doc/misc/faq.texi index 18e3340a474..1354f68cc9f 100644 --- a/doc/misc/faq.texi +++ b/doc/misc/faq.texi @@ -444,9 +444,9 @@ mail-to-news gateway). The correct way to report Emacs bugs is to use the command @kbd{M-x report-emacs-bug}. It sets up a mail buffer with the -essential information and the correct e-mail address, which is -@email{bug-gnu-emacs@@gnu.org} for the released versions of Emacs. -Anything sent to @email{bug-gnu-emacs@@gnu.org} also appears in the +essential information and the correct e-mail address, +@email{bug-gnu-emacs@@gnu.org}. +Anything sent there also appears in the newsgroup @uref{news:gnu.emacs.bug}, but please use e-mail instead of news to submit the bug report. This ensures a reliable return address so you can be contacted for further details. @@ -459,13 +459,17 @@ report (@pxref{Bugs, , Reporting Bugs, emacs, The GNU Emacs Manual}). RMS says: @quotation -Sending bug reports to @email{help-gnu-emacs@@gnu.org} (which has the -effect of posting on @uref{news:gnu.emacs.help}) is undesirable because -it takes the time of an unnecessarily large group of people, most of -whom are just users and have no idea how to fix these problem. -@email{bug-gnu-emacs@@gnu.org} reaches a much smaller group of people -who are more likely to know what to do and have expressed a wish to -receive more messages about Emacs than the others. +Sending bug reports to +@url{http://lists.gnu.org/mailman/listinfo/help-gnu-emacs, +the help-gnu-emacs mailing list} +(which has the effect of posting on @uref{news:gnu.emacs.help}) is +undesirable because it takes the time of an unnecessarily large group +of people, most of whom are just users and have no idea how to fix +these problem. +@url{http://lists.gnu.org/mailman/listinfo/bug-gnu-emacs, The +bug-gnu-emacs list} reaches a much smaller group of people who are +more likely to know what to do and have expressed a wish to receive +more messages about Emacs than the others. @end quotation RMS says it is sometimes fine to post to @uref{news:gnu.emacs.help}: @@ -960,7 +964,8 @@ by RMS for the editor TECO (Text Editor and COrrector, originally Tape Editor and COrrector) under ITS (the Incompatible Timesharing System) on a PDP-10. RMS had already extended TECO with a ``real-time'' full-screen mode with reprogrammable keys. Emacs was started by -@email{gls@@east.sun.com, Guy Steele} as a project to unify the many +@c gls@@east.sun.com +Guy Steele as a project to unify the many divergent TECO command sets and key bindings at MIT, and completed by RMS. @@ -1340,7 +1345,9 @@ of files from Macintosh, Microsoft, and Unix platforms. In general, new Emacs users should not be provided with @file{.emacs} files, because this can cause confusing non-standard behavior. Then -they send questions to @email{help-gnu-emacs@@gnu.org} asking why Emacs +they send questions to +@url{http://lists.gnu.org/mailman/listinfo/help-gnu-emacs, +the help-gnu-emacs mailing list} asking why Emacs isn't behaving as documented. Emacs includes the Customize facility (@pxref{Using Customize}). This @@ -1805,7 +1812,8 @@ requested by @code{emacsclient}, Emacs will switch to it; otherwise @cindex @code{gnuserv} There is an alternative version of @samp{emacsclient} called -@samp{gnuserv}, written by @email{ange@@hplb.hpl.hp.com, Andy Norman} +@c ange@@hplb.hpl.hp.com +@samp{gnuserv}, written by Andy Norman (@pxref{Packages that do not come with Emacs}). @samp{gnuserv} uses Internet domain sockets, so it can work across most network connections. @@ -1973,7 +1981,8 @@ On some systems, @key{Insert} toggles @code{overwrite-mode} on and off. @cindex Visible bell @cindex Bell, visible -@email{martin@@cc.gatech.edu, Martin R. Frank} writes: +@c martin@@cc.gatech.edu +Martin R. Frank writes: Tell Emacs to use the @dfn{visible bell} instead of the audible bell, and set the visible bell to nothing. @@ -3304,7 +3313,7 @@ to get more details about the features that it offers, and then if you wish, Emacs can download and automatically install it for you. @uref{http://www.damtp.cam.ac.uk/user/sje30/emacs/ell.html, The Emacs Lisp -List (ELL)}, maintained by @email{S.J.Eglen@@damtp.cam.ac.uk, Stephen Eglen}, +List (ELL)}, maintained by Stephen Eglen, aims to provide one compact list with links to all of the current Emacs Lisp files on the Internet. The ELL can be browsed over the web, or from Emacs with @uref{http://www.damtp.cam.ac.uk/user/sje30/emacs/ell.el, @@ -4313,7 +4322,8 @@ these systems, you should configure @code{movemail} to use @code{flock}. @cindex Sender, replying only to @cindex Rmail, replying to the sender of a message in -@email{isaacson@@seas.upenn.edu, Ron Isaacson} says: When you hit +@c isaacson@@seas.upenn.edu +Ron Isaacson says: When you hit @key{r} to reply in Rmail, by default it CCs all of the original recipients (everyone on the original @samp{To} and @samp{CC} lists). With a prefix argument (i.e., typing @kbd{C-u} before @key{r}), diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index e5ba2c19eec..be0425a679b 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -11858,6 +11858,11 @@ predicate. The following predicates are recognized: @code{or}, (typep "text/x-vcard")) @end lisp +@item +A function: the function is called with no arguments and should return +@code{nil} or non-@code{nil}. The current article is available in the +buffer named by @code{gnus-article-buffer}. + @end enumerate You may have noticed that the word @dfn{part} is used here. This refers diff --git a/doc/misc/ido.texi b/doc/misc/ido.texi new file mode 100644 index 00000000000..e61a90463c5 --- /dev/null +++ b/doc/misc/ido.texi @@ -0,0 +1,712 @@ +\input texinfo @c -*-texinfo-*- +@setfilename ../../info/ido +@settitle Interactive Do +@include emacsver.texi + +@copying +This file documents the Ido package for GNU Emacs. + +Copyright @copyright{} 2013 Free Software Foundation, Inc. + +@quotation +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation; with no +Invariant Sections, with the Front-Cover texts being ``A GNU Manual'', +and with the Back-Cover Texts as in (a) below. A copy of the license +is included in the section entitled ``GNU Free Documentation License''. + +(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and +modify this GNU manual.'' +@end quotation +@end copying + +@dircategory Emacs lisp libraries +@direntry +* Ido: (ido). Interactively do things with buffers and files. +@end direntry + +@finalout + +@titlepage +@sp 6 +@center @titlefont{Interactive Do} +@sp 4 +@center For GNU Emacs +@sp 1 +@center as distributed with Emacs @value{EMACSVER} +@sp 5 +@center Kim F. Storm +@center storm@@cua.dk +@page +@vskip 0pt plus 1filll +@insertcopying +@end titlepage + +@contents + +@ifnottex +@node Top +@top Interactive Do + +@insertcopying +@end ifnottex + +@menu +* Overview:: Basics, activation. +* Matching:: Interactivity, matching, scrolling. +* Highlighting:: Highlighting of matching items. +* Hidden Buffers and Files:: Hidden buffers, files, and directories. +* Customization:: Change the Ido functionality. +* Misc:: Various other features. + +Appendices +* GNU Free Documentation License:: The license for this documentation. + +Indexes +* Variable Index:: An entry for each documented variable. + +@detailmenu + --- The Detailed Node Listing --- + +Overview + +* Activation:: How to use this package. + +Matching + +* Interactive Substring Matching:: Interactivity, matching, scrolling. +* Prefix Matching:: Standard completion. +* Flexible Matching:: More flexible matching. +* Regexp Matching:: Matching using regular expression. + +Customization + +* Changing List Order:: Changing the list of files. +* Find File At Point:: Make Ido guess the context. +* Ignoring:: Ignorance is bliss. +* Misc Customization:: Miscellaneous customization for Ido. + +Miscellaneous + +* All Matching:: Seeing all the matching buffers or files. +* Replacement:: Replacement for @code{read-buffer} and @code{read-file-name}. +* Other Packages:: Don't want to depend on @code{ido-everywhere}? + +@end detailmenu +@end menu + +@node Overview +@chapter Overview +@cindex overview + +@noindent +This document describes a set of features that can interactively do +things with buffers and files. All the features are described here +in detail. + +The @dfn{Ido} package can let you switch between buffers and visit +files and directories with a minimum of keystrokes. It is a superset +of Iswitchb, the interactive buffer switching package by Stephen +Eglen. + +@cindex author of Ido +@cindex Iswitchb +This package was originally written by Kim F. Storm, based on the + @file{iswitchb.el} package by Stephen Eglen. + +@menu +* Activation:: How to use this package. +@end menu + +@node Activation +@section Activation +@cindex activation +@cindex installation + +@noindent +This package is distributed with Emacs, so there is no need to install +any additional files in order to start using it. To activate, use +@kbd{M-x ido-mode}. + +@noindent +You may wish to add the following expressions to your initialization +file (@pxref{Init File,,The Emacs Initialization File, emacs, GNU +Emacs Manual}), if you make frequent use of features from this +package. + +@example +(require 'ido) +(ido-mode t) +@end example + +@c @node Working Directories +@c @section Working Directories +@c @cindex working directories + +@node Matching +@chapter Matching +@cindex matching + +@noindent +This section describes features of this package that have to +do with various kinds of @emph{matching}: among buffers, files, and directories. + +@menu +* Interactive Substring Matching:: Interactivity, matching, scrolling. +* Prefix Matching:: Standard completion. +* Flexible Matching:: More flexible matching. +* Regexp Matching:: Matching using regular expression. +@end menu + +@node Interactive Substring Matching +@section Interactive Substring Matching +@cindex interactive substring matching +@cindex substring, interactive matching +@cindex matching, using substring + +@noindent +As you type in a substring, the list of buffers or files currently +matching the substring are displayed as you type. The list is +ordered so that the most recent buffers or files visited come at +the start of the list. + +The buffer or file at the start of the list will be the one visited +when you press @key{RET}. By typing more of the substring, the list +is narrowed down so that gradually the buffer or file you want will be +at the top of the list. Alternatively, you can use @kbd{C-s} and +@kbd{C-r} (or the right and left arrow keys) to rotate buffer or file +names in the list until the one you want is at the top of the list. + +Completion is also available so that you can see what is common to +all of the matching buffers or files as you type. + +For example, if there are two buffers called @file{123456} and +@file{123}, with @file{123456} the most recent, when using +@code{ido-switch-buffer}, you first of all get presented with the list +of all the buffers + +@example +Buffer: @{123456 | 123@} +@end example + +If you then press @kbd{2}: + +@example +Buffer: 2[3]@{123456 | 123@} +@end example + +The list in @{...@} are the matching buffers, most recent first +(buffers visible in the current frame are put at the end of the list +by default). At any time you can select the item at the head of the +list by pressing @key{RET}. You can also put the first element at the +end of the list by pressing @kbd{C-s} or @kbd{<right>}, or bring the +last element to the head of the list by pressing @kbd{C-r} or +@kbd{<left>}. + +The item in [...] indicates what can be added to your input by +pressing @key{TAB} (@code{ido-complete}). In this case, you will get +"3" added to your input. + +So, press @key{TAB}: + +@example +Buffer: 23@{123456 | 123@} +@end example + +At this point, you still have two matching buffers. If you want the +first buffer in the list, you can simply press @key{RET}. If you want +the second in the list, you can press @kbd{C-s} to move it to the top +of the list and then press @kbd{RET} to select it. + +However, if you type @kbd{4}, you'll only have one match left: + +@example +Buffer: 234[123456] +@end example + +Since there is only one matching buffer left, it is given in [] and it +is shown in the @code{ido-only-match} face (ForestGreen). You can now +press @key{TAB} or @key{RET} to go to that buffer. + +If you want to create a new buffer named @file{234}, you can press +@kbd{C-j} (@code{ido-select-text}) instead of @key{TAB} or @key{RET}. + +If instead, you type @kbd{a}: + +@example +Buffer: 234a [No match] +@end example + +There are no matching buffers. If you press @key{RET} or @key{TAB}, +you can be prompted to create a new buffer called @file{234a}. + +Of course, where this function comes in really useful is when you can +specify the buffer using only a few keystrokes. In the above example, +the quickest way to get to the @file{123456} file would be just to +type @kbd{4} and then @key{RET} (assuming there isn't any newer buffer +with @kbd{4} in its name). + +Likewise, if you use @kbd{C-x C-f} (@code{ido-find-file}), the list of +files and directories in the current directory is provided in the same +fashion as the buffers above. The files and directories are normally +sorted in alphabetical order, but the most recently visited directory +is placed first to speed up navigating to directories that you have +visited recently. + +In addition to scrolling through the list using @kbd{<right>} and +@kbd{<left>}, you can use @kbd{<up>} and @kbd{<down>} to quickly +scroll the list to the next or previous subdirectory. + +To go down into a subdirectory, and continue the file selection on +the files in that directory, simply move the directory to the head +of the list and hit @key{RET}. + +To go up to the parent directory, delete any partial file name already +specified (e.g. using @key{DEL}) and hit @key{DEL}. + +@c @defun ido-delete-backward-updir + +@cindex root directory +@cindex home directory +To go to the root directory (on the current drive), enter two slashes. +On MS-DOS or Windows, to select the root of another drive, enter +@samp{X:/} where @samp{X} is the drive letter. To go to the home +directory, enter @samp{~/}. To enter Dired for this directory, use +@kbd{C-d}. + +@c TODO: a new node for ftp hosts +@cindex ftp hosts +You can also visit files on other hosts using the ange-ftp +notations @samp{/host:} and @samp{/user@@host:}. +@c @defvr {User Option} ido-record-ftp-work-directories +@c @defvr {User Option} ido-merge-ftp-work-directories +@c @defvr {User Option} ido-cache-ftp-work-directory-time +@c @defvr {User Option} ido-slow-ftp-hosts +@c @defvr {User Option} ido-slow-ftp-host-regexps + +You can type @kbd{M-p} and @kbd{M-n} to change to previous/next +directories from the history, @kbd{M-s} to search for a file matching +your input, and @kbd{M-k} to remove the current directory from the history. + +If for some reason you cannot specify the proper file using +@code{ido-find-file}, you can press @kbd{C-f} to enter the normal +@code{find-file}. You can also press @kbd{C-b} to drop into +@code{ido-switch-buffer}. + +@c @kindex C-x b +@c @findex ido-switch-buffer +@c @defun ido-switch-buffer +@c This command switch to another buffer interactively. +@c @end defun + +@c @kindex C-x C-f +@c @findex ido-find-file +@c @defun ido-find-file +@c Edit file with name obtained via minibuffer. +@c @end defun + +@c @kindex C-x d +@c @findex ido-dired +@c @defun ido-dired +@c Call Dired the Ido way. +@c @end defun + +@node Prefix Matching +@section Prefix Matching +@cindex prefix matching +@cindex matching, using prefix +@cindex standard way of completion + +@noindent +The standard way of completion with *nix shells and Emacs is to insert +a @dfn{prefix} and then hitting @key{TAB} (or another completion key). +Cause of this behavior has become second nature to a lot of Emacs +users Ido offers in addition to the default substring matching method +(look above) also the prefix matching method. The kind of matching is +the only difference to the description of the substring matching +above. + +You can toggle prefix matching with @kbd{C-p} +(@code{ido-toggle-prefix}). + +For example, if you have two buffers @file{123456} and @file{123} then +hitting @kbd{2} does not match because @kbd{2} is not a prefix in any +of the buffer names. + +@node Flexible Matching +@section Flexible Matching +@cindex flexible matching + +@defvr {User Option} ido-enable-flex-matching +If non-@code{nil}, Ido will do flexible string matching. Flexible +matching means that if the entered string does not match any item, any +item containing the entered characters in the given sequence will +match. +@end defvr + +@noindent +If @code{ido-enable-flex-matching} is non-@code{nil}, Ido will do a +more flexible matching (unless regexp matching is active) to find +possible matches among the available buffer or file names if no +matches are found using the normal prefix or substring matching. + +The flexible matching implies that any item which simply contains all +of the entered characters in the specified sequence will match. + +For example, if you have four files @file{alpha}, @file{beta}, +@file{gamma}, and @file{delta}, entering @samp{aa} will match +@file{alpha} and @file{gamma}, while @samp{ea} matches @file{beta} and +@file{delta}. If prefix matching is also active, @samp{aa} only +matches @file{alpha}, while @samp{ea} does not match any files. + +@node Regexp Matching +@section Regular Expression Matching +@cindex regexp matching +@cindex matching, using regular expression + +@noindent +There is limited provision for regexp matching within Ido, enabled +through @code{ido-enable-regexp} (toggle with @kbd{C-t}). This allows +you to type @samp{[ch]$} for example and see all file names ending in +@samp{c} or @samp{h}. + +@defvr {User Option} ido-enable-regexp +If the value of this user option is non-@code{nil}, Ido will do regexp +matching. The value of this user option can be toggled within +ido-mode using @code{ido-toggle-regexp}. +@end defvr + +@strong{Please notice:} Ido-style completion is inhibited when you +enable regexp matching. + +@node Highlighting +@chapter Highlighting +@cindex highlighting + +@noindent +The highlighting of matching items is controlled via +@code{ido-use-faces}. The faces used are @code{ido-first-match}, +@code{ido-only-match} and @code{ido-subdir}. + +Coloring of the matching item was suggested by Carsten Dominik. + +@node Hidden Buffers and Files +@chapter Hidden Buffers and Files +@cindex hidden buffers and files + +Normally, Ido does not include hidden buffers (whose name starts with +a space) and hidden files and directories (whose name starts with +@samp{.}) in the list of possible completions. However, if the +substring you enter does not match any of the visible buffers or +files, Ido will automatically look for completions among the hidden +buffers or files. + +You can toggle display of the hidden buffers and files with @kbd{C-a} +(@code{ido-toggle-ignore}). + +@c @defun ido-toggle-ignore + +@node Customization +@chapter Customization +@cindex customization + +@noindent +You can customize the @code{ido} group to change Ido functionality: + +@example +M-x customize-group RET ido RET +@end example + +@noindent +or customize a certain variable: + +@example +M-x customize-variable RET ido-xxxxx +@end example + +To modify the keybindings, use the @code{ido-setup-hook}. For example: + +@example +(add-hook 'ido-setup-hook 'ido-my-keys) + +(defun ido-my-keys () + "Add my keybindings for Ido." + (define-key ido-completion-map " " 'ido-next-match)) +@end example + +@menu +* Changing List Order:: Changing the list of files. +* Find File At Point:: Make Ido guess the context. +* Ignoring:: Ignorance is bliss. +* Misc Customization:: Miscellaneous customization for Ido. +@end menu + +@node Changing List Order +@section Changing List Order +@cindex changing order of the list + +@noindent +By default, the list of current files is most recent first, +oldest last, with the exception that the files visible in the +current frame are put at the end of the list. A hook exists to +allow other functions to order the list. For example, if you add: + +@example +(add-hook 'ido-make-buffer-list-hook 'ido-summary-buffers-to-end) +@end example + +@noindent +then all files matching "Summary" are moved to the end of the list. +(I find this handy for keeping the INBOX Summary and so on out of the +way.) It also moves files matching @samp{output\*$} to the end of the +list (these are created by AUCTeX when compiling.) Other functions +could be made available which alter the list of matching files (either +deleting or rearranging elements.) + +@node Find File At Point +@section Find File At Point +@cindex find file at point +@cindex ffap + +@noindent +Find File At Point, also known generally as ``ffap'', is an +intelligent system for opening files, and URLs. + +The following expression will make Ido guess the context: + +@example +(setq ido-use-filename-at-point 'guess) +@end example + +@c @defvr {User Option} ido-use-filename-at-point +@c If the value of this user option is non-@code{nil}, ... +@c @end defvr + +You can disable URL ffap support by toggling +@code{ido-use-url-at-point}. + +@defvr {User Option} ido-use-url-at-point +If the value of this user option is non-@code{nil}, Ido will look for +a URL at point. If found, call @code{find-file-at-point} to visit it. +@end defvr + +@node Ignoring +@section Ignoring Buffers and Files +@cindex ignoring +@cindex regexp, ignore buffers and files + +@noindent +Ido is capable of ignoring buffers, directories, files and extensions +using regular expression. + +@defvr {User Option} ido-ignore-buffers +This variable takes a list of regular expressions for buffers to +ignore in @code{ido-switch-buffer}. +@end defvr + +@defvr {User Option} ido-ignore-directories +This variable takes a list of regular expressions for (sub)directories +names to ignore in @code{ido-dired} and @code{ido-find-file}. +@end defvr + +@defvr {User Option} ido-ignore-files +This variable takes a list of regular expressions for files to ignore +in @code{ido-find-file}. +@end defvr + +@defvr {User Option} ido-ignore-unc-host-regexps +This variable takes a list of regular expressions matching UNC hosts +to ignore. The letter case will be ignored if +@code{ido-downcase-unc-hosts} is non-@code{nil}. +@end defvr + +@c @defvr {User Option} ido-work-directory-list-ignore-regexps + +To make Ido use @code{completion-ignored-extensions} you need to +enable it: + +@example +(setq ido-ignore-extensions t) +@end example + +Now you can customize @code{completion-ignored-extensions} as well. +Go ahead and add all the useless object files, backup files, shared +library files and other computing flotsam you don’t want Ido to show. + +@strong{Please notice:} Ido will still complete the ignored elements +if it would otherwise not show any other matches. So if you type out +the name of an ignored file, Ido will still let you open it just fine. + +@node Misc Customization +@section Miscellaneous Customization +@cindex miscellaneous customization for Ido + +@defvr {User Option} ido-mode +This user option determines for which functional group (buffer and +files) Ido behavior should be enabled. +@end defvr + +@defvr {User Option} ido-case-fold +If the value of this user option is non-@code{nil}, searching of +buffer and file names should ignore case. +@end defvr + +@defvr {User Option} ido-show-dot-for-dired +If the value of this user option is non-@code{nil} , always put +@samp{.} as the first item in file name lists. This allows the +current directory to be opened immediately with Dired +@end defvr + +@defvr {User Option} ido-enable-dot-prefix +If the value of this user option is non-@code{nil}, Ido will match +leading dot as prefix. I.e., hidden files and buffers will match only +if you type a dot as first char (even if @code{ido-enable-prefix} is +@code{nil}). +@end defvr + +@c @defvr {User Option} ido-confirm-unique-completion +@c @defvr {User Option} ido-cannot-complete-command +@c @defvr {User Option} ido-record-commands +@c @defvr {User Option} ido-max-file-prompt-width +@c @defvr {User Option} ido-max-window-height +@c @defvr {User Option} ido-enable-last-directory-history +@c @defvr {User Option} ido-max-work-directory-list +@c @defvr {User Option} ido-enable-tramp-completion +@c @defvr {User Option} ido-unc-hosts +@c @defvr {User Option} ido-downcase-unc-hosts +@c @defvr {User Option} ido-cache-unc-host-shares-time +@c @defvr {User Option} ido-max-work-file-list +@c @defvr {User Option} ido-work-directory-match-only +@c @defvr {User Option} ido-auto-merge-work-directories-length +@c @defvr {User Option} ido-auto-merge-delay-time +@c @defvr {User Option} ido-auto-merge-inhibit-characters-regexp +@c @defvr {User Option} ido-merged-indicator +@c @defvr {User Option} ido-max-dir-file-cache +@c @defvr {User Option} ido-max-directory-size +@c @defvr {User Option} ido-rotate-file-list-default +@c @defvr {User Option} ido-enter-matching-directory +@c @defvr {User Option} ido-create-new-buffer +@c @defvr {User Option} ido-setup-hook +@c @defvr {User Option} ido-separator +@c @defvr {User Option} ido-decorations +@c @defvr {User Option} ido-use-virtual-buffers +@c @defvr {User Option} ido-use-faces +@c @defvr {User Option} ido-make-file-list-hook +@c @defvr {User Option} ido-make-dir-list-hook +@c @defvr {User Option} ido-make-buffer-list-hook +@c @defvr {User Option} ido-rewrite-file-prompt-functions +@c @defvr {User Option} ido-completion-buffer +@c @defvr {User Option} ido-completion-buffer-all-completions +@c @defvr {User Option} ido-all-frames +@c @defvr {User Option} ido-minibuffer-setup-hook +@c @defvr {User Option} ido-save-directory-list-file +@c @defvr {User Option} ido-read-file-name-as-directory-commands +@c @defvr {User Option} ido-read-file-name-non-ido +@c @defvr {User Option} ido-before-fallback-functions +@c @defvr {User Option} ido-buffer-disable-smart-matches + +@node Misc +@chapter Miscellaneous +@cindex miscellaneous + +@noindent +After @kbd{C-x b} (@code{ido-switch-buffer}), the buffer at the head +of the list can be killed by pressing @kbd{C-k}. If the buffer needs +saving, you will be queried before the buffer is killed. + +Likewise, after @kbd{C-x C-f}, you can delete (i.e., physically +remove) the file at the head of the list with @kbd{C-k}. You will +always be asked for confirmation before deleting the file. + +If you enter @kbd{C-x b} to switch to a buffer visiting a given file, +and you find that the file you are after is not in any buffer, you can +press @kbd{C-f} to immediately drop into @code{ido-find-file}. And +you can switch back to buffer selection with @kbd{C-b}. + +@c @defun ido-magic-forward-char +@c @defun ido-magic-backward-char + +You can also use Ido in your Emacs Lisp programs: + +@example +(setq my-pkgs (list "CEDET" "Gnus" "Rcirc" "Tramp" "Org" "all-of-them")) +(ido-completing-read "What's your favorite package? " my-pkgs) +@end example + +@menu +* All Matching:: Seeing all the matching buffers or files. +* Replacement:: Replacement for @code{read-buffer} and @code{read-file-name}. +* Other Packages:: Don't want to depend on @code{ido-everywhere}? +@end menu + +@node All Matching +@section All Matching +@cindex all matching +@cindex seeing all the matching buffers or files + +@noindent +If you have many matching files, they may not all fit onto one line of +the minibuffer. Normally, the minibuffer window will grow to show you +more of the matching files (depending on the value of the variables +@code{resize-mini-windows} and @code{max-mini-window-height}). If you +want Ido to behave differently from the default minibuffer resizing +behavior, set the variable @code{ido-max-window-height}. + +Also, to improve the responsiveness of Ido, the maximum number of +matching items is limited to 12, but you can increase or removed this +limit via the @code{ido-max-prospects} user option. + +@c @defvr {User Option} ido-max-prospects + +To see a full list of all matching buffers in a separate buffer, hit +@kbd{?} or press @key{TAB} when there are no further completions to +the substring. Repeated @key{TAB} presses will scroll you through +this separate buffer. + +@node Replacement +@section Replacement + +@noindent +@code{ido-read-buffer} and @code{ido-read-file-name} have been written +to be drop in replacements for the normal buffer and file name reading +functions @code{read-buffer} and @code{read-file-name}. + +To use ido for all buffer and file selections in Emacs, customize the +variable @code{ido-everywhere}. + +@c @defun ido-everywhere +@c @defvr {User Option} ido-everywhere + +@node Other Packages +@section Other Packages +@cindex other packages +@cindex used by other packages + +@noindent +If you don't want to rely on the @code{ido-everywhere} functionality, +@code{ido-read-buffer}, @code{ido-read-file-name}, and +@code{ido-read-directory-name} can be used by other packages to read a +buffer name, a file name, or a directory name in the @emph{Ido} way. + +@c @node Cheetsheet + +@c * History and Acknowledgments:: How Ido came into being +@c @node History and Acknowledgments +@c @appendix History and Acknowledgments + +@node GNU Free Documentation License +@appendix GNU Free Documentation License +@include doclicense.texi + +@c @node Function Index +@c @unnumbered Function Index + +@c @printindex fn + +@node Variable Index +@unnumbered Variable Index + +@printindex vr + +@bye diff --git a/doc/misc/pcl-cvs.texi b/doc/misc/pcl-cvs.texi index 7c294591d0e..1276eb95aa8 100644 --- a/doc/misc/pcl-cvs.texi +++ b/doc/misc/pcl-cvs.texi @@ -172,17 +172,20 @@ Per Cederqvist wrote most of the otherwise unattributed functions in PCL-CVS as well as all the documentation. @item -@email{inge@@lysator.liu.se, Inge Wallin} wrote the skeleton of +@c inge@@lysator.liu.se +Inge Wallin wrote the skeleton of @file{pcl-cvs.texi}, and gave useful comments on it. He also wrote the files @file{elib-node.el} and @file{compile-all.el}. The file @file{cookie.el} was inspired by Inge.@refill @item -@email{linus@@lysator.liu.se, Linus Tolke} contributed useful comments +@c linus@@lysator.liu.se +Linus Tolke contributed useful comments on both the functionality and the documentation.@refill @item -@email{jwz@@jwz.com, Jamie Zawinski} contributed +@c jwz@@jwz.com +Jamie Zawinski contributed @file{pcl-cvs-lucid.el}, which was later renamed to @file{pcl-cvs-xemacs.el}.@refill @@ -191,34 +194,40 @@ Leif Lonnblad contributed RCVS support (since superseded by the new remote CVS support). @item -@email{jimb@@cyclic.com, Jim Blandy} contributed hooks to automatically +@c jimb@@cyclic.com +Jim Blandy contributed hooks to automatically guess CVS log entries from @file{ChangeLog} contents, and initial support of the new Cygnus / Cyclic remote CVS, as well as various sundry bug fixes and cleanups. @item -@email{kingdon@@cyclic.com, Jim Kingdon} contributed lots of fixes to +@c kingdon@@cyclic.com +Jim Kingdon contributed lots of fixes to the build and installation procedure. @item -@email{woods@@weird.com, Greg A. Woods} contributed code to implement +@c woods@@weird.com +Greg A. Woods contributed code to implement the use of per-file diff buffers, and vendor join diffs with emerge and ediff, as well as various and sundry bug fixes and cleanups. @item -@email{greg.klanderman@@alum.mit.edu, Greg Klanderman} implemented +@c greg.klanderman@@alum.mit.edu +Greg Klanderman implemented toggling of marked files, setting of CVS command flags via prefix arguments, updated the XEmacs support, updated the manual, and fixed numerous bugs. @item -@email{monnier@@gnu.org, Stefan Monnier} added a slew of other +@c monnier@@gnu.org +Stefan Monnier added a slew of other features and introduced even more new bugs. If there's any bug left, you can be sure it's his. @item @c wordy to avoid an underfull hbox -@email{masata-y@@is.aist-nara.ac.jp, Masatake YAMATO} made a gracious +@c masata-y@@is.aist-nara.ac.jp +Masatake YAMATO made a gracious contribution of his cvstree code to display a tree of tags which was later superseded by the new @code{cvs-status-mode}. @end itemize @@ -1369,18 +1378,19 @@ Used to highlight CVS messages. @cindex FAQ @cindex Problems, list of common -If you find a bug or misfeature, don't hesitate to tell us! Send email -to @email{bug-gnu-emacs@@gnu.org} which is gatewayed to the newsgroup -@samp{gnu.emacs.bugs}. Feature requests should also be sent there. We -prefer discussing one thing at a time. If you find several unrelated +If you find a bug or misfeature, don't hesitate to tell us! +Use @kbd{M-x report-emacs-bug} to send us a report. +You can follow the same process for feature requests. +We prefer discussing one thing at a time. If you find several unrelated bugs, please report them separately. If you are running PCL-CVS under XEmacs, you should also send a copy of bug reports to -@email{xemacs-beta@@xemacs.org}. +the @url{http://lists.xemacs.org/mailman/listinfo/xemacs-beta, +XEmacs mailing list}. If you have problems using PCL-CVS or other questions, send them to -@email{help-gnu-emacs@@gnu.org}, which is gatewayed to the -@samp{gnu.emacs.help} newsgroup. This is a good place to get help, as -is @email{cvs-info@@gnu.org}, gatewayed to @samp{gnu.cvs.help}. +the @url{http://lists.gnu.org/mailman/listinfo/help-gnu-emacs, +help-gnu-emacs mailing list}. This is a good place to get help, as is +the @url{http://lists.nongnu.org/mailman/listinfo/info-cvs, info-cvs list}. If you have ideas for improvements, or if you have written some extensions to this package, we would like to hear from you. We hope that diff --git a/doc/misc/reftex.texi b/doc/misc/reftex.texi index 312b84146fa..b9cf2335647 100644 --- a/doc/misc/reftex.texi +++ b/doc/misc/reftex.texi @@ -3639,8 +3639,8 @@ With @i{Viper} mode prior to Vipers version 3.01, you need to protect @cindex @code{http}, @RefTeX{} home page @cindex @code{ftp}, @RefTeX{} site -@RefTeX{} was written by @i{Carsten Dominik} -@email{dominik@@science.uva.nl}, with contributions by @i{Stephen +@c dominik@@science.uva.nl +@RefTeX{} was written by @i{Carsten Dominik}, with contributions by @i{Stephen Eglen}. @RefTeX{} is currently maintained by @value{MAINTAINER}, see the @value{MAINTAINERSITE} for detailed information. diff --git a/doc/misc/ses.texi b/doc/misc/ses.texi index 2c84d04c666..a44d790781d 100644 --- a/doc/misc/ses.texi +++ b/doc/misc/ses.texi @@ -60,7 +60,7 @@ by formulas that can refer to the values of other cells. @end display @end ifnottex -To report bugs, send email to @email{jyavner@@member.fsf.org}. +To report bugs, use @kbd{M-x report-emacs-bug}. @insertcopying @@ -997,39 +997,62 @@ cell. Coding by: @quotation -Jonathan Yavner @email{jyavner@@member.fsf.org}@* -Stefan Monnier @email{monnier@@gnu.org}@* -Shigeru Fukaya @email{shigeru.fukaya@@gmail.com} +@c jyavner@@member.fsf.org +Jonathan Yavner, +@c monnier@@gnu.org +Stefan Monnier, +@c shigeru.fukaya@@gmail.com +Shigeru Fukaya @end quotation @noindent Texinfo manual by: @quotation -Jonathan Yavner @email{jyavner@@member.fsf.org}@* -Brad Collins <brad@@chenla.org> +@c jyavner@@member.fsf.org +Jonathan Yavner, +@c brad@@chenla.org +Brad Collins @end quotation @noindent Ideas from: @quotation -Christoph Conrad @email{christoph.conrad@@gmx.de}@* -CyberBob @email{cyberbob@@redneck.gacracker.org}@* -Syver Enstad @email{syver-en@@online.no}@* -Ami Fischman @email{fischman@@zion.bpnetworks.com}@* -Thomas Gehrlein @email{Thomas.Gehrlein@@t-online.de}@* -Chris F.A. Johnson @email{c.f.a.johnson@@rogers.com}@* -Yusong Li @email{lyusong@@hotmail.com}@* -Juri Linkov @email{juri@@jurta.org}@* -Harald Maier @email{maierh@@myself.com}@* -Alan Nash @email{anash@@san.rr.com}@* -François Pinard @email{pinard@@iro.umontreal.ca}@* -Pedro Pinto @email{ppinto@@cs.cmu.edu}@* -Stefan Reichör @email{xsteve@@riic.at}@* -Oliver Scholz @email{epameinondas@@gmx.de}@* -Richard M. Stallman @email{rms@@gnu.org}@* -Luc Teirlinck @email{teirllm@@dms.auburn.edu}@* -J. Otto Tennant @email{jotto@@pobox.com}@* -Jean-Philippe Theberge @email{jphil@@acs.pagesjaunes.fr} +@c christoph.conrad@@gmx.de +Christoph Conrad, +@c cyberbob@@redneck.gacracker.org +CyberBob, +@c syver-en@@online.no +Syver Enstad, +@c fischman@@zion.bpnetworks.com +Ami Fischman, +@c Thomas.Gehrlein@@t-online.de +Thomas Gehrlein, +@c c.f.a.johnson@@rogers.com +Chris F.A. Johnson, +@c lyusong@@hotmail.com +Yusong Li, +@c juri@@jurta.org +Juri Linkov, +@c maierh@@myself.com +Harald Maier, +@c anash@@san.rr.com +Alan Nash, +@c pinard@@iro.umontreal.ca +François Pinard, +@c ppinto@@cs.cmu.edu +Pedro Pinto, +@c xsteve@@riic.at +Stefan Reichör, +@c epameinondas@@gmx.de +Oliver Scholz, +@c rms@@gnu.org +Richard M. Stallman, +@c teirllm@@dms.auburn.edu +Luc Teirlinck, +@c jotto@@pobox.com +J. Otto Tennant, +@c jphil@@acs.pagesjaunes.fr +Jean-Philippe Theberge @end quotation @c =================================================================== diff --git a/doc/misc/woman.texi b/doc/misc/woman.texi index 9b9f9947da5..44a8b5573fa 100644 --- a/doc/misc/woman.texi +++ b/doc/misc/woman.texi @@ -105,10 +105,7 @@ version of Emacs. It was developed primarily on various versions of Microsoft Windows, but has also been tested on MS-DOS, and various versions of UNIX and GNU/Linux. -WoMan is distributed with GNU Emacs. In addition, the current source -code and documentation files are available from -@uref{http://centaur.maths.qmw.ac.uk/Emacs/WoMan/, the WoMan web -server}. +WoMan is distributed with GNU Emacs. WoMan implements a subset of the formatting performed by the Emacs @code{man} (or @code{manual-entry}) command to format a Unix-style @@ -148,11 +145,7 @@ which begin with the prefix @code{woman-} (or occasionally either running the command @code{woman-mini-help} or selecting the WoMan menu option @samp{Mini Help}. -WoMan is (of course) still under development! Please -@email{F.J.Wright@@qmw.ac.uk, let me know} what doesn't work---I am -adding and improving functionality as testing shows that it is -necessary. Guidance on reporting bugs is given below. @xref{Bugs, , -Reporting Bugs}. +Guidance on reporting bugs is given below. @xref{Bugs, , Reporting Bugs}. @c =================================================================== @@ -276,6 +269,7 @@ of the facilities implemented in the Emacs @code{man} library. WoMan and man can happily co-exist, which is very useful for comparison and debugging purposes. +@ignore @code{nroff} simulates non-@acronym{ASCII} characters by using one or more @acronym{ASCII} characters. WoMan should be able to do much better than this. I have recently begun to add support for WoMan to use more of the @@ -284,6 +278,7 @@ aspect that I intend to develop further in the near future. It should be possible to move WoMan from an emulation of @code{nroff} to an emulation of @code{troff} as GNU Emacs moves to providing bit-mapped display facilities. +@end ignore @node Finding @chapter Finding and Formatting Man Pages @@ -1290,8 +1285,8 @@ try the latest version of @file{woman.el} from the Emacs repository on @uref{http://savannah.gnu.org/projects/emacs/}. If it still fails, please @item -send a bug report to @email{bug-gnu-emacs@@gnu.org} and to -@email{F.J.Wright@@qmw.ac.uk}. Please include the entry from the +use @kbd{M-x report-emacs-bug} to send a bug report. +Please include the entry from the @code{*WoMan-Log*} buffer relating to the problem file, together with a brief description of the problem. Please indicate where you got the man source file from, but do not send it unless asked to send it. @@ -1310,43 +1305,80 @@ I also thank the following for helpful suggestions, bug reports, code fragments, general interest, etc.: @quotation -Jari Aalto, @email{jari.aalto@@cs.tpu.fi}@* -Dean Andrews, @email{dean@@dra.com}@* -Juanma Barranquero, @email{barranquero@@laley-actualidad.es}@* -Karl Berry, @email{kb@@cs.umb.edu}@* -Jim Chapman, @email{jchapman@@netcomuk.co.uk}@* -Frederic Corne, @email{frederic.corne@@erli.fr}@* -Peter Craft, @email{craft@@alacritech.com}@* -Charles Curley, @email{ccurley@@trib.com}@* -Jim Davidson, @email{jdavidso@@teknowledge.com}@* -Kevin D'Elia, @email{Kevin.DElia@@mci.com}@* -John Fitch, @email{jpff@@maths.bath.ac.uk}@* -Hans Frosch, @email{jwfrosch@@rish.b17c.ingr.com}@* -Guy Gascoigne-Piggford, @email{ggp@@informix.com}@* -Brian Gorka, @email{gorkab@@sanchez.com}@* -Nicolai Henriksen, @email{nhe@@lyngso-industri.dk}@* -Thomas Herchenroeder, @email{the@@software-ag.de}@* -Alexander Hinds, @email{ahinds@@thegrid.net}@* -Stefan Hornburg, @email{sth@@hacon.de}@* -Theodore Jump, @email{tjump@@cais.com}@* -Paul Kinnucan, @email{paulk@@mathworks.com}@* -Jonas Linde, @email{jonas@@init.se}@* -Andrew McRae, @email{andrewm@@optimation.co.nz}@* -Howard Melman, @email{howard@@silverstream.com}@* -Dennis Pixton, @email{dennis@@math.binghamton.edu}@* -T. V. Raman, @email{raman@@Adobe.com}@* -Bruce Ravel, @email{bruce.ravel@@nist.gov}@* -Benjamin Riefenstahl, @email{benny@@crocodial.de}@* -Kevin Ruland, @email{kruland@@seistl.com}@* -Tom Schutter, @email{tom@@platte.com}@* -Wei-Xue Shi, @email{wxshi@@ma.neweb.ne.jp}@* -Fabio Somenzi, @email{fabio@@joplin.colorado.edu}@* -Karel Sprenger, @email{ks@@ic.uva.nl}@* -Chris Szurgot, @email{szurgot@@itribe.net}@* -Paul A. Thompson, @email{pat@@po.cwru.edu}@* -Arrigo Triulzi, @email{arrigo@@maths.qmw.ac.uk}@* -Geoff Voelker, @email{voelker@@cs.washington.edu}@* -Eli Zaretskii, @email{eliz@@is.elta.co.il} +@c jari.aalto@@cs.tpu.fi +Jari Aalto, +@c dean@@dra.com +Dean Andrews, +@c barranquero@@laley-actualidad.es +Juanma Barranquero, +@c kb@@cs.umb.edu +Karl Berry, +@c jchapman@@netcomuk.co.uk +Jim Chapman, +@c frederic.corne@@erli.fr +Frederic Corne, +@c craft@@alacritech.com +Peter Craft, +@c ccurley@@trib.com +Charles Curley, +@c jdavidso@@teknowledge.com +Jim Davidson, +@c Kevin.DElia@@mci.com +Kevin D'Elia, +@c jpff@@maths.bath.ac.uk +John Fitch, +@c jwfrosch@@rish.b17c.ingr.com +Hans Frosch, +@c ggp@@informix.com +Guy Gascoigne-Piggford, +@c gorkab@@sanchez.com +Brian Gorka, +@c nhe@@lyngso-industri.dk +Nicolai Henriksen, +@c the@@software-ag.de +Thomas Herchenroeder, +@c ahinds@@thegrid.net +Alexander Hinds, +@c sth@@hacon.de +Stefan Hornburg, +@c tjump@@cais.com +Theodore Jump, +@c paulk@@mathworks.com +Paul Kinnucan, +@c jonas@@init.se +Jonas Linde, +@c andrewm@@optimation.co.nz +Andrew McRae, +@c howard@@silverstream.com +Howard Melman, +@c dennis@@math.binghamton.edu +Dennis Pixton, +@c raman@@Adobe.com +T. V. Raman, +@c bruce.ravel@@nist.gov +Bruce Ravel, +@c benny@@crocodial.de +Benjamin Riefenstahl, +@c kruland@@seistl.com +Kevin Ruland, +@c tom@@platte.com +Tom Schutter, +@c wxshi@@ma.neweb.ne.jp +Wei-Xue Shi, +@c fabio@@joplin.colorado.edu +Fabio Somenzi, +@c ks@@ic.uva.nl +Karel Sprenger, +@c szurgot@@itribe.net +Chris Szurgot, +@c pat@@po.cwru.edu +Paul A. Thompson, +@c arrigo@@maths.qmw.ac.uk +Arrigo Triulzi, +@c voelker@@cs.washington.edu +Geoff Voelker, +@c eliz@@is.elta.co.il +Eli Zaretskii @end quotation @c =================================================================== diff --git a/etc/ChangeLog b/etc/ChangeLog index 73bc76a1ff8..c201772cd93 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,21 @@ +2013-07-26 Micah Anderson <micah@riseup.net> (tiny change) + + * spook.lines: Additions. (Bug#14658) + +2013-07-16 Jan Djärv <jan.h.d@swipnet.se> + + * NEWS: Document blink-cursor-blinks and blink timers stopped. + +2013-07-13 Eli Zaretskii <eliz@gnu.org> + + * NEWS: Document prefer-utf-8 and the new attributes + :inhibit-null-byte-detection, :inhibit-iso-escape-detection, and + :prefer-utf-8. + +2013-07-13 Leo Liu <sdl.web@gmail.com> + + * NEWS: Mention new value for ido-use-virtual-buffers. + 2013-07-10 Paul Eggert <eggert@cs.ucla.edu> Timestamp fixes for undo (Bug#14824). @@ -122,6 +122,11 @@ monitor, use the new functions above. Similar notes also apply to Generic commands are interactive functions whose implementation can be selected among several alternatives, as a matter of user preference. +** The blink cursor stops blinking after 10 blinks (default) on X and NS. +You can change the default by customizing the variable blink-cursor-blinks. +Also timers for blinking are stopped when no blinking is done, so Emacs does +not consume CPU cycles. + * Editing Changes in Emacs 24.4 @@ -153,6 +158,10 @@ You can pick the name of the function and the variables with `C-x 4 a'. * Changes in Specialized Modes and Packages in Emacs 24.4 +** The debugger's `e' command evaluates the code in the context at point. +This includes using the lexical environment at point, which means that +`e' now lets you access lexical variables as well. + ** `eshell' now supports visual subcommands and options Eshell has been able to handle "visual" commands (interactive, non-line oriented commands such as top that require display @@ -174,7 +183,6 @@ You can use the new function `remember-store-in-files' within the See `remember-data-directory' and `remember-directory-file-name-format' for new options related to this function. -** `ido-decorations' has been slightly extended to give a bit more control. ** More packages look for ~/.emacs.d/<foo> additionally to ~/.<foo>. Affected files: @@ -253,8 +261,10 @@ on the given date. *** `desktop-auto-save-timeout' defines the number of seconds between auto-saves of the desktop. -*** `desktop-restore-frames' enables saving and restoring the window/frame -configuration. +*** `desktop-restore-frames', enabled by default, allows saving and +restoring the window/frame configuration. Additional options +`desktop-restore-in-current-display' and +`desktop-restoring-reuses-frames' allow further customization. ** Dired @@ -266,6 +276,22 @@ configuration. If set to a number, this can be used to avoid accidentally paste large amounts of data into the ERC input. +** EPA + +*** New option `epa-mail-aliases'. + +You can set this to a list of alias expansions for keys to use +in `epa-mail-encrypt'. + +If one element of the variable's value is ("foo@bar.com" "foo@hello.org"), +that means: when one of the recipients of the message being encrypted +is `foo@bar.com', encrypt the message for `foo@hello.org' instead. + +If one element of the variable's value is ("foo@bar.com"), +that means: when one of the recipients of the message being encrypted +is `foo@bar.com', ignore that name as regards encryption. +This is useful to avoid a query when you have no key for that name. + --- ** New F90 mode option `f90-smart-end-names'. @@ -274,6 +300,11 @@ amounts of data into the ERC input. *** The icomplete-separator is customizable, and its default has changed. *** Removed icomplete-show-key-bindings. +** Ido +*** Ido has a manual now. +*** `ido-use-virtual-buffers' takes a new value 'auto. +*** `ido-decorations' has been slightly extended to give a bit more control. + ** Image mode *** New commands `n' (`image-next-file') and `p' (`image-previous-file') @@ -452,6 +483,13 @@ module. *** The Info-edit command is obsolete. Editing Info nodes by hand has not been relevant for some time. +** Shell + +*** `explicit-bash-args' now always defaults to use --noediting. +During initialization, Emacs no longer expends a process to decide +whether it is safe to use Bash's --noediting option. These days +--noediting is ubiquitous; it was introduced in 1996 in Bash version 2. + * New Modes and Packages in Emacs 24.4 @@ -467,7 +505,8 @@ It is layered as: - advice-add/advice-remove to add/remove a piece of advice on a named function, much like `defadvice' does. -** The package file-notify.el provides an interface for file system ++++ +** The package filenotify.el provides an interface for file system notifications. It requires, that Emacs is compiled with one of the low-level libraries gfilenotify.c, inotify.c or w32notify.c. @@ -545,6 +584,9 @@ The few hooks that used with-wrapper-hook are replaced as follows: *** `completion-in-region-function' obsoletes `completion-in-region-functions'. *** `filter-buffer-substring-function' obsoletes `filter-buffer-substring-functions'. +** `split-string' now takes an optional argument TRIM. +The value, if non-nil, is a regexp that specifies what to trim from +the start and end of each substring. ** `get-upcase-table' is obsoleted by the new `case-table-get-table'. @@ -597,6 +639,35 @@ Emacs uses `image-default-frame-delay'. *** New functions `image-current-frame' and `image-show-frame' for getting and setting the current frame of a multi-frame image. +** Changes in encoding and decoding of text + +--- +*** New coding-system `prefer-utf-8'. +This is like `undecided' but prefers UTF-8 on decoding if the text to +be decoded does not contain any invalid UTF-8 sequences. On encoding, +any non-ASCII characters are automatically encoded as UTF-8. + +--- +*** New attributes of coding-systems whose type is `undecided'. +Two new attributes, `:inhibit-null-byte-detection' and +`:inhibit-iso-escape-detection', determine how to detect encoding of +text that includes null bytes and ISO-2022 escape sequences, +respectively. Each of these attributes can be either nil, zero, or +t. If it is t, decoding text ignores null bytes and, respectively, +ISO-2022 sequences. If it is nil, null bytes cause text to be decoded +with no-conversion and ISO-2022 sequences cause Emacs to assume the +text is encoded in one of the ISO-2022 encodings, such as +iso-2022-7bit. If the value is zero, Emacs consults the variables +inhibit-null-byte-detection and inhibit-iso-escape-detection, which +see. +The new attribute `:prefer-utf-8', if non-nil, causes Emacs to prefer +UTF-8 encoding and decoding, whenever possible. + +These attributes are only meaningful for coding-systems of type +`undecided'. (The type of a coding-system is determined by its +`:coding-type' attribute and can be accessed by calling the +`coding-system-type' function.) + ** The function `set-visited-file-modtime' now accepts a 0 or -1 argument with the same interpretation as the returned value of `visited-file-modtime'. diff --git a/etc/spook.lines b/etc/spook.lines Binary files differindex 16bc696e0f3..2a1a0ac1cb9 100644 --- a/etc/spook.lines +++ b/etc/spook.lines @@ -75,6 +75,7 @@ Emacs misc features * Forms: (forms). Emacs package for editing data bases by filling in forms. * Htmlfontify: (htmlfontify). Convert source code to html. +* Ido: (ido). Interactively do things with buffers and files. * PCL-CVS: (pcl-cvs). Emacs front-end to CVS. * RefTeX: (reftex). Emacs support for LaTeX cross-references and citations. diff --git a/leim/Makefile.in b/leim/Makefile.in index 5edf1665af7..b04eb6c2e77 100644 --- a/leim/Makefile.in +++ b/leim/Makefile.in @@ -1,4 +1,4 @@ -# Makefile for leim subdirectory in GNU Emacs. +### @configure_input@ # Copyright (C) 1997-2013 Free Software Foundation, Inc. # Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index 2e0e2818767..8285910cdbf 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -1,6 +1,7 @@ -# Makefile for lib-src subdirectory in GNU Emacs. -# Copyright (C) 1985, 1987-1988, 1993-1994, 2001-2013 Free Software -# Foundation, Inc. +### @configure_input@ + +# Copyright (C) 1985, 1987-1988, 1993-1994, 2001-2013 +# Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 81bcb1d033c..65bbc8a305b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,451 @@ +2013-07-26 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/nadvice.el (advice--called-interactively-skip): Use the new + `base' arg of backtrace-frame. + +2013-07-26 Eli Zaretskii <eliz@gnu.org> + + * simple.el (list-processes): Doc fix. + +2013-07-26 Juanma Barranquero <lekktu@gmail.com> + + * desktop.el (desktop--select-frame): + Try harder to reuse the initial frame. + +2013-07-26 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/edebug.el: Use backtrace-eval to handle lexical variables. + (edebug-eval): Use backtrace-eval. + (edebug--display, edebug--recursive-edit): Don't let-bind the + edebug-outer-* vars that keep track of variables we locally let-bind. + (edebug-outside-excursion): Don't restore outside values of locally + let-bound vars. + (edebug--display): Use user-error. + (cl-lexical-debug, cl-debug-env): Remove. + +2013-07-26 Juanma Barranquero <lekktu@gmail.com> + + * desktop.el (desktop-restore-frames): Call `sit-for' once all frames + are restored to be sure that they are visible before deleting any + remaining ones. + +2013-07-26 Matthias Meulien <orontee@gmail.com> + + * vc/vc-dir.el (vc-dir-mode-map): Add binding for vc-print-root-log. + +2013-07-26 Richard Stallman <rms@gnu.org> + + Add aliases for encrypting mail. + * epa.el (epa-mail-aliases): New option. + * epa-mail.el (epa-mail-encrypt): Rewrite to be callable from programs. + Bind inhibit-read-only so read-only text doesn't ruin everything. + (epa-mail-default-recipients): New subroutine broken out. + Handle epa-mail-aliases. + +2013-07-26 Stefan Monnier <monnier@iro.umontreal.ca> + + Add support for lexical variables to the debugger's `e' command. + * emacs-lisp/debug.el (debug): Don't let-bind the debugger-outer-* + vars, except for debugger-outer-match-data. + (debugger-frame-number): Move check for "on a function call" from + callers into it. Add `skip-base' argument. + (debugger-frame, debugger-frame-clear): Simplify accordingly. + (debugger-env-macro): Only reset the state stored in non-variables, + i.e. current-buffer and match-data. + (debugger-eval-expression): Rewrite using backtrace-eval. + * subr.el (internal--called-interactively-p--get-frame): Remove. + (called-interactively-p): + * emacs-lisp/edebug.el (edebug--called-interactively-skip): Use the new + `base' arg of backtrace-frame instead. + +2013-07-26 Glenn Morris <rgm@gnu.org> + + * align.el (align-regexp): Doc fix. (Bug#14857) + (align-region): Explicit error if subexpression missing/does not match. + + * simple.el (global-visual-line-mode): + Do not duplicate the mode lighter. (Bug#14858) + +2013-07-25 Martin Rudalics <rudalics@gmx.at> + + * window.el (display-buffer): In display-buffer bind + split-window-keep-point to t, bug#14829. + +2013-07-25 Juanma Barranquero <lekktu@gmail.com> + + * desktop.el: Rename internal "desktop-X" frame params to "desktop--X". + (desktop-filter-parameters-alist, desktop--filter-restore-desktop-parm) + (desktop--filter-save-desktop-parm, desktop--process-minibuffer-frames) + (desktop--select-frame, desktop--sort-states, desktop-restore-frames): + Change accordingly. + (desktop--select-frame, desktop--sort-states, desktop-restore-frames): + Use pcase-let, pcase-let* to deobfuscate access to desktop--mini values. + +2013-07-25 Glenn Morris <rgm@gnu.org> + + * dired-x.el (dired-mark-extension): Convert comment to doc string. + +2013-07-25 Juanma Barranquero <lekktu@gmail.com> + + * desktop.el (desktop--make-frame): Do not pass the `fullscreen' + parameter to modify-frame-parameters if the value has not changed; + this is a workaround for bug#14949. + (desktop--make-frame): On cl-delete-if call, check parameter name, + not full parameter. + +2013-07-24 Juanma Barranquero <lekktu@gmail.com> + + * desktop.el (desktop-restoring-frames-p): Return a true boolean. + (desktop-restore-frames): Warn when deleting an existing frame failed. + +2013-07-24 Glenn Morris <rgm@gnu.org> + + * ffap.el (ffap-machine-p): Handle "not known" response. (Bug#14929) + +2013-07-24 Michael Albinus <michael.albinus@gmx.de> + + * filenotify.el (file-notify-supported-p): + * net/tramp-sh.el (tramp-sh-handle-file-notify-supported-p): + Remove functions. + + * autorevert.el (auto-revert-use-notify): + (auto-revert-notify-add-watch): + * net/tramp.el (tramp-file-name-for-operation): + * net/tramp-adb.el (tramp-adb-file-name-handler-alist): + * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): + * net/tramp-sh.el (tramp-sh-file-name-handler-alist): + * net/tramp-smb.el (tramp-smb-file-name-handler-alist): + Remove `file-notify-supported-p' entry. + +2013-07-24 Glenn Morris <rgm@gnu.org> + + * printing.el: Replace all uses of deleted ps-windows-system, + ps-lp-system, ps-flatten-list with lpr- versions. + +2013-07-24 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/pcase.el (pcase--u1): Verify if self-quoting values can be + checked with memq (bug#14935). + + * files.el (revert-buffer-function): Use a non-nil default. + (revert-buffer-preserve-modes): Declare var to + provide access to the `preserve-modes' argument. + (revert-buffer): Let-bind it. + (revert-buffer--default): New function, extracted from revert-buffer. + +2013-07-24 Stefan Monnier <monnier@iro.umontreal.ca> + + * lpr.el: Signal print errors more prominently. + (print-region-function): Don't default to nil. + (lpr-print-region): New function, extracted from print-region-1. + Check lpr's return value and signal an error in case of problem. + (print-region-1): Use it. + * ps-print.el (ps-windows-system, ps-lp-system): Remove. Use the lpr-* + versions instead. + (ps-printer-name): Default to nil. + (ps-printer-name-option): Default to lpr-printer-switch. + (ps-print-region-function): Don't default to nil. + (ps-postscript-code-directory): Simplify default. + (ps-do-despool): Use lpr-print-region to properly check the outcome. + (ps-string-list, ps-eval-switch, ps-flatten-list) + (ps-flatten-list-1): Remove. + (ps-multibyte-buffer): Avoid setq. + * dos-w32.el (direct-print-region-helper): Use proper regexp operators. + (print-region-function, ps-print-region-function): Don't set them here. + +2013-07-24 Xue Fuqiao <xfq.free@gmail.com> + + * ido.el (ido-fractionp): + (ido-cache-ftp-work-directory-time, ido-max-prospects, ido-mode) + (ido-max-file-prompt-width, ido-unc-hosts-cache) + (ido-max-directory-size, ido-max-dir-file-cache) + (ido-decorations): Doc fix. + + * ansi-color.el: Fix old URL. + +2013-07-23 Michael R. Mauger <michael@mauger.com> + + * progmodes/sql.el Version 3.3 + (sql-product-alist): Improve oracle :prompt-cont-regexp. + (sql-starts-with-prompt-re, sql-ends-with-prompt-re): New functions. + (sql-interactive-remove-continuation-prompt): Rewrite, use + functions above. Fix continuation prompt and complete output line + handling. + (sql-redirect-one, sql-execute): Use `read-only-mode' on + redirected output buffer. + (sql-mode): Restore deleted code (Bug#13591). + +2013-07-23 Juanma Barranquero <lekktu@gmail.com> + + * desktop.el (desktop-clear, desktop-list*): Fix previous change. + +2013-07-23 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-handle-file-notify-add-watch): New defun. + + * net/tramp-adb.el (tramp-adb-file-name-handler-alist): + * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): + * net/tramp-smb.el (tramp-smb-file-name-handler-alist): Use it. + +2013-07-23 Juanma Barranquero <lekktu@gmail.com> + + * desktop.el (desktop-clear): Simplify; remove useless checks + against invalid buffer names. + (desktop-list*): Use cl-list*. + (desktop-buffer-info, desktop-create-buffer): Simplify. + +2013-07-23 Leo Liu <sdl.web@gmail.com> + + * bookmark.el (bookmark-make-record): Restore NAME as a default + value. (Bug#14933) + +2013-07-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/autoload.el (autoload--setup-output): New function, + extracted from autoload--insert-text. + (autoload--insert-text): Remove. + (autoload--print-cookie-text): New function, extracted from + autoload--insert-cookie-text. + (autoload--insert-cookie-text): Remove. + (autoload-generate-file-autoloads): Adjust calls accordingly. + + * winner.el (winner-hook-installed-p): Remove. + (winner-mode): Simplify accordingly. + + * subr.el (add-to-list): Fix compiler-macro when `append' is + not constant. Don't use `cl-member' for the base case. + + * progmodes/subword.el: Fix boundary case (bug#13758). + (subword-forward-regexp): Make it a constant. Wrap optional \\W in its + own group. + (subword-backward-regexp): Make it a constant. + (subword-forward-internal): Don't treat a trailing capital as the + beginning of a word. + +2013-07-22 Ari Roponen <ari.roponen@gmail.com> (tiny change) + + * emacs-lisp/package.el (package-menu-mode): Don't modify the + global value of tabulated-list-revert-hook (bug#14930). + +2013-07-22 Juanma Barranquero <lekktu@gmail.com> + + * desktop.el: Require 'cl-lib. + (desktop-before-saving-frames-functions): New hook. + (desktop--process-minibuffer-frames): Set desktop-mini parameter only + for frames being saved. Rename from desktop--save-minibuffer-frames. + (desktop-save-frames): Run hook desktop-before-saving-frames-functions. + Do not save frames with non-nil `desktop-dont-save' parameter. + Filter out deleted frames. + (desktop--find-frame): Use cl-find-if. + (desktop--select-frame): Use cl-(first|second|third) to access values + of desktop-mini. + (desktop--make-frame): Use cl-delete-if. + (desktop--sort-states): Fix sorting of minibuffer-owning frames. + (desktop-restore-frames): Use cl-(first|second|third) to access values + of desktop-mini. Look for visible frame at the end, not while + restoring frames. + + * dired-x.el (dired-mark-unmarked-files, dired-virtual) + (dired-guess-default, dired-mark-sexp, dired-filename-at-point): + Use string-match-p, looking-at-p (bug#14927). + +2013-07-21 Juanma Barranquero <lekktu@gmail.com> + + * desktop.el (desktop-saved-frame-states): + Rename from desktop--saved-states; all users changed. + (desktop-save-frames): Rename from desktop--save-frames. + Do not save state to desktop file. + (desktop-save): Save desktop-saved-frame-states to desktop file + and reset to nil. + (desktop-restoring-frames-p): New function. + (desktop-restore-frames): Use it. Rename from desktop--restore-frames. + (desktop-read): Use desktop-restoring-frames-p. Do not try to fix + buffer-lists when restoring frames. Suggested by Martin Rudalics. + + * desktop.el: Correctly restore iconified frames. + (desktop--filter-iconified-position): New function. + (desktop-filter-parameters-alist): Add entries for `top' and `left'. + +2013-07-20 Glenn Morris <rgm@gnu.org> + + * progmodes/gdb-mi.el (gdb-delete-handler, gdb-stopped): + Let `message' do the formatting. + (def-gdb-preempt-display-buffer): Add explicit format. + + * image-dired.el (image-dired-track-original-file): + Use with-current-buffer. + (image-dired-track-thumbnail): Use with-current-buffer. + Avoid changing point of wrong window. + + * image-dired.el (image-dired-track-original-file): + Avoid changing point of wrong window. (Bug#14909) + +2013-07-20 Richard Copley <rcopley@gmail.com> (tiny change) + + * progmodes/gdb-mi.el (gdb-done-or-error): + Guard against "%" in gdb output. (Bug#14127) + +2013-07-20 Andreas Schwab <schwab@linux-m68k.org> + + * progmodes/sh-script.el (sh-read-variable): Remove interactive spec. + (Bug#14826) + + * international/mule.el (coding-system-iso-2022-flags): Fix last + change. + +2013-07-20 Kenichi Handa <handa@gnu.org> + + * international/mule.el (coding-system-iso-2022-flags): + Add `8-bit-level-4'. (Bug#8522) + +2013-07-19 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/shr.el (shr-mouse-browse-url): New command and keystroke + (bug#14815). + + * net/eww.el (eww-process-text-input): Allow inputting when the + point is at the start of the line, as the properties aren't + front-sticky. + + * net/shr.el (shr-make-table-1): Ensure that we don't infloop on + degenerate widths. + +2013-07-19 Richard Stallman <rms@gnu.org> + + * epa.el (epa-popup-info-window): Doc fix. + + * subr.el (split-string): New arg TRIM. + +2013-07-18 Juanma Barranquero <lekktu@gmail.com> + + * frame.el (blink-cursor-timer-function, blink-cursor-suspend): + Add check for W32 (followup to 2013-07-16T11:41:06Z!jan.h.d@swipnet.se). + +2013-07-18 Michael Albinus <michael.albinus@gmx.de> + + * filenotify.el (file-notify--library): Rename from + `file-notify-support'. Do not autoload. Adapt all uses. + (file-notify-supported-p): New defun. + + * autorevert.el (auto-revert-use-notify): + Use `file-notify-supported-p' instead of `file-notify-support'. + Adapt docstring. + (auto-revert-notify-add-watch): Use `file-notify-supported-p'. + + * net/tramp.el (tramp-file-name-for-operation): + Add `file-notify-supported-p'. + + * net/tramp-sh.el (tramp-sh-handle-file-notify-supported-p): + New defun. + (tramp-sh-file-name-handler-alist): Add it as handler for + `file-notify-supported-p '. + + * net/tramp-adb.el (tramp-adb-file-name-handler-alist): + * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): + * net/tramp-smb.el (tramp-smb-file-name-handler-alist): + Add `ignore' as handler for `file-notify-*' functions. + +2013-07-17 Eli Zaretskii <eliz@gnu.org> + + * simple.el (line-move-partial, line-move): Don't start vscroll or + scroll-up if the current line is not taller than the window. + (Bug#14881) + +2013-07-16 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/ruby-mode.el (ruby-font-lock-keywords): Do not + highlight question marks in the method names as strings. + (ruby-block-beg-keywords): Inline. + (ruby-font-lock-keyword-beg-re): Extract from + `ruby-font-lock-keywords'. + +2013-07-16 Jan Djärv <jan.h.d@swipnet.se> + + * frame.el (blink-cursor-blinks): New defcustom. + (blink-cursor-blinks-done): New defvar. + (blink-cursor-start): Set blink-cursor-blinks-done to 1. + (blink-cursor-timer-function): Check if number of blinks has been + done on X and NS. + (blink-cursor-suspend, blink-cursor-check): New defuns. + +2013-07-15 Glenn Morris <rgm@gnu.org> + + * edmacro.el (edmacro-format-keys): Fix previous change. + +2013-07-15 Paul Eggert <eggert@cs.ucla.edu> + + * shell.el (explicit-bash-args): Remove obsolete hack for Bash 1.x. + The hack didn't work outside English locales anyway. + +2013-07-15 Juanma Barranquero <lekktu@gmail.com> + + * simple.el (define-alternatives): Rename from alternatives-define, + per RMS' suggestion. + +2013-07-14 Juanma Barranquero <lekktu@gmail.com> + + * desktop.el (desktop-restore-frames): Change default to t. + (desktop-restore-in-current-display): Now offer more options. + (desktop-restoring-reuses-frames): New customization option. + (desktop--saved-states): Doc fix. + (desktop-filter-parameters-alist): New variable, renamed and expanded + from desktop--excluded-frame-parameters. + (desktop--target-display): New variable. + (desktop-switch-to-gui-p, desktop-switch-to-tty-p) + (desktop--filter-tty*, desktop--filter-*-color) + (desktop--filter-minibuffer, desktop--filter-restore-desktop-parm) + (desktop--filter-save-desktop-parm) + (desktop-restore-in-original-display-p): New functions. + (desktop--filter-frame-parms): Use new desktop-filter-parameters-alist. + (desktop--save-minibuffer-frames): New function, inspired by a similar + function from Martin Rudalics. + (desktop--save-frames): Call it; play nice with desktop-globals-to-save. + (desktop--restore-in-this-display-p): Remove. + (desktop--find-frame): Rename from desktop--find-frame-in-display + and add predicate argument. + (desktop--make-full-frame): Remove, integrated into desktop--make-frame. + (desktop--reuse-list): New variable. + (desktop--select-frame, desktop--make-frame, desktop--sort-states): + New functions. + (desktop--restore-frames): Add support for "minibuffer-special" frames. + +2013-07-14 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-sh.el (tramp-sh-handle-vc-registered): Use `ignore-error'. + +2013-07-13 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/ruby-mode.el (ruby-font-lock-keywords): + Highlight conversion methods on Kernel. + +2013-07-13 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-engine.el (c-forward-decl-or-cast-1): Label CASE 13 + and comment it out. This out-commenting enables certain C++ + declarations to be parsed correctly. + +2013-07-13 Eli Zaretskii <eliz@gnu.org> + + * international/mule.el (define-coding-system): Doc fix. + + * simple.el (default-font-height): Don't call font-info if the + frame's default font didn't change since the frame was created. + (Bug#14838) + +2013-07-13 Leo Liu <sdl.web@gmail.com> + + * ido.el (ido-read-file-name): Guard against non-symbol value. + +2013-07-13 Fabián Ezequiel Gallina <fgallina@gnu.org> + + * progmodes/python.el (python-imenu--build-tree): Fix corner case + in nested defuns. + +2013-07-13 Leo Liu <sdl.web@gmail.com> + + * ido.el (ido-exhibit): Handle ido-enter-matching-directory before + ido-set-matches call. (Bug#6852) + 2013-07-12 Dmitry Gutov <dgutov@yandex.ru> * progmodes/ruby-mode.el (ruby-percent-literals-beg-re): @@ -128,17 +576,17 @@ * net/tramp.el (tramp-current-connection): New defvar, moved from tramp-sh.el. - (tramp-message-show-progress-reporter-message): Removed, not + (tramp-message-show-progress-reporter-message): Remove, not needed anymore. - (tramp-error-with-buffer): Show message in minibuffer. Discard - input before waiting. Reset connection timestamp. + (tramp-error-with-buffer): Show message in minibuffer. + Discard input before waiting. Reset connection timestamp. (with-tramp-progress-reporter): Improve messages. (tramp-process-actions): Use progress reporter. Delete process in case of error. Improve messages. - * net/tramp-sh.el (tramp-barf-if-no-shell-prompt): Use - condition-case. Call `tramp-error-with-buffer' with vector and buffer. - (tramp-current-connection): Removed. + * net/tramp-sh.el (tramp-barf-if-no-shell-prompt): Use condition-case. + Call `tramp-error-with-buffer' with vector and buffer. + (tramp-current-connection): Remove. (tramp-maybe-open-connection): The car of `tramp-current-connection' are the first 3 slots of the vector. @@ -3442,8 +3890,8 @@ (prolog-char-quote-workaround): * progmodes/cperl-mode.el (cperl-under-as-char): * progmodes/vhdl-mode.el (vhdl-underscore-is-part-of-word): - Mark as obsolete. - (vhdl-mode-syntax-table, vhdl-mode-ext-syntax-table): Initialize in + Mark as obsolete. + (vhdl-mode-syntax-table, vhdl-mode-ext-syntax-table): Initialize in their declaration. (vhdl-mode-syntax-table-init): Remove. diff --git a/lisp/ChangeLog.10 b/lisp/ChangeLog.10 index 2d331a2819d..30afe9ce970 100644 --- a/lisp/ChangeLog.10 +++ b/lisp/ChangeLog.10 @@ -5182,7 +5182,7 @@ inserted. (Info-hide-note-references): Fix doc and customize type. -2003-03-02 Matt Swift <swift@alum.mit.edu> +2003-03-02 Matthew Swift <swift@alum.mit.edu> * emacs-lisp/lisp-mode.el (emacs-lisp-docstring-fill-column): New custom variable. @@ -5228,7 +5228,7 @@ (tramp-send-region): Correct debug message. (tramp-bug): Add `tramp-chunksize'. -2003-02-26 Matt Swift <swift@alum.mit.edu> +2003-02-26 Matthew Swift <swift@alum.mit.edu> * startup.el: Streamline code in several functions for efficiency and readability. Rephrase booleans to avoid `(not noninteractive)'. diff --git a/lisp/ChangeLog.15 b/lisp/ChangeLog.15 index 4d0ff9a40e2..afa2bce104e 100644 --- a/lisp/ChangeLog.15 +++ b/lisp/ChangeLog.15 @@ -5119,7 +5119,7 @@ (x-setup-function-keys, xw-defined-colors): Merge x- and w32- definitions here. -2010-10-24 T.V. Raman <tv.raman.tv@gmail.com> (tiny change) +2010-10-24 T. V. Raman <tv.raman.tv@gmail.com> (tiny change) * net/mairix.el (mairix-searches-mode-map): * mail/mspools.el (mspools-mode-map): Fix 2010-10-10 change. diff --git a/lisp/ChangeLog.16 b/lisp/ChangeLog.16 index d6d1bac43c2..7692a0fffa8 100644 --- a/lisp/ChangeLog.16 +++ b/lisp/ChangeLog.16 @@ -4569,7 +4569,7 @@ * bookmark.el (bookmark-completing-read): Set the completion category to `bookmark' (bug#11131). -2012-10-26 Bastien <bzg@altern.org> +2012-10-26 Bastien Guerry <bzg@altern.org> Stefan Monnier <monnier@iro.umontreal.ca> * face-remap.el: Use lexical-binding. @@ -9712,7 +9712,7 @@ * international/mule-cmds.el (mule-menu-keymap) (set-language-environment, set-locale-environment): Doc tweaks. -2012-06-16 Aurelien Aptel <aurelien.aptel@gmail.com> +2012-06-16 Aurélien Aptel <aurelien.aptel@gmail.com> * cus-face.el (custom-face-attributes): Add wave-style underline attribute. diff --git a/lisp/ChangeLog.7 b/lisp/ChangeLog.7 index 4eec1795789..f52fdd7e194 100644 --- a/lisp/ChangeLog.7 +++ b/lisp/ChangeLog.7 @@ -7617,7 +7617,7 @@ Delete the binding for toggle-enable-multibyte-characters. (mule-menu-keymap): Delete the menu item for it. -1997-12-17 Peter Galbraith <galbraith@mixing.qc.dfo.ca> +1997-12-17 Peter S Galbraith <galbraith@mixing.qc.dfo.ca> * simple.el (copy-region-as-kill): Deactivate mark in transient-mark-mode. @@ -19637,7 +19637,7 @@ * term/x-win.el (function-key-map): Define iso-lefttab. -1997-03-24 Vince Del Vecchio <vdelvecc@spd.analog.com> +1997-03-24 Vincent Del Vecchio <vdelvecc@spd.analog.com> * mh-utils.el (mh-find-progs): When looking for mh-lib, construct likely paths based on mh-progs rather than using a static list. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index f93f2d32ef4..066e15368da 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -1,4 +1,5 @@ -# Maintenance productions for the Lisp directory +### @configure_input@ + # Copyright (C) 2000-2013 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/lisp/align.el b/lisp/align.el index 1b62042be75..3d2ca192245 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -906,15 +906,8 @@ on the format of these lists." ;;;###autoload (defun align-regexp (beg end regexp &optional group spacing repeat) "Align the current region using an ad-hoc rule read from the minibuffer. -BEG and END mark the limits of the region. This function will prompt -for the REGEXP to align with. If no prefix arg was specified, you -only need to supply the characters to be lined up and any preceding -whitespace is replaced. If a prefix arg was specified, the full -regexp with parenthesized whitespace should be supplied; it will also -prompt for which parenthesis GROUP within REGEXP to modify, the amount -of SPACING to use, and whether or not to REPEAT the rule throughout -the line. See `align-rules-list' for more information about these -options. +BEG and END mark the limits of the region. Interactively, this function +prompts for the regular expression REGEXP to align with. For example, let's say you had a list of phone numbers, and wanted to align them so that the opening parentheses would line up: @@ -925,8 +918,29 @@ align them so that the opening parentheses would line up: Joe (123) 456-7890 There is no predefined rule to handle this, but you could easily do it -using a REGEXP like \"(\". All you would have to do is to mark the -region, call `align-regexp' and type in that regular expression." +using a REGEXP like \"(\". Interactively, all you would have to do is +to mark the region, call `align-regexp' and enter that regular expression. + +REGEXP must contain at least one parenthesized subexpression, typically +whitespace of the form \"\\\\(\\\\s-*\\\\)\". In normal interactive use, +this is automatically added to the start of your regular expression after +you enter it. You only need to supply the characters to be lined up, and +any preceding whitespace is replaced. + +If you specify a prefix argument (or use this function non-interactively), +you must enter the full regular expression, including the subexpression. +The function also then prompts for which subexpression parenthesis GROUP +\(default 1) within REGEXP to modify, the amount of SPACING (default +`align-default-spacing') to use, and whether or not to REPEAT the rule +throughout the line. + +See `align-rules-list' for more information about these options. + +The non-interactive form of the previous example would look something like: + \(align-regexp (point-min) (point-max) \"\\\\(\\\\s-*\\\\)(\") + +This function is a nothing more than a small wrapper that helps you +construct a rule to pass to `align-region', which does the real work." (interactive (append (list (region-beginning) (region-end)) @@ -1498,6 +1512,9 @@ aligner would have dealt with are." (setq rule-beg (match-beginning first) save-match-data (match-data)) + (or rule-beg + (error "No match for subexpression %s" first)) + ;; unless the `valid' attribute is set, and tells ;; us that the rule is not valid at this point in ;; the code.. diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index bbe44f9b20b..105352117b7 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -40,11 +40,11 @@ ;; ;; SGR control sequences are defined in section 3.8.117 of the ECMA-48 ;; standard (identical to ISO/IEC 6429), which is freely available as a -;; PDF file <URL:http://www.ecma.ch/ecma1/STAND/ECMA-048.HTM>. The -;; "Graphic Rendition Combination Mode (GRCM)" implemented is -;; "cumulative mode" as defined in section 7.2.8. Cumulative mode means -;; that whenever possible, SGR control sequences are combined (ie. blue -;; and bold). +;; PDF file <URL:http://www.ecma-international.org/publications/standards/Ecma-048.htm>. +;; The "Graphic Rendition Combination Mode (GRCM)" implemented is +;; "cumulative mode" as defined in section 7.2.8. Cumulative mode +;; means that whenever possible, SGR control sequences are combined +;; (ie. blue and bold). ;; The basic functions are: ;; diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 00e88fc4a3d..1617a31cd82 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -271,21 +271,18 @@ This variable becomes buffer local when set in any fashion.") :type 'boolean :version "24.4") -(defcustom auto-revert-use-notify (and file-notify-support t) +(defcustom auto-revert-use-notify t "If non-nil Auto Revert Mode uses file notification functions. -This requires Emacs being compiled with file notification -support (see `file-notify-support'). You should set this variable -through Custom." +You should set this variable through Custom." :group 'auto-revert :type 'boolean :set (lambda (variable value) - (set-default variable (and file-notify-support value)) + (set-default variable value) (unless (symbol-value variable) - (when file-notify-support - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when (symbol-value 'auto-revert-notify-watch-descriptor) - (auto-revert-notify-rm-watch))))))) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (symbol-value 'auto-revert-notify-watch-descriptor) + (auto-revert-notify-rm-watch)))))) :initialize 'custom-initialize-default :version "24.4") diff --git a/lisp/bookmark.el b/lisp/bookmark.el index cab81c3b135..b1cdedb83c5 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -481,19 +481,18 @@ equivalently just return ALIST without NAME.") (defun bookmark-make-record () "Return a new bookmark record (NAME . ALIST) for the current location." (let ((record (funcall bookmark-make-record-function))) + ;; Set up default name if the function does not provide one. + (unless (stringp (car record)) + (if (car record) (push nil record)) + (setcar record (or bookmark-current-bookmark (bookmark-buffer-name)))) ;; Set up defaults. (bookmark-prop-set record 'defaults (delq nil (delete-dups (append (bookmark-prop-get record 'defaults) (list bookmark-current-bookmark - (bookmark-buffer-name)))))) - ;; Set up default name. - (if (stringp (car record)) - ;; The function already provided a default name. - record - (if (car record) (push nil record)) - (setcar record (or bookmark-current-bookmark (bookmark-buffer-name))) - record))) + (car record) + (bookmark-buffer-name)))))) + record)) (defun bookmark-store (name alist no-overwrite) "Store the bookmark NAME with data ALIST. diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el index 07e0e08bbaf..0bbe3c61d76 100644 --- a/lisp/cedet/semantic/bovine/el.el +++ b/lisp/cedet/semantic/bovine/el.el @@ -474,7 +474,7 @@ Return a bovination list to use." ((and name (file-exists-p (concat name ".el.gz"))) ;; This is the linux distro case. (concat name ".el.gz")) - ;; source file does not exists + ;; Source file does not exist. (name (message "semantic: cannot find source file %s" (concat name ".el"))) (t diff --git a/lisp/desktop.el b/lisp/desktop.el index 322b95715a2..d5895a8de57 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -33,6 +33,7 @@ ;; - the mark & mark-active ;; - buffer-read-only ;; - some local variables +;; - frame and window configuration ;; To use this, use customize to turn on desktop-save-mode or add the ;; following line somewhere in your init file: @@ -127,12 +128,13 @@ ;; --------------------------------------------------------------------------- ;; TODO: ;; -;; Save window configuration. ;; Recognize more minor modes. ;; Save mark rings. ;;; Code: +(require 'cl-lib) + (defvar desktop-file-version "206" "Version number of desktop file format. Written into the desktop file and used at desktop read to provide @@ -369,16 +371,36 @@ modes are restored automatically; they should not be listed here." :type '(repeat symbol) :group 'desktop) -(defcustom desktop-restore-frames nil +(defcustom desktop-restore-frames t "When non-nil, save window/frame configuration to desktop file." :type 'boolean :group 'desktop :version "24.4") (defcustom desktop-restore-in-current-display nil - "When non-nil, frames are restored in the current display. -Otherwise they are restored, if possible, in their original displays." - :type 'boolean + "If t, frames are restored in the current display. +If nil, frames are restored, if possible, in their original displays. +If `delete', frames on other displays are deleted instead of restored." + :type '(choice (const :tag "Restore in current display" t) + (const :tag "Restore in original display" nil) + (const :tag "Delete frames in other displays" 'delete)) + :group 'desktop + :version "24.4") + +(defcustom desktop-restoring-reuses-frames t + "If t, restoring frames reuses existing frames. +If nil, existing frames are deleted. +If `keep', existing frames are kept and not reused." + :type '(choice (const :tag "Reuse existing frames" t) + (const :tag "Delete existing frames" nil) + (const :tag "Keep existing frames" 'keep)) + :group 'desktop + :version "24.4") + +(defcustom desktop-before-saving-frames-functions nil + "Abnormal hook run before saving frames. +Functions in this hook are called with one argument, a live frame." + :type 'hook :group 'desktop :version "24.4") @@ -565,8 +587,9 @@ DIRNAME omitted or nil means use `desktop-dirname'." "Checksum of the last auto-saved contents of the desktop file. Used to avoid writing contents unchanged between auto-saves.") -(defvar desktop--saved-states nil - "Internal use only.") +(defvar desktop-saved-frame-states nil + "Saved state of all frames. +Only valid during frame saving & restoring; intended for internal use.") ;; ---------------------------------------------------------------------------- ;; Desktop file conflict detection @@ -621,22 +644,17 @@ Furthermore, it clears the variables listed in `desktop-globals-to-clear'." (if (symbolp var) (eval `(setq-default ,var nil)) (eval `(setq-default ,(car var) ,(cdr var))))) - (let ((buffers (buffer-list)) - (preserve-regexp (concat "^\\(" + (let ((preserve-regexp (concat "^\\(" (mapconcat (lambda (regexp) (concat "\\(" regexp "\\)")) desktop-clear-preserve-buffers "\\|") "\\)$"))) - (while buffers - (let ((bufname (buffer-name (car buffers)))) - (or - (null bufname) - (string-match-p preserve-regexp bufname) - ;; Don't kill buffers made for internal purposes. - (and (not (equal bufname "")) (eq (aref bufname 0) ?\s)) - (kill-buffer (car buffers)))) - (setq buffers (cdr buffers)))) + (dolist (buffer (buffer-list)) + (let ((bufname (buffer-name buffer))) + (unless (or (eq (aref bufname 0) ?\s) ;; Don't kill internal buffers + (string-match-p preserve-regexp bufname)) + (kill-buffer buffer))))) (delete-other-windows)) ;; ---------------------------------------------------------------------------- @@ -673,15 +691,7 @@ is nil, ask the user where to save the desktop." ;; ---------------------------------------------------------------------------- (defun desktop-list* (&rest args) - (if (null (cdr args)) - (car args) - (setq args (nreverse args)) - (let ((value (cons (nth 1 args) (car args)))) - (setq args (cdr (cdr args))) - (while args - (setq value (cons (car args) value)) - (setq args (cdr args))) - value))) + (and args (apply #'cl-list* args))) ;; ---------------------------------------------------------------------------- (defun desktop-buffer-info (buffer) @@ -713,16 +723,14 @@ is nil, ask the user where to save the desktop." (when (functionp desktop-save-buffer) (funcall desktop-save-buffer desktop-dirname)) ;; local variables - (let ((locals desktop-locals-to-save) - (loclist (buffer-local-variables)) - (ll)) - (while locals - (let ((here (assq (car locals) loclist))) - (if here - (setq ll (cons here ll)) - (when (member (car locals) loclist) - (setq ll (cons (car locals) ll))))) - (setq locals (cdr locals))) + (let ((loclist (buffer-local-variables)) + (ll nil)) + (dolist (local desktop-locals-to-save) + (let ((here (assq local loclist))) + (cond (here + (push here ll)) + ((member local loclist) + (push local ll))))) ll))) ;; ---------------------------------------------------------------------------- @@ -869,43 +877,224 @@ DIRNAME must be the directory in which the desktop file will be saved." ;; ---------------------------------------------------------------------------- -(defconst desktop--excluded-frame-parameters - '(buffer-list - buffer-predicate - buried-buffer-list - explicit-name - font - font-backend - minibuffer - name - outer-window-id - parent-id - window-id - window-system) - "Frame parameters not saved or restored.") - -(defun desktop--filter-frame-parms (frame) - "Return frame parameters of FRAME. -Parameters in `desktop--excluded-frame-parameters' are excluded. +(defvar desktop-filter-parameters-alist + '((background-color . desktop--filter-*-color) + (buffer-list . t) + (buffer-predicate . t) + (buried-buffer-list . t) + (desktop--font . desktop--filter-restore-desktop-parm) + (desktop--fullscreen . desktop--filter-restore-desktop-parm) + (desktop--height . desktop--filter-restore-desktop-parm) + (desktop--width . desktop--filter-restore-desktop-parm) + (font . desktop--filter-save-desktop-parm) + (font-backend . t) + (foreground-color . desktop--filter-*-color) + (fullscreen . desktop--filter-save-desktop-parm) + (height . desktop--filter-save-desktop-parm) + (left . desktop--filter-iconified-position) + (minibuffer . desktop--filter-minibuffer) + (name . t) + (outer-window-id . t) + (parent-id . t) + (top . desktop--filter-iconified-position) + (tty . desktop--filter-tty*) + (tty-type . desktop--filter-tty*) + (width . desktop--filter-save-desktop-parm) + (window-id . t) + (window-system . t)) + "Alist of frame parameters and filtering functions. + +Each element is a cons (PARAM . FILTER), where PARAM is a parameter +name (a symbol identifying a frame parameter), and FILTER can be t +\(meaning the parameter is removed from the parameter list on saving +and restoring), or a function that will be called with three args: + + CURRENT a cons (PARAM . VALUE), where PARAM is the one being + filtered and VALUE is its current value + PARAMETERS the complete alist of parameters being filtered + SAVING non-nil if filtering before saving state, nil otherwise + +The FILTER function must return: + nil CURRENT is removed from the list + t CURRENT is left as is + (PARAM' . VALUE') replace CURRENT with this + +Frame parameters not on this list are passed intact.") + +(defvar desktop--target-display nil + "Either (minibuffer . VALUE) or nil. +This refers to the current frame config being processed inside +`frame--restore-frames' and its auxiliary functions (like filtering). +If nil, there is no need to change the display. +If non-nil, display parameter to use when creating the frame. +Internal use only.") + +(defun desktop-switch-to-gui-p (parameters) + "True when switching to a graphic display. +Return t if PARAMETERS describes a text-only terminal and +the target is a graphic display; otherwise return nil. +Only meaningful when called from a filtering function in +`desktop-filter-parameters-alist'." + (and desktop--target-display ; we're switching + (null (cdr (assq 'display parameters))) ; from a tty + (cdr desktop--target-display))) ; to a GUI display + +(defun desktop-switch-to-tty-p (parameters) + "True when switching to a text-only terminal. +Return t if PARAMETERS describes a graphic display and +the target is a text-only terminal; otherwise return nil. +Only meaningful when called from a filtering function in +`desktop-filter-parameters-alist'." + (and desktop--target-display ; we're switching + (cdr (assq 'display parameters)) ; from a GUI display + (null (cdr desktop--target-display)))) ; to a tty + +(defun desktop--filter-tty* (_current parameters saving) + ;; Remove tty and tty-type parameters when switching + ;; to a GUI frame. + (or saving + (not (desktop-switch-to-gui-p parameters)))) + +(defun desktop--filter-*-color (current parameters saving) + ;; Remove (foreground|background)-color parameters + ;; when switching to a GUI frame if they denote an + ;; "unspecified" color. + (or saving + (not (desktop-switch-to-gui-p parameters)) + (not (stringp (cdr current))) + (not (string-match-p "^unspecified-[fb]g$" (cdr current))))) + +(defun desktop--filter-minibuffer (current _parameters saving) + ;; When minibuffer is a window, save it as minibuffer . t + (or (not saving) + (if (windowp (cdr current)) + '(minibuffer . t) + t))) + +(defun desktop--filter-restore-desktop-parm (current parameters saving) + ;; When switching to a GUI frame, convert desktop--XXX parameter to XXX + (or saving + (not (desktop-switch-to-gui-p parameters)) + (let ((val (cdr current))) + (if (eq val :desktop-processed) + nil + (cons (intern (substring (symbol-name (car current)) + 9)) ;; (length "desktop--") + val))))) + +(defun desktop--filter-save-desktop-parm (current parameters saving) + ;; When switching to a tty frame, save parameter XXX as desktop--XXX so it + ;; can be restored in a subsequent GUI session, unless it already exists. + (cond (saving t) + ((desktop-switch-to-tty-p parameters) + (let ((sym (intern (format "desktop--%s" (car current))))) + (if (assq sym parameters) + nil + (cons sym (cdr current))))) + ((desktop-switch-to-gui-p parameters) + (let* ((dtp (assq (intern (format "desktop--%s" (car current))) + parameters)) + (val (cdr dtp))) + (if (eq val :desktop-processed) + nil + (setcdr dtp :desktop-processed) + (cons (car current) val)))) + (t t))) + +(defun desktop--filter-iconified-position (_current parameters saving) + ;; When saving an iconified frame, top & left are meaningless, + ;; so remove them to allow restoring to a default position. + (not (and saving (eq (cdr (assq 'visibility parameters)) 'icon)))) + +(defun desktop-restore-in-original-display-p () + "True if saved frames' displays should be honored." + (cond ((daemonp) t) + ((eq system-type 'windows-nt) nil) + (t (null desktop-restore-in-current-display)))) + +(defun desktop--filter-frame-parms (parameters saving) + "Filter frame parameters and return filtered list. +PARAMETERS is a parameter alist as returned by `frame-parameters'. +If SAVING is non-nil, filtering is happening before saving frame state; +otherwise, filtering is being done before restoring frame state. +Parameters are filtered according to the setting of +`desktop-filter-parameters-alist' (which see). Internal use only." - (let (params) - (dolist (param (frame-parameters frame)) - (unless (memq (car param) desktop--excluded-frame-parameters) - (push param params))) - params)) - -(defun desktop--save-frames () - "Save window/frame state, as a global variable. -Intended to be called from `desktop-save'. -Internal use only." - (setq desktop--saved-states + (let ((filtered nil)) + (dolist (param parameters) + (let ((filter (cdr (assq (car param) desktop-filter-parameters-alist))) + this) + (cond (;; no filter: pass param + (null filter) + (push param filtered)) + (;; filter = t; skip param + (eq filter t)) + (;; filter func returns nil: skip param + (null (setq this (funcall filter param parameters saving)))) + (;; filter func returns t: pass param + (eq this t) + (push param filtered)) + (;; filter func returns a new param: use it + t + (push this filtered))))) + ;; Set the display parameter after filtering, so that filter functions + ;; have access to its original value. + (when desktop--target-display + (let ((display (assq 'display filtered))) + (if display + (setcdr display (cdr desktop--target-display)) + (push desktop--target-display filtered)))) + filtered)) + +(defun desktop--process-minibuffer-frames (frames) + ;; Adds a desktop--mini parameter to frames + ;; desktop--mini is a list (MINIBUFFER NUMBER DEFAULT?) where + ;; MINIBUFFER t if the frame (including minibuffer-only) owns a minibuffer + ;; NUMBER if MINIBUFFER = t, an ID for the frame; if nil, the ID of + ;; the frame containing the minibuffer used by this frame + ;; DEFAULT? if t, this frame is the value of default-minibuffer-frame + (let ((count 0)) + ;; Reset desktop--mini for all frames + (dolist (frame (frame-list)) + (set-frame-parameter frame 'desktop--mini nil)) + ;; Number all frames with its own minibuffer + (dolist (frame (minibuffer-frame-list)) + (set-frame-parameter frame 'desktop--mini + (list t + (cl-incf count) + (eq frame default-minibuffer-frame)))) + ;; Now link minibufferless frames with their minibuffer frames + (dolist (frame frames) + (unless (frame-parameter frame 'desktop--mini) + (let ((mb-frame (window-frame (minibuffer-window frame)))) + ;; Frames whose minibuffer frame has been filtered out will have + ;; desktop--mini = nil, so desktop-restore-frames will restore them + ;; according to their minibuffer parameter. Set up desktop--mini + ;; for the rest. + (when (memq mb-frame frames) + (set-frame-parameter frame 'desktop--mini + (list nil + (cl-second (frame-parameter mb-frame 'desktop--mini)) + nil)))))))) + +(defun desktop-save-frames () + "Save frame state in `desktop-saved-frame-states'. +Runs the hook `desktop-before-saving-frames-functions'. +Frames with a non-nil `desktop-dont-save' parameter are not saved." + (setq desktop-saved-frame-states (and desktop-restore-frames - (mapcar (lambda (frame) - (cons (desktop--filter-frame-parms frame) - (window-state-get (frame-root-window frame) t))) - (cons (selected-frame) - (delq (selected-frame) (frame-list)))))) - (desktop-outvar 'desktop--saved-states)) + (let ((frames (cl-delete-if + (lambda (frame) + (run-hook-with-args 'desktop-before-saving-frames-functions frame) + (frame-parameter frame 'desktop-dont-save)) + (frame-list)))) + ;; In case some frame was deleted by a hook function + (setq frames (cl-delete-if-not #'frame-live-p frames)) + (desktop--process-minibuffer-frames frames) + (mapcar (lambda (frame) + (cons (desktop--filter-frame-parms (frame-parameters frame) t) + (window-state-get (frame-root-window frame) t))) + frames))))) ;;;###autoload (defun desktop-save (dirname &optional release auto-save) @@ -947,8 +1136,11 @@ and don't save the buffer if they are the same." (insert "\n;; Global section:\n") ;; Called here because we save the window/frame state as a global ;; variable for compatibility with previous Emacsen. - (desktop--save-frames) + (desktop-save-frames) + (unless (memq 'desktop-saved-frame-states desktop-globals-to-save) + (desktop-outvar 'desktop-saved-frame-states)) (mapc (function desktop-outvar) desktop-globals-to-save) + (setq desktop-saved-frame-states nil) ; after saving desktop-globals-to-save (when (memq 'kill-ring desktop-globals-to-save) (insert "(setq kill-ring-yank-pointer (nthcdr " @@ -1006,71 +1198,242 @@ This function also sets `desktop-dirname' to nil." (defvar desktop-lazy-timer nil) ;; ---------------------------------------------------------------------------- -(defun desktop--restore-in-this-display-p () - (or desktop-restore-in-current-display - (and (eq system-type 'windows-nt) (not (display-graphic-p))))) - -(defun desktop--find-frame-in-display (frames display) - (let (result) - (while (and frames (not result)) - (if (equal display (frame-parameter (car frames) 'display)) - (setq result (car frames)) - (setq frames (cdr frames)))) - result)) - -(defun desktop--make-full-frame (full display config) - (let ((width (and (eq full 'fullheight) (cdr (assq 'width config)))) - (height (and (eq full 'fullwidth) (cdr (assq 'height config)))) - (params '((visibility))) +(defvar desktop--reuse-list nil + "Internal use only.") + +(defun desktop--find-frame (predicate display &rest args) + "Find a suitable frame in `desktop--reuse-list'. +Look through frames whose display property matches DISPLAY and +return the first one for which (PREDICATE frame ARGS) returns t. +If PREDICATE is nil, it is always satisfied. Internal use only. +This is an auxiliary function for `desktop--select-frame'." + (cl-find-if (lambda (frame) + (and (equal (frame-parameter frame 'display) display) + (or (null predicate) + (apply predicate frame args)))) + desktop--reuse-list)) + +(defun desktop--select-frame (display frame-cfg) + "Look for an existing frame to reuse. +DISPLAY is the display where the frame will be shown, and FRAME-CFG +is the parameter list of the frame being restored. Internal use only." + (if (eq desktop-restoring-reuses-frames t) + (let ((frame nil) + mini) + ;; There are no fancy heuristics there. We could implement some + ;; based on frame size and/or position, etc., but it is not clear + ;; that any "gain" (in the sense of reduced flickering, etc.) is + ;; worth the added complexity. In fact, the code below mainly + ;; tries to work nicely when M-x desktop-read is used after a desktop + ;; session has already been loaded. The other main use case, which + ;; is the initial desktop-read upon starting Emacs, should usually + ;; only have one, or very few, frame(s) to reuse. + (cond ((null display) + ;; When the target is tty, every existing frame is reusable. + (setq frame (desktop--find-frame nil display))) + ((car (setq mini (cdr (assq 'desktop--mini frame-cfg)))) + ;; If the frame has its own minibuffer, let's see whether + ;; that frame has already been loaded (which can happen after + ;; M-x desktop-read). + (setq frame (desktop--find-frame + (lambda (f m) + (equal (frame-parameter f 'desktop--mini) m)) + display mini)) + ;; If it has not been loaded, and it is not a minibuffer-only frame, + ;; let's look for an existing non-minibuffer-only frame to reuse. + (unless (or frame (eq (cdr (assq 'minibuffer frame-cfg)) 'only)) + (setq frame (desktop--find-frame + (lambda (f) + (let ((w (frame-parameter f 'minibuffer))) + (and (window-live-p w) + (window-minibuffer-p w) + (eq (window-frame w) f)))) + display)))) + (mini + ;; For minibufferless frames, check whether they already exist, + ;; and that they are linked to the right minibuffer frame. + (setq frame (desktop--find-frame + (lambda (f n) + (pcase-let (((and m `(,hasmini ,num)) + (frame-parameter f 'desktop--mini))) + (and m + (null hasmini) + (= num n) + (equal (cl-second (frame-parameter + (window-frame (minibuffer-window f)) + 'desktop--mini)) + n)))) + display (cl-second mini)))) + (t + ;; Default to just finding a frame in the same display. + (setq frame (desktop--find-frame nil display)))) + ;; If found, remove from the list. + (when frame + (setq desktop--reuse-list (delq frame desktop--reuse-list))) frame) - (when width - (setq params (append `((user-size . t) (width . ,width)) params) - config (assq-delete-all 'height config))) - (when height - (setq params (append `((user-size . t) (height . ,height)) params) - config (assq-delete-all 'width config))) - (setq frame (make-frame-on-display display params)) - (modify-frame-parameters frame config) + nil)) + +(defun desktop--make-frame (frame-cfg window-cfg) + "Set up a frame according to its saved state. +That means either creating a new frame or reusing an existing one. +FRAME-CFG is the parameter list of the new frame; WINDOW-CFG is +its window state. Internal use only." + (let* ((fullscreen (cdr (assq 'fullscreen frame-cfg))) + (lines (assq 'tool-bar-lines frame-cfg)) + (filtered-cfg (desktop--filter-frame-parms frame-cfg nil)) + (display (cdr (assq 'display filtered-cfg))) ;; post-filtering + alt-cfg frame) + + ;; This works around bug#14795 (or feature#14795, if not a bug :-) + (setq filtered-cfg (assq-delete-all 'tool-bar-lines filtered-cfg)) + (push '(tool-bar-lines . 0) filtered-cfg) + + (when fullscreen + ;; Currently Emacs has the limitation that it does not record the size + ;; and position of a frame before maximizing it, so we cannot save & + ;; restore that info. Instead, when restoring, we resort to creating + ;; invisible "fullscreen" frames of default size and then maximizing them + ;; (and making them visible) which at least is somewhat user-friendly + ;; when these frames are later de-maximized. + (let ((width (and (eq fullscreen 'fullheight) (cdr (assq 'width filtered-cfg)))) + (height (and (eq fullscreen 'fullwidth) (cdr (assq 'height filtered-cfg)))) + (visible (assq 'visibility filtered-cfg))) + (setq filtered-cfg (cl-delete-if (lambda (p) + (memq p '(visibility fullscreen width height))) + filtered-cfg :key #'car)) + (when width + (setq filtered-cfg (append `((user-size . t) (width . ,width)) + filtered-cfg))) + (when height + (setq filtered-cfg (append `((user-size . t) (height . ,height)) + filtered-cfg))) + ;; These are parameters to apply after creating/setting the frame. + (push visible alt-cfg) + (push (cons 'fullscreen fullscreen) alt-cfg))) + + ;; Time to select or create a frame an apply the big bunch of parameters + (if (setq frame (desktop--select-frame display filtered-cfg)) + (modify-frame-parameters frame + (if (eq (frame-parameter frame 'fullscreen) fullscreen) + ;; Workaround for bug#14949 + (assq-delete-all 'fullscreen filtered-cfg) + filtered-cfg)) + (setq frame (make-frame-on-display display filtered-cfg))) + + ;; Let's give the finishing touches (visibility, tool-bar, maximization). + (when lines (push lines alt-cfg)) + (when alt-cfg (modify-frame-parameters frame alt-cfg)) + ;; Now restore window state. + (window-state-put window-cfg (frame-root-window frame) 'safe) frame)) -(defun desktop--restore-frames () +(defun desktop--sort-states (state1 state2) + ;; Order: default minibuffer frame + ;; other frames with minibuffer, ascending ID + ;; minibufferless frames, ascending ID + (pcase-let ((`(,_p1 ,hasmini1 ,num1 ,default1) (assq 'desktop--mini (car state1))) + (`(,_p2 ,hasmini2 ,num2 ,default2) (assq 'desktop--mini (car state2)))) + (cond (default1 t) + (default2 nil) + ((eq hasmini1 hasmini2) (< num1 num2)) + (t hasmini1)))) + +(defun desktop-restoring-frames-p () + "True if calling `desktop-restore-frames' will actually restore frames." + (and desktop-restore-frames desktop-saved-frame-states t)) + +(defun desktop-restore-frames () "Restore window/frame configuration. -Internal use only." - (when (and desktop-restore-frames desktop--saved-states) - (let ((frames (frame-list)) - (current (frame-parameter nil 'display)) - (selected nil)) - (dolist (state desktop--saved-states) +This function depends on the value of `desktop-saved-frame-states' +being set (usually, by reading it from the desktop)." + (when (desktop-restoring-frames-p) + (let* ((frame-mb-map nil) ;; Alist of frames with their own minibuffer + (delete-saved (eq desktop-restore-in-current-display 'delete)) + (forcing (not (desktop-restore-in-original-display-p))) + (target (and forcing (cons 'display (frame-parameter nil 'display))))) + + ;; Sorting saved states allows us to easily restore minibuffer-owning frames + ;; before minibufferless ones. + (setq desktop-saved-frame-states (sort desktop-saved-frame-states + #'desktop--sort-states)) + ;; Potentially all existing frames are reusable. Later we will decide which ones + ;; to reuse, and how to deal with any leftover. + (setq desktop--reuse-list (frame-list)) + + (dolist (state desktop-saved-frame-states) (condition-case err - (let* ((config (car state)) - (display (if (desktop--restore-in-this-display-p) - (setcdr (assq 'display config) current) - (cdr (assq 'display config)))) - (full (cdr (assq 'fullscreen config))) - (frame (and (not full) - (desktop--find-frame-in-display frames display)))) - (cond (full - ;; treat fullscreen/maximized frames specially - (setq frame (desktop--make-full-frame full display config))) - (frame - ;; found a frame in the right display -- reuse - (setq frames (delq frame frames)) - (modify-frame-parameters frame config)) - (t - ;; no frames in the display -- make a new one - (setq frame (make-frame-on-display display config)))) - ;; restore windows - (window-state-put (cdr state) (frame-root-window frame) 'safe) - (unless selected (setq selected frame))) + (pcase-let* ((`(,frame-cfg . ,window-cfg) state) + ((and d-mini `(,hasmini ,num ,default)) + (cdr (assq 'desktop--mini frame-cfg))) + (frame nil) (to-tty nil)) + ;; Only set target if forcing displays and the target display is different. + (if (or (not forcing) + (equal target (or (assq 'display frame-cfg) '(display . nil)))) + (setq desktop--target-display nil) + (setq desktop--target-display target + to-tty (null (cdr target)))) + ;; Time to restore frames and set up their minibuffers as they were. + ;; We only skip a frame (thus deleting it) if either: + ;; - we're switching displays, and the user chose the option to delete, or + ;; - we're switching to tty, and the frame to restore is minibuffer-only. + (unless (and desktop--target-display + (or delete-saved + (and to-tty + (eq (cdr (assq 'minibuffer frame-cfg)) 'only)))) + + ;; Restore minibuffers. Some of this stuff could be done in a filter + ;; function, but it would be messy because restoring minibuffers affects + ;; global state; it's best to do it here than add a bunch of global + ;; variables to pass info back-and-forth to/from the filter function. + (cond + ((null d-mini)) ;; No desktop--mini. Process as normal frame. + (to-tty) ;; Ignore minibuffer stuff and process as normal frame. + (hasmini ;; Frame has minibuffer (or it is minibuffer-only). + (when (eq (cdr (assq 'minibuffer frame-cfg)) 'only) + (setq frame-cfg (append '((tool-bar-lines . 0) (menu-bar-lines . 0)) + frame-cfg)))) + (t ;; Frame depends on other frame's minibuffer window. + (let ((mb-frame (cdr (assq num frame-mb-map)))) + (unless (frame-live-p mb-frame) + (error "Minibuffer frame %s not found" num)) + (let ((mb-param (assq 'minibuffer frame-cfg)) + (mb-window (minibuffer-window mb-frame))) + (unless (and (window-live-p mb-window) + (window-minibuffer-p mb-window)) + (error "Not a minibuffer window %s" mb-window)) + (if mb-param + (setcdr mb-param mb-window) + (push (cons 'minibuffer mb-window) frame-cfg)))))) + ;; OK, we're ready at last to create (or reuse) a frame and + ;; restore the window config. + (setq frame (desktop--make-frame frame-cfg window-cfg)) + ;; Set default-minibuffer if required. + (when default (setq default-minibuffer-frame frame)) + ;; Store NUM/frame to assign to minibufferless frames. + (when hasmini (push (cons num frame) frame-mb-map)))) (error - (message "Error restoring frame: %S" (error-message-string err))))) - (when selected - ;; make sure the original selected frame is visible and selected - (unless (or (frame-parameter selected 'visibility) (daemonp)) - (modify-frame-parameters selected '((visibility . t)))) - (select-frame-set-input-focus selected) - ;; delete any remaining frames - (mapc #'delete-frame frames))))) + (delay-warning 'desktop (error-message-string err) :error)))) + + ;; In case we try to delete the initial frame, we want to make sure that + ;; other frames are already visible (discussed in thread for bug#14841). + (sit-for 0 t) + + ;; Delete remaining frames, but do not fail if some resist being deleted. + (unless (eq desktop-restoring-reuses-frames 'keep) + (dolist (frame desktop--reuse-list) + (condition-case err + (delete-frame frame) + (error + (delay-warning 'desktop (error-message-string err)))))) + (setq desktop--reuse-list nil) + ;; Make sure there's at least one visible frame, and select it. + (unless (or (daemonp) + (cl-find-if #'frame-visible-p (frame-list))) + (let ((visible (if (frame-live-p default-minibuffer-frame) + default-minibuffer-frame + (car (frame-list))))) + (make-frame-visible visible) + (select-frame-set-input-focus visible)))))) ;;;###autoload (defun desktop-read (&optional dirname) @@ -1131,16 +1494,17 @@ Using it may cause conflicts. Use it anyway? " owner))))) (file-error (message "Couldn't record use of desktop file") (sit-for 1)))) - ;; `desktop-create-buffer' puts buffers at end of the buffer list. - ;; We want buffers existing prior to evaluating the desktop (and - ;; not reused) to be placed at the end of the buffer list, so we - ;; move them here. - (mapc 'bury-buffer - (nreverse (cdr (memq desktop-first-buffer (nreverse (buffer-list)))))) - (switch-to-buffer (car (buffer-list))) + (unless (desktop-restoring-frames-p) + ;; `desktop-create-buffer' puts buffers at end of the buffer list. + ;; We want buffers existing prior to evaluating the desktop (and + ;; not reused) to be placed at the end of the buffer list, so we + ;; move them here. + (mapc 'bury-buffer + (nreverse (cdr (memq desktop-first-buffer (nreverse (buffer-list)))))) + (switch-to-buffer (car (buffer-list)))) (run-hooks 'desktop-delay-hook) (setq desktop-delay-hook nil) - (desktop--restore-frames) + (desktop-restore-frames) (run-hooks 'desktop-after-read-hook) (message "Desktop: %d buffer%s restored%s%s." desktop-buffer-ok-count @@ -1152,18 +1516,19 @@ Using it may cause conflicts. Use it anyway? " owner))))) (format ", %d to restore lazily" (length desktop-buffer-args-list)) "")) - ;; Bury the *Messages* buffer to not reshow it when burying - ;; the buffer we switched to above. - (when (buffer-live-p (get-buffer "*Messages*")) - (bury-buffer "*Messages*")) - ;; Clear all windows' previous and next buffers, these have - ;; been corrupted by the `switch-to-buffer' calls in - ;; `desktop-restore-file-buffer' (bug#11556). This is a - ;; brute force fix and should be replaced by a more subtle - ;; strategy eventually. - (walk-window-tree (lambda (window) - (set-window-prev-buffers window nil) - (set-window-next-buffers window nil))) + (unless (desktop-restoring-frames-p) + ;; Bury the *Messages* buffer to not reshow it when burying + ;; the buffer we switched to above. + (when (buffer-live-p (get-buffer "*Messages*")) + (bury-buffer "*Messages*")) + ;; Clear all windows' previous and next buffers, these have + ;; been corrupted by the `switch-to-buffer' calls in + ;; `desktop-restore-file-buffer' (bug#11556). This is a + ;; brute force fix and should be replaced by a more subtle + ;; strategy eventually. + (walk-window-tree (lambda (window) + (set-window-prev-buffers window nil) + (set-window-next-buffers window nil)))) t)) ;; No desktop file found. (desktop-clear) @@ -1387,17 +1752,15 @@ integer, start a new timer to call `desktop-auto-save' in that many seconds." (set-mark desktop-buffer-mark))) ;; Never override file system if the file really is read-only marked. (when desktop-buffer-read-only (setq buffer-read-only desktop-buffer-read-only)) - (while desktop-buffer-locals - (let ((this (car desktop-buffer-locals))) - (if (consp this) - ;; an entry of this form `(symbol . value)' - (progn - (make-local-variable (car this)) - (set (car this) (cdr this))) - ;; an entry of the form `symbol' - (make-local-variable this) - (makunbound this))) - (setq desktop-buffer-locals (cdr desktop-buffer-locals)))))))) + (dolist (this desktop-buffer-locals) + (if (consp this) + ;; an entry of this form `(symbol . value)' + (progn + (make-local-variable (car this)) + (set (car this) (cdr this))) + ;; an entry of the form `symbol' + (make-local-variable this) + (makunbound this)))))))) ;; ---------------------------------------------------------------------------- ;; Backward compatibility -- update parameters to 205 standards. diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 2a9bc167a9c..0c432593909 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -331,9 +331,9 @@ See also the functions: ;; Mark files with some extension. (defun dired-mark-extension (extension &optional marker-char) "Mark all files with a certain EXTENSION for use in later commands. -A `.' is *not* automatically prepended to the string entered." - ;; EXTENSION may also be a list of extensions instead of a single one. - ;; Optional MARKER-CHAR is marker to use. +A `.' is *not* automatically prepended to the string entered. +EXTENSION may also be a list of extensions instead of a single one. +Optional MARKER-CHAR is marker to use." (interactive "sMarking extension: \nP") (or (listp extension) (setq extension (list extension))) @@ -563,10 +563,10 @@ Optional fourth argument LOCALP is as in `dired-get-filename'." (dired-mark-if (and ;; not already marked - (looking-at " ") + (looking-at-p " ") ;; uninteresting (let ((fn (dired-get-filename localp t))) - (and fn (string-match regexp fn)))) + (and fn (string-match-p regexp fn)))) msg))) @@ -610,7 +610,7 @@ you can relist single subdirs using \\[dired-do-redisplay]." (interactive (list (read-string "Virtual Dired directory: " (dired-virtual-guess-dir)))) (goto-char (point-min)) - (or (looking-at " ") + (or (looking-at-p " ") ;; if not already indented, do it now: (indent-region (point-min) (point-max) 2)) (or dirname (setq dirname default-directory)) @@ -627,7 +627,7 @@ you can relist single subdirs using \\[dired-do-redisplay]." ;; If raw ls listing (not a saved old dired buffer), give it a ;; decent subdir headerline: (goto-char (point-min)) - (or (looking-at dired-subdir-regexp) + (or (looking-at-p dired-subdir-regexp) (insert " " (directory-file-name (file-name-directory default-directory)) ":\n")) @@ -1089,13 +1089,13 @@ See `dired-guess-shell-alist-user'." (setq elt (car alist) regexp (car elt) alist (cdr alist)) - (if (string-match regexp file) + (if (string-match-p regexp file) (setq cmds (cdr elt) alist nil))) ;; If more than one file, see if all of FILES match regular expression. (while (and flist - (string-match regexp (car flist))) + (string-match-p regexp (car flist))) (setq flist (cdr flist))) ;; If flist is still non-nil, then do not guess since this means that not @@ -1500,7 +1500,7 @@ to mark all zero length files." (or (dired-move-to-end-of-filename t) (point))) - sym (if (looking-at " -> ") + sym (if (looking-at-p " -> ") (buffer-substring (progn (forward-char 4) (point)) (line-end-position)) "")) @@ -1564,12 +1564,12 @@ Point should be in or after a filename." (save-excursion ;; First see if just past a filename. (or (eobp) ; why? - (when (looking-at "[] \t\n[{}()]") ; whitespace or some parens + (when (looking-at-p "[] \t\n[{}()]") ; whitespace or some parens (skip-chars-backward " \n\t\r({[]})") (or (bobp) (backward-char 1)))) (let ((filename-chars "-.[:alnum:]_/:$+@") start prefix) - (if (looking-at (format "[%s]" filename-chars)) + (if (looking-at-p (format "[%s]" filename-chars)) (progn (skip-chars-backward filename-chars) (setq start (point) @@ -1577,11 +1577,11 @@ Point should be in or after a filename." ;; This is something to do with ange-ftp filenames. ;; It convert foo@bar to /foo@bar. ;; But when does the former occur in dired buffers? - (and (string-match + (and (string-match-p "^\\w+@" (buffer-substring start (line-end-position))) "/")) - (if (string-match "[/~]" (char-to-string (preceding-char))) + (if (string-match-p "[/~]" (char-to-string (preceding-char))) (setq start (1- start))) (skip-chars-forward filename-chars)) (error "No file found around point!")) diff --git a/lisp/dired.el b/lisp/dired.el index 70fee538670..c871761bb3c 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -4367,7 +4367,7 @@ instead. ;;;*** -;;;### (autoloads nil "dired-x" "dired-x.el" "4b863621846609105c0371f8ffb8c1cf") +;;;### (autoloads nil "dired-x" "dired-x.el" "1419d865898f84c17f172320e578380c") ;;; Generated autoloads from dired-x.el (autoload 'dired-jump "dired-x" "\ diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el index ff4a3ad66f0..0573caa6c23 100644 --- a/lisp/dos-w32.el +++ b/lisp/dos-w32.el @@ -257,10 +257,10 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"." ;; Function to actually send data to the printer port. ;; Supports writing directly, and using various programs. (defun direct-print-region-helper (printer - start end - lpr-prog - _delete-text _buf _display - rest) + start end + lpr-prog + _delete-text _buf _display + rest) (let* (;; Ignore case when matching known external program names. (case-fold-search t) ;; Convert / to \ in printer name, for sake of external programs. @@ -295,12 +295,14 @@ filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"." (unwind-protect (cond ;; nprint.exe is the standard print command on Netware - ((string-match-p "^nprint\\(\\.exe\\)?$" (file-name-nondirectory lpr-prog)) + ((string-match-p "\\`nprint\\(\\.exe\\)?\\'" + (file-name-nondirectory lpr-prog)) (write-region start end tempfile nil 0) (call-process lpr-prog nil errbuf nil tempfile (concat "P=" printer))) ;; print.exe is a standard command on NT - ((string-match-p "^print\\(\\.exe\\)?$" (file-name-nondirectory lpr-prog)) + ((string-match-p "\\`print\\(\\.exe\\)?\\'" + (file-name-nondirectory lpr-prog)) ;; Be careful not to invoke print.exe on MS-DOS or Windows 9x ;; though, because it is a TSR program there (hangs Emacs). (or (and (eq system-type 'windows-nt) @@ -369,7 +371,7 @@ indicates a specific program should be invoked." (write-region-annotate-functions (cons (lambda (_start end) - (if (not (char-equal (char-before end) ?\C-l)) + (if (not (char-equal (char-before end) ?\f)) `((,end . "\f")))) write-region-annotate-functions)) (printer (or (and (boundp 'dos-printer) @@ -383,9 +385,7 @@ indicates a specific program should be invoked." (direct-print-region-helper printer start end lpr-prog delete-text buf display rest))) -(defvar print-region-function) (defvar lpr-headers-switches) -(setq print-region-function 'direct-print-region-function) ;; Set this to nil if you have a port of the `pr' program ;; (e.g., from GNU Textutils), or if you have an `lpr' @@ -416,9 +416,6 @@ indicates a specific program should be invoked." (direct-print-region-helper printer start end lpr-prog delete-text buf display rest))) -(defvar ps-print-region-function) -(setq ps-print-region-function 'direct-ps-print-region-function) - ;(setq ps-lpr-command "gs") ;(setq ps-lpr-switches '("-q" "-dNOPAUSE" "-sDEVICE=epson" "-r240x60" diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 67992d16527..73662951188 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -562,7 +562,8 @@ doubt, use whitespace." (unless (string-match " " desc) (let ((times 1) (pos bind-len)) (while (not (cl-mismatch rest-mac rest-mac - 0 bind-len pos (+ bind-len pos))) + :start1 0 :end1 bind-len + :start2 pos :end2 (+ bind-len pos))) (cl-incf times) (cl-incf pos bind-len)) (when (> times 1) diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 22713c6589c..e531bc0bdae 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -436,33 +436,26 @@ Return non-nil in the case where no autoloads were added at point." (defvar print-readably) -(defun autoload--insert-text (output-start otherbuf outbuf absfile - load-name printfun) - ;; If not done yet, figure out where to insert this text. - (unless (marker-buffer output-start) - (let ((outbuf - (or (if otherbuf - ;; A file-local setting of - ;; autoload-generated-file says we - ;; should ignore OUTBUF. - nil - outbuf) - (autoload-find-destination absfile load-name) - ;; The file has autoload cookies, but they're - ;; already up-to-date. If OUTFILE is nil, the - ;; entries are in the expected OUTBUF, - ;; otherwise they're elsewhere. - (throw 'done otherbuf)))) - (with-current-buffer outbuf - (move-marker output-start (point) outbuf)))) - (let ((standard-output (marker-buffer output-start))) - (funcall printfun))) -(defun autoload--insert-cookie-text (output-start otherbuf outbuf absfile - load-name file) - (autoload--insert-text - output-start otherbuf outbuf absfile load-name - (lambda () +(defun autoload--setup-output (otherbuf outbuf absfile load-name) + (let ((outbuf + (or (if otherbuf + ;; A file-local setting of + ;; autoload-generated-file says we + ;; should ignore OUTBUF. + nil + outbuf) + (autoload-find-destination absfile load-name) + ;; The file has autoload cookies, but they're + ;; already up-to-date. If OUTFILE is nil, the + ;; entries are in the expected OUTBUF, + ;; otherwise they're elsewhere. + (throw 'done otherbuf)))) + (with-current-buffer outbuf + (point-marker)))) + +(defun autoload--print-cookie-text (output-start load-name file) + (let ((standard-output (marker-buffer output-start))) (search-forward generate-autoload-cookie) (skip-chars-forward " \t") (if (eolp) @@ -490,7 +483,7 @@ Return non-nil in the case where no autoloads were added at point." ;; Eat one space. (forward-char 1)) (point)) - (progn (forward-line 1) (point)))))))) + (progn (forward-line 1) (point))))))) (defvar autoload-builtin-package-versions nil) @@ -553,23 +546,25 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE (setq package (or (lm-header "package") (file-name-sans-extension (file-name-nondirectory file)))) - (setq output-start (make-marker)) - (autoload--insert-text - output-start otherbuf outbuf absfile load-name - (lambda () + (setq output-start (autoload--setup-output + otherbuf outbuf absfile load-name)) + (let ((standard-output (marker-buffer output-start)) + (print-quoted t)) (princ `(push (purecopy ',(cons (intern package) version)) package--builtin-versions)) - (newline)))))) + (newline))))) (goto-char (point-min)) (while (not (eobp)) (skip-chars-forward " \t\n\f") (cond ((looking-at (regexp-quote generate-autoload-cookie)) - (unless output-start (setq output-start (make-marker))) - (autoload--insert-cookie-text - output-start otherbuf outbuf absfile load-name file)) + ;; If not done yet, figure out where to insert this text. + (unless output-start + (setq output-start (autoload--setup-output + otherbuf outbuf absfile load-name))) + (autoload--print-cookie-text output-start load-name file)) ((looking-at ";") ;; Don't read the comment. (forward-line 1)) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 0728e86d072..aee48eef668 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -102,22 +102,6 @@ The value used here is passed to `quit-restore-window'." This is to optimize `debugger-make-xrefs'.") (defvar debugger-outer-match-data) -(defvar debugger-outer-load-read-function) -(defvar debugger-outer-overriding-local-map) -(defvar debugger-outer-overriding-terminal-local-map) -(defvar debugger-outer-track-mouse) -(defvar debugger-outer-last-command) -(defvar debugger-outer-this-command) -(defvar debugger-outer-unread-command-events) -(defvar debugger-outer-unread-post-input-method-events) -(defvar debugger-outer-last-input-event) -(defvar debugger-outer-last-command-event) -(defvar debugger-outer-last-nonmenu-event) -(defvar debugger-outer-last-event-frame) -(defvar debugger-outer-standard-input) -(defvar debugger-outer-standard-output) -(defvar debugger-outer-inhibit-redisplay) -(defvar debugger-outer-cursor-in-echo-area) (defvar debugger-will-be-back nil "Non-nil if we expect to get back in the debugger soon.") @@ -174,24 +158,6 @@ first will be printed into the backtrace buffer." ;; Save the outer values of these vars for the `e' command ;; before we replace the values. (debugger-outer-match-data (match-data)) - (debugger-outer-load-read-function load-read-function) - (debugger-outer-overriding-local-map overriding-local-map) - (debugger-outer-overriding-terminal-local-map - overriding-terminal-local-map) - (debugger-outer-track-mouse track-mouse) - (debugger-outer-last-command last-command) - (debugger-outer-this-command this-command) - (debugger-outer-unread-command-events unread-command-events) - (debugger-outer-unread-post-input-method-events - unread-post-input-method-events) - (debugger-outer-last-input-event last-input-event) - (debugger-outer-last-command-event last-command-event) - (debugger-outer-last-nonmenu-event last-nonmenu-event) - (debugger-outer-last-event-frame last-event-frame) - (debugger-outer-standard-input standard-input) - (debugger-outer-standard-output standard-output) - (debugger-outer-inhibit-redisplay inhibit-redisplay) - (debugger-outer-cursor-in-echo-area cursor-in-echo-area) (debugger-with-timeout-suspend (with-timeout-suspend))) ;; Set this instead of binding it, so that `q' ;; will not restore it. @@ -294,26 +260,6 @@ first will be printed into the backtrace buffer." (funcall (nth 0 debugger-previous-state)))))) (with-timeout-unsuspend debugger-with-timeout-suspend) (set-match-data debugger-outer-match-data))) - ;; Put into effect the modified values of these variables - ;; in case the user set them with the `e' command. - (setq load-read-function debugger-outer-load-read-function) - (setq overriding-local-map debugger-outer-overriding-local-map) - (setq overriding-terminal-local-map - debugger-outer-overriding-terminal-local-map) - (setq track-mouse debugger-outer-track-mouse) - (setq last-command debugger-outer-last-command) - (setq this-command debugger-outer-this-command) - (setq unread-command-events debugger-outer-unread-command-events) - (setq unread-post-input-method-events - debugger-outer-unread-post-input-method-events) - (setq last-input-event debugger-outer-last-input-event) - (setq last-command-event debugger-outer-last-command-event) - (setq last-nonmenu-event debugger-outer-last-nonmenu-event) - (setq last-event-frame debugger-outer-last-event-frame) - (setq standard-input debugger-outer-standard-input) - (setq standard-output debugger-outer-standard-output) - (setq inhibit-redisplay debugger-outer-inhibit-redisplay) - (setq cursor-in-echo-area debugger-outer-cursor-in-echo-area) (setq debug-on-next-call debugger-step-after-exit) debugger-value))) @@ -518,18 +464,21 @@ removes itself from that hook." (setq debugger-jumping-flag nil) (remove-hook 'post-command-hook 'debugger-reenable)) -(defun debugger-frame-number () +(defun debugger-frame-number (&optional skip-base) "Return number of frames in backtrace before the one point points at." (save-excursion (beginning-of-line) + (if (looking-at " *;;;\\|[a-z]") + (error "This line is not a function call")) (let ((opoint (point)) (count 0)) - (while (not (eq (cadr (backtrace-frame count)) 'debug)) - (setq count (1+ count))) - ;; Skip debug--implement-debug-on-entry frame. - (when (eq 'debug--implement-debug-on-entry - (cadr (backtrace-frame (1+ count)))) - (setq count (+ 2 count))) + (unless skip-base + (while (not (eq (cadr (backtrace-frame count)) 'debug)) + (setq count (1+ count))) + ;; Skip debug--implement-debug-on-entry frame. + (when (eq 'debug--implement-debug-on-entry + (cadr (backtrace-frame (1+ count)))) + (setq count (+ 2 count)))) (goto-char (point-min)) (when (looking-at "Debugger entered--\\(Lisp error\\|returning value\\):") (goto-char (match-end 0)) @@ -551,12 +500,8 @@ removes itself from that hook." "Request entry to debugger when this frame exits. Applies to the frame whose line point is on in the backtrace." (interactive) - (save-excursion - (beginning-of-line) - (if (looking-at " *;;;\\|[a-z]") - (error "This line is not a function call"))) - (beginning-of-line) (backtrace-debug (debugger-frame-number) t) + (beginning-of-line) (if (= (following-char) ? ) (let ((inhibit-read-only t)) (delete-char 1) @@ -567,12 +512,8 @@ Applies to the frame whose line point is on in the backtrace." "Do not enter debugger when this frame exits. Applies to the frame whose line point is on in the backtrace." (interactive) - (save-excursion - (beginning-of-line) - (if (looking-at " *;;;\\|[a-z]") - (error "This line is not a function call"))) - (beginning-of-line) (backtrace-debug (debugger-frame-number) nil) + (beginning-of-line) (if (= (following-char) ?*) (let ((inhibit-read-only t)) (delete-char 1) @@ -583,59 +524,33 @@ Applies to the frame whose line point is on in the backtrace." "Run BODY in original environment." (declare (indent 0)) `(save-excursion - (if (null (buffer-name debugger-old-buffer)) + (if (null (buffer-live-p debugger-old-buffer)) ;; old buffer deleted (setq debugger-old-buffer (current-buffer))) (set-buffer debugger-old-buffer) - (let ((load-read-function debugger-outer-load-read-function) - (overriding-terminal-local-map - debugger-outer-overriding-terminal-local-map) - (overriding-local-map debugger-outer-overriding-local-map) - (track-mouse debugger-outer-track-mouse) - (last-command debugger-outer-last-command) - (this-command debugger-outer-this-command) - (unread-command-events debugger-outer-unread-command-events) - (unread-post-input-method-events - debugger-outer-unread-post-input-method-events) - (last-input-event debugger-outer-last-input-event) - (last-command-event debugger-outer-last-command-event) - (last-nonmenu-event debugger-outer-last-nonmenu-event) - (last-event-frame debugger-outer-last-event-frame) - (standard-input debugger-outer-standard-input) - (standard-output debugger-outer-standard-output) - (inhibit-redisplay debugger-outer-inhibit-redisplay) - (cursor-in-echo-area debugger-outer-cursor-in-echo-area)) - (set-match-data debugger-outer-match-data) - (prog1 - (progn ,@body) - (setq debugger-outer-match-data (match-data)) - (setq debugger-outer-load-read-function load-read-function) - (setq debugger-outer-overriding-terminal-local-map - overriding-terminal-local-map) - (setq debugger-outer-overriding-local-map overriding-local-map) - (setq debugger-outer-track-mouse track-mouse) - (setq debugger-outer-last-command last-command) - (setq debugger-outer-this-command this-command) - (setq debugger-outer-unread-command-events unread-command-events) - (setq debugger-outer-unread-post-input-method-events - unread-post-input-method-events) - (setq debugger-outer-last-input-event last-input-event) - (setq debugger-outer-last-command-event last-command-event) - (setq debugger-outer-last-nonmenu-event last-nonmenu-event) - (setq debugger-outer-last-event-frame last-event-frame) - (setq debugger-outer-standard-input standard-input) - (setq debugger-outer-standard-output standard-output) - (setq debugger-outer-inhibit-redisplay inhibit-redisplay) - (setq debugger-outer-cursor-in-echo-area cursor-in-echo-area) - )))) + (set-match-data debugger-outer-match-data) + (prog1 + (progn ,@body) + (setq debugger-outer-match-data (match-data))))) (defun debugger-eval-expression (exp) - "Eval an expression, in an environment like that outside the debugger." + "Eval an expression, in an environment like that outside the debugger. +The environment used is the one when entering the activation frame at point." (interactive (list (read-from-minibuffer "Eval: " nil read-expression-map t 'read-expression-history))) - (debugger-env-macro (eval-expression exp))) + (let ((nframe (condition-case nil (1+ (debugger-frame-number 'skip-base)) + (error 0))) ;; If on first line. + (base (if (eq 'debug--implement-debug-on-entry + (cadr (backtrace-frame 1 'debug))) + 'debug--implement-debug-on-entry 'debug))) + (debugger-env-macro + (let ((val (backtrace-eval exp nframe base))) + (prog1 + (prin1 val t) + (let ((str (eval-expression-print-format val))) + (if str (princ str t)))))))) (defvar debugger-mode-map (let ((map (make-keymap)) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 36c72f3a3bd..ae20e5270e1 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -2088,8 +2088,6 @@ expressions; a `progn' form will be returned enclosing these forms." (defvar edebug-coverage) ; the coverage results of each expression of function. (defvar edebug-buffer) ; which buffer the function is in. -(defvar edebug-outside-executing-macro) -(defvar edebug-outside-defining-kbd-macro) (defvar edebug-execution-mode 'step) ; Current edebug mode set by user. (defvar edebug-next-execution-mode nil) ; Use once instead of initial mode. @@ -2097,12 +2095,6 @@ expressions; a `progn' form will be returned enclosing these forms." (defvar edebug-outside-debug-on-error) ; the value of debug-on-error outside (defvar edebug-outside-debug-on-quit) ; the value of debug-on-quit outside - -(defvar edebug-outside-pre-command-hook) -(defvar edebug-outside-post-command-hook) - -(defvar cl-lexical-debug) ;; Defined in cl.el - ;;; Handling signals (defun edebug-signal (signal-name signal-data) @@ -2154,10 +2146,7 @@ error is signaled again." ;; Binding these may not be the right thing to do. ;; We want to allow the global values to be changed. (debug-on-error (or debug-on-error edebug-on-error)) - (debug-on-quit edebug-on-quit) - - ;; Lexical bindings must be uncompiled for this to work. - (cl-lexical-debug t)) + (debug-on-quit edebug-on-quit)) (unwind-protect (let ((signal-hook-function 'edebug-signal)) (setq edebug-execution-mode (or edebug-next-execution-mode @@ -2386,9 +2375,6 @@ MSG is printed after `::::} '." (defvar edebug-window-data) ; window and window-start for current function (defvar edebug-outside-windows) ; outside window configuration (defvar edebug-eval-buffer) ; for the evaluation list. -(defvar edebug-outside-o-a-p) ; outside overlay-arrow-position -(defvar edebug-outside-o-a-s) ; outside overlay-arrow-string -(defvar edebug-outside-c-i-e-a) ; outside cursor-in-echo-area (defvar edebug-outside-d-c-i-n-s-w) ; outside default-cursor-in-non-selected-windows (defvar edebug-eval-list nil) ;; List of expressions to evaluate. @@ -2398,8 +2384,6 @@ MSG is printed after `::::} '." ;; Emacs 19 adds an arg to mark and mark-marker. (defalias 'edebug-mark-marker 'mark-marker) -(defvar edebug-outside-unread-command-events) - (defun edebug--display (value offset-index arg-mode) (unless (marker-position edebug-def-mark) ;; The buffer holding the source has been killed. @@ -2421,7 +2405,6 @@ MSG is printed after `::::} '." (edebug-outside-buffer (current-buffer)) (edebug-outside-point (point)) (edebug-outside-mark (edebug-mark)) - (edebug-outside-unread-command-events unread-command-events) edebug-outside-windows ; Window or screen configuration. edebug-buffer-points @@ -2431,9 +2414,6 @@ MSG is printed after `::::} '." edebug-trace-window edebug-trace-window-start - (edebug-outside-o-a-p overlay-arrow-position) - (edebug-outside-o-a-s overlay-arrow-string) - (edebug-outside-c-i-e-a cursor-in-echo-area) (edebug-outside-d-c-i-n-s-w (default-value 'cursor-in-non-selected-windows))) (unwind-protect @@ -2445,8 +2425,7 @@ MSG is printed after `::::} '." ) (setq-default cursor-in-non-selected-windows t) (if (not (buffer-name edebug-buffer)) - (let ((debug-on-error nil)) - (error "Buffer defining %s not found" edebug-function))) + (user-error "Buffer defining %s not found" edebug-function)) (if (eq 'after arg-mode) ;; Compute result string now before windows are modified. @@ -2486,10 +2465,9 @@ MSG is printed after `::::} '." ;; Check whether positions are up-to-date. ;; This assumes point is never before symbol. (if (not (memq (following-char) '(?\( ?\# ?\` ))) - (let ((debug-on-error nil)) - (error "Source has changed - reevaluate definition of %s" - edebug-function) - ))) + (user-error "Source has changed - reevaluate definition of %s" + edebug-function) + )) (setcdr edebug-window-data (edebug-adjust-window (cdr edebug-window-data))) @@ -2645,11 +2623,6 @@ MSG is printed after `::::} '." (if edebug-eval-buffer (kill-buffer edebug-eval-buffer)) (with-timeout-unsuspend edebug-with-timeout-suspend) ;; Reset global variables to outside values in case they were changed. - (setq - unread-command-events edebug-outside-unread-command-events - overlay-arrow-position edebug-outside-o-a-p - overlay-arrow-string edebug-outside-o-a-s - cursor-in-echo-area edebug-outside-c-i-e-a) (setq-default cursor-in-non-selected-windows edebug-outside-d-c-i-n-s-w) ))) @@ -2667,27 +2640,6 @@ MSG is printed after `::::} '." (defvar edebug-inside-windows) (defvar edebug-interactive-p) -(defvar edebug-outside-map) -(defvar edebug-outside-standard-output) -(defvar edebug-outside-standard-input) -(defvar edebug-outside-current-prefix-arg) -(defvar edebug-outside-last-command) -(defvar edebug-outside-this-command) - -;; Note: here we have defvars for variables that are -;; built-in in certain versions. -;; Each defvar makes a difference -;; in versions where the variable is *not* built-in. - -;; Emacs 18 FIXME - -;; Emacs 19. -(defvar edebug-outside-last-command-event) -(defvar edebug-outside-last-input-event) -(defvar edebug-outside-last-event-frame) -(defvar edebug-outside-last-nonmenu-event) -(defvar edebug-outside-track-mouse) - (defun edebug--recursive-edit (arg-mode) ;; Start up a recursive edit inside of edebug. ;; The current buffer is the edebug-buffer, which is put into edebug-mode. @@ -2705,28 +2657,6 @@ MSG is printed after `::::} '." ;; The window configuration may be saved and restored ;; during a recursive-edit edebug-inside-windows - - ;; Save the outside value of executing macro. (here??) - (edebug-outside-executing-macro executing-kbd-macro) - (edebug-outside-pre-command-hook - (edebug-var-status 'pre-command-hook)) - (edebug-outside-post-command-hook - (edebug-var-status 'post-command-hook)) - - (edebug-outside-standard-output standard-output) - (edebug-outside-standard-input standard-input) - (edebug-outside-defining-kbd-macro defining-kbd-macro) - - (edebug-outside-last-command last-command) - (edebug-outside-this-command this-command) - - (edebug-outside-current-prefix-arg current-prefix-arg) - - (edebug-outside-last-input-event last-input-event) - (edebug-outside-last-command-event last-command-event) - (edebug-outside-last-event-frame last-event-frame) - (edebug-outside-last-nonmenu-event last-nonmenu-event) - (edebug-outside-track-mouse track-mouse) ) (unwind-protect @@ -2757,7 +2687,7 @@ MSG is printed after `::::} '." (overriding-local-map nil) (overriding-terminal-local-map nil) - ;; Bind again to outside values. + ;; Bind again to outside values. (debug-on-error edebug-outside-debug-on-error) (debug-on-quit edebug-outside-debug-on-quit) @@ -2805,27 +2735,7 @@ MSG is printed after `::::} '." ;; gotta have a buffer to let its buffer local variables be set (get-buffer-create " bogus edebug buffer")) ));; inner let - - ;; Reset global vars to outside values, in case they have been changed. - (setq - last-command-event edebug-outside-last-command-event - last-command edebug-outside-last-command - this-command edebug-outside-this-command - current-prefix-arg edebug-outside-current-prefix-arg - last-input-event edebug-outside-last-input-event - last-event-frame edebug-outside-last-event-frame - last-nonmenu-event edebug-outside-last-nonmenu-event - track-mouse edebug-outside-track-mouse - - standard-output edebug-outside-standard-output - standard-input edebug-outside-standard-input - defining-kbd-macro edebug-outside-defining-kbd-macro) - - (setq executing-kbd-macro edebug-outside-executing-macro) - (edebug-restore-status - 'post-command-hook edebug-outside-post-command-hook) - (edebug-restore-status - 'pre-command-hook edebug-outside-pre-command-hook)))) + ))) ;;; Display related functions @@ -3423,6 +3333,9 @@ edebug-mode." (defmacro edebug-outside-excursion (&rest body) "Evaluate an expression list in the outside context. Return the result of the last expression." + ;; Only restores the non-variables context since all the variables let-bound + ;; by Edebug will be properly reset to the appropriate context's value by + ;; backtrace-eval. (declare (debug t)) `(save-excursion ; of current-buffer (if edebug-save-windows @@ -3435,89 +3348,32 @@ Return the result of the last expression." (edebug-set-windows edebug-outside-windows))) (set-buffer edebug-buffer) ; why? - ;; (use-local-map edebug-outside-map) (set-match-data edebug-outside-match-data) ;; Restore outside context. - (let (;; (edebug-inside-map (current-local-map)) ;; restore map?? - (last-command-event edebug-outside-last-command-event) - (last-command edebug-outside-last-command) - (this-command edebug-outside-this-command) - (unread-command-events edebug-outside-unread-command-events) - (current-prefix-arg edebug-outside-current-prefix-arg) - (last-input-event edebug-outside-last-input-event) - (last-event-frame edebug-outside-last-event-frame) - (last-nonmenu-event edebug-outside-last-nonmenu-event) - (track-mouse edebug-outside-track-mouse) - (standard-output edebug-outside-standard-output) - (standard-input edebug-outside-standard-input) - - (executing-kbd-macro edebug-outside-executing-macro) - (defining-kbd-macro edebug-outside-defining-kbd-macro) - ;; Get the values out of the saved statuses. - (pre-command-hook (cdr edebug-outside-pre-command-hook)) - (post-command-hook (cdr edebug-outside-post-command-hook)) - - ;; See edebug-display. - (overlay-arrow-position edebug-outside-o-a-p) - (overlay-arrow-string edebug-outside-o-a-s) - (cursor-in-echo-area edebug-outside-c-i-e-a) - ) - (setq-default cursor-in-non-selected-windows edebug-outside-d-c-i-n-s-w) - (unwind-protect - (with-current-buffer edebug-outside-buffer ; of edebug-buffer - (goto-char edebug-outside-point) - (if (marker-buffer (edebug-mark-marker)) - (set-marker (edebug-mark-marker) edebug-outside-mark)) - ,@body) - - ;; Back to edebug-buffer. Restore rest of inside context. - ;; (use-local-map edebug-inside-map) - (if edebug-save-windows - ;; Restore inside windows. - (edebug-set-windows edebug-inside-windows)) - - ;; Save values that may have been changed. - (setq - edebug-outside-last-command-event last-command-event - edebug-outside-last-command last-command - edebug-outside-this-command this-command - edebug-outside-unread-command-events unread-command-events - edebug-outside-current-prefix-arg current-prefix-arg - edebug-outside-last-input-event last-input-event - edebug-outside-last-event-frame last-event-frame - edebug-outside-last-nonmenu-event last-nonmenu-event - edebug-outside-track-mouse track-mouse - edebug-outside-standard-output standard-output - edebug-outside-standard-input standard-input - - edebug-outside-executing-macro executing-kbd-macro - edebug-outside-defining-kbd-macro defining-kbd-macro - - edebug-outside-o-a-p overlay-arrow-position - edebug-outside-o-a-s overlay-arrow-string - edebug-outside-c-i-e-a cursor-in-echo-area - edebug-outside-d-c-i-n-s-w (default-value - 'cursor-in-non-selected-windows) - ) - - ;; Restore the outside saved values; don't alter - ;; the outside binding loci. - (setcdr edebug-outside-pre-command-hook pre-command-hook) - (setcdr edebug-outside-post-command-hook post-command-hook) - - (setq-default cursor-in-non-selected-windows t) - )) ; let - )) - -(defvar cl-debug-env) ; defined in cl; non-nil when lexical env used. + (setq-default cursor-in-non-selected-windows edebug-outside-d-c-i-n-s-w) + (unwind-protect + (with-current-buffer edebug-outside-buffer ; of edebug-buffer + (goto-char edebug-outside-point) + (if (marker-buffer (edebug-mark-marker)) + (set-marker (edebug-mark-marker) edebug-outside-mark)) + ,@body) + + ;; Back to edebug-buffer. Restore rest of inside context. + ;; (use-local-map edebug-inside-map) + (if edebug-save-windows + ;; Restore inside windows. + (edebug-set-windows edebug-inside-windows)) + + ;; Save values that may have been changed. + (setq edebug-outside-d-c-i-n-s-w + (default-value 'cursor-in-non-selected-windows)) + + ;; Restore the outside saved values; don't alter + ;; the outside binding loci. + (setq-default cursor-in-non-selected-windows t)))) (defun edebug-eval (expr) - ;; Are there cl lexical variables active? - (eval (if (and (bound-and-true-p cl-debug-env) - (fboundp 'cl-macroexpand-all)) - (cl-macroexpand-all expr cl-debug-env) - expr) - lexical-binding)) + (backtrace-eval expr 0 'edebug-after)) (defun edebug-safe-eval (expr) ;; Evaluate EXPR safely. @@ -4268,7 +4124,7 @@ With prefix argument, make it a temporary breakpoint." (eq (nth 1 (nth 1 frame1)) '()) (eq (nth 1 frame2) 'edebug-enter)) ;; `edebug-enter' calls itself on its first invocation. - (if (eq (nth 1 (internal--called-interactively-p--get-frame i)) + (if (eq (nth 1 (backtrace-frame i 'called-interactively-p)) 'edebug-enter) 2 1))) diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 8b149aad7bb..edcfc409085 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -425,7 +425,7 @@ of the piece of advice." (get-next-frame (lambda () (setq frame1 frame2) - (setq frame2 (internal--called-interactively-p--get-frame i)) + (setq frame2 (backtrace-frame i #'called-interactively-p)) ;; (message "Advice Frame %d = %S" i frame2) (setq i (1+ i))))) (when (and (eq (nth 1 frame2) 'apply) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 32339249085..68d2880d33e 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1393,7 +1393,7 @@ Letters do not insert themselves; instead, they are commands. ("Description" 0 nil)]) (setq tabulated-list-padding 2) (setq tabulated-list-sort-key (cons "Status" nil)) - (add-hook 'tabulated-list-revert-hook 'package-menu--refresh) + (add-hook 'tabulated-list-revert-hook 'package-menu--refresh nil t) (tabulated-list-init-header)) (defmacro package--push (pkg-desc status listname) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 511f1480099..50c92518b02 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -659,11 +659,15 @@ Otherwise, it defers to REST which is a list of branches of the form (memq-fine t)) (when all (dolist (alt (cdr upat)) - (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))))) + (unless (if (pcase--self-quoting-p alt) + (progn + (unless (or (symbolp alt) (integerp alt)) + (setq memq-fine nil)) + t) + (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. diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el index 6ba29d3748f..896fc2a954e 100644 --- a/lisp/epa-mail.el +++ b/lisp/epa-mail.el @@ -109,94 +109,127 @@ If no one is selected, default secret key is used. " (if verbose (epa--read-signature-type) 'clear))))) - (epa-sign-region start end signers mode)) + (let ((inhibit-read-only t)) + (epa-sign-region start end signers mode))) + +(defun epa-mail-default-recipients () + "Return the default list of encryption recipients for a mail buffer." + (let ((config (epg-configuration)) + recipients-string real-recipients) + (save-excursion + (goto-char (point-min)) + (save-restriction + (narrow-to-region (point) + (if (search-forward mail-header-separator nil 0) + (match-beginning 0) + (point))) + (setq recipients-string + (mapconcat #'identity + (nconc (mail-fetch-field "to" nil nil t) + (mail-fetch-field "cc" nil nil t) + (mail-fetch-field "bcc" nil nil t)) + ",")) + (setq recipients-string + (mail-strip-quoted-names + (with-temp-buffer + (insert "to: " recipients-string "\n") + (expand-mail-aliases (point-min) (point-max)) + (car (mail-fetch-field "to" nil nil t)))))) + + (setq real-recipients + (split-string recipients-string "," t "[ \t\n]*")) + + ;; Process all the recipients thru the list of GnuPG groups. + ;; Expand GnuPG group names to what they stand for. + (setq real-recipients + (apply #'nconc + (mapcar + (lambda (recipient) + (or (epg-expand-group config recipient) + (list recipient))) + real-recipients))) + + ;; Process all the recipients thru the user's list + ;; of encryption aliases. + (setq real-recipients + (apply #'nconc + (mapcar + (lambda (recipient) + (let ((tem (assoc recipient epa-mail-aliases))) + (if tem (cdr tem) + (list recipient)))) + real-recipients))) + ))) ;;;###autoload -(defun epa-mail-encrypt (start end recipients sign signers) - "Encrypt the current buffer. -The buffer is expected to contain a mail message. +(defun epa-mail-encrypt (&optional recipients signers) + "Encrypt the outgoing mail message in the current buffer. +Takes the recipients from the text in the header in the buffer +and translates them through `epa-mail-aliases'. +With prefix argument, asks you to select among them interactively +and also whether and how to sign. -Don't use this command in Lisp programs!" +Called from Lisp, the optional argument RECIPIENTS is a list +of recipient addresses, t to perform symmetric encryption, +or nil meaning use the defaults. + +SIGNERS is a list of keys to sign the message with." (interactive - (save-excursion - (let ((verbose current-prefix-arg) - (config (epg-configuration)) - (context (epg-make-context epa-protocol)) - recipients-string recipients recipient-key sign) - (goto-char (point-min)) - (save-restriction - (narrow-to-region (point) - (if (search-forward mail-header-separator nil 0) - (match-beginning 0) - (point))) - (setq recipients-string - (mapconcat #'identity - (nconc (mail-fetch-field "to" nil nil t) - (mail-fetch-field "cc" nil nil t) - (mail-fetch-field "bcc" nil nil t)) - ",")) - (setq recipients - (mail-strip-quoted-names - (with-temp-buffer - (insert "to: " recipients-string "\n") - (expand-mail-aliases (point-min) (point-max)) - (car (mail-fetch-field "to" nil nil t)))))) - (if recipients - (setq recipients (delete "" - (split-string recipients - "[ \t\n]*,[ \t\n]*")))) - - ;; Process all the recipients thru the list of GnuPG groups. - ;; Expand GnuPG group names to what they stand for. - (setq recipients - (apply #'nconc - (mapcar - (lambda (recipient) - (or (epg-expand-group config recipient) - (list recipient))) - recipients))) - - (goto-char (point-min)) - (if (search-forward mail-header-separator nil t) - (forward-line)) - (setq epa-last-coding-system-specified - (or coding-system-for-write - (epa--select-safe-coding-system (point) (point-max)))) - (list (point) (point-max) - (if verbose - (epa-select-keys - context - "Select recipients for encryption. + (let ((verbose current-prefix-arg) + (context (epg-make-context epa-protocol))) + (list (if verbose + (or (epa-select-keys + context + "Select recipients for encryption. If no one is selected, symmetric encryption will be performed. " - recipients) - (if recipients + (epa-mail-default-recipients)) + t)) + (and verbose (y-or-n-p "Sign? ") + (epa-select-keys context + "Select keys for signing. "))))) + (let (start recipient-keys default-recipients) + (save-excursion + (setq recipient-keys + (cond ((eq recipients t) + nil) + (recipients recipients) + (t + (setq default-recipients + (epa-mail-default-recipients)) + ;; Convert recipients to keys. (apply 'nconc (mapcar (lambda (recipient) - (setq recipient-key - (epa-mail--find-usable-key - (epg-list-keys - (epg-make-context epa-protocol) - (if (string-match "@" recipient) - (concat "<" recipient ">") - recipient)) - 'encrypt)) - (unless (or recipient-key - (y-or-n-p - (format - "No public key for %s; skip it? " - recipient))) - (error "No public key for %s" recipient)) - (if recipient-key (list recipient-key))) - recipients)))) - (setq sign (if verbose (y-or-n-p "Sign? "))) - (if sign - (epa-select-keys context - "Select keys for signing. ")))))) - ;; Don't let some read-only text stop us from encrypting. - (let ((inhibit-read-only t)) - (epa-encrypt-region start end recipients sign signers))) + (let ((recipient-key + (epa-mail--find-usable-key + (epg-list-keys + (epg-make-context epa-protocol) + (if (string-match "@" recipient) + (concat "<" recipient ">") + recipient)) + 'encrypt))) + (unless (or recipient-key + (y-or-n-p + (format + "No public key for %s; skip it? " + recipient))) + (error "No public key for %s" recipient)) + (if recipient-key (list recipient-key)))) + default-recipients))))) + + (goto-char (point-min)) + (if (search-forward mail-header-separator nil t) + (forward-line)) + (setq start (point)) + + (setq epa-last-coding-system-specified + (or coding-system-for-write + (epa--select-safe-coding-system (point) (point-max))))) + + ;; Don't let some read-only text stop us from encrypting. + (let ((inhibit-read-only t)) + (epa-encrypt-region start (point-max) recipient-keys signers signers)))) ;;;###autoload (defun epa-mail-import-keys () diff --git a/lisp/epa.el b/lisp/epa.el index 14f8879c1c6..a99fb9230e1 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -34,8 +34,7 @@ :group 'epg) (defcustom epa-popup-info-window t - "If non-nil, status information from epa commands is displayed on -the separate window." + "If non-nil, display status information from epa commands in another window." :type 'boolean :group 'epa) @@ -49,6 +48,18 @@ the separate window." :version "23.1" :group 'epa) +(defcustom epa-mail-aliases nil + "Alist of aliases of email addresses that stand for encryption keys. +Each element is (ALIAS EXPANSIONS...). +It means that when a message is addressed to ALIAS, +instead of encrypting it for ALIAS, encrypt it for EXPANSIONS... +If EXPANSIONS is empty, ignore ALIAS as regards encryption. +That is a handy way to avoid warnings about addresses +that you don't have any key for." + :type '(repeat (cons (string :tag "Alias") (repeat '(string :tag "Expansion")))) + :group 'epa + :version "24.4") + (defface epa-validity-high '((default :weight bold) (((class color) (background dark)) :foreground "PaleTurquoise")) diff --git a/lisp/ffap.el b/lisp/ffap.el index 0769469cbf2..70096248e19 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -459,7 +459,8 @@ Returned values: (let ((mesg (car (cdr error)))) (cond ;; v18: - ((string-match "^Unknown host" mesg) nil) + ((string-match "\\(^Unknown host\\|Name or service not known$\\)" + mesg) nil) ((string-match "not responding$" mesg) mesg) ;; v19: ;; (file-error "connection failed" "permission denied" diff --git a/lisp/filenotify.el b/lisp/filenotify.el index e170db2dd5f..d2f37b99107 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -27,8 +27,7 @@ ;;; Code: -;;;###autoload -(defconst file-notify-support +(defconst file-notify--library (cond ((featurep 'gfilenotify) 'gfilenotify) ((featurep 'inotify) 'inotify) @@ -238,7 +237,7 @@ FILE is the name of the file whose event is being reported." (let* ((handler (find-file-name-handler file 'file-notify-add-watch)) (dir (directory-file-name - (if (or (and (not handler) (eq file-notify-support 'w32notify)) + (if (or (and (not handler) (eq file-notify--library 'w32notify)) (file-directory-p file)) file (file-name-directory file)))) @@ -259,32 +258,33 @@ FILE is the name of the file whose event is being reported." ;; Check, whether Emacs has been compiled with file ;; notification support. - (unless file-notify-support + (unless file-notify--library (signal 'file-notify-error '("No file notification package available"))) ;; Determine low-level function to be called. - (setq func (cond - ((eq file-notify-support 'gfilenotify) 'gfile-add-watch) - ((eq file-notify-support 'inotify) 'inotify-add-watch) - ((eq file-notify-support 'w32notify) 'w32notify-add-watch))) + (setq func + (cond + ((eq file-notify--library 'gfilenotify) 'gfile-add-watch) + ((eq file-notify--library 'inotify) 'inotify-add-watch) + ((eq file-notify--library 'w32notify) 'w32notify-add-watch))) ;; Determine respective flags. - (if (eq file-notify-support 'gfilenotify) + (if (eq file-notify--library 'gfilenotify) (setq l-flags '(watch-mounts send-moved)) (when (memq 'change flags) (setq l-flags (cond - ((eq file-notify-support 'inotify) '(create modify move delete)) - ((eq file-notify-support 'w32notify) + ((eq file-notify--library 'inotify) '(create modify move delete)) + ((eq file-notify--library 'w32notify) '(file-name directory-name size last-write-time))))) (when (memq 'attribute-change flags) (add-to-list 'l-flags (cond - ((eq file-notify-support 'inotify) 'attrib) - ((eq file-notify-support 'w32notify) 'attributes))))) + ((eq file-notify--library 'inotify) 'attrib) + ((eq file-notify--library 'w32notify) 'attributes))))) ;; Call low-level function. (setq desc (funcall func dir l-flags 'file-notify-callback)))) @@ -311,9 +311,9 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'." (funcall handler 'file-notify-rm-watch descriptor) (funcall (cond - ((eq file-notify-support 'gfilenotify) 'gfile-rm-watch) - ((eq file-notify-support 'inotify) 'inotify-rm-watch) - ((eq file-notify-support 'w32notify) 'w32notify-rm-watch)) + ((eq file-notify--library 'gfilenotify) 'gfile-rm-watch) + ((eq file-notify--library 'inotify) 'inotify-rm-watch) + ((eq file-notify--library 'w32notify) 'w32notify-rm-watch)) descriptor))) (remhash descriptor file-notify-descriptors))) diff --git a/lisp/files.el b/lisp/files.el index ff4ccec2279..10d66e0b2e0 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5246,10 +5246,12 @@ comparison." (put 'revert-buffer-function 'permanent-local t) -(defvar revert-buffer-function nil +(defvar revert-buffer-function #'revert-buffer--default "Function to use to revert this buffer, or nil to do the default. The function receives two arguments IGNORE-AUTO and NOCONFIRM, -which are the arguments that `revert-buffer' received.") +which are the arguments that `revert-buffer' received. +It also has access to the `preserve-modes' argument of `revert-buffer' +via the `revert-buffer-preserve-modes' dynamic variable.") (put 'revert-buffer-insert-file-contents-function 'permanent-local t) (defvar revert-buffer-insert-file-contents-function nil @@ -5296,6 +5298,11 @@ This is true even if a `revert-buffer-function' is being used.") (defvar revert-buffer-internal-hook) +;; `revert-buffer-function' was defined long ago to be a function of only +;; 2 arguments, so we have to use a dynbind variable to pass the +;; `preserve-modes' argument of `revert-buffer'. +(defvar revert-buffer-preserve-modes) + (defun revert-buffer (&optional ignore-auto noconfirm preserve-modes) "Replace current buffer text with the text of the visited file on disk. This undoes all changes since the file was visited or saved. @@ -5337,112 +5344,113 @@ non-nil, it is called instead of rereading visited file contents." ;; reversal of the argument sense. So I'm just changing the user ;; interface, but leaving the programmatic interface the same. (interactive (list (not current-prefix-arg))) - (if revert-buffer-function - (let ((revert-buffer-in-progress-p t)) - (funcall revert-buffer-function ignore-auto noconfirm)) - (with-current-buffer (or (buffer-base-buffer (current-buffer)) - (current-buffer)) - (let* ((revert-buffer-in-progress-p t) - (auto-save-p (and (not ignore-auto) - (recent-auto-save-p) - buffer-auto-save-file-name - (file-readable-p buffer-auto-save-file-name) - (y-or-n-p - "Buffer has been auto-saved recently. Revert from auto-save file? "))) - (file-name (if auto-save-p - buffer-auto-save-file-name - buffer-file-name))) - (cond ((null file-name) - (error "Buffer does not seem to be associated with any file")) - ((or noconfirm - (and (not (buffer-modified-p)) - (catch 'found - (dolist (regexp revert-without-query) - (when (string-match regexp file-name) - (throw 'found t))))) - (yes-or-no-p (format "Revert buffer from file %s? " - file-name))) - (run-hooks 'before-revert-hook) - ;; If file was backed up but has changed since, - ;; we should make another backup. - (and (not auto-save-p) - (not (verify-visited-file-modtime (current-buffer))) - (setq buffer-backed-up nil)) - ;; Effectively copy the after-revert-hook status, - ;; since after-find-file will clobber it. - (let ((global-hook (default-value 'after-revert-hook)) - (local-hook (when (local-variable-p 'after-revert-hook) - after-revert-hook)) - (inhibit-read-only t)) - (cond - (revert-buffer-insert-file-contents-function - (unless (eq buffer-undo-list t) - ;; Get rid of all undo records for this buffer. - (setq buffer-undo-list nil)) - ;; Don't make undo records for the reversion. - (let ((buffer-undo-list t)) - (funcall revert-buffer-insert-file-contents-function - file-name auto-save-p))) - ((not (file-exists-p file-name)) - (error (if buffer-file-number - "File %s no longer exists!" - "Cannot revert nonexistent file %s") - file-name)) - ((not (file-readable-p file-name)) - (error (if buffer-file-number - "File %s no longer readable!" - "Cannot revert unreadable file %s") - file-name)) - (t - ;; Bind buffer-file-name to nil - ;; so that we don't try to lock the file. - (let ((buffer-file-name nil)) - (or auto-save-p - (unlock-buffer))) - (widen) - (let ((coding-system-for-read - ;; Auto-saved file should be read by Emacs's - ;; internal coding. - (if auto-save-p 'auto-save-coding - (or coding-system-for-read - (and - buffer-file-coding-system-explicit - (car buffer-file-coding-system-explicit)))))) - (if (and (not enable-multibyte-characters) - coding-system-for-read - (not (memq (coding-system-base - coding-system-for-read) - '(no-conversion raw-text)))) - ;; As a coding system suitable for multibyte - ;; buffer is specified, make the current - ;; buffer multibyte. - (set-buffer-multibyte t)) - - ;; This force after-insert-file-set-coding - ;; (called from insert-file-contents) to set - ;; buffer-file-coding-system to a proper value. - (kill-local-variable 'buffer-file-coding-system) - - ;; Note that this preserves point in an intelligent way. - (if preserve-modes - (let ((buffer-file-format buffer-file-format)) - (insert-file-contents file-name (not auto-save-p) - nil nil t)) - (insert-file-contents file-name (not auto-save-p) - nil nil t))))) - ;; Recompute the truename in case changes in symlinks - ;; have changed the truename. - (setq buffer-file-truename - (abbreviate-file-name (file-truename buffer-file-name))) - (after-find-file nil nil t nil preserve-modes) - ;; Run after-revert-hook as it was before we reverted. - (setq-default revert-buffer-internal-hook global-hook) - (if local-hook - (set (make-local-variable 'revert-buffer-internal-hook) - local-hook) - (kill-local-variable 'revert-buffer-internal-hook)) - (run-hooks 'revert-buffer-internal-hook)) - t)))))) + (let ((revert-buffer-in-progress-p t) + (revert-buffer-preserve-modes preserve-modes)) + (funcall (or revert-buffer-function #'revert-buffer--default) + ignore-auto noconfirm))) +(defun revert-buffer--default (ignore-auto noconfirm) + (with-current-buffer (or (buffer-base-buffer (current-buffer)) + (current-buffer)) + (let* ((auto-save-p (and (not ignore-auto) + (recent-auto-save-p) + buffer-auto-save-file-name + (file-readable-p buffer-auto-save-file-name) + (y-or-n-p + "Buffer has been auto-saved recently. Revert from auto-save file? "))) + (file-name (if auto-save-p + buffer-auto-save-file-name + buffer-file-name))) + (cond ((null file-name) + (error "Buffer does not seem to be associated with any file")) + ((or noconfirm + (and (not (buffer-modified-p)) + (catch 'found + (dolist (regexp revert-without-query) + (when (string-match regexp file-name) + (throw 'found t))))) + (yes-or-no-p (format "Revert buffer from file %s? " + file-name))) + (run-hooks 'before-revert-hook) + ;; If file was backed up but has changed since, + ;; we should make another backup. + (and (not auto-save-p) + (not (verify-visited-file-modtime (current-buffer))) + (setq buffer-backed-up nil)) + ;; Effectively copy the after-revert-hook status, + ;; since after-find-file will clobber it. + (let ((global-hook (default-value 'after-revert-hook)) + (local-hook (when (local-variable-p 'after-revert-hook) + after-revert-hook)) + (inhibit-read-only t)) + (cond + (revert-buffer-insert-file-contents-function + (unless (eq buffer-undo-list t) + ;; Get rid of all undo records for this buffer. + (setq buffer-undo-list nil)) + ;; Don't make undo records for the reversion. + (let ((buffer-undo-list t)) + (funcall revert-buffer-insert-file-contents-function + file-name auto-save-p))) + ((not (file-exists-p file-name)) + (error (if buffer-file-number + "File %s no longer exists!" + "Cannot revert nonexistent file %s") + file-name)) + ((not (file-readable-p file-name)) + (error (if buffer-file-number + "File %s no longer readable!" + "Cannot revert unreadable file %s") + file-name)) + (t + ;; Bind buffer-file-name to nil + ;; so that we don't try to lock the file. + (let ((buffer-file-name nil)) + (or auto-save-p + (unlock-buffer))) + (widen) + (let ((coding-system-for-read + ;; Auto-saved file should be read by Emacs's + ;; internal coding. + (if auto-save-p 'auto-save-coding + (or coding-system-for-read + (and + buffer-file-coding-system-explicit + (car buffer-file-coding-system-explicit)))))) + (if (and (not enable-multibyte-characters) + coding-system-for-read + (not (memq (coding-system-base + coding-system-for-read) + '(no-conversion raw-text)))) + ;; As a coding system suitable for multibyte + ;; buffer is specified, make the current + ;; buffer multibyte. + (set-buffer-multibyte t)) + + ;; This force after-insert-file-set-coding + ;; (called from insert-file-contents) to set + ;; buffer-file-coding-system to a proper value. + (kill-local-variable 'buffer-file-coding-system) + + ;; Note that this preserves point in an intelligent way. + (if revert-buffer-preserve-modes + (let ((buffer-file-format buffer-file-format)) + (insert-file-contents file-name (not auto-save-p) + nil nil t)) + (insert-file-contents file-name (not auto-save-p) + nil nil t))))) + ;; Recompute the truename in case changes in symlinks + ;; have changed the truename. + (setq buffer-file-truename + (abbreviate-file-name (file-truename buffer-file-name))) + (after-find-file nil nil t nil revert-buffer-preserve-modes) + ;; Run after-revert-hook as it was before we reverted. + (setq-default revert-buffer-internal-hook global-hook) + (if local-hook + (set (make-local-variable 'revert-buffer-internal-hook) + local-hook) + (kill-local-variable 'revert-buffer-internal-hook)) + (run-hooks 'revert-buffer-internal-hook)) + t))))) (defun recover-this-file () "Recover the visited file--get contents from its last auto-save file." diff --git a/lisp/frame.el b/lisp/frame.el index 3ac24a509a0..71e7cc10de2 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1671,6 +1671,16 @@ left untouched. FRAME nil or omitted means use the selected frame." :type 'number :group 'cursor) +(defcustom blink-cursor-blinks 10 + "How many times to blink before using a solid cursor on NS and X. +Use 0 or negative value to blink forever." + :version "24.4" + :type 'integer + :group 'cursor) + +(defvar blink-cursor-blinks-done 1 + "Number of blinks done since we started blinking on NS and X") + (defvar blink-cursor-idle-timer nil "Timer started after `blink-cursor-delay' seconds of Emacs idle time. The function `blink-cursor-start' is called when the timer fires.") @@ -1688,6 +1698,7 @@ command starts, by installing a pre-command hook." (when (null blink-cursor-timer) ;; Set up the timer first, so that if this signals an error, ;; blink-cursor-end is not added to pre-command-hook. + (setq blink-cursor-blinks-done 1) (setq blink-cursor-timer (run-with-timer blink-cursor-interval blink-cursor-interval 'blink-cursor-timer-function)) @@ -1696,7 +1707,15 @@ command starts, by installing a pre-command hook." (defun blink-cursor-timer-function () "Timer function of timer `blink-cursor-timer'." - (internal-show-cursor nil (not (internal-show-cursor-p)))) + (internal-show-cursor nil (not (internal-show-cursor-p))) + ;; Each blink is two calls to this function. + (when (memq window-system '(x ns w32)) + (setq blink-cursor-blinks-done (1+ blink-cursor-blinks-done)) + (when (and (> blink-cursor-blinks 0) + (<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done)) + (blink-cursor-suspend) + (add-hook 'post-command-hook 'blink-cursor-check)))) + (defun blink-cursor-end () "Stop cursor blinking. @@ -1709,6 +1728,29 @@ itself as a pre-command hook." (cancel-timer blink-cursor-timer) (setq blink-cursor-timer nil))) +(defun blink-cursor-suspend () + "Suspend cursor blinking on NS, X and W32. +This is called when no frame has focus and timers can be suspended. +Timers are restarted by `blink-cursor-check', which is called when a +frame receives focus." + (when (memq window-system '(x ns w32)) + (blink-cursor-end) + (when blink-cursor-idle-timer + (cancel-timer blink-cursor-idle-timer) + (setq blink-cursor-idle-timer nil)))) + +(defun blink-cursor-check () + "Check if cursor blinking shall be restarted. +This is done when a frame gets focus. Blink timers may be stopped by +`blink-cursor-suspend'." + (when (and blink-cursor-mode + (not blink-cursor-idle-timer)) + (remove-hook 'post-command-hook 'blink-cursor-check) + (setq blink-cursor-idle-timer + (run-with-idle-timer blink-cursor-delay + blink-cursor-delay + 'blink-cursor-start)))) + (define-obsolete-variable-alias 'blink-cursor 'blink-cursor-mode "22.1") (define-minor-mode blink-cursor-mode diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 006b415b180..a67c55947ac 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,39 @@ +2013-07-25 Andreas Schwab <schwab@linux-m68k.org> + + * gnus-art.el (gnus-button-url-regexp): Make it match url in which + punctuation characters follow parentheses (bug#14950). + +2013-07-23 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus.el (gnus-continuum-version): + * gnus-msg.el (gnus-extended-version): Simplify. + + * gnus.el (gnus-continuum-version-1): Remove. + * gnus-msg.el (gnus-bug): Revert. + + Calculate gnus-version correctly on Cygwin. + + * gnus.el (gnus-continuum-version): Do main calculations in integers. + (gnus-continuum-version-1): New function, return a string. + + * gnus-msg.el (gnus-extended-version, gnus-bug): + Use gnus-continuum-version-1 instead of gnus-continuum-version. + +2013-07-19 Geoff Kuenning <geoff@cs.hmc.edu> (tiny change) + + * gnus-art.el (gnus-treat-predicate): Allow functions as predicates + (bug#13384). + +2013-07-18 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-start.el (gnus-clean-old-newsrc): Remove the newsrc cleanups + that were only relevant in a development version a long time ago. + +2013-07-18 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-shr-put-image): Make it work as well for shr.el's + that the old Emacs 24s bundle. + 2013-07-10 David Engster <deng@randomsample.de> * gnus-start.el (gnus-clean-old-newsrc): Always remove 'unexist' marks @@ -143,7 +179,7 @@ 2013-07-02 Lars Magne Ingebrigtsen <larsi@gnus.org> * gnus-sum.el (gnus-summary-insert-old-articles): - Don't include unexistent messages. + Don't include unexisting messages. 2013-07-02 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -1861,7 +1897,7 @@ * nnmail.el (mail-send-and-exit): Silence the byte compiler. -2012-06-26 Peter Munster <pmrb@free.fr> +2012-06-26 Peter Münster <pmrb@free.fr> * gnus-demon.el (gnus-demon-timers): Now a plist (function -> timer). (gnus-demon-cancel): Ditto. @@ -2088,7 +2124,7 @@ (spam-check-BBDB): Use it. (spam-enter-ham-BBDB): Use it. -2012-06-26 Peter Munster <pmrb@free.fr> (tiny change) +2012-06-26 Peter Münster <pmrb@free.fr> (tiny change) * gnus-group.el (gnus-group-get-new-news): New parameter `one-level' for scanning exactly one level. @@ -8451,7 +8487,7 @@ * nnimap.el (nnimap-request-group): Low higher than high to signal no messages in empty groups. -2010-10-01 Ted Zlatanov <tzz@lifelogs.com> +2010-10-01 Teodor Zlatanov <tzz@lifelogs.com> * nnimap.el (nnimap-request-group): Don't bug out when there's an empty non-UIDNEXT group. @@ -8592,7 +8628,7 @@ * nndraft.el (nndraft-request-expire-articles): Use the group name instead if "nndraft". Fix found by Nils Ackermann. -2010-09-29 Ludovic Courtes <ludo@gnu.org> +2010-09-29 Ludovic Courtès <ludo@gnu.org> * nnregistry.el: Add. diff --git a/lisp/gnus/ChangeLog.1 b/lisp/gnus/ChangeLog.1 index 9043a23361e..9a71bc35b41 100644 --- a/lisp/gnus/ChangeLog.1 +++ b/lisp/gnus/ChangeLog.1 @@ -340,7 +340,7 @@ * nnmail.el (nnmail-spool-file): Allow lists of files. -1998-08-20 Per Starback <starback@update.uu.se> +1998-08-20 Per Starbäck <starback@update.uu.se> * gnus/gnus-start.el (gnus-check-first-time-used): Change current buffer before creating help group. diff --git a/lisp/gnus/ChangeLog.2 b/lisp/gnus/ChangeLog.2 index 4ddd622ce9a..df223bd332b 100644 --- a/lisp/gnus/ChangeLog.2 +++ b/lisp/gnus/ChangeLog.2 @@ -210,7 +210,7 @@ * mml1991.el (mml1991-pgg-encrypt): Decode according to CTE before encrypting. -2003-12-28 Ivan Boldyrev <boldyrev@uiggm.nsc.ru> (tiny change). +2003-12-28 Ivan Boldyrev <boldyrev@uiggm.nsc.ru> (tiny change) * mml1991.el (mml1991-pgg-sign): Use unibyte when re-encoding. @@ -4490,7 +4490,7 @@ * gnus-start.el (gnus-backup-startup-file): Fixed custom type. -2003-02-24 Ted Zlatanov <tzz@lifelogs.com> +2003-02-24 Teodor Zlatanov <tzz@lifelogs.com> * spam.el: Disabled spam-get-article-as-filename. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index b41ff9c0550..e65b9fb99e4 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -6197,9 +6197,14 @@ Provided for backwards compatibility." (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) - flags))) + (let ((image (if flags + (shr-put-image data (propertize (or alt "*") + 'gnus-image-category 'shr) + flags) + ;; Old `shr-put-image' doesn't take the optional `flags' + ;; argument. + (shr-put-image data (propertize (or alt "*") + 'gnus-image-category 'shr))))) (when image (gnus-add-image 'shr image)))) @@ -7172,15 +7177,17 @@ groups." "\\(?:" ;; Match paired parentheses, e.g. in Wikipedia URLs: ;; http://thread.gmane.org/47B4E3B2.3050402@gmail.com - "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" "[" chars "]*" + "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" + "\\(?:" "[" chars punct "]+" "[" chars "]" "\\)?" "\\|" - "[" chars punct "]+" "[" chars "]" + "[" chars punct "]+" "[" chars "]" "\\)")) (concat ;; XEmacs 21.4 doesn't support POSIX. "\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+" "\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)")) "\\)") "Regular expression that matches URLs." + :version "24.4" :group 'gnus-article-buttons :type 'regexp) @@ -8414,6 +8421,8 @@ For example: (not (gnus-treat-predicate (car val)))) ((eq pred 'typep) (equal (car val) gnus-treat-type)) + ((functionp pred) + (funcall pred)) (t (error "%S is not a valid predicate" pred))))) ((eq val t) diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index e3f18662af4..0f78f2edc5f 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1132,7 +1132,9 @@ See the variable `gnus-user-agent'." (gnus-v (when (memq 'gnus gnus-user-agent) (concat "Gnus/" - (prin1-to-string (gnus-continuum-version gnus-version) t) + (gnus-replace-in-string + (format "%1.8f" (gnus-continuum-version gnus-version)) + "0+\\'" "") " (" gnus-version ")"))) (emacs-v (gnus-emacs-version))) (concat gnus-v (when (and gnus-v emacs-v) " ") diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 94803800e0b..05cf290cac9 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -2305,24 +2305,8 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-clean-old-newsrc)))) (defun gnus-clean-old-newsrc (&optional force) - (when gnus-newsrc-file-version - ;; Remove totally bogus `unexists' entries. The name is - ;; `unexist'. - (dolist (info (cdr gnus-newsrc-alist)) - (let ((exist (assoc 'unexists (gnus-info-marks info)))) - (when exist - (gnus-info-set-marks - info (delete exist (gnus-info-marks info)))))) - (when (or force - (not (string= gnus-newsrc-file-version gnus-version))) - (message (concat "Removing unexist marks because newsrc " - "version does not match Gnus version.")) - ;; Remove old `exist' marks from old nnimap groups. - (dolist (info (cdr gnus-newsrc-alist)) - (let ((exist (assoc 'unexist (gnus-info-marks info)))) - (when exist - (gnus-info-set-marks - info (delete exist (gnus-info-marks info))))))))) + ;; Currently no cleanups. + ) (defun gnus-convert-old-newsrc () "Convert old newsrc formats into the current format, if needed." diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 9bae9f981bd..f3918b0a215 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1525,7 +1525,7 @@ This list will always be a subset of gnus-newsgroup-undownloaded.") "Range of seen articles in the current newsgroup.") (defvar gnus-newsgroup-unexist nil - "Range of unexistent articles in the current newsgroup.") + "Range of unexisting articles in the current newsgroup.") (defvar gnus-newsgroup-articles nil "List of articles in the current newsgroup.") diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 8741a03b54d..409b1cc6255 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -3246,9 +3246,9 @@ If ARG, insert string at point." 0)) (string-to-number (if (zerop major) - (format "%s00%02d%02d" + (format "%1.2f00%02d%02d" (if (member alpha '("(ding)" "d")) - "4.99" + 4.99 (+ 5 (* 0.02 (abs (- (mm-char-int (aref (downcase alpha) 0)) diff --git a/lisp/gnus/registry.el b/lisp/gnus/registry.el index 37fe6440743..b056ac5e7f3 100644 --- a/lisp/gnus/registry.el +++ b/lisp/gnus/registry.el @@ -228,7 +228,7 @@ With assert non-nil, errors out if the key does not exist already." (let ((entry (gethash key data))) (when assert (assert entry nil - "Key %s does not exists in database" key)) + "Key %s does not exist in database" key)) ;; clean entry from the secondary indices (dolist (tr tracked) ;; is this tracked symbol indexed? diff --git a/lisp/ido.el b/lisp/ido.el index 9c4e56544cb..d3c0e0f09f7 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -161,10 +161,10 @@ ;; --------------- ;; ;; The standard way of completion with Unix-shells and Emacs is to insert a -;; PREFIX and then hitting TAB (or another completion key). Cause of this -;; behavior has become second nature to a lot of emacs users `ido' offers in +;; PREFIX and then hitting TAB (or another completion key). Cause of this +;; behavior has become second nature to a lot of Emacs users `ido' offers in ;; addition to the default substring-matching-method (look above) also the -;; prefix-matching-method. The kind of matching is the only difference to +;; prefix-matching-method. The kind of matching is the only difference to ;; the description of the substring-matching above. ;; ;; You can toggle prefix matching with C-p. @@ -271,7 +271,7 @@ ;; To use ido for all buffer and file selections in Emacs, customize the ;; variable `ido-everywhere'. -;; Using ido-like behavior in other lisp packages +;; Using ido-like behavior in other Lisp packages ;; ----------------------------------------------- ;; If you don't want to rely on the `ido-everywhere' functionality, @@ -312,7 +312,7 @@ ;; so I invented a common "ido-" namespace for the merged packages. ;; ;; This version is based on ido.el version 1.57 released on -;; gnu.emacs.sources adapted for emacs 22.1 to use command remapping +;; gnu.emacs.sources adapted for Emacs 22.1 to use command remapping ;; and optionally hooking the read-buffer and read-file-name functions. ;; ;; Prefix matching was added by Klaus Berndl <klaus.berndl@sdm.de> based on @@ -328,6 +328,7 @@ ;; These are some things you might want to change. (defun ido-fractionp (n) + "Return t if N is a fraction." (and (numberp n) (> n 0.0) (<= n 1.0))) (defgroup ido nil @@ -340,13 +341,13 @@ ;;;###autoload (defcustom ido-mode nil - "Determines for which functional group \(buffer and files) ido behavior -should be enabled. The following values are possible: -- `buffer': Turn only on ido buffer behavior \(switching, killing, + "Determines for which buffer/file Ido should be enabled. +The following values are possible: +- `buffer': Turn only on ido buffer behavior (switching, killing, displaying...) -- `file': Turn only on ido file behavior \(finding, writing, inserting...) +- `file': Turn only on ido file behavior (finding, writing, inserting...) - `both': Turn on ido buffer and file behavior. -- `nil': Turn off any ido switching. +- nil: Turn off any ido switching. Setting this variable directly does not take effect; use either \\[customize] or the function `ido-mode'." @@ -528,15 +529,20 @@ Note that the non-ido equivalent command is recorded." :group 'ido) (defcustom ido-max-prospects 12 - "Non-zero means that the prospect list will be limited to that number of items. -For a long list of prospects, building the full list for the minibuffer can take a -non-negligible amount of time; setting this variable reduces that time." + "Upper limit of the prospect list if non-zero. +Zero means no limit for the prospect list. +For a long list of prospects, building the full list for the +minibuffer can take a non-negligible amount of time; setting this +variable reduces that time." :type 'integer :group 'ido) (defcustom ido-max-file-prompt-width 0.35 - "Non-zero means that the prompt string be limited to that number of characters. -If value is a floating point number, it specifies a fraction of the frame width." + "Upper limit of the prompt string. +If value is an integer, it specifies the number of characters of +the string. +If value is a floating point number, it specifies a fraction of +the frame width." :type '(choice (integer :tag "Characters" :value 20) (restricted-sexp :tag "Fraction of frame width" @@ -612,7 +618,8 @@ A tramp file name uses the following syntax: /method:user@host:filename." (defcustom ido-cache-ftp-work-directory-time 1.0 "Maximum time to cache contents of an ftp directory (in hours). -Use C-l in prompt to refresh list. +\\<ido-file-completion-map> +Use \\[ido-reread-directory] in prompt to refresh list. If zero, ftp directories are not cached." :type 'number :group 'ido) @@ -630,7 +637,7 @@ equivalent function, e.g. `find-file' rather than `ido-find-file'." :group 'ido) (defvar ido-unc-hosts-cache t - "Cached value from `ido-unc-hosts' function.") + "Cached value from the function `ido-unc-hosts'.") (defcustom ido-unc-hosts nil "List of known UNC host names to complete after initial //. @@ -658,7 +665,8 @@ Case is ignored if `ido-downcase-unc-hosts' is set." (defcustom ido-cache-unc-host-shares-time 8.0 "Maximum time to cache shares of an UNC host (in hours). -Use C-l in prompt to refresh list. +\\<ido-file-completion-map> +Use \\[ido-reread-directory] in prompt to refresh list. If zero, UNC host shares are not cached." :type 'number :group 'ido) @@ -704,20 +712,22 @@ When a (partial) file name matches this regexp, merging is inhibited." (defcustom ido-max-dir-file-cache 100 "Maximum number of working directories to be cached. +\\<ido-file-completion-map> This is the size of the cache of `file-name-all-completions' results. Each cache entry is time stamped with the modification time of the directory. Some systems, like Windows, have unreliable directory modification times, so you may choose to disable caching on such systems, or explicitly refresh the cache contents using the command -`ido-reread-directory' command (C-l) in the minibuffer. +`ido-reread-directory' command (\\[ido-reread-directory]) in the minibuffer. See also `ido-dir-file-cache' and `ido-save-directory-list-file'." :type 'integer :group 'ido) (defcustom ido-max-directory-size nil "Maximum size (in bytes) for directories to use ido completion. +\\<ido-completion-map> If you enter a directory with a size larger than this size, ido will -not provide the normal completion. To show the completions, use C-a." +not provide the normal completion. To show the completions, use \\[ido-toggle-ignore]." :type '(choice (const :tag "No limit" nil) (integer :tag "Size in bytes" 30000)) :group 'ido) @@ -767,7 +777,8 @@ Obsolete. Set 3rd element of `ido-decorations' instead." "List of strings used by ido to display the alternatives in the minibuffer. There are between 11 and 13 elements in this list: 1st and 2nd elements are used as brackets around the prospect list, -3rd element is the separator between prospects (ignored if `ido-separator' is set), +3rd element is the separator between prospects (ignored if +`ido-separator' is set), 4th element is the string inserted at the end of a truncated list of prospects, 5th and 6th elements are used as brackets around the common match string which can be completed using TAB, @@ -782,7 +793,7 @@ remaining completion. If absent, elements 5 and 6 are used instead." :group 'ido) (defcustom ido-use-virtual-buffers nil - "Specify how vritual buffers should be used. + "Specify how virtual buffers should be used. The value can be one of the following: nil: No virtual buffers are used. @@ -4482,11 +4493,6 @@ For details of keybindings, see `ido-find-file'." (setq ido-exit 'refresh) (exit-minibuffer)) - ;; Update the list of matches - (setq ido-text contents) - (ido-set-matches) - (ido-trace "new " ido-matches) - (when (and ido-enter-matching-directory ido-matches (or (eq ido-enter-matching-directory 'first) @@ -4500,6 +4506,11 @@ For details of keybindings, see `ido-find-file'." (setq ido-exit 'refresh) (exit-minibuffer)) + ;; Update the list of matches + (setq ido-text contents) + (ido-set-matches) + (ido-trace "new " ido-matches) + (when (and (boundp 'ido-enable-virtual-buffers) (not (eq ido-enable-virtual-buffers 'always)) (eq ido-cur-item 'buffer) @@ -4760,16 +4771,20 @@ See `read-file-name' for additional parameters." (let (filename) (cond ((or (eq predicate 'file-directory-p) - (eq (get this-command 'ido) 'dir) + (eq (and (symbolp this-command) + (get this-command 'ido)) 'dir) (memq this-command ido-read-file-name-as-directory-commands)) (setq filename (ido-read-directory-name prompt dir default-filename mustmatch initial))) - ((and (not (eq (get this-command 'ido) 'ignore)) + ((and (not (eq (and (symbolp this-command) + (get this-command 'ido)) 'ignore)) (not (memq this-command ido-read-file-name-non-ido)) (or (null predicate) (eq predicate 'file-exists-p))) (let* (ido-saved-vc-hb (ido-context-switch-command - (if (eq (get this-command 'ido) 'find-file) nil 'ignore)) + (if (eq (and (symbolp this-command) + (get this-command 'ido)) 'find-file) + nil 'ignore)) (vc-handled-backends (and (boundp 'vc-handled-backends) vc-handled-backends)) (minibuffer-completing-file-name t) (ido-current-directory (ido-expand-directory dir)) diff --git a/lisp/image-dired.el b/lisp/image-dired.el index afb940fe337..f26ad5dcd0e 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -1039,16 +1039,14 @@ With prefix argument ARG, remove tag from file at point." See documentation for `image-dired-toggle-movement-tracking'. Interactive use only useful if `image-dired-track-movement' is nil." (interactive) - (let ((old-buf (current-buffer)) - (dired-buf (image-dired-associated-dired-buffer)) - (file-name (image-dired-original-file-name))) - (when (and (buffer-live-p dired-buf) file-name) - (set-buffer dired-buf) - (if (not (dired-goto-file file-name)) - (message "Could not track file") - (set-window-point - (image-dired-get-buffer-window dired-buf) (point))) - (set-buffer old-buf)))) + (let* ((dired-buf (image-dired-associated-dired-buffer)) + (file-name (image-dired-original-file-name)) + (window (image-dired-get-buffer-window dired-buf))) + (and (buffer-live-p dired-buf) file-name + (with-current-buffer dired-buf + (if (not (dired-goto-file file-name)) + (message "Could not track file") + (if window (set-window-point window (point)))))))) (defun image-dired-toggle-movement-tracking () "Turn on and off `image-dired-track-movement'. @@ -1065,24 +1063,22 @@ position in the other buffer." This is almost the same as what `image-dired-track-original-file' does, but the other way around." (let ((file (dired-get-filename)) - (old-buf (current-buffer)) - prop-val found) + prop-val found window) (when (get-buffer image-dired-thumbnail-buffer) - (set-buffer image-dired-thumbnail-buffer) - (goto-char (point-min)) - (while (and (not (eobp)) - (not found)) - (if (and (setq prop-val - (get-text-property (point) 'original-file-name)) - (string= prop-val file)) - (setq found t)) - (if (not found) - (forward-char 1))) - (when found - (set-window-point - (image-dired-thumbnail-window) (point)) - (image-dired-display-thumb-properties)) - (set-buffer old-buf)))) + (with-current-buffer image-dired-thumbnail-buffer + (goto-char (point-min)) + (while (and (not (eobp)) + (not found)) + (if (and (setq prop-val + (get-text-property (point) 'original-file-name)) + (string= prop-val file)) + (setq found t)) + (if (not found) + (forward-char 1))) + (when found + (if (setq window (image-dired-thumbnail-window)) + (set-window-point window (point))) + (image-dired-display-thumb-properties)))))) (defun image-dired-dired-next-line (&optional arg) "Call `dired-next-line', then track thumbnail. diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 3577e0e9152..11c4db5977d 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -518,7 +518,8 @@ Return -1 if charset isn't an ISO 2022 one." composition euc-tw-shift use-roman - use-oldjis) + use-oldjis + 8-bit-level-4) "List of symbols that control ISO-2022 encoder/decoder. The value of the `:flags' attribute in the argument of the function @@ -542,8 +543,9 @@ If `locking-shift' is specified, decode locking-shift code correctly on decoding, and use locking-shift to invoke a graphic element on encoding. -If `single-shift' is specified, decode single-shift code correctly on -decoding, and use single-shift to invoke a graphic element on encoding. +If `single-shift' is specified, decode single-shift code +correctly on decoding, and use single-shift to invoke a graphic +element on encoding. See also `8-bit-level-4' specification. If `designation' is specified, decode designation code correctly on decoding, and use designation to designate a charset to a graphic @@ -578,7 +580,13 @@ If `use-roman' is specified, JIS0201-1976-Roman is designated instead of ASCII. If `use-oldjis' is specified, JIS0208-1976 is designated instead of -JIS0208-1983.") +JIS0208-1983. + +If `8-bit-level-4' is specified, the decoder assumes the +implementation level \"4\" for 8-bit codes which means that GL is +identified as the single-shift area. The default implementation +level for 8-bit code is \"4A\" which means that GR is identified +as the single-shift area.") (defun define-coding-system (name docstring &rest props) "Define NAME (a symbol) as a coding system with DOCSTRING and attributes. @@ -672,7 +680,7 @@ is unsuitable for the top-level media type \"text\". VALUE must be a list of symbols that control the ISO-2022 converter. Each must be a member of the list `coding-system-iso-2022-flags' -\(which see). This attribute has a meaning only when `:coding-type' +\(which see). This attribute is meaningful only when `:coding-type' is `iso-2022'. `:designation' @@ -692,7 +700,7 @@ to GN. If the list contains 96, any charsets whose whose ranges are 96 long can be designated to GN. If the first element is a charset, that charset is initially designated to GN. -This attribute has a meaning only when `:coding-type' is `iso-2022'. +This attribute is meaningful only when `:coding-type' is `iso-2022'. `:bom' @@ -712,7 +720,7 @@ are 0xFF 0xFE, use the cdr part coding system of the value. Otherwise, treat them as bytes for a normal character. On encoding, produce BOM bytes according to the value of `:endian'. -This attribute has a meaning only when `:coding-type' is `utf-16' or +This attribute is meaningful only when `:coding-type' is `utf-16' or `utf-8'. `:endian' @@ -720,37 +728,37 @@ This attribute has a meaning only when `:coding-type' is `utf-16' or VALUE must be `big' or `little' specifying big-endian and little-endian respectively. The default value is `big'. -This attribute has a meaning only when `:coding-type' is `utf-16'. +This attribute is meaningful only when `:coding-type' is `utf-16'. `:ccl-decoder' VALUE is a symbol representing the registered CCL program used for -decoding. This attribute has a meaning only when `:coding-type' is +decoding. This attribute is meaningful only when `:coding-type' is `ccl'. `:ccl-encoder' VALUE is a symbol representing the registered CCL program used for -encoding. This attribute has a meaning only when `:coding-type' is +encoding. This attribute is meaningful only when `:coding-type' is `ccl'. -:inhibit-null-byte-detection +`:inhibit-null-byte-detection' VALUE non-nil means Emacs ignore null bytes on code detection. See the variable `inhibit-null-byte-detection'. This attribute -has a meaning only when `:coding-type' is `undecided'. +is meaningful only when `:coding-type' is `undecided'. -:inhibit-iso-escape-detection +`:inhibit-iso-escape-detection' VALUE non-nil means Emacs ignores ISO-2022 escape sequences on code detection. See the variable `inhibit-iso-escape-detection'. -This attribute has a meaning only when `:coding-type' is +This attribute is meaningful only when `:coding-type' is `undecided'. -:prefer-utf-8 +`:prefer-utf-8' VALUE non-nil means Emacs prefers UTF-8 on code detection for -non-ASCII files. This attribute has a meaning only when +non-ASCII files. This attribute is meaningful only when `:coding-type' is `undecided'." (let* ((common-attrs (mapcar 'list '(:mnemonic diff --git a/lisp/lpr.el b/lisp/lpr.el index 0b860ed07f1..5aed3bcc484 100644 --- a/lisp/lpr.el +++ b/lisp/lpr.el @@ -130,10 +130,13 @@ and print the result." (repeat :tag "Multiple arguments" (string :tag "Argument"))) :group 'lpr) -(defcustom print-region-function nil +(defcustom print-region-function + (if (memq system-type '(ms-dos windows-nt)) + #'direct-print-region-function + #'call-process-region) "Function to call to print the region on a printer. See definition of `print-region-1' for calling conventions." - :type '(choice (const nil) function) + :type 'function :group 'lpr) (defcustom lpr-page-header-program "pr" @@ -212,35 +215,24 @@ for further customization of the printer command." (print-region-1 start end lpr-switches t)) (defun print-region-1 (start end switches page-headers) + (and page-headers lpr-headers-switches + ;; It's possible to use an lpr option to get page headers. + (setq switches (append (if (stringp lpr-headers-switches) + (list lpr-headers-switches) + lpr-headers-switches) + switches))) ;; On some MIPS system, having a space in the job name ;; crashes the printer demon. But using dashes looks ugly ;; and it seems to annoying to do for that MIPS system. - (let ((name (concat (buffer-name) " Emacs buffer")) - (title (concat (buffer-name) " Emacs buffer")) - ;; Make pipes use the same coding system as - ;; writing the buffer to a file would. - (coding-system-for-write (or coding-system-for-write - buffer-file-coding-system)) - (coding-system-for-read (or coding-system-for-read - buffer-file-coding-system)) - (width tab-width) - nswitches - switch-string) - (save-excursion - (and page-headers lpr-headers-switches - ;; It's possible to use an lpr option to get page headers. - (setq switches (append (if (stringp lpr-headers-switches) - (list lpr-headers-switches) - lpr-headers-switches) - switches))) - (setq nswitches (lpr-flatten-list - (mapcar 'lpr-eval-switch ; Dynamic evaluation - switches)) - switch-string (if switches - (concat " with options " - (mapconcat 'identity switches " ")) - "")) - (message "Spooling%s..." switch-string) + (save-excursion + (let ((name (concat (buffer-name) " Emacs buffer")) + ;; Make pipes use the same coding system as + ;; writing the buffer to a file would. + (coding-system-for-write (or coding-system-for-write + buffer-file-coding-system)) + (coding-system-for-read (or coding-system-for-read + buffer-file-coding-system)) + (width tab-width)) (if (/= tab-width 8) (let ((new-coords (print-region-new-buffer start end))) (setq start (car new-coords) @@ -258,34 +250,48 @@ for further customization of the printer command." (let ((new-coords (print-region-new-buffer start end))) (apply 'call-process-region (car new-coords) (cdr new-coords) lpr-page-header-program t t nil - (mapcar (lambda (e) (format e title)) + (mapcar (lambda (e) (format e name)) lpr-page-header-switches))) (setq start (point-min) end (point-max)))) - (let ((buf (current-buffer))) - (with-temp-buffer - (let ((tempbuf (current-buffer))) - (with-current-buffer buf - (apply (or print-region-function 'call-process-region) - (nconc (list start end lpr-command - nil tempbuf nil) - (and lpr-add-switches - (list "-J" name)) - ;; These belong in pr if we are using that. - (and lpr-add-switches lpr-headers-switches - (list "-T" title)) - (and (stringp printer-name) - (list (concat lpr-printer-switch - printer-name))) - nswitches)))) - (if (markerp end) - (set-marker end nil)) - (message "Spooling%s...done%s%s" switch-string - (pcase (count-lines (point-min) (point-max)) - (0 "") - (1 ": ") - (_ ":\n")) - (buffer-string))))))) + (lpr-print-region start end switches name)))) + +(defun lpr-print-region (start end switches name) + (let ((buf (current-buffer)) + (nswitches (lpr-flatten-list + (mapcar #'lpr-eval-switch ; Dynamic evaluation + switches))) + (switch-string (if switches + (concat " with options " + (mapconcat #'identity switches " ")) + ""))) + (message "Spooling%s..." switch-string) + (with-temp-buffer + (let ((retval + (let ((tempbuf (current-buffer))) + (with-current-buffer buf + (apply (or print-region-function 'call-process-region) + start end lpr-command + nil tempbuf nil + (nconc (and name lpr-add-switches + (list "-J" name)) + ;; These belong in pr if we are using that. + (and name lpr-add-switches lpr-headers-switches + (list "-T" name)) + (and (stringp printer-name) + (string< "" printer-name) + (list (concat lpr-printer-switch + printer-name))) + nswitches)))))) + (if (markerp end) + (set-marker end nil)) + (funcall (if (memq retval '(nil 0)) #'message #'user-error) + "Spooling%s...done%s%s" switch-string + (pcase (count-lines (point-min) (point-max)) + (0 "") + (1 ": ") + (_ ":\n")) + (buffer-string)))))) ;; This function copies the text between start and end ;; into a new buffer, makes that buffer current. @@ -325,7 +331,7 @@ The characters tab, linefeed, space, return and formfeed are not affected." ;; Dynamic evaluation (defun lpr-eval-switch (arg) (cond ((stringp arg) arg) - ((functionp arg) (apply arg nil)) + ((functionp arg) (funcall arg)) ((symbolp arg) (symbol-value arg)) ((consp arg) (apply (car arg) (cdr arg))) (t nil))) @@ -342,7 +348,7 @@ The characters tab, linefeed, space, return and formfeed are not affected." (defun lpr-flatten-list-1 (list) (cond - ((null list) (list)) + ((null list) nil) ((consp list) (append (lpr-flatten-list-1 (car list)) (lpr-flatten-list-1 (cdr list)))) diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el index c5f1e3921fa..4d9b24e0043 100644 --- a/lisp/mail/mailalias.el +++ b/lisp/mail/mailalias.el @@ -209,7 +209,9 @@ removed from alias expansions." (if (re-search-forward "[ \t]*[\n,][ \t]*" end1 t) (setq epos (match-beginning 0) seplen (- (point) epos)) - (setq epos (marker-position end1) seplen 0)) + ;; Handle the last name in this header field. + ;; We already moved END1 back across whitespace after it. + (setq epos (marker-position end1) seplen 0)) (let ((string (buffer-substring-no-properties pos epos)) translation) (if (and (not (assoc string disabled-aliases)) diff --git a/lisp/mh-e/ChangeLog.1 b/lisp/mh-e/ChangeLog.1 index e57911947b1..f90d88ee0de 100644 --- a/lisp/mh-e/ChangeLog.1 +++ b/lisp/mh-e/ChangeLog.1 @@ -1403,11 +1403,11 @@ (mh-x-image-url-display): Don't display image if the URL looks malformed. -2003-10-04 Mark D Baushke <mdb@gnu.org> +2003-10-04 Mark D. Baushke <mdb@gnu.org> * mh-comp.el (mh-letter-menu): Simplify menu heading. -2003-10-03 Mark D Baushke <mdb@gnu.org> +2003-10-03 Mark D. Baushke <mdb@gnu.org> * mh-mime.el (mh-mml-query-cryptographic-method): Avoid revisionist history and still provide a good default. @@ -3877,7 +3877,7 @@ runs checkdoc and lm-verify which is useful before releasing the software. It can and should be expanded to do real unit tests. -2003-04-22 Mark D Baushke <mdb@gnu.org> +2003-04-22 Mark D. Baushke <mdb@gnu.org> * mh-alias.el: Update Copyright. * mh-comp.el: Ditto. @@ -6106,7 +6106,7 @@ explicitly stated. (mh-visit-folder): Really fix it this time. -2003-01-01 Mark D Baushke <mdb@gnu.org> +2003-01-01 Mark D. Baushke <mdb@gnu.org> * mh-alias.el (mh-alias-from-has-no-alias-p): Needs the mh-autoload comment or mh-customize may have problems finding the @@ -6854,7 +6854,7 @@ * Makefile: Moved .PHONY rule after all rule for compatibility with BSD/OS's old pmake. -2002-12-03 Mark D Baushke <mdb@gnu.org> +2002-12-03 Mark D. Baushke <mdb@gnu.org> * mh-e.el (mh-get-new-mail): Simplify no-new-mail test. (mh-add-cur-notation): Remove unnecessary function. @@ -6878,7 +6878,7 @@ number of scan lines is fewer than mh-large-folders (closes SF #646794). -2002-12-02 Mark D Baushke <mdb@gnu.org> +2002-12-02 Mark D. Baushke <mdb@gnu.org> * mh-e.el (mh-add-cur-notation): New function to mark the current message with the mh-note-cur character. @@ -8312,7 +8312,7 @@ variable as new-file-flag. This addresses part of SF #627015. -2002-10-24 Mark D Baushke <mdb@gnu.org> +2002-10-24 Mark D. Baushke <mdb@gnu.org> * mh-comp.el (mh-forward): Fix mh-mml-compose-insert-p reference in last commit to be mh-mml-compose-insert-flag. @@ -8581,7 +8581,7 @@ * mh-comp.el (mh-mml-to-mime autoload): Ditto. -2002-10-21 Mark D Baushke <mdb@gnu.org> +2002-10-21 Mark D. Baushke <mdb@gnu.org> * mh-mime.el (smiley-region): Use load for a non-fatal dependency on the smiley library. @@ -8735,7 +8735,7 @@ prompted for the number of messages to display, you got an error. This has been fixed. -2002-10-19 Mark D Baushke <mdb@gnu.org> +2002-10-19 Mark D. Baushke <mdb@gnu.org> * mh-e.el (mh-last-destination-folder): Destination of last refile command. @@ -8777,7 +8777,7 @@ macro mh-compat-write-file-hook to use write-file-functions for Emacs 21.4 and local-write-file-hooks for older versions. -2002-10-18 Mark D Baushke <mdb@gnu.org> +2002-10-18 Mark D. Baushke <mdb@gnu.org> * mh-utils.el (mh-invisible-headers): Add more anti-spam headers. @@ -9079,7 +9079,7 @@ (mh-remove-xemacs-horizontal-scrollbar): New macro to avoid compiler-warnings. -2002-10-10 Mark D Baushke <mdb@gnu.org> +2002-10-10 Mark D. Baushke <mdb@gnu.org> * Makefile (EMACS_OPTIONS): New macro for command-line compile options. @@ -9088,13 +9088,13 @@ (COMPILE_COMMAND): Combine the compile command with its options. (.el.elc): Use the new $(COMPILE_COMMAND). -2002-10-10 Mark D Baushke <mdb@gnu.org> +2002-10-10 Mark D. Baushke <mdb@gnu.org> * mh-speed.el (mh-speed-select-attached-frame): Define a new compatibility macro for getting to the attached-frame. (mh-speed-update-current-folder): Use it. -2002-10-10 Mark D Baushke <mdb@gnu.org> +2002-10-10 Mark D. Baushke <mdb@gnu.org> * mh-speed.el (mh-speed-update-current-folder): Use 'dframe-select-attached-frame if we are in a newer speedbar @@ -9452,7 +9452,7 @@ present in the load-path. * mh-mime.el (mh-require): Don't use it anymore. -2002-07-15 Mark D Baushke <mdb@gnu.org> +2002-07-15 Mark D. Baushke <mdb@gnu.org> * mh-utils.el (mh-update-scan-format): Rewrite for compatibility with XEmacs as replace-match appears not to have identical @@ -9531,7 +9531,7 @@ * mh-mime.el (mm-destroy-parts): Add definition for old emacs. -2002-06-30 Mark D Baushke <mdb@gnu.org> +2002-06-30 Mark D. Baushke <mdb@gnu.org> * mh-utils.el (mh-update-scan-format): Add documentation string. (mh-scan-msg-format-regexp): Update the regexp to find %(msg). @@ -9574,7 +9574,7 @@ * mh-index.el (mh-count-windows): This function works around the lack of the window-list builtin function in emacs20. -2002-06-29 Mark D Baushke <mdb@gnu.org> +2002-06-29 Mark D. Baushke <mdb@gnu.org> * mh-utils.el (mh-message-number-width): New function to scan the last message of a folder and return its width. @@ -9625,7 +9625,7 @@ * mh-mime.el (gnus-newsgroup-name): Initialize it to nil, so that mm-uu-dissect doesn't cause error. -2002-06-27 Mark D Baushke <mdb@gnu.org> +2002-06-27 Mark D. Baushke <mdb@gnu.org> * mh-utils.el (mh-cmd-note): Make buffer-local. Changes to this variable should be made via the new mh-set-default-cmd-note diff --git a/lisp/net/eww.el b/lisp/net/eww.el index d832aa7ef3e..d65932ae7c9 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -603,7 +603,7 @@ appears in a <link> or <a> tag." (insert " "))) (defun eww-process-text-input (beg end length) - (let* ((form (get-text-property end 'eww-form)) + (let* ((form (get-text-property (min (1+ end) (point-max)) 'eww-form)) (properties (text-properties-at end)) (type (plist-get form :type))) (when (and form diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 4506ede8722..6ddf8d2af90 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -143,6 +143,7 @@ cid: URL as the argument.") (define-key map [tab] 'shr-next-link) (define-key map [backtab] 'shr-previous-link) (define-key map [follow-link] 'mouse-face) + (define-key map [mouse-2] 'shr-mouse-browse-url) (define-key map "I" 'shr-insert-image) (define-key map "w" 'shr-copy-url) (define-key map "u" 'shr-copy-url) @@ -657,6 +658,12 @@ size, and full-buffer size." (forward-line 1) (goto-char end)))))) +(defun shr-mouse-browse-url (ev) + "Browse the URL under the mouse cursor." + (interactive "e") + (mouse-set-point ev) + (shr-browse-url)) + (defun shr-browse-url (&optional external) "Browse the URL under point. If EXTERNAL, browse the URL using `shr-external-browser'." @@ -1476,9 +1483,6 @@ ones, in case fg and bg are nil." (if column (aref widths width-column) 10)) - ;; Sanity check for degenerate tables. - (when (zerop width) - (setq width 10)) (when (and fill (setq colspan (cdr (assq :colspan (cdr column))))) (setq colspan (string-to-number colspan)) @@ -1491,6 +1495,9 @@ ones, in case fg and bg are nil." (setq width-column (+ width-column (1- colspan)))) (when (or column (not fill)) + ;; Sanity check for degenerate tables. + (when (zerop width) + (setq width 10)) (push (shr-render-td (cdr column) width fill) tds)) (setq i (1+ i) @@ -1499,6 +1506,7 @@ ones, in case fg and bg are nil." (nreverse trs))) (defun shr-render-td (cont width fill) + (when (= width 0) (debug)) (with-temp-buffer (let ((bgcolor (cdr (assq :bgcolor cont))) (fgcolor (cdr (assq :fgcolor cont))) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 14fb8575fff..82b017fa230 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -108,6 +108,8 @@ (file-writable-p . tramp-adb-handle-file-writable-p) (file-local-copy . tramp-adb-handle-file-local-copy) (file-modes . tramp-handle-file-modes) + (file-notify-add-watch . tramp-handle-file-notify-add-watch) + (file-notify-rm-watch . ignore) (expand-file-name . tramp-adb-handle-expand-file-name) (find-backup-file-name . tramp-handle-find-backup-file-name) (directory-files . tramp-handle-directory-files) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index d4115352b34..2b0ea74c492 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -184,7 +184,7 @@ 'file-expand-wildcards 'around 'tramp-advice-file-expand-wildcards) (ad-activate 'file-expand-wildcards))))) -;; `with-temp-message' does not exists in XEmacs. +;; `with-temp-message' does not exist in XEmacs. (if (fboundp 'with-temp-message) (defalias 'tramp-compat-with-temp-message 'with-temp-message) (defmacro tramp-compat-with-temp-message (message &rest body) @@ -292,7 +292,7 @@ Not actually used. Use `(format \"%o\" i)' instead?" (error "Non-octal junk in string `%s'" x)) (string-to-number ostr 8))) -;; ID-FORMAT does not exists in XEmacs. +;; ID-FORMAT does not exist in XEmacs. (defun tramp-compat-file-attributes (filename &optional id-format) "Like `file-attributes' for Tramp files (compat function)." (cond diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index c2fdc0491b6..e25c9bd4caf 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -435,6 +435,8 @@ Every entry is a list (NAME ADDRESS).") (file-name-nondirectory . tramp-handle-file-name-nondirectory) ;; `file-name-sans-versions' performed by default handler. (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) + (file-notify-add-watch . tramp-handle-file-notify-add-watch) + (file-notify-rm-watch . ignore) (file-ownership-preserved-p . ignore) (file-readable-p . tramp-gvfs-handle-file-readable-p) (file-regular-p . tramp-handle-file-regular-p) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 281f497692d..c92eacd4473 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3334,7 +3334,8 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." ;; `process-file-side-effects' in order to keep the cache when ;; `process-file' calls appear. (let (process-file-side-effects) - (tramp-run-real-handler 'vc-registered (list file))))))) + (ignore-errors + (tramp-run-real-handler 'vc-registered (list file)))))))) ;;;###tramp-autoload (defun tramp-sh-file-name-handler (operation &rest args) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 65c52ae4f3c..fee34f856dd 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -209,6 +209,8 @@ See `tramp-actions-before-shell' for more info.") (file-name-nondirectory . tramp-handle-file-name-nondirectory) ;; `file-name-sans-versions' performed by default handler. (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) + (file-notify-add-watch . tramp-handle-file-notify-add-watch) + (file-notify-rm-watch . ignore) (file-ownership-preserved-p . ignore) (file-readable-p . tramp-handle-file-exists-p) (file-regular-p . tramp-handle-file-regular-p) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 3513701d20e..db6a1e381a6 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1980,8 +1980,8 @@ ARGS are the arguments OPERATION has been called with." ;; Emacs 22+ only. 'set-file-times ;; Emacs 24+ only. - 'file-acl 'file-notify-add-watch 'file-selinux-context - 'set-file-acl 'set-file-selinux-context + 'file-acl 'file-notify-add-watch + 'file-selinux-context 'set-file-acl 'set-file-selinux-context ;; XEmacs only. 'abbreviate-file-name 'create-file-buffer 'dired-file-modtime 'dired-make-compressed-filename @@ -2036,8 +2036,9 @@ ARGS are the arguments OPERATION has been called with." default-directory) ;; PROC. ((eq operation 'file-notify-rm-watch) - (with-current-buffer (process-buffer (nth 0 args)) - default-directory)) + (when (processp (nth 0 args)) + (with-current-buffer (process-buffer (nth 0 args)) + default-directory))) ;; Unknown file primitive. (t (error "unknown file I/O primitive: %s" operation)))) @@ -3278,6 +3279,14 @@ beginning of local filename are not substituted." ;; for backward compatibility. (expand-file-name "~/")) +(defun tramp-handle-file-notify-add-watch (filename flags callback) + "Like `file-notify-add-watch' for Tramp files." + ;; This is the default handler. Some packages might have its own one. + (setq filename (expand-file-name filename)) + (with-parsed-tramp-file-name filename nil + (tramp-error + v 'file-notify-error "File notification not supported for `%s'" filename))) + ;;; Functions for establishing connection: ;; The following functions are actions to be taken when seeing certain diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog index 16097c1c0b2..019fa8a358d 100644 --- a/lisp/org/ChangeLog +++ b/lisp/org/ChangeLog @@ -3983,7 +3983,7 @@ (org-export-latex-tables-tend): New options. (org-export-latex-tables): Use the new options. -2012-09-30 tumashu <tumashu@gmail.com> (tiny change) +2012-09-30 Feng Shu <tumashu@gmail.com> (tiny change) * org-exp.el (org-export-language-setup): Add simplified chinese translation. @@ -9437,7 +9437,7 @@ (org-update-checkbox-count-maybe): Add an optional argument passed to org-update-checkbox-count. -2011-07-28 Ted Zlatanov <tzz@lifelogs.com> +2011-07-28 Teodor Zlatanov <tzz@lifelogs.com> * org.el (org-fontify-meta-lines-and-blocks): Ignore errors. @@ -18000,7 +18000,7 @@ * org-habit.el (org-habit-build-graph): Help-echo date when mouse is over stars. -2010-07-19 Jan Böker <jan.boecker@jboecker.de> +2010-07-19 Jan Böcker <jan.boecker@jboecker.de> * org.el (org-file-apps): Improve docstring to reflect grouping matches. diff --git a/lisp/org/org-freemind.el b/lisp/org/org-freemind.el index 3b1c6863f54..2ee58501ca1 100644 --- a/lisp/org/org-freemind.el +++ b/lisp/org/org-freemind.el @@ -598,7 +598,7 @@ DRAWERS-REGEXP are converted to freemind notes." (defun org-freemind-check-overwrite (file interactively) "Check if file FILE already exists. -If FILE does not exists return t. +If FILE does not exist return t. If INTERACTIVELY is non-nil ask if the file should be replaced and return t/nil if it should/should not be replaced. diff --git a/lisp/printing.el b/lisp/printing.el index 18b2b89363b..2c807b078f5 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -1030,7 +1030,7 @@ Please send all bug fixes and enhancements to (defconst pr-cygwin-system - (and ps-windows-system (getenv "OSTYPE") + (and lpr-windows-system (getenv "OSTYPE") (string-match "cygwin" (getenv "OSTYPE")))) @@ -1414,7 +1414,7 @@ Used by `pr-menu-bind' and `pr-update-menus'.") (eval-and-compile (cond - (ps-windows-system + (lpr-windows-system ;; GNU Emacs for Windows 9x/NT (defun pr-menu-position (entry index horizontal) (let ((pos (cdr (mouse-pixel-position)))) @@ -1614,7 +1614,7 @@ Used by `pr-menu-bind' and `pr-update-menus'.") "Ensure the proper directory separator depending on the OS. That is, if Emacs is running on DOS/Windows, ensure dos/windows-style directory separator; otherwise, ensure unix-style directory separator." - (if (or pr-cygwin-system ps-windows-system) + (if (or pr-cygwin-system lpr-windows-system) (subst-char-in-string ?/ ?\\ path) (subst-char-in-string ?\\ ?/ path))) @@ -1667,7 +1667,7 @@ separator; otherwise, ensure unix-style directory separator." (defcustom pr-path-style (if (and (not pr-cygwin-system) - ps-windows-system) + lpr-windows-system) 'windows 'unix) "Specify which path style to use for external commands. @@ -1778,7 +1778,7 @@ function (see it for documentation) to update text printer menu." (defcustom pr-txt-printer-alist (list (list 'default lpr-command nil (cond ((boundp 'printer-name) printer-name) - (ps-windows-system "PRN") + (lpr-windows-system "PRN") (t nil) ))) ;; Examples: @@ -1923,8 +1923,8 @@ function (see it for documentation) to update PostScript printer menu." (defcustom pr-ps-printer-alist (list (list 'default lpr-command nil - (cond (ps-windows-system nil) - (ps-lp-system "-d") + (cond (lpr-windows-system nil) + (lpr-lp-system "-d") (t "-P")) (or (getenv "PRINTER") (getenv "LPDEST") ps-printer-name))) ;; Examples: @@ -2200,7 +2200,7 @@ Useful links: ;; hacked from `temporary-file-directory' variable in files.el (file-name-as-directory (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") - (cond (ps-windows-system "c:/temp") + (cond (lpr-windows-system "c:/temp") (t "/tmp") ))))) "Specify a directory for temporary files during printing. @@ -2232,7 +2232,7 @@ See also `pr-temp-dir' and `pr-ps-temp-file'." (defcustom pr-gv-command - (if ps-windows-system + (if lpr-windows-system "gsview32.exe" "gv") "Specify path and name of the gsview/gv utility. @@ -2273,7 +2273,7 @@ Useful links: (defcustom pr-gs-command - (if ps-windows-system + (if lpr-windows-system "gswin32.exe" "gs") "Specify path and name of the ghostscript utility. @@ -2299,7 +2299,7 @@ Useful links: (defcustom pr-gs-switches - (if ps-windows-system + (if lpr-windows-system '("-q -dNOPAUSE -Ic:/gs/gs5.50;c:/gs/gs5.50/fonts") '("-q -dNOPAUSE -I/usr/share/ghostscript/5.10")) "Specify ghostscript switches. See the documentation on GS for more info. @@ -2341,7 +2341,7 @@ Useful links: (defcustom pr-gs-device - (if ps-windows-system + (if lpr-windows-system "mswinpr2" "uniprint") "Specify the ghostscript device switch value (-sDEVICE=). @@ -4852,8 +4852,8 @@ Or choose the menu option Printing/Show Settings/printing." (ps-comment-string "pr-ps-printer-switch" pr-ps-printer-switch) (ps-comment-string "pr-ps-printer " pr-ps-printer) (ps-comment-string "pr-cygwin-system " pr-cygwin-system) - (ps-comment-string "ps-windows-system " ps-windows-system) - (ps-comment-string "ps-lp-system " ps-lp-system) + (ps-comment-string "lpr-windows-system " lpr-windows-system) + (ps-comment-string "lpr-lp-system " lpr-lp-system) nil '(14 . pr-path-style) '(14 . pr-path-alist) @@ -5235,14 +5235,14 @@ If menu binding was not done, calls `pr-menu-bind'." pr-ps-printer (nth 3 ps)) (or (stringp pr-ps-command) (setq pr-ps-command - (cond (ps-windows-system "print") - (ps-lp-system "lp") + (cond (lpr-windows-system "print") + (lpr-lp-system "lp") (t "lpr") ))) (or (stringp pr-ps-printer-switch) (setq pr-ps-printer-switch - (cond (ps-windows-system "/D:") - (ps-lp-system "-d") + (cond (lpr-windows-system "/D:") + (lpr-lp-system "-d") (t "-P") ))) (pr-eval-alist (nthcdr 4 ps))) @@ -5260,8 +5260,8 @@ If menu binding was not done, calls `pr-menu-bind'." pr-txt-printer (nth 2 txt))) (or (stringp pr-txt-command) (setq pr-txt-command - (cond (ps-windows-system "print") - (ps-lp-system "lp") + (cond (lpr-windows-system "print") + (lpr-lp-system "lp") (t "lpr") ))) (pr-update-mode-line)) @@ -5667,7 +5667,7 @@ If menu binding was not done, calls `pr-menu-bind'." (defun pr-switches (switches mess) (or (listp switches) (error "%S should have a list of strings" mess)) - (ps-flatten-list ; dynamic evaluation + (lpr-flatten-list ; dynamic evaluation (mapcar 'ps-eval-switch switches))) @@ -5825,7 +5825,7 @@ If menu binding was not done, calls `pr-menu-bind'." (defun pr-find-buffer-visiting (file) (if (not (file-directory-p file)) - (find-buffer-visiting (if ps-windows-system + (find-buffer-visiting (if lpr-windows-system (downcase file) file)) (let ((truename (file-truename file)) @@ -5939,7 +5939,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (pr-dosify-file-name (or (pr-find-command command) (pr-path-command (cond (pr-cygwin-system 'cygwin) - (ps-windows-system 'windows) + (lpr-windows-system 'windows) (t 'unix)) (file-name-nondirectory command) nil) @@ -5976,7 +5976,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (defun pr-find-command (cmd) - (if ps-windows-system + (if lpr-windows-system ;; windows system (let ((ext (cons (file-name-extension cmd t) (list ".exe" ".bat" ".com"))) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 9077bdbb513..a3bd000a4f3 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -6892,7 +6892,7 @@ comment at the start of cc-engine.el for more info." (while (and (looking-at c-type-decl-prefix-key) (if (and (c-major-mode-is 'c++-mode) (match-beginning 3)) - ;; If the second submatch matches in C++ then + ;; If the third submatch matches in C++ then ;; we're looking at an identifier that's a ;; prefix only if it specifies a member pointer. (when (setq got-identifier (c-forward-name)) @@ -7193,19 +7193,23 @@ comment at the start of cc-engine.el for more info." ;; uncommon (e.g. some placements of "const" in C++) it's not worth ;; the effort to look for them.) - (unless (or at-decl-end (looking-at "=[^=]")) - ;; If this is a declaration it should end here or its initializer(*) - ;; should start here, so check for allowed separation tokens. Note - ;; that this rule doesn't work e.g. with a K&R arglist after a - ;; function header. - ;; - ;; *) Don't check for C++ style initializers using parens - ;; since those already have been matched as suffixes. - ;; - ;; If `at-decl-or-cast' is then we've found some other sign that - ;; it's a declaration or cast, so then it's probably an - ;; invalid/unfinished one. - (throw 'at-decl-or-cast at-decl-or-cast)) +;;; 2008-04-16: commented out the next form, to allow the function to recognize +;;; "foo (int bar)" in CC (an implicit type (in class foo) without a semicolon) +;;; as a(n almost complete) declaration, enabling it to be fontified. + ;; CASE 13 + ;; (unless (or at-decl-end (looking-at "=[^=]")) + ;; If this is a declaration it should end here or its initializer(*) + ;; should start here, so check for allowed separation tokens. Note + ;; that this rule doesn't work e.g. with a K&R arglist after a + ;; function header. + ;; + ;; *) Don't check for C++ style initializers using parens + ;; since those already have been matched as suffixes. + ;; + ;; If `at-decl-or-cast' is then we've found some other sign that + ;; it's a declaration or cast, so then it's probably an + ;; invalid/unfinished one. + ;; (throw 'at-decl-or-cast at-decl-or-cast)) ;; Below are tests that only should be applied when we're certain to ;; not have parsed halfway through an expression. diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 10472ec5815..4b51a5e7835 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -290,9 +290,8 @@ discard all handlers having a token number less than TOKEN-NUMBER." (lambda (handler) "Discard any HANDLER with a token number `<=' than TOKEN-NUMBER." (when (< (gdb-handler-token-number handler) token-number) - (message (format - "WARNING! Discarding GDB handler with token #%d\n" - (gdb-handler-token-number handler)))) + (message "WARNING! Discarding GDB handler with token #%d\n" + (gdb-handler-token-number handler))) (<= (gdb-handler-token-number handler) token-number)) gdb-handler-list)) @@ -1490,7 +1489,7 @@ this trigger is subscribed to `gdb-buf-publisher' and called with split-horizontal) `(defun ,name (&optional thread) ,(when doc doc) - (message thread) + (message "%s" thread) (gdb-preempt-existing-or-display-buffer (gdb-get-buffer-create ,buffer thread) ,split-horizontal))) @@ -2445,9 +2444,9 @@ current thread and update GDB buffers." (if (or (eq gdb-switch-reasons t) (member reason gdb-switch-reasons)) (when (not (string-equal gdb-thread-number thread-id)) - (message (concat "Switched to thread " thread-id)) + (message "Switched to thread %s" thread-id) (gdb-setq-thread-number thread-id)) - (message (format "Thread %s stopped" thread-id))))) + (message "Thread %s stopped" thread-id)))) ;; Print "(gdb)" to GUD console (when gdb-first-done-or-error @@ -2500,7 +2499,7 @@ current thread and update GDB buffers." ;; MI error - send to minibuffer (when (eq type 'error) ;; Skip "msg=" from `output-field' - (message (read (substring output-field 4))) + (message "%s" (read (substring output-field 4))) ;; Don't send to the console twice. (If it is a console error ;; it is also in the console stream.) (setq output-field nil))) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 915b52ce04d..62870f9085b 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -3091,7 +3091,12 @@ you are doing." ;; Stop collecting nodes after moving to a position with ;; indentation equaling min-indent. This is specially ;; useful for navigating nested definitions recursively. - tree) + (if (> num-children 0) + tree + ;; When there are no children, the collected tree is a + ;; single node intended to be added in the list of defuns + ;; of its parent. + (car tree))) (t (python-imenu--build-tree min-indent @@ -3131,7 +3136,7 @@ you are doing." (cons (prog1 (python-imenu--build-tree - prev-indent indent 1 (list (cons label pos))) + prev-indent indent 0 (list (cons label pos))) ;; Adjustment: after scanning backwards ;; for all deeper children, we need to ;; continue our scan for a parent from diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 06dffd80d88..c8fae7ba1e6 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -46,11 +46,6 @@ :prefix "ruby-" :group 'languages) -(defconst ruby-keyword-end-re - (if (string-match "\\_>" "ruby") - "\\_>" - "\\>")) - (defconst ruby-block-beg-keywords '("class" "module" "def" "if" "unless" "case" "while" "until" "for" "begin" "do") "Keywords at the beginning of blocks.") @@ -60,7 +55,7 @@ "Regexp to match the beginning of blocks.") (defconst ruby-non-block-do-re - (concat (regexp-opt '("while" "until" "for" "rescue") t) ruby-keyword-end-re) + (regexp-opt '("while" "until" "for" "rescue") 'symbols) "Regexp to match keywords that nest without blocks.") (defconst ruby-indent-beg-re @@ -696,7 +691,7 @@ Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'." ((looking-at (concat "\\_<\\(" ruby-block-beg-re "\\)\\_>")) (and (save-match-data - (or (not (looking-at (concat "do" ruby-keyword-end-re))) + (or (not (looking-at "do\\_>")) (save-excursion (back-to-indentation) (not (looking-at ruby-non-block-do-re))))) @@ -1718,14 +1713,16 @@ See the definition of `ruby-font-lock-syntactic-keywords'." "The syntax table to use for fontifying Ruby mode buffers. See `font-lock-syntax-table'.") +(defconst ruby-font-lock-keyword-beg-re "\\(?:^\\|[^.@$]\\|\\.\\.\\)") + (defconst ruby-font-lock-keywords (list ;; functions '("^\\s *def\\s +\\(?:[^( \t\n.]*\\.\\)?\\([^( \t\n]+\\)" 1 font-lock-function-name-face) + ;; keywords (list (concat - "\\(^\\|[^.@$]\\|\\.\\.\\)\\(" - ;; keywords + ruby-font-lock-keyword-beg-re (regexp-opt '("alias" "and" @@ -1760,11 +1757,14 @@ See `font-lock-syntax-table'.") "when" "while" "yield") - 'symbols) - "\\|" + 'symbols)) + 1 'font-lock-keyword-face) + ;; some core methods + (list (concat + ruby-font-lock-keyword-beg-re (regexp-opt - ;; built-in methods on Kernel - '("__callee__" + '(;; built-in methods on Kernel + "__callee__" "__dir__" "__method__" "abort" @@ -1823,20 +1823,17 @@ See `font-lock-syntax-table'.") "public" "refine" "using") - 'symbols) - "\\)") - 2 - '(if (match-beginning 4) - font-lock-builtin-face - font-lock-keyword-face)) + 'symbols)) + 1 'font-lock-builtin-face) ;; Perl-ish keywords "\\_<\\(?:BEGIN\\|END\\)\\_>\\|^__END__$" ;; here-doc beginnings `(,ruby-here-doc-beg-re 0 (unless (ruby-singleton-class-p (match-beginning 0)) 'font-lock-string-face)) ;; variables - '("\\(^\\|[^.@$]\\|\\.\\.\\)\\_<\\(nil\\|self\\|true\\|false\\)\\>" - 2 font-lock-variable-name-face) + `(,(concat ruby-font-lock-keyword-beg-re + "\\_<\\(nil\\|self\\|true\\|false\\)\\>") + 1 font-lock-variable-name-face) ;; keywords that evaluate to certain values '("\\_<__\\(?:LINE\\|ENCODING\\|FILE\\)__\\_>" 0 font-lock-variable-name-face) ;; symbols @@ -1851,6 +1848,11 @@ See `font-lock-syntax-table'.") '("\\(?:\\_<\\|::\\)\\([A-Z]+\\(\\w\\|_\\)*\\)" 1 (unless (eq ?\( (char-after)) font-lock-type-face)) '("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-constant-face) + ;; conversion methods on Kernel + (list (concat ruby-font-lock-keyword-beg-re + (regexp-opt '("Array" "Complex" "Float" "Hash" + "Integer" "Rational" "String") 'symbols)) + 1 font-lock-builtin-face) ;; expression expansion '(ruby-match-expression-expansion 2 font-lock-variable-name-face t) @@ -1859,7 +1861,7 @@ See `font-lock-syntax-table'.") 1 font-lock-negation-char-face) ;; character literals ;; FIXME: Support longer escape sequences. - '("\\?\\\\?\\S " 0 font-lock-string-face) + '("\\_<\\?\\\\?\\S " 0 font-lock-string-face) ) "Additional expressions to highlight in Ruby mode.") diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 07e9bb85c4e..29020d95226 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -2401,7 +2401,6 @@ which in this buffer is currently %s. (defun sh-read-variable (var) "Read a new value for indentation variable VAR." - (interactive "*variable? ") ;; to test (let ((minibuffer-help-form `(sh-help-string-for-variable (quote ,var))) val) diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 940afc3d5f4..56a6f155f31 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -4,7 +4,7 @@ ;; Author: Alex Schroeder <alex@gnu.org> ;; Maintainer: Michael Mauger <michael@mauger.com> -;; Version: 3.2 +;; Version: 3.3 ;; Keywords: comm languages processes ;; URL: http://savannah.gnu.org/projects/emacs/ @@ -233,6 +233,7 @@ (require 'regexp-opt)) (require 'custom) (require 'thingatpt) +(require 'view) (defvar font-lock-keyword-face) (defvar font-lock-set-defaults) @@ -246,7 +247,7 @@ :group 'languages :group 'processes) -;; These four variables will be used as defaults, if set. +;; These five variables will be used as defaults, if set. (defcustom sql-user "" "Default username." @@ -437,7 +438,7 @@ file. Since that is a plaintext file, this could be dangerous." :completion-object sql-oracle-completion-object :prompt-regexp "^SQL> " :prompt-length 5 - :prompt-cont-regexp "^\\s-*[[:digit:]]+ " + :prompt-cont-regexp "^\\(?:[ ][ ][1-9]\\|[ ][1-9][0-9]\\|[1-9][0-9]\\{2\\}\\)[ ]\\{2\\}" :statement sql-oracle-statement-starters :syntax-alist ((?$ . "_") (?# . "_")) :terminator ("\\(^/\\|;\\)$" . "/") @@ -3276,6 +3277,17 @@ Allows the suppression of continuation prompts.") (defvar sql-preoutput-hold nil) +(defun sql-starts-with-prompt-re () + "Anchor the prompt expression at the beginning of the output line. +Remove the start of line regexp." + (replace-regexp-in-string "\\^" "\\\\`" comint-prompt-regexp)) + +(defun sql-ends-with-prompt-re () + "Anchor the prompt expression at the end of the output line. +Remove the start of line regexp from the prompt expression since +it may not follow newline characters in the output line." + (concat (replace-regexp-in-string "\\^" "" sql-prompt-regexp) "\\'")) + (defun sql-interactive-remove-continuation-prompt (oline) "Strip out continuation prompts out of the OLINE. @@ -3293,38 +3305,52 @@ to the next chunk to properly match the broken-up prompt. If the filter gets confused, it should reset and stop filtering to avoid deleting non-prompt output." - (let (did-filter) - (setq oline (concat (or sql-preoutput-hold "") oline) - sql-preoutput-hold nil) - - (if (and comint-prompt-regexp - (integerp sql-output-newline-count) - (>= sql-output-newline-count 1)) - (progn - (while (and (not (string= oline "")) - (> sql-output-newline-count 0) - (string-match comint-prompt-regexp oline) - (= (match-beginning 0) 0)) + (when comint-prompt-regexp + (save-match-data + (let (prompt-found last-nl) - (setq oline (replace-match "" nil nil oline) - sql-output-newline-count (1- sql-output-newline-count) - did-filter t)) + ;; Add this text to what's left from the last pass + (setq oline (concat sql-preoutput-hold oline) + sql-preoutput-hold "") + ;; If we are looking for multiple prompts + (when (and (integerp sql-output-newline-count) + (>= sql-output-newline-count 1)) + ;; Loop thru each starting prompt and remove it + (let ((start-re (sql-starts-with-prompt-re))) + (while (and (not (string= oline "")) + (> sql-output-newline-count 0) + (string-match start-re oline)) + (setq oline (replace-match "" nil nil oline) + sql-output-newline-count (1- sql-output-newline-count) + prompt-found t))) + + ;; If we've found all the expected prompts, stop looking (if (= sql-output-newline-count 0) (setq sql-output-newline-count nil oline (concat "\n" oline)) + ;; Still more possible prompts, leave them for the next pass (setq sql-preoutput-hold oline - oline "")) - - (unless did-filter - (setq oline (or sql-preoutput-hold "") - sql-preoutput-hold nil - sql-output-newline-count nil))) - - (setq sql-output-newline-count nil)) - - oline)) + oline ""))) + + ;; If no prompts were found, stop looking + (unless prompt-found + (setq sql-output-newline-count nil + oline (concat oline sql-preoutput-hold) + sql-preoutput-hold "")) + + ;; Break up output by physical lines if we haven't hit the final prompt + (unless (and (not (string= oline "")) + (string-match (sql-ends-with-prompt-re) oline) + (>= (match-end 0) (length oline))) + (setq last-nl 0) + (while (string-match "\n" oline last-nl) + (setq last-nl (match-end 0))) + (setq sql-preoutput-hold (concat (substring oline last-nl) + sql-preoutput-hold) + oline (substring oline 0 last-nl)))))) + oline) ;;; Sending the region to the SQLi buffer. @@ -3462,7 +3488,8 @@ list of SQLi command strings." :prompt-regexp)) (start nil)) (with-current-buffer buf - (setq view-read-only nil) + (setq-local view-no-disable-on-exit t) + (read-only-mode -1) (unless save-prior (erase-buffer)) (goto-char (point-max)) @@ -3571,8 +3598,8 @@ buffer is popped into a view window." (get-lru-window)))) (with-current-buffer outbuf (set-buffer-modified-p nil) - (setq view-read-only t)) - (view-buffer-other-window outbuf) + (read-only-mode +1)) + (pop-to-buffer outbuf) (when one-win (shrink-window-if-larger-than-buffer))))) @@ -3747,7 +3774,9 @@ must tell Emacs. Here's how to do that in your init file: (setq-local abbrev-all-caps 1) ;; Contains the name of database objects (set (make-local-variable 'sql-contains-names) t) + ;; Set syntax and font-face highlighting ;; Catch changes to sql-product and highlight accordingly + (sql-set-product (or sql-product 'ansi)) ; Fixes bug#13591 (add-hook 'hack-local-variables-hook 'sql-highlight-product t t)) diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el index a75bdff27bd..8cf4feb62cb 100644 --- a/lisp/progmodes/subword.el +++ b/lisp/progmodes/subword.el @@ -93,11 +93,11 @@ (defvar subword-backward-function 'subword-backward-internal "Function to call for backward subword movement.") -(defvar subword-forward-regexp - "\\W*\\(\\([[:upper:]]*\\W?\\)[[:lower:][:digit:]]*\\)" +(defconst subword-forward-regexp + "\\W*\\(\\([[:upper:]]*\\(\\W\\)?\\)[[:lower:][:digit:]]*\\)" "Regexp used by `subword-forward-internal'.") -(defvar subword-backward-regexp +(defconst subword-backward-regexp "\\(\\(\\W\\|[[:lower:][:digit:]]\\)\\([[:upper:]]+\\W*\\)\\|\\W\\w+\\)" "Regexp used by `subword-backward-internal'.") @@ -319,7 +319,11 @@ edit them as words. (> (match-end 0) (point))) (goto-char (cond - ((< 1 (- (match-end 2) (match-beginning 2))) + ((and (< 1 (- (match-end 2) (match-beginning 2))) + ;; If we have an all-caps word with no following lower-case or + ;; non-word letter, don't leave the last char (bug#13758). + (not (and (null (match-beginning 3)) + (eq (match-end 2) (match-end 1))))) (1- (match-end 2))) (t (match-end 0)))) diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el index 059261ac0ac..7f30700bee8 100644 --- a/lisp/ps-mule.el +++ b/lisp/ps-mule.el @@ -1058,6 +1058,7 @@ It checks if all multi-byte characters in the region are printable or not." (= (skip-chars-forward "\x00-\x7F" to) to))) ;; All characters can be printed by normal PostScript fonts. (setq ps-basic-plot-string-function 'ps-basic-plot-string + ;; FIXME: Doesn't ps-encode-header-string-function take 2 args? ps-encode-header-string-function 'identity) (setq ps-basic-plot-string-function 'ps-mule-plot-string ps-encode-header-string-function 'ps-mule-encode-header-string diff --git a/lisp/ps-print.el b/lisp/ps-print.el index b5961064cb4..8369afcbbc7 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -1472,12 +1472,6 @@ Please send all bug fixes and enhancements to (error "`ps-print' only supports Emacs 23 and higher"))) -(defconst ps-windows-system - (memq system-type '(ms-dos windows-nt))) -(defconst ps-lp-system - (memq system-type '(usg-unix-v hpux irix))) - - ;; Load XEmacs/Emacs definitions (require 'ps-def) @@ -1676,8 +1670,7 @@ For more information about PostScript document comments, see: :version "20" :group 'ps-print-miscellany) -(defcustom ps-printer-name (and (boundp 'printer-name) - (symbol-value 'printer-name)) +(defcustom ps-printer-name nil "The name of a local printer for printing PostScript files. On Unix-like systems, a string value should be a name understood by lpr's -P @@ -1709,12 +1702,8 @@ See also `ps-printer-name-option' for documentation." :group 'ps-print-printer) (defcustom ps-printer-name-option - (cond (ps-windows-system - "/D:") - (ps-lp-system - "-d") - (t - "-P" )) + (cond (lpr-windows-system "/D:") + (t lpr-printer-switch)) "Option for `ps-printer-name' variable (see it). On Unix-like systems, if `lpr' is in use, this should be the string @@ -1729,8 +1718,6 @@ Set this to \"\" or nil, if the utility given by `ps-lpr-command' needs an empty printer name option--that is, pass the printer name with no special option preceding it. -Any value that is not a string is treated as nil. - This variable is used only when `ps-printer-name' is a non-empty string." :type '(choice :menu-tag "Printer Name Option" :tag "Printer Name Option" @@ -1782,11 +1769,14 @@ See `ps-lpr-command'." :version "20" :group 'ps-print-printer) -(defcustom ps-print-region-function nil +(defcustom ps-print-region-function + (if (memq system-type '(ms-dos windows-nt)) + #'direct-ps-print-region-function + #'call-process-region) "Specify a function to print the region on a PostScript printer. See definition of `call-process-region' for calling conventions. The fourth and the sixth arguments are both nil." - :type '(choice (const nil) function) + :type 'function :version "20" :group 'ps-print-printer) @@ -1798,7 +1788,7 @@ If it's nil, automatic feeding takes place." :version "20" :group 'ps-print-printer) -(defcustom ps-end-with-control-d (and ps-windows-system t) +(defcustom ps-end-with-control-d (and lpr-windows-system t) "Non-nil means insert C-d at end of PostScript file generated." :version "21.1" :type 'boolean @@ -2636,7 +2626,7 @@ NOTE: page numbers are displayed as part of headers, :group 'ps-print-headers) (defcustom ps-spool-config - (if ps-windows-system + (if lpr-windows-system nil 'lpr-switches) "Specify who is responsible for setting duplex and page size. @@ -3389,15 +3379,12 @@ It's like the very first character of buffer (or region) is ^L (\\014)." :group 'ps-print-headers) (defcustom ps-postscript-code-directory - (or (if (featurep 'xemacs) - (cond ((fboundp 'locate-data-directory) ; XEmacs - (funcall 'locate-data-directory "ps-print")) - ((boundp 'data-directory) ; XEmacs - (symbol-value 'data-directory)) - (t ; don't know what to do - nil)) - data-directory) ; Emacs - (error "`ps-postscript-code-directory' isn't set properly")) + (cond ((fboundp 'locate-data-directory) ; XEmacs + (locate-data-directory "ps-print")) + ((boundp 'data-directory) ; XEmacs and Emacs. + data-directory) + (t ; don't know what to do + (error "`ps-postscript-code-directory' isn't set properly"))) "Directory where it's located the PostScript prologue file used by ps-print. By default, this directory is the same as in the variable `data-directory'." :type 'directory @@ -3646,8 +3633,7 @@ The table depends on the current ps-print setup." ") ps-print version " ps-print-version "\n") ";; internal vars" (ps-comment-string "emacs-version " emacs-version) - (ps-comment-string "ps-windows-system " ps-windows-system) - (ps-comment-string "ps-lp-system " ps-lp-system) + (ps-comment-string "lpr-windows-system" lpr-windows-system) nil '(25 . ps-print-color-p) '(25 . ps-lpr-command) @@ -5426,8 +5412,8 @@ XSTART YSTART are the relative position for the first page in a sheet.") "%%Title: " (buffer-name) ; Take job name from name of ; first buffer printed "\n%%Creator: ps-print v" ps-print-version - "\n%%For: " (user-full-name) - "\n%%CreationDate: " (format-time-string "%T %b %d %Y") + "\n%%For: " (user-full-name) ;FIXME: may need encoding! + "\n%%CreationDate: " (format-time-string "%T %b %d %Y") ;FIXME: encoding! "\n%%Orientation: " (if ps-landscape-mode "Landscape" "Portrait") "\n%%DocumentNeededResources: font Times-Roman Times-Italic\n%%+ font " @@ -6569,96 +6555,36 @@ If FACE is not a valid face name, use default face." (write-region (point-min) (point-max) filename)) (and ps-razzle-dazzle (message "Wrote %s" filename))) ;; Else, spool to the printer - (and ps-razzle-dazzle (message "Printing...")) (with-current-buffer ps-spool-buffer (let* ((coding-system-for-write 'raw-text-unix) - (ps-printer-name (or ps-printer-name - (and (boundp 'printer-name) - (symbol-value 'printer-name)))) - (ps-lpr-switches - (append ps-lpr-switches - (and (stringp ps-printer-name) - (string< "" ps-printer-name) - (list (concat - (and (stringp ps-printer-name-option) - ps-printer-name-option) - ps-printer-name)))))) - (or (stringp ps-printer-name) - (setq ps-printer-name nil)) - (apply (or ps-print-region-function 'call-process-region) - (point-min) (point-max) ps-lpr-command nil - (and (fboundp 'start-process) 0) - nil - (ps-flatten-list ; dynamic evaluation - (ps-string-list - (mapcar 'ps-eval-switch ps-lpr-switches)))))) - (and ps-razzle-dazzle (message "Printing...done"))) + (printer-name (or ps-printer-name printer-name)) + (lpr-printer-switch ps-printer-name-option) + (print-region-function ps-print-region-function) + (lpr-command ps-lpr-command)) + (lpr-print-region (point-min) (point-max) ps-lpr-switches nil)))) (kill-buffer ps-spool-buffer))) -(defun ps-string-list (arg) - (let (lstr) - (dolist (elm arg) - (cond ((stringp elm) - (setq lstr (cons elm lstr))) - ((listp elm) - (let ((s (ps-string-list elm))) - (when s - (setq lstr (cons s lstr))))) - (t ))) ; ignore any other value - (nreverse lstr))) - -;; Dynamic evaluation -(defun ps-eval-switch (arg) - (cond ((stringp arg) arg) - ((functionp arg) (apply arg nil)) - ((symbolp arg) (symbol-value arg)) - ((consp arg) (apply (car arg) (cdr arg))) - (t nil))) - -;; `ps-flatten-list' is defined here (copied from "message.el" and -;; enhanced to handle dotted pairs as well) until we can get some -;; sensible autoloads, or `flatten-list' gets put somewhere decent. - -;; (ps-flatten-list '((a . b) c (d . e) (f g h) i . j)) -;; => (a b c d e f g h i j) - -(defun ps-flatten-list (&rest list) - (ps-flatten-list-1 list)) - -(defun ps-flatten-list-1 (list) - (cond ((null list) nil) - ((consp list) (append (ps-flatten-list-1 (car list)) - (ps-flatten-list-1 (cdr list)))) - (t (list list)))) - (defun ps-kill-emacs-check () - (let (ps-buffer) - (and (setq ps-buffer (get-buffer ps-spool-buffer-name)) - (buffer-name ps-buffer) ; check if it's not killed + (let ((ps-buffer (get-buffer ps-spool-buffer-name))) + (and (buffer-live-p ps-buffer) (buffer-modified-p ps-buffer) (y-or-n-p "Unprinted PostScript waiting; print now? ") - (ps-despool)) - (and (setq ps-buffer (get-buffer ps-spool-buffer-name)) - (buffer-name ps-buffer) ; check if it's not killed + (ps-despool))) + (let ((ps-buffer (get-buffer ps-spool-buffer-name))) + (and (buffer-live-p ps-buffer) (buffer-modified-p ps-buffer) (not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? ")) (error "Unprinted PostScript")))) -(cond ((fboundp 'add-hook) - (unless noninteractive - (funcall 'add-hook 'kill-emacs-hook 'ps-kill-emacs-check))) - (kill-emacs-hook - (message "Won't override existing `kill-emacs-hook'")) - (t - (setq kill-emacs-hook 'ps-kill-emacs-check))) +(unless noninteractive + (add-hook 'kill-emacs-hook #'ps-kill-emacs-check)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; To make this file smaller, some commands go in a separate file. ;; But autoload them here to make the separation invisible. -;;;### (autoloads (ps-mule-end-job ps-mule-begin-job ps-mule-initialize -;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "b39f881d3a029049994ef6aa3de93c89") +;;;### (autoloads nil "ps-mule" "ps-mule.el" "a90e8414a27ac8fdf093251ac648d761") ;;; Generated autoloads from ps-mule.el (defvar ps-multibyte-buffer nil "\ diff --git a/lisp/shell.el b/lisp/shell.el index 51a0ffc4fe8..a78ab7f81ab 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -284,21 +284,9 @@ Value is a list of strings, which may be nil." ;; Note: There are no explicit references to the variable `explicit-bash-args'. ;; It is used implicitly by M-x shell when the interactive shell is `bash'. (defcustom explicit-bash-args - (let* ((prog (or (and (boundp 'explicit-shell-file-name) explicit-shell-file-name) - (getenv "ESHELL") shell-file-name)) - (name (file-name-nondirectory prog))) - ;; Tell bash not to use readline, except for bash 1.x which - ;; doesn't grok --noediting. Bash 1.x has -nolineediting, but - ;; process-send-eof cannot terminate bash if we use it. - (if (and (not purify-flag) - (equal name "bash") - (file-executable-p prog) - (string-match "bad option" - (shell-command-to-string - (concat (shell-quote-argument prog) - " --noediting")))) - '("-i") - '("--noediting" "-i"))) + ;; Tell bash not to use readline. It's safe to assume --noediting now, + ;; as it was introduced in 1996 in Bash version 2. + '("--noediting" "-i") "Args passed to inferior shell by \\[shell], if the shell is bash. Value is a list of strings, which may be nil." :type '(repeat (string :tag "Argument")) diff --git a/lisp/simple.el b/lisp/simple.el index 9158452fd64..1fb2fa6014c 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -3141,14 +3141,17 @@ Also, delete any process that is exited or signaled." (display-buffer (button-get button 'process-buffer))) (defun list-processes (&optional query-only buffer) - "Display a list of all processes. + "Display a list of all processes that are Emacs sub-processes. If optional argument QUERY-ONLY is non-nil, only processes with the query-on-exit flag set are listed. Any process listed as exited or signaled is actually eliminated after the listing is made. Optional argument BUFFER specifies a buffer to use, instead of \"*Process List*\". -The return value is always nil." +The return value is always nil. + +This function lists only processes that were launched by Emacs. To +see other processes running on the system, use `list-system-processes'." (interactive) (or (fboundp 'process-list) (error "Asynchronous subprocesses are not supported on this system")) @@ -4739,10 +4742,15 @@ lines." (defun default-font-height () "Return the height in pixels of the current buffer's default face font." - (cond - ((display-multi-font-p) - (aref (font-info (face-font 'default)) 3)) - (t (frame-char-height)))) + (let ((default-font (face-font 'default))) + (cond + ((and (display-multi-font-p) + ;; Avoid calling font-info if the frame's default font was + ;; not changed since the frame was created. That's because + ;; font-info is expensive for some fonts, see bug #14838. + (not (string= (frame-parameter nil 'font) default-font))) + (aref (font-info default-font) 3)) + (t (frame-char-height))))) (defun default-line-height () "Return the pixel height of current buffer's default-face text line. @@ -4795,6 +4803,8 @@ The value is a floating-point number." (this-ypos (nth 2 this-lh)) (dlh (default-line-height)) (wslines (window-screen-lines)) + (edges (window-inside-pixel-edges)) + (winh (- (nth 3 edges) (nth 1 edges) 1)) py vs last-line) (if (> (mod wslines 1.0) 0.0) (setq wslines (round (+ wslines 0.5)))) @@ -4843,7 +4853,7 @@ The value is a floating-point number." nil) ;; If cursor is not in the bottom scroll margin, and the ;; current line is is not too tall, move forward. - ((and (or (null this-height) (<= this-height dlh)) + ((and (or (null this-height) (<= this-height winh)) vpos (> vpos 0) (< py last-line)) @@ -4860,7 +4870,7 @@ The value is a floating-point number." (> vpos 0) (= py last-line)) ;; Don't vscroll if the partially-visible line at window - ;; bottom has the default height (a.k.a. "just one more text + ;; bottom is not too tall (a.k.a. "just one more text ;; line"): in that case, we do want redisplay to behave ;; normally, i.e. recenter or whatever. ;; @@ -4869,7 +4879,7 @@ The value is a floating-point number." ;; partially-visible glyph row at the end of the window. As ;; we are dealing with floats, we disregard sub-pixel ;; discrepancies between that and DLH. - (if (and rowh rbot (>= (- (+ rowh rbot) dlh) 1)) + (if (and rowh rbot (>= (- (+ rowh rbot) winh) 1)) (set-window-vscroll nil dlh t)) (line-move-1 arg noerror to-end) t) @@ -4913,10 +4923,13 @@ The value is a floating-point number." ;; If we moved into a tall line, set vscroll to make ;; scrolling through tall images more smooth. (let ((lh (line-pixel-height)) - (dlh (default-line-height))) + (edges (window-inside-pixel-edges)) + (dlh (default-line-height)) + winh) + (setq winh (- (nth 3 edges) (nth 1 edges) 1)) (if (and (< arg 0) (< (point) (window-start)) - (> lh dlh)) + (> lh winh)) (set-window-vscroll nil (- lh dlh) t)))) @@ -5520,8 +5533,7 @@ Mode' for details." (visual-line-mode 1)) (define-globalized-minor-mode global-visual-line-mode - visual-line-mode turn-on-visual-line-mode - :lighter " vl") + visual-line-mode turn-on-visual-line-mode) (defun transpose-chars (arg) @@ -7432,19 +7444,19 @@ warning using STRING as the message.") ;;; Generic dispatcher commands -;; Macro `alternatives-define' is used to create generic commands. +;; Macro `define-alternatives' is used to create generic commands. ;; Generic commands are these (like web, mail, news, encrypt, irc, etc.) ;; that can have different alternative implementations where choosing ;; among them is exclusively a matter of user preference. -;; (alternatives-define COMMAND) creates a new interactive command +;; (define-alternatives COMMAND) creates a new interactive command ;; M-x COMMAND and a customizable variable COMMAND-alternatives. ;; Typically, the user will not need to customize this variable; packages ;; wanting to add alternative implementations should use ;; ;; ;;;###autoload (push '("My impl name" . my-impl-symbol) COMMAND-alternatives -(defmacro alternatives-define (command &rest customizations) +(defmacro define-alternatives (command &rest customizations) "Define new command `COMMAND'. The variable `COMMAND-alternatives' will contain alternative implementations of COMMAND, so that running `C-u M-x COMMAND' diff --git a/lisp/subr.el b/lisp/subr.el index a2afe0768c4..453ac7e049d 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1498,9 +1498,10 @@ other hooks, such as major mode hooks, can do the job." ;; FIXME: Something like this could be used for `set' as well. (if (or (not (eq 'quote (car-safe list-var))) (special-variable-p (cadr list-var)) - (and append compare-fn)) + (not (macroexp-const-p append))) exp (let* ((sym (cadr list-var)) + (append (eval append)) (msg (format "`add-to-list' can't use lexical var `%s'; use `push' or `cl-pushnew'" sym)) ;; Big ugly hack so we only output a warning during @@ -1513,13 +1514,17 @@ other hooks, such as major mode hooks, can do the job." (when (assq sym byte-compile--lexical-environment) (byte-compile-log-warning msg t :error)))) (code - (if append - (macroexp-let2 macroexp-copyable-p x element - `(unless (member ,x ,sym) - (setq ,sym (append ,sym (list ,x))))) - (require 'cl-lib) - `(cl-pushnew ,element ,sym - :test ,(or compare-fn '#'equal))))) + (macroexp-let2 macroexp-copyable-p x element + `(unless ,(if compare-fn + (progn + (require 'cl-lib) + `(cl-member ,x ,sym :test ,compare-fn)) + ;; For bootstrapping reasons, don't rely on + ;; cl--compiler-macro-member for the base case. + `(member ,x ,sym)) + ,(if append + `(setq ,sym (append ,sym (list ,x))) + `(push ,x ,sym)))))) (if (not (macroexp--compiling-p)) code `(progn @@ -3529,7 +3534,7 @@ likely to have undesired semantics.") ;; defaulted, OMIT-NULLS should be treated as t. Simplifying the logical ;; expression leads to the equivalent implementation that if SEPARATORS ;; is defaulted, OMIT-NULLS is treated as t. -(defun split-string (string &optional separators omit-nulls) +(defun split-string (string &optional separators omit-nulls trim) "Split STRING into substrings bounded by matches for SEPARATORS. The beginning and end of STRING, and each match for SEPARATORS, are @@ -3547,17 +3552,50 @@ that for the default value of SEPARATORS leading and trailing whitespace are effectively trimmed). If nil, all zero-length substrings are retained, which correctly parses CSV format, for example. +If TRIM is non-nil, it should be a regular expression to match +text to trim from the beginning and end of each substring. If trimming +makes the substring empty, it is treated as null. + +If you want to trim whitespace from the substrings, the reliably correct +way is using TRIM. Making SEPARATORS match that whitespace gives incorrect +results when there is whitespace at the start or end of STRING. If you +see such calls to `split-string', please fix them. + Note that the effect of `(split-string STRING)' is the same as `(split-string STRING split-string-default-separators t)'. In the rare case that you wish to retain zero-length substrings when splitting on whitespace, use `(split-string STRING split-string-default-separators)'. Modifies the match data; use `save-match-data' if necessary." - (let ((keep-nulls (not (if separators omit-nulls t))) - (rexp (or separators split-string-default-separators)) - (start 0) - notfirst - (list nil)) + (let* ((keep-nulls (not (if separators omit-nulls t))) + (rexp (or separators split-string-default-separators)) + (start 0) + this-start this-end + notfirst + (list nil) + (push-one + ;; Push the substring in range THIS-START to THIS-END + ;; onto LIST, trimming it and perhaps discarding it. + (lambda () + (when trim + ;; Discard the trim from start of this substring. + (let ((tem (string-match trim string this-start))) + (and (eq tem this-start) + (setq this-start (match-end 0))))) + + (when (or keep-nulls (< this-start this-end)) + (let ((this (substring string this-start this-end))) + + ;; Discard the trim from end of this substring. + (when trim + (let ((tem (string-match (concat trim "\\'") this 0))) + (and tem (< tem (length this)) + (setq this (substring this 0 tem))))) + + ;; Trimming could make it empty; check again. + (when (or keep-nulls (> (length this) 0)) + (push this list))))))) + (while (and (string-match rexp string (if (and notfirst (= start (match-beginning 0)) @@ -3565,15 +3603,15 @@ Modifies the match data; use `save-match-data' if necessary." (1+ start) start)) (< start (length string))) (setq notfirst t) - (if (or keep-nulls (< start (match-beginning 0))) - (setq list - (cons (substring string start (match-beginning 0)) - list))) - (setq start (match-end 0))) - (if (or keep-nulls (< start (length string))) - (setq list - (cons (substring string start) - list))) + (setq this-start start this-end (match-beginning 0) + start (match-end 0)) + + (funcall push-one)) + + ;; Handle the substring at the end of STRING. + (setq this-start start this-end (length string)) + (funcall push-one) + (nreverse list))) (defun combine-and-quote-strings (strings &optional separator) @@ -4153,22 +4191,6 @@ I is the index of the frame after FRAME2. It should return nil if those frames don't seem special and otherwise, it should return the number of frames to skip (minus 1).") -(defmacro internal--called-interactively-p--get-frame (n) - ;; `sym' will hold a global variable, which will be used kind of like C's - ;; "static" variables. - (let ((sym (make-symbol "base-index"))) - `(progn - (defvar ,sym) - (unless (boundp ',sym) - (let ((i 1)) - (while (not (eq (indirect-function (nth 1 (backtrace-frame i)) t) - (indirect-function 'called-interactively-p))) - (setq i (1+ i))) - (setq ,sym i))) - ;; (unless (eq (nth 1 (backtrace-frame ,sym)) 'called-interactively-p) - ;; (error "called-interactively-p: %s is out-of-sync!" ,sym)) - (backtrace-frame (+ ,sym ,n))))) - (defun called-interactively-p (&optional kind) "Return t if the containing function was called by `call-interactively'. If KIND is `interactive', then only return t if the call was made @@ -4203,7 +4225,7 @@ command is called from a keyboard macro?" (get-next-frame (lambda () (setq frame nextframe) - (setq nextframe (internal--called-interactively-p--get-frame i)) + (setq nextframe (backtrace-frame i 'called-interactively-p)) ;; (message "Frame %d = %S" i nextframe) (setq i (1+ i))))) (funcall get-next-frame) ;; Get the first frame. diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 43a14985ae2..254ea5db4e4 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,15 @@ +2013-07-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * url-http.el (status): Remove, unused. + (success): Remove var. + (url-http-handle-authentication): Return the value that `success' + should take instead of setting `success' directly. Don't set `status' + since it's not used. + (url-http-parse-headers): Avoid unneeded setq. + Move the `setq success'. + (url-http): Use pcase. + (url-http-file-exists-p): Simplify. + 2013-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org> * url-cookie.el: Implement a command and mode for displaying and diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 33fc5722759..7f21a38c535 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -375,9 +375,6 @@ Return the number of characters removed." (replace-match "")) (- end url-http-end-of-headers))) -(defvar status) -(defvar success) - (defun url-http-handle-authentication (proxy) (url-http-debug "Handling %s authentication" (if proxy "proxy" "normal")) (let ((auths (or (nreverse @@ -404,9 +401,9 @@ Return the number of characters removed." (url-strip-leading-spaces this-auth))) (let* ((this-type - (if (string-match "[ \t]" this-auth) - (downcase (substring this-auth 0 (match-beginning 0))) - (downcase this-auth))) + (downcase (if (string-match "[ \t]" this-auth) + (substring this-auth 0 (match-beginning 0)) + this-auth))) (registered (url-auth-registered this-type)) (this-strength (cddr registered))) (when (and registered (> this-strength strength)) @@ -421,20 +418,26 @@ Return the number of characters removed." (insert "<hr>Sorry, but I do not know how to handle " type " authentication. If you'd like to write it," " send it to " url-bug-address ".<hr>") - (setq status t)) + ;; We used to set a `status' var (declared "special") but I can't + ;; find the corresponding let-binding, so it's probably an error. + ;; FIXME: Maybe it was supposed to set `success', i.e. to return t? + ;; (setq status t) + nil) ;; Not success yet. + (let* ((args (url-parse-args (subst-char-in-string ?, ?\; auth))) (auth (url-get-authentication auth-url (cdr-safe (assoc "realm" args)) type t args))) (if (not auth) - (setq success t) + t ;Success. (push (cons (if proxy "Proxy-Authorization" "Authorization") auth) url-http-extra-headers) (let ((url-request-method url-http-method) (url-request-data url-http-data) (url-request-extra-headers url-http-extra-headers)) (url-retrieve-internal url url-callback-function - url-callback-arguments))))))) + url-callback-arguments)) + nil))))) ;; Not success yet. (defun url-http-parse-response () "Parse just the response code." @@ -498,12 +501,11 @@ should be shown to the user." (when (and connection (string= (downcase connection) "close")) (delete-process url-http-process))))) - (let ((buffer (current-buffer)) - (class nil) - (success nil) - ;; other status symbols: jewelry and luxury cars - (status-symbol (cadr (assq url-http-response-status url-http-codes)))) - (setq class (/ url-http-response-status 100)) + (let* ((buffer (current-buffer)) + (class (/ url-http-response-status 100)) + (success nil) + ;; other status symbols: jewelry and luxury cars + (status-symbol (cadr (assq url-http-response-status url-http-codes)))) (url-http-debug "Parsed HTTP headers: class=%d status=%d" class url-http-response-status) (when (url-use-cookies url-http-target-url) @@ -536,15 +538,14 @@ should be shown to the user." (pcase status-symbol ((or `no-content `reset-content) ;; No new data, just stay at the same document - (url-mark-buffer-as-dead buffer) - (setq success t)) + (url-mark-buffer-as-dead buffer)) (_ ;; Generic success for all others. Store in the cache, and ;; mark it as successful. (widen) (if (and url-automatic-caching (equal url-http-method "GET")) - (url-store-in-cache buffer)) - (setq success t)))) + (url-store-in-cache buffer)))) + (setq success t)) (3 ; Redirection ;; 300 Multiple choices ;; 301 Moved permanently @@ -684,106 +685,107 @@ should be shown to the user." ;; 422 Unprocessable Entity (Added by DAV) ;; 423 Locked ;; 424 Failed Dependency - (pcase status-symbol - (`unauthorized ; 401 - ;; The request requires user authentication. The response - ;; MUST include a WWW-Authenticate header field containing a - ;; challenge applicable to the requested resource. The - ;; client MAY repeat the request with a suitable - ;; Authorization header field. - (url-http-handle-authentication nil)) - (`payment-required ; 402 - ;; This code is reserved for future use - (url-mark-buffer-as-dead buffer) - (error "Somebody wants you to give them money")) - (`forbidden ; 403 - ;; The server understood the request, but is refusing to - ;; fulfill it. Authorization will not help and the request - ;; SHOULD NOT be repeated. - (setq success t)) - (`not-found ; 404 - ;; Not found - (setq success t)) - (`method-not-allowed ; 405 - ;; The method specified in the Request-Line is not allowed - ;; for the resource identified by the Request-URI. The - ;; response MUST include an Allow header containing a list of - ;; valid methods for the requested resource. - (setq success t)) - (`not-acceptable ; 406 - ;; The resource identified by the request is only capable of - ;; generating response entities which have content - ;; characteristics not acceptable according to the accept - ;; headers sent in the request. - (setq success t)) - (`proxy-authentication-required ; 407 - ;; This code is similar to 401 (Unauthorized), but indicates - ;; that the client must first authenticate itself with the - ;; proxy. The proxy MUST return a Proxy-Authenticate header - ;; field containing a challenge applicable to the proxy for - ;; the requested resource. - (url-http-handle-authentication t)) - (`request-timeout ; 408 - ;; The client did not produce a request within the time that - ;; the server was prepared to wait. The client MAY repeat - ;; the request without modifications at any later time. - (setq success t)) - (`conflict ; 409 - ;; The request could not be completed due to a conflict with - ;; the current state of the resource. This code is only - ;; allowed in situations where it is expected that the user - ;; might be able to resolve the conflict and resubmit the - ;; request. The response body SHOULD include enough - ;; information for the user to recognize the source of the - ;; conflict. - (setq success t)) - (`gone ; 410 - ;; The requested resource is no longer available at the - ;; server and no forwarding address is known. - (setq success t)) - (`length-required ; 411 - ;; The server refuses to accept the request without a defined - ;; Content-Length. The client MAY repeat the request if it - ;; adds a valid Content-Length header field containing the - ;; length of the message-body in the request message. - ;; - ;; NOTE - this will never happen because - ;; `url-http-create-request' automatically calculates the - ;; content-length. - (setq success t)) - (`precondition-failed ; 412 - ;; The precondition given in one or more of the - ;; request-header fields evaluated to false when it was - ;; tested on the server. - (setq success t)) - ((or `request-entity-too-large `request-uri-too-large) ; 413 414 - ;; The server is refusing to process a request because the - ;; request entity|URI is larger than the server is willing or - ;; able to process. - (setq success t)) - (`unsupported-media-type ; 415 - ;; The server is refusing to service the request because the - ;; entity of the request is in a format not supported by the - ;; requested resource for the requested method. - (setq success t)) - (`requested-range-not-satisfiable ; 416 - ;; A server SHOULD return a response with this status code if - ;; a request included a Range request-header field, and none - ;; of the range-specifier values in this field overlap the - ;; current extent of the selected resource, and the request - ;; did not include an If-Range request-header field. - (setq success t)) - (`expectation-failed ; 417 - ;; The expectation given in an Expect request-header field - ;; could not be met by this server, or, if the server is a - ;; proxy, the server has unambiguous evidence that the - ;; request could not be met by the next-hop server. - (setq success t)) - (_ - ;; The request could not be understood by the server due to - ;; malformed syntax. The client SHOULD NOT repeat the - ;; request without modifications. - (setq success t))) + (setq success + (pcase status-symbol + (`unauthorized ; 401 + ;; The request requires user authentication. The response + ;; MUST include a WWW-Authenticate header field containing a + ;; challenge applicable to the requested resource. The + ;; client MAY repeat the request with a suitable + ;; Authorization header field. + (url-http-handle-authentication nil)) + (`payment-required ; 402 + ;; This code is reserved for future use + (url-mark-buffer-as-dead buffer) + (error "Somebody wants you to give them money")) + (`forbidden ; 403 + ;; The server understood the request, but is refusing to + ;; fulfill it. Authorization will not help and the request + ;; SHOULD NOT be repeated. + t) + (`not-found ; 404 + ;; Not found + t) + (`method-not-allowed ; 405 + ;; The method specified in the Request-Line is not allowed + ;; for the resource identified by the Request-URI. The + ;; response MUST include an Allow header containing a list of + ;; valid methods for the requested resource. + t) + (`not-acceptable ; 406 + ;; The resource identified by the request is only capable of + ;; generating response entities which have content + ;; characteristics not acceptable according to the accept + ;; headers sent in the request. + t) + (`proxy-authentication-required ; 407 + ;; This code is similar to 401 (Unauthorized), but indicates + ;; that the client must first authenticate itself with the + ;; proxy. The proxy MUST return a Proxy-Authenticate header + ;; field containing a challenge applicable to the proxy for + ;; the requested resource. + (url-http-handle-authentication t)) + (`request-timeout ; 408 + ;; The client did not produce a request within the time that + ;; the server was prepared to wait. The client MAY repeat + ;; the request without modifications at any later time. + t) + (`conflict ; 409 + ;; The request could not be completed due to a conflict with + ;; the current state of the resource. This code is only + ;; allowed in situations where it is expected that the user + ;; might be able to resolve the conflict and resubmit the + ;; request. The response body SHOULD include enough + ;; information for the user to recognize the source of the + ;; conflict. + t) + (`gone ; 410 + ;; The requested resource is no longer available at the + ;; server and no forwarding address is known. + t) + (`length-required ; 411 + ;; The server refuses to accept the request without a defined + ;; Content-Length. The client MAY repeat the request if it + ;; adds a valid Content-Length header field containing the + ;; length of the message-body in the request message. + ;; + ;; NOTE - this will never happen because + ;; `url-http-create-request' automatically calculates the + ;; content-length. + t) + (`precondition-failed ; 412 + ;; The precondition given in one or more of the + ;; request-header fields evaluated to false when it was + ;; tested on the server. + t) + ((or `request-entity-too-large `request-uri-too-large) ; 413 414 + ;; The server is refusing to process a request because the + ;; request entity|URI is larger than the server is willing or + ;; able to process. + t) + (`unsupported-media-type ; 415 + ;; The server is refusing to service the request because the + ;; entity of the request is in a format not supported by the + ;; requested resource for the requested method. + t) + (`requested-range-not-satisfiable ; 416 + ;; A server SHOULD return a response with this status code if + ;; a request included a Range request-header field, and none + ;; of the range-specifier values in this field overlap the + ;; current extent of the selected resource, and the request + ;; did not include an If-Range request-header field. + t) + (`expectation-failed ; 417 + ;; The expectation given in an Expect request-header field + ;; could not be met by this server, or, if the server is a + ;; proxy, the server has unambiguous evidence that the + ;; request could not be met by the next-hop server. + t) + (_ + ;; The request could not be understood by the server due to + ;; malformed syntax. The client SHOULD NOT repeat the + ;; request without modifications. + t))) ;; Tell the callback that an error occurred, and what the ;; status code was. (when success @@ -1222,18 +1224,17 @@ previous `url-http' call, which is being re-attempted." (set-process-buffer connection buffer) (set-process-filter connection 'url-http-generic-filter) - (let ((status (process-status connection))) - (cond - ((eq status 'connect) - ;; Asynchronous connection - (set-process-sentinel connection 'url-http-async-sentinel)) - ((eq status 'failed) - ;; Asynchronous connection failed - (error "Could not create connection to %s:%d" host port)) - (t - (set-process-sentinel connection - 'url-http-end-of-document-sentinel) - (process-send-string connection (url-http-create-request))))))) + (pcase (process-status connection) + (`connect + ;; Asynchronous connection + (set-process-sentinel connection 'url-http-async-sentinel)) + (`failed + ;; Asynchronous connection failed + (error "Could not create connection to %s:%d" host port)) + (_ + (set-process-sentinel connection + 'url-http-end-of-document-sentinel) + (process-send-string connection (url-http-create-request)))))) buffer)) (defun url-http-async-sentinel (proc why) @@ -1302,17 +1303,14 @@ previous `url-http' call, which is being re-attempted." (url-retrieve-synchronously url))) (defun url-http-file-exists-p (url) - (let ((status nil) - (exists nil) - (buffer (url-http-head url))) - (if (not buffer) - (setq exists nil) - (setq status (url-http-symbol-value-in-buffer 'url-http-response-status - buffer 500) - exists (and (integerp status) - (>= status 200) (< status 300))) - (kill-buffer buffer)) - exists)) + (let ((buffer (url-http-head url))) + (when buffer + (let ((status (url-http-symbol-value-in-buffer 'url-http-response-status + buffer 500))) + (prog1 + (and (integerp status) + (>= status 200) (< status 300)) + (kill-buffer buffer)))))) (defalias 'url-http-file-readable-p 'url-http-file-exists-p) diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 80f78496a43..325e66ea530 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -240,6 +240,7 @@ See `run-hooks'." (define-key map "i" 'vc-register) ;; C-x v i (define-key map "+" 'vc-update) ;; C-x v + (define-key map "l" 'vc-print-log) ;; C-x v l + (define-key map "L" 'vc-print-root-log) ;; C-x v L ;; More confusing than helpful, probably ;;(define-key map "R" 'vc-revert) ;; u is taken by vc-dir-unmark. ;;(define-key map "A" 'vc-annotate) ;; g is taken by revert-buffer diff --git a/lisp/window.el b/lisp/window.el index a2acd2a81b0..86d93c0a9f6 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -5470,6 +5470,9 @@ argument, ACTION is t." (let ((buffer (if (bufferp buffer-or-name) buffer-or-name (get-buffer buffer-or-name))) + ;; Make sure that when we split windows the old window keeps + ;; point, bug#14829. + (split-window-keep-point t) ;; Handle the old form of the first argument. (inhibit-same-window (and action (not (listp action))))) (unless (listp action) (setq action nil)) diff --git a/lisp/winner.el b/lisp/winner.el index f521ba0521b..e7e7d0614b4 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -342,31 +342,18 @@ You may want to include buffer names such as *Help*, *Apropos*, map) "Keymap for Winner mode.") -;; Check if `window-configuration-change-hook' is working. -(defun winner-hook-installed-p () - (save-window-excursion - (let ((winner-var nil) - (window-configuration-change-hook - '((lambda () (setq winner-var t))))) - (split-window) - winner-var))) - ;;;###autoload (define-minor-mode winner-mode nil :global t ; let d-m-m make the doc (if winner-mode (progn - (if (winner-hook-installed-p) - (progn - (add-hook 'window-configuration-change-hook 'winner-change-fun) - (add-hook 'post-command-hook 'winner-save-old-configurations)) - (add-hook 'post-command-hook 'winner-save-conditionally)) + (add-hook 'window-configuration-change-hook 'winner-change-fun) + (add-hook 'post-command-hook 'winner-save-old-configurations) (add-hook 'minibuffer-setup-hook 'winner-save-unconditionally) (setq winner-modified-list (frame-list)) (winner-save-old-configurations)) (remove-hook 'window-configuration-change-hook 'winner-change-fun) (remove-hook 'post-command-hook 'winner-save-old-configurations) - (remove-hook 'post-command-hook 'winner-save-conditionally) (remove-hook 'minibuffer-setup-hook 'winner-save-unconditionally))) ;; Inspired by undo (simple.el) diff --git a/lwlib/Makefile.in b/lwlib/Makefile.in index a44f62955bf..f228221c45d 100644 --- a/lwlib/Makefile.in +++ b/lwlib/Makefile.in @@ -1,3 +1,5 @@ +### @configure_input@ + # Copyright (C) 1992, 1993 Lucid, Inc. # Copyright (C) 1994, 2001-2013 Free Software Foundation, Inc. # diff --git a/make-dist b/make-dist index 34e5c3f75e1..75e4b22b238 100755 --- a/make-dist +++ b/make-dist @@ -1,8 +1,7 @@ #!/bin/sh ### make-dist: create an Emacs distribution tar file from current srcdir -## Copyright (C) 1995, 1997-1998, 2000-2013 Free Software Foundation, -## Inc. +## Copyright (C) 1995, 1997-1998, 2000-2013 Free Software Foundation, Inc. ## This file is part of GNU Emacs. @@ -51,6 +50,7 @@ clean_up=no make_tar=no default_gzip=gzip newer="" +with_tests=no while [ $# -gt 0 ]; do case "$1" in @@ -98,6 +98,12 @@ while [ $# -gt 0 ]; do check=no ;; + ## Include the test/ directory. + ## This option is mainly for the hydra build server. + "--tests") + with_tests=yes + ;; + "--help") echo "Usage: ${progname} [options]" echo "" @@ -110,6 +116,7 @@ while [ $# -gt 0 ]; do echo " --no-update don't recompile or do analogous things" echo " --snapshot same as --clean-up --no-update --tar --no-check" echo " --tar make a tar file" + echo " --tests include the test/ directory" echo "" exit 0 ;; @@ -289,7 +296,7 @@ for subdir in site-lisp \ build-aux build-aux/snippet \ src src/bitmaps lib lib-src oldXMenu lwlib \ nt nt/inc nt/inc/sys nt/inc/arpa nt/inc/netinet nt/icons \ - `find etc lisp admin -type d` \ + `find etc lisp admin test -type d` \ doc doc/emacs doc/misc doc/man doc/lispref doc/lispintro \ info m4 msdos \ nextstep nextstep/templates \ @@ -300,6 +307,13 @@ for subdir in site-lisp \ nextstep/GNUstep/Emacs.base \ nextstep/GNUstep/Emacs.base/Resources do + + if [ "$with_tests" != "yes" ]; then + case $subdir in + test*) continue ;; + esac + fi + ## site-lisp for in-place installs (?). [ "$subdir" = "site-lisp" ] || [ -d "$subdir" ] || \ echo "WARNING: $subdir not found, making anyway" @@ -447,6 +461,17 @@ for f in `find admin -type f`; do ln $f $tempdir/$f done +if [ "$with_tests" = "yes" ]; then + echo "Making links to \`test' and its subdirectories" + for f in `find test -type f`; do + case $f in + test/automated/flymake/warnpred/a.out) continue ;; + test/automated/Makefile) continue ;; + esac + ln $f $tempdir/$f + done +fi + echo "Making links to \`etc' and its subdirectories" for f in `find etc -type f`; do case $f in diff --git a/nextstep/Makefile.in b/nextstep/Makefile.in index cd226821f18..feeafc0d694 100644 --- a/nextstep/Makefile.in +++ b/nextstep/Makefile.in @@ -1,4 +1,4 @@ -### nextstep/Makefile for GNU Emacs +### @configure_input@ ## Copyright (C) 2012-2013 Free Software Foundation, Inc. diff --git a/nt/Makefile.in b/nt/Makefile.in index 7f68a1b83ad..0b7318c9b49 100644 --- a/nt/Makefile.in +++ b/nt/Makefile.in @@ -1,4 +1,4 @@ -# nt/Makefile for GNU Emacs. +### @configure_input@ # Copyright (C) 2013 Free Software Foundation, Inc. diff --git a/oldXMenu/Makefile.in b/oldXMenu/Makefile.in index f4fda56e28d..b08e6649cbd 100644 --- a/oldXMenu/Makefile.in +++ b/oldXMenu/Makefile.in @@ -1,4 +1,4 @@ -## Makefile for oldXMenu +### @configure_input@ ## Copyright 1985, 1986, 1987 by the Massachusetts Institute of Technology diff --git a/src/ChangeLog b/src/ChangeLog index 60e7e376729..38fa72b0506 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,566 @@ +2013-07-26 Eli Zaretskii <eliz@gnu.org> + + * process.c (Fprocess_list): Doc fix. + + * w32term.c (w32_read_socket) <WM_EMACS_PAINT>: Warn about frame + being re-exposed only if it didn't ask to become visible. + <WM_SIZE>: Under SIZE_RESTORED, only set the frame visible if it + was previously iconified. (Bug#14841) + (x_iconify_frame): Mark the frame iconified. + +2013-07-26 Paul Eggert <eggert@cs.ucla.edu> + + Fix minor problems found by static checking. + * eval.c (get_backtrace_frame, backtrace_eval_unrewind): Now static. + (backtrace_eval_unrewind): ';' -> '{}' to pacify GCC. + +2013-07-26 Stefan Monnier <monnier@iro.umontreal.ca> + + * eval.c (set_specpdl_old_value): New function. + (unbind_to): Minor simplification. + (get_backtrace_frame): New function. + (Fbacktrace_frame): Use it. Add `base' argument. + (backtrace_eval_unrewind, Fbacktrace_eval): New functions. + (syms_of_eval): Export backtrace-eval. + * xterm.c (x_focus_changed): Simplify. + +2013-07-25 Paul Eggert <eggert@cs.ucla.edu> + + * fileio.c (Finsert_file_contents): Avoid double-close (Bug#14936). + +2013-07-24 Eli Zaretskii <eliz@gnu.org> + + * xdisp.c (redisplay_window): Instead of moving point out of + scroll margin, reject the force_start method, and try scrolling + instead. (Bug#14780) + +2013-07-24 Ken Brown <kbrown@cornell.edu> + + * alloc.c (make_save_ptr): Define if HAVE_NTGUI is defined + (Bug#14944). + +2013-07-24 Paul Eggert <eggert@cs.ucla.edu> + + * eval.c (Fprogn): Do not check that BODY is a proper list. + This undoes the previous change. The check slows down the + interpreter, and is not needed to prevent a crash. See + <http://lists.gnu.org/archive/html/emacs-devel/2013-07/msg00693.html>. + +2013-07-23 Glenn Morris <rgm@gnu.org> + + * Makefile.in ($(etc)/DOC, temacs$(EXEEXT)): Ensure etc/ exists. + +2013-07-23 Paul Eggert <eggert@cs.ucla.edu> + + Port to GNU/Linux systems with tinfo but not ncurses. + * dispnew.c (init_display): Depend on USE_NCURSES, not GNU_LINUX, + to decide whether ncurses is being used. Without this change, + GCC complains about tgetent not being declared, on a system + that has tinfo installed but ncurses not installed. + + * eval.c (Fprogn): Check that BODY is a proper list. + + Tune UNEVALLED functions by using XCAR instead of Fcar, etc. + * data.c (Fsetq_default): + * eval.c (Fif, Fcond, Fprog1, Fsetq, Fquote, Ffunction, Fdefvar) + (Fdefconst, FletX, Flet, Fwhile, Fcatch, Funwind_protect) + (Fcondition_case): + Tune by taking advantage of the fact that ARGS is always a list + when a function is declared to have UNEVALLED args. + + * emacsgtkfixed.c: Port to GCC 4.6. + GCC 4.6 complains about -Wunused-local-typedefs, introduced in 4.7. + +2013-07-23 Juanma Barranquero <lekktu@gmail.com> + + * callproc.c (child_setup)[!WINDOWSNT]: Move exec_errno and pid + here to silence compiler warnings. + +2013-07-22 Paul Eggert <eggert@cs.ucla.edu> + + * sysdep.c (frame) [__FreeBSD__]: #define to freebsd_frame + when including <sys/user.h>, to prevent Sparc/ARM machine/frame.h + from messing up Emacs's 'struct frame' (Bug#14923). + +2013-07-21 Paul Eggert <eggert@cs.ucla.edu> + + * alloc.c (make_save_ptr_ptr): Define this function. + It was inadvertently omitted. It's needed only if + HAVE_MENUS && ! (USE_X_TOOLKIT || USE_GTK). + +2013-07-21 Jan Djärv <jan.h.d@swipnet.se> + + * nsterm.m (sendEvent:): Skip mouse moved if no dialog and no Emacs + frame have focus (Bug#14895). + +2013-07-21 Paul Eggert <eggert@cs.ucla.edu> + + Avoid vfork-related deadlock more cleanly. + * callproc.c (child_setup): When the child's exec fails, output + the program name, as that's more useful. Use O_NONBLOCK to avoid + deadlock. + * process.c (create_process_1): Remove; no longer needed. + (create_process): Remove timer hack; no longer needed, now that + the child avoids deadlock. + +2013-07-20 Glenn Morris <rgm@gnu.org> + + * image.c (Fimage_flush): Fix doc typo. + +2013-07-20 Paul Eggert <eggert@cs.ucla.edu> + + Fix array bounds violation when pty allocation fails. + * process.c (PTY_NAME_SIZE): New constant. + (pty_name): Remove static variable; it's now auto. + (allocate_pty): Define even if !HAVE_PTYS; that's simpler. + Take pty_name as an arg rather than using a static variable. + All callers changed. + (create_process): Recover pty_flag from process, not from volatile local. + (create_pty): Stay inside array even when pty allocation fails. + (Fmake_serial_process): Omit unnecessary initializaiton of pty_flag. + + * lread.c (Fload): Avoid initialization only when lint checking. + Mention that it's needed only for older GCCs. + +2013-07-20 Kenichi Handa <handa@gnu.org> + + * coding.c (CODING_ISO_FLAG_LEVEL_4): New macro. + (decode_coding_iso_2022): Check the single-shift area. (Bug#8522) + +2013-07-20 Andreas Schwab <schwab@linux-m68k.org> + + * lread.c (Fload): Avoid uninitialized warning. + +2013-07-19 Paul Eggert <eggert@cs.ucla.edu> + + Fix some minor file descriptor leaks and related glitches. + * filelock.c (create_lock_file) [!O_CLOEXEC]: Use fcntl with FD_CLOEXEC. + (create_lock_file): Use write, not emacs_write. + * image.c (slurp_file, png_load_body): + * process.c (Fnetwork_interface_list, Fnetwork_interface_info) + (server_accept_connection): + Don't leak an fd on memory allocation failure. + * image.c (slurp_file): Add a cheap heuristic for growing files. + * xfaces.c (Fx_load_color_file): Block input around the fopen too, + as that's what the other routines do. Maybe input need not be + blocked at all, but it's better to be consistent. + Avoid undefined behavior when strlen is zero. + + * alloc.c (staticpro): Avoid buffer overrun on repeated calls. + (NSTATICS): Now a constant; doesn't need to be a macro. + +2013-07-19 Richard Stallman <rms@gnu.org> + + * coding.c (decode_coding_utf_8): Add simple loop for fast + processing of ASCII characters. + +2013-07-19 Paul Eggert <eggert@cs.ucla.edu> + + * conf_post.h (RE_TRANSLATE_P) [emacs]: Remove obsolete optimization. + +2013-07-19 Eli Zaretskii <eliz@gnu.org> + + * keyboard.c (kbd_buffer_get_event): Use Display_Info instead of + unportable 'struct x_display_info'. + (DISPLAY_LIST_INFO): Delete macro: not needed, since Display_Info + is a portable type. + +2013-07-19 Paul Eggert <eggert@cs.ucla.edu> + + * sysdep.c [GNU_LINUX]: Fix fd and memory leaks and similar issues. + (procfs_ttyname): Don't use uninitialized storage if emacs_fopen + or fscanf fails. + (system_process_attributes): Prefer plain char to unsigned char + when either will do. Clean up properly if interrupted or if + memory allocations fail. Don't assume sscanf succeeds. Remove + no-longer-needed workaround to stop GCC from whining. Read + command-line once, instead of multiple times. Check read status a + bit more carefully. + + Fix obscure porting bug with varargs functions. + The code assumed that int is treated like ptrdiff_t in a vararg + function, which is not a portable assumption. There was a similar + -- though these days less likely -- porting problem with various + assumptions that pointers of different types all smell the same as + far as vararg functions is conserved. To make this problem less + likely in the future, redo the API to use varargs functions. + * alloc.c (make_save_value): Remove this vararg function. + All uses changed to ... + (make_save_int_int_int, make_save_obj_obj_obj_obj) + (make_save_ptr_int, make_save_funcptr_ptr_obj, make_save_memory): + New functions. + (make_save_ptr): Rename from make_save_pointer, for consistency with + the above. Define only on platforms that need it. All uses changed. + +2013-07-18 Paul Eggert <eggert@cs.ucla.edu> + + * keyboard.c: Try to fix typos in previous change. + (DISPLAY_LIST_INFO): New macro. + (kbd_buffer_get_event): Do not access members that are not present + in X11. Revert inadvertent change of "!=" to "=". + +2013-07-18 Juanma Barranquero <lekktu@gmail.com> + + * keyboard.c (kbd_buffer_get_event): + * w32term.c (x_focus_changed): Port FOCUS_(IN|OUT)_EVENT changes to W32. + Followup to 2013-07-16T11:41:06Z!jan.h.d@swipnet.se. + +2013-07-18 Paul Eggert <eggert@cs.ucla.edu> + + * filelock.c: Fix unlikely file descriptor leaks. + (get_boot_time_1): Rework to avoid using emacs_open. + This doesn't actually fix a leak, but is better anyway. + (read_lock_data): Use read, not emacs_read. + + * doc.c: Fix minor memory and file descriptor leaks. + * doc.c (get_doc_string): Fix memory leak when doc file absent. + (get_doc_string, Fsnarf_documentation): + Fix file descriptor leak on error. + + * term.c: Fix minor fdopen-related file descriptor leaks. + * term.c (Fresume_tty) [!MSDOS]: Close fd if fdopen (fd) fails. + (init_tty) [!DOS_NT]: Likewise. Also close fd if isatty (fd) fails. + + * charset.c: Fix file descriptor leaks and errno issues. + Include <errno.h>. + (load_charset_map_from_file): Don't leak file descriptor on error. + Use plain record_xmalloc since the allocation is larger than + MAX_ALLOCA; that's simpler here. Simplify test for exhaustion + of entries. + * eval.c (record_unwind_protect_nothing): + * fileio.c (fclose_unwind): + New functions. + * lread.c (load_unwind): Remove. All uses replaced by fclose_unwind. + The replacement doesn't block input, but that no longer seems + necessary. + +2013-07-17 Paul Eggert <eggert@cs.ucla.edu> + + * lread.c: Fix file descriptor leaks and errno issues. + (Fload): Close some races that leaked fds or streams when 'load' + was interrupted. + (Fload, openp): Report error number of last nontrivial failure to open. + ENOENT counts as trivial. + * eval.c (do_nothing, clear_unwind_protect, set_unwind_protect_ptr): + New functions. + * fileio.c (close_file_unwind): No need to test whether FD is nonnegative, + now that the function is always called with a nonnegative arg. + * lisp.h (set_unwind_protect_ptr, set_unwind_protect_int): Remove. + All uses replaced with ... + (clear_unwind_protect, set_unwind_protect_ptr): New decls. + + A few more minor file errno-reporting bugs. + * callproc.c (Fcall_process): + * doc.c (Fsnarf_documentation): + * fileio.c (Frename_file, Fadd_name_to_file, Fmake_symbolic_link): + * process.c (set_socket_option): + Don't let a constructor trash errno. + * doc.c: Include <errno.h>. + +2013-07-16 Juanma Barranquero <lekktu@gmail.com> + + * w32fns.c (unwind_create_tip_frame): Fix declaration. + +2013-07-16 Paul Eggert <eggert@cs.ucla.edu> + + Fix w32 bug with call-process-region (Bug#14885). + * callproc.c (Fcall_process_region): Pass nil, not "/dev/null", + to Fcall_process when the input is empty. This simplifies the + code a bit. It makes no difference on POSIXish platforms but + apparently it fixes a bug on w32. + + Fix bug where insert-file-contents closes a file twice. (Bug#14839). + * fileio.c (close_file_unwind): Don't close if FD is negative; + this can happen when unwinding a zapped file descriptor. + (Finsert_file_contents): Unwind-protect the fd before the point marker, + in case Emacs runs out of memory between the two unwind-protects. + Don't trash errno when closing FD. + Zap the FD in the specpdl when closing it, instead of deferring + the removal of the unwind-protect; this fixes a bug where a child + function unwinds the stack past us. + + New unwind-protect flavors to better type-check C callbacks. + This also lessens the need to write wrappers for callbacks, + and the need for make_save_pointer. + * alloca.c (free_save_value): + * atimer.c (run_all_atimers): + Now extern. + * alloc.c (safe_alloca_unwind): + * atimer.c (unwind_stop_other_atimers): + * keyboard.c (cancel_hourglass_unwind) [HAVE_WINDOW_SYSTEM]: + * menu.c (cleanup_popup_menu) [HAVE_NS]: + * minibuf.c (choose_minibuf_frame_1): + * process.c (make_serial_process_unwind): + * xdisp.h (pop_message_unwind): + * xselect.c (queue_selection_requests_unwind): + Remove no-longer-needed wrapper. All uses replaced by the wrappee. + * alloca.c (record_xmalloc): + Prefer record_unwind_protect_ptr to record_unwind_protect with + make_save_pointer. + * alloca.c (Fgarbage_collect): + Prefer record_unwind_protect_void to passing a dummy. + * buffer.c (restore_buffer): + * window.c (restore_window_configuration): + * xfns.c, w32fns.c (do_unwind_create_frame) + New wrapper. All record-unwind uses of wrappee changed. + * buffer.c (set_buffer_if_live): + * callproc.c (call_process_cleanup, delete_temp_file): + * coding.c (code_conversion_restore): + * dired.c (directory_files_internal_w32_unwind) [WINDOWSNT]: + * editfns.c (save_excursion_restore) + (subst_char_in_region_unwind, subst_char_in_region_unwind_1) + (save_restriction_restore): + * eval.c (restore_stack_limits, un_autoload): + * fns.c (require_unwind): + * keyboard.c (recursive_edit_unwind, tracking_off): + * lread.c (record_load_unwind, load_warn_old_style_backquotes): + * macros.c (pop_kbd_macro, restore_menu_items): + * nsfns.m (unwind_create_frame): + * print.c (print_unwind): + * process.c (start_process_unwind): + * search.c (unwind_set_match_data): + * window.c (select_window_norecord, select_frame_norecord): + * xdisp.c (unwind_with_echo_area_buffer, unwind_format_mode_line) + (fast_set_selected_frame): + * xfns.c, w32fns.c (unwind_create_tip_frame): + Return void, not a dummy Lisp_Object. All uses changed. + * buffer.h (set_buffer_if_live): Move decl here from lisp.h. + * callproc.c (call_process_kill): + * fileio.c (restore_point_unwind, decide_coding_unwind) + (build_annotations_unwind): + * insdel.c (Fcombine_after_change_execute_1): + * keyboard.c (read_char_help_form_unwind): + * menu.c (unuse_menu_items): + * minibuf.c (run_exit_minibuf_hook, read_minibuf_unwind): + * sound.c (sound_cleanup): + * xdisp.c (unwind_redisplay): + * xfns.c (clean_up_dialog): + * xselect.c (x_selection_request_lisp_error, x_catch_errors_unwind): + Accept no args and return void, instead of accepting and returning + a dummy Lisp_Object. All uses changed. + * cygw32.c (fchdir_unwind): + * fileio.c (close_file_unwind): + * keyboard.c (restore_kboard_configuration): + * lread.c (readevalllop_1): + * process.c (wait_reading_process_output_unwind): + Accept int and return void, rather than accepting an Emacs integer + and returning a dummy object. In some cases this fixes an + unlikely bug when the corresponding int is outside Emacs integer + range. All uses changed. + * dired.c (directory_files_internal_unwind): + * fileio.c (do_auto_save_unwind): + * gtkutil.c (pop_down_dialog): + * insdel.c (reset_var_on_error): + * lread.c (load_unwind): + * xfns.c (clean_up_file_dialog): + * xmenu.c, nsmenu.m (pop_down_menu): + * xmenu.c (cleanup_widget_value_tree): + * xselect.c (wait_for_property_change_unwind): + Accept pointer and return void, rather than accepting an Emacs + save value encapsulating the pointer and returning a dummy object. + All uses changed. + * editfns.c (Fformat): Update the saved pointer directly via + set_unwind_protect_ptr rather than indirectly via make_save_pointer. + * eval.c (specpdl_func): Remove. All uses replaced by definiens. + (unwind_body): New function. + (record_unwind_protect): First arg is now a function returning void, + not a dummy Lisp_Object. + (record_unwind_protect_ptr, record_unwind_protect_int) + (record_unwind_protect_void): New functions. + (unbind_to): Support SPECPDL_UNWIND_PTR etc. + * fileio.c (struct auto_save_unwind): New type. + (do_auto_save_unwind): Use it. + (do_auto_save_unwind_1): Remove; subsumed by new do_auto_save_unwind. + * insdel.c (struct rvoe_arg): New type. + (reset_var_on_error): Use it. + * lisp.h (SPECPDL_UNWIND_PTR, SPECPDL_UNWIND_INT, SPECPDL_UNWIND_VOID): + New constants. + (specbinding_func): Remove; there are now several such functions. + (union specbinding): New members unwind_ptr, unwind_int, unwind_void. + (set_unwind_protect_ptr): New function. + * xselect.c: Remove unnecessary forward decls, to simplify maintenance. + + Be simpler and more consistent about reporting I/O errors. + * fileio.c (Fcopy_file, Finsert_file_contents, Fwrite_region): + Say "Read error" and "Write error", rather than "I/O error", or + "IO error reading", or "IO error writing", when a read or write + error occurs. + * process.c (Fmake_network_process, wait_reading_process_output) + (send_process, Fprocess_send_eof, wait_reading_process_output): + Capitalize diagnostics consistently. Put "failed foo" at the + start of the diagnostic, so that we don't capitalize the + function name "foo". Consistently say "failed" for such + diagnostics. + * sysdep.c, w32.c (serial_open): Now accepts Lisp string, not C string. + All callers changed. This is so it can use report_file_error. + * sysdep.c (serial_open, serial_configure): Capitalize I/O + diagnostics consistently as above. + + * fileio.c (report_file_errno): Fix errno reporting bug. + If the file name is neither null nor a pair, package it up as a + singleton list. All callers changed, both to this function and to + report_file_error. This fixes a bug where the memory allocator + invoked by list1 set errno so that the immediately following + report_file_error reported the wrong errno value. + + Fix minor problems found by --enable-gcc-warnings. + * frame.c (Fhandle_focus_in, Fhandle_focus_out): Return a value. + * keyboard.c (kbd_buffer_get_event): Remove unused local. + +2013-07-16 Jan Djärv <jan.h.d@swipnet.se> + + * xterm.c (x_focus_changed): Always generate FOCUS_IN_EVENT. + Set event->arg to Qt if switch-event shall be generated. + Generate FOCUS_OUT_EVENT for FocusOut if this is the focused frame. + + * termhooks.h (enum event_kind): Add FOCUS_OUT_EVENT. + + * nsterm.m (windowDidResignKey): If this is the focused frame, generate + FOCUS_OUT_EVENT. + + * keyboard.c (Qfocus_in, Qfocus_out): New static objects. + (make_lispy_focus_in, make_lispy_focus_out): Declare and define. + (kbd_buffer_get_event): For FOCUS_IN, make a focus_in event if no + switch frame event is made. Check ! NILP (event->arg) if X11 (moved + from xterm.c). Make focus_out event for FOCUS_OUT_EVENT if NS or X11 + and there is a focused frame. + (head_table): Add focus-in and focus-out. + (keys_of_keyboard): Add focus-in and focus-out to Vspecial_event_map, + bind to handle-focus-in/out. + + * frame.c (Fhandle_focus_in, Fhandle_focus_out): New functions. + (Fhandle_switch_frame): Call Fhandle_focus_in. + (syms_of_frame): defsubr handle-focus-in/out. + +2013-07-16 Paul Eggert <eggert@cs.ucla.edu> + + Fix porting bug to older POSIXish platforms (Bug#14862). + * sysdep.c (emacs_pipe): New function, that implements + pipe2 (fd, O_CLOEXEC) even on hosts that lack O_CLOEXEC. + This should port better to CentOS 5 and to Mac OS X 10.6. + All calls to pipe2 changed. + + Prefer list1 (X) to Fcons (X, Qnil) when building lists. + This makes the code easier to read and the executable a bit smaller. + Do not replace all calls to Fcons that happen to create lists, + just calls that are intended to create lists. For example, when + creating an alist that maps FOO to nil, use list1 (Fcons (FOO, Qnil)) + rather than list1 (list1 (FOO)) or Fcons (Fcons (FOO, Qnil), Qnil). + Similarly for list2 through list5. + * buffer.c (Fget_buffer_create, Fmake_indirect_buffer): + * bytecode.c (exec_byte_code): + * callint.c (quotify_arg, Fcall_interactively): + * callproc.c (Fcall_process, create_temp_file): + * charset.c (load_charset_map_from_file) + (Fdefine_charset_internal, init_charset): + * coding.c (get_translation_table, detect_coding_system) + (Fcheck_coding_systems_region) + (Fset_terminal_coding_system_internal) + (Fdefine_coding_system_internal, Fdefine_coding_system_alias): + * composite.c (update_compositions, Ffind_composition_internal): + * dired.c (directory_files_internal, file_name_completion) + (Fsystem_users): + * dispnew.c (Fopen_termscript, bitch_at_user, init_display): + * doc.c (Fsnarf_documentation): + * editfns.c (Fmessage_box): + * emacs.c (main): + * eval.c (do_debug_on_call, signal_error, maybe_call_debugger) + (Feval, eval_sub, Ffuncall, apply_lambda): + * fileio.c (make_temp_name, Fcopy_file, Faccess_file) + (Fset_file_selinux_context, Fset_file_acl, Fset_file_modes) + (Fset_file_times, Finsert_file_contents) + (Fchoose_write_coding_system, Fwrite_region): + * fns.c (Flax_plist_put, Fyes_or_no_p, syms_of_fns): + * font.c (font_registry_charsets, font_parse_fcname) + (font_prepare_cache, font_update_drivers, Flist_fonts): + * fontset.c (Fset_fontset_font, Ffontset_info, syms_of_fontset): + * frame.c (make_frame, Fmake_terminal_frame) + (x_set_frame_parameters, x_report_frame_params) + (x_default_parameter, Fx_parse_geometry): + * ftfont.c (syms_of_ftfont): + * image.c (gif_load): + * keyboard.c (command_loop_1): + * keymap.c (Fmake_keymap, Fmake_sparse_keymap, access_keymap_1) + (Fcopy_keymap, append_key, Fcurrent_active_maps) + (Fminor_mode_key_binding, accessible_keymaps_1) + (Faccessible_keymaps, Fwhere_is_internal): + * lread.c (read_emacs_mule_char): + * menu.c (find_and_return_menu_selection): + * minibuf.c (get_minibuffer): + * nsfns.m (Fns_perform_service): + * nsfont.m (ns_script_to_charset): + * nsmenu.m (ns_popup_dialog): + * nsselect.m (ns_get_local_selection, ns_string_from_pasteboard) + (Fx_own_selection_internal): + * nsterm.m (append2): + * print.c (Fredirect_debugging_output) + (print_prune_string_charset): + * process.c (Fdelete_process, Fprocess_contact) + (Fformat_network_address, set_socket_option) + (read_and_dispose_of_process_output, write_queue_push) + (send_process, exec_sentinel): + * sound.c (Fplay_sound_internal): + * textprop.c (validate_plist, add_properties) + (Fput_text_property, Fadd_face_text_property) + (copy_text_properties, text_property_list, syms_of_textprop): + * unexaix.c (report_error): + * unexcoff.c (report_error): + * unexsol.c (unexec): + * xdisp.c (redisplay_tool_bar, store_mode_line_string) + (Fformat_mode_line, syms_of_xdisp): + * xfaces.c (set_font_frame_param) + (Finternal_lisp_face_attribute_values) + (Finternal_merge_in_global_face, syms_of_xfaces): + * xfns.c (x_default_scroll_bar_color_parameter) + (x_default_font_parameter, x_create_tip_frame): + * xfont.c (xfont_supported_scripts): + * xmenu.c (Fx_popup_dialog, xmenu_show, xdialog_show) + (menu_help_callback, xmenu_show): + * xml.c (make_dom): + * xterm.c (set_wm_state): + Prefer list1 (FOO) to Fcons (FOO, Qnil) when creating a list, + and similarly for list2 through list5. + +2013-07-15 Paul Eggert <eggert@cs.ucla.edu> + + * callproc.c (Fcall_process_region): Fix minor race and tune. + (create_temp_file): New function, with the temp-file-creation part + of the old Fcall_process_region. Use Fcopy_sequence to create the + temp file name, rather than alloca + build_string, for simplicity. + Don't bother to block input around the temp file creation; + shouldn't be needed. Simplify use of mktemp. Use + record_unwind_protect immediately after creating the temp file; + this closes an unlikely race where the temp file was not removed. + Use memcpy rather than an open-coded loop. + (Fcall_process_region): Use the new function. If the input is + empty, redirect from /dev/null rather than from a newly created + empty temp file; this avoids unnecessary file system traffic. + +2013-07-14 Paul Eggert <eggert@cs.ucla.edu> + + * filelock.c (create_lock_file) [!HAVE_MKOSTEMP && !HAVE_MKSTEMP]: + Simplify by making this case like the other two. This is a bit + slower on obsolete hosts, but the extra complexity isn't worth it. + + * callproc.c (child_setup, relocate_fd) [!DOS_NT]: + * process.c (create_process) [!DOS_NT]: + Remove now-unnecessary calls to emacs_close. + +2013-07-13 Eli Zaretskii <eliz@gnu.org> + + * w32term.c (x_draw_hollow_cursor): Delete the brush object when + returning early. (Bug#14850) + + * coding.c (syms_of_coding): Set up inhibit-null-byte-detection + and inhibit-iso-escape-detection attributes of 'undecided'. + (Bug#14822) + 2013-07-13 Paul Eggert <eggert@cs.ucla.edu> + * deps.mk (sysdep.o): Remove dependency on ../lib/ignore-value.h. + Reported by Herbert J. Skuhra in + <http://lists.gnu.org/archive/html/emacs-devel/2013-07/msg00455.html>. + Don't lose top specpdl entry when memory is exhausted. * eval.c (grow_specpdl): Increment specpdl top by 1 and check for specpdl overflow here, to simplify callers; all callers changed. @@ -136,7 +697,7 @@ initializers. Syntax cleanup, mostly replacing macros with functions. -` This removes the need for the syntax_temp hack. + This removes the need for the syntax_temp hack. * search.c: Include syntax.h after buffer.h, since syntax.h uses BVAR. * syntax.c (SYNTAX_INLINE): New macro. (SYNTAX_FLAGS_COMSTART_FIRST, SYNTAX_FLAGS_COMSTART_SECOND) @@ -234,7 +795,7 @@ (emacswrite_sig, emacs_perror): New functions. * xrdb.c (fatal): Don't invoke perror, since errno might be garbage. -2013-07-08 Magnus Henoch <magnus.henoch@gmail.com> (tiny change). +2013-07-08 Magnus Henoch <magnus.henoch@gmail.com> (tiny change). * image.c (imagemagick_load_image): Do not use MagickExportImagePixels on NS even if it is present. Pixmap on NS is a void*. @@ -789,7 +1350,7 @@ * floatfns.c (Flog10): Move to Lisp (marked obsolete there). -2013-06-20 Rüdiger Sonderfeld <ruediger@c-plusplus.de> +2013-06-20 Rüdiger Sonderfeld <ruediger@c-plusplus.de> * floatfns.c (Flog) [HAVE_LOG2]: Use log2 if available and if the base is 2; this is more accurate. diff --git a/src/ChangeLog.12 b/src/ChangeLog.12 index 2b22690bb87..053baa3d487 100644 --- a/src/ChangeLog.12 +++ b/src/ChangeLog.12 @@ -69,7 +69,7 @@ * dispnew.c (update_window): Use MATRIX_ROW and MATRIX_MODE_LINE_ROW. -2013-03-10 handa <handa@gnu.org> +2013-03-10 Kenichi Handa <handa@gnu.org> * lisp.h (adjust_after_replace): Extern it. @@ -11043,7 +11043,7 @@ * nsterm.m (x_free_frame_resources): Move xfree so freed memory isn't referenced (Bug#11583). -2012-06-16 Aurelien Aptel <aurelien.aptel@gmail.com> +2012-06-16 Aurélien Aptel <aurelien.aptel@gmail.com> Implement wave-style variant of underlining. * dispextern.h (face_underline_type): New enum. @@ -21400,7 +21400,7 @@ * process.c (Fformat_network_address): Doc fix. -2011-04-08 T.V. Raman <tv.raman.tv@gmail.com> (tiny change) +2011-04-08 T. V. Raman <tv.raman.tv@gmail.com> (tiny change) * xml.c (parse_region): Avoid creating spurious whitespace nodes. diff --git a/src/Makefile.in b/src/Makefile.in index 2bd1fc43239..ce709a6bc44 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -1,4 +1,4 @@ -# src/Makefile for GNU Emacs. +### @configure_input@ # Copyright (C) 1985, 1987-1988, 1993-1995, 1999-2013 Free Software # Foundation, Inc. @@ -470,6 +470,7 @@ emacs$(EXEEXT): temacs$(EXEEXT) $(ADDSECTION) \ ## in the contents of the DOC file. ## $(etc)/DOC: $(libsrc)/make-docfile$(EXEEXT) $(obj) $(lisp) + $(MKDIR_P) $(etc) -rm -f $(etc)/DOC $(libsrc)/make-docfile -d $(srcdir) $(SOME_MACHINE_OBJECTS) $(obj) > $(etc)/DOC $(libsrc)/make-docfile -a $(etc)/DOC -d $(lispsource) `sed -n -e 's| \\\\||' -e 's|^[ ]*$$(lispsource)/||p' $(srcdir)/lisp.mk` @@ -498,10 +499,15 @@ $(ALLOBJS): globals.h $(lib)/libgnu.a: $(config_h) cd $(lib) && $(MAKE) libgnu.a +## We have to create $(etc) here because init_cmdargs tests its +## existence when setting Vinstallation_directory (FIXME?). +## This goes on to affect various things, and the emacs binary fails +## to start if Vinstallation_directory has the wrong value. temacs$(EXEEXT): stamp-oldxmenu $(ALLOBJS) \ $(lib)/libgnu.a $(EMACSRES) $(CC) $(ALL_CFLAGS) $(TEMACS_LDFLAGS) $(LDFLAGS) \ -o temacs $(ALLOBJS) $(lib)/libgnu.a $(W32_RES_LINK) $(LIBES) + $(MKDIR_P) $(etc) $(TEMACS_POST_LINK) test "$(CANNOT_DUMP)" = "yes" || \ test "X$(PAXCTL)" = X || $(PAXCTL) -r temacs$(EXEEXT) diff --git a/src/alloc.c b/src/alloc.c index 6ef6af1e3a1..0eb54f8b271 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -209,7 +209,6 @@ Lisp_Object Qchar_table_extra_slots; static Lisp_Object Qpost_gc_hook; -static void free_save_value (Lisp_Object); static void mark_terminals (void); static void gc_sweep (void); static Lisp_Object make_pure_vector (ptrdiff_t); @@ -334,7 +333,7 @@ static struct mem_node *mem_find (void *); /* Addresses of staticpro'd variables. Initialize it to a nonzero value; otherwise some compilers put it into BSS. */ -#define NSTATICS 0x800 +enum { NSTATICS = 2048 }; static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag}; /* Index of next unused slot in staticvec. */ @@ -805,22 +804,13 @@ xputenv (char const *string) memory_full (0); } -/* Unwind for SAFE_ALLOCA */ - -Lisp_Object -safe_alloca_unwind (Lisp_Object arg) -{ - free_save_value (arg); - return Qnil; -} - /* Return a newly allocated memory block of SIZE bytes, remembering to free it when unwinding. */ void * record_xmalloc (size_t size) { void *p = xmalloc (size); - record_unwind_protect (safe_alloca_unwind, make_save_pointer (p)); + record_unwind_protect_ptr (xfree, p); return p; } @@ -3351,67 +3341,101 @@ verify (((SAVE_INTEGER | SAVE_POINTER | SAVE_FUNCPOINTER | SAVE_OBJECT) >> SAVE_SLOT_BITS) == 0); -/* Return a Lisp_Save_Value object with the data saved according to - DATA_TYPE. DATA_TYPE should be one of SAVE_TYPE_INT_INT, etc. */ +/* Return Lisp_Save_Value objects for the various combinations + that callers need. */ Lisp_Object -make_save_value (enum Lisp_Save_Type save_type, ...) +make_save_int_int_int (ptrdiff_t a, ptrdiff_t b, ptrdiff_t c) { - va_list ap; - int i; Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); struct Lisp_Save_Value *p = XSAVE_VALUE (val); + p->save_type = SAVE_TYPE_INT_INT_INT; + p->data[0].integer = a; + p->data[1].integer = b; + p->data[2].integer = c; + return val; +} - eassert (0 < save_type - && (save_type < 1 << (SAVE_TYPE_BITS - 1) - || save_type == SAVE_TYPE_MEMORY)); - p->save_type = save_type; - va_start (ap, save_type); - save_type &= ~ (1 << (SAVE_TYPE_BITS - 1)); - - for (i = 0; save_type; i++, save_type >>= SAVE_SLOT_BITS) - switch (save_type & ((1 << SAVE_SLOT_BITS) - 1)) - { - case SAVE_POINTER: - p->data[i].pointer = va_arg (ap, void *); - break; - - case SAVE_FUNCPOINTER: - p->data[i].funcpointer = va_arg (ap, voidfuncptr); - break; +Lisp_Object +make_save_obj_obj_obj_obj (Lisp_Object a, Lisp_Object b, Lisp_Object c, + Lisp_Object d) +{ + Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); + struct Lisp_Save_Value *p = XSAVE_VALUE (val); + p->save_type = SAVE_TYPE_OBJ_OBJ_OBJ_OBJ; + p->data[0].object = a; + p->data[1].object = b; + p->data[2].object = c; + p->data[3].object = d; + return val; +} - case SAVE_INTEGER: - p->data[i].integer = va_arg (ap, ptrdiff_t); - break; +#if defined HAVE_NS || defined HAVE_NTGUI +Lisp_Object +make_save_ptr (void *a) +{ + Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); + struct Lisp_Save_Value *p = XSAVE_VALUE (val); + p->save_type = SAVE_POINTER; + p->data[0].pointer = a; + return val; +} +#endif - case SAVE_OBJECT: - p->data[i].object = va_arg (ap, Lisp_Object); - break; +Lisp_Object +make_save_ptr_int (void *a, ptrdiff_t b) +{ + Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); + struct Lisp_Save_Value *p = XSAVE_VALUE (val); + p->save_type = SAVE_TYPE_PTR_INT; + p->data[0].pointer = a; + p->data[1].integer = b; + return val; +} - default: - emacs_abort (); - } +#if defined HAVE_MENUS && ! (defined USE_X_TOOLKIT || defined USE_GTK) +Lisp_Object +make_save_ptr_ptr (void *a, void *b) +{ + Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); + struct Lisp_Save_Value *p = XSAVE_VALUE (val); + p->save_type = SAVE_TYPE_PTR_PTR; + p->data[0].pointer = a; + p->data[1].pointer = b; + return val; +} +#endif - va_end (ap); +Lisp_Object +make_save_funcptr_ptr_obj (void (*a) (void), void *b, Lisp_Object c) +{ + Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); + struct Lisp_Save_Value *p = XSAVE_VALUE (val); + p->save_type = SAVE_TYPE_FUNCPTR_PTR_OBJ; + p->data[0].funcpointer = a; + p->data[1].pointer = b; + p->data[2].object = c; return val; } -/* The most common task it to save just one C pointer. */ +/* Return a Lisp_Save_Value object that represents an array A + of N Lisp objects. */ Lisp_Object -make_save_pointer (void *pointer) +make_save_memory (Lisp_Object *a, ptrdiff_t n) { Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); struct Lisp_Save_Value *p = XSAVE_VALUE (val); - p->save_type = SAVE_POINTER; - p->data[0].pointer = pointer; + p->save_type = SAVE_TYPE_MEMORY; + p->data[0].pointer = a; + p->data[1].integer = n; return val; } /* Free a Lisp_Save_Value object. Do not use this function if SAVE contains pointer other than returned by xmalloc. */ -static void +void free_save_value (Lisp_Object save) { xfree (XSAVE_POINTER (save, 0)); @@ -4750,7 +4774,7 @@ valid_pointer_p (void *p) Unfortunately, we cannot use NULL_DEVICE here, as emacs_write may not validate p in that case. */ - if (pipe2 (fd, O_CLOEXEC) == 0) + if (emacs_pipe (fd) == 0) { bool valid = emacs_write (fd[1], (char *) p, 16) == 16; emacs_close (fd[1]); @@ -5134,9 +5158,9 @@ Does not copy symbols. Copies strings without text properties. */) void staticpro (Lisp_Object *varaddress) { - staticvec[staticidx++] = varaddress; if (staticidx >= NSTATICS) fatal ("NSTATICS too small; try increasing and recompiling Emacs."); + staticvec[staticidx++] = varaddress; } @@ -5236,7 +5260,7 @@ See Info node `(elisp)Garbage Collection'. */) /* Save what's currently displayed in the echo area. */ message_p = push_message (); - record_unwind_protect (pop_message_unwind, Qnil); + record_unwind_protect_void (pop_message_unwind); /* Save a copy of the contents of the stack, for debugging. */ #if MAX_SAVE_STACK > 0 diff --git a/src/atimer.c b/src/atimer.c index bb5294670d3..219b3502acc 100644 --- a/src/atimer.c +++ b/src/atimer.c @@ -250,7 +250,7 @@ stop_other_atimers (struct atimer *t) /* Run all timers again, if some have been stopped with a call to stop_other_atimers. */ -static void +void run_all_atimers (void) { if (stopped_atimers) @@ -274,16 +274,6 @@ run_all_atimers (void) } -/* A version of run_all_atimers suitable for a record_unwind_protect. */ - -Lisp_Object -unwind_stop_other_atimers (Lisp_Object dummy) -{ - run_all_atimers (); - return Qnil; -} - - /* Arrange for a SIGALRM to arrive when the next timer is ripe. */ static void diff --git a/src/atimer.h b/src/atimer.h index 2a92f1bebea..a1825fc0933 100644 --- a/src/atimer.h +++ b/src/atimer.h @@ -77,6 +77,6 @@ void do_pending_atimers (void); void init_atimer (void); void turn_on_atimers (bool); void stop_other_atimers (struct atimer *); -Lisp_Object unwind_stop_other_atimers (Lisp_Object); +void run_all_atimers (void); #endif /* EMACS_ATIMER_H */ diff --git a/src/buffer.c b/src/buffer.c index 19e3982a8a4..3ca1bd98b29 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -611,7 +611,7 @@ even if it is dead. The return value is never nil. */) /* Put this in the alist of all live buffers. */ XSETBUFFER (buffer, b); - Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buffer), Qnil)); + Vbuffer_alist = nconc2 (Vbuffer_alist, list1 (Fcons (name, buffer))); /* And run buffer-list-update-hook. */ if (!NILP (Vrun_hooks)) call1 (Vrun_hooks, Qbuffer_list_update_hook); @@ -822,7 +822,7 @@ CLONE nil means the indirect buffer's state is reset to default values. */) /* Put this in the alist of all live buffers. */ XSETBUFFER (buf, b); - Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil)); + Vbuffer_alist = nconc2 (Vbuffer_alist, list1 (Fcons (name, buf))); bset_mark (b, Fmake_marker ()); @@ -2207,14 +2207,19 @@ ends when the current command terminates. Use `switch-to-buffer' or return buffer; } +void +restore_buffer (Lisp_Object buffer_or_name) +{ + Fset_buffer (buffer_or_name); +} + /* Set the current buffer to BUFFER provided if it is alive. */ -Lisp_Object +void set_buffer_if_live (Lisp_Object buffer) { if (BUFFER_LIVE_P (XBUFFER (buffer))) set_buffer_internal (XBUFFER (buffer)); - return Qnil; } DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only, diff --git a/src/buffer.h b/src/buffer.h index 2b0b49dddad..6c0058ee8f3 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -1069,6 +1069,8 @@ extern Lisp_Object buffer_local_value_1 (Lisp_Object, Lisp_Object); extern void record_buffer (Lisp_Object); extern void fix_overlays_before (struct buffer *, ptrdiff_t, ptrdiff_t); extern void mmap_set_vars (bool); +extern void restore_buffer (Lisp_Object); +extern void set_buffer_if_live (Lisp_Object); /* Set the current buffer to B. diff --git a/src/bytecode.c b/src/bytecode.c index f186f7d1bc3..1be3e5c6188 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -569,9 +569,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, if (nargs < mandatory) /* Too few arguments. */ Fsignal (Qwrong_number_of_arguments, - Fcons (Fcons (make_number (mandatory), + list2 (Fcons (make_number (mandatory), rest ? Qand_rest : make_number (nonrest)), - Fcons (make_number (nargs), Qnil))); + make_number (nargs))); else { for (; i < nonrest; i++) @@ -590,9 +590,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, else /* Too many arguments. */ Fsignal (Qwrong_number_of_arguments, - Fcons (Fcons (make_number (mandatory), - make_number (nonrest)), - Fcons (make_number (nargs), Qnil))); + list2 (Fcons (make_number (mandatory), make_number (nonrest)), + make_number (nargs))); } else if (! NILP (args_template)) /* We should push some arguments on the stack. */ @@ -1061,8 +1060,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CASE (Bsave_window_excursion): /* Obsolete since 24.1. */ { - register ptrdiff_t count1 = SPECPDL_INDEX (); - record_unwind_protect (Fset_window_configuration, + ptrdiff_t count1 = SPECPDL_INDEX (); + record_unwind_protect (restore_window_configuration, Fcurrent_window_configuration (Qnil)); BEFORE_POTENTIAL_GC (); TOP = Fprogn (TOP); @@ -1087,7 +1086,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, } CASE (Bunwind_protect): /* FIXME: avoid closure for lexbind. */ - record_unwind_protect (Fprogn, POP); + record_unwind_protect (unwind_body, POP); NEXT; CASE (Bcondition_case): /* FIXME: ill-suited for lexbind. */ @@ -1169,14 +1168,14 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, } CASE (Blist1): - TOP = Fcons (TOP, Qnil); + TOP = list1 (TOP); NEXT; CASE (Blist2): { Lisp_Object v1; v1 = POP; - TOP = Fcons (TOP, Fcons (v1, Qnil)); + TOP = list2 (TOP, v1); NEXT; } diff --git a/src/callint.c b/src/callint.c index 0651b68dc05..38431226508 100644 --- a/src/callint.c +++ b/src/callint.c @@ -127,7 +127,7 @@ quotify_arg (register Lisp_Object exp) if (CONSP (exp) || (SYMBOLP (exp) && !NILP (exp) && !EQ (exp, Qt))) - return Fcons (Qquote, Fcons (exp, Qnil)); + return list2 (Qquote, exp); return exp; } @@ -802,7 +802,7 @@ invoke it. If KEYS is omitted or nil, the return value of for (i = 1; i < nargs; i++) { if (varies[i] > 0) - visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil); + visargs[i] = list1 (intern (callint_argfuns[varies[i]])); else visargs[i] = quotify_arg (args[i]); } diff --git a/src/callproc.c b/src/callproc.c index 30f9dc58d46..91f29bd589b 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -123,8 +123,8 @@ record_kill_process (struct Lisp_Process *p) /* Clean up when exiting call_process_cleanup. */ -static Lisp_Object -call_process_kill (Lisp_Object ignored) +static void +call_process_kill (void) { if (synch_process_fd >= 0) emacs_close (synch_process_fd); @@ -136,15 +136,13 @@ call_process_kill (Lisp_Object ignored) proc.pid = synch_process_pid; record_kill_process (&proc); } - - return Qnil; } /* Clean up when exiting Fcall_process. On MSDOS, delete the temporary file on any kind of termination. On Unix, kill the process and any children on termination by signal. */ -static Lisp_Object +static void call_process_cleanup (Lisp_Object arg) { #ifdef MSDOS @@ -162,7 +160,7 @@ call_process_cleanup (Lisp_Object arg) { ptrdiff_t count = SPECPDL_INDEX (); kill (-synch_process_pid, SIGINT); - record_unwind_protect (call_process_kill, make_number (0)); + record_unwind_protect_void (call_process_kill); message1 ("Waiting for process to die...(type C-g again to kill it instantly)"); immediate_quit = 1; QUIT; @@ -183,8 +181,6 @@ call_process_cleanup (Lisp_Object arg) if (!(strcmp (SDATA (file), NULL_DEVICE) == 0 || SREF (file, 0) == '\0')) unlink (SDATA (file)); #endif - - return Qnil; } #ifdef DOS_NT @@ -392,7 +388,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * if (NILP (Ffile_accessible_directory_p (current_dir))) report_file_error ("Setting current directory", - Fcons (BVAR (current_buffer, directory), Qnil)); + BVAR (current_buffer, directory)); if (STRING_MULTIBYTE (infile)) infile = ENCODE_FILE (infile); @@ -409,8 +405,11 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * filefd = emacs_open (SSDATA (infile), O_RDONLY, 0); if (filefd < 0) - report_file_error ("Opening process input file", - Fcons (DECODE_FILE (infile), Qnil)); + { + int open_errno = errno; + report_file_errno ("Opening process input file", DECODE_FILE (infile), + open_errno); + } if (STRINGP (output_file)) { @@ -422,7 +421,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * int open_errno = errno; output_file = DECODE_FILE (output_file); report_file_errno ("Opening process output file", - Fcons (output_file, Qnil), open_errno); + output_file, open_errno); } if (STRINGP (error_file) || NILP (error_file)) output_to_buffer = 0; @@ -440,8 +439,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * { int openp_errno = errno; emacs_close (filefd); - report_file_errno ("Searching for program", - Fcons (args[0], Qnil), openp_errno); + report_file_errno ("Searching for program", args[0], openp_errno); } } @@ -506,7 +504,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * int open_errno = errno; emacs_close (filefd); report_file_errno ("Opening process output file", - Fcons (build_string (tempfile), Qnil), open_errno); + build_string (tempfile), open_errno); } } else @@ -524,7 +522,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * { #ifndef MSDOS int fd[2]; - if (pipe2 (fd, O_CLOEXEC) != 0) + if (emacs_pipe (fd) != 0) { int pipe_errno = errno; emacs_close (filefd); @@ -563,8 +561,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * error_file = build_string (NULL_DEVICE); else if (STRINGP (error_file)) error_file = DECODE_FILE (error_file); - report_file_errno ("Cannot redirect stderr", - Fcons (error_file, Qnil), open_errno); + report_file_errno ("Cannot redirect stderr", error_file, open_errno); } #ifdef MSDOS /* MW, July 1993 */ @@ -596,8 +593,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * unlink (tempfile); emacs_close (filefd); report_file_errno ("Cannot re-open temporary file", - Fcons (build_string (tempfile), Qnil), - open_errno); + build_string (tempfile), open_errno); } } else @@ -935,7 +931,7 @@ usage: (call-process PROGRAM &optional INFILE DESTINATION DISPLAY &rest ARGS) * return make_number (WEXITSTATUS (status)); } -static Lisp_Object +static void delete_temp_file (Lisp_Object name) { /* Suppress jka-compr handling, etc. */ @@ -957,44 +953,18 @@ delete_temp_file (Lisp_Object name) internal_delete_file (name); #endif unbind_to (count, Qnil); - return Qnil; } -DEFUN ("call-process-region", Fcall_process_region, Scall_process_region, - 3, MANY, 0, - doc: /* Send text from START to END to a synchronous process running PROGRAM. -The remaining arguments are optional. -Delete the text if fourth arg DELETE is non-nil. - -Insert output in BUFFER before point; t means current buffer; nil for - BUFFER means discard it; 0 means discard and don't wait; and `(:file - FILE)', where FILE is a file name string, means that it should be - written to that file (if the file already exists it is overwritten). -BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case, -REAL-BUFFER says what to do with standard output, as above, -while STDERR-FILE says what to do with standard error in the child. -STDERR-FILE may be nil (discard standard error output), -t (mix it with ordinary output), or a file name string. - -Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted. -Remaining args are passed to PROGRAM at startup as command args. +/* Create a temporary file suitable for storing the input data of + call-process-region. NARGS and ARGS are the same as for + call-process-region. */ -If BUFFER is 0, `call-process-region' returns immediately with value nil. -Otherwise it waits for PROGRAM to terminate -and returns a numeric exit status or a signal description string. -If you quit, the process is killed with SIGINT, or SIGKILL if you quit again. - -usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS) */) - (ptrdiff_t nargs, Lisp_Object *args) +static Lisp_Object +create_temp_file (ptrdiff_t nargs, Lisp_Object *args) { struct gcpro gcpro1; Lisp_Object filename_string; - register Lisp_Object start, end; - ptrdiff_t count = SPECPDL_INDEX (); - /* Qt denotes we have not yet called Ffind_operation_coding_system. */ - Lisp_Object coding_systems; - Lisp_Object val, *args2; - ptrdiff_t i; + Lisp_Object val, start, end; Lisp_Object tmpdir; if (STRINGP (Vtemporary_file_directory)) @@ -1016,9 +986,7 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r } { - USE_SAFE_ALLOCA; Lisp_Object pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir); - Lisp_Object encoded_tem; char *tempfile; #ifdef WINDOWSNT @@ -1036,39 +1004,30 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r } #endif - encoded_tem = ENCODE_FILE (pattern); - tempfile = SAFE_ALLOCA (SBYTES (encoded_tem) + 1); - memcpy (tempfile, SDATA (encoded_tem), SBYTES (encoded_tem) + 1); - coding_systems = Qt; + filename_string = Fcopy_sequence (ENCODE_FILE (pattern)); + GCPRO1 (filename_string); + tempfile = SSDATA (filename_string); -#if defined HAVE_MKOSTEMP || defined HAVE_MKSTEMP { - int fd, open_errno; + int fd; - block_input (); -# ifdef HAVE_MKOSTEMP +#ifdef HAVE_MKOSTEMP fd = mkostemp (tempfile, O_CLOEXEC); -# else +#elif defined HAVE_MKSTEMP fd = mkstemp (tempfile); -# endif - open_errno = errno; - unblock_input (); +#else + errno = EEXIST; + mktemp (tempfile); + /* INT_MAX denotes success, because close (INT_MAX) does nothing. */ + fd = *tempfile ? INT_MAX : -1; +#endif if (fd < 0) - report_file_errno ("Failed to open temporary file", - Fcons (build_string (tempfile), Qnil), open_errno); + report_file_error ("Failed to open temporary file using pattern", + pattern); emacs_close (fd); } -#else - errno = EEXIST; - mktemp (tempfile); - if (!*tempfile) - report_file_error ("Failed to open temporary file using pattern", - Fcons (pattern, Qnil)); -#endif - filename_string = build_string (tempfile); - GCPRO1 (filename_string); - SAFE_FREE (); + record_unwind_protect (delete_temp_file, filename_string); } start = args[0]; @@ -1080,10 +1039,12 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r val = Qraw_text; else { + Lisp_Object coding_systems; + Lisp_Object *args2; USE_SAFE_ALLOCA; SAFE_NALLOCA (args2, 1, nargs + 1); args2[0] = Qcall_process_region; - for (i = 0; i < nargs; i++) args2[i + 1] = args[i]; + memcpy (args2 + 1, args, nargs * sizeof *args); coding_systems = Ffind_operation_coding_system (nargs + 1, args2); val = CONSP (coding_systems) ? XCDR (coding_systems) : Qnil; SAFE_FREE (); @@ -1105,7 +1066,57 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r /* Note that Fcall_process takes care of binding coding-system-for-read. */ - record_unwind_protect (delete_temp_file, filename_string); + RETURN_UNGCPRO (filename_string); +} + +DEFUN ("call-process-region", Fcall_process_region, Scall_process_region, + 3, MANY, 0, + doc: /* Send text from START to END to a synchronous process running PROGRAM. +The remaining arguments are optional. +Delete the text if fourth arg DELETE is non-nil. + +Insert output in BUFFER before point; t means current buffer; nil for + BUFFER means discard it; 0 means discard and don't wait; and `(:file + FILE)', where FILE is a file name string, means that it should be + written to that file (if the file already exists it is overwritten). +BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case, +REAL-BUFFER says what to do with standard output, as above, +while STDERR-FILE says what to do with standard error in the child. +STDERR-FILE may be nil (discard standard error output), +t (mix it with ordinary output), or a file name string. + +Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted. +Remaining args are passed to PROGRAM at startup as command args. + +If BUFFER is 0, `call-process-region' returns immediately with value nil. +Otherwise it waits for PROGRAM to terminate +and returns a numeric exit status or a signal description string. +If you quit, the process is killed with SIGINT, or SIGKILL if you quit again. + +usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &rest ARGS) */) + (ptrdiff_t nargs, Lisp_Object *args) +{ + struct gcpro gcpro1; + Lisp_Object infile; + ptrdiff_t count = SPECPDL_INDEX (); + Lisp_Object start = args[0]; + Lisp_Object end = args[1]; + bool empty_input; + + if (STRINGP (start)) + empty_input = SCHARS (start) == 0; + else if (NILP (start)) + empty_input = BEG == Z; + else + { + validate_region (&args[0], &args[1]); + start = args[0]; + end = args[1]; + empty_input = XINT (start) == XINT (end); + } + + infile = empty_input ? Qnil : create_temp_file (nargs, args); + GCPRO1 (infile); if (nargs > 3 && !NILP (args[3])) Fdelete_region (start, end); @@ -1120,7 +1131,7 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r args[0] = args[2]; nargs = 2; } - args[1] = filename_string; + args[1] = infile; RETURN_UNGCPRO (unbind_to (count, Fcall_process (nargs, args))); } @@ -1185,9 +1196,11 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp, #ifdef WINDOWSNT int cpid; HANDLE handles[3]; -#endif /* WINDOWSNT */ +#else + int exec_errno; pid_t pid = getpid (); +#endif /* WINDOWSNT */ /* Note that use of alloca is always safe here. It's obvious for systems that do not have true vfork or that have true (stack) alloca. @@ -1346,32 +1359,27 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp, } #ifndef MSDOS - emacs_close (0); - emacs_close (1); - emacs_close (2); - - /* Redirect file descriptors and clear FD_CLOEXEC on the redirected ones. */ + /* Redirect file descriptors and clear the close-on-exec flag on the + redirected ones. IN, OUT, and ERR are close-on-exec so they + need not be closed explicitly. */ dup2 (in, 0); dup2 (out, 1); dup2 (err, 2); - emacs_close (in); - if (out != in) - emacs_close (out); - if (err != in && err != out) - emacs_close (err); - setpgid (0, 0); tcsetpgrp (0, pid); execve (new_argv[0], new_argv, env); + exec_errno = errno; - /* Don't output the program name here, as it can be arbitrarily long, - and a long write from a vforked child to its parent can cause a - deadlock. */ - emacs_perror ("child process"); + /* Avoid deadlock if the child's perror writes to a full pipe; the + pipe's reader is the parent, but with vfork the parent can't + run until the child exits. Truncate the diagnostic instead. */ + fcntl (STDERR_FILENO, F_SETFL, O_NONBLOCK); - _exit (errno == ENOENT ? EXIT_ENOENT : EXIT_CANNOT_INVOKE); + errno = exec_errno; + emacs_perror (new_argv[0]); + _exit (exec_errno == ENOENT ? EXIT_ENOENT : EXIT_CANNOT_INVOKE); #else /* MSDOS */ pid = run_msdos_command (new_argv, pwd_var + 4, in, out, err, env); @@ -1386,7 +1394,8 @@ child_setup (int in, int out, int err, char **new_argv, bool set_pgrp, #ifndef WINDOWSNT /* Move the file descriptor FD so that its number is not less than MINFD. - If the file descriptor is moved at all, the original is freed. */ + If the file descriptor is moved at all, the original is closed on MSDOS, + but not elsewhere as the caller will close it anyway. */ static int relocate_fd (int fd, int minfd) { @@ -1400,7 +1409,9 @@ relocate_fd (int fd, int minfd) emacs_perror ("while setting up child"); _exit (EXIT_CANCELED); } +#ifdef MSDOS emacs_close (fd); +#endif return new; } } diff --git a/src/charset.c b/src/charset.c index fdb8eebde8b..eedf65faa6c 100644 --- a/src/charset.c +++ b/src/charset.c @@ -28,6 +28,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #define CHARSET_INLINE EXTERN_INLINE +#include <errno.h> #include <stdio.h> #include <unistd.h> #include <limits.h> @@ -477,7 +478,8 @@ read_hex (FILE *fp, bool *eof, bool *overflow) `file-name-handler-alist' to avoid running any Lisp code. */ static void -load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, int control_flag) +load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, + int control_flag) { unsigned min_code = CHARSET_MIN_CODE (charset); unsigned max_code = CHARSET_MAX_CODE (charset); @@ -487,22 +489,26 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, int co struct charset_map_entries *head, *entries; int n_entries; ptrdiff_t count; - USE_SAFE_ALLOCA; - suffixes = Fcons (build_string (".map"), - Fcons (build_string (".TXT"), Qnil)); + suffixes = list2 (build_string (".map"), build_string (".TXT")); count = SPECPDL_INDEX (); + record_unwind_protect_nothing (); specbind (Qfile_name_handler_alist, Qnil); fd = openp (Vcharset_map_path, mapfile, suffixes, NULL, Qnil); - unbind_to (count, Qnil); - if (fd < 0 - || ! (fp = fdopen (fd, "r"))) - error ("Failure in loading charset map: %s", SDATA (mapfile)); + fp = fd < 0 ? 0 : fdopen (fd, "r"); + if (!fp) + { + int open_errno = errno; + emacs_close (fd); + report_file_errno ("Loading charset map", mapfile, open_errno); + } + set_unwind_protect_ptr (count, fclose_unwind, fp); + unbind_to (count + 1, Qnil); - /* Use SAFE_ALLOCA instead of alloca, as `charset_map_entries' is + /* Use record_xmalloc, as `charset_map_entries' is large (larger than MAX_ALLOCA). */ - head = SAFE_ALLOCA (sizeof *head); + head = record_xmalloc (sizeof *head); entries = head; memset (entries, 0, sizeof (struct charset_map_entries)); @@ -531,9 +537,9 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, int co if (from < min_code || to > max_code || from > to || c > MAX_CHAR) continue; - if (n_entries > 0 && (n_entries % 0x10000) == 0) + if (n_entries == 0x10000) { - entries->next = SAFE_ALLOCA (sizeof *entries->next); + entries->next = record_xmalloc (sizeof *entries->next); entries = entries->next; memset (entries, 0, sizeof (struct charset_map_entries)); n_entries = 0; @@ -545,9 +551,10 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, int co n_entries++; } fclose (fp); + clear_unwind_protect (count); load_charset_map (charset, head, n_entries, control_flag); - SAFE_FREE (); + unbind_to (count, Qnil); } static void @@ -1178,7 +1185,7 @@ usage: (define-charset-internal ...) */) charset.iso_final) = id; if (new_definition_p) Viso_2022_charset_list = nconc2 (Viso_2022_charset_list, - Fcons (make_number (id), Qnil)); + list1 (make_number (id))); if (ISO_CHARSET_TABLE (1, 0, 'J') == id) charset_jisx0201_roman = id; else if (ISO_CHARSET_TABLE (2, 0, '@') == id) @@ -1198,7 +1205,7 @@ usage: (define-charset-internal ...) */) emacs_mule_bytes[charset.emacs_mule_id] = charset.dimension + 2; if (new_definition_p) Vemacs_mule_charset_list = nconc2 (Vemacs_mule_charset_list, - Fcons (make_number (id), Qnil)); + list1 (make_number (id))); } if (new_definition_p) @@ -1206,7 +1213,7 @@ usage: (define-charset-internal ...) */) Vcharset_list = Fcons (args[charset_arg_name], Vcharset_list); if (charset.supplementary_p) Vcharset_ordered_list = nconc2 (Vcharset_ordered_list, - Fcons (make_number (id), Qnil)); + list1 (make_number (id))); else { Lisp_Object tail; @@ -1223,7 +1230,7 @@ usage: (define-charset-internal ...) */) Vcharset_ordered_list); else if (NILP (tail)) Vcharset_ordered_list = nconc2 (Vcharset_ordered_list, - Fcons (make_number (id), Qnil)); + list1 (make_number (id))); else { val = Fcons (XCAR (tail), XCDR (tail)); @@ -2308,7 +2315,7 @@ Please check your installation!\n", exit (1); } - Vcharset_map_path = Fcons (tempdir, Qnil); + Vcharset_map_path = list1 (tempdir); } diff --git a/src/coding.c b/src/coding.c index 1ab59294b98..0cdd8f9cd9e 100644 --- a/src/coding.c +++ b/src/coding.c @@ -493,6 +493,8 @@ enum iso_code_class_type #define CODING_ISO_FLAG_USE_OLDJIS 0x10000 +#define CODING_ISO_FLAG_LEVEL_4 0x20000 + #define CODING_ISO_FLAG_FULL_SUPPORT 0x100000 /* A character to be produced on output if encoding of the original @@ -1363,6 +1365,45 @@ decode_coding_utf_8 (struct coding_system *coding) break; } + /* In the simple case, rapidly handle ordinary characters */ + if (multibytep && ! eol_dos + && charbuf < charbuf_end - 6 && src < src_end - 6) + { + while (charbuf < charbuf_end - 6 && src < src_end - 6) + { + c1 = *src; + if (c1 & 0x80) + break; + src++; + consumed_chars++; + *charbuf++ = c1; + + c1 = *src; + if (c1 & 0x80) + break; + src++; + consumed_chars++; + *charbuf++ = c1; + + c1 = *src; + if (c1 & 0x80) + break; + src++; + consumed_chars++; + *charbuf++ = c1; + + c1 = *src; + if (c1 & 0x80) + break; + src++; + consumed_chars++; + *charbuf++ = c1; + } + /* If we handled at least one character, restart the main loop. */ + if (src != src_base) + continue; + } + if (byte_after_cr >= 0) c1 = byte_after_cr, byte_after_cr = -1; else @@ -3733,7 +3774,10 @@ decode_coding_iso_2022 (struct coding_system *coding) else charset = CHARSET_FROM_ID (charset_id_2); ONE_MORE_BYTE (c1); - if (c1 < 0x20 || (c1 >= 0x80 && c1 < 0xA0)) + if (c1 < 0x20 || (c1 >= 0x80 && c1 < 0xA0) + || (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS) + && ((CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LEVEL_4) + ? c1 >= 0x80 : c1 < 0x80))) goto invalid_code; break; @@ -3747,7 +3791,10 @@ decode_coding_iso_2022 (struct coding_system *coding) else charset = CHARSET_FROM_ID (charset_id_3); ONE_MORE_BYTE (c1); - if (c1 < 0x20 || (c1 >= 0x80 && c1 < 0xA0)) + if (c1 < 0x20 || (c1 >= 0x80 && c1 < 0xA0) + || (! (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_SEVEN_BITS) + && ((CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_LEVEL_4) + ? c1 >= 0x80 : c1 < 0x80))) goto invalid_code; break; @@ -6864,11 +6911,9 @@ get_translation_table (Lisp_Object attrs, bool encodep, int *max_lookup) if (CHAR_TABLE_P (standard)) { if (CONSP (translation_table)) - translation_table = nconc2 (translation_table, - Fcons (standard, Qnil)); + translation_table = nconc2 (translation_table, list1 (standard)); else - translation_table = Fcons (translation_table, - Fcons (standard, Qnil)); + translation_table = list2 (translation_table, standard); } } @@ -7793,7 +7838,7 @@ make_conversion_work_buffer (bool multibyte) } -static Lisp_Object +static void code_conversion_restore (Lisp_Object arg) { Lisp_Object current, workbuf; @@ -7811,7 +7856,6 @@ code_conversion_restore (Lisp_Object arg) } set_buffer_internal (XBUFFER (current)); UNGCPRO; - return Qnil; } Lisp_Object @@ -8667,20 +8711,20 @@ detect_coding_system (const unsigned char *src, { detect_info.found = CATEGORY_MASK_RAW_TEXT; id = CODING_SYSTEM_ID (Qno_conversion); - val = Fcons (make_number (id), Qnil); + val = list1 (make_number (id)); } else if (! detect_info.rejected && ! detect_info.found) { detect_info.found = CATEGORY_MASK_ANY; id = coding_categories[coding_category_undecided].id; - val = Fcons (make_number (id), Qnil); + val = list1 (make_number (id)); } else if (highest) { if (detect_info.found) { detect_info.found = 1 << category; - val = Fcons (make_number (this->id), Qnil); + val = list1 (make_number (this->id)); } else for (i = 0; i < coding_category_raw_text; i++) @@ -8688,7 +8732,7 @@ detect_coding_system (const unsigned char *src, { detect_info.found = 1 << coding_priorities[i]; id = coding_categories[coding_priorities[i]].id; - val = Fcons (make_number (id), Qnil); + val = list1 (make_number (id)); break; } } @@ -8705,7 +8749,7 @@ detect_coding_system (const unsigned char *src, found |= 1 << category; id = coding_categories[category].id; if (id >= 0) - val = Fcons (make_number (id), val); + val = list1 (make_number (id)); } } for (i = coding_category_raw_text - 1; i >= 0; i--) @@ -8730,7 +8774,7 @@ detect_coding_system (const unsigned char *src, this = coding_categories + coding_category_utf_8_sig; else this = coding_categories + coding_category_utf_8_nosig; - val = Fcons (make_number (this->id), Qnil); + val = list1 (make_number (this->id)); } } else if (base_category == coding_category_utf_16_auto) @@ -8747,13 +8791,13 @@ detect_coding_system (const unsigned char *src, this = coding_categories + coding_category_utf_16_be_nosig; else this = coding_categories + coding_category_utf_16_le_nosig; - val = Fcons (make_number (this->id), Qnil); + val = list1 (make_number (this->id)); } } else { detect_info.found = 1 << XINT (CODING_ATTR_CATEGORY (attrs)); - val = Fcons (make_number (coding.id), Qnil); + val = list1 (make_number (coding.id)); } /* Then, detect eol-format if necessary. */ @@ -9224,7 +9268,7 @@ is nil. */) attrs = AREF (CODING_SYSTEM_SPEC (elt), 0); ASET (attrs, coding_attr_trans_tbl, get_translation_table (attrs, 1, NULL)); - list = Fcons (Fcons (elt, Fcons (attrs, Qnil)), list); + list = Fcons (list2 (elt, attrs), list); } if (STRINGP (start)) @@ -9635,7 +9679,7 @@ DEFUN ("set-terminal-coding-system-internal", Fset_terminal_coding_system_intern tset_charset_list (term, (terminal_coding->common_flags & CODING_REQUIRE_ENCODING_MASK ? coding_charset_list (terminal_coding) - : Fcons (make_number (charset_ascii), Qnil))); + : list1 (make_number (charset_ascii)))); return Qnil; } @@ -10080,9 +10124,9 @@ usage: (define-coding-system-internal ...) */) { dim2 = CHARSET_DIMENSION (CHARSET_FROM_ID (XFASTINT (tmp))); if (dim < dim2) - tmp = Fcons (XCAR (tail), Fcons (tmp, Qnil)); + tmp = list2 (XCAR (tail), tmp); else - tmp = Fcons (tmp, Fcons (XCAR (tail), Qnil)); + tmp = list2 (tmp, XCAR (tail)); } else { @@ -10093,7 +10137,7 @@ usage: (define-coding-system-internal ...) */) break; } if (NILP (tmp2)) - tmp = nconc2 (tmp, Fcons (XCAR (tail), Qnil)); + tmp = nconc2 (tmp, list1 (XCAR (tail))); else { XSETCDR (tmp2, Fcons (XCAR (tmp2), XCDR (tmp2))); @@ -10411,7 +10455,7 @@ usage: (define-coding-system-internal ...) */) && ! EQ (eol_type, Qmac)) error ("Invalid eol-type"); - aliases = Fcons (name, Qnil); + aliases = list1 (name); if (NILP (eol_type)) { @@ -10421,7 +10465,7 @@ usage: (define-coding-system-internal ...) */) Lisp_Object this_spec, this_name, this_aliases, this_eol_type; this_name = AREF (eol_type, i); - this_aliases = Fcons (this_name, Qnil); + this_aliases = list1 (this_name); this_eol_type = (i == 0 ? Qunix : i == 1 ? Qdos : Qmac); this_spec = make_uninit_vector (3); ASET (this_spec, 0, attrs); @@ -10536,7 +10580,7 @@ DEFUN ("define-coding-system-alias", Fdefine_coding_system_alias, list. */ while (!NILP (XCDR (aliases))) aliases = XCDR (aliases); - XSETCDR (aliases, Fcons (alias, Qnil)); + XSETCDR (aliases, list1 (alias)); eol_type = AREF (spec, 2); if (VECTORP (eol_type)) @@ -11218,6 +11262,8 @@ character."); plist[13] = build_pure_c_string ("No conversion on encoding, automatic conversion on decoding."); plist[15] = args[coding_arg_eol_type] = Qnil; args[coding_arg_plist] = Flist (16, plist); + args[coding_arg_undecided_inhibit_null_byte_detection] = make_number (0); + args[coding_arg_undecided_inhibit_iso_escape_detection] = make_number (0); Fdefine_coding_system_internal (coding_arg_undecided_max, args); } diff --git a/src/composite.c b/src/composite.c index 8b1f0171a60..99b5da22af5 100644 --- a/src/composite.c +++ b/src/composite.c @@ -595,7 +595,7 @@ update_compositions (ptrdiff_t from, ptrdiff_t to, int check_mask) specbind (Qinhibit_point_motion_hooks, Qt); Fremove_list_of_text_properties (make_number (min_pos), make_number (max_pos), - Fcons (Qauto_composed, Qnil), Qnil); + list1 (Qauto_composed), Qnil); unbind_to (count, Qnil); } } @@ -1873,11 +1873,9 @@ See `find-composition' for more details. */) return list3 (make_number (s), make_number (e), gstring); } if (!COMPOSITION_VALID_P (start, end, prop)) - return Fcons (make_number (start), Fcons (make_number (end), - Fcons (Qnil, Qnil))); + return list3 (make_number (start), make_number (end), Qnil); if (NILP (detail_p)) - return Fcons (make_number (start), Fcons (make_number (end), - Fcons (Qt, Qnil))); + return list3 (make_number (start), make_number (end), Qt); if (COMPOSITION_REGISTERD_P (prop)) id = COMPOSITION_ID (prop); @@ -1899,10 +1897,7 @@ See `find-composition' for more details. */) relative_p = (method == COMPOSITION_WITH_RULE_ALTCHARS ? Qnil : Qt); mod_func = COMPOSITION_MODIFICATION_FUNC (prop); - tail = Fcons (components, - Fcons (relative_p, - Fcons (mod_func, - Fcons (make_number (width), Qnil)))); + tail = list4 (components, relative_p, mod_func, make_number (width)); } else tail = Qnil; diff --git a/src/conf_post.h b/src/conf_post.h index b19456749a2..16714076f6f 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -160,13 +160,7 @@ extern void _DebPrint (const char *fmt, ...); /* Tell regex.c to use a type compatible with Emacs. */ #define RE_TRANSLATE_TYPE Lisp_Object #define RE_TRANSLATE(TBL, C) char_table_translate (TBL, C) -#ifdef make_number -/* If make_number is a macro, use it. */ #define RE_TRANSLATE_P(TBL) (!EQ (TBL, make_number (0))) -#else -/* If make_number is a function, avoid it. */ -#define RE_TRANSLATE_P(TBL) (!(INTEGERP (TBL) && XINT (TBL) == 0)) -#endif #endif #include <string.h> diff --git a/src/cygw32.c b/src/cygw32.c index bbc3a49fd88..3e0f4ae1803 100644 --- a/src/cygw32.c +++ b/src/cygw32.c @@ -23,12 +23,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <unistd.h> #include <fcntl.h> -static Lisp_Object -fchdir_unwind (Lisp_Object dir_fd) +static void +fchdir_unwind (int dir_fd) { - (void) fchdir (XFASTINT (dir_fd)); - (void) close (XFASTINT (dir_fd)); - return Qnil; + (void) fchdir (dir_fd); + (void) close (dir_fd); } static void @@ -40,7 +39,7 @@ chdir_to_default_directory () if (old_cwd_fd == -1) error ("could not open current directory: %s", strerror (errno)); - record_unwind_protect (fchdir_unwind, make_number (old_cwd_fd)); + record_unwind_protect_int (fchdir_unwind, old_cwd_fd); new_cwd = Funhandled_file_name_directory ( Fexpand_file_name (build_string ("."), Qnil)); diff --git a/src/data.c b/src/data.c index ea72a3fc181..25a9e698481 100644 --- a/src/data.c +++ b/src/data.c @@ -1515,24 +1515,19 @@ of previous VARs. usage: (setq-default [VAR VALUE]...) */) (Lisp_Object args) { - register Lisp_Object args_left; - register Lisp_Object val, symbol; + Lisp_Object args_left, symbol, val; struct gcpro gcpro1; - if (NILP (args)) - return Qnil; - - args_left = args; + args_left = val = args; GCPRO1 (args); - do + while (CONSP (args_left)) { - val = eval_sub (Fcar (Fcdr (args_left))); + val = eval_sub (Fcar (XCDR (args_left))); symbol = XCAR (args_left); Fset_default (symbol, val); args_left = Fcdr (XCDR (args_left)); } - while (!NILP (args_left)); UNGCPRO; return val; diff --git a/src/deps.mk b/src/deps.mk index 83444474c59..39666dca515 100644 --- a/src/deps.mk +++ b/src/deps.mk @@ -190,7 +190,7 @@ sysdep.o: sysdep.c syssignal.h systty.h systime.h syswait.h blockinput.h \ frame.h atimer.h window.h msdos.h dosfns.h keyboard.h cm.h lisp.h \ globals.h $(config_h) composite.h sysselect.h gnutls.h \ ../lib/allocator.h ../lib/careadlinkat.h \ - ../lib/unistd.h ../lib/ignore-value.h + ../lib/unistd.h term.o: term.c termchar.h termhooks.h termopts.h lisp.h globals.h $(config_h) \ cm.h frame.h disptab.h keyboard.h character.h charset.h coding.h ccl.h \ xterm.h msdos.h window.h keymap.h blockinput.h atimer.h systime.h \ diff --git a/src/dired.c b/src/dired.c index b3348b0aff0..2b79b54f2a4 100644 --- a/src/dired.c +++ b/src/dired.c @@ -107,22 +107,20 @@ open_directory (char const *name, int *fdp) } #ifdef WINDOWSNT -Lisp_Object +void directory_files_internal_w32_unwind (Lisp_Object arg) { Vw32_get_true_file_attributes = arg; - return Qnil; } #endif -static Lisp_Object -directory_files_internal_unwind (Lisp_Object dh) +static void +directory_files_internal_unwind (void *dh) { - DIR *d = XSAVE_POINTER (dh, 0); + DIR *d = dh; block_input (); closedir (d); unblock_input (); - return Qnil; } /* Function shared by Fdirectory_files and Fdirectory_files_and_attributes. @@ -185,13 +183,12 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, d = open_directory (SSDATA (dirfilename), &fd); if (d == NULL) - report_file_error ("Opening directory", Fcons (directory, Qnil)); + report_file_error ("Opening directory", directory); /* Unfortunately, we can now invoke expand-file-name and file-attributes on filenames, both of which can throw, so we must do a proper unwind-protect. */ - record_unwind_protect (directory_files_internal_unwind, - make_save_pointer (d)); + record_unwind_protect_ptr (directory_files_internal_unwind, d); #ifdef WINDOWSNT if (attrs) @@ -488,10 +485,9 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, d = open_directory (SSDATA (encoded_dir), &fd); if (!d) - report_file_error ("Opening directory", Fcons (dirname, Qnil)); + report_file_error ("Opening directory", dirname); - record_unwind_protect (directory_files_internal_unwind, - make_save_pointer (d)); + record_unwind_protect_ptr (directory_files_internal_unwind, d); /* Loop reading blocks */ /* (att3b compiler bug requires do a null comparison this way) */ @@ -1017,7 +1013,7 @@ return a list with one element, taken from `user-real-login-name'. */) #endif if (EQ (users, Qnil)) /* At least current user is always known. */ - users = Fcons (Vuser_real_login_name, Qnil); + users = list1 (Vuser_real_login_name); return users; } diff --git a/src/dispnew.c b/src/dispnew.c index 1eb097f05ab..522a0e6a30d 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -5619,7 +5619,7 @@ FILE = nil means just close any termscript file currently open. */) file = Fexpand_file_name (file, Qnil); tty->termscript = emacs_fopen (SSDATA (file), "w"); if (tty->termscript == 0) - report_file_error ("Opening termscript", Fcons (file, Qnil)); + report_file_error ("Opening termscript", file); } return Qnil; } @@ -5699,7 +5699,7 @@ bitch_at_user (void) { const char *msg = "Keyboard macro terminated by a command ringing the bell"; - Fsignal (Quser_error, Fcons (build_string (msg), Qnil)); + Fsignal (Quser_error, list1 (build_string (msg))); } else ring_bell (XFRAME (selected_frame)); @@ -6041,7 +6041,7 @@ init_display (void) #ifdef HAVE_X11 Vwindow_system_version = make_number (11); #endif -#ifdef GNU_LINUX +#ifdef USE_NCURSES /* In some versions of ncurses, tputs crashes if we have not called tgetent. So call tgetent. */ @@ -6127,15 +6127,14 @@ init_display (void) /* Update frame parameters to reflect the new type. */ Fmodify_frame_parameters - (selected_frame, Fcons (Fcons (Qtty_type, - Ftty_type (selected_frame)), Qnil)); + (selected_frame, list1 (Fcons (Qtty_type, + Ftty_type (selected_frame)))); if (t->display_info.tty->name) - Fmodify_frame_parameters (selected_frame, - Fcons (Fcons (Qtty, build_string (t->display_info.tty->name)), - Qnil)); + Fmodify_frame_parameters + (selected_frame, + list1 (Fcons (Qtty, build_string (t->display_info.tty->name)))); else - Fmodify_frame_parameters (selected_frame, Fcons (Fcons (Qtty, Qnil), - Qnil)); + Fmodify_frame_parameters (selected_frame, list1 (Fcons (Qtty, Qnil))); } { diff --git a/src/doc.c b/src/doc.c index 3c5a682c001..009616f4f87 100644 --- a/src/doc.c +++ b/src/doc.c @@ -21,6 +21,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <config.h> +#include <errno.h> #include <sys/types.h> #include <sys/file.h> /* Must be after sys/types.h for USG. */ #include <fcntl.h> @@ -84,6 +85,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition) int offset; EMACS_INT position; Lisp_Object file, tem, pos; + ptrdiff_t count; USE_SAFE_ALLOCA; if (INTEGERP (filepos)) @@ -143,9 +145,14 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition) } #endif if (fd < 0) - return concat3 (build_string ("Cannot open doc string file \""), - file, build_string ("\"\n")); + { + SAFE_FREE (); + return concat3 (build_string ("Cannot open doc string file \""), + file, build_string ("\"\n")); + } } + count = SPECPDL_INDEX (); + record_unwind_protect_int (close_file_unwind, fd); /* Seek only to beginning of disk block. */ /* Make sure we read at least 1024 bytes before `position' @@ -153,13 +160,8 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition) offset = min (position, max (1024, position % (8 * 1024))); if (TYPE_MAXIMUM (off_t) < position || lseek (fd, position - offset, 0) < 0) - { - emacs_close (fd); - error ("Position %"pI"d out of range in doc string file \"%s\"", - position, name); - } - - SAFE_FREE (); + error ("Position %"pI"d out of range in doc string file \"%s\"", + position, name); /* Read the doc string into get_doc_string_buffer. P points beyond the data just read. */ @@ -189,10 +191,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition) space_left = 1024 * 8; nread = emacs_read (fd, p, space_left); if (nread < 0) - { - emacs_close (fd); - error ("Read error on documentation file"); - } + report_file_error ("Read error on documentation file", file); p[nread] = 0; if (!nread) break; @@ -208,7 +207,8 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition) } p += nread; } - emacs_close (fd); + unbind_to (count, Qnil); + SAFE_FREE (); /* Sanity checking. */ if (CONSP (filepos)) @@ -573,6 +573,7 @@ the same file name is found in the `doc-directory'. */) Lisp_Object sym; char *p, *name; bool skip_file = 0; + ptrdiff_t count; CHECK_STRING (filename); @@ -609,8 +610,13 @@ the same file name is found in the `doc-directory'. */) fd = emacs_open (name, O_RDONLY, 0); if (fd < 0) - report_file_error ("Opening doc string file", - Fcons (build_string (name), Qnil)); + { + int open_errno = errno; + report_file_errno ("Opening doc string file", build_string (name), + open_errno); + } + count = SPECPDL_INDEX (); + record_unwind_protect_int (close_file_unwind, fd); Vdoc_file_name = filename; filled = 0; pos = 0; @@ -688,8 +694,7 @@ the same file name is found in the `doc-directory'. */) filled -= end - buf; memmove (buf, end, filled); } - emacs_close (fd); - return Qnil; + return unbind_to (count, Qnil); } DEFUN ("substitute-command-keys", Fsubstitute_command_keys, diff --git a/src/editfns.c b/src/editfns.c index cc6b4cff895..50bde90788d 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -838,9 +838,8 @@ This function does not move point. */) Lisp_Object save_excursion_save (void) { - return make_save_value - (SAVE_TYPE_OBJ_OBJ_OBJ_OBJ, - Fpoint_marker (), + return make_save_obj_obj_obj_obj + (Fpoint_marker (), /* Do not copy the mark if it points to nowhere. */ (XMARKER (BVAR (current_buffer, mark))->buffer ? Fcopy_marker (BVAR (current_buffer, mark), Qnil) @@ -853,7 +852,7 @@ save_excursion_save (void) /* Restore saved buffer before leaving `save-excursion' special form. */ -Lisp_Object +void save_excursion_restore (Lisp_Object info) { Lisp_Object tem, tem1, omark, nmark; @@ -927,7 +926,6 @@ save_excursion_restore (Lisp_Object info) out: free_misc (info); - return Qnil; } DEFUN ("save-excursion", Fsave_excursion, Ssave_excursion, 0, UNEVALLED, 0, @@ -2809,18 +2807,16 @@ determines whether case is significant or ignored. */) return make_number (0); } -static Lisp_Object +static void subst_char_in_region_unwind (Lisp_Object arg) { bset_undo_list (current_buffer, arg); - return arg; } -static Lisp_Object +static void subst_char_in_region_unwind_1 (Lisp_Object arg) { bset_filename (current_buffer, arg); - return arg; } DEFUN ("subst-char-in-region", Fsubst_char_in_region, @@ -3331,7 +3327,7 @@ save_restriction_save (void) } } -Lisp_Object +void save_restriction_restore (Lisp_Object data) { struct buffer *cur = NULL; @@ -3398,8 +3394,6 @@ save_restriction_restore (Lisp_Object data) if (cur) set_buffer_internal (cur); - - return Qnil; } DEFUN ("save-restriction", Fsave_restriction, Ssave_restriction, 0, UNEVALLED, 0, @@ -3492,7 +3486,7 @@ usage: (message-box FORMAT-STRING &rest ARGS) */) { Lisp_Object pane, menu; struct gcpro gcpro1; - pane = Fcons (Fcons (build_string ("OK"), Qt), Qnil); + pane = list1 (Fcons (build_string ("OK"), Qt)); GCPRO1 (pane); menu = Fcons (val, pane); Fx_popup_dialog (Qt, menu, Qt); @@ -3627,7 +3621,7 @@ usage: (format STRING &rest OBJECTS) */) ptrdiff_t bufsize = sizeof initial_buffer; ptrdiff_t max_bufsize = STRING_BYTES_BOUND + 1; char *p; - Lisp_Object buf_save_value IF_LINT (= {0}); + ptrdiff_t buf_save_value_index IF_LINT (= 0); char *format, *end, *format_start; ptrdiff_t formatlen, nchars; /* True if the format is multibyte. */ @@ -4236,14 +4230,14 @@ usage: (format STRING &rest OBJECTS) */) { buf = xmalloc (bufsize); sa_must_free = 1; - buf_save_value = make_save_pointer (buf); - record_unwind_protect (safe_alloca_unwind, buf_save_value); + buf_save_value_index = SPECPDL_INDEX (); + record_unwind_protect_ptr (xfree, buf); memcpy (buf, initial_buffer, used); } else { buf = xrealloc (buf, bufsize); - set_save_pointer (buf_save_value, 0, buf); + set_unwind_protect_ptr (buf_save_value_index, xfree, buf); } p = buf + used; diff --git a/src/emacs.c b/src/emacs.c index 274321482e1..6d406407a9d 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -974,7 +974,7 @@ main (int argc, char **argv) use a pipe for synchronization. The parent waits for the child to close its end of the pipe (using `daemon-initialized') before exiting. */ - if (pipe2 (daemon_pipe, O_CLOEXEC) != 0) + if (emacs_pipe (daemon_pipe) != 0) { fprintf (stderr, "Cannot pipe!\n"); exit (1); @@ -1494,12 +1494,11 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem char *file; /* Handle -l loadup, args passed by Makefile. */ if (argmatch (argv, argc, "-l", "--load", 3, &file, &skip_args)) - Vtop_level = Fcons (intern_c_string ("load"), - Fcons (build_string (file), Qnil)); + Vtop_level = list2 (intern_c_string ("load"), build_string (file)); /* Unless next switch is -nl, load "loadup.el" first thing. */ if (! no_loadup) - Vtop_level = Fcons (intern_c_string ("load"), - Fcons (build_string ("loadup.el"), Qnil)); + Vtop_level = list2 (intern_c_string ("load"), + build_string ("loadup.el")); } if (initialized) diff --git a/src/emacsgtkfixed.c b/src/emacsgtkfixed.c index 970683da9c4..8b19d89f3a0 100644 --- a/src/emacsgtkfixed.c +++ b/src/emacsgtkfixed.c @@ -28,7 +28,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "xterm.h" /* Silence a bogus diagnostic; see GNOME bug 683906. */ -#if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 6) +#if 4 < __GNUC__ + (7 <= __GNUC_MINOR__) # pragma GCC diagnostic push # pragma GCC diagnostic ignored "-Wunused-local-typedefs" #endif diff --git a/src/eval.c b/src/eval.c index 97e812dd890..e93c3473ae8 100644 --- a/src/eval.c +++ b/src/eval.c @@ -138,6 +138,13 @@ specpdl_old_value (union specbinding *pdl) return pdl->let.old_value; } +static void +set_specpdl_old_value (union specbinding *pdl, Lisp_Object val) +{ + eassert (pdl->kind >= SPECPDL_LET); + pdl->let.old_value = val; +} + static Lisp_Object specpdl_where (union specbinding *pdl) { @@ -159,13 +166,6 @@ specpdl_arg (union specbinding *pdl) return pdl->unwind.arg; } -static specbinding_func -specpdl_func (union specbinding *pdl) -{ - eassert (pdl->kind == SPECPDL_UNWIND); - return pdl->unwind.func; -} - Lisp_Object backtrace_function (union specbinding *pdl) { @@ -287,12 +287,11 @@ mark_catchlist (struct catchtag *catch) /* Unwind-protect function used by call_debugger. */ -static Lisp_Object +static void restore_stack_limits (Lisp_Object data) { max_specpdl_size = XINT (XCAR (data)); max_lisp_eval_depth = XINT (XCDR (data)); - return Qnil; } /* Call the Lisp debugger, giving it argument ARG. */ @@ -358,7 +357,7 @@ do_debug_on_call (Lisp_Object code) { debug_on_next_call = 0; set_backtrace_debug_on_exit (specpdl_ptr - 1, true); - call_debugger (Fcons (code, Qnil)); + call_debugger (list1 (code)); } /* NOTE!!! Every function that can call EVAL must protect its args @@ -421,16 +420,16 @@ If COND yields nil, and there are no ELSE's, the value is nil. usage: (if COND THEN ELSE...) */) (Lisp_Object args) { - register Lisp_Object cond; + Lisp_Object cond; struct gcpro gcpro1; GCPRO1 (args); - cond = eval_sub (Fcar (args)); + cond = eval_sub (XCAR (args)); UNGCPRO; if (!NILP (cond)) - return eval_sub (Fcar (Fcdr (args))); - return Fprogn (Fcdr (Fcdr (args))); + return eval_sub (Fcar (XCDR (args))); + return Fprogn (XCDR (XCDR (args))); } DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0, @@ -445,18 +444,17 @@ CONDITION's value if non-nil is returned from the cond-form. usage: (cond CLAUSES...) */) (Lisp_Object args) { - register Lisp_Object clause, val; + Lisp_Object val = args; struct gcpro gcpro1; - val = Qnil; GCPRO1 (args); - while (!NILP (args)) + while (CONSP (args)) { - clause = Fcar (args); + Lisp_Object clause = XCAR (args); val = eval_sub (Fcar (clause)); if (!NILP (val)) { - if (!EQ (XCDR (clause), Qnil)) + if (!NILP (XCDR (clause))) val = Fprogn (XCDR (clause)); break; } @@ -470,23 +468,32 @@ usage: (cond CLAUSES...) */) DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0, doc: /* Eval BODY forms sequentially and return value of last one. usage: (progn BODY...) */) - (Lisp_Object args) + (Lisp_Object body) { - register Lisp_Object val = Qnil; + Lisp_Object val = Qnil; struct gcpro gcpro1; - GCPRO1 (args); + GCPRO1 (body); - while (CONSP (args)) + while (CONSP (body)) { - val = eval_sub (XCAR (args)); - args = XCDR (args); + val = eval_sub (XCAR (body)); + body = XCDR (body); } UNGCPRO; return val; } +/* Evaluate BODY sequentially, discarding its value. Suitable for + record_unwind_protect. */ + +void +unwind_body (Lisp_Object body) +{ + Fprogn (body); +} + DEFUN ("prog1", Fprog1, Sprog1, 1, UNEVALLED, 0, doc: /* Eval FIRST and BODY sequentially; return value from FIRST. The value of FIRST is saved during the evaluation of the remaining args, @@ -495,11 +502,11 @@ usage: (prog1 FIRST BODY...) */) (Lisp_Object args) { Lisp_Object val; - register Lisp_Object args_left; + Lisp_Object args_left; struct gcpro gcpro1, gcpro2; args_left = args; - val = Qnil; + val = args; GCPRO2 (args, val); val = eval_sub (XCAR (args_left)); @@ -536,36 +543,37 @@ The return value of the `setq' form is the value of the last VAL. usage: (setq [SYM VAL]...) */) (Lisp_Object args) { - register Lisp_Object args_left; - register Lisp_Object val, sym, lex_binding; - struct gcpro gcpro1; - - if (NILP (args)) - return Qnil; + Lisp_Object val, sym, lex_binding; - args_left = args; - GCPRO1 (args); - - do + val = args; + if (CONSP (args)) { - val = eval_sub (Fcar (Fcdr (args_left))); - sym = Fcar (args_left); + Lisp_Object args_left = args; + struct gcpro gcpro1; + GCPRO1 (args); - /* Like for eval_sub, we do not check declared_special here since - it's been done when let-binding. */ - if (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */ - && SYMBOLP (sym) - && !NILP (lex_binding - = Fassq (sym, Vinternal_interpreter_environment))) - XSETCDR (lex_binding, val); /* SYM is lexically bound. */ - else - Fset (sym, val); /* SYM is dynamically bound. */ + do + { + val = eval_sub (Fcar (XCDR (args_left))); + sym = XCAR (args_left); + + /* Like for eval_sub, we do not check declared_special here since + it's been done when let-binding. */ + if (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */ + && SYMBOLP (sym) + && !NILP (lex_binding + = Fassq (sym, Vinternal_interpreter_environment))) + XSETCDR (lex_binding, val); /* SYM is lexically bound. */ + else + Fset (sym, val); /* SYM is dynamically bound. */ + + args_left = Fcdr (XCDR (args_left)); + } + while (CONSP (args_left)); - args_left = Fcdr (Fcdr (args_left)); + UNGCPRO; } - while (!NILP (args_left)); - UNGCPRO; return val; } @@ -582,9 +590,9 @@ of unexpected results when a quoted object is modified. usage: (quote ARG) */) (Lisp_Object args) { - if (!NILP (Fcdr (args))) + if (CONSP (XCDR (args))) xsignal2 (Qwrong_number_of_arguments, Qquote, Flength (args)); - return Fcar (args); + return XCAR (args); } DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0, @@ -596,7 +604,7 @@ usage: (function ARG) */) { Lisp_Object quoted = XCAR (args); - if (!NILP (Fcdr (args))) + if (CONSP (XCDR (args))) xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args)); if (!NILP (Vinternal_interpreter_environment) @@ -698,21 +706,23 @@ To define a user option, use `defcustom' instead of `defvar'. usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) (Lisp_Object args) { - register Lisp_Object sym, tem, tail; + Lisp_Object sym, tem, tail; - sym = Fcar (args); - tail = Fcdr (args); - if (!NILP (Fcdr (Fcdr (tail)))) - error ("Too many arguments"); + sym = XCAR (args); + tail = XCDR (args); - tem = Fdefault_boundp (sym); - if (!NILP (tail)) + if (CONSP (tail)) { + if (CONSP (XCDR (tail)) && CONSP (XCDR (XCDR (tail)))) + error ("Too many arguments"); + + tem = Fdefault_boundp (sym); + /* Do it before evaluating the initial value, for self-references. */ XSYMBOL (sym)->declared_special = 1; if (NILP (tem)) - Fset_default (sym, eval_sub (Fcar (tail))); + Fset_default (sym, eval_sub (XCAR (tail))); else { /* Check if there is really a global binding rather than just a let binding that shadows the global unboundness of the var. */ @@ -730,7 +740,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) } } } - tail = Fcdr (tail); + tail = XCDR (tail); tem = Fcar (tail); if (!NILP (tem)) { @@ -775,18 +785,18 @@ The optional DOCSTRING specifies the variable's documentation string. usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */) (Lisp_Object args) { - register Lisp_Object sym, tem; + Lisp_Object sym, tem; - sym = Fcar (args); - if (!NILP (Fcdr (Fcdr (Fcdr (args))))) + sym = XCAR (args); + if (CONSP (Fcdr (XCDR (XCDR (args))))) error ("Too many arguments"); - tem = eval_sub (Fcar (Fcdr (args))); + tem = eval_sub (Fcar (XCDR (args))); if (!NILP (Vpurify_flag)) tem = Fpurecopy (tem); Fset_default (sym, tem); XSYMBOL (sym)->declared_special = 1; - tem = Fcar (Fcdr (Fcdr (args))); + tem = Fcar (XCDR (XCDR (args))); if (!NILP (tem)) { if (!NILP (Vpurify_flag)) @@ -827,7 +837,7 @@ usage: (let* VARLIST BODY...) */) lexenv = Vinternal_interpreter_environment; - varlist = Fcar (args); + varlist = XCAR (args); while (CONSP (varlist)) { QUIT; @@ -868,7 +878,7 @@ usage: (let* VARLIST BODY...) */) varlist = XCDR (varlist); } UNGCPRO; - val = Fprogn (Fcdr (args)); + val = Fprogn (XCDR (args)); return unbind_to (count, val); } @@ -888,7 +898,7 @@ usage: (let VARLIST BODY...) */) struct gcpro gcpro1, gcpro2; USE_SAFE_ALLOCA; - varlist = Fcar (args); + varlist = XCAR (args); /* Make space to hold the values to give the bound variables. */ elt = Flength (varlist); @@ -915,7 +925,7 @@ usage: (let VARLIST BODY...) */) lexenv = Vinternal_interpreter_environment; - varlist = Fcar (args); + varlist = XCAR (args); for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist)) { Lisp_Object var; @@ -938,7 +948,7 @@ usage: (let VARLIST BODY...) */) /* Instantiate a new lexical environment. */ specbind (Qinternal_interpreter_environment, lexenv); - elt = Fprogn (Fcdr (args)); + elt = Fprogn (XCDR (args)); SAFE_FREE (); return unbind_to (count, elt); } @@ -955,8 +965,8 @@ usage: (while TEST BODY...) */) GCPRO2 (test, body); - test = Fcar (args); - body = Fcdr (args); + test = XCAR (args); + body = XCDR (args); while (!NILP (eval_sub (test))) { QUIT; @@ -1053,9 +1063,9 @@ usage: (catch TAG BODY...) */) struct gcpro gcpro1; GCPRO1 (args); - tag = eval_sub (Fcar (args)); + tag = eval_sub (XCAR (args)); UNGCPRO; - return internal_catch (tag, Fprogn, Fcdr (args)); + return internal_catch (tag, Fprogn, XCDR (args)); } /* Set up a catch, then call C function FUNC on argument ARG. @@ -1169,8 +1179,8 @@ usage: (unwind-protect BODYFORM UNWINDFORMS...) */) Lisp_Object val; ptrdiff_t count = SPECPDL_INDEX (); - record_unwind_protect (Fprogn, Fcdr (args)); - val = eval_sub (Fcar (args)); + record_unwind_protect (unwind_body, XCDR (args)); + val = eval_sub (XCAR (args)); return unbind_to (count, val); } @@ -1202,9 +1212,9 @@ See also the function `signal' for more info. usage: (condition-case VAR BODYFORM &rest HANDLERS) */) (Lisp_Object args) { - Lisp_Object var = Fcar (args); - Lisp_Object bodyform = Fcar (Fcdr (args)); - Lisp_Object handlers = Fcdr (Fcdr (args)); + Lisp_Object var = XCAR (args); + Lisp_Object bodyform = XCAR (XCDR (args)); + Lisp_Object handlers = XCDR (XCDR (args)); return internal_lisp_condition_case (var, bodyform, handlers); } @@ -1631,7 +1641,7 @@ signal_error (const char *s, Lisp_Object arg) } if (!NILP (hare)) - arg = Fcons (arg, Qnil); /* Make it a list. */ + arg = list1 (arg); xsignal (Qerror, Fcons (build_string (s), arg)); } @@ -1723,7 +1733,7 @@ maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data) /* RMS: What's this for? */ && when_entered_debugger < num_nonmacro_input_events) { - call_debugger (Fcons (Qerror, Fcons (combined_data, Qnil))); + call_debugger (list2 (Qerror, combined_data)); return 1; } @@ -1910,10 +1920,10 @@ this does nothing and returns nil. */) Qnil); } -Lisp_Object +void un_autoload (Lisp_Object oldqueue) { - register Lisp_Object queue, first, second; + Lisp_Object queue, first, second; /* Queue to unwind is current value of Vautoload_queue. oldqueue is the shadowed value to leave in Vautoload_queue. */ @@ -1930,7 +1940,6 @@ un_autoload (Lisp_Object oldqueue) Ffset (first, second); queue = XCDR (queue); } - return Qnil; } /* Load an autoloaded function. @@ -2012,7 +2021,7 @@ If LEXICAL is t, evaluate using lexical scoping. */) { ptrdiff_t count = SPECPDL_INDEX (); specbind (Qinternal_interpreter_environment, - CONSP (lexical) || NILP (lexical) ? lexical : Fcons (Qt, Qnil)); + CONSP (lexical) || NILP (lexical) ? lexical : list1 (Qt)); return unbind_to (count, eval_sub (form)); } @@ -2277,7 +2286,7 @@ eval_sub (Lisp_Object form) lisp_eval_depth--; if (backtrace_debug_on_exit (specpdl_ptr - 1)) - val = call_debugger (Fcons (Qexit, Fcons (val, Qnil))); + val = call_debugger (list2 (Qexit, val)); specpdl_ptr--; return val; @@ -2898,7 +2907,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) check_cons_list (); lisp_eval_depth--; if (backtrace_debug_on_exit (specpdl_ptr - 1)) - val = call_debugger (Fcons (Qexit, Fcons (val, Qnil))); + val = call_debugger (list2 (Qexit, val)); specpdl_ptr--; return val; } @@ -2940,7 +2949,7 @@ apply_lambda (Lisp_Object fun, Lisp_Object args) { /* Don't do it again when we return to eval. */ set_backtrace_debug_on_exit (specpdl_ptr - 1, false); - tem = call_debugger (Fcons (Qexit, Fcons (tem, Qnil))); + tem = call_debugger (list2 (Qexit, tem)); } SAFE_FREE (); return tem; @@ -3255,8 +3264,10 @@ specbind (Lisp_Object symbol, Lisp_Object value) } } +/* Push unwind-protect entries of various types. */ + void -record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg) +record_unwind_protect (void (*function) (Lisp_Object), Lisp_Object arg) { specpdl_ptr->unwind.kind = SPECPDL_UNWIND; specpdl_ptr->unwind.func = function; @@ -3265,6 +3276,32 @@ record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg) } void +record_unwind_protect_ptr (void (*function) (void *), void *arg) +{ + specpdl_ptr->unwind_ptr.kind = SPECPDL_UNWIND_PTR; + specpdl_ptr->unwind_ptr.func = function; + specpdl_ptr->unwind_ptr.arg = arg; + grow_specpdl (); +} + +void +record_unwind_protect_int (void (*function) (int), int arg) +{ + specpdl_ptr->unwind_int.kind = SPECPDL_UNWIND_INT; + specpdl_ptr->unwind_int.func = function; + specpdl_ptr->unwind_int.arg = arg; + grow_specpdl (); +} + +void +record_unwind_protect_void (void (*function) (void)) +{ + specpdl_ptr->unwind_void.kind = SPECPDL_UNWIND_VOID; + specpdl_ptr->unwind_void.func = function; + grow_specpdl (); +} + +void rebind_for_thread_switch (void) { union specbinding *bind; @@ -3288,7 +3325,18 @@ do_one_unbind (union specbinding *this_binding, int unwinding) switch (this_binding->kind) { case SPECPDL_UNWIND: - specpdl_func (this_binding) (specpdl_arg (this_binding)); + specpdl_ptr->unwind.func (specpdl_ptr->unwind.arg); + break; + case SPECPDL_UNWIND_PTR: + specpdl_ptr->unwind_ptr.func (specpdl_ptr->unwind_ptr.arg); + break; + case SPECPDL_UNWIND_INT: + specpdl_ptr->unwind_int.func (specpdl_ptr->unwind_int.arg); + break; + case SPECPDL_UNWIND_VOID: + specpdl_ptr->unwind_void.func (); + break; + case SPECPDL_BACKTRACE: break; case SPECPDL_LET: /* If variable has a trivial value (no forwarding), we can @@ -3304,8 +3352,6 @@ do_one_unbind (union specbinding *this_binding, int unwinding) Fset_default (specpdl_symbol (this_binding), specpdl_old_value (this_binding)); break; - case SPECPDL_BACKTRACE: - break; case SPECPDL_LET_LOCAL: case SPECPDL_LET_DEFAULT: { /* If the symbol is a list, it is really (SYMBOL WHERE @@ -3331,6 +3377,46 @@ do_one_unbind (union specbinding *this_binding, int unwinding) } } +void +do_nothing (void) +{} + +/* Push an unwind-protect entry that does nothing, so that + set_unwind_protect_ptr can overwrite it later. */ + +void +record_unwind_protect_nothing (void) +{ + record_unwind_protect_void (do_nothing); +} + +/* Clear the unwind-protect entry COUNT, so that it does nothing. + It need not be at the top of the stack. */ + +void +clear_unwind_protect (ptrdiff_t count) +{ + union specbinding *p = specpdl + count; + p->unwind_void.kind = SPECPDL_UNWIND_VOID; + p->unwind_void.func = do_nothing; +} + +/* Set the unwind-protect entry COUNT so that it invokes FUNC (ARG). + It need not be at the top of the stack. Discard the entry's + previous value without invoking it. */ + +void +set_unwind_protect_ptr (ptrdiff_t count, void (*func) (void *), void *arg) +{ + union specbinding *p = specpdl + count; + p->unwind_ptr.kind = SPECPDL_UNWIND_PTR; + p->unwind_ptr.func = func; + p->unwind_ptr.arg = arg; +} + +/* Pop and execute entries from the unwind-protect stack until the + depth COUNT is reached. Return VALUE. */ + Lisp_Object unbind_to (ptrdiff_t count, Lisp_Object value) { @@ -3449,7 +3535,30 @@ Output stream used is value of `standard-output'. */) return Qnil; } -DEFUN ("backtrace-frame", Fbacktrace_frame, Sbacktrace_frame, 1, 1, NULL, +static union specbinding * +get_backtrace_frame (Lisp_Object nframes, Lisp_Object base) +{ + union specbinding *pdl = backtrace_top (); + register EMACS_INT i; + + CHECK_NATNUM (nframes); + + if (!NILP (base)) + { /* Skip up to `base'. */ + base = Findirect_function (base, Qt); + while (backtrace_p (pdl) + && !EQ (base, Findirect_function (backtrace_function (pdl), Qt))) + pdl = backtrace_next (pdl); + } + + /* Find the frame requested. */ + for (i = XFASTINT (nframes); i > 0 && backtrace_p (pdl); i--) + pdl = backtrace_next (pdl); + + return pdl; +} + +DEFUN ("backtrace-frame", Fbacktrace_frame, Sbacktrace_frame, 1, 2, NULL, doc: /* Return the function and arguments NFRAMES up from current execution point. If that frame has not evaluated the arguments yet (or is a special form), the value is (nil FUNCTION ARG-FORMS...). @@ -3458,17 +3567,12 @@ the value is (t FUNCTION ARG-VALUES...). A &rest arg is represented as the tail of the list ARG-VALUES. FUNCTION is whatever was supplied as car of evaluated list, or a lambda expression for macro calls. -If NFRAMES is more than the number of frames, the value is nil. */) - (Lisp_Object nframes) +If NFRAMES is more than the number of frames, the value is nil. +If BASE is non-nil, it should be a function and NFRAMES counts from its +nearest activation frame. */) + (Lisp_Object nframes, Lisp_Object base) { - union specbinding *pdl = backtrace_top (); - register EMACS_INT i; - - CHECK_NATNUM (nframes); - - /* Find the frame requested. */ - for (i = 0; backtrace_p (pdl) && i < XFASTINT (nframes); i++) - pdl = backtrace_next (pdl); + union specbinding *pdl = get_backtrace_frame (nframes, base); if (!backtrace_p (pdl)) return Qnil; @@ -3483,6 +3587,109 @@ If NFRAMES is more than the number of frames, the value is nil. */) } } +/* For backtrace-eval, we want to temporarily unwind the last few elements of + the specpdl stack, and then rewind them. We store the pre-unwind values + directly in the pre-existing specpdl elements (i.e. we swap the current + value and the old value stored in the specpdl), kind of like the inplace + pointer-reversal trick. As it turns out, the rewind does the same as the + unwind, except it starts from the other end of the spepdl stack, so we use + the same function for both unwind and rewind. */ +static void +backtrace_eval_unrewind (int distance) +{ + union specbinding *tmp = specpdl_ptr; + int step = -1; + if (distance < 0) + { /* It's a rewind rather than unwind. */ + tmp += distance - 1; + step = 1; + distance = -distance; + } + + for (; distance > 0; distance--) + { + tmp += step; + /* */ + switch (tmp->kind) + { + /* FIXME: Ideally we'd like to "temporarily unwind" (some of) those + unwind_protect, but the problem is that we don't know how to + rewind them afterwards. */ + case SPECPDL_UNWIND: + case SPECPDL_UNWIND_PTR: + case SPECPDL_UNWIND_INT: + case SPECPDL_UNWIND_VOID: + case SPECPDL_BACKTRACE: + break; + case SPECPDL_LET: + /* If variable has a trivial value (no forwarding), we can + just set it. No need to check for constant symbols here, + since that was already done by specbind. */ + if (XSYMBOL (specpdl_symbol (tmp))->redirect + == SYMBOL_PLAINVAL) + { + struct Lisp_Symbol *sym = XSYMBOL (specpdl_symbol (tmp)); + Lisp_Object old_value = specpdl_old_value (tmp); + set_specpdl_old_value (tmp, SYMBOL_VAL (sym)); + SET_SYMBOL_VAL (sym, old_value); + break; + } + else + { + /* FALLTHROUGH! + NOTE: we only ever come here if make_local_foo was used for + the first time on this var within this let. */ + } + case SPECPDL_LET_DEFAULT: + { + Lisp_Object sym = specpdl_symbol (tmp); + Lisp_Object old_value = specpdl_old_value (tmp); + set_specpdl_old_value (tmp, Fdefault_value (sym)); + Fset_default (sym, old_value); + } + break; + case SPECPDL_LET_LOCAL: + { + Lisp_Object symbol = specpdl_symbol (tmp); + Lisp_Object where = specpdl_where (tmp); + Lisp_Object old_value = specpdl_old_value (tmp); + eassert (BUFFERP (where)); + + /* If this was a local binding, reset the value in the appropriate + buffer, but only if that buffer's binding still exists. */ + if (!NILP (Flocal_variable_p (symbol, where))) + { + set_specpdl_old_value + (tmp, Fbuffer_local_value (symbol, where)); + set_internal (symbol, old_value, where, 1); + } + } + break; + } + } +} + +DEFUN ("backtrace-eval", Fbacktrace_eval, Sbacktrace_eval, 2, 3, NULL, + doc: /* Evaluate EXP in the context of some activation frame. +NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. */) + (Lisp_Object exp, Lisp_Object nframes, Lisp_Object base) +{ + union specbinding *pdl = get_backtrace_frame (nframes, base); + ptrdiff_t count = SPECPDL_INDEX (); + ptrdiff_t distance = specpdl_ptr - pdl; + eassert (distance >= 0); + + if (!backtrace_p (pdl)) + error ("Activation frame not found!"); + + backtrace_eval_unrewind (distance); + record_unwind_protect_int (backtrace_eval_unrewind, -distance); + + /* Use eval_sub rather than Feval since the main motivation behind + backtrace-eval is to be able to get/set the value of lexical variables + from the debugger. */ + return unbind_to (count, eval_sub (exp)); +} void mark_specpdl (union specbinding *first, union specbinding *ptr) @@ -3729,6 +3936,7 @@ alist of active lexical bindings. */); defsubr (&Sbacktrace_debug); defsubr (&Sbacktrace); defsubr (&Sbacktrace_frame); + defsubr (&Sbacktrace_eval); defsubr (&Sspecial_variable_p); defsubr (&Sfunctionp); } diff --git a/src/fileio.c b/src/fileio.c index c3566390130..c47b3533145 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -160,11 +160,16 @@ static bool e_write (int, Lisp_Object, ptrdiff_t, ptrdiff_t, /* Signal a file-access failure. STRING describes the failure, - DATA the file that was involved, and ERRORNO the errno value. */ + NAME the file involved, and ERRORNO the errno value. + + If NAME is neither null nor a pair, package it up as a singleton + list before reporting it; this saves report_file_errno's caller the + trouble of preserving errno before calling list1. */ void -report_file_errno (char const *string, Lisp_Object data, int errorno) +report_file_errno (char const *string, Lisp_Object name, int errorno) { + Lisp_Object data = CONSP (name) || NILP (name) ? name : list1 (name); Lisp_Object errstring; char *str; @@ -198,27 +203,37 @@ report_file_errno (char const *string, Lisp_Object data, int errorno) } } +/* Signal a file-access failure that set errno. STRING describes the + failure, NAME the file involved. When invoking this function, take + care to not use arguments such as build_string ("foo") that involve + side effects that may set errno. */ + void -report_file_error (char const *string, Lisp_Object data) +report_file_error (char const *string, Lisp_Object name) { - report_file_errno (string, data, errno); + report_file_errno (string, name, errno); } -Lisp_Object -close_file_unwind (Lisp_Object fd) +void +close_file_unwind (int fd) { - emacs_close (XFASTINT (fd)); - return Qnil; + emacs_close (fd); +} + +void +fclose_unwind (void *arg) +{ + FILE *stream = arg; + fclose (stream); } /* Restore point, having saved it as a marker. */ -Lisp_Object +void restore_point_unwind (Lisp_Object location) { Fgoto_char (location); Fset_marker (location, Qnil, Qnil); - return Qnil; } @@ -749,7 +764,7 @@ make_temp_name (Lisp_Object prefix, bool base64_p) dog-slow, but also useless since eventually nil would have to be returned anyway. */ report_file_error ("Cannot create temporary name for prefix", - Fcons (prefix, Qnil)); + prefix); /* not reached */ } } @@ -2019,7 +2034,7 @@ entries (depending on how Emacs was built). */) { acl = acl_get_file (SDATA (encoded_file), ACL_TYPE_ACCESS); if (acl == NULL && acl_errno_valid (errno)) - report_file_error ("Getting ACL", Fcons (file, Qnil)); + report_file_error ("Getting ACL", file); } if (!CopyFile (SDATA (encoded_file), SDATA (encoded_newname), @@ -2027,7 +2042,7 @@ entries (depending on how Emacs was built). */) { /* CopyFile doesn't set errno when it fails. By far the most "popular" reason is that the target is read-only. */ - report_file_errno ("Copying file", Fcons (file, Fcons (newname, Qnil)), + report_file_errno ("Copying file", list2 (file, newname), GetLastError () == 5 ? EACCES : EPERM); } /* CopyFile retains the timestamp by default. */ @@ -2058,7 +2073,7 @@ entries (depending on how Emacs was built). */) bool fail = acl_set_file (SDATA (encoded_newname), ACL_TYPE_ACCESS, acl) != 0; if (fail && acl_errno_valid (errno)) - report_file_error ("Setting ACL", Fcons (newname, Qnil)); + report_file_error ("Setting ACL", newname); acl_free (acl); } @@ -2068,12 +2083,12 @@ entries (depending on how Emacs was built). */) immediate_quit = 0; if (ifd < 0) - report_file_error ("Opening input file", Fcons (file, Qnil)); + report_file_error ("Opening input file", file); - record_unwind_protect (close_file_unwind, make_number (ifd)); + record_unwind_protect_int (close_file_unwind, ifd); if (fstat (ifd, &st) != 0) - report_file_error ("Input file status", Fcons (file, Qnil)); + report_file_error ("Input file status", file); if (!NILP (preserve_extended_attributes)) { @@ -2082,7 +2097,7 @@ entries (depending on how Emacs was built). */) { conlength = fgetfilecon (ifd, &con); if (conlength == -1) - report_file_error ("Doing fgetfilecon", Fcons (file, Qnil)); + report_file_error ("Doing fgetfilecon", file); } #endif } @@ -2090,11 +2105,11 @@ entries (depending on how Emacs was built). */) if (out_st.st_mode != 0 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino) report_file_errno ("Input and output files are the same", - Fcons (file, Fcons (newname, Qnil)), 0); + list2 (file, newname), 0); /* We can copy only regular files. */ if (!S_ISREG (st.st_mode)) - report_file_errno ("Non-regular file", Fcons (file, Qnil), + report_file_errno ("Non-regular file", file, S_ISDIR (st.st_mode) ? EISDIR : EINVAL); { @@ -2109,15 +2124,15 @@ entries (depending on how Emacs was built). */) new_mask); } if (ofd < 0) - report_file_error ("Opening output file", Fcons (newname, Qnil)); + report_file_error ("Opening output file", newname); - record_unwind_protect (close_file_unwind, make_number (ofd)); + record_unwind_protect_int (close_file_unwind, ofd); immediate_quit = 1; QUIT; while ((n = emacs_read (ifd, buf, sizeof buf)) > 0) if (emacs_write_sig (ofd, buf, n) != n) - report_file_error ("I/O error", Fcons (newname, Qnil)); + report_file_error ("Write error", newname); immediate_quit = 0; #ifndef MSDOS @@ -2145,8 +2160,8 @@ entries (depending on how Emacs was built). */) st.st_mode & mode_mask) : fchmod (ofd, st.st_mode & mode_mask)) { - case -2: report_file_error ("Copying permissions from", list1 (file)); - case -1: report_file_error ("Copying permissions to", list1 (newname)); + case -2: report_file_error ("Copying permissions from", file); + case -1: report_file_error ("Copying permissions to", newname); } } #endif /* not MSDOS */ @@ -2158,7 +2173,7 @@ entries (depending on how Emacs was built). */) bool fail = fsetfilecon (ofd, con) != 0; /* See http://debbugs.gnu.org/11245 for ENOTSUP. */ if (fail && errno != ENOTSUP) - report_file_error ("Doing fsetfilecon", Fcons (newname, Qnil)); + report_file_error ("Doing fsetfilecon", newname); freecon (con); } @@ -2174,7 +2189,7 @@ entries (depending on how Emacs was built). */) } if (emacs_close (ofd) < 0) - report_file_error ("I/O error", Fcons (newname, Qnil)); + report_file_error ("Write error", newname); emacs_close (ifd); @@ -2220,7 +2235,7 @@ DEFUN ("make-directory-internal", Fmake_directory_internal, #else if (mkdir (dir, 0777 & ~auto_saving_dir_umask) != 0) #endif - report_file_error ("Creating directory", list1 (directory)); + report_file_error ("Creating directory", directory); return Qnil; } @@ -2239,7 +2254,7 @@ DEFUN ("delete-directory-internal", Fdelete_directory_internal, dir = SSDATA (encoded_dir); if (rmdir (dir) != 0) - report_file_error ("Removing directory", list1 (directory)); + report_file_error ("Removing directory", directory); return Qnil; } @@ -2282,7 +2297,7 @@ With a prefix argument, TRASH is nil. */) encoded_file = ENCODE_FILE (filename); if (unlink (SSDATA (encoded_file)) < 0) - report_file_error ("Removing old name", list1 (filename)); + report_file_error ("Removing old name", filename); return Qnil; } @@ -2364,7 +2379,8 @@ This is what happens in interactive use with M-x. */) INTEGERP (ok_if_already_exists), 0, 0); if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0) { - if (errno == EXDEV) + int rename_errno = errno; + if (rename_errno == EXDEV) { ptrdiff_t count; symlink_target = Ffile_symlink_p (file); @@ -2390,7 +2406,7 @@ This is what happens in interactive use with M-x. */) unbind_to (count, Qnil); } else - report_file_error ("Renaming", list2 (file, newname)); + report_file_errno ("Renaming", list2 (file, newname), rename_errno); } UNGCPRO; return Qnil; @@ -2444,7 +2460,10 @@ This is what happens in interactive use with M-x. */) unlink (SSDATA (newname)); if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0) - report_file_error ("Adding new name", list2 (file, newname)); + { + int link_errno = errno; + report_file_errno ("Adding new name", list2 (file, newname), link_errno); + } UNGCPRO; return Qnil; @@ -2503,6 +2522,7 @@ This happens for interactive use with M-x. */) if (symlink (SSDATA (encoded_filename), SSDATA (encoded_linkname)) < 0) { /* If we didn't complain already, silently delete existing file. */ + int symlink_errno; if (errno == EEXIST) { unlink (SSDATA (encoded_linkname)); @@ -2520,7 +2540,9 @@ This happens for interactive use with M-x. */) build_string ("Symbolic links are not supported")); } - report_file_error ("Making symbolic link", list2 (filename, linkname)); + symlink_errno = errno; + report_file_errno ("Making symbolic link", list2 (filename, linkname), + symlink_errno); } UNGCPRO; return Qnil; @@ -2719,7 +2741,7 @@ If there is no error, returns nil. */) encoded_filename = ENCODE_FILE (absname); if (faccessat (AT_FDCWD, SSDATA (encoded_filename), R_OK, AT_EACCESS) != 0) - report_file_error (SSDATA (string), Fcons (filename, Qnil)); + report_file_error (SSDATA (string), filename); return Qnil; } @@ -3054,14 +3076,14 @@ or if Emacs was not compiled with SELinux support. */) != 0); /* See http://debbugs.gnu.org/11245 for ENOTSUP. */ if (fail && errno != ENOTSUP) - report_file_error ("Doing lsetfilecon", Fcons (absname, Qnil)); + report_file_error ("Doing lsetfilecon", absname); context_free (parsed_con); freecon (con); return fail ? Qnil : Qt; } else - report_file_error ("Doing lgetfilecon", Fcons (absname, Qnil)); + report_file_error ("Doing lgetfilecon", absname); } #endif @@ -3151,7 +3173,7 @@ support. */) acl = acl_from_text (SSDATA (acl_string)); if (acl == NULL) { - report_file_error ("Converting ACL", Fcons (absname, Qnil)); + report_file_error ("Converting ACL", absname); return Qnil; } @@ -3161,7 +3183,7 @@ support. */) acl) != 0); if (fail && acl_errno_valid (errno)) - report_file_error ("Setting ACL", Fcons (absname, Qnil)); + report_file_error ("Setting ACL", absname); acl_free (acl); return fail ? Qnil : Qt; @@ -3221,7 +3243,7 @@ symbolic notation, like the `chmod' command from GNU Coreutils. */) encoded_absname = ENCODE_FILE (absname); if (chmod (SSDATA (encoded_absname), XINT (mode) & 07777) < 0) - report_file_error ("Doing chmod", Fcons (absname, Qnil)); + report_file_error ("Doing chmod", absname); return Qnil; } @@ -3287,7 +3309,7 @@ Use the current time if TIMESTAMP is nil. TIMESTAMP is in the format of if (file_directory_p (SSDATA (encoded_absname))) return Qnil; #endif - report_file_error ("Setting file times", Fcons (absname, Qnil)); + report_file_error ("Setting file times", absname); } } @@ -3369,7 +3391,7 @@ verify (READ_BUF_SIZE <= INT_MAX); o remove all text properties. o set back the buffer multibyteness. */ -static Lisp_Object +static void decide_coding_unwind (Lisp_Object unwind_data) { Lisp_Object multibyte, undo_list, buffer; @@ -3388,8 +3410,6 @@ decide_coding_unwind (Lisp_Object unwind_data) /* Now we are safe to change the buffer's multibyteness directly. */ bset_enable_multibyte_characters (current_buffer, multibyte); bset_undo_list (current_buffer, undo_list); - - return Qnil; } /* Read from a non-regular file. STATE is a Lisp_Save_Value @@ -3510,7 +3530,7 @@ by calling `format-decode', which see. */) && BEG == Z); Lisp_Object old_Vdeactivate_mark = Vdeactivate_mark; bool we_locked_file = 0; - bool deferred_remove_unwind_protect = 0; + ptrdiff_t fd_index; if (current_buffer->base_buffer && ! NILP (visit)) error ("Cannot do file visiting in an indirect buffer"); @@ -3553,7 +3573,7 @@ by calling `format-decode', which see. */) { save_errno = errno; if (NILP (visit)) - report_file_error ("Opening input file", Fcons (orig_filename, Qnil)); + report_file_error ("Opening input file", orig_filename); mtime = time_error_value (save_errno); st.st_size = -1; if (!NILP (Vcoding_system_for_read)) @@ -3561,14 +3581,15 @@ by calling `format-decode', which see. */) goto notfound; } + fd_index = SPECPDL_INDEX (); + record_unwind_protect_int (close_file_unwind, fd); + /* Replacement should preserve point as it preserves markers. */ if (!NILP (replace)) record_unwind_protect (restore_point_unwind, Fpoint_marker ()); - record_unwind_protect (close_file_unwind, make_number (fd)); - if (fstat (fd, &st) != 0) - report_file_error ("Input file status", Fcons (orig_filename, Qnil)); + report_file_error ("Input file status", orig_filename); mtime = get_stat_mtime (&st); /* This code will need to be changed in order to work on named @@ -3682,15 +3703,14 @@ by calling `format-decode', which see. */) int ntail; if (lseek (fd, - (1024 * 3), SEEK_END) < 0) report_file_error ("Setting file position", - Fcons (orig_filename, Qnil)); + orig_filename); ntail = emacs_read (fd, read_buf + nread, 1024 * 3); nread = ntail < 0 ? ntail : nread + ntail; } } if (nread < 0) - error ("IO error reading %s: %s", - SDATA (orig_filename), emacs_strerror (errno)); + report_file_error ("Read error", orig_filename); else if (nread > 0) { struct buffer *prev = current_buffer; @@ -3726,8 +3746,7 @@ by calling `format-decode', which see. */) /* Rewind the file for the actual read done later. */ if (lseek (fd, 0, SEEK_SET) < 0) - report_file_error ("Setting file position", - Fcons (orig_filename, Qnil)); + report_file_error ("Setting file position", orig_filename); } } @@ -3793,8 +3812,7 @@ by calling `format-decode', which see. */) if (beg_offset != 0) { if (lseek (fd, beg_offset, SEEK_SET) < 0) - report_file_error ("Setting file position", - Fcons (orig_filename, Qnil)); + report_file_error ("Setting file position", orig_filename); } immediate_quit = 1; @@ -3807,8 +3825,7 @@ by calling `format-decode', which see. */) nread = emacs_read (fd, read_buf, sizeof read_buf); if (nread < 0) - error ("IO error reading %s: %s", - SSDATA (orig_filename), emacs_strerror (errno)); + report_file_error ("Read error", orig_filename); else if (nread == 0) break; @@ -3843,7 +3860,8 @@ by calling `format-decode', which see. */) if (same_at_start - BEGV_BYTE == end_offset - beg_offset) { emacs_close (fd); - specpdl_ptr--; + clear_unwind_protect (fd_index); + /* Truncate the buffer to the size of the file. */ del_range_1 (same_at_start, same_at_end, 0, 0); goto handled; @@ -3866,16 +3884,14 @@ by calling `format-decode', which see. */) /* How much can we scan in the next step? */ trial = min (curpos, sizeof read_buf); if (lseek (fd, curpos - trial, SEEK_SET) < 0) - report_file_error ("Setting file position", - Fcons (orig_filename, Qnil)); + report_file_error ("Setting file position", orig_filename); total_read = nread = 0; while (total_read < trial) { nread = emacs_read (fd, read_buf + total_read, trial - total_read); if (nread < 0) - error ("IO error reading %s: %s", - SDATA (orig_filename), emacs_strerror (errno)); + report_file_error ("Read error", orig_filename); else if (nread == 0) break; total_read += nread; @@ -3987,8 +4003,7 @@ by calling `format-decode', which see. */) CONVERSION_BUFFER. */ if (lseek (fd, beg_offset, SEEK_SET) < 0) - report_file_error ("Setting file position", - Fcons (orig_filename, Qnil)); + report_file_error ("Setting file position", orig_filename); inserted = 0; /* Bytes put into CONVERSION_BUFFER so far. */ unprocessed = 0; /* Bytes not processed in previous loop. */ @@ -4018,16 +4033,10 @@ by calling `format-decode', which see. */) memcpy (read_buf, coding.carryover, unprocessed); } UNGCPRO; - emacs_close (fd); - - /* We should remove the unwind_protect calling - close_file_unwind, but other stuff has been added the stack, - so defer the removal till we reach the `handled' label. */ - deferred_remove_unwind_protect = 1; - if (this < 0) - error ("IO error reading %s: %s", - SDATA (orig_filename), emacs_strerror (errno)); + report_file_error ("Read error", orig_filename); + emacs_close (fd); + clear_unwind_protect (fd_index); if (unprocessed > 0) { @@ -4168,8 +4177,7 @@ by calling `format-decode', which see. */) if (beg_offset != 0 || !NILP (replace)) { if (lseek (fd, beg_offset, SEEK_SET) < 0) - report_file_error ("Setting file position", - Fcons (orig_filename, Qnil)); + report_file_error ("Setting file position", orig_filename); } /* In the following loop, HOW_MUCH contains the total bytes read so @@ -4208,8 +4216,7 @@ by calling `format-decode', which see. */) to be signaled after decoding the text we read. */ nbytes = internal_condition_case_1 (read_non_regular, - make_save_value (SAVE_TYPE_INT_INT_INT, (ptrdiff_t) fd, - inserted, trytry), + make_save_int_int_int (fd, inserted, trytry), Qerror, read_non_regular_quit); if (NILP (nbytes)) @@ -4269,13 +4276,10 @@ by calling `format-decode', which see. */) Vdeactivate_mark = Qt; emacs_close (fd); - - /* Discard the unwind protect for closing the file. */ - specpdl_ptr--; + clear_unwind_protect (fd_index); if (how_much < 0) - error ("IO error reading %s: %s", - SDATA (orig_filename), emacs_strerror (errno)); + report_file_error ("Read error", orig_filename); /* Make the text read part of the buffer. */ GAP_SIZE -= inserted; @@ -4399,11 +4403,6 @@ by calling `format-decode', which see. */) handled: - if (deferred_remove_unwind_protect) - /* If requested above, discard the unwind protect for closing the - file. */ - specpdl_ptr--; - if (!NILP (visit)) { if (empty_undo_list_p) @@ -4574,8 +4573,7 @@ by calling `format-decode', which see. */) && EMACS_NSECS (current_buffer->modtime) == NONEXISTENT_MODTIME_NSECS) { /* If visiting nonexistent file, return nil. */ - report_file_errno ("Opening input file", Fcons (orig_filename, Qnil), - save_errno); + report_file_errno ("Opening input file", orig_filename, save_errno); } if (read_quit) @@ -4590,11 +4588,10 @@ by calling `format-decode', which see. */) static Lisp_Object build_annotations (Lisp_Object, Lisp_Object); -static Lisp_Object +static void build_annotations_unwind (Lisp_Object arg) { Vwrite_region_annotation_buffers = arg; - return Qnil; } /* Decide the coding-system to encode the data with. */ @@ -4631,7 +4628,7 @@ This function is for internal use only. It may prompt the user. */ ) && !NILP (Ffboundp (Vselect_safe_coding_system_function))) /* Confirm that VAL can surely encode the current region. */ val = call5 (Vselect_safe_coding_system_function, - start, end, Fcons (Qt, Fcons (val, Qnil)), + start, end, list2 (Qt, val), Qnil, filename); } else @@ -4834,7 +4831,7 @@ This calls `write-region-annotate-functions' at the start, and record_unwind_protect (build_annotations_unwind, Vwrite_region_annotation_buffers); - Vwrite_region_annotation_buffers = Fcons (Fcurrent_buffer (), Qnil); + Vwrite_region_annotation_buffers = list1 (Fcurrent_buffer ()); count1 = SPECPDL_INDEX (); given_buffer = current_buffer; @@ -4901,11 +4898,10 @@ This calls `write-region-annotate-functions' at the start, and if (!auto_saving) unlock_file (lockname); #endif /* CLASH_DETECTION */ UNGCPRO; - report_file_errno ("Opening output file", Fcons (filename, Qnil), - open_errno); + report_file_errno ("Opening output file", filename, open_errno); } - record_unwind_protect (close_file_unwind, make_number (desc)); + record_unwind_protect_int (close_file_unwind, desc); if (NUMBERP (append)) { @@ -4917,8 +4913,7 @@ This calls `write-region-annotate-functions' at the start, and if (!auto_saving) unlock_file (lockname); #endif /* CLASH_DETECTION */ UNGCPRO; - report_file_errno ("Lseek error", Fcons (filename, Qnil), - lseek_errno); + report_file_errno ("Lseek error", filename, lseek_errno); } } @@ -5071,8 +5066,7 @@ This calls `write-region-annotate-functions' at the start, and } if (! ok) - error ("IO error writing %s: %s", SDATA (filename), - emacs_strerror (save_errno)); + report_file_errno ("Write error", filename, save_errno); if (visiting) { @@ -5498,11 +5492,18 @@ auto_save_1 (void) Qnil, Qnil); } -static Lisp_Object -do_auto_save_unwind (Lisp_Object arg) /* used as unwind-protect function */ +struct auto_save_unwind +{ + FILE *stream; + bool auto_raise; +}; +static void +do_auto_save_unwind (void *arg) { - FILE *stream = XSAVE_POINTER (arg, 0); + struct auto_save_unwind *p = arg; + FILE *stream = p->stream; + minibuffer_auto_raise = p->auto_raise; auto_saving = 0; if (stream != NULL) { @@ -5510,15 +5511,6 @@ do_auto_save_unwind (Lisp_Object arg) /* used as unwind-protect function */ fclose (stream); unblock_input (); } - return Qnil; -} - -static Lisp_Object -do_auto_save_unwind_1 (Lisp_Object value) /* used as unwind-protect function */ - -{ - minibuffer_auto_raise = XINT (value); - return Qnil; } static Lisp_Object @@ -5561,6 +5553,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) ptrdiff_t count = SPECPDL_INDEX (); bool orig_minibuffer_auto_raise = minibuffer_auto_raise; bool old_message_p = 0; + struct auto_save_unwind auto_save_unwind; struct gcpro gcpro1, gcpro2; if (max_specpdl_size < specpdl_size + 40) @@ -5572,7 +5565,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) if (NILP (no_message)) { old_message_p = push_message (); - record_unwind_protect (pop_message_unwind, Qnil); + record_unwind_protect_void (pop_message_unwind); } /* Ordinarily don't quit within this function, @@ -5611,10 +5604,9 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) stream = emacs_fopen (SSDATA (listfile), "w"); } - record_unwind_protect (do_auto_save_unwind, - make_save_pointer (stream)); - record_unwind_protect (do_auto_save_unwind_1, - make_number (minibuffer_auto_raise)); + auto_save_unwind.stream = stream; + auto_save_unwind.auto_raise = minibuffer_auto_raise; + record_unwind_protect_ptr (do_auto_save_unwind, &auto_save_unwind); minibuffer_auto_raise = 0; auto_saving = 1; auto_save_error_occurred = 0; diff --git a/src/filelock.c b/src/filelock.c index 244663ad20a..b9c991e4baf 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -257,18 +257,14 @@ void get_boot_time_1 (const char *filename, bool newest) { struct utmp ut, *utp; - int desc; if (filename) { /* On some versions of IRIX, opening a nonexistent file name is likely to crash in the utmp routines. */ - desc = emacs_open (filename, O_RDONLY, 0); - if (desc < 0) + if (faccessat (AT_FDCWD, filename, R_OK, AT_EACCESS) != 0) return; - emacs_close (desc); - utmpname (filename); } @@ -412,8 +408,6 @@ create_lock_file (char *lfname, char *lock_info_str, bool force) USE_SAFE_ALLOCA; char *nonce = SAFE_ALLOCA (lfdirlen + sizeof nonce_base); int fd; - bool need_fchmod; - mode_t world_readable = S_IRUSR | S_IRGRP | S_IROTH; memcpy (nonce, lfname, lfdirlen); strcpy (nonce + lfdirlen, nonce_base); @@ -421,17 +415,14 @@ create_lock_file (char *lfname, char *lock_info_str, bool force) /* Prefer mkostemp to mkstemp, as it avoids a window where FD is temporarily open without close-on-exec. */ fd = mkostemp (nonce, O_BINARY | O_CLOEXEC); - need_fchmod = 1; #elif HAVE_MKSTEMP /* Prefer mkstemp to mktemp, as it avoids a race between mktemp and emacs_open. */ fd = mkstemp (nonce); - need_fchmod = 1; #else mktemp (nonce); fd = emacs_open (nonce, O_WRONLY | O_CREAT | O_EXCL | O_BINARY, - world_readable); - need_fchmod = 0; + S_IRUSR | S_IWUSR); #endif if (fd < 0) @@ -439,13 +430,15 @@ create_lock_file (char *lfname, char *lock_info_str, bool force) else { ptrdiff_t lock_info_len; -#if ! HAVE_MKOSTEMP +#if ! (HAVE_MKOSTEMP && O_CLOEXEC) fcntl (fd, F_SETFD, FD_CLOEXEC); #endif lock_info_len = strlen (lock_info_str); err = 0; - if (emacs_write (fd, lock_info_str, lock_info_len) != lock_info_len - || (need_fchmod && fchmod (fd, world_readable) != 0)) + /* Use 'write', not 'emacs_write', as garbage collection + might signal an error, which would leak FD. */ + if (write (fd, lock_info_str, lock_info_len) != lock_info_len + || fchmod (fd, S_IRUSR | S_IRGRP | S_IROTH) != 0) err = errno; /* There is no need to call fsync here, as the contents of the lock file need not survive system crashes. */ @@ -517,7 +510,8 @@ read_lock_data (char *lfname, char lfinfo[MAX_LFINFO + 1]) int fd = emacs_open (lfname, O_RDONLY | O_BINARY | O_NOFOLLOW, 0); if (0 <= fd) { - ptrdiff_t read_bytes = emacs_read (fd, lfinfo, MAX_LFINFO + 1); + /* Use read, not emacs_read, since FD isn't unwind-protected. */ + ptrdiff_t read_bytes = read (fd, lfinfo, MAX_LFINFO + 1); int read_errno = errno; if (emacs_close (fd) != 0) return -1; diff --git a/src/fns.c b/src/fns.c index 49bd8470f7f..9fd0ad2a9d1 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1962,7 +1962,7 @@ The PLIST is modified by side effects. */) prev = tail; QUIT; } - newcell = Fcons (prop, Fcons (val, Qnil)); + newcell = list2 (prop, val); if (NILP (prev)) return newcell; else @@ -2455,9 +2455,8 @@ is nil, and `use-dialog-box' is non-nil. */) { Lisp_Object pane, menu, obj; redisplay_preserve_echo_area (4); - pane = Fcons (Fcons (build_string ("Yes"), Qt), - Fcons (Fcons (build_string ("No"), Qnil), - Qnil)); + pane = list2 (Fcons (build_string ("Yes"), Qt), + Fcons (build_string ("No"), Qnil)); GCPRO1 (pane); menu = Fcons (prompt, pane); obj = Fx_popup_dialog (Qt, menu, Qnil); @@ -2586,10 +2585,10 @@ particular subfeatures supported in this version of FEATURE. */) static Lisp_Object require_nesting_list; -static Lisp_Object +static void require_unwind (Lisp_Object old_value) { - return require_nesting_list = old_value; + require_nesting_list = old_value; } DEFUN ("require", Frequire, Srequire, 1, 3, 0, @@ -4915,7 +4914,7 @@ syms_of_fns (void) DEFVAR_LISP ("features", Vfeatures, doc: /* A list of symbols which are the features of the executing Emacs. Used by `featurep' and `require', and altered by `provide'. */); - Vfeatures = Fcons (intern_c_string ("emacs"), Qnil); + Vfeatures = list1 (intern_c_string ("emacs")); DEFSYM (Qsubfeatures, "subfeatures"); DEFSYM (Qfuncall, "funcall"); diff --git a/src/font.c b/src/font.c index 231df2ef71a..124d5f9bd9e 100644 --- a/src/font.c +++ b/src/font.c @@ -472,7 +472,7 @@ font_registry_charsets (Lisp_Object registry, struct charset **encoding, struct goto invalid_entry; val = Fcons (make_number (encoding_id), make_number (repertory_id)); font_charset_alist - = nconc2 (font_charset_alist, Fcons (Fcons (registry, val), Qnil)); + = nconc2 (font_charset_alist, list1 (Fcons (registry, val))); } if (encoding) @@ -483,7 +483,7 @@ font_registry_charsets (Lisp_Object registry, struct charset **encoding, struct invalid_entry: font_charset_alist - = nconc2 (font_charset_alist, Fcons (Fcons (registry, Qnil), Qnil)); + = nconc2 (font_charset_alist, list1 (Fcons (registry, Qnil))); return -1; } @@ -1453,7 +1453,7 @@ font_parse_fcname (char *name, ptrdiff_t len, Lisp_Object font) else { extra_props = nconc2 (extra_props, - Fcons (Fcons (key, val), Qnil)); + list1 (Fcons (key, val))); } } p = q; @@ -1861,7 +1861,7 @@ otf_open (Lisp_Object file) else { otf = STRINGP (file) ? OTF_open (SSDATA (file)) : NULL; - val = make_save_pointer (otf); + val = make_save_ptr (otf); otf_list = Fcons (Fcons (file, val), otf_list); } return otf; @@ -2519,7 +2519,7 @@ font_prepare_cache (FRAME_PTR f, struct font_driver *driver) val = XCDR (val); if (NILP (val)) { - val = Fcons (driver->type, Fcons (make_number (1), Qnil)); + val = list2 (driver->type, make_number (1)); XSETCDR (cache, Fcons (val, XCDR (cache))); } else @@ -3517,8 +3517,7 @@ font_update_drivers (FRAME_PTR f, Lisp_Object new_drivers) for (list = f->font_driver_list; list; list = list->next) if (list->on) - active_drivers = nconc2 (active_drivers, - Fcons (list->driver->type, Qnil)); + active_drivers = nconc2 (active_drivers, list1 (list->driver->type)); return active_drivers; } @@ -4133,7 +4132,7 @@ how close they are to PREFER. */) return Qnil; if (NILP (XCDR (list)) && ASIZE (XCAR (list)) == 1) - return Fcons (AREF (XCAR (list), 0), Qnil); + return list1 (AREF (XCAR (list), 0)); if (! NILP (prefer)) vec = font_sort_entities (list, prefer, frame, 0); diff --git a/src/fontset.c b/src/fontset.c index 2f6313c4214..6a6a434add0 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -1523,7 +1523,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */) { if (XFASTINT (target) < 0x80) error ("Can't set a font for partial ASCII range"); - range_list = Fcons (Fcons (target, target), Qnil); + range_list = list1 (Fcons (target, target)); } else if (CONSP (target)) { @@ -1539,7 +1539,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */) error ("Can't set a font for partial ASCII range"); ascii_changed = 1; } - range_list = Fcons (target, Qnil); + range_list = list1 (target); } else if (SYMBOLP (target) && !NILP (target)) { @@ -1552,7 +1552,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */) { if (EQ (target, Qlatin)) ascii_changed = 1; - val = Fcons (target, Qnil); + val = list1 (target); map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table, val); range_list = Fnreverse (XCDR (val)); @@ -1568,7 +1568,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */) SDATA (SYMBOL_NAME (target))); } else if (NILP (target)) - range_list = Fcons (Qnil, Qnil); + range_list = list1 (Qnil); else error ("Invalid target for setting a font"); @@ -1628,7 +1628,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */) if (! NILP (font_object)) { update_auto_fontset_alist (font_object, fontset); - alist = Fcons (Fcons (Qfont, Fcons (name, font_object)), Qnil); + alist = list1 (Fcons (Qfont, Fcons (name, font_object))); Fmodify_frame_parameters (fr, alist); } } @@ -1999,7 +1999,7 @@ format is the same as above. */) slot = Fassq (RFONT_DEF_SPEC (elt), alist); name = AREF (font_object, FONT_NAME_INDEX); if (NILP (Fmember (name, XCDR (slot)))) - nconc2 (slot, Fcons (name, Qnil)); + nconc2 (slot, list1 (name)); } } } @@ -2238,9 +2238,9 @@ alternate fontnames (if any) are tried instead. */); DEFVAR_LISP ("fontset-alias-alist", Vfontset_alias_alist, doc: /* Alist of fontset names vs the aliases. */); - Vfontset_alias_alist = Fcons (Fcons (FONTSET_NAME (Vdefault_fontset), - build_pure_c_string ("fontset-default")), - Qnil); + Vfontset_alias_alist + = list1 (Fcons (FONTSET_NAME (Vdefault_fontset), + build_pure_c_string ("fontset-default"))); DEFVAR_LISP ("vertical-centering-font-regexp", Vvertical_centering_font_regexp, diff --git a/src/frame.c b/src/frame.c index 648687a7cb4..5fa54052cd2 100644 --- a/src/frame.c +++ b/src/frame.c @@ -389,7 +389,7 @@ make_frame (int mini_p) etc. Running Lisp functions at this point surely ends in a SEGV. */ set_window_buffer (root_window, buf, 0, 0); - fset_buffer_list (f, Fcons (buf, Qnil)); + fset_buffer_list (f, list1 (buf)); } if (mini_p) @@ -726,15 +726,15 @@ affects all frames on the same terminal device. */) calculate_costs (f); XSETFRAME (frame, f); Fmodify_frame_parameters (frame, parms); - Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty_type, - build_string (t->display_info.tty->type)), - Qnil)); + Fmodify_frame_parameters + (frame, list1 (Fcons (Qtty_type, + build_string (t->display_info.tty->type)))); if (t->display_info.tty->name != NULL) - Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty, - build_string (t->display_info.tty->name)), - Qnil)); + Fmodify_frame_parameters + (frame, list1 (Fcons (Qtty, + build_string (t->display_info.tty->name)))); else - Fmodify_frame_parameters (frame, Fcons (Fcons (Qtty, Qnil), Qnil)); + Fmodify_frame_parameters (frame, list1 (Fcons (Qtty, Qnil))); /* Make the frame face alist be frame-specific, so that each frame could change its face definitions independently. */ @@ -887,6 +887,26 @@ This function returns FRAME, or nil if FRAME has been deleted. */) return do_switch_frame (frame, 1, 0, norecord); } +DEFUN ("handle-focus-in", Fhandle_focus_in, Shandle_focus_in, 1, 1, "e", + doc: /* Handle a focus-in event. +Focus in events are usually bound to this function. +Focus in events occur when a frame has focus, but a switch-frame event +is not generated. +This function checks if blink-cursor timers should be turned on again. */) + (Lisp_Object event) +{ + return call0 (intern ("blink-cursor-check")); +} + +DEFUN ("handle-focus-out", Fhandle_focus_out, Shandle_focus_out, 1, 1, "e", + doc: /* Handle a focus-out event. +Focus out events are usually bound to this function. +Focus out events occur when no frame has focus. +This function checks if blink-cursor timers should be turned off. */) + (Lisp_Object event) +{ + return call0 (intern ("blink-cursor-suspend")); +} DEFUN ("handle-switch-frame", Fhandle_switch_frame, Shandle_switch_frame, 1, 1, "e", doc: /* Handle a switch-frame event EVENT. @@ -902,6 +922,7 @@ to that frame. */) /* Preserve prefix arg that the command loop just cleared. */ kset_prefix_arg (current_kboard, Vcurrent_prefix_arg); Frun_hooks (1, &Qmouse_leave_buffer_hook); + Fhandle_focus_in (event); // switch-frame implies a focus in. return do_switch_frame (event, 0, 0, Qnil); } @@ -2731,7 +2752,7 @@ x_set_frame_parameters (FRAME_PTR f, Lisp_Object alist) { left_no_change = 1; if (f->left_pos < 0) - left = Fcons (Qplus, Fcons (make_number (f->left_pos), Qnil)); + left = list2 (Qplus, make_number (f->left_pos)); else XSETINT (left, f->left_pos); } @@ -2739,7 +2760,7 @@ x_set_frame_parameters (FRAME_PTR f, Lisp_Object alist) { top_no_change = 1; if (f->top_pos < 0) - top = Fcons (Qplus, Fcons (make_number (f->top_pos), Qnil)); + top = list2 (Qplus, make_number (f->top_pos)); else XSETINT (top, f->top_pos); } @@ -2874,13 +2895,13 @@ x_report_frame_params (struct frame *f, Lisp_Object *alistptr) if (f->left_pos >= 0) store_in_alist (alistptr, Qleft, tem); else - store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil))); + store_in_alist (alistptr, Qleft, list2 (Qplus, tem)); XSETINT (tem, f->top_pos); if (f->top_pos >= 0) store_in_alist (alistptr, Qtop, tem); else - store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil))); + store_in_alist (alistptr, Qtop, list2 (Qplus, tem)); store_in_alist (alistptr, Qborder_width, make_number (f->border_width)); @@ -3739,7 +3760,7 @@ x_default_parameter (struct frame *f, Lisp_Object alist, Lisp_Object prop, tem = x_frame_get_arg (f, alist, prop, xprop, xclass, type); if (EQ (tem, Qunbound)) tem = deflt; - x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil)); + x_set_frame_parameters (f, list1 (Fcons (prop, tem))); return tem; } @@ -3871,9 +3892,9 @@ On Nextstep, this just calls `ns-parse-geometry'. */) Lisp_Object element; if (x >= 0 && (geometry & XNegative)) - element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil))); + element = list3 (Qleft, Qminus, make_number (-x)); else if (x < 0 && ! (geometry & XNegative)) - element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil))); + element = list3 (Qleft, Qplus, make_number (x)); else element = Fcons (Qleft, make_number (x)); result = Fcons (element, result); @@ -3884,9 +3905,9 @@ On Nextstep, this just calls `ns-parse-geometry'. */) Lisp_Object element; if (y >= 0 && (geometry & YNegative)) - element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil))); + element = list3 (Qtop, Qminus, make_number (-y)); else if (y < 0 && ! (geometry & YNegative)) - element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil))); + element = list3 (Qtop, Qplus, make_number (y)); else element = Fcons (Qtop, make_number (y)); result = Fcons (element, result); @@ -4449,6 +4470,8 @@ automatically. See also `mouse-autoselect-window'. */); defsubr (&Swindow_system); defsubr (&Smake_terminal_frame); defsubr (&Shandle_switch_frame); + defsubr (&Shandle_focus_in); + defsubr (&Shandle_focus_out); defsubr (&Sselect_frame); defsubr (&Sselected_frame); defsubr (&Sframe_list); diff --git a/src/ftfont.c b/src/ftfont.c index 0ad173af98a..10090cb3bda 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -393,7 +393,7 @@ ftfont_lookup_cache (Lisp_Object key, enum ftfont_cache_for cache_for) cache_data = xmalloc (sizeof *cache_data); cache_data->ft_face = NULL; cache_data->fc_charset = NULL; - val = make_save_value (SAVE_TYPE_PTR_INT, cache_data, 0); + val = make_save_ptr_int (cache_data, 0); cache = Fcons (Qnil, val); Fputhash (key, cache, ft_face_cache); } @@ -2703,13 +2703,12 @@ syms_of_ftfont (void) DEFSYM (Qsans__serif, "sans serif"); staticpro (&freetype_font_cache); - freetype_font_cache = Fcons (Qt, Qnil); + freetype_font_cache = list1 (Qt); staticpro (&ftfont_generic_family_list); - ftfont_generic_family_list - = Fcons (Fcons (Qmonospace, Qt), - Fcons (Fcons (Qsans_serif, Qt), - Fcons (Fcons (Qsans, Qt), Qnil))); + ftfont_generic_family_list = list3 (Fcons (Qmonospace, Qt), + Fcons (Qsans_serif, Qt), + Fcons (Qsans, Qt)); staticpro (&ft_face_cache); ft_face_cache = Qnil; diff --git a/src/gfilenotify.c b/src/gfilenotify.c index 4e684d1fb54..8f13c72df81 100644 --- a/src/gfilenotify.c +++ b/src/gfilenotify.c @@ -173,7 +173,7 @@ will be reported only in case of the 'moved' event. */) CHECK_STRING (file); file = Fdirectory_file_name (Fexpand_file_name (file, Qnil)); if (NILP (Ffile_exists_p (file))) - report_file_error ("File does not exists", Fcons (file, Qnil)); + report_file_error ("File does not exist", file); CHECK_LIST (flags); diff --git a/src/gtkutil.c b/src/gtkutil.c index 8ac58f18158..f8ddf6a90f6 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -1650,10 +1650,10 @@ xg_dialog_response_cb (GtkDialog *w, /* Destroy the dialog. This makes it pop down. */ -static Lisp_Object -pop_down_dialog (Lisp_Object arg) +static void +pop_down_dialog (void *arg) { - struct xg_dialog_data *dd = XSAVE_POINTER (arg, 0); + struct xg_dialog_data *dd = arg; block_input (); if (dd->w) gtk_widget_destroy (dd->w); @@ -1663,8 +1663,6 @@ pop_down_dialog (Lisp_Object arg) g_main_loop_unref (dd->loop); unblock_input (); - - return Qnil; } /* If there are any emacs timers pending, add a timeout to main loop in DATA. @@ -1719,7 +1717,7 @@ xg_dialog_run (FRAME_PTR f, GtkWidget *w) g_signal_connect (G_OBJECT (w), "delete-event", G_CALLBACK (gtk_true), NULL); gtk_widget_show (w); - record_unwind_protect (pop_down_dialog, make_save_pointer (&dd)); + record_unwind_protect_ptr (pop_down_dialog, &dd); (void) xg_maybe_add_timer (&dd); g_main_loop_run (dd.loop); diff --git a/src/image.c b/src/image.c index c085e6e63eb..1f8cb520dca 100644 --- a/src/image.c +++ b/src/image.c @@ -1569,7 +1569,7 @@ which is then usually a filename. */) DEFUN ("image-flush", Fimage_flush, Simage_flush, 1, 2, 0, - doc: /* Fush the image with specification SPEC on frame FRAME. + doc: /* Flush the image with specification SPEC on frame FRAME. This removes the image from the Emacs image cache. If SPEC specifies an image file, the next redisplay of this image will read from the current contents of that file. @@ -2276,23 +2276,28 @@ slurp_file (char *file, ptrdiff_t *size) unsigned char *buf = NULL; struct stat st; - if (fp && fstat (fileno (fp), &st) == 0 - && 0 <= st.st_size && st.st_size <= min (PTRDIFF_MAX, SIZE_MAX) - && (buf = xmalloc (st.st_size), - fread (buf, 1, st.st_size, fp) == st.st_size)) - { - *size = st.st_size; - fclose (fp); - } - else + if (fp) { - if (fp) - fclose (fp); - if (buf) + ptrdiff_t count = SPECPDL_INDEX (); + record_unwind_protect_ptr (fclose_unwind, fp); + + if (fstat (fileno (fp), &st) == 0 + && 0 <= st.st_size && st.st_size < min (PTRDIFF_MAX, SIZE_MAX)) { - xfree (buf); - buf = NULL; + /* Report an error if we read past the purported EOF. + This can happen if the file grows as we read it. */ + ptrdiff_t buflen = st.st_size; + buf = xmalloc (buflen + 1); + if (fread (buf, 1, buflen + 1, fp) == buflen) + *size = buflen; + else + { + xfree (buf); + buf = NULL; + } } + + unbind_to (count, Qnil); } return buf; @@ -5732,8 +5737,8 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c) if (fread (sig, 1, sizeof sig, fp) != sizeof sig || fn_png_sig_cmp (sig, 0, sizeof sig)) { - image_error ("Not a PNG file: `%s'", file, Qnil); fclose (fp); + image_error ("Not a PNG file: `%s'", file, Qnil); return 0; } } @@ -7581,8 +7586,7 @@ gif_load (struct frame *f, struct image *img) delay |= ext->Bytes[1]; } } - img->lisp_data = Fcons (Qextension_data, - Fcons (img->lisp_data, Qnil)); + img->lisp_data = list2 (Qextension_data, img->lisp_data); if (delay) img->lisp_data = Fcons (Qdelay, diff --git a/src/insdel.c b/src/insdel.c index ed684264249..15d585568a0 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -1913,12 +1913,18 @@ prepare_to_modify_buffer (ptrdiff_t start, ptrdiff_t end, VARIABLE is the variable to maybe set to nil. NO-ERROR-FLAG is nil if there was an error, anything else meaning no error (so this function does nothing). */ -static Lisp_Object -reset_var_on_error (Lisp_Object val) +struct rvoe_arg { - if (NILP (XCDR (val))) - Fset (XCAR (val), Qnil); - return Qnil; + Lisp_Object *location; + bool errorp; +}; + +static void +reset_var_on_error (void *ptr) +{ + struct rvoe_arg *p = ptr; + if (p->errorp) + *p->location = Qnil; } /* Signal a change to the buffer immediately before it happens. @@ -1936,6 +1942,7 @@ signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int, Lisp_Object preserve_marker; struct gcpro gcpro1, gcpro2, gcpro3; ptrdiff_t count = SPECPDL_INDEX (); + struct rvoe_arg rvoe_arg; if (inhibit_modification_hooks) return; @@ -1963,13 +1970,14 @@ signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int, if (!NILP (Vbefore_change_functions)) { Lisp_Object args[3]; - Lisp_Object rvoe_arg = Fcons (Qbefore_change_functions, Qnil); + rvoe_arg.location = &Vbefore_change_functions; + rvoe_arg.errorp = 1; PRESERVE_VALUE; PRESERVE_START_END; /* Mark before-change-functions to be reset to nil in case of error. */ - record_unwind_protect (reset_var_on_error, rvoe_arg); + record_unwind_protect_ptr (reset_var_on_error, &rvoe_arg); /* Actually run the hook functions. */ args[0] = Qbefore_change_functions; @@ -1978,7 +1986,7 @@ signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int, Frun_hook_with_args (3, args); /* There was no error: unarm the reset_on_error. */ - XSETCDR (rvoe_arg, Qt); + rvoe_arg.errorp = 0; } if (buffer_has_overlays ()) @@ -2009,6 +2017,8 @@ void signal_after_change (ptrdiff_t charpos, ptrdiff_t lendel, ptrdiff_t lenins) { ptrdiff_t count = SPECPDL_INDEX (); + struct rvoe_arg rvoe_arg; + if (inhibit_modification_hooks) return; @@ -2042,10 +2052,11 @@ signal_after_change (ptrdiff_t charpos, ptrdiff_t lendel, ptrdiff_t lenins) if (!NILP (Vafter_change_functions)) { Lisp_Object args[4]; - Lisp_Object rvoe_arg = Fcons (Qafter_change_functions, Qnil); + rvoe_arg.location = &Vafter_change_functions; + rvoe_arg.errorp = 1; /* Mark after-change-functions to be reset to nil in case of error. */ - record_unwind_protect (reset_var_on_error, rvoe_arg); + record_unwind_protect_ptr (reset_var_on_error, &rvoe_arg); /* Actually run the hook functions. */ args[0] = Qafter_change_functions; @@ -2055,7 +2066,7 @@ signal_after_change (ptrdiff_t charpos, ptrdiff_t lendel, ptrdiff_t lenins) Frun_hook_with_args (4, args); /* There was no error: unarm the reset_on_error. */ - XSETCDR (rvoe_arg, Qt); + rvoe_arg.errorp = 0; } if (buffer_has_overlays ()) @@ -2075,11 +2086,10 @@ signal_after_change (ptrdiff_t charpos, ptrdiff_t lendel, ptrdiff_t lenins) unbind_to (count, Qnil); } -static Lisp_Object +static void Fcombine_after_change_execute_1 (Lisp_Object val) { Vcombine_after_change_calls = val; - return val; } DEFUN ("combine-after-change-execute", Fcombine_after_change_execute, diff --git a/src/keyboard.c b/src/keyboard.c index b6eb9e6ad15..830f70bc1f5 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -295,6 +295,7 @@ static struct input_event * volatile kbd_store_ptr; static Lisp_Object Qmouse_movement; static Lisp_Object Qscroll_bar_movement; Lisp_Object Qswitch_frame; +static Lisp_Object Qfocus_in, Qfocus_out; static Lisp_Object Qdelete_frame; static Lisp_Object Qiconify_frame; static Lisp_Object Qmake_frame_visible; @@ -356,7 +357,7 @@ Lisp_Object Qvertical_line; static Lisp_Object Qvertical_scroll_bar; Lisp_Object Qmenu_bar; -static Lisp_Object recursive_edit_unwind (Lisp_Object buffer); +static void recursive_edit_unwind (Lisp_Object buffer); static Lisp_Object command_loop (void); static Lisp_Object Qcommand_execute; EMACS_TIME timer_check (void); @@ -420,12 +421,14 @@ static Lisp_Object modify_event_symbol (ptrdiff_t, int, Lisp_Object, Lisp_Object, const char *const *, Lisp_Object *, ptrdiff_t); static Lisp_Object make_lispy_switch_frame (Lisp_Object); +static Lisp_Object make_lispy_focus_in (Lisp_Object); +static Lisp_Object make_lispy_focus_out (Lisp_Object); static bool help_char_p (Lisp_Object); static void save_getcjmp (sys_jmp_buf); static void restore_getcjmp (sys_jmp_buf); static Lisp_Object apply_modifiers (int, Lisp_Object); static void clear_event (struct input_event *); -static Lisp_Object restore_kboard_configuration (Lisp_Object); +static void restore_kboard_configuration (int); #ifdef USABLE_SIGIO static void deliver_input_available_signal (int signo); #endif @@ -841,7 +844,7 @@ This function is called by the editor initialization to begin editing. */) return unbind_to (count, Qnil); } -Lisp_Object +void recursive_edit_unwind (Lisp_Object buffer) { if (BUFFERP (buffer)) @@ -849,7 +852,6 @@ recursive_edit_unwind (Lisp_Object buffer) command_loop_level--; update_mode_lines = 1; - return Qnil; } @@ -946,7 +948,7 @@ pop_kboard (void) from which further input is accepted. If F is non-nil, set its KBOARD as the current keyboard. - This function uses record_unwind_protect to return to the previous + This function uses record_unwind_protect_int to return to the previous state later. If Emacs is already in single_kboard mode, and F's keyboard is @@ -977,8 +979,7 @@ temporarily_switch_to_single_kboard (struct frame *f) else if (f != NULL) current_kboard = FRAME_KBOARD (f); single_kboard = 1; - record_unwind_protect (restore_kboard_configuration, - (was_locked ? Qt : Qnil)); + record_unwind_protect_int (restore_kboard_configuration, was_locked); } #if 0 /* This function is not needed anymore. */ @@ -987,26 +988,22 @@ record_single_kboard_state () { if (single_kboard) push_kboard (current_kboard); - record_unwind_protect (restore_kboard_configuration, - (single_kboard ? Qt : Qnil)); + record_unwind_protect_int (restore_kboard_configuration, single_kboard); } #endif -static Lisp_Object -restore_kboard_configuration (Lisp_Object was_locked) +static void +restore_kboard_configuration (int was_locked) { - if (NILP (was_locked)) - single_kboard = 0; - else + single_kboard = was_locked; + if (was_locked) { struct kboard *prev = current_kboard; - single_kboard = 1; pop_kboard (); /* The pop should not change the kboard. */ if (single_kboard && current_kboard != prev) emacs_abort (); } - return Qnil; } @@ -1234,7 +1231,7 @@ DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, /* Restore mouse tracking enablement. See Ftrack_mouse for the only use of this function. */ -static Lisp_Object +static void tracking_off (Lisp_Object old_value) { do_mouse_tracking = old_value; @@ -1251,7 +1248,6 @@ tracking_off (Lisp_Object old_value) get_input_pending (READABLE_EVENTS_DO_TIMERS_NOW); } } - return Qnil; } DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0, @@ -1314,17 +1310,6 @@ static int read_key_sequence (Lisp_Object *, int, Lisp_Object, void safe_run_hooks (Lisp_Object); static void adjust_point_for_property (ptrdiff_t, bool); -/* Cancel hourglass from protect_unwind. - ARG is not used. */ -#ifdef HAVE_WINDOW_SYSTEM -static Lisp_Object -cancel_hourglass_unwind (Lisp_Object arg) -{ - cancel_hourglass (); - return Qnil; -} -#endif - /* The last boundary auto-added to buffer-undo-list. */ Lisp_Object last_undo_boundary; @@ -1427,7 +1412,7 @@ command_loop_1 (void) if (!NILP (Vquit_flag)) { Vquit_flag = Qnil; - Vunread_command_events = Fcons (make_number (quit_char), Qnil); + Vunread_command_events = list1 (make_number (quit_char)); } } @@ -1559,7 +1544,7 @@ command_loop_1 (void) if (display_hourglass_p && NILP (Vexecuting_kbd_macro)) { - record_unwind_protect (cancel_hourglass_unwind, Qnil); + record_unwind_protect_void (cancel_hourglass); start_hourglass (); } #endif @@ -2201,14 +2186,13 @@ static Lisp_Object kbd_buffer_get_event (KBOARD **kbp, bool *used_mouse_menu, static void record_char (Lisp_Object c); static Lisp_Object help_form_saved_window_configs; -static Lisp_Object -read_char_help_form_unwind (Lisp_Object arg) +static void +read_char_help_form_unwind (void) { Lisp_Object window_config = XCAR (help_form_saved_window_configs); help_form_saved_window_configs = XCDR (help_form_saved_window_configs); if (!NILP (window_config)) Fset_window_configuration (window_config); - return Qnil; } #define STOP_POLLING \ @@ -2255,9 +2239,9 @@ read_event_from_main_queue (EMACS_TIME *end_time, emacs_abort (); } if (!CONSP (last)) - kset_kbd_queue (kb, Fcons (c, Qnil)); + kset_kbd_queue (kb, list1 (c)); else - XSETCDR (last, Fcons (c, Qnil)); + XSETCDR (last, list1 (c)); kb->kbd_queue_has_data = 1; c = Qnil; if (single_kboard) @@ -2679,9 +2663,9 @@ read_char (int commandflag, Lisp_Object map, emacs_abort (); } if (!CONSP (last)) - kset_kbd_queue (kb, Fcons (c, Qnil)); + kset_kbd_queue (kb, list1 (c)); else - XSETCDR (last, Fcons (c, Qnil)); + XSETCDR (last, list1 (c)); kb->kbd_queue_has_data = 1; current_kboard = kb; /* This is going to exit from read_char @@ -2999,7 +2983,7 @@ read_char (int commandflag, Lisp_Object map, if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar)) { /* Change menu-bar to (menu-bar) as the event "position". */ - POSN_SET_POSN (EVENT_START (c), Fcons (posn, Qnil)); + POSN_SET_POSN (EVENT_START (c), list1 (posn)); also_record = c; Vunread_command_events = Fcons (c, Vunread_command_events); @@ -3196,7 +3180,7 @@ read_char (int commandflag, Lisp_Object map, help_form_saved_window_configs = Fcons (Fcurrent_window_configuration (Qnil), help_form_saved_window_configs); - record_unwind_protect (read_char_help_form_unwind, Qnil); + record_unwind_protect_void (read_char_help_form_unwind); call0 (Qhelp_form_show); cancel_echoing (); @@ -3582,8 +3566,8 @@ kbd_buffer_store_event_hold (register struct input_event *event, if (single_kboard && kb != current_kboard) { kset_kbd_queue - (kb, Fcons (make_lispy_switch_frame (event->frame_or_window), - Fcons (make_number (c), Qnil))); + (kb, list2 (make_lispy_switch_frame (event->frame_or_window), + make_number (c))); kb->kbd_queue_has_data = 1; for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++) { @@ -3946,9 +3930,9 @@ kbd_buffer_get_event (KBOARD **kbp, else if (event->kind == NS_TEXT_EVENT) { if (event->code == KEY_NS_PUT_WORKING_TEXT) - obj = Fcons (intern ("ns-put-working-text"), Qnil); + obj = list1 (intern ("ns-put-working-text")); else - obj = Fcons (intern ("ns-unput-working-text"), Qnil); + obj = list1 (intern ("ns-unput-working-text")); kbd_fetch_ptr = event + 1; if (used_mouse_menu) *used_mouse_menu = 1; @@ -3960,8 +3944,7 @@ kbd_buffer_get_event (KBOARD **kbp, else if (event->kind == DELETE_WINDOW_EVENT) { /* Make an event (delete-frame (FRAME)). */ - obj = Fcons (event->frame_or_window, Qnil); - obj = Fcons (Qdelete_frame, Fcons (obj, Qnil)); + obj = list2 (Qdelete_frame, list1 (event->frame_or_window)); kbd_fetch_ptr = event + 1; } #endif @@ -3970,15 +3953,13 @@ kbd_buffer_get_event (KBOARD **kbp, else if (event->kind == ICONIFY_EVENT) { /* Make an event (iconify-frame (FRAME)). */ - obj = Fcons (event->frame_or_window, Qnil); - obj = Fcons (Qiconify_frame, Fcons (obj, Qnil)); + obj = list2 (Qiconify_frame, list1 (event->frame_or_window)); kbd_fetch_ptr = event + 1; } else if (event->kind == DEICONIFY_EVENT) { /* Make an event (make-frame-visible (FRAME)). */ - obj = Fcons (event->frame_or_window, Qnil); - obj = Fcons (Qmake_frame_visible, Fcons (obj, Qnil)); + obj = list2 (Qmake_frame_visible, list1 (event->frame_or_window)); kbd_fetch_ptr = event + 1; } #endif @@ -4001,11 +3982,11 @@ kbd_buffer_get_event (KBOARD **kbp, #ifdef HAVE_NTGUI else if (event->kind == LANGUAGE_CHANGE_EVENT) { - /* Make an event (language-change (FRAME CODEPAGE LANGUAGE-ID)). */ - obj = Fcons (Qlanguage_change, - list3 (event->frame_or_window, - make_number (event->code), - make_number (event->modifiers))); + /* Make an event (language-change FRAME CODEPAGE LANGUAGE-ID). */ + obj = list4 (Qlanguage_change, + event->frame_or_window, + make_number (event->code), + make_number (event->modifiers)); kbd_fetch_ptr = event + 1; } #endif @@ -4014,11 +3995,11 @@ kbd_buffer_get_event (KBOARD **kbp, { #ifdef HAVE_W32NOTIFY /* Make an event (file-notify (DESCRIPTOR ACTION FILE) CALLBACK). */ - obj = Fcons (Qfile_notify, - list2 (list3 (make_number (event->code), - XCAR (event->arg), - XCDR (event->arg)), - event->frame_or_window)); + obj = list3 (Qfile_notify, + list3 (make_number (event->code), + XCAR (event->arg), + XCDR (event->arg)), + event->frame_or_window); #else obj = make_lispy_event (event); #endif @@ -4027,7 +4008,7 @@ kbd_buffer_get_event (KBOARD **kbp, #endif /* USE_FILE_NOTIFY */ else if (event->kind == SAVE_SESSION_EVENT) { - obj = Fcons (Qsave_session, Fcons (event->arg, Qnil)); + obj = list2 (Qsave_session, event->arg); kbd_fetch_ptr = event + 1; } /* Just discard these, by returning nil. @@ -4064,17 +4045,43 @@ kbd_buffer_get_event (KBOARD **kbp, switch-frame event if necessary. */ Lisp_Object frame, focus; - frame = event->frame_or_window; - focus = FRAME_FOCUS_FRAME (XFRAME (frame)); - if (FRAMEP (focus)) - frame = focus; + frame = event->frame_or_window; + focus = FRAME_FOCUS_FRAME (XFRAME (frame)); + if (FRAMEP (focus)) + frame = focus; - if (!EQ (frame, internal_last_event_frame) - && !EQ (frame, selected_frame)) - obj = make_lispy_switch_frame (frame); - internal_last_event_frame = frame; - kbd_fetch_ptr = event + 1; - } + if ( +#ifdef HAVE_X11 + ! NILP (event->arg) + && +#endif + !EQ (frame, internal_last_event_frame) + && !EQ (frame, selected_frame)) + obj = make_lispy_switch_frame (frame); + else + obj = make_lispy_focus_in (frame); + + internal_last_event_frame = frame; + kbd_fetch_ptr = event + 1; + } + else if (event->kind == FOCUS_OUT_EVENT) + { +#ifdef HAVE_WINDOW_SYSTEM + + Display_Info *di; + Lisp_Object frame = event->frame_or_window; + bool focused = false; + + for (di = x_display_list; di && ! focused; di = di->next) + focused = di->x_highlight_frame != 0; + + if (!focused) + obj = make_lispy_focus_out (frame); + +#endif /* HAVE_WINDOW_SYSTEM */ + + kbd_fetch_ptr = event + 1; + } #ifdef HAVE_DBUS else if (event->kind == DBUS_EVENT) { @@ -5555,14 +5562,12 @@ make_lispy_event (struct input_event *event) /* ELisp manual 2.4b says (x y) are window relative but code says they are frame-relative. */ - position - = Fcons (event->frame_or_window, - Fcons (Qmenu_bar, - Fcons (Fcons (event->x, event->y), - Fcons (make_number (event->timestamp), - Qnil)))); - - return Fcons (item, Fcons (position, Qnil)); + position = list4 (event->frame_or_window, + Qmenu_bar, + Fcons (event->x, event->y), + make_number (event->timestamp)); + + return list2 (item, position); } #endif /* not USE_X_TOOLKIT && not USE_GTK && not HAVE_NS */ @@ -5581,12 +5586,9 @@ make_lispy_event (struct input_event *event) portion_whole = Fcons (event->x, event->y); part = *scroll_bar_parts[(int) event->part]; - position - = Fcons (window, - Fcons (Qvertical_scroll_bar, - Fcons (portion_whole, - Fcons (make_number (event->timestamp), - Fcons (part, Qnil))))); + position = list5 (window, Qvertical_scroll_bar, + portion_whole, make_number (event->timestamp), + part); } #endif /* not USE_TOOLKIT_SCROLL_BARS */ @@ -5734,19 +5736,11 @@ make_lispy_event (struct input_event *event) &mouse_syms, ASIZE (mouse_syms)); if (event->modifiers & drag_modifier) - return Fcons (head, - Fcons (start_pos, - Fcons (position, - Qnil))); + return list3 (head, start_pos, position); else if (event->modifiers & (double_modifier | triple_modifier)) - return Fcons (head, - Fcons (position, - Fcons (make_number (double_click_count), - Qnil))); + return list3 (head, position, make_number (double_click_count)); else - return Fcons (head, - Fcons (position, - Qnil)); + return list2 (head, position); } } @@ -5845,14 +5839,9 @@ make_lispy_event (struct input_event *event) } if (event->modifiers & (double_modifier | triple_modifier)) - return Fcons (head, - Fcons (position, - Fcons (make_number (double_click_count), - Qnil))); + return list3 (head, position, make_number (double_click_count)); else - return Fcons (head, - Fcons (position, - Qnil)); + return list2 (head, position); } @@ -5883,12 +5872,8 @@ make_lispy_event (struct input_event *event) portion_whole = Fcons (event->x, event->y); part = *scroll_bar_parts[(int) event->part]; - position - = Fcons (window, - Fcons (Qvertical_scroll_bar, - Fcons (portion_whole, - Fcons (make_number (event->timestamp), - Fcons (part, Qnil))))); + position = list5 (window, Qvertical_scroll_bar, portion_whole, + make_number (event->timestamp), part); /* Always treat scroll bar events as clicks. */ event->modifiers |= click_modifier; @@ -5906,7 +5891,7 @@ make_lispy_event (struct input_event *event) Vlispy_mouse_stem, NULL, &mouse_syms, ASIZE (mouse_syms)); - return Fcons (head, Fcons (position, Qnil)); + return list2 (head, position); } #endif /* USE_TOOLKIT_SCROLL_BARS */ @@ -5932,10 +5917,7 @@ make_lispy_event (struct input_event *event) Qdrag_n_drop, Qnil, lispy_drag_n_drop_names, &drag_n_drop_syms, 1); - return Fcons (head, - Fcons (position, - Fcons (files, - Qnil))); + return list3 (head, position, files); } #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \ @@ -5945,22 +5927,20 @@ make_lispy_event (struct input_event *event) /* This is the prefix key. We translate this to `(menu_bar)' because the code in keyboard.c for menu events, which we use, relies on this. */ - return Fcons (Qmenu_bar, Qnil); + return list1 (Qmenu_bar); return event->arg; #endif case SELECT_WINDOW_EVENT: /* Make an event (select-window (WINDOW)). */ - return Fcons (Qselect_window, - Fcons (Fcons (event->frame_or_window, Qnil), - Qnil)); + return list2 (Qselect_window, list1 (event->frame_or_window)); case TOOL_BAR_EVENT: if (EQ (event->arg, event->frame_or_window)) /* This is the prefix key. We translate this to `(tool_bar)' because the code in keyboard.c for tool bar events, which we use, relies on this. */ - return Fcons (Qtool_bar, Qnil); + return list1 (Qtool_bar); else if (SYMBOLP (event->arg)) return apply_modifiers (event->modifiers, event->arg); return event->arg; @@ -5992,9 +5972,8 @@ make_lispy_event (struct input_event *event) #endif /* defined HAVE_GFILENOTIFY || defined HAVE_INOTIFY */ case CONFIG_CHANGED_EVENT: - return Fcons (Qconfig_changed_event, - Fcons (event->arg, - Fcons (event->frame_or_window, Qnil))); + return list3 (Qconfig_changed_event, + event->arg, event->frame_or_window); #ifdef HAVE_GPM case GPM_CLICK_EVENT: { @@ -6035,24 +6014,13 @@ make_lispy_event (struct input_event *event) ASIZE (mouse_syms)); if (event->modifiers & drag_modifier) - return Fcons (head, - Fcons (start_pos, - Fcons (position, - Qnil))); + return list3 (head, start_pos, position); else if (event->modifiers & double_modifier) - return Fcons (head, - Fcons (position, - Fcons (make_number (2), - Qnil))); + return list3 (head, position, make_number (2)); else if (event->modifiers & triple_modifier) - return Fcons (head, - Fcons (position, - Fcons (make_number (3), - Qnil))); + return list3 (head, position, make_number (3)); else - return Fcons (head, - Fcons (position, - Qnil)); + return list2 (head, position); } #endif /* HAVE_GPM */ @@ -6072,13 +6040,12 @@ make_lispy_movement (FRAME_PTR frame, Lisp_Object bar_window, enum scroll_bar_pa Lisp_Object part_sym; part_sym = *scroll_bar_parts[(int) part]; - return Fcons (Qscroll_bar_movement, - Fcons (list5 (bar_window, - Qvertical_scroll_bar, - Fcons (x, y), - make_number (t), - part_sym), - Qnil)); + return list2 (Qscroll_bar_movement, + list5 (bar_window, + Qvertical_scroll_bar, + Fcons (x, y), + make_number (t), + part_sym)); } /* Or is it an ordinary mouse movement? */ else @@ -6093,7 +6060,18 @@ make_lispy_movement (FRAME_PTR frame, Lisp_Object bar_window, enum scroll_bar_pa static Lisp_Object make_lispy_switch_frame (Lisp_Object frame) { - return Fcons (Qswitch_frame, Fcons (frame, Qnil)); + return list2 (Qswitch_frame, frame); +} + +static Lisp_Object +make_lispy_focus_in (Lisp_Object frame) +{ + return list2 (Qfocus_in, frame); +} +static Lisp_Object +make_lispy_focus_out (Lisp_Object frame) +{ + return list2 (Qfocus_out, frame); } /* Manipulating modifiers. */ @@ -6326,7 +6304,7 @@ parse_modifiers (Lisp_Object symbol) if (modifiers & ~INTMASK) emacs_abort (); XSETFASTINT (mask, modifiers); - elements = Fcons (unmodified, Fcons (mask, Qnil)); + elements = list2 (unmodified, mask); /* Cache the parsing results on SYMBOL. */ Fput (symbol, Qevent_symbol_element_mask, @@ -6399,7 +6377,7 @@ apply_modifiers (int modifiers, Lisp_Object base) the caches: XSETFASTINT (idx, modifiers); Fput (new_symbol, Qevent_symbol_element_mask, - Fcons (base, Fcons (idx, Qnil))); + list2 (base, idx)); Fput (new_symbol, Qevent_symbol_elements, Fcons (base, lispy_modifier_list (modifiers))); Sadly, this is only correct if `base' is indeed a base event, @@ -7551,7 +7529,7 @@ menu_bar_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy1, void *dumm ASET (menu_bar_items_vector, i, key); i++; ASET (menu_bar_items_vector, i, AREF (item_properties, ITEM_PROPERTY_NAME)); i++; - ASET (menu_bar_items_vector, i, Fcons (item, Qnil)); i++; + ASET (menu_bar_items_vector, i, list1 (item)); i++; ASET (menu_bar_items_vector, i, make_number (0)); i++; menu_bar_items_index = i; } @@ -8106,7 +8084,7 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item) /* As an exception, allow old-style menu separators. */ if (STRINGP (XCAR (item))) - item = Fcons (XCAR (item), Qnil); + item = list1 (XCAR (item)); else if (!EQ (XCAR (item), Qmenu_item) || (item = XCDR (item), !CONSP (item))) return 0; @@ -9338,8 +9316,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, /* Zap the position in key, so we know that we've expanded it, and don't try to do so again. */ - POSN_SET_POSN (EVENT_START (key), - Fcons (posn, Qnil)); + POSN_SET_POSN (EVENT_START (key), list1 (posn)); mock_input = t + 2; goto replay_sequence; @@ -9494,8 +9471,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, new_head = apply_modifiers (modifiers, XCAR (breakdown)); - new_click - = Fcons (new_head, Fcons (EVENT_START (key), Qnil)); + new_click = list2 (new_head, EVENT_START (key)); /* Look for a binding for this new key. */ new_binding = follow_key (current_binding, new_click); @@ -10131,7 +10107,7 @@ The file will be closed when Emacs exits. */) file = Fexpand_file_name (file, Qnil); dribble = emacs_fopen (SSDATA (file), "w"); if (dribble == 0) - report_file_error ("Opening dribble", Fcons (file, Qnil)); + report_file_error ("Opening dribble", file); } return Qnil; } @@ -10196,8 +10172,7 @@ On such systems, Emacs starts a subshell instead of suspending. */) reset_all_sys_modes (); /* sys_suspend can get an error if it tries to fork a subshell and the system resources aren't available for that. */ - record_unwind_protect ((Lisp_Object (*) (Lisp_Object)) init_all_sys_modes, - Qnil); + record_unwind_protect_void (init_all_sys_modes); stuff_buffered_input (stuffstring); if (cannot_suspend) sys_subshell (); @@ -10956,6 +10931,8 @@ static const struct event_head head_table[] = { {&Qmouse_movement, "mouse-movement", &Qmouse_movement}, {&Qscroll_bar_movement, "scroll-bar-movement", &Qmouse_movement}, {&Qswitch_frame, "switch-frame", &Qswitch_frame}, + {&Qfocus_in, "focus-in", &Qfocus_in}, + {&Qfocus_out, "focus-out", &Qfocus_out}, {&Qdelete_frame, "delete-frame", &Qdelete_frame}, {&Qiconify_frame, "iconify-frame", &Qiconify_frame}, {&Qmake_frame_visible, "make-frame-visible", &Qmake_frame_visible}, @@ -11079,7 +11056,7 @@ syms_of_keyboard (void) *p->var = intern_c_string (p->name); staticpro (p->var); Fput (*p->var, Qevent_kind, *p->kind); - Fput (*p->var, Qevent_symbol_elements, Fcons (*p->var, Qnil)); + Fput (*p->var, Qevent_symbol_elements, list1 (*p->var)); } } @@ -11474,7 +11451,7 @@ and the minor mode maps regardless of `overriding-local-map'. */); DEFVAR_LISP ("special-event-map", Vspecial_event_map, doc: /* Keymap defining bindings for special events to execute at low level. */); - Vspecial_event_map = Fcons (intern_c_string ("keymap"), Qnil); + Vspecial_event_map = list1 (intern_c_string ("keymap")); DEFVAR_LISP ("track-mouse", do_mouse_tracking, doc: /* Non-nil means generate motion events for mouse motion. */); @@ -11770,6 +11747,10 @@ keys_of_keyboard (void) initial_define_lispy_key (Vspecial_event_map, "language-change", "ignore"); #endif + initial_define_lispy_key (Vspecial_event_map, "focus-in", + "handle-focus-in"); + initial_define_lispy_key (Vspecial_event_map, "focus-out", + "handle-focus-out"); } /* Mark the pointers in the kboard objects. diff --git a/src/keyboard.h b/src/keyboard.h index 8bb1c409efc..daba94898d8 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -341,7 +341,7 @@ enum menu_item_idx MENU_ITEMS_ITEM_LENGTH }; -extern Lisp_Object unuse_menu_items (Lisp_Object dummy); +extern void unuse_menu_items (void); /* This is how to deal with multibyte text if HAVE_MULTILINGUAL_MENU isn't defined. The use of HAVE_MULTILINGUAL_MENU could probably be diff --git a/src/keymap.c b/src/keymap.c index d29d5636e1c..d13a6274347 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -129,7 +129,7 @@ in case you use it as a menu with `x-popup-menu'. */) { Lisp_Object tail; if (!NILP (string)) - tail = Fcons (string, Qnil); + tail = list1 (string); else tail = Qnil; return Fcons (Qkeymap, @@ -151,9 +151,9 @@ in case you use it as a menu with `x-popup-menu'. */) { if (!NILP (Vpurify_flag)) string = Fpurecopy (string); - return Fcons (Qkeymap, Fcons (string, Qnil)); + return list2 (Qkeymap, string); } - return Fcons (Qkeymap, Qnil); + return list1 (Qkeymap); } /* This function is used for installing the standard key bindings @@ -534,12 +534,12 @@ access_keymap_1 (Lisp_Object map, Lisp_Object idx, retval = val; else if (CONSP (retval_tail)) { - XSETCDR (retval_tail, Fcons (val, Qnil)); + XSETCDR (retval_tail, list1 (val)); retval_tail = XCDR (retval_tail); } else { - retval_tail = Fcons (val, Qnil); + retval_tail = list1 (val); retval = Fcons (Qkeymap, Fcons (retval, retval_tail)); } } @@ -617,8 +617,8 @@ map_keymap_internal (Lisp_Object map, } else if (CHAR_TABLE_P (binding)) map_char_table (map_keymap_char_table_item, Qnil, binding, - make_save_value (SAVE_TYPE_FUNCPTR_PTR_OBJ, - (voidfuncptr) fun, data, args)); + make_save_funcptr_ptr_obj ((voidfuncptr) fun, data, + args)); } UNGCPRO; return tail; @@ -1045,9 +1045,9 @@ However, a key definition which is a symbol whose definition is a keymap is not copied. */) (Lisp_Object keymap) { - register Lisp_Object copy, tail; + Lisp_Object copy, tail; keymap = get_keymap (keymap, 1, 0); - copy = tail = Fcons (Qkeymap, Qnil); + copy = tail = list1 (Qkeymap); keymap = XCDR (keymap); /* Skip the `keymap' symbol. */ while (CONSP (keymap) && !EQ (XCAR (keymap), Qkeymap)) @@ -1073,7 +1073,7 @@ is not copied. */) else elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt))); } - XSETCDR (tail, Fcons (elt, Qnil)); + XSETCDR (tail, list1 (elt)); tail = XCDR (tail); keymap = XCDR (keymap); } @@ -1341,8 +1341,7 @@ append_key (Lisp_Object key_sequence, Lisp_Object key) Lisp_Object args[2]; args[0] = key_sequence; - - args[1] = Fcons (key, Qnil); + args[1] = list1 (key); return Fvconcat (2, args); } @@ -1549,7 +1548,7 @@ like in the respective argument of `key-binding'. */) { ptrdiff_t count = SPECPDL_INDEX (); - Lisp_Object keymaps = Fcons (current_global_map, Qnil); + Lisp_Object keymaps = list1 (current_global_map); /* If a mouse click position is given, our variables are based on the buffer clicked on, not the current buffer. So we may have to @@ -1809,7 +1808,7 @@ bindings; see the description of `lookup-key' for more details about this. */) if (KEYMAPP (binding)) maps[j++] = Fcons (modes[i], binding); else if (j == 0) - RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil)); + RETURN_UNGCPRO (list1 (Fcons (modes[i], binding))); } UNGCPRO; @@ -1951,7 +1950,7 @@ accessible_keymaps_1 (Lisp_Object key, Lisp_Object cmd, Lisp_Object args, void * else { tem = append_key (thisseq, key); - nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil)); + nconc2 (tail, list1 (Fcons (tem, cmd))); } } @@ -2005,13 +2004,13 @@ then the value includes only maps for prefixes that start with PREFIX. */) } prefix = copy; } - maps = Fcons (Fcons (prefix, tem), Qnil); + maps = list1 (Fcons (prefix, tem)); } else return Qnil; } else - maps = Fcons (Fcons (zero_vector, get_keymap (keymap, 1, 0)), Qnil); + maps = list1 (Fcons (zero_vector, get_keymap (keymap, 1, 0))); /* For each map in the list maps, look at any other maps it points to, @@ -2619,7 +2618,7 @@ The optional 5th arg NO-REMAP alters how command remapping is handled: if (CONSP (keymap) && KEYMAPP (XCAR (keymap))) keymaps = keymap; else if (!NILP (keymap)) - keymaps = Fcons (keymap, Fcons (current_global_map, Qnil)); + keymaps = list2 (keymap, current_global_map); else keymaps = Fcurrent_active_maps (Qnil, Qnil); diff --git a/src/lisp.h b/src/lisp.h index acd21089655..952991a32d9 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -443,8 +443,7 @@ enum Lisp_Fwd_Type displayed to users. These are Lisp_Save_Value, a Lisp_Misc subtype; and PVEC_OTHER, a kind of vectorlike object. The former is suitable for temporarily stashing away pointers and integers in - a Lisp object (see the existing uses of make_save_value and - XSAVE_VALUE). The latter is useful for vector-like Lisp objects + a Lisp object. The latter is useful for vector-like Lisp objects that need to be used as part of other objects, but which are never shown to users or Lisp code (search for PVEC_OTHER in xterm.c for an example). @@ -1851,46 +1850,27 @@ enum Lisp_Save_Type /* Special object used to hold a different values for later use. This is mostly used to package C integers and pointers to call - record_unwind_protect. A typical task is to pass just one C object - pointer to the unwind function. You should pack an object pointer with - make_save_pointer and then get it back with XSAVE_POINTER, e.g.: + record_unwind_protect when two or more values need to be saved. + For example: ... struct my_data *md = get_my_data (); - record_unwind_protect (my_unwind, make_save_pointer (md)); + ptrdiff_t mi = get_my_integer (); + record_unwind_protect (my_unwind, make_save_ptr_int (md, mi)); ... Lisp_Object my_unwind (Lisp_Object arg) { struct my_data *md = XSAVE_POINTER (arg, 0); - ... - } - - If you need to pass something else you can use make_save_value, - which allows you to pack up to SAVE_VALUE_SLOTS integers, pointers, - function pointers or Lisp_Objects and conveniently get them back - with XSAVE_INTEGER, XSAVE_POINTER, XSAVE_FUNCPOINTER, and - XSAVE_OBJECT macros: - - ... - struct my_data *md = get_my_data (); - Lisp_Object my_object = get_my_object (); - record_unwind_protect - (my_unwind, make_save_value (SAVE_TYPE_PTR_OBJ, md, my_object)); - ... - - Lisp_Object my_unwind (Lisp_Object arg) - { - struct my_data *md = XSAVE_POINTER (arg, 0); - Lisp_Object my_object = XSAVE_OBJECT (arg, 1); + ptrdiff_t mi = XSAVE_INTEGER (arg, 1); ... } If ENABLE_CHECKING is in effect, XSAVE_xxx macros do type checking of the saved objects and raise eassert if type of the saved object doesn't match the type which is extracted. In the example above, XSAVE_INTEGER (arg, 2) - or XSAVE_OBJECT (arg, 0) are wrong because nothing was saved in slot 2 and - Lisp_Object was saved in slot 1 of ARG. */ + and XSAVE_OBJECT (arg, 0) are wrong because nothing was saved in slot 2 and + slot 0 is a pointer. */ typedef void (*voidfuncptr) (void); @@ -1900,12 +1880,13 @@ struct Lisp_Save_Value unsigned gcmarkbit : 1; int spacer : 32 - (16 + 1 + SAVE_TYPE_BITS); - /* DATA[N] may hold up to SAVE_VALUE_SLOTS entries. The type of - V's Ith entry is given by save_type (V, I). E.g., if save_type - (V, 3) == SAVE_INTEGER, V->data[3].integer is in use. + /* V->data may hold up to SAVE_VALUE_SLOTS entries. The type of + V's data entries are determined by V->save_type. E.g., if + V->save_type == SAVE_TYPE_PTR_OBJ, V->data[0] is a pointer, + V->data[1] is an integer, and V's other data entries are unused. - If SAVE_TYPE == SAVE_TYPE_MEMORY, DATA[0].pointer is the address of - a memory area containing DATA[1].integer potential Lisp_Objects. */ + If V->save_type == SAVE_TYPE_MEMORY, V->data[0].pointer is the address of + a memory area containing V->data[1].integer potential Lisp_Objects. */ ENUM_BF (Lisp_Save_Type) save_type : SAVE_TYPE_BITS; union { void *pointer; @@ -2775,10 +2756,11 @@ typedef jmp_buf sys_jmp_buf; used all over the place, needs to be fast, and needs to know the size of union specbinding. But only eval.c should access it. */ -typedef Lisp_Object (*specbinding_func) (Lisp_Object); - enum specbind_tag { - SPECPDL_UNWIND, /* An unwind_protect function. */ + SPECPDL_UNWIND, /* An unwind_protect function on Lisp_Object. */ + SPECPDL_UNWIND_PTR, /* Likewise, on void *. */ + SPECPDL_UNWIND_INT, /* Likewise, on int. */ + SPECPDL_UNWIND_VOID, /* Likewise, with no arg. */ SPECPDL_BACKTRACE, /* An element of the backtrace. */ SPECPDL_LET, /* A plain and simple dynamic let-binding. */ /* Tags greater than SPECPDL_LET must be "subkinds" of LET. */ @@ -2791,11 +2773,25 @@ union specbinding ENUM_BF (specbind_tag) kind : CHAR_BIT; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; + void (*func) (Lisp_Object); Lisp_Object arg; - specbinding_func func; } unwind; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; + void (*func) (void *); + void *arg; + } unwind_ptr; + struct { + ENUM_BF (specbind_tag) kind : CHAR_BIT; + void (*func) (int); + int arg; + } unwind_int; + struct { + ENUM_BF (specbind_tag) kind : CHAR_BIT; + void (*func) (void); + } unwind_void; + struct { + ENUM_BF (specbind_tag) kind : CHAR_BIT; /* `where' is not used in the case of SPECPDL_LET. */ Lisp_Object symbol, old_value, where; /* Normally this is unused; but it is set to the symbol's @@ -3487,7 +3483,7 @@ extern void add_to_log (const char *, Lisp_Object, Lisp_Object); extern void check_message_stack (void); extern void setup_echo_area_for_printing (int); extern bool push_message (void); -extern Lisp_Object pop_message_unwind (Lisp_Object); +extern void pop_message_unwind (void); extern Lisp_Object restore_message_unwind (Lisp_Object); extern void restore_message (void); extern Lisp_Object current_message (void); @@ -3652,8 +3648,16 @@ extern bool abort_on_gc; extern Lisp_Object make_float (double); extern void display_malloc_warning (void); extern ptrdiff_t inhibit_garbage_collection (void); -extern Lisp_Object make_save_value (enum Lisp_Save_Type, ...); -extern Lisp_Object make_save_pointer (void *); +extern Lisp_Object make_save_int_int_int (ptrdiff_t, ptrdiff_t, ptrdiff_t); +extern Lisp_Object make_save_obj_obj_obj_obj (Lisp_Object, Lisp_Object, + Lisp_Object, Lisp_Object); +extern Lisp_Object make_save_ptr (void *); +extern Lisp_Object make_save_ptr_int (void *, ptrdiff_t); +extern Lisp_Object make_save_ptr_ptr (void *, void *); +extern Lisp_Object make_save_funcptr_ptr_obj (void (*) (void), void *, + Lisp_Object); +extern Lisp_Object make_save_memory (Lisp_Object *, ptrdiff_t); +extern void free_save_value (Lisp_Object); extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object); extern void free_marker (Lisp_Object); extern void free_cons (struct Lisp_Cons *); @@ -3811,14 +3815,20 @@ extern Lisp_Object internal_condition_case_n (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *, Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *)); extern void specbind (Lisp_Object, Lisp_Object); -extern void record_unwind_protect (Lisp_Object (*) (Lisp_Object), Lisp_Object); +extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object); +extern void record_unwind_protect_int (void (*) (int), int); +extern void record_unwind_protect_ptr (void (*) (void *), void *); +extern void record_unwind_protect_void (void (*) (void)); +extern void record_unwind_protect_nothing (void); +extern void clear_unwind_protect (ptrdiff_t); +extern void set_unwind_protect_ptr (ptrdiff_t, void (*) (void *), void *); extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object); extern void rebind_for_thread_switch (void); extern void unbind_for_thread_switch (void); extern _Noreturn void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2); extern _Noreturn void verror (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0); -extern Lisp_Object un_autoload (Lisp_Object); +extern void un_autoload (Lisp_Object); extern Lisp_Object call_debugger (Lisp_Object arg); extern void init_eval_once (void); extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...); @@ -3826,6 +3836,7 @@ extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object); extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object); extern void init_eval (void); extern void syms_of_eval (void); +extern void unwind_body (Lisp_Object); extern void record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs); extern void mark_specpdl (union specbinding *first, union specbinding *ptr); @@ -3844,8 +3855,8 @@ extern void insert1 (Lisp_Object); extern Lisp_Object format2 (const char *, Lisp_Object, Lisp_Object); extern Lisp_Object save_excursion_save (void); extern Lisp_Object save_restriction_save (void); -extern Lisp_Object save_excursion_restore (Lisp_Object); -extern Lisp_Object save_restriction_restore (Lisp_Object); +extern void save_excursion_restore (Lisp_Object); +extern void save_restriction_restore (Lisp_Object); extern _Noreturn void time_overflow (void); extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool); extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t, @@ -3864,7 +3875,6 @@ extern void report_overlay_modification (Lisp_Object, Lisp_Object, bool, Lisp_Object, Lisp_Object, Lisp_Object); extern bool overlay_touches_p (ptrdiff_t); extern Lisp_Object Vbuffer_alist; -extern Lisp_Object set_buffer_if_live (Lisp_Object); extern Lisp_Object other_buffer_safely (Lisp_Object); extern Lisp_Object Qpriority, Qwindow, Qbefore_string, Qafter_string; extern Lisp_Object get_truename_buffer (Lisp_Object); @@ -3898,8 +3908,9 @@ extern Lisp_Object Qinsert_file_contents; extern Lisp_Object Qfile_name_history; extern Lisp_Object expand_and_dir_to_file (Lisp_Object, Lisp_Object); EXFUN (Fread_file_name, 6); /* Not a normal DEFUN. */ -extern Lisp_Object close_file_unwind (Lisp_Object); -extern Lisp_Object restore_point_unwind (Lisp_Object); +extern void close_file_unwind (int); +extern void fclose_unwind (void *); +extern void restore_point_unwind (Lisp_Object); extern _Noreturn void report_file_errno (const char *, Lisp_Object, int); extern _Noreturn void report_file_error (const char *, Lisp_Object); extern bool internal_delete_file (Lisp_Object); @@ -4171,6 +4182,7 @@ extern void init_random (void); extern void emacs_backtrace (int); extern _Noreturn void emacs_abort (void) NO_INLINE; extern int emacs_open (const char *, int, int); +extern int emacs_pipe (int[2]); extern int emacs_close (int); extern ptrdiff_t emacs_read (int, char *, ptrdiff_t); extern ptrdiff_t emacs_write (int, const char *, ptrdiff_t); @@ -4334,7 +4346,6 @@ extern void init_system_name (void); enum MAX_ALLOCA { MAX_ALLOCA = 16 * 1024 }; -extern Lisp_Object safe_alloca_unwind (Lisp_Object); extern void *record_xmalloc (size_t); #define USE_SAFE_ALLOCA \ @@ -4358,8 +4369,7 @@ extern void *record_xmalloc (size_t); { \ (buf) = xnmalloc (nitems, sizeof *(buf) * (multiplier)); \ sa_must_free = 1; \ - record_unwind_protect (safe_alloca_unwind, \ - make_save_pointer (buf)); \ + record_unwind_protect_ptr (xfree, buf); \ } \ } while (0) @@ -4384,9 +4394,9 @@ extern void *record_xmalloc (size_t); { \ Lisp_Object arg_; \ buf = xmalloc ((nelt) * word_size); \ - arg_ = make_save_value (SAVE_TYPE_MEMORY, buf, nelt); \ + arg_ = make_save_memory (buf, nelt); \ sa_must_free = 1; \ - record_unwind_protect (safe_alloca_unwind, arg_); \ + record_unwind_protect (free_save_value, arg_); \ } \ else \ memory_full (SIZE_MAX); \ diff --git a/src/lread.c b/src/lread.c index f0423f166dd..57c7df74127 100644 --- a/src/lread.c +++ b/src/lread.c @@ -145,7 +145,6 @@ static int read_emacs_mule_char (int, int (*) (int, Lisp_Object), static void readevalloop (Lisp_Object, FILE *, Lisp_Object, bool, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); -static Lisp_Object load_unwind (Lisp_Object); /* Functions that read one byte from the current source READCHARFUN or unreads one byte. If the integer argument C is -1, it returns @@ -562,7 +561,7 @@ read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object rea c = DECODE_CHAR (charset, code); if (c < 0) Fsignal (Qinvalid_read_syntax, - Fcons (build_string ("invalid multibyte form"), Qnil)); + list1 (build_string ("invalid multibyte form"))); return c; } @@ -672,7 +671,7 @@ read_filtered_event (bool no_switch_frame, bool ascii_required, { if (error_nonascii) { - Vunread_command_events = Fcons (val, Qnil); + Vunread_command_events = list1 (val); error ("Non-character input-event"); } else @@ -952,10 +951,10 @@ safe_to_load_version (int fd) /* Callback for record_unwind_protect. Restore the old load list OLD, after loading a file successfully. */ -static Lisp_Object +static void record_load_unwind (Lisp_Object old) { - return Vloads_in_progress = old; + Vloads_in_progress = old; } /* This handler function is used via internal_condition_case_1. */ @@ -966,7 +965,7 @@ load_error_handler (Lisp_Object data) return Qnil; } -static Lisp_Object +static void load_warn_old_style_backquotes (Lisp_Object file) { if (!NILP (Vold_style_backquotes)) @@ -976,7 +975,6 @@ load_warn_old_style_backquotes (Lisp_Object file) args[1] = file; Fmessage (2, args); } - return Qnil; } DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0, @@ -1041,10 +1039,12 @@ While the file is in the process of being loaded, the variable is bound to the file's name. Return t if the file exists and loads successfully. */) - (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage, Lisp_Object nosuffix, Lisp_Object must_suffix) + (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage, + Lisp_Object nosuffix, Lisp_Object must_suffix) { - register FILE *stream; - register int fd = -1; + FILE *stream; + int fd; + int fd_index; ptrdiff_t count = SPECPDL_INDEX (); struct gcpro gcpro1, gcpro2, gcpro3; Lisp_Object found, efound, hist_file_name; @@ -1055,7 +1055,6 @@ Return t if the file exists and loads successfully. */) Lisp_Object handler; bool safe_p = 1; const char *fmode = "r"; - Lisp_Object tmp[2]; int version; #ifdef DOS_NT @@ -1088,19 +1087,23 @@ Return t if the file exists and loads successfully. */) else file = Fsubstitute_in_file_name (file); - /* Avoid weird lossage with null string as arg, since it would try to load a directory as a Lisp file. */ - if (SBYTES (file) > 0) + if (SCHARS (file) == 0) { - ptrdiff_t size = SBYTES (file); - + fd = -1; + errno = ENOENT; + } + else + { + Lisp_Object suffixes; found = Qnil; GCPRO2 (file, found); if (! NILP (must_suffix)) { /* Don't insist on adding a suffix if FILE already ends with one. */ + ptrdiff_t size = SBYTES (file); if (size > 3 && !strcmp (SSDATA (file) + size - 3, ".el")) must_suffix = Qnil; @@ -1113,20 +1116,28 @@ Return t if the file exists and loads successfully. */) must_suffix = Qnil; } - fd = openp (Vload_path, file, - (!NILP (nosuffix) ? Qnil - : !NILP (must_suffix) ? Fget_load_suffixes () - : Fappend (2, (tmp[0] = Fget_load_suffixes (), - tmp[1] = Vload_file_rep_suffixes, - tmp))), - &found, Qnil); + if (!NILP (nosuffix)) + suffixes = Qnil; + else + { + suffixes = Fget_load_suffixes (); + if (NILP (must_suffix)) + { + Lisp_Object arg[2]; + arg[0] = suffixes; + arg[1] = Vload_file_rep_suffixes; + suffixes = Fappend (2, arg); + } + } + + fd = openp (Vload_path, file, suffixes, &found, Qnil); UNGCPRO; } if (fd == -1) { if (NILP (noerror)) - xsignal2 (Qfile_error, build_string ("Cannot open load file"), file); + report_file_error ("Cannot open load file", file); return Qnil; } @@ -1164,6 +1175,17 @@ Return t if the file exists and loads successfully. */) #endif } + if (fd < 0) + { + /* Pacify older GCC with --enable-gcc-warnings. */ + IF_LINT (fd_index = 0); + } + else + { + fd_index = SPECPDL_INDEX (); + record_unwind_protect_int (close_file_unwind, fd); + } + /* Check if we're stuck in a recursive load cycle. 2000-09-21: It's not possible to just check for the file loaded @@ -1179,11 +1201,7 @@ Return t if the file exists and loads successfully. */) Lisp_Object tem; for (tem = Vloads_in_progress; CONSP (tem); tem = XCDR (tem)) if (!NILP (Fequal (found, XCAR (tem))) && (++load_count > 3)) - { - if (fd >= 0) - emacs_close (fd); - signal_error ("Recursive load", Fcons (found, Vloads_in_progress)); - } + signal_error ("Recursive load", Fcons (found, Vloads_in_progress)); record_unwind_protect (record_load_unwind, Vloads_in_progress); Vloads_in_progress = Fcons (found, Vloads_in_progress); } @@ -1196,9 +1214,8 @@ Return t if the file exists and loads successfully. */) /* Get the name for load-history. */ hist_file_name = (! NILP (Vpurify_flag) - ? Fconcat (2, (tmp[0] = Ffile_name_directory (file), - tmp[1] = Ffile_name_nondirectory (found), - tmp)) + ? concat2 (Ffile_name_directory (file), + Ffile_name_nondirectory (found)) : found) ; version = -1; @@ -1224,12 +1241,7 @@ Return t if the file exists and loads successfully. */) { safe_p = 0; if (!load_dangerous_libraries) - { - if (fd >= 0) - emacs_close (fd); - error ("File `%s' was not compiled in Emacs", - SDATA (found)); - } + error ("File `%s' was not compiled in Emacs", SDATA (found)); else if (!NILP (nomessage) && !force_load_messages) message_with_string ("File `%s' not compiled in Emacs", found, 1); } @@ -1275,7 +1287,10 @@ Return t if the file exists and loads successfully. */) Lisp_Object val; if (fd >= 0) - emacs_close (fd); + { + emacs_close (fd); + clear_unwind_protect (fd_index); + } val = call4 (Vload_source_file_function, found, hist_file_name, NILP (noerror) ? Qnil : Qt, (NILP (nomessage) || force_load_messages) ? Qnil : Qt); @@ -1285,26 +1300,28 @@ Return t if the file exists and loads successfully. */) GCPRO3 (file, found, hist_file_name); -#ifdef WINDOWSNT - efound = ENCODE_FILE (found); - /* If we somehow got here with fd == -2, meaning the file is deemed - to be remote, don't even try to reopen the file locally; just - force a failure instead. */ - if (fd >= 0) + if (fd < 0) { - emacs_close (fd); - stream = emacs_fopen (SSDATA (efound), fmode); + /* We somehow got here with fd == -2, meaning the file is deemed + to be remote. Don't even try to reopen the file locally; + just force a failure. */ + stream = NULL; + errno = EINVAL; } else - stream = NULL; -#else /* not WINDOWSNT */ - stream = fdopen (fd, fmode); -#endif /* not WINDOWSNT */ - if (stream == 0) { +#ifdef WINDOWSNT emacs_close (fd); - error ("Failure to create stdio stream for %s", SDATA (file)); + clear_unwind_protect (fd_index); + efound = ENCODE_FILE (found); + stream = emacs_fopen (SSDATA (efound), fmode); +#else + stream = fdopen (fd, fmode); +#endif } + if (! stream) + report_file_error ("Opening stdio stream", file); + set_unwind_protect_ptr (fd_index, fclose_unwind, stream); if (! NILP (Vpurify_flag)) Vpreloaded_file_list = Fcons (Fpurecopy (file), Vpreloaded_file_list); @@ -1323,7 +1340,6 @@ Return t if the file exists and loads successfully. */) message_with_string ("Loading %s...", file, 1); } - record_unwind_protect (load_unwind, make_save_pointer (stream)); specbind (Qload_file_name, found); specbind (Qinhibit_file_name_operation, Qnil); specbind (Qload_in_progress, Qt); @@ -1375,19 +1391,6 @@ Return t if the file exists and loads successfully. */) return Qt; } - -static Lisp_Object -load_unwind (Lisp_Object arg) /* Used as unwind-protect function in load. */ -{ - FILE *stream = XSAVE_POINTER (arg, 0); - if (stream != NULL) - { - block_input (); - fclose (stream); - unblock_input (); - } - return Qnil; -} static bool complete_filename_p (Lisp_Object pathname) @@ -1494,7 +1497,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, fn = alloca (fn_size = 100 + want_length); /* Loop over suffixes. */ - for (tail = NILP (suffixes) ? Fcons (empty_unibyte_string, Qnil) : suffixes; + for (tail = NILP (suffixes) ? list1 (empty_unibyte_string) : suffixes; CONSP (tail); tail = XCDR (tail)) { ptrdiff_t fnlen, lsuffix = SBYTES (XCAR (tail)); @@ -1523,7 +1526,6 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate)) { bool exists; - last_errno = ENOENT; if (NILP (predicate)) exists = !NILP (Ffile_readable_p (string)); else @@ -1578,7 +1580,10 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, { fd = emacs_open (pfn, O_RDONLY, 0); if (fd < 0) - last_errno = errno; + { + if (errno != ENOENT) + last_errno = errno; + } else { struct stat st; @@ -1682,11 +1687,10 @@ build_load_history (Lisp_Object filename, bool entire) Vload_history); } -static Lisp_Object -readevalloop_1 (Lisp_Object old) +static void +readevalloop_1 (int old) { - load_convert_to_unibyte = ! NILP (old); - return Qnil; + load_convert_to_unibyte = old; } /* Signal an `end-of-file' error, if possible with file name @@ -1756,7 +1760,7 @@ readevalloop (Lisp_Object readcharfun, specbind (Qstandard_input, readcharfun); /* GCPROs readcharfun. */ specbind (Qcurrent_load_list, Qnil); - record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil); + record_unwind_protect_int (readevalloop_1, load_convert_to_unibyte); load_convert_to_unibyte = !NILP (unibyte); /* If lexical binding is active (either because it was specified in @@ -1764,8 +1768,8 @@ readevalloop (Lisp_Object readcharfun, lexical environment, otherwise, turn off lexical binding. */ lex_bound = find_symbol_value (Qlexical_binding); specbind (Qinternal_interpreter_environment, - NILP (lex_bound) || EQ (lex_bound, Qunbound) - ? Qnil : Fcons (Qt, Qnil)); + (NILP (lex_bound) || EQ (lex_bound, Qunbound) + ? Qnil : list1 (Qt))); GCPRO4 (sourcename, readfun, start, end); @@ -2724,7 +2728,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (c == '$') return Vload_file_name; if (c == '\'') - return Fcons (Qfunction, Fcons (read0 (readcharfun), Qnil)); + return list2 (Qfunction, read0 (readcharfun)); /* #:foo is the uninterned symbol named foo. */ if (c == ':') { @@ -2819,9 +2823,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) goto retry; case '\'': - { - return Fcons (Qquote, Fcons (read0 (readcharfun), Qnil)); - } + return list2 (Qquote, read0 (readcharfun)); case '`': { @@ -2851,7 +2853,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) value = read0 (readcharfun); new_backquote_flag = saved_new_backquote_flag; - return Fcons (Qbackquote, Fcons (value, Qnil)); + return list2 (Qbackquote, value); } } case ',': @@ -2889,7 +2891,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) } value = read0 (readcharfun); - return Fcons (comma_type, Fcons (value, Qnil)); + return list2 (comma_type, value); } else { @@ -3665,7 +3667,7 @@ read_list (bool flag, Lisp_Object readcharfun) } invalid_syntax ("] in a list"); } - tem = Fcons (elt, Qnil); + tem = list1 (elt); if (!NILP (tail)) XSETCDR (tail, tem); else @@ -4232,7 +4234,7 @@ init_lread (void) points to the eventual installed lisp, leim directories. We should not use those now, even if they exist, so start over from a clean slate. */ - Vload_path = Fcons (tem, Qnil); + Vload_path = list1 (tem); } } else @@ -4459,8 +4461,8 @@ otherwise to default specified by file `epaths.h' when Emacs was built. */); This list should not include the empty string. `load' and related functions try to append these suffixes, in order, to the specified file name if a Lisp suffix is allowed or required. */); - Vload_suffixes = Fcons (build_pure_c_string (".elc"), - Fcons (build_pure_c_string (".el"), Qnil)); + Vload_suffixes = list2 (build_pure_c_string (".elc"), + build_pure_c_string (".el")); DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes, doc: /* List of suffixes that indicate representations of \ the same file. @@ -4474,7 +4476,7 @@ and, if so, which suffixes they should try to append to the file name in order to do so. However, if you want to customize which suffixes the loading functions recognize as compression suffixes, you should customize `jka-compr-load-suffixes' rather than the present variable. */); - Vload_file_rep_suffixes = Fcons (empty_unibyte_string, Qnil); + Vload_file_rep_suffixes = list1 (empty_unibyte_string); DEFVAR_BOOL ("load-in-progress", load_in_progress, doc: /* Non-nil if inside of `load'. */); diff --git a/src/macros.c b/src/macros.c index 48d23a977b1..0c11efcdc9a 100644 --- a/src/macros.c +++ b/src/macros.c @@ -279,7 +279,7 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */) /* Restore Vexecuting_kbd_macro and executing_kbd_macro_index. Called when the unwind-protect in Fexecute_kbd_macro gets invoked. */ -static Lisp_Object +static void pop_kbd_macro (Lisp_Object info) { Lisp_Object tem; @@ -288,7 +288,6 @@ pop_kbd_macro (Lisp_Object info) executing_kbd_macro_index = XINT (XCAR (tem)); Vreal_this_command = XCDR (tem); Frun_hooks (1, &Qkbd_macro_termination_hook); - return Qnil; } DEFUN ("execute-kbd-macro", Fexecute_kbd_macro, Sexecute_kbd_macro, 1, 3, 0, diff --git a/src/menu.c b/src/menu.c index 58558d5aedd..6b4a22d3052 100644 --- a/src/menu.c +++ b/src/menu.c @@ -102,10 +102,10 @@ finish_menu_items (void) { } -Lisp_Object -unuse_menu_items (Lisp_Object dummy) +void +unuse_menu_items (void) { - return menu_items_inuse = Qnil; + menu_items_inuse = Qnil; } /* Call when finished using the data for the current menu @@ -124,19 +124,10 @@ discard_menu_items (void) eassert (NILP (menu_items_inuse)); } -#ifdef HAVE_NS -static Lisp_Object -cleanup_popup_menu (Lisp_Object arg) -{ - discard_menu_items (); - return Qnil; -} -#endif - /* This undoes save_menu_items, and it is called by the specpdl unwind mechanism. */ -static Lisp_Object +static void restore_menu_items (Lisp_Object saved) { menu_items = XCAR (saved); @@ -148,7 +139,6 @@ restore_menu_items (Lisp_Object saved) menu_items_n_panes = XINT (XCAR (saved)); saved = XCDR (saved); menu_items_submenu_depth = XINT (XCAR (saved)); - return Qnil; } /* Push the whole state of menu_items processing onto the specpdl. @@ -1004,7 +994,7 @@ find_and_return_menu_selection (FRAME_PTR f, bool keymaps, void *client_data) { int j; - entry = Fcons (entry, Qnil); + entry = list1 (entry); if (!NILP (prefix)) entry = Fcons (prefix, entry); for (j = submenu_depth - 1; j >= 0; j--) @@ -1213,7 +1203,7 @@ no quit occurs and `x-popup-menu' returns nil. */) #endif /* HAVE_MENUS */ /* Now parse the lisp menus. */ - record_unwind_protect (unuse_menu_items, Qnil); + record_unwind_protect_void (unuse_menu_items); title = Qnil; GCPRO1 (title); @@ -1315,7 +1305,7 @@ no quit occurs and `x-popup-menu' returns nil. */) #endif #ifdef HAVE_NS /* FIXME: ns-specific, why? --Stef */ - record_unwind_protect (cleanup_popup_menu, Qnil); + record_unwind_protect_void (discard_menu_items); #endif /* Display them in a menu. */ diff --git a/src/minibuf.c b/src/minibuf.c index b69a16eff42..2c33b83c11b 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -137,13 +137,6 @@ choose_minibuf_frame (void) } } -static Lisp_Object -choose_minibuf_frame_1 (Lisp_Object ignore) -{ - choose_minibuf_frame (); - return Qnil; -} - DEFUN ("active-minibuffer-window", Factive_minibuffer_window, Sactive_minibuffer_window, 0, 0, 0, doc: /* Return the currently active minibuffer window, or nil if none. */) @@ -171,8 +164,8 @@ without invoking the usual minibuffer commands. */) /* Actual minibuffer invocation. */ -static Lisp_Object read_minibuf_unwind (Lisp_Object); -static Lisp_Object run_exit_minibuf_hook (Lisp_Object); +static void read_minibuf_unwind (void); +static void run_exit_minibuf_hook (void); /* Read a Lisp object from VAL and return it. If VAL is an empty @@ -474,20 +467,20 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, /* Prepare for restoring the current buffer since choose_minibuf_frame calling Fset_frame_selected_window may change it (Bug#12766). */ - record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); + record_unwind_protect (restore_buffer, Fcurrent_buffer ()); choose_minibuf_frame (); - record_unwind_protect (choose_minibuf_frame_1, Qnil); + record_unwind_protect_void (choose_minibuf_frame); - record_unwind_protect (Fset_window_configuration, + record_unwind_protect (restore_window_configuration, Fcurrent_window_configuration (Qnil)); /* If the minibuffer window is on a different frame, save that frame's configuration too. */ mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window)); if (!EQ (mini_frame, selected_frame)) - record_unwind_protect (Fset_window_configuration, + record_unwind_protect (restore_window_configuration, Fcurrent_window_configuration (mini_frame)); /* If the minibuffer is on an iconified or invisible frame, @@ -518,14 +511,14 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, Fcons (Vminibuffer_history_variable, minibuf_save_list)))))); - record_unwind_protect (read_minibuf_unwind, Qnil); + record_unwind_protect_void (read_minibuf_unwind); minibuf_level++; /* We are exiting the minibuffer one way or the other, so run the hook. It should be run before unwinding the minibuf settings. Do it separately from read_minibuf_unwind because we need to make sure that read_minibuf_unwind is fully executed even if exit-minibuffer-hook signals an error. --Stef */ - record_unwind_protect (run_exit_minibuf_hook, Qnil); + record_unwind_protect_void (run_exit_minibuf_hook); /* Now that we can restore all those variables, start changing them. */ @@ -786,7 +779,7 @@ get_minibuffer (EMACS_INT depth) tail = Fnthcdr (num, Vminibuffer_list); if (NILP (tail)) { - tail = Fcons (Qnil, Qnil); + tail = list1 (Qnil); Vminibuffer_list = nconc2 (Vminibuffer_list, tail); } buf = Fcar (tail); @@ -821,18 +814,17 @@ get_minibuffer (EMACS_INT depth) return buf; } -static Lisp_Object -run_exit_minibuf_hook (Lisp_Object data) +static void +run_exit_minibuf_hook (void) { safe_run_hooks (Qminibuffer_exit_hook); - return Qnil; } /* This function is called on exiting minibuffer, whether normally or not, and it restores the current window, buffer, etc. */ -static Lisp_Object -read_minibuf_unwind (Lisp_Object data) +static void +read_minibuf_unwind (void) { Lisp_Object old_deactivate_mark; Lisp_Object window; @@ -895,7 +887,6 @@ read_minibuf_unwind (Lisp_Object data) to make sure we don't leave around bindings and stuff which only made sense during the read_minibuf invocation. */ call0 (intern ("minibuffer-inactive-mode")); - return Qnil; } @@ -1862,7 +1853,7 @@ If FLAG is nil, invoke `try-completion'; if it is t, invoke else if (EQ (flag, Qlambda)) return Ftest_completion (string, Vbuffer_alist, predicate); else if (EQ (flag, Qmetadata)) - return Fcons (Qmetadata, Fcons (Fcons (Qcategory, Qbuffer), Qnil)); + return list2 (Qmetadata, Fcons (Qcategory, Qbuffer)); else return Qnil; } @@ -2106,8 +2097,7 @@ These are in addition to the basic `field' property, and stickiness properties. */); /* We use `intern' here instead of Qread_only to avoid initialization-order problems. */ - Vminibuffer_prompt_properties - = Fcons (intern_c_string ("read-only"), Fcons (Qt, Qnil)); + Vminibuffer_prompt_properties = list2 (intern_c_string ("read-only"), Qt); defsubr (&Sactive_minibuffer_window); defsubr (&Sset_minibuffer_window); diff --git a/src/nsfns.m b/src/nsfns.m index 6eebb4d2567..121ac539646 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -981,7 +981,7 @@ frame_parm_handler ns_frame_parm_handlers[] = /* Handler for signals raised during x_create_frame. FRAME is the frame which is partially constructed. */ -static Lisp_Object +static void unwind_create_frame (Lisp_Object frame) { struct frame *f = XFRAME (frame); @@ -990,7 +990,7 @@ unwind_create_frame (Lisp_Object frame) display is disconnected after the frame has become official, but before x_create_frame removes the unwind protect. */ if (!FRAME_LIVE_P (f)) - return Qnil; + return; /* If frame is ``official'', nothing to do. */ if (NILP (Fmemq (frame, Vframe_list))) @@ -1006,10 +1006,7 @@ unwind_create_frame (Lisp_Object frame) /* Check that reference counts are indeed correct. */ eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount); #endif - return Qt; } - - return Qnil; } /* @@ -2022,7 +2019,7 @@ there was no result. */) ns_string_to_pasteboard (pb, send); if (NSPerformService (svcName, pb) == NO) - Fsignal (Qquit, Fcons (build_string ("service not available"), Qnil)); + Fsignal (Qquit, list1 (build_string ("service not available"))); if ([[pb types] count] == 0) return build_string (""); @@ -2878,7 +2875,7 @@ Example: Install an icon Gnus.tiff and execute the following code When you miniaturize a Group, Summary or Article frame, Gnus.tiff will be used as the image of the icon representing the frame. */); - Vns_icon_type_alist = Fcons (Qt, Qnil); + Vns_icon_type_alist = list1 (Qt); DEFVAR_LISP ("ns-version-string", Vns_version_string, doc: /* Toolkit version for NS Windowing. */); diff --git a/src/nsfont.m b/src/nsfont.m index a657d01dbe4..df7ef0bb0bc 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -446,7 +446,7 @@ static NSCharacterSet { Lisp_Object ranges, range_list; - ranges = Fcons (script, Qnil); + ranges = list1 (script); map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table, ranges); range_list = Fnreverse (XCDR (ranges)); diff --git a/src/nsmenu.m b/src/nsmenu.m index 22635dca0a2..02fe0b04ca0 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -1410,10 +1410,10 @@ struct Popdown_data EmacsDialogPanel *dialog; }; -static Lisp_Object -pop_down_menu (Lisp_Object arg) +static void +pop_down_menu (void *arg) { - struct Popdown_data *unwind_data = XSAVE_POINTER (arg, 0); + struct Popdown_data *unwind_data = arg; block_input (); if (popup_activated_flag) @@ -1427,8 +1427,6 @@ pop_down_menu (Lisp_Object arg) xfree (unwind_data); unblock_input (); - - return Qnil; } @@ -1492,7 +1490,7 @@ ns_popup_dialog (Lisp_Object position, Lisp_Object contents, Lisp_Object header) if (NILP (Fcar (Fcdr (contents)))) /* No buttons specified, add an "Ok" button so users can pop down the dialog. */ - contents = Fcons (title, Fcons (Fcons (build_string ("Ok"), Qt), Qnil)); + contents = list2 (title, Fcons (build_string ("Ok"), Qt)); block_input (); pool = [[NSAutoreleasePool alloc] init]; @@ -1506,7 +1504,7 @@ ns_popup_dialog (Lisp_Object position, Lisp_Object contents, Lisp_Object header) unwind_data->pool = pool; unwind_data->dialog = dialog; - record_unwind_protect (pop_down_menu, make_save_pointer (unwind_data)); + record_unwind_protect_ptr (pop_down_menu, unwind_data); popup_activated_flag = 1; tem = [dialog runDialogAt: p]; unbind_to (specpdl_count, Qnil); /* calls pop_down_menu */ diff --git a/src/nsselect.m b/src/nsselect.m index 6053ee9ceb2..d95ff799877 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -219,9 +219,10 @@ ns_get_local_selection (Lisp_Object selection_name, return value; // FIXME: Why `quit' rather than `error'? - Fsignal (Qquit, Fcons (build_string ( - "invalid data returned by selection-conversion function"), - Fcons (handler_fn, Fcons (value, Qnil)))); + Fsignal (Qquit, + list3 (build_string ("invalid data returned by" + " selection-conversion function"), + handler_fn, value)); // FIXME: Beware, `quit' can return!! return Qnil; } @@ -256,8 +257,7 @@ ns_string_from_pasteboard (id pb) if (type == nil) { Fsignal (Qquit, - Fcons (build_string ("empty or unsupported pasteboard type"), - Qnil)); + list1 (build_string ("empty or unsupported pasteboard type"))); return Qnil; } @@ -275,8 +275,8 @@ ns_string_from_pasteboard (id pb) else { Fsignal (Qquit, - Fcons (build_string ("pasteboard doesn't contain valid data"), - Qnil)); + list1 (build_string ("pasteboard doesn't contain" + " valid data"))); return Qnil; } } @@ -362,7 +362,7 @@ On Nextstep, FRAME is unused. */) ns_declare_pasteboard (pb); old_value = assq_no_quit (selection, Vselection_alist); - new_value = Fcons (selection, Fcons (value, Qnil)); + new_value = list2 (selection, value); if (NILP (old_value)) Vselection_alist = Fcons (new_value, Vselection_alist); diff --git a/src/nsterm.m b/src/nsterm.m index d7cea5c189a..61538798337 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -362,7 +362,7 @@ append2 (Lisp_Object list, Lisp_Object item) { Lisp_Object array[2]; array[0] = list; - array[1] = Fcons (item, Qnil); + array[1] = list1 (item); return Fnconc (2, &array[0]); } @@ -3777,7 +3777,7 @@ ns_set_vertical_scroll_bar (struct window *window, } bar = [[EmacsScroller alloc] initFrame: r window: win]; - wset_vertical_scroll_bar (window, make_save_pointer (bar)); + wset_vertical_scroll_bar (window, make_save_ptr (bar)); } else { @@ -4142,7 +4142,7 @@ ns_term_init (Lisp_Object display_name) if (selfds[0] == -1) { - if (pipe2 (selfds, O_CLOEXEC) != 0) + if (emacs_pipe (selfds) != 0) { fprintf (stderr, "Failed to create pipe: %s\n", emacs_strerror (errno)); @@ -4416,6 +4416,7 @@ ns_term_shutdown (int sig) { int type = [theEvent type]; NSWindow *window = [theEvent window]; + /* NSTRACE (sendEvent); */ /*fprintf (stderr, "received event of type %d\t%d\n", type);*/ @@ -4469,6 +4470,23 @@ ns_term_shutdown (int sig) } } + +#ifdef NS_IMPL_COCOA + /* If no dialog and none of our frames have focus and it is a move, skip it. + It is a mouse move in an auxillary menu, i.e. on the top right on OSX, + such as Wifi, sound, date or similar. + This prevents "spooky" highlightning in the frame under the menu. */ + if (type == NSMouseMoved && [NSApp modalWindow] == nil) + { + struct ns_display_info *di; + BOOL has_focus = NO; + for (di = x_display_list; ! has_focus && di; di = di->next) + has_focus = di->x_focus_frame != 0; + if (! has_focus) + return; + } +#endif + [super sendEvent: theEvent]; } @@ -5746,9 +5764,10 @@ not_in_argv (NSString *arg) /* cf. x_detect_focus_change(), x_focus_changed(), x_new_focus_frame() */ { struct ns_display_info *dpyinfo = FRAME_NS_DISPLAY_INFO (emacsframe); + BOOL is_focus_frame = dpyinfo->x_focus_frame == emacsframe; NSTRACE (windowDidResignKey); - if (dpyinfo->x_focus_frame == emacsframe) + if (is_focus_frame) dpyinfo->x_focus_frame = 0; ns_frame_rehighlight (emacsframe); @@ -5761,10 +5780,10 @@ not_in_argv (NSString *arg) x_set_frame_alpha (emacsframe); } - if (emacs_event) + if (emacs_event && is_focus_frame) { [self deleteWorkingText]; - emacs_event->kind = FOCUS_IN_EVENT; + emacs_event->kind = FOCUS_OUT_EVENT; EV_TRAILER ((id)nil); } } diff --git a/src/print.c b/src/print.c index 01e490dcbad..ec14b7be93c 100644 --- a/src/print.c +++ b/src/print.c @@ -199,11 +199,10 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1; /* This is used to restore the saved contents of print_buffer when there is a recursive call to print. */ -static Lisp_Object +static void print_unwind (Lisp_Object saved_text) { memcpy (print_buffer, SDATA (saved_text), SCHARS (saved_text)); - return Qnil; } @@ -770,8 +769,7 @@ append to existing target file. */) { stderr = initial_stderr_stream; initial_stderr_stream = NULL; - report_file_error ("Cannot open debugging output stream", - Fcons (file, Qnil)); + report_file_error ("Cannot open debugging output stream", file); } } return Qnil; @@ -1301,7 +1299,7 @@ print_prune_string_charset (Lisp_Object string) if (print_check_string_result & PRINT_STRING_NON_CHARSET_FOUND) { if (NILP (print_prune_charset_plist)) - print_prune_charset_plist = Fcons (Qcharset, Qnil); + print_prune_charset_plist = list1 (Qcharset); Fremove_text_properties (make_number (0), make_number (SCHARS (string)), print_prune_charset_plist, string); diff --git a/src/process.c b/src/process.c index dc37bfe7067..33d8ccbbc35 100644 --- a/src/process.c +++ b/src/process.c @@ -785,19 +785,16 @@ status_message (struct Lisp_Process *p) return Fcopy_sequence (Fsymbol_name (symbol)); } -#ifdef HAVE_PTYS - -/* The file name of the pty opened by allocate_pty. */ -static char pty_name[24]; +enum { PTY_NAME_SIZE = 24 }; /* Open an available pty, returning a file descriptor. - Return -1 on failure. - The file name of the terminal corresponding to the pty - is left in the variable pty_name. */ + Store into PTY_NAME the file name of the terminal corresponding to the pty. + Return -1 on failure. */ static int -allocate_pty (void) +allocate_pty (char pty_name[PTY_NAME_SIZE]) { +#ifdef HAVE_PTYS int fd; #ifdef PTY_ITERATION @@ -842,9 +839,9 @@ allocate_pty (void) return fd; } } +#endif /* HAVE_PTYS */ return -1; } -#endif /* HAVE_PTYS */ static Lisp_Object make_process (Lisp_Object name) @@ -1008,7 +1005,7 @@ nil, indicating the current buffer's process. */) p->raw_status_new = 0; if (NETCONN1_P (p) || SERIALCONN1_P (p)) { - pset_status (p, Fcons (Qexit, Fcons (make_number (0), Qnil))); + pset_status (p, list2 (Qexit, make_number (0))); p->tick = ++process_tick; status_notify (p); redisplay_preserve_echo_area (13); @@ -1403,11 +1400,11 @@ list of keywords. */) if ((!NETCONN_P (process) && !SERIALCONN_P (process)) || EQ (key, Qt)) return contact; if (NILP (key) && NETCONN_P (process)) - return Fcons (Fplist_get (contact, QChost), - Fcons (Fplist_get (contact, QCservice), Qnil)); + return list2 (Fplist_get (contact, QChost), + Fplist_get (contact, QCservice)); if (NILP (key) && SERIALCONN_P (process)) - return Fcons (Fplist_get (contact, QCport), - Fcons (Fplist_get (contact, QCspeed), Qnil)); + return list2 (Fplist_get (contact, QCport), + Fplist_get (contact, QCspeed)); return Fplist_get (contact, key); } @@ -1530,7 +1527,7 @@ Returns nil if format of ADDRESS is invalid. */) } DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0, - doc: /* Return a list of all processes. */) + doc: /* Return a list of all processes that are Emacs sub-processes. */) (void) { return Fmapcar (Qcdr, Vprocess_alist); @@ -1538,7 +1535,7 @@ DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0, /* Starting asynchronous inferior processes. */ -static Lisp_Object start_process_unwind (Lisp_Object proc); +static void start_process_unwind (Lisp_Object proc); DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0, doc: /* Start a program in a subprocess. Return the process object for it. @@ -1594,7 +1591,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) current_dir = expand_and_dir_to_file (current_dir, Qnil); if (NILP (Ffile_accessible_directory_p (current_dir))) report_file_error ("Setting current directory", - Fcons (BVAR (current_buffer, directory), Qnil)); + BVAR (current_buffer, directory)); UNGCPRO; } @@ -1716,7 +1713,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) openp (Vexec_path, program, Vexec_suffixes, &tem, make_number (X_OK)); UNGCPRO; if (NILP (tem)) - report_file_error ("Searching for program", Fcons (program, Qnil)); + report_file_error ("Searching for program", program); tem = Fexpand_file_name (tem, Qnil); } else @@ -1739,7 +1736,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) /* Encode the file name and put it in NEW_ARGV. That's where the child will use it to execute the program. */ - tem = Fcons (ENCODE_FILE (tem), Qnil); + tem = list1 (ENCODE_FILE (tem)); /* Here we encode arguments by the coding system used for sending data to the process. We don't support using different coding @@ -1787,7 +1784,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) PROC doesn't have its pid set, then we know someone has signaled an error and the process wasn't started successfully, so we should remove it from the process list. */ -static Lisp_Object +static void start_process_unwind (Lisp_Object proc) { if (!PROCESSP (proc)) @@ -1797,14 +1794,6 @@ start_process_unwind (Lisp_Object proc) -2 is used for a pty with no process, eg for gdb. */ if (XPROCESS (proc)->pid <= 0 && XPROCESS (proc)->pid != -2) remove_process (proc); - - return Qnil; -} - -static void -create_process_1 (struct atimer *timer) -{ - /* Nothing to do. */ } @@ -1820,14 +1809,14 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) #endif int forkin, forkout; bool pty_flag = 0; + char pty_name[PTY_NAME_SIZE]; Lisp_Object lisp_pty_name = Qnil; Lisp_Object encoded_current_dir; inchannel = outchannel = -1; -#ifdef HAVE_PTYS if (!NILP (Vprocess_connection_type)) - outchannel = inchannel = allocate_pty (); + outchannel = inchannel = allocate_pty (pty_name); if (inchannel >= 0) { @@ -1846,13 +1835,12 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) lisp_pty_name = build_string (pty_name); } else -#endif /* HAVE_PTYS */ { - if (pipe2 (sv, O_CLOEXEC) != 0) + if (emacs_pipe (sv) != 0) report_file_error ("Creating pipe", Qnil); inchannel = sv[0]; forkout = sv[1]; - if (pipe2 (sv, O_CLOEXEC) != 0) + if (emacs_pipe (sv) != 0) { int pipe_errno = errno; emacs_close (inchannel); @@ -1864,7 +1852,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) } #ifndef WINDOWSNT - if (pipe2 (wait_child_setup, O_CLOEXEC) != 0) + if (emacs_pipe (wait_child_setup) != 0) report_file_error ("Creating pipe", Qnil); #endif @@ -1900,7 +1888,6 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) Lisp_Object volatile encoded_current_dir_volatile = encoded_current_dir; Lisp_Object volatile lisp_pty_name_volatile = lisp_pty_name; Lisp_Object volatile process_volatile = process; - bool volatile pty_flag_volatile = pty_flag; char **volatile new_argv_volatile = new_argv; int volatile forkin_volatile = forkin; int volatile forkout_volatile = forkout; @@ -1912,12 +1899,13 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) encoded_current_dir = encoded_current_dir_volatile; lisp_pty_name = lisp_pty_name_volatile; process = process_volatile; - pty_flag = pty_flag_volatile; new_argv = new_argv_volatile; forkin = forkin_volatile; forkout = forkout_volatile; wait_child_setup[0] = wait_child_setup_0_volatile; wait_child_setup[1] = wait_child_setup_1_volatile; + + pty_flag = XPROCESS (process)->pty_flag; } if (pid == 0) @@ -1987,15 +1975,15 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) if (pty_flag) { - /* I wonder if emacs_close (emacs_open (pty_name, ...)) + /* I wonder if emacs_close (emacs_open (SSDATA (lisp_pty_name), ...)) would work? */ if (xforkin >= 0) emacs_close (xforkin); - xforkout = xforkin = emacs_open (pty_name, O_RDWR, 0); + xforkout = xforkin = emacs_open (SSDATA (lisp_pty_name), O_RDWR, 0); if (xforkin < 0) { - emacs_perror (pty_name); + emacs_perror (SSDATA (lisp_pty_name)); _exit (EXIT_CANCELED); } @@ -2025,7 +2013,6 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) pid = child_setup (xforkin, xforkout, xforkout, new_argv, 1, encoded_current_dir); #else /* not WINDOWSNT */ - emacs_close (wait_child_setup[0]); child_setup (xforkin, xforkout, xforkout, new_argv, 1, encoded_current_dir); #endif /* not WINDOWSNT */ @@ -2042,14 +2029,13 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) unblock_child_signal (); unblock_input (); + if (forkin >= 0) + emacs_close (forkin); + if (forkin != forkout && forkout >= 0) + emacs_close (forkout); + if (pid < 0) - { - if (forkin >= 0) - emacs_close (forkin); - if (forkin != forkout && forkout >= 0) - emacs_close (forkout); - report_file_errno ("Doing vfork", Qnil, vfork_errno); - } + report_file_errno ("Doing vfork", Qnil, vfork_errno); else { /* vfork succeeded. */ @@ -2058,26 +2044,6 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) register_child (pid, inchannel); #endif /* WINDOWSNT */ - /* If the subfork execv fails, and it exits, - this close hangs. I don't know why. - So have an interrupt jar it loose. */ - { - struct atimer *timer; - EMACS_TIME offset = make_emacs_time (1, 0); - - stop_polling (); - timer = start_atimer (ATIMER_RELATIVE, offset, create_process_1, 0); - - if (forkin >= 0) - emacs_close (forkin); - - cancel_atimer (timer); - start_polling (); - } - - if (forkin != forkout && forkout >= 0) - emacs_close (forkout); - pset_tty_name (XPROCESS (process), lisp_pty_name); #ifndef WINDOWSNT @@ -2096,17 +2062,16 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) } } -void +static void create_pty (Lisp_Object process) { + char pty_name[PTY_NAME_SIZE]; int inchannel, outchannel; - bool pty_flag = 0; inchannel = outchannel = -1; -#ifdef HAVE_PTYS if (!NILP (Vprocess_connection_type)) - outchannel = inchannel = allocate_pty (); + outchannel = inchannel = allocate_pty (pty_name); if (inchannel >= 0) { @@ -2125,37 +2090,29 @@ create_pty (Lisp_Object process) child_setup_tty (forkout); #endif /* DONT_REOPEN_PTY */ #endif /* not USG, or USG_SUBTTY_WORKS */ - pty_flag = 1; - } -#endif /* HAVE_PTYS */ - fcntl (inchannel, F_SETFL, O_NONBLOCK); - fcntl (outchannel, F_SETFL, O_NONBLOCK); + fcntl (inchannel, F_SETFL, O_NONBLOCK); + fcntl (outchannel, F_SETFL, O_NONBLOCK); - /* Record this as an active process, with its channels. - As a result, child_setup will close Emacs's side of the pipes. */ - chan_process[inchannel] = process; - XPROCESS (process)->infd = inchannel; - XPROCESS (process)->outfd = outchannel; + /* Record this as an active process, with its channels. + As a result, child_setup will close Emacs's side of the pipes. */ + chan_process[inchannel] = process; + XPROCESS (process)->infd = inchannel; + XPROCESS (process)->outfd = outchannel; - /* Previously we recorded the tty descriptor used in the subprocess. - It was only used for getting the foreground tty process, so now - we just reopen the device (see emacs_get_tty_pgrp) as this is - more portable (see USG_SUBTTY_WORKS above). */ + /* Previously we recorded the tty descriptor used in the subprocess. + It was only used for getting the foreground tty process, so now + we just reopen the device (see emacs_get_tty_pgrp) as this is + more portable (see USG_SUBTTY_WORKS above). */ - XPROCESS (process)->pty_flag = pty_flag; - pset_status (XPROCESS (process), Qrun); - setup_process_coding_systems (process); + XPROCESS (process)->pty_flag = 1; + pset_status (XPROCESS (process), Qrun); + setup_process_coding_systems (process); - add_process_read_fd (inchannel); + pset_tty_name (XPROCESS (process), build_string (pty_name)); + } XPROCESS (process)->pid = -2; -#ifdef HAVE_PTYS - if (pty_flag) - pset_tty_name (XPROCESS (process), build_string (pty_name)); - else -#endif - pset_tty_name (XPROCESS (process), Qnil); } @@ -2515,8 +2472,12 @@ set_socket_option (int s, Lisp_Object opt, Lisp_Object val) } if (ret < 0) - report_file_error ("Cannot set network option", - Fcons (opt, Fcons (val, Qnil))); + { + int setsockopt_errno = errno; + report_file_errno ("Cannot set network option", list2 (opt, val), + setsockopt_errno); + } + return (1 << sopt->optbit); } @@ -2648,16 +2609,6 @@ usage: (serial-process-configure &rest ARGS) */) return Qnil; } -/* Used by make-serial-process to recover from errors. */ -static Lisp_Object -make_serial_process_unwind (Lisp_Object proc) -{ - if (!PROCESSP (proc)) - emacs_abort (); - remove_process (proc); - return Qnil; -} - DEFUN ("make-serial-process", Fmake_serial_process, Smake_serial_process, 0, MANY, 0, doc: /* Create and return a serial port process. @@ -2763,10 +2714,10 @@ usage: (make-serial-process &rest ARGS) */) CHECK_STRING (name); proc = make_process (name); specpdl_count = SPECPDL_INDEX (); - record_unwind_protect (make_serial_process_unwind, proc); + record_unwind_protect (remove_process, proc); p = XPROCESS (proc); - fd = serial_open (SSDATA (port)); + fd = serial_open (port); p->infd = fd; p->outfd = fd; if (fd > max_desc) @@ -2789,7 +2740,7 @@ usage: (make-serial-process &rest ARGS) */) p->kill_without_query = 1; if (tem = Fplist_get (contact, QCstop), !NILP (tem)) pset_command (p, Qt); - p->pty_flag = 0; + eassert (! p->pty_flag); if (!EQ (p->command, Qt)) add_non_keyboard_read_fd (fd); @@ -3196,7 +3147,7 @@ usage: (make-network-process &rest ARGS) */) #ifdef POLL_FOR_INPUT if (socktype != SOCK_DGRAM) { - record_unwind_protect (unwind_stop_other_atimers, Qnil); + record_unwind_protect_void (run_all_atimers); bind_polling_period (10); } #endif @@ -3356,7 +3307,7 @@ usage: (make-network-process &rest ARGS) */) #endif /* Make us close S if quit. */ - record_unwind_protect (close_file_unwind, make_number (s)); + record_unwind_protect_int (close_file_unwind, s); /* Parse network options in the arg list. We simply ignore anything which isn't a known option (including other keywords). @@ -3447,16 +3398,16 @@ usage: (make-network-process &rest ARGS) */) if (errno == EINTR) goto retry_select; else - report_file_error ("select failed", Qnil); + report_file_error ("Failed select", Qnil); } eassert (sc > 0); len = sizeof xerrno; eassert (FD_ISSET (s, &fdset)); if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) < 0) - report_file_error ("getsockopt failed", Qnil); + report_file_error ("Failed getsockopt", Qnil); if (xerrno) - report_file_errno ("error during connect", Qnil, xerrno); + report_file_errno ("Failed connect", Qnil, xerrno); break; } #endif /* !WINDOWSNT */ @@ -3716,10 +3667,13 @@ format; see the description of ADDRESS in `make-network-process'. */) ptrdiff_t buf_size = 512; int s; Lisp_Object res; + ptrdiff_t count; s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0); if (s < 0) return Qnil; + count = SPECPDL_INDEX (); + record_unwind_protect_int (close_file_unwind, s); do { @@ -3735,9 +3689,7 @@ format; see the description of ADDRESS in `make-network-process'. */) } while (ifconf.ifc_len == buf_size); - emacs_close (s); - - res = Qnil; + res = unbind_to (count, Qnil); ifreq = ifconf.ifc_req; while ((char *) ifreq < (char *) ifconf.ifc_req + ifconf.ifc_len) { @@ -3862,6 +3814,7 @@ FLAGS is the current flags of the interface. */) Lisp_Object elt; int s; bool any = 0; + ptrdiff_t count; #if (! (defined SIOCGIFHWADDR && defined HAVE_STRUCT_IFREQ_IFR_HWADDR) \ && defined HAVE_GETIFADDRS && defined LLADDR) struct ifaddrs *ifap; @@ -3876,6 +3829,8 @@ FLAGS is the current flags of the interface. */) s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0); if (s < 0) return Qnil; + count = SPECPDL_INDEX (); + record_unwind_protect_int (close_file_unwind, s); elt = Qnil; #if defined (SIOCGIFFLAGS) && defined (HAVE_STRUCT_IFREQ_IFR_FLAGS) @@ -3992,9 +3947,7 @@ FLAGS is the current flags of the interface. */) #endif res = Fcons (elt, res); - emacs_close (s); - - return any ? res : Qnil; + return unbind_to (count, any ? res : Qnil); } #endif #endif /* defined (HAVE_NET_IF_H) */ @@ -4164,6 +4117,7 @@ server_accept_connection (Lisp_Object server, int channel) #endif } saddr; socklen_t len = sizeof saddr; + ptrdiff_t count; s = accept4 (channel, &saddr.sa, &len, SOCK_CLOEXEC); @@ -4186,6 +4140,9 @@ server_accept_connection (Lisp_Object server, int channel) return; } + count = SPECPDL_INDEX (); + record_unwind_protect_int (close_file_unwind, s); + connect_counter++; /* Setup a new process to handle the connection. */ @@ -4302,6 +4259,10 @@ server_accept_connection (Lisp_Object server, int channel) pset_filter (p, ps->filter); pset_command (p, Qnil); p->pid = 0; + + /* Discard the unwind protect for closing S. */ + specpdl_ptr = specpdl + count; + p->infd = s; p->outfd = s; pset_status (p, Qrun); @@ -4338,12 +4299,11 @@ server_accept_connection (Lisp_Object server, int channel) build_string ("\n"))); } -static Lisp_Object -wait_reading_process_output_unwind (Lisp_Object data) +static void +wait_reading_process_output_unwind (int data) { clear_waiting_thread_info (); - waiting_for_user_input_p = XINT (data); - return Qnil; + waiting_for_user_input_p = data; } /* This is here so breakpoints can be put on it. */ @@ -4425,8 +4385,8 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, if (wait_proc != NULL) wait_channel = wait_proc->infd; - record_unwind_protect (wait_reading_process_output_unwind, - make_number (waiting_for_user_input_p)); + record_unwind_protect_int (wait_reading_process_output_unwind, + waiting_for_user_input_p); waiting_for_user_input_p = read_kbd; if (time_limit < 0) @@ -4791,7 +4751,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, else if (xerrno == EBADF) emacs_abort (); else - error ("select error: %s", emacs_strerror (xerrno)); + report_file_errno ("Failed select", Qnil, xerrno); } if (no_avail) @@ -5284,9 +5244,7 @@ read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars, sometimes it's simply wrong to wrap (e.g. when called from accept-process-output). */ internal_condition_case_1 (read_process_output_call, - Fcons (outstream, - Fcons (make_lisp_proc (p), - Fcons (text, Qnil))), + list3 (outstream, make_lisp_proc (p), text), !NILP (Vdebug_on_error) ? Qnil : Qerror, read_process_output_error_handler); @@ -5456,7 +5414,7 @@ write_queue_push (struct Lisp_Process *p, Lisp_Object input_obj, if (front) pset_write_queue (p, Fcons (entry, p->write_queue)); else - pset_write_queue (p, nconc2 (p->write_queue, Fcons (entry, Qnil))); + pset_write_queue (p, nconc2 (p->write_queue, list1 (entry))); } /* Remove the first element in the write_queue of process P, put its @@ -5629,7 +5587,7 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len, if (rv >= 0) written = rv; else if (errno == EMSGSIZE) - report_file_error ("sending datagram", Fcons (proc, Qnil)); + report_file_error ("Sending datagram", proc); } else #endif @@ -5706,7 +5664,7 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len, } else /* This is a real error. */ - report_file_error ("writing to process", Fcons (proc, Qnil)); + report_file_error ("Writing to process", proc); } cur_buf += written; cur_len -= written; @@ -6196,7 +6154,7 @@ process has been transmitted to the serial port. */) { #ifndef WINDOWSNT if (tcdrain (XPROCESS (proc)->outfd) != 0) - error ("tcdrain() failed: %s", emacs_strerror (errno)); + report_file_error ("Failed tcdrain", Qnil); #endif /* not WINDOWSNT */ /* Do nothing on Windows because writes are blocking. */ } @@ -6425,8 +6383,7 @@ exec_sentinel (Lisp_Object proc, Lisp_Object reason) running_asynch_code = 1; internal_condition_case_1 (read_process_output_call, - Fcons (sentinel, - Fcons (proc, Fcons (reason, Qnil))), + list3 (sentinel, proc, reason), !NILP (Vdebug_on_error) ? Qnil : Qerror, exec_sentinel_error_handler); @@ -6890,7 +6847,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, if (xerrno == EINTR) FD_ZERO (&waitchannels); else - error ("select error: %s", emacs_strerror (xerrno)); + report_file_errno ("Failed select", Qnil, xerrno); } /* Check for keyboard input */ diff --git a/src/search.c b/src/search.c index ff47bb2fecf..e1147aca858 100644 --- a/src/search.c +++ b/src/search.c @@ -3016,11 +3016,11 @@ restore_search_regs (void) } } -static Lisp_Object +static void unwind_set_match_data (Lisp_Object list) { /* It is NOT ALWAYS safe to free (evaporate) the markers immediately. */ - return Fset_match_data (list, Qt); + Fset_match_data (list, Qt); } /* Called to unwind protect the match data. */ diff --git a/src/sound.c b/src/sound.c index 5ce185ea60e..27e06b8abab 100644 --- a/src/sound.c +++ b/src/sound.c @@ -437,10 +437,10 @@ find_sound_type (struct sound *s) } -/* Function installed by play-sound-internal with record_unwind_protect. */ +/* Function installed by play-sound-internal with record_unwind_protect_void. */ -static Lisp_Object -sound_cleanup (Lisp_Object arg) +static void +sound_cleanup (void) { if (current_sound_device->close) current_sound_device->close (current_sound_device); @@ -448,8 +448,6 @@ sound_cleanup (Lisp_Object arg) emacs_close (current_sound->fd); xfree (current_sound_device); xfree (current_sound); - - return Qnil; } /*********************************************************************** @@ -1346,13 +1344,13 @@ Internal use only, use `play-sound' instead. */) GCPRO2 (sound, file); current_sound_device = xzalloc (sizeof *current_sound_device); current_sound = xzalloc (sizeof *current_sound); - record_unwind_protect (sound_cleanup, Qnil); + record_unwind_protect_void (sound_cleanup); current_sound->header = alloca (MAX_SOUND_HEADER_BYTES); if (STRINGP (attrs[SOUND_FILE])) { /* Open the sound file. */ - current_sound->fd = openp (Fcons (Vdata_directory, Qnil), + current_sound->fd = openp (list1 (Vdata_directory), attrs[SOUND_FILE], Qnil, &file, Qnil); if (current_sound->fd < 0) sound_perror ("Could not open sound file"); diff --git a/src/sysdep.c b/src/sysdep.c index f614d8bc557..11a6f4a76ce 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -42,9 +42,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #endif #ifdef __FreeBSD__ -#include <sys/user.h> -#include <sys/resource.h> -#include <math.h> +/* Sparc/ARM machine/frame.h has 'struct frame' which conflicts with Emacs's + 'struct frame', so rename it. */ +# define frame freebsd_frame +# include <sys/user.h> +# undef frame + +# include <sys/resource.h> +# include <math.h> #endif #ifdef WINDOWSNT @@ -2201,6 +2206,20 @@ emacs_fopen (char const *file, char const *mode) return fd < 0 ? 0 : fdopen (fd, mode); } +/* Create a pipe for Emacs use. */ + +int +emacs_pipe (int fd[2]) +{ + int result = pipe2 (fd, O_CLOEXEC); + if (! O_CLOEXEC && result == 0) + { + fcntl (fd[0], F_SETFD, FD_CLOEXEC); + fcntl (fd[1], F_SETFD, FD_CLOEXEC); + } + return result; +} + /* Approximate posix_close and POSIX_CLOSE_RESTART well enough for Emacs. For the background behind this mess, please see Austin Group defect 529 <http://austingroupbugs.net/view.php?id=529>. */ @@ -2422,14 +2441,11 @@ safe_strsignal (int code) #ifndef DOS_NT /* For make-serial-process */ int -serial_open (char *port) +serial_open (Lisp_Object port) { - int fd = emacs_open (port, O_RDWR | O_NOCTTY | O_NONBLOCK, 0); + int fd = emacs_open (SSDATA (port), O_RDWR | O_NOCTTY | O_NONBLOCK, 0); if (fd < 0) - { - error ("Could not open %s: %s", - port, emacs_strerror (errno)); - } + report_file_error ("Opening serial port", port); #ifdef TIOCEXCL ioctl (fd, TIOCEXCL, (char *) 0); #endif @@ -2477,7 +2493,7 @@ serial_configure (struct Lisp_Process *p, /* Read port attributes and prepare default configuration. */ err = tcgetattr (p->outfd, &attr); if (err != 0) - error ("tcgetattr() failed: %s", emacs_strerror (errno)); + report_file_error ("Failed tcgetattr", Qnil); cfmakeraw (&attr); #if defined (CLOCAL) attr.c_cflag |= CLOCAL; @@ -2494,8 +2510,7 @@ serial_configure (struct Lisp_Process *p, CHECK_NUMBER (tem); err = cfsetspeed (&attr, XINT (tem)); if (err != 0) - error ("cfsetspeed(%"pI"d) failed: %s", XINT (tem), - emacs_strerror (errno)); + report_file_error ("Failed cfsetspeed", tem); childp2 = Fplist_put (childp2, QCspeed, tem); /* Configure bytesize. */ @@ -2617,7 +2632,7 @@ serial_configure (struct Lisp_Process *p, /* Activate configuration. */ err = tcsetattr (p->outfd, TCSANOW, &attr); if (err != 0) - error ("tcsetattr() failed: %s", emacs_strerror (errno)); + report_file_error ("Failed tcsetattr", Qnil); childp2 = Fplist_put (childp2, QCsummary, build_string (summary)); pset_childp (p, childp2); @@ -2797,11 +2812,12 @@ get_up_time (void) static Lisp_Object procfs_ttyname (int rdev) { - FILE *fdev = NULL; + FILE *fdev; char name[PATH_MAX]; block_input (); fdev = emacs_fopen ("/proc/tty/drivers", "r"); + name[0] = 0; if (fdev) { @@ -2810,7 +2826,7 @@ procfs_ttyname (int rdev) char minor[25]; /* 2 32-bit numbers + dash */ char *endp; - while (!feof (fdev) && !ferror (fdev)) + for (; !feof (fdev) && !ferror (fdev); name[0] = 0) { if (fscanf (fdev, "%*s %s %u %s %*s\n", name, &major, minor) >= 3 && major == MAJOR (rdev)) @@ -2839,7 +2855,7 @@ procfs_ttyname (int rdev) static unsigned long procfs_get_total_memory (void) { - FILE *fmem = NULL; + FILE *fmem; unsigned long retval = 2 * 1024 * 1024; /* default: 2GB */ block_input (); @@ -2882,7 +2898,7 @@ system_process_attributes (Lisp_Object pid) int cmdsize = sizeof default_cmd - 1; char *cmdline = NULL; ptrdiff_t cmdline_size; - unsigned char c; + char c; printmax_t proc_id; int ppid, pgrp, sess, tty, tpgid, thcount; uid_t uid; @@ -2893,7 +2909,8 @@ system_process_attributes (Lisp_Object pid) EMACS_TIME tnow, tstart, tboot, telapsed, us_time; double pcpu, pmem; Lisp_Object attrs = Qnil; - Lisp_Object cmd_str, decoded_cmd, tem; + Lisp_Object cmd_str, decoded_cmd; + ptrdiff_t count; struct gcpro gcpro1, gcpro2; CHECK_NUMBER_OR_FLOAT (pid); @@ -2921,11 +2938,19 @@ system_process_attributes (Lisp_Object pid) if (gr) attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs); + count = SPECPDL_INDEX (); strcpy (fn, procfn); procfn_end = fn + strlen (fn); strcpy (procfn_end, "/stat"); fd = emacs_open (fn, O_RDONLY, 0); - if (fd >= 0 && (nread = emacs_read (fd, procbuf, sizeof (procbuf) - 1)) > 0) + if (fd < 0) + nread = 0; + else + { + record_unwind_protect_int (close_file_unwind, fd); + nread = emacs_read (fd, procbuf, sizeof procbuf - 1); + } + if (0 < nread) { procbuf[nread] = '\0'; p = procbuf; @@ -2949,39 +2974,32 @@ system_process_attributes (Lisp_Object pid) Vlocale_coding_system, 0); attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs); - if (q) + /* state ppid pgrp sess tty tpgid . minflt cminflt majflt cmajflt + utime stime cutime cstime priority nice thcount . start vsize rss */ + if (q + && (sscanf (q + 2, ("%c %d %d %d %d %d %*u %lu %lu %lu %lu " + "%Lu %Lu %Lu %Lu %ld %ld %d %*d %Lu %lu %ld"), + &c, &ppid, &pgrp, &sess, &tty, &tpgid, + &minflt, &cminflt, &majflt, &cmajflt, + &u_time, &s_time, &cutime, &cstime, + &priority, &niceness, &thcount, &start, &vsize, &rss) + == 20)) { - EMACS_INT ppid_eint, pgrp_eint, sess_eint, tpgid_eint, thcount_eint; - p = q + 2; - /* state ppid pgrp sess tty tpgid . minflt cminflt majflt cmajflt utime stime cutime cstime priority nice thcount . start vsize rss */ - sscanf (p, "%c %d %d %d %d %d %*u %lu %lu %lu %lu %Lu %Lu %Lu %Lu %ld %ld %d %*d %Lu %lu %ld", - &c, &ppid, &pgrp, &sess, &tty, &tpgid, - &minflt, &cminflt, &majflt, &cmajflt, - &u_time, &s_time, &cutime, &cstime, - &priority, &niceness, &thcount, &start, &vsize, &rss); - { - char state_str[2]; - - state_str[0] = c; - state_str[1] = '\0'; - tem = build_string (state_str); - attrs = Fcons (Fcons (Qstate, tem), attrs); - } - /* Stops GCC whining about limited range of data type. */ - ppid_eint = ppid; - pgrp_eint = pgrp; - sess_eint = sess; - tpgid_eint = tpgid; - thcount_eint = thcount; - attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (ppid_eint)), attrs); - attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (pgrp_eint)), attrs); - attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (sess_eint)), attrs); + char state_str[2]; + state_str[0] = c; + state_str[1] = '\0'; + attrs = Fcons (Fcons (Qstate, build_string (state_str)), attrs); + attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (ppid)), attrs); + attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (pgrp)), attrs); + attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (sess)), attrs); attrs = Fcons (Fcons (Qttname, procfs_ttyname (tty)), attrs); - attrs = Fcons (Fcons (Qtpgid, make_fixnum_or_float (tpgid_eint)), attrs); + attrs = Fcons (Fcons (Qtpgid, make_fixnum_or_float (tpgid)), attrs); attrs = Fcons (Fcons (Qminflt, make_fixnum_or_float (minflt)), attrs); attrs = Fcons (Fcons (Qmajflt, make_fixnum_or_float (majflt)), attrs); - attrs = Fcons (Fcons (Qcminflt, make_fixnum_or_float (cminflt)), attrs); - attrs = Fcons (Fcons (Qcmajflt, make_fixnum_or_float (cmajflt)), attrs); + attrs = Fcons (Fcons (Qcminflt, make_fixnum_or_float (cminflt)), + attrs); + attrs = Fcons (Fcons (Qcmajflt, make_fixnum_or_float (cmajflt)), + attrs); clocks_per_sec = sysconf (_SC_CLK_TCK); if (clocks_per_sec < 0) clocks_per_sec = 100; @@ -3002,19 +3020,22 @@ system_process_attributes (Lisp_Object pid) ltime_from_jiffies (cstime, clocks_per_sec)), attrs); attrs = Fcons (Fcons (Qctime, - ltime_from_jiffies (cstime+cutime, clocks_per_sec)), + ltime_from_jiffies (cstime + cutime, + clocks_per_sec)), attrs); attrs = Fcons (Fcons (Qpri, make_number (priority)), attrs); attrs = Fcons (Fcons (Qnice, make_number (niceness)), attrs); - attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (thcount_eint)), attrs); + attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (thcount)), + attrs); tnow = current_emacs_time (); telapsed = get_up_time (); tboot = sub_emacs_time (tnow, telapsed); tstart = time_from_jiffies (start, clocks_per_sec); tstart = add_emacs_time (tboot, tstart); attrs = Fcons (Fcons (Qstart, make_lisp_time (tstart)), attrs); - attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (vsize/1024)), attrs); - attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (4*rss)), attrs); + attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (vsize / 1024)), + attrs); + attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (4 * rss)), attrs); telapsed = sub_emacs_time (tnow, tstart); attrs = Fcons (Fcons (Qetime, make_lisp_time (telapsed)), attrs); us_time = time_from_jiffies (u_time + s_time, clocks_per_sec); @@ -3029,67 +3050,63 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qpmem, make_float (pmem)), attrs); } } - if (fd >= 0) - emacs_close (fd); + unbind_to (count, Qnil); /* args */ strcpy (procfn_end, "/cmdline"); fd = emacs_open (fn, O_RDONLY, 0); if (fd >= 0) { - char ch; - for (cmdline_size = 0; cmdline_size < STRING_BYTES_BOUND; cmdline_size++) + ptrdiff_t readsize, nread_incr; + record_unwind_protect_int (close_file_unwind, fd); + record_unwind_protect_nothing (); + nread = cmdline_size = 0; + + do { - if (emacs_read (fd, &ch, 1) != 1) - break; - c = ch; - if (c_isspace (c) || c == '\\') - cmdline_size++; /* for later quoting, see below */ + cmdline = xpalloc (cmdline, &cmdline_size, 2, STRING_BYTES_BOUND, 1); + set_unwind_protect_ptr (count + 1, xfree, cmdline); + + /* Leave room even if every byte needs escaping below. */ + readsize = (cmdline_size >> 1) - nread; + + nread_incr = emacs_read (fd, cmdline + nread, readsize); + nread += max (0, nread_incr); } - if (cmdline_size) + while (nread_incr == readsize); + + if (nread) { - cmdline = xmalloc (cmdline_size + 1); - lseek (fd, 0L, SEEK_SET); - cmdline[0] = '\0'; - if ((nread = read (fd, cmdline, cmdline_size)) >= 0) - cmdline[nread++] = '\0'; - else - { - /* Assigning zero to `nread' makes us skip the following - two loops, assign zero to cmdline_size, and enter the - following `if' clause that handles unknown command - lines. */ - nread = 0; - } /* We don't want trailing null characters. */ - for (p = cmdline + nread; p > cmdline + 1 && !p[-1]; p--) - nread--; - for (p = cmdline; p < cmdline + nread; p++) + for (p = cmdline + nread; cmdline < p && !p[-1]; p--) + continue; + + /* Escape-quote whitespace and backslashes. */ + q = cmdline + cmdline_size; + while (cmdline < p) { - /* Escape-quote whitespace and backslashes. */ - if (c_isspace (*p) || *p == '\\') - { - memmove (p + 1, p, nread - (p - cmdline)); - nread++; - *p++ = '\\'; - } - else if (*p == '\0') - *p = ' '; + char c = *--p; + *--q = c ? c : ' '; + if (c_isspace (c) || c == '\\') + *--q = '\\'; } - cmdline_size = nread; + + nread = cmdline + cmdline_size - q; } - if (!cmdline_size) + + if (!nread) { - cmdline_size = cmdsize + 2; - cmdline = xmalloc (cmdline_size + 1); + nread = cmdsize + 2; + cmdline_size = nread + 1; + q = cmdline = xrealloc (cmdline, cmdline_size); + set_unwind_protect_ptr (count + 1, xfree, cmdline); sprintf (cmdline, "[%.*s]", cmdsize, cmd); } - emacs_close (fd); /* Command line is encoded in locale-coding-system; decode it. */ - cmd_str = make_unibyte_string (cmdline, cmdline_size); + cmd_str = make_unibyte_string (q, nread); decoded_cmd = code_convert_string_norecord (cmd_str, Vlocale_coding_system, 0); - xfree (cmdline); + unbind_to (count, Qnil); attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs); } @@ -3131,8 +3148,9 @@ system_process_attributes (Lisp_Object pid) uid_t uid; gid_t gid; Lisp_Object attrs = Qnil; - Lisp_Object decoded_cmd, tem; + Lisp_Object decoded_cmd; struct gcpro gcpro1, gcpro2; + ptrdiff_t count; CHECK_NUMBER_OR_FLOAT (pid); CONS_TO_INTEGER (pid, pid_t, proc_id); @@ -3159,72 +3177,83 @@ system_process_attributes (Lisp_Object pid) if (gr) attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs); + count = SPECPDL_INDEX (); strcpy (fn, procfn); procfn_end = fn + strlen (fn); strcpy (procfn_end, "/psinfo"); fd = emacs_open (fn, O_RDONLY, 0); - if (fd >= 0 - && (nread = read (fd, (char*)&pinfo, sizeof (struct psinfo)) > 0)) + if (fd < 0) + nread = 0; + else { - attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (pinfo.pr_ppid)), attrs); - attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (pinfo.pr_pgid)), attrs); - attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (pinfo.pr_sid)), attrs); - - { - char state_str[2]; - state_str[0] = pinfo.pr_lwp.pr_sname; - state_str[1] = '\0'; - tem = build_string (state_str); - attrs = Fcons (Fcons (Qstate, tem), attrs); - } - - /* FIXME: missing Qttyname. psinfo.pr_ttydev is a dev_t, - need to get a string from it. */ - - /* FIXME: missing: Qtpgid */ - - /* FIXME: missing: - Qminflt - Qmajflt - Qcminflt - Qcmajflt - - Qutime - Qcutime - Qstime - Qcstime - Are they available? */ - - attrs = Fcons (Fcons (Qtime, make_lisp_time (pinfo.pr_time)), attrs); - attrs = Fcons (Fcons (Qctime, make_lisp_time (pinfo.pr_ctime)), attrs); - attrs = Fcons (Fcons (Qpri, make_number (pinfo.pr_lwp.pr_pri)), attrs); - attrs = Fcons (Fcons (Qnice, make_number (pinfo.pr_lwp.pr_nice)), attrs); - attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (pinfo.pr_nlwp)), attrs); - - attrs = Fcons (Fcons (Qstart, make_lisp_time (pinfo.pr_start)), attrs); - attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (pinfo.pr_size)), attrs); - attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (pinfo.pr_rssize)), attrs); - - /* pr_pctcpu and pr_pctmem are unsigned integers in the - range 0 .. 2**15, representing 0.0 .. 1.0. */ - attrs = Fcons (Fcons (Qpcpu, make_float (100.0 / 0x8000 * pinfo.pr_pctcpu)), attrs); - attrs = Fcons (Fcons (Qpmem, make_float (100.0 / 0x8000 * pinfo.pr_pctmem)), attrs); - - decoded_cmd - = code_convert_string_norecord (make_unibyte_string (pinfo.pr_fname, - strlen (pinfo.pr_fname)), - Vlocale_coding_system, 0); - attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs); - decoded_cmd - = code_convert_string_norecord (make_unibyte_string (pinfo.pr_psargs, - strlen (pinfo.pr_psargs)), - Vlocale_coding_system, 0); - attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs); + record_unwind_protect (close_file_unwind, fd); + nread = emacs_read (fd, &pinfo, sizeof pinfo); } - if (fd >= 0) - emacs_close (fd); + if (nread == sizeof pinfo) + { + attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (pinfo.pr_ppid)), attrs); + attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (pinfo.pr_pgid)), attrs); + attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (pinfo.pr_sid)), attrs); + { + char state_str[2]; + state_str[0] = pinfo.pr_lwp.pr_sname; + state_str[1] = '\0'; + attrs = Fcons (Fcons (Qstate, build_string (state_str)), attrs); + } + + /* FIXME: missing Qttyname. psinfo.pr_ttydev is a dev_t, + need to get a string from it. */ + + /* FIXME: missing: Qtpgid */ + + /* FIXME: missing: + Qminflt + Qmajflt + Qcminflt + Qcmajflt + + Qutime + Qcutime + Qstime + Qcstime + Are they available? */ + + attrs = Fcons (Fcons (Qtime, make_lisp_time (pinfo.pr_time)), attrs); + attrs = Fcons (Fcons (Qctime, make_lisp_time (pinfo.pr_ctime)), attrs); + attrs = Fcons (Fcons (Qpri, make_number (pinfo.pr_lwp.pr_pri)), attrs); + attrs = Fcons (Fcons (Qnice, make_number (pinfo.pr_lwp.pr_nice)), attrs); + attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (pinfo.pr_nlwp)), + attrs); + + attrs = Fcons (Fcons (Qstart, make_lisp_time (pinfo.pr_start)), attrs); + attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (pinfo.pr_size)), + attrs); + attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (pinfo.pr_rssize)), + attrs); + + /* pr_pctcpu and pr_pctmem are unsigned integers in the + range 0 .. 2**15, representing 0.0 .. 1.0. */ + attrs = Fcons (Fcons (Qpcpu, + make_float (100.0 / 0x8000 * pinfo.pr_pctcpu)), + attrs); + attrs = Fcons (Fcons (Qpmem, + make_float (100.0 / 0x8000 * pinfo.pr_pctmem)), + attrs); + + decoded_cmd = (code_convert_string_norecord + (make_unibyte_string (pinfo.pr_fname, + strlen (pinfo.pr_fname)), + Vlocale_coding_system, 0)); + attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs); + decoded_cmd = (code_convert_string_norecord + (make_unibyte_string (pinfo.pr_psargs, + strlen (pinfo.pr_psargs)), + Vlocale_coding_system, 0)); + attrs = Fcons (Fcons (Qargs, decoded_cmd), attrs); + } + unbind_to (count, Qnil); UNGCPRO; return attrs; } diff --git a/src/systty.h b/src/systty.h index 6d38c980725..b735971c66f 100644 --- a/src/systty.h +++ b/src/systty.h @@ -79,5 +79,5 @@ struct emacs_tty { }; /* From sysdep.c or w32.c */ -extern int serial_open (char *); +extern int serial_open (Lisp_Object); extern void serial_configure (struct Lisp_Process *, Lisp_Object); diff --git a/src/term.c b/src/term.c index b6878a0abd1..376d6e7831a 100644 --- a/src/term.c +++ b/src/term.c @@ -2416,15 +2416,20 @@ frame's terminal). */) t->display_info.tty->input = stdin; #else /* !MSDOS */ fd = emacs_open (t->display_info.tty->name, O_RDWR | O_NOCTTY, 0); + t->display_info.tty->input = t->display_info.tty->output + = fd < 0 ? 0 : fdopen (fd, "w+"); - if (fd == -1) - error ("Can not reopen tty device %s: %s", t->display_info.tty->name, strerror (errno)); + if (! t->display_info.tty->input) + { + int open_errno = errno; + emacs_close (fd); + report_file_errno ("Cannot reopen tty device", + build_string (t->display_info.tty->name), + open_errno); + } if (!O_IGNORE_CTTY && strcmp (t->display_info.tty->name, DEV_TTY) != 0) dissociate_if_controlling_tty (fd); - - t->display_info.tty->output = fdopen (fd, "w+"); - t->display_info.tty->input = t->display_info.tty->output; #endif add_keyboard_wait_descriptor (fd); @@ -2990,7 +2995,6 @@ init_tty (const char *name, const char *terminal_type, bool must_succeed) { /* Open the terminal device. */ - FILE *file; /* If !ctty, don't recognize it as our controlling terminal, and don't make it the controlling tty if we don't have one now. @@ -3001,30 +3005,21 @@ init_tty (const char *name, const char *terminal_type, bool must_succeed) open a frame on the same terminal. */ int flags = O_RDWR | O_NOCTTY | (ctty ? 0 : O_IGNORE_CTTY); int fd = emacs_open (name, flags, 0); + tty->input = tty->output = fd < 0 || ! isatty (fd) ? 0 : fdopen (fd, "w+"); - tty->name = xstrdup (name); - terminal->name = xstrdup (name); - - if (fd < 0) - maybe_fatal (must_succeed, terminal, - "Could not open file: %s", - "Could not open file: %s", - name); - if (!isatty (fd)) + if (! tty->input) { - emacs_close (fd); - maybe_fatal (must_succeed, terminal, - "Not a tty device: %s", - "Not a tty device: %s", - name); + char const *diagnostic + = tty->input ? "Not a tty device: %s" : "Could not open file: %s"; + emacs_close (fd); + maybe_fatal (must_succeed, terminal, diagnostic, diagnostic, name); } + tty->name = xstrdup (name); + terminal->name = xstrdup (name); + if (!O_IGNORE_CTTY && !ctty) dissociate_if_controlling_tty (fd); - - file = fdopen (fd, "w+"); - tty->input = file; - tty->output = file; } tty->type = xstrdup (terminal_type); diff --git a/src/termhooks.h b/src/termhooks.h index 0190478c254..b49a7bc706b 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -172,6 +172,8 @@ enum event_kind `switch-frame' events in kbd_buffer_get_event, if necessary. */ FOCUS_IN_EVENT, + FOCUS_OUT_EVENT, + /* Generated when mouse moves over window not currently selected. */ SELECT_WINDOW_EVENT, diff --git a/src/textprop.c b/src/textprop.c index e5d4fe06c60..282ae11d4ac 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -226,7 +226,7 @@ validate_plist (Lisp_Object list) return list; } - return Fcons (list, Fcons (Qnil, Qnil)); + return list2 (list, Qnil); } /* Return true if interval I has all the properties, @@ -436,16 +436,14 @@ add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object, if (set_type == TEXT_PROPERTY_PREPEND) Fsetcar (this_cdr, Fcons (val1, Fcar (this_cdr))); else - nconc2 (Fcar (this_cdr), Fcons (val1, Qnil)); + nconc2 (Fcar (this_cdr), list1 (val1)); else { /* The previous value is a single value, so make it into a list. */ if (set_type == TEXT_PROPERTY_PREPEND) - Fsetcar (this_cdr, - Fcons (val1, Fcons (Fcar (this_cdr), Qnil))); + Fsetcar (this_cdr, list2 (val1, Fcar (this_cdr))); else - Fsetcar (this_cdr, - Fcons (Fcar (this_cdr), Fcons (val1, Qnil))); + Fsetcar (this_cdr, list2 (Fcar (this_cdr), val1)); } } changed = 1; @@ -1308,9 +1306,7 @@ the current buffer), START and END are buffer positions (integers or markers). If OBJECT is a string, START and END are 0-based indices into it. */) (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object) { - Fadd_text_properties (start, end, - Fcons (property, Fcons (value, Qnil)), - object); + Fadd_text_properties (start, end, list2 (property, value), object); return Qnil; } @@ -1344,11 +1340,10 @@ into it. */) (Lisp_Object start, Lisp_Object end, Lisp_Object face, Lisp_Object appendp, Lisp_Object object) { - add_text_properties_1 (start, end, - Fcons (Qface, Fcons (face, Qnil)), - object, - NILP (appendp)? TEXT_PROPERTY_PREPEND: - TEXT_PROPERTY_APPEND); + add_text_properties_1 (start, end, list2 (Qface, face), object, + (NILP (appendp) + ? TEXT_PROPERTY_PREPEND + : TEXT_PROPERTY_APPEND)); return Qnil; } @@ -1929,7 +1924,7 @@ copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, Lisp_ { if (EQ (Fcar (plist), prop)) { - plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil)); + plist = list2 (prop, Fcar (Fcdr (plist))); break; } plist = Fcdr (Fcdr (plist)); @@ -1938,10 +1933,8 @@ copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, Lisp_ { /* Must defer modifications to the interval tree in case src and dest refer to the same string or buffer. */ - stuff = Fcons (Fcons (make_number (p), - Fcons (make_number (p + len), - Fcons (plist, Qnil))), - stuff); + stuff = Fcons (list3 (make_number (p), make_number (p + len), plist), + stuff); } i = next_interval (i); @@ -2007,14 +2000,13 @@ text_property_list (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp for (; CONSP (plist); plist = Fcdr (XCDR (plist))) if (EQ (XCAR (plist), prop)) { - plist = Fcons (prop, Fcons (Fcar (XCDR (plist)), Qnil)); + plist = list2 (prop, Fcar (XCDR (plist))); break; } if (!NILP (plist)) - result = Fcons (Fcons (make_number (s), - Fcons (make_number (s + len), - Fcons (plist, Qnil))), + result = Fcons (list3 (make_number (s), make_number (s + len), + plist), result); i = next_interval (i); @@ -2343,8 +2335,8 @@ inherits it if NONSTICKINESS is nil. The `front-sticky' and /* Text properties `syntax-table'and `display' should be nonsticky by default. */ Vtext_property_default_nonsticky - = Fcons (Fcons (intern_c_string ("syntax-table"), Qt), - Fcons (Fcons (intern_c_string ("display"), Qt), Qnil)); + = list2 (Fcons (intern_c_string ("syntax-table"), Qt), + Fcons (intern_c_string ("display"), Qt)); staticpro (&interval_insert_behind_hooks); staticpro (&interval_insert_in_front_hooks); diff --git a/src/unexaix.c b/src/unexaix.c index 757ba6f51b3..fc1acc9ab4f 100644 --- a/src/unexaix.c +++ b/src/unexaix.c @@ -97,7 +97,7 @@ report_error (const char *file, int fd) int err = errno; if (fd) emacs_close (fd); - report_file_errno ("Cannot unexec", Fcons (build_string (file), Qnil), err); + report_file_errno ("Cannot unexec", build_string (file), err); } #define ERROR0(msg) report_error_1 (new, msg) diff --git a/src/unexcoff.c b/src/unexcoff.c index c467e59a665..5ac8ea8c9b0 100644 --- a/src/unexcoff.c +++ b/src/unexcoff.c @@ -130,7 +130,7 @@ report_error (const char *file, int fd) int err = errno; if (fd) emacs_close (fd); - report_file_errno ("Cannot unexec", Fcons (build_string (file), Qnil), err); + report_file_errno ("Cannot unexec", build_string (file), err); } #define ERROR0(msg) report_error_1 (new, msg, 0, 0); return -1 diff --git a/src/unexsol.c b/src/unexsol.c index 470206d5838..cfd515ff504 100644 --- a/src/unexsol.c +++ b/src/unexsol.c @@ -20,7 +20,7 @@ unexec (const char *new_name, const char *old_name) if (! dldump (0, new_name, RTLD_MEMORY)) return; - data = Fcons (build_string (new_name), Qnil); + data = list1 (build_string (new_name)); synchronize_system_messages_locale (); errstring = code_convert_string_norecord (build_string (dlerror ()), Vlocale_coding_system, 0); diff --git a/src/w32.c b/src/w32.c index 1a3d81bbffc..fb2d7c75972 100644 --- a/src/w32.c +++ b/src/w32.c @@ -7707,8 +7707,9 @@ globals_of_w32 (void) /* For make-serial-process */ int -serial_open (char *port) +serial_open (Lisp_Object port_obj) { + char *port = SSDATA (port_obj); HANDLE hnd; child_process *cp; int fd = -1; diff --git a/src/w32fns.c b/src/w32fns.c index 3fa23c166e2..675b716f3b0 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -318,7 +318,7 @@ x_window_to_frame (struct w32_display_info *dpyinfo, HWND wdesc) static Lisp_Object unwind_create_frame (Lisp_Object); -static Lisp_Object unwind_create_tip_frame (Lisp_Object); +static void unwind_create_tip_frame (Lisp_Object); static void my_create_window (struct frame *); static void my_create_tip_window (struct frame *); @@ -4259,6 +4259,12 @@ unwind_create_frame (Lisp_Object frame) } static void +do_unwind_create_frame (Lisp_Object frame) +{ + unwind_create_frame (frame); +} + +static void x_default_font_parameter (struct frame *f, Lisp_Object parms) { struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f); @@ -4398,7 +4404,7 @@ This function is an internal primitive--use `make-frame' instead. */) /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */ /* With FRAME_X_DISPLAY_INFO set up, this unwind-protect is safe. */ - record_unwind_protect (unwind_create_frame, frame); + record_unwind_protect (do_unwind_create_frame, frame); #ifdef GLYPH_DEBUG image_cache_refcount = FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0; @@ -4910,7 +4916,7 @@ w32_monitor_enum (HMONITOR monitor, HDC hdc, RECT *rcMonitor, LPARAM dwData) { Lisp_Object *monitor_list = (Lisp_Object *) dwData; - *monitor_list = Fcons (make_save_pointer (monitor), *monitor_list); + *monitor_list = Fcons (make_save_ptr (monitor), *monitor_list); return TRUE; } @@ -5585,7 +5591,7 @@ Window tip_window; Lisp_Object last_show_tip_args; -static Lisp_Object +static void unwind_create_tip_frame (Lisp_Object frame) { Lisp_Object deleted; @@ -5596,8 +5602,6 @@ unwind_create_tip_frame (Lisp_Object frame) tip_window = NULL; tip_frame = Qnil; } - - return deleted; } diff --git a/src/w32term.c b/src/w32term.c index c9951ca1d52..0b22fd178e4 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -2912,9 +2912,15 @@ x_focus_changed (int type, int state, struct w32_display_info *dpyinfo, && CONSP (Vframe_list) && !NILP (XCDR (Vframe_list))) { - bufp->kind = FOCUS_IN_EVENT; - XSETFRAME (bufp->frame_or_window, frame); + bufp->arg = Qt; } + else + { + bufp->arg = Qnil; + } + + bufp->kind = FOCUS_IN_EVENT; + XSETFRAME (bufp->frame_or_window, frame); } frame->output_data.x->focus_state |= state; @@ -2929,7 +2935,10 @@ x_focus_changed (int type, int state, struct w32_display_info *dpyinfo, { dpyinfo->w32_focus_event_frame = 0; x_new_focus_frame (dpyinfo, 0); - } + + bufp->kind = FOCUS_OUT_EVENT; + XSETFRAME (bufp->frame_or_window, frame); + } /* TODO: IME focus? */ } @@ -4351,8 +4360,9 @@ w32_read_socket (struct terminal *terminal, SET_FRAME_VISIBLE (f, 1); SET_FRAME_ICONIFIED (f, 0); SET_FRAME_GARBAGED (f); - DebPrint (("frame %p (%s) reexposed by WM_PAINT\n", f, - SDATA (f->name))); + if (!f->output_data.w32->asked_for_visible) + DebPrint (("frame %p (%s) reexposed by WM_PAINT\n", f, + SDATA (f->name))); /* WM_PAINT serves as MapNotify as well, so report visibility changes properly. */ @@ -4810,7 +4820,8 @@ w32_read_socket (struct terminal *terminal, { bool iconified = FRAME_ICONIFIED_P (f); - SET_FRAME_VISIBLE (f, 1); + if (iconified) + SET_FRAME_VISIBLE (f, 1); SET_FRAME_ICONIFIED (f, 0); /* wait_reading_process_output will notice this @@ -5174,7 +5185,10 @@ x_draw_hollow_cursor (struct window *w, struct glyph_row *row) the current matrix is invalid or such, give up. */ cursor_glyph = get_phys_cursor_glyph (w); if (cursor_glyph == NULL) - return; + { + DeleteObject (hb); + return; + } /* Compute frame-relative coordinates for phys cursor. */ get_phys_cursor_geometry (w, row, cursor_glyph, &left, &top, &h); @@ -6117,6 +6131,9 @@ x_iconify_frame (struct frame *f) /* Simulate the user minimizing the frame. */ SendMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, SC_MINIMIZE, 0); + SET_FRAME_VISIBLE (f, 0); + SET_FRAME_ICONIFIED (f, 1); + unblock_input (); } diff --git a/src/window.c b/src/window.c index ba9728f09af..bf4ce1dbe39 100644 --- a/src/window.c +++ b/src/window.c @@ -3086,18 +3086,18 @@ run_funs (Lisp_Object funs) call0 (XCAR (funs)); } -static Lisp_Object +static void select_window_norecord (Lisp_Object window) { - return WINDOW_LIVE_P (window) - ? Fselect_window (window, Qt) : selected_window; + if (WINDOW_LIVE_P (window)) + Fselect_window (window, Qt); } -static Lisp_Object +static void select_frame_norecord (Lisp_Object frame) { - return FRAME_LIVE_P (XFRAME (frame)) - ? Fselect_frame (frame, Qt) : selected_frame; + if (FRAME_LIVE_P (XFRAME (frame))) + Fselect_frame (frame, Qt); } void @@ -3410,7 +3410,7 @@ temp_output_buffer_show (register Lisp_Object buf) Note: Both Fselect_window and select_window_norecord may set-buffer to the buffer displayed in the window, so we need to save the current buffer. --stef */ - record_unwind_protect (Fset_buffer, prev_buffer); + record_unwind_protect (restore_buffer, prev_buffer); record_unwind_protect (select_window_norecord, prev_window); Fselect_window (window, Qt); Fset_buffer (w->contents); @@ -5873,6 +5873,12 @@ the return value is nil. Otherwise the value is t. */) return (FRAME_LIVE_P (f) ? Qt : Qnil); } +void +restore_window_configuration (Lisp_Object configuration) +{ + Fset_window_configuration (configuration); +} + /* If WINDOW is an internal window, recursively delete all child windows reachable via the next and contents slots of WINDOW. Otherwise setup diff --git a/src/window.h b/src/window.h index 846831e43d5..5da6165c48d 100644 --- a/src/window.h +++ b/src/window.h @@ -886,6 +886,7 @@ extern Lisp_Object make_window (void); extern Lisp_Object window_from_coordinates (struct frame *, int, int, enum window_part *, bool); extern void resize_frame_windows (struct frame *, int, bool); +extern void restore_window_configuration (Lisp_Object); extern void delete_all_child_windows (Lisp_Object); extern void freeze_window_starts (struct frame *, bool); extern void grow_mini_window (struct window *, int); diff --git a/src/xdisp.c b/src/xdisp.c index 12b294e6800..1da7de5759c 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -813,21 +813,20 @@ static void handle_stop (struct it *); static void handle_stop_backwards (struct it *, ptrdiff_t); static void vmessage (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0); static void ensure_echo_area_buffers (void); -static Lisp_Object unwind_with_echo_area_buffer (Lisp_Object); +static void unwind_with_echo_area_buffer (Lisp_Object); static Lisp_Object with_echo_area_buffer_unwind_data (struct window *); static int with_echo_area_buffer (struct window *, int, int (*) (ptrdiff_t, Lisp_Object), ptrdiff_t, Lisp_Object); static void clear_garbaged_frames (void); static int current_message_1 (ptrdiff_t, Lisp_Object); -static void pop_message (void); static int truncate_message_1 (ptrdiff_t, Lisp_Object); static void set_message (Lisp_Object); static int set_message_1 (ptrdiff_t, Lisp_Object); static int display_echo_area (struct window *); static int display_echo_area_1 (ptrdiff_t, Lisp_Object); static int resize_mini_window_1 (ptrdiff_t, Lisp_Object); -static Lisp_Object unwind_redisplay (Lisp_Object); +static void unwind_redisplay (void); static int string_char_and_length (const unsigned char *, int *); static struct text_pos display_prop_end (struct it *, Lisp_Object, struct text_pos); @@ -10146,7 +10145,7 @@ with_echo_area_buffer_unwind_data (struct window *w) /* Restore global state from VECTOR which was created by with_echo_area_buffer_unwind_data. */ -static Lisp_Object +static void unwind_with_echo_area_buffer (Lisp_Object vector) { set_buffer_internal_1 (XBUFFER (AREF (vector, 0))); @@ -10171,7 +10170,6 @@ unwind_with_echo_area_buffer (Lisp_Object vector) } Vwith_echo_area_save_vector = vector; - return Qnil; } @@ -10570,20 +10568,12 @@ restore_message (void) } -/* Handler for record_unwind_protect calling pop_message. */ - -Lisp_Object -pop_message_unwind (Lisp_Object dummy) -{ - pop_message (); - return Qnil; -} - -/* Pop the top-most entry off Vmessage_stack. */ +/* Handler for unwind-protect calling pop_message. */ -static void -pop_message (void) +void +pop_message_unwind (void) { + /* Pop the top-most entry off Vmessage_stack. */ eassert (CONSP (Vmessage_stack)); Vmessage_stack = XCDR (Vmessage_stack); } @@ -10979,7 +10969,7 @@ format_mode_line_unwind_data (struct frame *target_frame, return vector; } -static Lisp_Object +static void unwind_format_mode_line (Lisp_Object vector) { Lisp_Object old_window = AREF (vector, 7); @@ -11022,7 +11012,6 @@ unwind_format_mode_line (Lisp_Object vector) } Vmode_line_unwind_vector = vector; - return Qnil; } @@ -11471,7 +11460,7 @@ int last_tool_bar_item; do_switch_frame. FIXME: Maybe do_switch_frame should be trimmed down similarly when `norecord' is set. */ -static Lisp_Object +static void fast_set_selected_frame (Lisp_Object frame) { if (!EQ (selected_frame, frame)) @@ -11479,7 +11468,6 @@ fast_set_selected_frame (Lisp_Object frame) selected_frame = frame; selected_window = XFRAME (frame)->selected_window; } - return Qnil; } /* Update the tool-bar item list for frame F. This has to be done @@ -11999,9 +11987,8 @@ redisplay_tool_bar (struct frame *f) XSETFRAME (frame, f); Fmodify_frame_parameters (frame, - Fcons (Fcons (Qtool_bar_lines, - make_number (nlines)), - Qnil)); + list1 (Fcons (Qtool_bar_lines, + make_number (nlines)))); if (WINDOW_TOTAL_LINES (w) != old_height) { clear_glyph_matrix (w->desired_matrix); @@ -12100,9 +12087,8 @@ redisplay_tool_bar (struct frame *f) { XSETFRAME (frame, f); Fmodify_frame_parameters (frame, - Fcons (Fcons (Qtool_bar_lines, - make_number (nlines)), - Qnil)); + list1 (Fcons (Qtool_bar_lines, + make_number (nlines)))); if (WINDOW_TOTAL_LINES (w) != old_height) { clear_glyph_matrix (w->desired_matrix); @@ -12982,7 +12968,7 @@ redisplay_internal (void) /* Record a function that clears redisplaying_p when we leave this function. */ count = SPECPDL_INDEX (); - record_unwind_protect (unwind_redisplay, selected_frame); + record_unwind_protect_void (unwind_redisplay); redisplaying_p = 1; specbind (Qinhibit_free_realized_faces, Qnil); @@ -13662,14 +13648,12 @@ redisplay_preserve_echo_area (int from_where) } -/* Function registered with record_unwind_protect in redisplay_internal. - Clear redisplaying_p. Also select the previously selected frame. */ +/* Function registered with record_unwind_protect in redisplay_internal. */ -static Lisp_Object -unwind_redisplay (Lisp_Object old_frame) +static void +unwind_redisplay (void) { redisplaying_p = 0; - return Qnil; } @@ -15624,10 +15608,11 @@ redisplay_window (Lisp_Object window, int just_this_one_p) the Y coordinate of the _next_ row, see the definition of MATRIX_ROW_BOTTOM_Y. */ if (w->cursor.vpos < margin + header_line) - new_vpos - = pixel_margin + (header_line - ? CURRENT_HEADER_LINE_HEIGHT (w) - : 0) + frame_line_height; + { + w->cursor.vpos = -1; + clear_glyph_matrix (w->desired_matrix); + goto try_to_scroll; + } else { int window_height = window_box_height (w); @@ -15635,7 +15620,11 @@ redisplay_window (Lisp_Object window, int just_this_one_p) if (header_line) window_height += CURRENT_HEADER_LINE_HEIGHT (w); if (w->cursor.y >= window_height - pixel_margin) - new_vpos = window_height - pixel_margin; + { + w->cursor.vpos = -1; + clear_glyph_matrix (w->desired_matrix); + goto try_to_scroll; + } } } @@ -21345,7 +21334,7 @@ store_mode_line_string (const char *string, Lisp_Object lisp_string, int copy_st if (NILP (face)) face = mode_line_string_face; else - face = Fcons (face, Fcons (mode_line_string_face, Qnil)); + face = list2 (face, mode_line_string_face); props = Fplist_put (props, Qface, face); } Fadd_text_properties (make_number (0), make_number (len), @@ -21369,8 +21358,8 @@ store_mode_line_string (const char *string, Lisp_Object lisp_string, int copy_st if (NILP (face)) face = mode_line_string_face; else - face = Fcons (face, Fcons (mode_line_string_face, Qnil)); - props = Fcons (Qface, Fcons (face, Qnil)); + face = list2 (face, mode_line_string_face); + props = list2 (Qface, face); if (copy_string) lisp_string = Fcopy_sequence (lisp_string); } @@ -21484,7 +21473,7 @@ are the selected window and the WINDOW's buffer). */) mode_line_string_list = Qnil; mode_line_string_face = face; mode_line_string_face_prop - = (NILP (face) ? Qnil : Fcons (Qface, Fcons (face, Qnil))); + = NILP (face) ? Qnil : list2 (Qface, face); } push_kboard (FRAME_KBOARD (it.f)); @@ -29234,9 +29223,8 @@ syms_of_xdisp (void) DEFSYM (Qarrow, "arrow"); DEFSYM (Qinhibit_free_realized_faces, "inhibit-free-realized-faces"); - list_of_error = Fcons (Fcons (intern_c_string ("error"), - Fcons (intern_c_string ("void-variable"), Qnil)), - Qnil); + list_of_error = list1 (list2 (intern_c_string ("error"), + intern_c_string ("void-variable"))); staticpro (&list_of_error); DEFSYM (Qlast_arrow_position, "last-arrow-position"); @@ -29340,7 +29328,7 @@ See also `overlay-arrow-position'. */); The symbols on this list are examined during redisplay to determine where to display overlay arrows. */); Voverlay_arrow_variable_list - = Fcons (intern_c_string ("overlay-arrow-position"), Qnil); + = list1 (intern_c_string ("overlay-arrow-position")); DEFVAR_INT ("scroll-step", emacs_scroll_step, doc: /* The number of lines to try scrolling a window by when point moves out. diff --git a/src/xfaces.c b/src/xfaces.c index 4b42cb7dc40..f647ff2e209 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -3388,7 +3388,7 @@ set_font_frame_param (Lisp_Object frame, Lisp_Object lface) ASET (lface, LFACE_FONT_INDEX, font); } f->default_face_done_p = 0; - Fmodify_frame_parameters (frame, Fcons (Fcons (Qfont, font), Qnil)); + Fmodify_frame_parameters (frame, list1 (Fcons (Qfont, font))); } } @@ -3709,14 +3709,10 @@ Value is nil if ATTR doesn't have a discrete set of valid values. */) CHECK_SYMBOL (attr); - if (EQ (attr, QCunderline)) - result = Fcons (Qt, Fcons (Qnil, Qnil)); - else if (EQ (attr, QCoverline)) - result = Fcons (Qt, Fcons (Qnil, Qnil)); - else if (EQ (attr, QCstrike_through)) - result = Fcons (Qt, Fcons (Qnil, Qnil)); - else if (EQ (attr, QCinverse_video) || EQ (attr, QCreverse_video)) - result = Fcons (Qt, Fcons (Qnil, Qnil)); + if (EQ (attr, QCunderline) || EQ (attr, QCoverline) + || EQ (attr, QCstrike_through) + || EQ (attr, QCinverse_video) || EQ (attr, QCreverse_video)) + result = list2 (Qt, Qnil); return result; } @@ -3779,21 +3775,18 @@ Default face attributes override any local face attributes. */) && newface->font) { Lisp_Object name = newface->font->props[FONT_NAME_INDEX]; - Fmodify_frame_parameters (frame, Fcons (Fcons (Qfont, name), - Qnil)); + Fmodify_frame_parameters (frame, list1 (Fcons (Qfont, name))); } if (STRINGP (gvec[LFACE_FOREGROUND_INDEX])) Fmodify_frame_parameters (frame, - Fcons (Fcons (Qforeground_color, - gvec[LFACE_FOREGROUND_INDEX]), - Qnil)); + list1 (Fcons (Qforeground_color, + gvec[LFACE_FOREGROUND_INDEX]))); if (STRINGP (gvec[LFACE_BACKGROUND_INDEX])) Fmodify_frame_parameters (frame, - Fcons (Fcons (Qbackground_color, - gvec[LFACE_BACKGROUND_INDEX]), - Qnil)); + list1 (Fcons (Qbackground_color, + gvec[LFACE_BACKGROUND_INDEX]))); } } @@ -6290,6 +6283,7 @@ where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */) CHECK_STRING (filename); abspath = Fexpand_file_name (filename, Qnil); + block_input (); fp = emacs_fopen (SSDATA (abspath), "rt"); if (fp) { @@ -6297,29 +6291,24 @@ where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */) int red, green, blue; int num; - block_input (); - while (fgets (buf, sizeof (buf), fp) != NULL) { if (sscanf (buf, "%u %u %u %n", &red, &green, &blue, &num) == 3) { - char *name = buf + num; - num = strlen (name) - 1; - if (num >= 0 && name[num] == '\n') - name[num] = 0; - cmap = Fcons (Fcons (build_string (name), #ifdef HAVE_NTGUI - make_number (RGB (red, green, blue))), + int color = RGB (red, green, blue); #else - make_number ((red << 16) | (green << 8) | blue)), + int color = (red << 16) | (green << 8) | blue; #endif + char *name = buf + num; + ptrdiff_t len = strlen (name); + len -= 0 < len && name[len - 1] == '\n'; + cmap = Fcons (Fcons (make_string (name, len), make_number (color)), cmap); } } fclose (fp); - - unblock_input (); } - + unblock_input (); return cmap; } #endif @@ -6483,7 +6472,7 @@ syms_of_xfaces (void) DEFSYM (Qtty_color_alist, "tty-color-alist"); DEFSYM (Qscalable_fonts_allowed, "scalable-fonts-allowed"); - Vparam_value_alist = Fcons (Fcons (Qnil, Qnil), Qnil); + Vparam_value_alist = list1 (Fcons (Qnil, Qnil)); staticpro (&Vparam_value_alist); Vface_alternative_font_family_alist = Qnil; staticpro (&Vface_alternative_font_family_alist); diff --git a/src/xfns.c b/src/xfns.c index a1c709a6c26..a3eff1a5cce 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -1715,7 +1715,7 @@ x_default_scroll_bar_color_parameter (struct frame *f, #endif /* not USE_TOOLKIT_SCROLL_BARS */ } - x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil)); + x_set_frame_parameters (f, list1 (Fcons (prop, tem))); return tem; } @@ -2883,11 +2883,16 @@ unwind_create_frame (Lisp_Object frame) return Qnil; } -static Lisp_Object +static void +do_unwind_create_frame (Lisp_Object frame) +{ + unwind_create_frame (frame); +} + +static void unwind_create_frame_1 (Lisp_Object val) { inhibit_lisp_code = val; - return Qnil; } static void @@ -2948,7 +2953,7 @@ x_default_font_parameter (struct frame *f, Lisp_Object parms) { /* Remember the explicit font parameter, so we can re-apply it after we've applied the `default' face settings. */ - x_set_frame_parameters (f, Fcons (Fcons (Qfont_param, font_param), Qnil)); + x_set_frame_parameters (f, list1 (Fcons (Qfont_param, font_param))); } /* This call will make X resources override any system font setting. */ @@ -3090,7 +3095,7 @@ This function is an internal primitive--use `make-frame' instead. */) FRAME_X_DISPLAY_INFO (f) = dpyinfo; /* With FRAME_X_DISPLAY_INFO set up, this unwind-protect is safe. */ - record_unwind_protect (unwind_create_frame, frame); + record_unwind_protect (do_unwind_create_frame, frame); /* These colors will be set anyway later, but it's important to get the color reference counts right, so initialize them! */ @@ -4975,7 +4980,7 @@ Window tip_window; static Lisp_Object last_show_tip_args; -static Lisp_Object +static void unwind_create_tip_frame (Lisp_Object frame) { Lisp_Object deleted; @@ -4986,8 +4991,6 @@ unwind_create_tip_frame (Lisp_Object frame) tip_window = None; tip_frame = Qnil; } - - return deleted; } @@ -5238,7 +5241,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo, /* Add `tooltip' frame parameter's default value. */ if (NILP (Fframe_parameter (frame, Qtooltip))) - Fmodify_frame_parameters (frame, Fcons (Fcons (Qtooltip, Qt), Qnil)); + Fmodify_frame_parameters (frame, list1 (Fcons (Qtooltip, Qt))); /* FIXME - can this be done in a similar way to normal frames? http://lists.gnu.org/archive/html/emacs-devel/2007-10/msg00641.html */ @@ -5256,8 +5259,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo, disptype = intern ("color"); if (NILP (Fframe_parameter (frame, Qdisplay_type))) - Fmodify_frame_parameters (frame, Fcons (Fcons (Qdisplay_type, disptype), - Qnil)); + Fmodify_frame_parameters (frame, list1 (Fcons (Qdisplay_type, disptype))); } /* Set up faces after all frame parameters are known. This call @@ -5276,8 +5278,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo, call2 (Qface_set_after_frame_default, frame, Qnil); if (!EQ (bg, Fframe_parameter (frame, Qbackground_color))) - Fmodify_frame_parameters (frame, Fcons (Fcons (Qbackground_color, bg), - Qnil)); + Fmodify_frame_parameters (frame, list1 (Fcons (Qbackground_color, bg))); } f->no_split = 1; @@ -5766,10 +5767,10 @@ file_dialog_unmap_cb (Widget widget, XtPointer client_data, XtPointer call_data) *result = XmCR_CANCEL; } -static Lisp_Object -clean_up_file_dialog (Lisp_Object arg) +static void +clean_up_file_dialog (void *arg) { - Widget dialog = XSAVE_POINTER (arg, 0); + Widget dialog = arg; /* Clean up. */ block_input (); @@ -5777,8 +5778,6 @@ clean_up_file_dialog (Lisp_Object arg) XtDestroyWidget (dialog); x_menu_set_in_use (0); unblock_input (); - - return Qnil; } @@ -5893,7 +5892,7 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */) XmStringFree (default_xmstring); } - record_unwind_protect (clean_up_file_dialog, make_save_pointer (dialog)); + record_unwind_protect_ptr (clean_up_file_dialog, dialog); /* Process events until the user presses Cancel or OK. */ x_menu_set_in_use (1); @@ -5947,12 +5946,10 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */) #ifdef USE_GTK -static Lisp_Object -clean_up_dialog (Lisp_Object arg) +static void +clean_up_dialog (void) { x_menu_set_in_use (0); - - return Qnil; } DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, @@ -5986,7 +5983,7 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */) /* Prevent redisplay. */ specbind (Qinhibit_redisplay, Qt); - record_unwind_protect (clean_up_dialog, Qnil); + record_unwind_protect_void (clean_up_dialog); block_input (); @@ -6041,7 +6038,7 @@ nil, it defaults to the selected frame. */) /* Prevent redisplay. */ specbind (Qinhibit_redisplay, Qt); - record_unwind_protect (clean_up_dialog, Qnil); + record_unwind_protect_void (clean_up_dialog); block_input (); diff --git a/src/xfont.c b/src/xfont.c index 9978aba76de..9647a51ac6e 100644 --- a/src/xfont.c +++ b/src/xfont.c @@ -295,9 +295,9 @@ xfont_supported_scripts (Display *display, char *fontname, Lisp_Object props, /* Two special cases to avoid opening rather big fonts. */ if (EQ (AREF (props, 2), Qja)) - return Fcons (intern ("kana"), Fcons (intern ("han"), Qnil)); + return list2 (intern ("kana"), intern ("han")); if (EQ (AREF (props, 2), Qko)) - return Fcons (intern ("hangul"), Qnil); + return list1 (intern ("hangul")); scripts = Fgethash (props, xfont_scripts_cache, Qt); if (EQ (scripts, Qt)) { diff --git a/src/xmenu.c b/src/xmenu.c index 48ab3519723..6c0e3dd78a6 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -296,10 +296,10 @@ for instance using the window manager, then this produces a quit and XSETFRAME (frame, f); XSETINT (x, x_pixel_width (f) / 2); XSETINT (y, x_pixel_height (f) / 2); - newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil)); + newpos = list2 (list2 (x, y), frame); return Fx_popup_menu (newpos, - Fcons (Fcar (contents), Fcons (contents, Qnil))); + list2 (Fcar (contents), contents)); } #else { @@ -311,15 +311,15 @@ for instance using the window manager, then this produces a quit and /* Decode the dialog items from what was specified. */ title = Fcar (contents); CHECK_STRING (title); - record_unwind_protect (unuse_menu_items, Qnil); + record_unwind_protect_void (unuse_menu_items); if (NILP (Fcar (Fcdr (contents)))) /* No buttons specified, add an "Ok" button so users can pop down the dialog. Also, the lesstif/motif version crashes if there are no buttons. */ - contents = Fcons (title, Fcons (Fcons (build_string ("Ok"), Qt), Qnil)); + contents = list2 (title, Fcons (build_string ("Ok"), Qt)); - list_of_panes (Fcons (contents, Qnil)); + list_of_panes (list1 (contents)); /* Display them in a dialog box. */ block_input (); @@ -1405,14 +1405,13 @@ popup_selection_callback (GtkWidget *widget, gpointer client_data) if (cb_data) menu_item_selection = (Lisp_Object *) cb_data->call_data; } -static Lisp_Object -pop_down_menu (Lisp_Object arg) +static void +pop_down_menu (void *arg) { popup_activated_flag = 0; block_input (); - gtk_widget_destroy (GTK_WIDGET (XSAVE_POINTER (arg, 0))); + gtk_widget_destroy (GTK_WIDGET (arg)); unblock_input (); - return Qnil; } /* Pop up the menu for frame F defined by FIRST_WV at X/Y and loop until the @@ -1474,7 +1473,7 @@ create_and_show_popup_menu (FRAME_PTR f, widget_value *first_wv, int x, int y, gtk_menu_popup (GTK_MENU (menu), 0, 0, pos_func, &popup_x_y, i, timestamp ? timestamp : gtk_get_current_event_time ()); - record_unwind_protect (pop_down_menu, make_save_pointer (menu)); + record_unwind_protect_ptr (pop_down_menu, menu); if (gtk_widget_get_mapped (menu)) { @@ -1513,7 +1512,7 @@ popup_selection_callback (Widget widget, LWLIB_ID id, XtPointer client_data) /* ARG is the LWLIB ID of the dialog box, represented as a Lisp object as (HIGHPART . LOWPART). */ -static Lisp_Object +static void pop_down_menu (Lisp_Object arg) { LWLIB_ID id = (XINT (XCAR (arg)) << 4 * sizeof (LWLIB_ID) @@ -1523,8 +1522,6 @@ pop_down_menu (Lisp_Object arg) lw_destroy_all_widgets (id); unblock_input (); popup_activated_flag = 0; - - return Qnil; } /* Pop up the menu for frame F defined by FIRST_WV at X/Y and loop until the @@ -1604,11 +1601,10 @@ create_and_show_popup_menu (FRAME_PTR f, widget_value *first_wv, #endif /* not USE_GTK */ -static Lisp_Object -cleanup_widget_value_tree (Lisp_Object arg) +static void +cleanup_widget_value_tree (void *arg) { - free_menubar_widget_value_tree (XSAVE_POINTER (arg, 0)); - return Qnil; + free_menubar_widget_value_tree (arg); } Lisp_Object @@ -1822,8 +1818,7 @@ xmenu_show (FRAME_PTR f, int x, int y, bool for_click, bool keymaps, /* Make sure to free the widget_value objects we used to specify the contents even with longjmp. */ - record_unwind_protect (cleanup_widget_value_tree, - make_save_pointer (first_wv)); + record_unwind_protect_ptr (cleanup_widget_value_tree, first_wv); /* Actually create and show the menu until popped down. */ create_and_show_popup_menu (f, first_wv, x, y, for_click, timestamp); @@ -1871,7 +1866,7 @@ xmenu_show (FRAME_PTR f, int x, int y, bool for_click, bool keymaps, { int j; - entry = Fcons (entry, Qnil); + entry = list1 (entry); if (!NILP (prefix)) entry = Fcons (prefix, entry); for (j = submenu_depth - 1; j >= 0; j--) @@ -1922,7 +1917,7 @@ create_and_show_dialog (FRAME_PTR f, widget_value *first_wv) if (menu) { ptrdiff_t specpdl_count = SPECPDL_INDEX (); - record_unwind_protect (pop_down_menu, make_save_pointer (menu)); + record_unwind_protect_ptr (pop_down_menu, menu); /* Display the menu. */ gtk_widget_show_all (menu); @@ -2132,8 +2127,7 @@ xdialog_show (FRAME_PTR f, /* Make sure to free the widget_value objects we used to specify the contents even with longjmp. */ - record_unwind_protect (cleanup_widget_value_tree, - make_save_pointer (first_wv)); + record_unwind_protect_ptr (cleanup_widget_value_tree, first_wv); /* Actually create and show the dialog. */ create_and_show_dialog (f, first_wv); @@ -2172,7 +2166,7 @@ xdialog_show (FRAME_PTR f, { if (keymaps != 0) { - entry = Fcons (entry, Qnil); + entry = list1 (entry); if (!NILP (prefix)) entry = Fcons (prefix, entry); } @@ -2223,14 +2217,12 @@ menu_help_callback (char const *help_string, int pane, int item) pane_name = first_item[MENU_ITEMS_ITEM_NAME]; /* (menu-item MENU-NAME PANE-NUMBER) */ - menu_object = Fcons (Qmenu_item, - Fcons (pane_name, - Fcons (make_number (pane), Qnil))); + menu_object = list3 (Qmenu_item, pane_name, make_number (pane)); show_help_echo (help_string ? build_string (help_string) : Qnil, Qnil, menu_object, make_number (item)); } -static Lisp_Object +static void pop_down_menu (Lisp_Object arg) { FRAME_PTR f = XSAVE_POINTER (arg, 0); @@ -2257,8 +2249,6 @@ pop_down_menu (Lisp_Object arg) #endif /* HAVE_X_WINDOWS */ unblock_input (); - - return Qnil; } @@ -2475,8 +2465,7 @@ xmenu_show (FRAME_PTR f, int x, int y, bool for_click, bool keymaps, XMenuActivateSetWaitFunction (x_menu_wait_for_event, FRAME_X_DISPLAY (f)); #endif - record_unwind_protect (pop_down_menu, - make_save_value (SAVE_TYPE_PTR_PTR, f, menu)); + record_unwind_protect (pop_down_menu, make_save_ptr_ptr (f, menu)); /* Help display under X won't work because XMenuActivate contains a loop that doesn't give Emacs a chance to process it. */ @@ -2515,7 +2504,7 @@ xmenu_show (FRAME_PTR f, int x, int y, bool for_click, bool keymaps, = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE); if (keymaps) { - entry = Fcons (entry, Qnil); + entry = list1 (entry); if (!NILP (pane_prefix)) entry = Fcons (pane_prefix, entry); } diff --git a/src/xml.c b/src/xml.c index 4b466dc1bca..c330dce4a4a 100644 --- a/src/xml.c +++ b/src/xml.c @@ -124,7 +124,7 @@ make_dom (xmlNode *node) { if (node->type == XML_ELEMENT_NODE) { - Lisp_Object result = Fcons (intern ((char *) node->name), Qnil); + Lisp_Object result = list1 (intern ((char *) node->name)); xmlNode *child; xmlAttr *property; Lisp_Object plist = Qnil; diff --git a/src/xselect.c b/src/xselect.c index b422a22d68b..6a80eddc82c 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -45,26 +45,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ struct prop_location; struct selection_data; -static Lisp_Object x_atom_to_symbol (Display *dpy, Atom atom); -static Atom symbol_to_x_atom (struct x_display_info *, Lisp_Object); -static void x_own_selection (Lisp_Object, Lisp_Object, Lisp_Object); -static Lisp_Object x_get_local_selection (Lisp_Object, Lisp_Object, int, - struct x_display_info *); static void x_decline_selection_request (struct input_event *); -static Lisp_Object x_selection_request_lisp_error (Lisp_Object); -static Lisp_Object queue_selection_requests_unwind (Lisp_Object); -static Lisp_Object x_catch_errors_unwind (Lisp_Object); -static void x_reply_selection_request (struct input_event *, struct x_display_info *); static int x_convert_selection (struct input_event *, Lisp_Object, Lisp_Object, Atom, int, struct x_display_info *); static int waiting_for_other_props_on_window (Display *, Window); static struct prop_location *expect_property_change (Display *, Window, Atom, int); static void unexpect_property_change (struct prop_location *); -static Lisp_Object wait_for_property_change_unwind (Lisp_Object); static void wait_for_property_change (struct prop_location *); -static Lisp_Object x_get_foreign_selection (Lisp_Object, Lisp_Object, - Lisp_Object, Lisp_Object); static Lisp_Object x_get_window_property_as_lisp_data (Display *, Window, Atom, Lisp_Object, Atom); @@ -74,7 +62,6 @@ static Lisp_Object selection_data_to_lisp_data (Display *, static void lisp_data_to_selection_data (Display *, Lisp_Object, unsigned char **, Atom *, ptrdiff_t *, int *, int *); -static Lisp_Object clean_local_selection_data (Lisp_Object); /* Printing traces to stderr. */ @@ -513,8 +500,8 @@ static Atom conversion_fail_tag; an error, we tell the requestor that we were unable to do what they wanted before we throw to top-level or go into the debugger or whatever. */ -static Lisp_Object -x_selection_request_lisp_error (Lisp_Object ignore) +static void +x_selection_request_lisp_error (void) { struct selection_data *cs, *next; @@ -530,16 +517,14 @@ x_selection_request_lisp_error (Lisp_Object ignore) if (x_selection_current_request != 0 && selection_request_dpyinfo->display) x_decline_selection_request (x_selection_current_request); - return Qnil; } -static Lisp_Object -x_catch_errors_unwind (Lisp_Object dummy) +static void +x_catch_errors_unwind (void) { block_input (); x_uncatch_errors (); unblock_input (); - return Qnil; } @@ -560,11 +545,6 @@ struct prop_location struct prop_location *next; }; -static struct prop_location *expect_property_change (Display *display, Window window, Atom property, int state); -static void wait_for_property_change (struct prop_location *location); -static void unexpect_property_change (struct prop_location *location); -static int waiting_for_other_props_on_window (Display *display, Window window); - static int prop_location_identifier; static Lisp_Object property_change_reply; @@ -573,13 +553,6 @@ static struct prop_location *property_change_reply_object; static struct prop_location *property_change_wait_list; -static Lisp_Object -queue_selection_requests_unwind (Lisp_Object tem) -{ - x_stop_queuing_selection_requests (); - return Qnil; -} - /* Send the reply to a selection request event EVENT. */ @@ -614,7 +587,7 @@ x_reply_selection_request (struct input_event *event, /* The protected block contains wait_for_property_change, which can run random lisp code (process handlers) or signal. Therefore, we put the x_uncatch_errors call in an unwind. */ - record_unwind_protect (x_catch_errors_unwind, Qnil); + record_unwind_protect_void (x_catch_errors_unwind); x_catch_errors (display); /* Loop over converted selections, storing them in the requested @@ -805,12 +778,12 @@ x_handle_selection_request (struct input_event *event) x_selection_current_request = event; selection_request_dpyinfo = dpyinfo; - record_unwind_protect (x_selection_request_lisp_error, Qnil); + record_unwind_protect_void (x_selection_request_lisp_error); /* We might be able to handle nested x_handle_selection_requests, but this is difficult to test, and seems unimportant. */ x_start_queuing_selection_requests (); - record_unwind_protect (queue_selection_requests_unwind, Qnil); + record_unwind_protect_void (x_stop_queuing_selection_requests); TRACE2 ("x_handle_selection_request: selection=%s, target=%s", SDATA (SYMBOL_NAME (selection_symbol)), @@ -1117,15 +1090,14 @@ unexpect_property_change (struct prop_location *location) /* Remove the property change expectation element for IDENTIFIER. */ -static Lisp_Object -wait_for_property_change_unwind (Lisp_Object loc) +static void +wait_for_property_change_unwind (void *loc) { - struct prop_location *location = XSAVE_POINTER (loc, 0); + struct prop_location *location = loc; unexpect_property_change (location); if (location == property_change_reply_object) property_change_reply_object = 0; - return Qnil; } /* Actually wait for a property change. @@ -1140,8 +1112,7 @@ wait_for_property_change (struct prop_location *location) emacs_abort (); /* Make sure to do unexpect_property_change if we quit or err. */ - record_unwind_protect (wait_for_property_change_unwind, - make_save_pointer (location)); + record_unwind_protect_ptr (wait_for_property_change_unwind, location); XSETCAR (property_change_reply, Qnil); property_change_reply_object = location; @@ -1254,7 +1225,7 @@ x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type, SelectionNotify. */ #if 0 x_start_queuing_selection_requests (); - record_unwind_protect (queue_selection_requests_unwind, Qnil); + record_unwind_protect_void (x_stop_queuing_selection_requests); #endif unblock_input (); diff --git a/src/xterm.c b/src/xterm.c index 818b69cc41d..b3534871da9 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -3435,13 +3435,12 @@ x_focus_changed (int type, int state, struct x_display_info *dpyinfo, struct fra /* Don't stop displaying the initial startup message for a switch-frame event we don't need. */ /* When run as a daemon, Vterminal_frame is always NIL. */ - if ((NILP (Vterminal_frame) || EQ (Fdaemonp(), Qt)) - && CONSP (Vframe_list) - && !NILP (XCDR (Vframe_list))) - { - bufp->kind = FOCUS_IN_EVENT; - XSETFRAME (bufp->frame_or_window, frame); - } + bufp->arg = (((NILP (Vterminal_frame) || EQ (Fdaemonp (), Qt)) + && CONSP (Vframe_list) + && !NILP (XCDR (Vframe_list))) + ? Qt : Qnil); + bufp->kind = FOCUS_IN_EVENT; + XSETFRAME (bufp->frame_or_window, frame); } frame->output_data.x->focus_state |= state; @@ -3459,6 +3458,9 @@ x_focus_changed (int type, int state, struct x_display_info *dpyinfo, struct fra { dpyinfo->x_focus_event_frame = 0; x_new_focus_frame (dpyinfo, 0); + + bufp->kind = FOCUS_OUT_EVENT; + XSETFRAME (bufp->frame_or_window, frame); } #ifdef HAVE_X_I18N @@ -8372,9 +8374,9 @@ set_wm_state (Lisp_Object frame, int add, Atom atom, Atom value) (make_number (add ? 1 : 0), Fcons (make_fixnum_or_float (atom), - value != 0 - ? Fcons (make_fixnum_or_float (value), Qnil) - : Qnil))); + (value != 0 + ? list1 (make_fixnum_or_float (value)) + : Qnil)))); } void diff --git a/test/ChangeLog b/test/ChangeLog index d3d8db6b501..bffe85e6a7a 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,30 @@ +2013-07-24 Michael Albinus <michael.albinus@gmx.de> + + * automated/file-notify-tests.el + (file-notify--test-local-enabled): New defconst. Replaces all + `file-notify-support' occurences. + (file-notify--test-remote-enabled): New defun. + (file-notify--deftest-remote): Use it. + (file-notify-test00-availability): Rewrite. + (file-notify-test00-availability-remote): New defun. + (file-notify-test01-add-watch): Rewrite first erroneous check. + +2013-07-23 Glenn Morris <rgm@gnu.org> + + * automated/inotify-test.el (inotify-file-watch-simple): + Delete temp-file when done. + + * automated/subword-tests.el: Require subword. + +2013-07-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * automated/subword-tests.el: New file. + +2013-07-13 Fabián Ezequiel Gallina <fgallina@gnu.org> + + * automated/python-tests.el (python-imenu-create-index-2) + (python-imenu-create-index-3): New tests. + 2013-07-11 Glenn Morris <rgm@gnu.org> * automated/ert-tests.el: Require cl-lib at runtime too. diff --git a/test/automated/Makefile.in b/test/automated/Makefile.in index 6e7111e589c..d4bfcc12130 100644 --- a/test/automated/Makefile.in +++ b/test/automated/Makefile.in @@ -1,4 +1,5 @@ -# Maintenance productions for the automated test directory +### @configure_input@ + # Copyright (C) 2010-2013 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/test/automated/file-notify-tests.el b/test/automated/file-notify-tests.el index 0e9be33f157..8bd4f258b1c 100644 --- a/test/automated/file-notify-tests.el +++ b/test/automated/file-notify-tests.el @@ -47,13 +47,21 @@ tramp-message-show-message nil) (when noninteractive (defalias 'tramp-read-passwd 'ignore)) +;; We do not want to try and fail `file-notify-add-watch'. +(defconst file-notify--test-local-enabled file-notify--library + "Whether local file notification is enabled.") + +;; We need also a check on the remote side, w/o adding a file monitor. +(defun file-notify--test-remote-enabled () + "Whether remote file notification is enabled." + (ignore-errors + (and (file-remote-p file-notify-test-remote-temporary-file-directory) + (file-directory-p file-notify-test-remote-temporary-file-directory) + (file-writable-p file-notify-test-remote-temporary-file-directory)))) + (defmacro file-notify--deftest-remote (test docstring) "Define ert `TEST-remote' for remote files." - `(when (ignore-errors - (and - (file-remote-p file-notify-test-remote-temporary-file-directory) - (file-directory-p file-notify-test-remote-temporary-file-directory) - (file-writable-p file-notify-test-remote-temporary-file-directory))) + `(when (and (file-notify--test-remote-enabled) (ert-get-test ',test)) ;; Define the test. (ert-deftest ,(intern (concat (symbol-name test) "-remote")) () ,docstring @@ -77,10 +85,16 @@ (ert-deftest file-notify-test00-availability () "Test availability of `file-notify'." - :expected-result (if file-notify-support :passed :failed) - (should (memq file-notify-support '(gfilenotify inotify w32notify)))) + (let (desc) + ;; Check, that different valid parameters are accepted. + (should (setq desc (file-notify-add-watch + temporary-file-directory '(change) 'ignore))) + (file-notify-rm-watch desc))) + +(file-notify--deftest-remote file-notify-test00-availability + "Test availability of `file-notify' for remote files.") -(when file-notify-support +(when file-notify--test-local-enabled (ert-deftest file-notify-test01-add-watch () "Check `file-notify-add-watch'." @@ -99,9 +113,8 @@ (file-notify-rm-watch desc) ;; Check error handling. - (should - (equal (car (should-error (file-notify-add-watch 1 2 3 4))) - 'wrong-number-of-arguments)) + (should-error (file-notify-add-watch 1 2 3 4) + :type 'wrong-number-of-arguments) (should (equal (should-error (file-notify-add-watch 1 2 3)) '(wrong-type-argument 1))) @@ -116,7 +129,7 @@ (file-notify--deftest-remote file-notify-test01-add-watch "Check `file-notify-add-watch' for remote files.") - ) ;; file-notify-support + ) ;; file-notify--test-local-enabled (defun file-notify--test-event-test () "Ert test function to be called by `file-notify--test-event-handler'. @@ -147,7 +160,7 @@ Save the result in `file-notify--test-results', for later analysis." (expand-file-name (make-temp-name "file-notify-test") temporary-file-directory)) -(when file-notify-support +(when file-notify--test-local-enabled (ert-deftest file-notify-test02-events () "Check file creation/removal notifications." @@ -189,13 +202,13 @@ Save the result in `file-notify--test-results', for later analysis." (file-notify--deftest-remote file-notify-test02-events "Check file creation/removal notifications for remote files.") - ) ;; file-notify-support + ) ;; file-notify--test-local-enabled ;; autorevert runs only in interactive mode. (defvar auto-revert-remote-files) (setq auto-revert-remote-files t) (require 'autorevert) -(when (and file-notify-support (null noninteractive)) +(when (and file-notify--test-local-enabled (null noninteractive)) (ert-deftest file-notify-test03-autorevert () "Check autorevert via file notification. @@ -249,12 +262,12 @@ This test is skipped in batch mode." (file-notify--deftest-remote file-notify-test03-autorevert "Check autorevert via file notification for remote files. This test is skipped in batch mode.") - ) ;; (and file-notify-support (null noninteractive)) + ) ;; (and file-notify--test-local-enabled (null noninteractive)) (defun file-notify-test-all (&optional interactive) "Run all tests for \\[file-notify]." (interactive "p") - (when file-notify-support + (when file-notify--test-local-enabled (if interactive (ert-run-tests-interactively "^file-notify-") (ert-run-tests-batch "^file-notify-")))) diff --git a/test/automated/inotify-test.el b/test/automated/inotify-test.el index b4d20cf4fb1..97d78dcb58e 100644 --- a/test/automated/inotify-test.el +++ b/test/automated/inotify-test.el @@ -56,8 +56,10 @@ (insert "Foo\n")) (sit-for 5) ;; Hacky. Wait for 5s until events are processed (should (> events 0))) - (inotify-rm-watch wd))))) + (inotify-rm-watch wd) + (delete-file temp-file))))) ) (provide 'inotify-tests) + ;;; inotify-tests.el ends here. diff --git a/test/automated/python-tests.el b/test/automated/python-tests.el index 1dffe9544fe..fdae235ad38 100644 --- a/test/automated/python-tests.el +++ b/test/automated/python-tests.el @@ -1745,6 +1745,53 @@ class Baz(object): (cons "c (def)" (copy-marker 626))))) (python-imenu-create-index))))) +(ert-deftest python-imenu-create-index-2 () + (python-tests-with-temp-buffer + " +class Foo(object): + def foo(self): + def foo1(): + pass + + def foobar(self): + pass +" + (goto-char (point-max)) + (should (equal + (list + (list + "Foo (class)" + (cons "*class definition*" (copy-marker 2)) + (list + "foo (def)" + (cons "*function definition*" (copy-marker 21)) + (cons "foo1 (def)" (copy-marker 40))) + (cons "foobar (def)" (copy-marker 78)))) + (python-imenu-create-index))))) + +(ert-deftest python-imenu-create-index-3 () + (python-tests-with-temp-buffer + " +class Foo(object): + def foo(self): + def foo1(): + pass + def foo2(): + pass +" + (goto-char (point-max)) + (should (equal + (list + (list + "Foo (class)" + (cons "*class definition*" (copy-marker 2)) + (list + "foo (def)" + (cons "*function definition*" (copy-marker 21)) + (cons "foo1 (def)" (copy-marker 40)) + (cons "foo2 (def)" (copy-marker 77))))) + (python-imenu-create-index))))) + (ert-deftest python-imenu-create-flat-index-1 () (python-tests-with-temp-buffer " diff --git a/test/automated/subword-tests.el b/test/automated/subword-tests.el new file mode 100644 index 00000000000..2137cd7d908 --- /dev/null +++ b/test/automated/subword-tests.el @@ -0,0 +1,50 @@ +;;; subword-tests.el --- Testing the subword rules + +;; Copyright (C) 2011-2013 Free Software Foundation, Inc. + +;; Author: Stefan Monnier <monnier@iro.umontreal.ca> +;; Keywords: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; + +;;; Code: + +(require 'ert) +(require 'subword) + +(defconst subword-tests-strings + '("ABC^" ;;Bug#13758 + "ABC^ ABC^Foo^ ABC^-Foo^ toto^ ABC^")) + +(ert-deftest subword-tests () + "Test the `subword-mode' rules." + (with-temp-buffer + (dolist (str subword-tests-strings) + (erase-buffer) + (insert str) + (goto-char (point-min)) + (while (search-forward "^" nil t) + (replace-match "")) + (goto-char (point-min)) + (while (not (eobp)) + (subword-forward 1) + (insert "^")) + (should (equal (buffer-string) str))))) + +(provide 'subword-tests) +;;; subword-tests.el ends here |