diff options
| author | Kenichi Handa <handa@gnu.org> | 2012-09-30 23:39:46 +0900 |
|---|---|---|
| committer | Kenichi Handa <handa@gnu.org> | 2012-09-30 23:39:46 +0900 |
| commit | c194970e15b6d6efa07697679a25dfab3aa76442 (patch) | |
| tree | 49aec8be9d2dcc74ad3c81f562e48308d8e27b75 | |
| parent | 95402d5faa114a311cabfb8c64cf22a93787a066 (diff) | |
| parent | dd946752ab8810149a66a3eff469eb128709972d (diff) | |
| download | emacs-c194970e15b6d6efa07697679a25dfab3aa76442.tar.gz emacs-c194970e15b6d6efa07697679a25dfab3aa76442.tar.bz2 emacs-c194970e15b6d6efa07697679a25dfab3aa76442.zip | |
merge trunk
294 files changed, 8071 insertions, 4694 deletions
diff --git a/ChangeLog b/ChangeLog index 2b1b2f2915c..411ef633420 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,22 @@ +2012-09-30 Paul Eggert <eggert@cs.ucla.edu> + + Merge from gnulib, incorporating: + 2012-09-28 extern-inline: provide a -Wundef safe config.h + +2012-09-27 Paul Eggert <eggert@cs.ucla.edu> + + Check more robustly for timer_settime. + This should fix an OS X build problem reported by Ivan Andrus in + <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00671.html>. + * configure.ac (gl_THREADLIB): Define to empty, since Emacs + does threads its own way. + * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. + +2012-09-23 Paul Eggert <eggert@cs.ucla.edu> + + * Makefile.in (bootstrap): Set MAKEFILE_NAME when building Makefile, + to avoid problems with recursion when using GNU make. + 2012-09-22 Paul Eggert <eggert@cs.ucla.edu> * Makefile.in (bootstrap): Simplify build procedure. diff --git a/Makefile.in b/Makefile.in index 542c30bbab7..571013e3244 100644 --- a/Makefile.in +++ b/Makefile.in @@ -355,6 +355,10 @@ blessmail: Makefile src FRC # config.status overrides MAKEFILE_NAME with a bogus name when creating # src/epaths.h, so that 'make epaths-force' does not recursively invoke # config.status and overwrite config.status while executing it (Bug#11214). +# +# 'make bootstrap' overrides MAKEFILE_NAME to a nonexistent file but +# then attempts to build that file. This forces 'Makefile', 'lib/Makefile', +# etc. to be built without running into similar recursion problems. MAKEFILE_NAME = Makefile $(MAKEFILE_NAME): config.status $(srcdir)/src/config.in \ $(srcdir)/Makefile.in $(SUBDIR_MAKEFILES_IN) @@ -895,7 +899,7 @@ dvi: # * Do the actual build. bootstrap: bootstrap-clean FRC cd $(srcdir) && { ./autogen.sh || autogen/copy_autogen; } - $(MAKE) $(MFLAGS) Makefile + $(MAKE) $(MFLAGS) MAKEFILE_NAME=force-Makefile force-Makefile $(MAKE) $(MFLAGS) info all .PHONY: check-declare diff --git a/admin/ChangeLog b/admin/ChangeLog index 7f30fe8fc0f..b5b1b75c55c 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,17 @@ +2012-09-27 Glenn Morris <rgm@gnu.org> + + * admin.el (set-version): Set msdos.c's Vwindow_system_version. + +2012-09-27 Paul Eggert <eggert@cs.ucla.edu> + + Check more robustly for timer_settime. + * merge-gnulib (GNULIB_MODULES): Add timer-time. + +2012-09-26 Juanma Barranquero <lekktu@gmail.com> + + * unidata/BidiMirroring.txt: + * unidata/UnicodeData.txt: Update to Unicode 6.2. + 2012-09-17 Glenn Morris <rgm@gnu.org> * admin.el (add-log-time-format): Declare. diff --git a/admin/admin.el b/admin/admin.el index 862e5aed6c1..c71e6539413 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -129,8 +129,12 @@ Root must be the root of an Emacs source tree." (rx (and "\"ProductVersion\"" (0+ space) ?, (0+ space) ?\" (submatch (1+ (in "0-9, "))) "\\0\""))) + ;; Major version only. (when (string-match "\\([0-9]\\{2,\\}\\)" version) (setq version (match-string 1 version)) + (set-version-in-file root "src/msdos.c" version + (rx (and "Vwindow_system_version" (1+ not-newline) + ?\( (submatch (1+ (in "0-9"))) ?\)))) (set-version-in-file root "etc/refcards/ru-refcard.tex" version "\\\\newcommand{\\\\versionemacs}\\[0\\]\ {\\([0-9]\\{2,\\}\\)}.+%.+version of Emacs") diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 775d43e68d3..7fc0b5f4844 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -34,7 +34,7 @@ GNULIB_MODULES=' manywarnings mktime pselect pthread_sigmask readlink socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat - sys_time time timespec-add timespec-sub utimens + sys_time time timer-time timespec-add timespec-sub utimens warnings ' diff --git a/admin/notes/bugtracker b/admin/notes/bugtracker index eed67f10dfd..1d1c196f073 100644 --- a/admin/notes/bugtracker +++ b/admin/notes/bugtracker @@ -610,7 +610,7 @@ An /etc/aliases entry redirects it to the real emacs-bug-tracker address. All discarded messages are stored in /var/lib/mailman/spam. If a non-spam message accidentally gets discarded, just do: -cat /var/lib/mailman/spam/not-really-spam.msg | /usr/lib/debbugs/receive +/usr/lib/debbugs/receive < /var/lib/mailman/spam/not-really-spam.msg chown Debian-debbugs:Debian-debbugs /var/lib/debbugs/spool/incoming/* ... check it works ... mv /var/lib/mailman/spam/not-really-spam.msg /var/lib/mailman/not-spam/ diff --git a/admin/unidata/BidiMirroring.txt b/admin/unidata/BidiMirroring.txt index 2e719bc1e05..ec41b769375 100644 --- a/admin/unidata/BidiMirroring.txt +++ b/admin/unidata/BidiMirroring.txt @@ -1,19 +1,19 @@ -# BidiMirroring-6.1.0.txt -# Date: 2011-12-20, 19:31:00 GMT [KW, LI] +# BidiMirroring-6.2.0.txt +# Date: 2012-05-15, 24:19:00 GMT [KW, LI] # # Bidi_Mirroring_Glyph Property # # This file is an informative contributory data file in the # Unicode Character Database. # -# Copyright (c) 1991-2011 Unicode, Inc. +# Copyright (c) 1991-2012 Unicode, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # This data file lists characters that have the Bidi_Mirrored=Yes property # value, for which there is another Unicode character that typically has a glyph # that is the mirror image of the original character's glyph. # -# The repertoire covered by the file is Unicode 6.1.0. +# The repertoire covered by the file is Unicode 6.2.0. # # The file contains a list of lines with mappings from one code point # to another one for character-based mirroring. @@ -30,16 +30,8 @@ # characters exist with mirrored glyphs, are # listed as comments at the end of the file. # -# Note: (2011-12-19) There is an inconsistency between the -# following statement about the default value -# of the Bidi_Mirroring_Glyph property and the -# value of the @missing line for Bidi_Mirroring_Glyph in -# PropertyValueAliases.txt. This inconsistency was discovered too -# late in the release process to be resolved by -# the UTC. The inconsistency will be resolved in a future revision. -# # Formally, the default value of the Bidi_Mirroring_Glyph property -# for each code point is the code point itself, unless a mapping to +# for each code point is <none>, unless a mapping to # some other character is specified in this data file. When a code # point has the default value for the Bidi_Mirroring_Glyph property, # that means that no other character exists whose glyph is suitable @@ -50,12 +42,13 @@ # # This file was originally created by Markus Scherer. # Extended for Unicode 3.2, 4.0, 4.1, 5.0, 5.1, 5.2, and 6.0 by Ken Whistler, -# and for Unicode 6.1 by Ken Whistler and Laurentiu Iancu. +# and for Unicode 6.1 and 6.2 by Ken Whistler and Laurentiu Iancu. # # ############################################################ # # Property: Bidi_Mirroring_Glyph # +# @missing: 0000..10FFFF; <none> 0028; 0029 # LEFT PARENTHESIS 0029; 0028 # RIGHT PARENTHESIS diff --git a/admin/unidata/UnicodeData.txt b/admin/unidata/UnicodeData.txt index 9f204050c6b..086379eb4f3 100644 --- a/admin/unidata/UnicodeData.txt +++ b/admin/unidata/UnicodeData.txt @@ -7190,6 +7190,7 @@ 20B7;SPESMILO SIGN;Sc;0;ET;;;;;N;;;;; 20B8;TENGE SIGN;Sc;0;ET;;;;;N;;;;; 20B9;INDIAN RUPEE SIGN;Sc;0;ET;;;;;N;;;;; +20BA;TURKISH LIRA SIGN;Sc;0;ET;;;;;N;;;;; 20D0;COMBINING LEFT HARPOON ABOVE;Mn;230;NSM;;;;;N;NON-SPACING LEFT HARPOON ABOVE;;;; 20D1;COMBINING RIGHT HARPOON ABOVE;Mn;230;NSM;;;;;N;NON-SPACING RIGHT HARPOON ABOVE;;;; 20D2;COMBINING LONG VERTICAL LINE OVERLAY;Mn;1;NSM;;;;;N;NON-SPACING LONG VERTICAL BAR OVERLAY;;;; @@ -18703,8 +18704,8 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 1242F;CUNEIFORM NUMERIC SIGN THREE SHARU VARIANT FORM;Nl;0;L;;;;3;N;;;;; 12430;CUNEIFORM NUMERIC SIGN FOUR SHARU;Nl;0;L;;;;4;N;;;;; 12431;CUNEIFORM NUMERIC SIGN FIVE SHARU;Nl;0;L;;;;5;N;;;;; -12432;CUNEIFORM NUMERIC SIGN SHAR2 TIMES GAL PLUS DISH;Nl;0;L;;;;;N;;;;; -12433;CUNEIFORM NUMERIC SIGN SHAR2 TIMES GAL PLUS MIN;Nl;0;L;;;;;N;;;;; +12432;CUNEIFORM NUMERIC SIGN SHAR2 TIMES GAL PLUS DISH;Nl;0;L;;;;216000;N;;;;; +12433;CUNEIFORM NUMERIC SIGN SHAR2 TIMES GAL PLUS MIN;Nl;0;L;;;;432000;N;;;;; 12434;CUNEIFORM NUMERIC SIGN ONE BURU;Nl;0;L;;;;1;N;;;;; 12435;CUNEIFORM NUMERIC SIGN TWO BURU;Nl;0;L;;;;2;N;;;;; 12436;CUNEIFORM NUMERIC SIGN THREE BURU;Nl;0;L;;;;3;N;;;;; @@ -18739,8 +18740,8 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;; 12453;CUNEIFORM NUMERIC SIGN FOUR BAN2 VARIANT FORM;Nl;0;L;;;;4;N;;;;; 12454;CUNEIFORM NUMERIC SIGN FIVE BAN2;Nl;0;L;;;;5;N;;;;; 12455;CUNEIFORM NUMERIC SIGN FIVE BAN2 VARIANT FORM;Nl;0;L;;;;5;N;;;;; -12456;CUNEIFORM NUMERIC SIGN NIGIDAMIN;Nl;0;L;;;;;N;;;;; -12457;CUNEIFORM NUMERIC SIGN NIGIDAESH;Nl;0;L;;;;;N;;;;; +12456;CUNEIFORM NUMERIC SIGN NIGIDAMIN;Nl;0;L;;;;-1;N;;;;; +12457;CUNEIFORM NUMERIC SIGN NIGIDAESH;Nl;0;L;;;;-1;N;;;;; 12458;CUNEIFORM NUMERIC SIGN ONE ESHE3;Nl;0;L;;;;1;N;;;;; 12459;CUNEIFORM NUMERIC SIGN TWO ESHE3;Nl;0;L;;;;2;N;;;;; 1245A;CUNEIFORM NUMERIC SIGN ONE THIRD DISH;Nl;0;L;;;;1/3;N;;;;; diff --git a/autogen/Makefile.in b/autogen/Makefile.in index 103a2e94ef3..e3264ff0c3f 100644 --- a/autogen/Makefile.in +++ b/autogen/Makefile.in @@ -36,7 +36,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=errno --avoid=fcntl --avoid=fcntl-h --avoid=fstat --avoid=msvc-inval --avoid=msvc-nothrow --avoid=raise --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt c-ctype c-strcase careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo filemode getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings mktime pselect pthread_sigmask readlink socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timespec-add timespec-sub utimens warnings +# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=errno --avoid=fcntl --avoid=fcntl-h --avoid=fstat --avoid=msvc-inval --avoid=msvc-nothrow --avoid=raise --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt c-ctype c-strcase careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo filemode getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings mktime pselect pthread_sigmask readlink socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub utimens warnings VPATH = @srcdir@ pkgdatadir = $(datadir)/@PACKAGE@ @@ -95,11 +95,11 @@ am__aclocal_m4_deps = $(top_srcdir)/m4/00gnulib.m4 \ $(top_srcdir)/m4/sys_socket_h.m4 \ $(top_srcdir)/m4/sys_stat_h.m4 $(top_srcdir)/m4/sys_time_h.m4 \ $(top_srcdir)/m4/time_h.m4 $(top_srcdir)/m4/time_r.m4 \ - $(top_srcdir)/m4/timespec.m4 $(top_srcdir)/m4/tm_gmtoff.m4 \ - $(top_srcdir)/m4/unistd_h.m4 $(top_srcdir)/m4/utimbuf.m4 \ - $(top_srcdir)/m4/utimens.m4 $(top_srcdir)/m4/utimes.m4 \ - $(top_srcdir)/m4/warnings.m4 $(top_srcdir)/m4/wchar_t.m4 \ - $(top_srcdir)/configure.ac + $(top_srcdir)/m4/timer_time.m4 $(top_srcdir)/m4/timespec.m4 \ + $(top_srcdir)/m4/tm_gmtoff.m4 $(top_srcdir)/m4/unistd_h.m4 \ + $(top_srcdir)/m4/utimbuf.m4 $(top_srcdir)/m4/utimens.m4 \ + $(top_srcdir)/m4/utimes.m4 $(top_srcdir)/m4/warnings.m4 \ + $(top_srcdir)/m4/wchar_t.m4 $(top_srcdir)/configure.ac am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ $(ACLOCAL_M4) mkinstalldirs = $(install_sh) -d @@ -566,6 +566,7 @@ LIB_MATH = @LIB_MATH@ LIB_PTHREAD = @LIB_PTHREAD@ LIB_PTHREAD_SIGMASK = @LIB_PTHREAD_SIGMASK@ LIB_STANDARD = @LIB_STANDARD@ +LIB_TIMER_TIME = @LIB_TIMER_TIME@ LN_S = @LN_S@ LTLIBINTL = @LTLIBINTL@ LTLIBOBJS = @LTLIBOBJS@ diff --git a/autogen/aclocal.m4 b/autogen/aclocal.m4 index 38f7863ba9d..0bc91e263c2 100644 --- a/autogen/aclocal.m4 +++ b/autogen/aclocal.m4 @@ -1043,6 +1043,7 @@ m4_include([m4/sys_stat_h.m4]) m4_include([m4/sys_time_h.m4]) m4_include([m4/time_h.m4]) m4_include([m4/time_r.m4]) +m4_include([m4/timer_time.m4]) m4_include([m4/timespec.m4]) m4_include([m4/tm_gmtoff.m4]) m4_include([m4/unistd_h.m4]) diff --git a/autogen/config.in b/autogen/config.in index 2f2555c75c9..8a8799db1cf 100644 --- a/autogen/config.in +++ b/autogen/config.in @@ -958,6 +958,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define to 1 if you have the tiff library (-ltiff). */ #undef HAVE_TIFF +/* Define to 1 if you have the `timer_settime' function. */ +#undef HAVE_TIMER_SETTIME + /* Define if struct tm has the tm_gmtoff member. */ #undef HAVE_TM_GMTOFF @@ -1519,7 +1522,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=54113>. _GL_INLINE_HEADER_END contains useful stuff to put in the same include file, after uses of _GL_INLINE. */ -#if __GNUC__ ? __GNUC_STDC_INLINE__ : 199901L <= __STDC_VERSION__ +#if (__GNUC__ \ + ? defined __GNUC_STDC_INLINE__ && __GNUC_STDC_INLINE__ \ + : 199901L <= __STDC_VERSION__) # define _GL_INLINE inline # define _GL_EXTERN_INLINE extern inline #elif 2 < __GNUC__ + (7 <= __GNUC_MINOR__) @@ -1536,7 +1541,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #endif #if 4 < __GNUC__ + (6 <= __GNUC_MINOR__) -# if __GNUC_STDC_INLINE__ +# if defined __GNUC_STDC_INLINE__ && __GNUC_STDC_INLINE__ # define _GL_INLINE_HEADER_CONST_PRAGMA # else # define _GL_INLINE_HEADER_CONST_PRAGMA \ diff --git a/autogen/configure b/autogen/configure index e771c7fd0f7..11e046c551b 100755 --- a/autogen/configure +++ b/autogen/configure @@ -631,6 +631,7 @@ WINDOWS_64_BIT_OFF_T HAVE_UNISTD_H NEXT_AS_FIRST_DIRECTIVE_UNISTD_H NEXT_UNISTD_H +LIB_TIMER_TIME PTHREAD_H_DEFINES_STRUCT_TIMESPEC SYS_TIME_H_DEFINES_STRUCT_TIMESPEC TIME_H_DEFINES_STRUCT_TIMESPEC @@ -5723,6 +5724,9 @@ else test "x$NON_GCC_TEST_OPTIONS" != x && CC="$CC $NON_GCC_TEST_OPTIONS" fi +# Avoid gnulib's threadlib module, as we do threads our own way. + + # Initialize gnulib right after choosing the compiler. ac_ext=c @@ -7006,6 +7010,7 @@ esac # Code from module sys_time: # Code from module time: # Code from module time_r: + # Code from module timer-time: # Code from module timespec: # Code from module timespec-add: # Code from module timespec-sub: @@ -19229,6 +19234,7 @@ done + ac_fn_c_check_type "$LINENO" "sigset_t" "ac_cv_type_sigset_t" " #include <signal.h> /* Mingw defines sigset_t not in <signal.h>, but in <sys/types.h>. */ @@ -21655,11 +21661,61 @@ $as_echo "$gl_cv_sig_pselect" >&6; } LIB_PTHREAD_SIGMASK= - if test $ac_cv_func_pthread_sigmask = yes; then - : + + + if test "$gl_threads_api" = posix; then + if test $ac_cv_func_pthread_sigmask = yes; then + : + else + if test -n "$LIBMULTITHREAD"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_sigmask in $LIBMULTITHREAD" >&5 +$as_echo_n "checking for pthread_sigmask in $LIBMULTITHREAD... " >&6; } +if test "${gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + gl_save_LIBS="$LIBS" + LIBS="$LIBS $LIBMULTITHREAD" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <pthread.h> + #include <signal.h> + +int +main () +{ +return pthread_sigmask (0, (sigset_t *) 0, (sigset_t *) 0); + ; + return 0; +} + +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD=yes +else + gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LIBS="$gl_save_LIBS" + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD" >&5 +$as_echo "$gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD" >&6; } + if test $gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD = yes; then + LIB_PTHREAD_SIGMASK="$LIBMULTITHREAD" + else + HAVE_PTHREAD_SIGMASK=0 + fi + else + HAVE_PTHREAD_SIGMASK=0 + fi + fi else - HAVE_PTHREAD_SIGMASK=0 - REPLACE_PTHREAD_SIGMASK=1 + if test $ac_cv_func_pthread_sigmask = yes; then + REPLACE_PTHREAD_SIGMASK=1 + else + HAVE_PTHREAD_SIGMASK=0 + fi fi @@ -23576,6 +23632,102 @@ $as_echo "$gl_cv_time_r_posix" >&6; } + + + + + + LIB_TIMER_TIME= + + gl_saved_libs=$LIBS + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing timer_settime" >&5 +$as_echo_n "checking for library containing timer_settime... " >&6; } +if test "${ac_cv_search_timer_settime+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_func_search_save_LIBS=$LIBS +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char timer_settime (); +int +main () +{ +return timer_settime (); + ; + return 0; +} +_ACEOF +for ac_lib in '' rt posix4; do + if test -z "$ac_lib"; then + ac_res="none required" + else + ac_res=-l$ac_lib + LIBS="-l$ac_lib $ac_func_search_save_LIBS" + fi + if ac_fn_c_try_link "$LINENO"; then : + ac_cv_search_timer_settime=$ac_res +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext + if test "${ac_cv_search_timer_settime+set}" = set; then : + break +fi +done +if test "${ac_cv_search_timer_settime+set}" = set; then : + +else + ac_cv_search_timer_settime=no +fi +rm conftest.$ac_ext +LIBS=$ac_func_search_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_timer_settime" >&5 +$as_echo "$ac_cv_search_timer_settime" >&6; } +ac_res=$ac_cv_search_timer_settime +if test "$ac_res" != no; then : + test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" + test "$ac_cv_search_timer_settime" = "none required" || + LIB_TIMER_TIME=$ac_cv_search_timer_settime +fi + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <features.h> +#ifdef __GNU_LIBRARY__ + #if ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 2) || (__GLIBC__ > 2)) \ + && !defined __UCLIBC__ + Thread emulation available + #endif +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "Thread" >/dev/null 2>&1; then : + LIB_TIMER_TIME="$LIB_TIMER_TIME $LIBMULTITHREAD" +fi +rm -f conftest* + + for ac_func in timer_settime +do : + ac_fn_c_check_func "$LINENO" "timer_settime" "ac_cv_func_timer_settime" +if test "x$ac_cv_func_timer_settime" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_TIMER_SETTIME 1 +_ACEOF + +fi +done + + LIBS=$gl_saved_libs + : diff --git a/configure.ac b/configure.ac index a6462f7959a..5a3aea763c0 100644 --- a/configure.ac +++ b/configure.ac @@ -571,6 +571,9 @@ else test "x$NON_GCC_TEST_OPTIONS" != x && CC="$CC $NON_GCC_TEST_OPTIONS" fi +# Avoid gnulib's threadlib module, as we do threads our own way. +AC_DEFUN([gl_THREADLIB]) + # Initialize gnulib right after choosing the compiler. gl_EARLY diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index 28d6d2865a8..c1894fb900b 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,3 +1,42 @@ +2012-09-30 Chong Yidong <cyd@gnu.org> + + * killing.texi (Rectangles): Document copy-rectangle-as-kill. + + * search.texi (Special Isearch): Document the lax space search + feature and M-s SPC. + (Regexp Search): Move main search-whitespace-regexp description to + Special Isearch. + (Replace): Document replace-lax-whitespace. + + * basic.texi (Position Info): Document C-u M-=. + (Moving Point): Document move-to-column. + + * display.texi (Useless Whitespace): Add delete-trailing-lines. + + * misc.texi (emacsclient Options): Document the effect of + initial-buffer-choice on client frames. Document server-auth-dir. + Do not document server-host, which is bad security practice. + + * building.texi (Lisp Libraries): Docstring lookups can trigger + autoloading. Document help-enable-auto-load. + + * mini.texi (Yes or No Prompts): New node. + + * ack.texi (Acknowledgments): Remove obsolete packages. + +2012-09-27 Glenn Morris <rgm@gnu.org> + + * cal-xtra.texi (Advanced Calendar/Diary Usage): + Rename the section to be more general. + * emacs.texi: Update menu. + +2012-09-23 Chong Yidong <cyd@gnu.org> + + * buffers.texi (Misc Buffer): Replace toggle-read-only with + read-only-mode. + + * files.texi (Visiting): Likewise. + 2012-09-22 Paul Eggert <eggert@cs.ucla.edu> * trouble.texi (Crashing): Document ulimit -c. diff --git a/doc/emacs/ack.texi b/doc/emacs/ack.texi index 487e3c19c16..8d1e4221a6c 100644 --- a/doc/emacs/ack.texi +++ b/doc/emacs/ack.texi @@ -644,10 +644,9 @@ statically scoped Emacs lisp. @item Daniel LaLiberte wrote @file{edebug.el}, a source-level debugger for Emacs Lisp; @file{cl-specs.el}, specifications to help @code{edebug} -debug code written using David Gillespie's Common Lisp support; -@file{cust-print.el}, a customizable package for printing lisp -objects; and @file{isearch.el}, Emacs's incremental search minor mode. -He also co-wrote @file{hideif.el} (q.v.@:). +debug code written using David Gillespie's Common Lisp support; and +@file{isearch.el}, Emacs's incremental search minor mode. He also +co-wrote @file{hideif.el} (q.v.@:). @item Karl Landstrom and Daniel Colascione wrote @file{js.el}, a mode for @@ -1301,15 +1300,14 @@ providing electric accent keys. Colin Walters wrote Ibuffer, an enhanced buffer menu. @item -Barry Warsaw wrote @file{assoc.el}, a set of utility functions for -working with association lists; @file{cc-mode.el}, a mode for editing -C, C@t{++}, and Java code, based on earlier work by Dave Detlefs, -Stewart Clamen, and Richard Stallman; @file{elp.el}, a profiler for -Emacs Lisp programs; @file{man.el}, a mode for reading Unix manual -pages; @file{regi.el}, providing an AWK-like functionality for use in -lisp programs; @file{reporter.el}, providing customizable bug -reporting for lisp packages; and @file{supercite.el}, a minor mode for -quoting sections of mail messages and news articles. +Barry Warsaw wrote @file{cc-mode.el}, a mode for editing C, C@t{++}, +and Java code, based on earlier work by Dave Detlefs, Stewart Clamen, +and Richard Stallman; @file{elp.el}, a profiler for Emacs Lisp +programs; @file{man.el}, a mode for reading Unix manual pages; +@file{regi.el}, providing an AWK-like functionality for use in lisp +programs; @file{reporter.el}, providing customizable bug reporting for +lisp packages; and @file{supercite.el}, a minor mode for quoting +sections of mail messages and news articles. @item Christoph Wedler wrote @file{antlr-mode.el}, a major mode for ANTLR @@ -1351,9 +1349,8 @@ Directory Client; and @code{eshell}, a command shell implemented entirely in Emacs Lisp. He also contributed to Org mode (q.v.@:). @item -Mike Williams wrote @file{mouse-sel.el}, providing enhanced mouse -selection; and @file{thingatpt.el}, a library of functions for finding -the ``thing'' (word, line, s-expression) containing point. +Mike Williams wrote @file{thingatpt.el}, a library of functions for +finding the ``thing'' (word, line, s-expression) at point. @item Roland Winkler wrote @file{proced.el}, a system process editor. diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index 16ccdba0866..42bd2a4fde2 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -267,7 +267,8 @@ necessary (@code{scroll-up-command}). @xref{Scrolling}. Scroll one screen backward, and move point onscreen if necessary (@code{scroll-down-command}). @xref{Scrolling}. -@item M-x goto-char +@item M-g c +@kindex M-g c @findex goto-char Read a number @var{n} and move point to buffer position @var{n}. Position 1 is the beginning of the buffer. @@ -285,6 +286,13 @@ also specify @var{n} by giving @kbd{M-g M-g} a numeric prefix argument. @xref{Select Buffer}, for the behavior of @kbd{M-g M-g} when you give it a plain prefix argument. +@item M-g @key{TAB} +@kindex M-g TAB +@findex move-to-column +Read a number @var{n} and move to column @var{n} in the current line. +Column 0 is the leftmost column. If called with a prefix argument, +move to the column number specified by the argument's numeric value. + @item C-x C-n @kindex C-x C-n @findex set-goal-column @@ -619,12 +627,16 @@ narrowed region and the line number relative to the whole buffer. @kindex M-= @findex count-words-region -@findex count-words @kbd{M-=} (@code{count-words-region}) displays a message reporting -the number of lines, words, and characters in the region. @kbd{M-x -count-words} displays a similar message for the entire buffer, or for -the region if the region is @dfn{active}. @xref{Mark}, for an -explanation of the region. +the number of lines, words, and characters in the region +(@pxref{Mark}, for an explanation of the region). With a prefix +argument, @kbd{C-u M-=}, the command displays a count for the entire +buffer. + +@findex count-words + The command @kbd{M-x count-words} does the same job, but with a +different calling convention. It displays a count for the region if +the region is active, and for the buffer otherwise. @kindex C-x = @findex what-cursor-position diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi index 24bb0e83778..dfd8f792300 100644 --- a/doc/emacs/buffers.texi +++ b/doc/emacs/buffers.texi @@ -212,7 +212,7 @@ unless they visit files: such buffers are used internally by Emacs. @table @kbd @item C-x C-q -Toggle read-only status of buffer (@code{toggle-read-only}). +Toggle read-only status of buffer (@code{read-only-mode}). @item M-x rename-buffer @key{RET} @var{name} @key{RET} Change the name of the current buffer. @item M-x rename-uniquely @@ -231,9 +231,9 @@ buffers are usually made by subsystems such as Dired and Rmail that have special commands to operate on the text; also by visiting a file whose access control says you cannot write it. -@findex toggle-read-only +@findex read-only-mode @vindex view-read-only - The command @kbd{C-x C-q} (@code{toggle-read-only}) makes a read-only + The command @kbd{C-x C-q} (@code{read-only-mode}) makes a read-only buffer writable, and makes a writable buffer read-only. This works by setting the variable @code{buffer-read-only}, which has a local value in each buffer and makes the buffer read-only if its value is diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi index 21948f181fb..eaee16ac8d5 100644 --- a/doc/emacs/building.texi +++ b/doc/emacs/building.texi @@ -1393,13 +1393,21 @@ putting a line like this in your init file (@pxref{Init File}): @end example @cindex autoload - Some commands are @dfn{autoloaded}: when you run them, Emacs + Some commands are @dfn{autoloaded}; when you run them, Emacs automatically loads the associated library first. For instance, the @kbd{M-x compile} command (@pxref{Compilation}) is autoloaded; if you call it, Emacs automatically loads the @code{compile} library first. In contrast, the command @kbd{M-x recompile} is not autoloaded, so it is unavailable until you load the @code{compile} library. +@vindex help-enable-auto-load + Automatic loading can also occur when you look up the documentation +of an autoloaded command (@pxref{Name Help}), if the documentation +refers to other functions and variables in its library (loading the +library lets Emacs properly set up the hyperlinks in the @file{*Help*} +buffer). To disable this feature, change the variable +@code{help-enable-auto-load} to @code{nil}. + @vindex load-dangerous-libraries @cindex Lisp files byte-compiled by XEmacs By default, Emacs refuses to load compiled Lisp files which were diff --git a/doc/emacs/cal-xtra.texi b/doc/emacs/cal-xtra.texi index 45760afd7a6..b29a8526625 100644 --- a/doc/emacs/cal-xtra.texi +++ b/doc/emacs/cal-xtra.texi @@ -7,10 +7,12 @@ @c Moved here from the Emacs Lisp Reference Manual, 2005-03-26. @node Advanced Calendar/Diary Usage -@section Customizing the Calendar and Diary +@section More advanced features of the Calendar and Diary - There are many ways in which you can customize the calendar and -diary to suit your personal tastes. + This section describes some of the more advanced/specialized +features of the calendar and diary. It starts with some of the +many ways in which you can customize the calendar and diary to suit +your personal tastes. @menu * Calendar Customizing:: Calendar layout and hooks. diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 2238570eaa9..2313d117a90 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1044,9 +1044,9 @@ the left fringe, but no arrow bitmaps, use @code{((top . left) @cindex whitespace, trailing @vindex show-trailing-whitespace It is easy to leave unnecessary spaces at the end of a line, or -empty lines at the end of a file, without realizing it. In most -cases, this @dfn{trailing whitespace} has no effect, but there are -special circumstances where it matters, and it can be a nuisance. +empty lines at the end of a buffer, without realizing it. In most +cases, this @dfn{trailing whitespace} has no effect, but sometimes it +can be a nuisance. You can make trailing whitespace at the end of a line visible by setting the buffer-local variable @code{show-trailing-whitespace} to @@ -1061,9 +1061,13 @@ the location of point is enough to show you that the spaces are present. @findex delete-trailing-whitespace +@vindex delete-trailing-lines Type @kbd{M-x delete-trailing-whitespace} to delete all trailing -whitespace within the buffer. If the region is active, it deletes all -trailing whitespace in the region instead. +whitespace. This command deletes all extra spaces at the end of each +line in the buffer, and all empty lines at the end of the buffer; to +ignore the latter, change the varaible @code{delete-trailing-lines} to +@code{nil}. If the region is active, the command instead deletes +extra spaces at the end of each line in the region. @vindex indicate-empty-lines @cindex unused lines diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index 192a9a2bb28..a2eaaf673e5 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -267,6 +267,7 @@ The Minibuffer * Minibuffer History:: Reusing recent minibuffer arguments. * Repetition:: Re-executing commands that used the minibuffer. * Passwords:: Entering passwords in the echo area. +* Yes or No Prompts:: Replying yes or no in the echo area. Completion @@ -953,7 +954,7 @@ The Diary * Special Diary Entries:: Anniversaries, blocks of dates, cyclic entries, etc. @ifnottex -Customizing the Calendar and Diary +More advanced features of the Calendar and Diary * Calendar Customizing:: Calendar layout and hooks. * Holiday Customizing:: Defining your own holidays. diff --git a/doc/emacs/entering.texi b/doc/emacs/entering.texi index de143516ce8..224ab356d08 100644 --- a/doc/emacs/entering.texi +++ b/doc/emacs/entering.texi @@ -79,11 +79,6 @@ non-@code{nil} value. (In that case, even if you specify one or more files on the command line, Emacs opens but does not display them.) The value of @code{initial-buffer-choice} should be the name of the desired file or directory. -@ignore -@c I do not think this should be mentioned. AFAICS it is just a dodge -@c around inhibit-startup-screen not being settable on a site-wide basis. -or @code{t}, which means to display the @file{*scratch*} buffer. -@end ignore @node Exiting @section Exiting Emacs diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 422100e27b9..c1cebc424ca 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -246,7 +246,7 @@ Archives}, for more about these features. or that is marked read-only, Emacs makes the buffer read-only too, so that you won't go ahead and make changes that you'll have trouble saving afterward. You can make the buffer writable with @kbd{C-x C-q} -(@code{toggle-read-only}). @xref{Misc Buffer}. +(@code{read-only-mode}). @xref{Misc Buffer}. @kindex C-x C-r @findex find-file-read-only diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index d09885c5edd..050ecd150ab 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -243,7 +243,7 @@ by the innermost Lisp expression in the buffer around point, (That name appears as the default while you enter the argument.) For example, if point is located following the text @samp{(make-vector (car x)}, the innermost list containing point is the one that starts -with @samp{(make-vector}, so @kbd{C-h f @key{RET}} will describe the +with @samp{(make-vector}, so @kbd{C-h f @key{RET}} describes the function @code{make-vector}. @kbd{C-h f} is also useful just to verify that you spelled a diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi index 1eb53d0d2ec..5510816b067 100644 --- a/doc/emacs/killing.texi +++ b/doc/emacs/killing.texi @@ -709,6 +709,9 @@ rectangle, depending on the command that uses them. @item C-x r k Kill the text of the region-rectangle, saving its contents as the ``last killed rectangle'' (@code{kill-rectangle}). +@item C-x r M-w +Save the text of the region-rectangle as the ``last killed rectangle'' +(@code{copy-rectangle-as-kill}). @item C-x r d Delete the text of the region-rectangle (@code{delete-rectangle}). @item C-x r y @@ -757,6 +760,12 @@ yanking a rectangle is so different from yanking linear text that different yank commands have to be used. Yank-popping is not defined for rectangles. +@kindex C-x r M-w +@findex copy-rectangle-as-kill + @kbd{C-x r M-w} (@code{copy-rectangle-as-kill}) is the equivalent of +@kbd{M-w} for rectangles: it records the rectangle as the ``last +killed rectangle'', without deleting the text from the buffer. + @kindex C-x r y @findex yank-rectangle To yank the last killed rectangle, type @kbd{C-x r y} diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi index 2856db7a4fa..5d2fc804498 100644 --- a/doc/emacs/mini.texi +++ b/doc/emacs/mini.texi @@ -45,6 +45,7 @@ do not echo. * Minibuffer History:: Reusing recent minibuffer arguments. * Repetition:: Re-executing commands that used the minibuffer. * Passwords:: Entering passwords in the echo area. +* Yes or No Prompts:: Replying yes or no in the echo area. @end menu @node Minibuffer File @@ -733,3 +734,53 @@ password (@pxref{Killing}). You may type either @key{RET} or @key{ESC} to submit the password. Any other self-inserting character key inserts the associated character into the password, and all other input is ignored. + +@node Yes or No Prompts +@section Yes or No Prompts + + An Emacs command may require you to answer a ``yes or no'' question +during the course of its execution. Such queries come in two main +varieties. + +@cindex y or n prompt + For the first type of ``yes or no'' query, the prompt ends with +@samp{(y or n)}. Such a query does not actually use the minibuffer; +the prompt appears in the echo area, and you answer by typing either +@samp{y} or @samp{n}, which immediately delivers the response. For +example, if you type @kbd{C-x C-w} (@kbd{write-file}) to save a +buffer, and enter the name of an existing file, Emacs issues a prompt +like this: + +@smallexample +File `foo.el' exists; overwrite? (y or n) +@end smallexample + +@noindent +Because this query does not actually use the minibuffer, the usual +minibuffer editing commands cannot be used. However, you can perform +some window scrolling operations while the query is active: @kbd{C-l} +recenters the selected window; @kbd{M-v} (or @key{PageDown} or +@key{next}) scrolls forward; @kbd{C-v} (or @key{PageUp}, or +@key{prior}) scrolls backward; @kbd{C-M-v} scrolls forward in the next +window; and @kbd{C-M-S-v} scrolls backward in the next window. Typing +@kbd{C-g} dismisses the query, and quits the command that issued it +(@pxref{Quitting}). + +@cindex yes or no prompt + The second type of ``yes or no'' query is typically employed if +giving the wrong answer would have serious consequences; it uses the +minibuffer, and features a prompt ending with @samp{(yes or no)}. For +example, if you invoke @kbd{C-x k} (@code{kill-buffer}) on a +file-visiting buffer with unsaved changes, Emacs activates the +minibuffer with a prompt like this: + +@smallexample +Buffer foo.el modified; kill anyway? (yes or no) +@end smallexample + +@noindent +To answer, you must type @samp{yes} or @samp{no} into the minibuffer, +followed by @key{RET}. The minibuffer behaves as described in the +previous sections; you can switch to another window with @kbd{C-x o}, +use the history commands @kbd{M-p} and @kbd{M-f}, etc. Type @kbd{C-g} +to quit the minibuffer and the querying command. diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 5d7a51a01f5..4f0a1009e30 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -1509,15 +1509,11 @@ precedence. @cindex client frame @item -c Create a new graphical @dfn{client frame}, instead of using an -existing Emacs frame. If you omit a filename argument while supplying -the @samp{-c} option, the new frame displays the @file{*scratch*} -buffer (@pxref{Buffers}). See below for the special behavior of -@kbd{C-x C-c} in a client frame. - -If Emacs is unable to create a new graphical frame (e.g.@: if it is -unable to connect to the X server), it tries to create a text terminal -client frame, as though you had supplied the @samp{-t} option instead -(see below). +existing Emacs frame. See below for the special behavior of @kbd{C-x +C-c} in a client frame. If Emacs cannot create a new graphical frame +(e.g.@: if it cannot connect to the X server), it tries to create a +text terminal client frame, as though you had supplied the @samp{-t} +option instead. On MS-Windows, a single Emacs session cannot display frames on both graphical and text terminals, nor on multiple text terminals. Thus, @@ -1525,6 +1521,11 @@ if the Emacs server is running on a text terminal, the @samp{-c} option, like the @samp{-t} option, creates a new frame in the server's current text terminal. @xref{Windows Startup}. +If you omit a filename argument while supplying the @samp{-c} option, +the new frame displays the @file{*scratch*} buffer by default. If +@code{initial-buffer-choice} is a string (@pxref{Entering Emacs}), the +new frame displays that file or directory instead. + @item -F @var{alist} @itemx --frame-parameters=@var{alist} Set the parameters for a newly-created graphical frame @@ -1545,38 +1546,24 @@ evaluate, @emph{not} as a list of files to visit. @item -f @var{server-file} @itemx --server-file=@var{server-file} @cindex @env{EMACS_SERVER_FILE} environment variable -@cindex server file -@vindex server-use-tcp -@vindex server-host Specify a @dfn{server file} for connecting to an Emacs server via TCP. An Emacs server usually uses an operating system feature called a ``local socket'' to listen for connections. Some operating systems, such as Microsoft Windows, do not support local sockets; in that case, -Emacs uses TCP instead. When you start the Emacs server, Emacs -creates a server file containing some TCP information that -@command{emacsclient} needs for making the connection. By default, -the server file is in @file{~/.emacs.d/server/}. On Microsoft -Windows, if @command{emacsclient} does not find the server file there, -it looks in the @file{.emacs.d/server/} subdirectory of the directory -pointed to by the @env{APPDATA} environment variable. You can tell -@command{emacsclient} to use a specific server file with the @samp{-f} -or @samp{--server-file} option, or by setting the -@env{EMACS_SERVER_FILE} environment variable. - -Even if local sockets are available, you can tell Emacs to use TCP by -setting the variable @code{server-use-tcp} to @code{t}. One advantage -of TCP is that the server can accept connections from remote machines. -For this to work, you must (i) set the variable @code{server-host} to -the hostname or IP address of the machine on which the Emacs server -runs, and (ii) provide @command{emacsclient} with the server file. -(One convenient way to do the latter is to put the server file on a -networked file system such as NFS.) +the server communicates with @command{emacsclient} via TCP. +@vindex server-auth-dir +@cindex server file @vindex server-port - When the Emacs server is using TCP, the variable @code{server-port} -determines the port number to listen on; the default value, -@code{nil}, means to choose a random port when the server starts. +When you start a TCP Emacs server, Emacs creates a @dfn{server file} +containing the TCP information to be used by @command{emacsclient} to +connect to the server. The variable @code{server-auth-dir} specifies +the directory containing the server file; by default, this is +@file{~/.emacs.d/server/}. To tell @command{emacsclient} to connect +to the server over TCP with a specific server file, use the @samp{-f} +or @samp{--server-file} option, or set the @env{EMACS_SERVER_FILE} +environment variable. @item -n @itemx --no-wait @@ -1606,19 +1593,14 @@ server it finds. (This option is not supported on MS-Windows.) @itemx --tty @itemx -nw Create a new client frame on the current text terminal, instead of -using an existing Emacs frame. This is similar to the @samp{-c} -option, above, except that it creates a text terminal frame -(@pxref{Non-Window Terminals}). If you omit a filename argument while -supplying this option, the new frame displays the @file{*scratch*} -buffer (@pxref{Buffers}). See below for the special behavior of -@kbd{C-x C-c} in a client frame. - -On MS-Windows, a single Emacs session cannot display frames on both -graphical and text terminals, nor on multiple text terminals. Thus, -if the Emacs server is using the graphical display, @samp{-t} behaves -like @samp{-c} (see above); whereas if the Emacs server is running on -a text terminal, it creates a new frame in its current text terminal. -@xref{Windows Startup}. +using an existing Emacs frame. This behaves just like the @samp{-c} +option, described above, except that it creates a text terminal frame +(@pxref{Non-Window Terminals}). + +On MS-Windows, @samp{-t} behaves just like @samp{-c} if the Emacs +server is using the graphical display, but if the Emacs server is +running on a text terminal, it creates a new frame in the current text +terminal. @end table The new graphical or text terminal frames created by the @samp{-c} diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index d5c9783b772..21db02c8ab8 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -17,7 +17,6 @@ thing, but search for patterns instead of fixed strings. (@pxref{Operating on Files}), or ask the @code{grep} program to do it (@pxref{Grep Searching}). - @menu * Incremental Search:: Search happens as you type the string. * Nonincremental Search:: Specify entire string and then search. @@ -218,6 +217,24 @@ search. Some of the characters you type during incremental search have special effects. +@cindex lax space matching +@kindex M-s SPC @r{(Incremental search)} +@kindex SPC @r{(Incremental search)} +@findex isearch-toggle-lax-whitespace +@vindex search-whitespace-regexp + By default, incremental search performs @dfn{lax space matching}: +each space, or sequence of spaces, matches any sequence of one or more +spaces in the text. Hence, @samp{foo bar} matches @samp{foo bar}, +@samp{foo bar}, @samp{foo bar}, and so on (but not @samp{foobar}). +More precisely, Emacs matches each sequence of space characters in the +search string to a regular expression specified by the variable +@code{search-whitespace-regexp}. For example, set it to +@samp{"[[:space:]\n]+"} to make spaces match sequences of newlines as +well as spaces. To toggle lax space matching, type @kbd{M-s SPC} +(@code{isearch-toggle-lax-whitespace}). To disable this feature +entirely, change @code{search-whitespace-regexp} to @code{nil}; then +each space in the search string matches exactly one space + If the search string you entered contains only lower-case letters, the search is case-insensitive; as long as an upper-case letter exists in the search string, the search becomes case-sensitive. If you @@ -492,12 +509,12 @@ Incremental regexp and non-regexp searches have independent defaults. They also have separate search rings, which you can access with @kbd{M-p} and @kbd{M-n}. -@vindex search-whitespace-regexp - If you type @key{SPC} in incremental regexp search, it matches any -sequence of whitespace characters, including newlines. If you want to -match just a space, type @kbd{C-q @key{SPC}}. You can control what a -bare space matches by setting the variable -@code{search-whitespace-regexp} to the desired regexp. + Just as in ordinary incremental search, any @key{SPC} typed in +incremental regexp search matches any sequence of one or more +whitespace characters. The variable @code{search-whitespace-regexp} +specifies the regexp for the lax space matching, and @kbd{M-s SPC} +(@code{isearch-toggle-lax-whitespace}) toggles the feature. +@xref{Special Isearch}. In some cases, adding characters to the regexp in an incremental regexp search can make the cursor move back and start again. For @@ -974,6 +991,13 @@ instead (@pxref{Mark}). The basic replace commands replace one is possible to perform several replacements in parallel, using the command @code{expand-region-abbrevs} (@pxref{Expanding Abbrevs}). +@vindex replace-lax-whitespace + Unlike incremental search, the replacement commands do not use lax +space matching (@pxref{Special Isearch}) by default. To enable lax +space matching for replacement, change the variable +@code{replace-lax-whitespace} to @code{t}. (This only affects how +Emacs finds the text to replace, not the replacement text.) + @menu * Unconditional Replace:: Replacing all matches for a string. * Regexp Replace:: Replacing all matches for a regexp. diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index b813ac6bb1c..b5c847b4b72 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,59 @@ +2012-09-30 Chong Yidong <cyd@gnu.org> + + * commands.texi (Click Events): Define "mouse position list". + Remove mention of unimplemented horizontal scroll bars. + (Drag Events, Motion Events): Refer to "mouse position list". + (Accessing Mouse): Document posnp. + + * errors.texi (Standard Errors): Tweak arith-error description. + Tweak markup. Remove domain-error and friends, which seem to be + unused after the floating-point code revamp. + + * functions.texi (Obsolete Functions): Obsolescence also affects + documentation commands. Various clarifications. + (Declare Form): New node. + + * strings.texi (String Basics): Copyedits. + + * os.texi (Idle Timers): Minor clarifications. + (User Identification): Add system-users and system-groups. + + * macros.texi (Defining Macros): Move description of `declare' to + Declare Form node. + + * loading.texi (Autoload): + * help.texi (Documentation Basics): The special sequences can + trigger autoloading. + + * numbers.texi (Integer Basics): Copyedits. + (Float Basics): Consider IEEE floating point always available. + (Random Numbers): Document actual limits. + (Arithmetic Operations): Clarify division by zero. Don't mention + the machine-independence of negative division since it does not + happen in practice. + +2012-09-28 Chong Yidong <cyd@gnu.org> + + * os.texi (Startup Summary): Document leim-list.el change. + +2012-09-25 Chong Yidong <cyd@gnu.org> + + * functions.texi (Defining Functions): defun is now a macro. + +2012-09-28 Leo Liu <sdl.web@gmail.com> + + * files.texi (Files): Fix typo. + +2012-09-23 Chong Yidong <cyd@gnu.org> + + * buffers.texi (Read Only Buffers): Document read-only-mode. + + * keymaps.texi (Alias Menu Items): Replace toggle-read-only with + read-only-mode. + + * backups.texi (Auto-Saving): Refer to Minor Mode Conventions for + calling conventions. + 2012-09-22 Chong Yidong <cyd@gnu.org> * searching.texi (Replacing Match): Minor clarification. diff --git a/doc/lispref/backups.texi b/doc/lispref/backups.texi index 04aa28e9f04..935a49116cd 100644 --- a/doc/lispref/backups.texi +++ b/doc/lispref/backups.texi @@ -441,12 +441,14 @@ buffer-auto-save-file-name @end defvar @deffn Command auto-save-mode arg -When used interactively without an argument, this command is a toggle -switch: it turns on auto-saving of the current buffer if it is off, -and vice versa. When called from Lisp with no argument, it turns -auto-saving on. With an argument @var{arg}, it turns auto-saving on -if the value of @var{arg} is @code{t}, a nonempty list, or a positive -integer; otherwise, it turns auto-saving off. +This is the mode command for Auto Save mode, a buffer-local minor +mode. When Auto Save mode is enabled, auto-saving is enabled in the +buffer. The calling convention is the same as for other minor mode +commands (@pxref{Minor Mode Conventions}). + +Unlike most minor modes, there is no @code{auto-save-mode} variable. +Auto Save mode is enabled if @code{buffer-auto-save-file-name} is +non-@code{nil} and @code{buffer-saved-size} (see below) is non-zero. @end deffn @defun auto-save-file-name-p filename diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 6ad329f3a30..b9666a79f5b 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -740,31 +740,25 @@ properties have no effect. If @code{inhibit-read-only} is a list, then of the list (comparison is done with @code{eq}). @end defvar -@deffn Command toggle-read-only &optional arg message -This command toggles whether the current buffer is read-only, by -setting the variable @code{buffer-read-only}. If @var{arg} is -non-@code{nil}, it should be a raw prefix argument; the command then -makes the buffer read-only if the numeric value of that prefix -argument is positive, and makes the buffer writable otherwise. -@xref{Prefix Command Arguments}. - -If called interactively, or if called from Lisp with @var{message} is -non-@code{nil}, the command prints a message reporting the buffer's -new read-only status. - -When making the buffer read-only, this command also enables View mode +@deffn Command read-only-mode &optional arg +This is the mode command for Read Only minor mode, a buffer-local +minor mode. When the mode is enabled, @code{buffer-read-only} is +non-@code{nil} in the buffer; when disabled, @code{buffer-read-only} +is @code{nil} in the buffer. The calling convention is the same as +for other minor mode commands (@pxref{Minor Mode Conventions}). + +This minor mode mainly serves as a wrapper for +@code{buffer-read-only}; unlike most minor modes, there is no separate +@code{read-only-mode} variable. Even when Read Only mode is disabled, +characters with non-@code{nil} @code{read-only} text properties remain +read-only. To temporarily ignore all read-only states, bind +@code{inhibit-read-only}, as described above. + +When enabling Read Only mode, this mode command also enables View mode if the option @code{view-read-only} is non-@code{nil}. @xref{Misc Buffer,,Miscellaneous Buffer Operations, emacs, The GNU Emacs Manual}. -When making the buffer writable, it disables View mode if View mode -was enabled. - -Lisp programs should only call @code{toggle-read-only} if they really -intend to do the same thing as the user command, including possibly -enabling or disabling View mode. Note also that this command works by -setting @code{buffer-read-only}, so even if you make the buffer -writable, characters with non-@code{nil} @code{read-only} text -properties will remain read-only. To temporarily ignore all read-only -states, bind @code{inhibit-read-only}, as described above. +When disabling Read Only mode, it disables View mode if View mode was +enabled. @end deffn @defun barf-if-buffer-read-only diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index dc0fa4c639d..93dba237013 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -1275,12 +1275,21 @@ describe events by their types; thus, if there is a key binding for @var{event-type} is @code{mouse-1}. @item @var{position} -This is the position where the mouse click occurred. The actual -format of @var{position} depends on what part of a window was clicked -on. +@cindex mouse position list +This is a @dfn{mouse position list} specifying where the mouse click +occurred; see below for details. -For mouse click events in the text area, mode line, header line, or in -the marginal areas, @var{position} has this form: +@item @var{click-count} +This is the number of rapid repeated presses so far of the same mouse +button. @xref{Repeat Events}. +@end table + + To access the contents of a mouse position list in the +@var{position} slot of a click event, you should typically use the +functions documented in @ref{Accessing Mouse}. The explicit format of +the list depends on where the click occurred. For clicks in the text +area, mode line, header line, or in the fringe or marginal areas, the +mouse position list has the form @example (@var{window} @var{pos-or-area} (@var{x} . @var{y}) @var{timestamp} @@ -1289,18 +1298,16 @@ the marginal areas, @var{position} has this form: @end example @noindent -The meanings of these list elements are documented below. -@xref{Accessing Mouse}, for functions that let you easily access these -elements. +The meanings of these list elements are as follows: @table @asis @item @var{window} -This is the window in which the click occurred. +The window in which the click occurred. @item @var{pos-or-area} -This is the buffer position of the character clicked on in the text -area, or if clicked outside the text area, it is the window area in -which the click occurred. It is one of the symbols @code{mode-line}, +The buffer position of the character clicked on in the text area; or, +if the click was outside the text area, the window area where it +occurred. It is one of the symbols @code{mode-line}, @code{header-line}, @code{vertical-line}, @code{left-margin}, @code{right-margin}, @code{left-fringe}, or @code{right-fringe}. @@ -1310,22 +1317,23 @@ happens after the imaginary prefix keys for the event are registered by Emacs. @xref{Key Sequence Input}. @item @var{x}, @var{y} -These are the relative pixel coordinates of the click. For clicks in -the text area of a window, the coordinate origin @code{(0 . 0)} is -taken to be the top left corner of the text area. @xref{Window -Sizes}. For clicks in a mode line or header line, the coordinate -origin is the top left corner of the window itself. For fringes, -margins, and the vertical border, @var{x} does not have meaningful -data. For fringes and margins, @var{y} is relative to the bottom edge -of the header line. In all cases, the @var{x} and @var{y} coordinates -increase rightward and downward respectively. +The relative pixel coordinates of the click. For clicks in the text +area of a window, the coordinate origin @code{(0 . 0)} is taken to be +the top left corner of the text area. @xref{Window Sizes}. For +clicks in a mode line or header line, the coordinate origin is the top +left corner of the window itself. For fringes, margins, and the +vertical border, @var{x} does not have meaningful data. For fringes +and margins, @var{y} is relative to the bottom edge of the header +line. In all cases, the @var{x} and @var{y} coordinates increase +rightward and downward respectively. @item @var{timestamp} -This is the time at which the event occurred, in milliseconds. +The time at which the event occurred, as an integer number of +milliseconds since a system-dependent initial time. @item @var{object} -This is either @code{nil} if there is no string-type text property at -the click position, or a cons cell of the form (@var{string} +Either @code{nil} if there is no string-type text property at the +click position, or a cons cell of the form (@var{string} . @var{string-pos}) if there is one: @table @asis @@ -1371,8 +1379,7 @@ These are the pixel width and height of @var{object} or, if this is @code{nil}, those of the character glyph clicked on. @end table -@sp 1 -For mouse clicks on a scroll-bar, @var{position} has this form: +For clicks on a scroll bar, @var{position} has this form: @example (@var{window} @var{area} (@var{portion} . @var{whole}) @var{timestamp} @var{part}) @@ -1380,32 +1387,35 @@ For mouse clicks on a scroll-bar, @var{position} has this form: @table @asis @item @var{window} -This is the window whose scroll-bar was clicked on. +The window whose scroll bar was clicked on. @item @var{area} -This is the scroll bar where the click occurred. It is one of the -symbols @code{vertical-scroll-bar} or @code{horizontal-scroll-bar}. +This is the symbol @code{vertical-scroll-bar}. @item @var{portion} -This is the distance of the click from the top or left end of -the scroll bar. +The number of pixels from the top of the scroll bar to the click +position. On some toolkits, including GTK+, Emacs cannot extract this +data, so the value is always @code{0}. @item @var{whole} -This is the length of the entire scroll bar. +The total length, in pixels, of the scroll bar. On some toolkits, +including GTK+, Emacs cannot extract this data, so the value is always +@code{0}. @item @var{timestamp} -This is the time at which the event occurred, in milliseconds. +The time at which the event occurred, in milliseconds. On some +toolkits, including GTK+, Emacs cannot extract this data, so the value +is always @code{0}. @item @var{part} -This is the part of the scroll-bar which was clicked on. It is one -of the symbols @code{above-handle}, @code{handle}, @code{below-handle}, -@code{up}, @code{down}, @code{top}, @code{bottom}, and @code{end-scroll}. +The part of the scroll bar on which the click occurred. It is one of +the symbols @code{handle} (the scroll bar handle), @code{above-handle} +(the area above the handle), @code{below-handle} (the area below the +handle), @code{up} (the up arrow at one end of the scroll bar), or +@code{down} (the down arrow at one end of the scroll bar). +@c The `top', `bottom', and `end-scroll' codes don't seem to be used. @end table -@item @var{click-count} -This is the number of rapid repeated presses so far of the same mouse -button. @xref{Repeat Events}. -@end table @node Drag Events @subsection Drag Events @@ -1429,10 +1439,9 @@ For a drag event, the name of the symbol @var{event-type} contains the prefix @samp{drag-}. For example, dragging the mouse with button 2 held down generates a @code{drag-mouse-2} event. The second and third elements of the event give the starting and ending position of the -drag. They have the same form as @var{position} in a click event -(@pxref{Click Events}) that is not on the scroll bar part of the -window. You can access the second element of any mouse event in the -same way, with no need to distinguish drag events from others. +drag, as mouse position lists (@pxref{Click Events}). You can access +the second element of any mouse event in the same way, with no need to +distinguish drag events from others. The @samp{drag-} prefix follows the modifier key prefixes such as @samp{C-} and @samp{M-}. @@ -1575,13 +1584,14 @@ represented by lists that look like this: (mouse-movement POSITION) @end example -The second element of the list describes the current position of the -mouse, just as in a click event (@pxref{Click Events}). +@noindent +@var{position} is a mouse position list (@pxref{Click Events}), +specifying the current position of the mouse cursor. -The special form @code{track-mouse} enables generation of motion events -within its body. Outside of @code{track-mouse} forms, Emacs does not -generate events for mere motion of the mouse, and these events do not -appear. @xref{Mouse Tracking}. +The special form @code{track-mouse} enables generation of motion +events within its body. Outside of @code{track-mouse} forms, Emacs +does not generate events for mere motion of the mouse, and these +events do not appear. @xref{Mouse Tracking}. @node Focus Events @subsection Focus Events @@ -1648,13 +1658,11 @@ frame has already been made visible, Emacs has no work to do. @cindex @code{wheel-up} event @cindex @code{wheel-down} event @item (wheel-up @var{position}) -@item (wheel-down @var{position}) -These kinds of event are generated by moving a mouse wheel. Their -usual meaning is a kind of scroll or zoom. - -The element @var{position} is a list describing the position of the -event, in the same format as used in a mouse-click event (@pxref{Click -Events}). +@itemx (wheel-down @var{position}) +These kinds of event are generated by moving a mouse wheel. The +@var{position} element is a mouse position list (@pxref{Click +Events}), specifying the position of the mouse cursor when the event +occurred. @vindex mouse-wheel-up-event @vindex mouse-wheel-down-event @@ -1922,14 +1930,8 @@ must be the last element of the list. For example, This section describes convenient functions for accessing the data in a mouse button or motion event. - These two functions return the starting or ending position of a -mouse-button event, as a list of this form (@pxref{Click Events}): - -@example -(@var{window} @var{pos-or-area} (@var{x} . @var{y}) @var{timestamp} - @var{object} @var{text-pos} (@var{col} . @var{row}) - @var{image} (@var{dx} . @var{dy}) (@var{width} . @var{height})) -@end example + The following two functions return a mouse position list +(@pxref{Click Events}), specifying the position of a mouse event. @defun event-start event This returns the starting position of @var{event}. @@ -1948,9 +1950,15 @@ event, the value is actually the starting position, which is the only position such events have. @end defun +@defun posnp object +This function returns non-@code{nil} if @var{object} is a mouse +oposition list, in either of the formats documented in @ref{Click +Events}); and @code{nil} otherwise. +@end defun + @cindex mouse position list, accessing - These functions take a position list as described above, and -return various parts of it. + These functions take a mouse position list as argument, and return +various parts of it: @defun posn-window position Return the window that @var{position} is in. diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index db770616820..d46cb071bf7 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -516,6 +516,7 @@ Functions * Obsolete Functions:: Declaring functions obsolete. * Inline Functions:: Defining functions that the compiler will expand inline. +* Declare Form:: Adding additional information about a function. * Declaring Functions:: Telling the compiler that a function is defined. * Function Safety:: Determining whether a function is safe to call. * Related Topics:: Cross-references to specific Lisp primitives diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi index a822a2d9608..b7b26c8708c 100644 --- a/doc/lispref/errors.texi +++ b/doc/lispref/errors.texi @@ -37,78 +37,69 @@ handled. @table @code @item error -@code{"error"}@* -@xref{Errors}. +The message is @samp{error}. @xref{Errors}. @item quit -@code{"Quit"}@* -@xref{Quitting}. +The message is @samp{Quit}. @xref{Quitting}. @item args-out-of-range -@code{"Args out of range"}@* -This happens when trying to access an element beyond the range of a -sequence or buffer.@* -@xref{Sequences Arrays Vectors}, @xref{Text}. +The message is @samp{Args out of range}. This happens when trying to +access an element beyond the range of a sequence, buffer, or other +container-like object. @xref{Sequences Arrays Vectors}, and +@xref{Text}. @item arith-error -@code{"Arithmetic error"}@* +The message is @samp{Arithmetic error}. This occurs when trying to +perform integer division by zero. @xref{Numeric Conversions}, and @xref{Arithmetic Operations}. @item beginning-of-buffer -@code{"Beginning of buffer"}@* -@xref{Character Motion}. +The message is @samp{Beginning of buffer}. @xref{Character Motion}. @item buffer-read-only -@code{"Buffer is read-only"}@* -@xref{Read Only Buffers}. +The message is @samp{Buffer is read-only}. @xref{Read Only Buffers}. @item circular-list -@code{"List contains a loop"}@* -This happens when some operations (e.g. resolving face names) -encounter circular structures.@* -@xref{Circular Objects}. +The message is @samp{List contains a loop}. This happens when a +circular structure is encountered. @xref{Circular Objects}. @item cl-assertion-failed -@code{"Assertion failed"}@* -This happens when the @code{assert} macro fails a test.@* -@xref{Assertions,,, cl, Common Lisp Extensions}. +The message is @samp{Assertion failed}. This happens when the +@code{assert} macro fails a test. @xref{Assertions,,, cl, Common Lisp +Extensions}. @item coding-system-error -@code{"Invalid coding system"}@* -@xref{Lisp and Coding Systems}. +The message is @samp{Invalid coding system}. @xref{Lisp and Coding +Systems}. @item cyclic-function-indirection -@code{"Symbol's chain of function indirections contains a loop"}@* -@xref{Function Indirection}. +The message is @samp{Symbol's chain of function indirections contains +a loop}. @xref{Function Indirection}. @item cyclic-variable-indirection -@code{"Symbol's chain of variable indirections contains a loop"}@* -@xref{Variable Aliases}. +The message is @samp{Symbol's chain of variable indirections contains +a loop}. @xref{Variable Aliases}. @item dbus-error -@code{"D-Bus error"}@* -This is only defined if Emacs was compiled with D-Bus support.@* -@xref{Errors and Events,,, dbus, D-Bus integration in Emacs}. +The message is @samp{D-Bus error}. This is only defined if Emacs was +compiled with D-Bus support. @xref{Errors and Events,,, dbus, D-Bus +integration in Emacs}. @item end-of-buffer -@code{"End of buffer"}@* -@xref{Character Motion}. +The message is @samp{End of buffer}. @xref{Character Motion}. @item end-of-file -@code{"End of file during parsing"}@* -Note that this is not a subcategory of @code{file-error}, -because it pertains to the Lisp reader, not to file I/O.@* -@xref{Input Functions}. +The message is @samp{End of file during parsing}. Note that this is +not a subcategory of @code{file-error}, because it pertains to the +Lisp reader, not to file I/O. @xref{Input Functions}. @item file-already-exists -This is a subcategory of @code{file-error}.@* -@xref{Writing to Files}. +This is a subcategory of @code{file-error}. @xref{Writing to Files}. @item file-date-error This is a subcategory of @code{file-error}. It occurs when @code{copy-file} tries and fails to set the last-modification time of -the output file.@* -@xref{Changing Files}. +the output file. @xref{Changing Files}. @item file-error We do not list the error-strings of this error and its subcategories, @@ -116,122 +107,109 @@ because the error message is normally constructed from the data items alone when the error condition @code{file-error} is present. Thus, the error-strings are not very relevant. However, these error symbols do have @code{error-message} properties, and if no data is provided, -the @code{error-message} property @emph{is} used.@* -@xref{Files}. +the @code{error-message} property @emph{is} used. @xref{Files}. @c jka-compr.el @item compression-error This is a subcategory of @code{file-error}, which results from -problems handling a compressed file.@* -@xref{How Programs Do Loading}. +problems handling a compressed file. @xref{How Programs Do Loading}. @c userlock.el @item file-locked -This is a subcategory of @code{file-error}.@* -@xref{File Locks}. +This is a subcategory of @code{file-error}. @xref{File Locks}. @c userlock.el @item file-supersession -This is a subcategory of @code{file-error}.@* -@xref{Modification Time}. +This is a subcategory of @code{file-error}. @xref{Modification Time}. @c net/ange-ftp.el @item ftp-error -This is a subcategory of @code{file-error}, which results from problems -in accessing a remote file using ftp.@* -@xref{Remote Files,,, emacs, The GNU Emacs Manual}. +This is a subcategory of @code{file-error}, which results from +problems in accessing a remote file using ftp. @xref{Remote Files,,, +emacs, The GNU Emacs Manual}. @item invalid-function -@code{"Invalid function"}@* -@xref{Function Indirection}. +The message is @samp{Invalid function}. @xref{Function Indirection}. @item invalid-read-syntax -@code{"Invalid read syntax"}@* -@xref{Printed Representation}. +The message is @samp{Invalid read syntax}. @xref{Printed +Representation}. @item invalid-regexp -@code{"Invalid regexp"}@* -@xref{Regular Expressions}. +The message is @samp{Invalid regexp}. @xref{Regular Expressions}. @c simple.el @item mark-inactive -@code{"The mark is not active now"}@* -@xref{The Mark}. +The message is @samp{The mark is not active now}. @xref{The Mark}. @item no-catch -@code{"No catch for tag"}@* -@xref{Catch and Throw}. +The message is @samp{No catch for tag}. @xref{Catch and Throw}. @ignore @c Not actually used for anything? Probably definition should be removed. @item protected-field -@code{"Attempt to modify a protected field"} +The message is @samp{Attempt to modify a protected fiel. @end ignore @item scan-error -@code{"Scan error"}@* -This happens when certain syntax-parsing functions -find invalid syntax or mismatched parentheses.@* -@xref{List Motion}, and @ref{Parsing Expressions}. +The message is @samp{Scan error}. This happens when certain +syntax-parsing functions find invalid syntax or mismatched +parentheses. @xref{List Motion}, and @xref{Parsing Expressions}. @item search-failed -@code{"Search failed"}@* -@xref{Searching and Matching}. +The message is @samp{Search failed}. @xref{Searching and Matching}. @item setting-constant -@code{"Attempt to set a constant symbol"}@* -The values of the symbols @code{nil} and @code{t}, -and any symbols that start with @samp{:}, -may not be changed.@* -@xref{Constant Variables, , Variables that Never Change}. +The message is @samp{Attempt to set a constant symbol}. This happens +when attempting to assign values to @code{nil}, @code{t}, and keyword +symbols. @xref{Constant Variables}. @c simple.el @item text-read-only -@code{"Text is read-only"}@* -This is a subcategory of @code{buffer-read-only}.@* -@xref{Special Properties}. +The message is @samp{Text is read-only}. This is a subcategory of +@code{buffer-read-only}. @xref{Special Properties}. @item undefined-color -@code{"Undefined color"}@* -@xref{Color Names}. +The message is @samp{Undefined color}. @xref{Color Names}. @item void-function -@code{"Symbol's function definition is void"}@* +The message is @samp{Symbol's function definition is void}. @xref{Function Cells}. @item void-variable -@code{"Symbol's value as variable is void"}@* +The message is @samp{Symbol's value as variable is void}. @xref{Accessing Variables}. @item wrong-number-of-arguments -@code{"Wrong number of arguments"}@* -@xref{Classifying Lists}. +The message is @samp{Wrong number of arguments}. @xref{Classifying +Lists}. @item wrong-type-argument -@code{"Wrong type argument"}@* -@xref{Type Predicates}. +The message is @samp{Wrong type argument}. @xref{Type Predicates}. @end table +@ignore The following seem to be unused now. The following kinds of error, which are classified as special cases of @code{arith-error}, can occur on certain systems for invalid use of mathematical functions. @xref{Math Functions}. @table @code @item domain-error -@code{"Arithmetic domain error"} +The message is @samp{Arithmetic domain error}. @item overflow-error -@code{"Arithmetic overflow error"}@* -This is a subcategory of @code{domain-error}. +The message is @samp{Arithmetic overflow error}. This is a subcategory +of @code{domain-error}. @item range-error -@code{"Arithmetic range error"} +The message is @code{Arithmetic range error}. @item singularity-error -@code{"Arithmetic singularity error"}@* -This is a subcategory of @code{domain-error}. +The mssage is @samp{Arithmetic singularity error}. This is a +subcategory of @code{domain-error}. @item underflow-error -@code{"Arithmetic underflow error"}@* -This is a subcategory of @code{domain-error}. +The message is @samp{Arithmetic underflow error}. This is a +subcategory of @code{domain-error}. @end table +@end ignore diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 56971bf0ff0..9424a661236 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -29,7 +29,7 @@ arguments, except where noted. @xref{Magic File Names}, for details. When file I/O functions signal Lisp errors, they usually use the condition @code{file-error} (@pxref{Handling Errors}). The error message is in most cases obtained from the operating system, according -to locale @code{system-message-locale}, and decoded using coding system +to locale @code{system-messages-locale}, and decoded using coding system @code{locale-coding-system} (@pxref{Locales}). @menu diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 356a891fbcd..af6f4b4c079 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -1529,24 +1529,14 @@ track of such changes. @xref{Misc Events}. @node Raising and Lowering @section Raising and Lowering Frames - Most window systems use a desktop metaphor. Part of this metaphor is -the idea that windows are stacked in a notional third dimension -perpendicular to the screen surface, and thus ordered from ``highest'' -to ``lowest''. Where two windows overlap, the one higher up covers -the one underneath. Even a window at the bottom of the stack can be -seen if no other window overlaps it. - -@c @cindex raising a frame redundant with raise-frame +@cindex raising a frame @cindex lowering a frame - A window's place in this ordering is not fixed; in fact, users tend -to change the order frequently. @dfn{Raising} a window means moving -it ``up'', to the top of the stack. @dfn{Lowering} a window means -moving it to the bottom of the stack. This motion is in the notional -third dimension only, and does not change the position of the window -on the screen. - - With Emacs, frames constitute the windows in the metaphor sketched -above. You can raise and lower frames using these functions: + Most window systems use a desktop metaphor. Part of this metaphor +is the idea that system-level windows (e.g.@: Emacs frames) are +stacked in a notional third dimension perpendicular to the screen +surface. Where two overlap, the one higher up covers the one +underneath. You can @dfn{raise} or @dfn{lower} a frame using the +functions @code{raise-frame} and @code{lower-frame}. @deffn Command raise-frame &optional frame This function raises frame @var{frame} (default, the selected frame). diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 9e1d3f9c6ae..cab6d12a3d8 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -23,6 +23,7 @@ define them. * Closures:: Functions that enclose a lexical environment. * Obsolete Functions:: Declaring functions obsolete. * Inline Functions:: Functions that the compiler will expand inline. +* Declare Form:: Adding additional information about a function. * Declaring Functions:: Telling the compiler that a function is defined. * Function Safety:: Determining whether a function is safe to call. * Related Topics:: Cross-references to specific Lisp primitives @@ -521,7 +522,7 @@ Scheme.) is called @dfn{defining a function}, and it is done with the @code{defun} special form. -@defspec defun name argument-list body-forms... +@defmac defun name argument-list body-forms... @code{defun} is the usual way to define new Lisp functions. It defines the symbol @var{name} as a function that looks like this: @@ -578,7 +579,7 @@ without any hesitation or notification. Emacs does not prevent you from doing this, because redefining a function is sometimes done deliberately, and there is no way to distinguish deliberate redefinition from unintentional redefinition. -@end defspec +@end defmac @cindex function aliases @defun defalias name definition &optional docstring @@ -1132,29 +1133,46 @@ examining or altering the structure of closure objects. @node Obsolete Functions @section Declaring Functions Obsolete -You can use @code{make-obsolete} to declare a function obsolete. This -indicates that the function may be removed at some stage in the future. + You can mark a named function as @dfn{obsolete}, meaning that it may +be removed at some point in the future. This causes Emacs to warn +that the function is obsolete whenever it byte-compiles code +containing that function, and whenever it displays the documentation +for that function. In all other respects, an obsolete function +behaves like any other function. + + The easiest way to mark a function as obsolete is to put a +@code{(declare (obsolete @dots{}))} form in the function's +@code{defun} definition. @xref{Declare Form}. Alternatively, you can +use the @code{make-obsolete} function, described below. + + A macro (@pxref{Macros}) can also be marked obsolete with +@code{make-obsolete}; this has the same effects as for a function. An +alias for a function or macro can also be marked as obsolete; this +makes the alias itself obsolete, not the function or macro which it +resolves to. @defun make-obsolete obsolete-name current-name &optional when -This function makes the byte compiler warn that the function -@var{obsolete-name} is obsolete. If @var{current-name} is a symbol, the -warning message says to use @var{current-name} instead of -@var{obsolete-name}. @var{current-name} does not need to be an alias for -@var{obsolete-name}; it can be a different function with similar -functionality. If @var{current-name} is a string, it is the warning -message. +This function marks @var{obsolete-name} as obsolete. +@var{obsolete-name} should be a symbol naming a function or macro, or +an alias for a function or macro. + +If @var{current-name} is a symbol, the warning message says to use +@var{current-name} instead of @var{obsolete-name}. @var{current-name} +does not need to be an alias for @var{obsolete-name}; it can be a +different function with similar functionality. @var{current-name} can +also be a string, which serves as the warning message. The message +should begin in lower case, and end with a period. It can also be +@code{nil}, in which case the warning message provides no additional +details. If provided, @var{when} should be a string indicating when the function was first made obsolete---for example, a date or a release number. @end defun -You can define a function as an alias and declare it obsolete at the -same time using the macro @code{define-obsolete-function-alias}: - @defmac define-obsolete-function-alias obsolete-name current-name &optional when docstring -This macro marks the function @var{obsolete-name} obsolete and also -defines it as an alias for the function @var{current-name}. It is -equivalent to the following: +This convenience macro marks the function @var{obsolete-name} obsolete +and also defines it as an alias for the function @var{current-name}. +It is equivalent to the following: @example (defalias @var{obsolete-name} @var{current-name} @var{docstring}) @@ -1236,6 +1254,63 @@ body uses the arguments, as you do for macros. After an inline function is defined, its inline expansion can be performed later on in the same file, just like macros. +@node Declare Form +@section The @code{declare} Form +@findex declare + + @code{declare} is a special macro which can be used to add ``meta'' +properties to a function or macro: for example, marking it as +obsolete, or giving its forms a special @key{TAB} indentation +convention in Emacs Lisp mode. + +@anchor{Definition of declare} +@defmac declare @var{specs}@dots{} +This macro ignores its arguments and evaluates to @code{nil}; it has +no run-time effect. However, when a @code{declare} form occurs as the +@emph{very first form} in the body of a @code{defun} function +definition or a @code{defmacro} macro definition (@pxref{Defining +Macros}, for a description of @code{defmacro}), it appends the +properties specified by @var{specs} to the function or macro. This +work is specially performed by the @code{defun} and @code{defmacro} +macros. + +Note that if you put a @code{declare} form in an interactive function, +it should go before the @code{interactive} form. + +Each element in @var{specs} should have the form @code{(@var{property} +@var{args}@dots{})}, which should not be quoted. These have the +following effects: + +@table @code +@item (advertised-calling-convention @var{signature} @var{when}) +This acts like a call to @code{set-advertised-calling-convention} +(@pxref{Obsolete Functions}); @var{signature} specifies the correct +argument list for calling the function or macro, and @var{when} should +be a string indicating when the variable was first made obsolete. + +@item (debug @var{edebug-form-spec}) +This is valid for macros only. When stepping through the macro with +Edebug, use @var{edebug-form-spec}. @xref{Instrumenting Macro Calls}. + +@item (doc-string @var{n}) +Use element number @var{n}, if any, as the documentation string. + +@item (indent @var{indent-spec}) +Indent calls to this function or macro according to @var{indent-spec}. +This is typically used for macros, though it works for functions too. +@xref{Indenting Macros}. + +@item (obsolete @var{current-name} @var{when}) +Mark the function or macro as obsolete, similar to a call to +@code{make-obsolete} (@pxref{Obsolete Functions}). @var{current-name} +should be a symbol (in which case the warning message says to use that +instead), a string (specifying the warning message), or @code{nil} (in +which case the warning message gives no extra details). @var{when} +should be a string indicating when the function or macro was first +made obsolete. +@end table +@end defmac + @node Declaring Functions @section Telling the Compiler that a Function is Defined @cindex function declaration diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index 5dd8f3c11f5..1375a057a5a 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi @@ -58,11 +58,17 @@ use @kbd{C-h f} (@code{describe-function}) or @kbd{C-h v} are many other conventions for documentation strings; see @ref{Documentation Tips}. - Documentation strings can contain several special substrings, which -stand for key bindings to be looked up in the current keymaps when the -documentation is displayed. This allows documentation strings to refer -to the keys for related commands and be accurate even when a user -rearranges the key bindings. (@xref{Keys in Documentation}.) + Documentation strings can contain several special text sequences, +referring to key bindings which are looked up in the current keymaps +when the user views the documentation. This allows the help commands +to display the correct keys even if a user rearranges the default key +bindings. @xref{Keys in Documentation}. + + In the documentation string of an autoloaded command +(@pxref{Autoload}), these special text sequences have an additional +special effect: they cause @kbd{C-h f} (@code{describe-function}) on +the command to trigger autoloading. (This is needed for correctly +setting up the hyperlinks in the @file{*Help*} buffer). @vindex emacs-lisp-docstring-fill-column Emacs Lisp mode fills documentation strings to the width diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index f6ec0ae5e55..40dfcaea043 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -2288,12 +2288,12 @@ command but with different enable conditions. The best way to do this in Emacs now is with extended menu items; before that feature existed, it could be done by defining alias commands and using them in menu items. Here's an example that makes two aliases for -@code{toggle-read-only} and gives them different enable conditions: +@code{read-only-mode} and gives them different enable conditions: @example -(defalias 'make-read-only 'toggle-read-only) +(defalias 'make-read-only 'read-only-mode) (put 'make-read-only 'menu-enable '(not buffer-read-only)) -(defalias 'make-writable 'toggle-read-only) +(defalias 'make-writable 'read-only-mode) (put 'make-writable 'menu-enable 'buffer-read-only) @end example @@ -2310,7 +2310,7 @@ itself). To request this, give the alias symbol a non-@code{nil} @noindent causes menu items for @code{make-read-only} and @code{make-writable} to -show the keyboard bindings for @code{toggle-read-only}. +show the keyboard bindings for @code{read-only-mode}. @node Toolkit Differences @subsubsection Toolkit Differences diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index 3c9bee96639..aa243185359 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -384,11 +384,13 @@ non-@acronym{ASCII} characters written as @code{?v@var{literal}}. @section Autoload @cindex autoload - The @dfn{autoload} facility allows you to register the existence of -a function or macro, but put off loading the file that defines it. -The first call to the function automatically reads the proper file, in + The @dfn{autoload} facility lets you register the existence of a +function or macro, but put off loading the file that defines it. The +first call to the function automatically loads the proper library, in order to install the real definition and other associated code, then runs the real definition as if it had been loaded all along. +Autoloading can also be triggered by looking up the documentation of +the function or macro (@pxref{Documentation Basics}). There are two ways to set up an autoloaded function: by calling @code{autoload}, and by writing a special ``magic'' comment in the diff --git a/doc/lispref/macros.texi b/doc/lispref/macros.texi index efe298bf647..0a5152a43a1 100644 --- a/doc/lispref/macros.texi +++ b/doc/lispref/macros.texi @@ -235,43 +235,8 @@ of constants and nonconstant parts. To make this easier, use the @end example The body of a macro definition can include a @code{declare} form, -which can specify how @key{TAB} should indent macro calls, and how to -step through them for Edebug. - -@defmac declare @var{specs}@dots{} -@anchor{Definition of declare} -A @code{declare} form is used in a macro definition to specify various -additional information about it. The following specifications are -currently supported: - -@table @code -@item (debug @var{edebug-form-spec}) -Specify how to step through macro calls for Edebug. -@xref{Instrumenting Macro Calls}. - -@item (indent @var{indent-spec}) -Specify how to indent calls to this macro. @xref{Indenting Macros}, -for more details. - -@item (doc-string @var{number}) -Specify which element of the macro is the documentation string, if -any. -@end table - -A @code{declare} form only has its special effect in the body of a -@code{defmacro} form if it immediately follows the documentation -string, if present, or the argument list otherwise. (Strictly -speaking, @emph{several} @code{declare} forms can follow the -documentation string or argument list, but since a @code{declare} form -can have several @var{specs}, they can always be combined into a -single form.) When used at other places in a @code{defmacro} form, or -outside a @code{defmacro} form, @code{declare} just returns @code{nil} -without evaluating any @var{specs}. -@end defmac - - No macro absolutely needs a @code{declare} form, because that form -has no effect on how the macro expands, on what the macro means in the -program. It only affects the secondary features listed above. +which specifies additional properties about the macro. @xref{Declare +Form}. @node Problems with Macros @section Common Problems Using Macros diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi index 7c9672a38c0..a086f2b3af1 100644 --- a/doc/lispref/numbers.texi +++ b/doc/lispref/numbers.texi @@ -48,9 +48,8 @@ to @tex @math{2^{29}-1}), @end tex -but some machines provide a wider range. Many examples in this -chapter assume that an integer has 30 bits and that floating point -numbers are IEEE double precision. +but many machines provide a wider range. Many examples in this +chapter assume the minimum integer width of 30 bits. @cindex overflow The Lisp reader reads an integer as a sequence of digits with optional @@ -160,8 +159,9 @@ The value of this variable is the smallest integer that Emacs Lisp can handle. It is negative. @end defvar - @xref{Character Codes, max-char}, for the maximum value of a valid -character codepoint. + In Emacs Lisp, text characters are represented by integers. Any +integer between zero and the value of @code{max-char}, inclusive, is +considered to be valid as a character. @xref{String Basics}. @node Float Basics @section Floating Point Basics @@ -171,8 +171,8 @@ character codepoint. not integral. The precise range of floating point numbers is machine-specific; it is the same as the range of the C data type @code{double} on the machine you are using. Emacs uses the -@acronym{IEEE} floating point standard where possible (the standard is -supported by most modern computers). +@acronym{IEEE} floating point standard, which is supported by all +modern computers. The read syntax for floating point numbers requires either a decimal point (with at least one digit following), an exponent, or both. For @@ -316,17 +316,16 @@ compare them, then you test whether two values are the same @emph{object}. By contrast, @code{=} compares only the numeric values of the objects. - At present, each integer value has a unique Lisp object in Emacs Lisp. + In Emacs Lisp, each integer value is a unique Lisp object. Therefore, @code{eq} is equivalent to @code{=} where integers are -concerned. It is sometimes convenient to use @code{eq} for comparing an -unknown value with an integer, because @code{eq} does not report an -error if the unknown value is not a number---it accepts arguments of any -type. By contrast, @code{=} signals an error if the arguments are not -numbers or markers. However, it is a good idea to use @code{=} if you -can, even for comparing integers, just in case we change the -representation of integers in a future Emacs version. - - Sometimes it is useful to compare numbers with @code{equal}; it +concerned. It is sometimes convenient to use @code{eq} for comparing +an unknown value with an integer, because @code{eq} does not report an +error if the unknown value is not a number---it accepts arguments of +any type. By contrast, @code{=} signals an error if the arguments are +not numbers or markers. However, it is better programming practice to +use @code{=} if you can, even for comparing integers. + + Sometimes it is useful to compare numbers with @code{equal}, which treats two numbers as equal if they have the same data type (both integers, or both floating point) and the same value. By contrast, @code{=} can treat an integer and a floating point number as equal. @@ -439,15 +438,16 @@ If @var{number} is already a floating point number, @code{float} returns it unchanged. @end defun -There are four functions to convert floating point numbers to integers; -they differ in how they round. All accept an argument @var{number} -and an optional argument @var{divisor}. Both arguments may be -integers or floating point numbers. @var{divisor} may also be + There are four functions to convert floating point numbers to +integers; they differ in how they round. All accept an argument +@var{number} and an optional argument @var{divisor}. Both arguments +may be integers or floating point numbers. @var{divisor} may also be @code{nil}. If @var{divisor} is @code{nil} or omitted, these functions convert @var{number} to an integer, or return it unchanged if it already is an integer. If @var{divisor} is non-@code{nil}, they divide @var{number} by @var{divisor} and convert the result to an -integer. An @code{arith-error} results if @var{divisor} is 0. +integer. integer. If @var{divisor} is zero (whether integer or +floating-point), Emacs signals an @code{arith-error} error. @defun truncate number &optional divisor This returns @var{number}, converted to an integer by rounding towards @@ -524,14 +524,12 @@ depending on your machine. @section Arithmetic Operations @cindex arithmetic operations - Emacs Lisp provides the traditional four arithmetic operations: -addition, subtraction, multiplication, and division. Remainder and modulus -functions supplement the division functions. The functions to -add or subtract 1 are provided because they are traditional in Lisp and -commonly used. - - All of these functions except @code{%} return a floating point value -if any argument is floating. + Emacs Lisp provides the traditional four arithmetic operations +(addition, subtraction, multiplication, and division), as well as +remainder and modulus functions, and functions to add or subtract 1. +Except for @code{%}, each of these functions accepts both integer and +floating point arguments, and returns a floating point number if any +argument is a floating point number. It is important to note that in Emacs Lisp, arithmetic functions do not check for overflow. Thus @code{(1+ 536870911)} may evaluate to @@ -620,40 +618,49 @@ quotient. If there are additional arguments @var{divisors}, then it divides @var{dividend} by each divisor in turn. Each argument may be a number or a marker. -If all the arguments are integers, then the result is an integer too. -This means the result has to be rounded. On most machines, the result -is rounded towards zero after each division, but some machines may round -differently with negative arguments. This is because the Lisp function -@code{/} is implemented using the C division operator, which also -permits machine-dependent rounding. As a practical matter, all known -machines round in the standard fashion. - -@cindex @code{arith-error} in division -If you divide an integer by 0, an @code{arith-error} error is signaled. -(@xref{Errors}.) Floating point division by zero returns either -infinity or a NaN if your machine supports @acronym{IEEE} floating point; -otherwise, it signals an @code{arith-error} error. +If all the arguments are integers, the result is an integer, obtained +by rounding the quotient towards zero after each division. +(Hypothetically, some machines may have different rounding behavior +for negative arguments, because @code{/} is implemented using the C +division operator, which permits machine-dependent rounding; but this +does not happen in practice.) @example @group (/ 6 2) @result{} 3 @end group +@group (/ 5 2) @result{} 2 +@end group +@group (/ 5.0 2) @result{} 2.5 +@end group +@group (/ 5 2.0) @result{} 2.5 +@end group +@group (/ 5.0 2.0) @result{} 2.5 +@end group +@group (/ 25 3 2) @result{} 4 +@end group @group (/ -17 6) - @result{} -2 @r{(could in theory be @minus{}3 on some machines)} + @result{} -2 @end group @end example + +@cindex @code{arith-error} in division +If you divide an integer by the integer 0, Emacs signals an +@code{arith-error} error (@pxref{Errors}). If you divide a floating +point number by 0, or divide by the floating point number 0.0, the +result is either positive or negative infinity (@pxref{Float Basics}). @end defun @defun % dividend divisor @@ -661,10 +668,18 @@ otherwise, it signals an @code{arith-error} error. This function returns the integer remainder after division of @var{dividend} by @var{divisor}. The arguments must be integers or markers. -For negative arguments, the remainder is in principle machine-dependent -since the quotient is; but in practice, all known machines behave alike. +For any two integers @var{dividend} and @var{divisor}, + +@example +@group +(+ (% @var{dividend} @var{divisor}) + (* (/ @var{dividend} @var{divisor}) @var{divisor})) +@end group +@end example -An @code{arith-error} results if @var{divisor} is 0. +@noindent +always equals @var{dividend}. If @var{divisor} is zero, Emacs signals +an @code{arith-error} error. @example (% 9 4) @@ -676,18 +691,6 @@ An @code{arith-error} results if @var{divisor} is 0. (% -9 -4) @result{} -1 @end example - -For any two integers @var{dividend} and @var{divisor}, - -@example -@group -(+ (% @var{dividend} @var{divisor}) - (* (/ @var{dividend} @var{divisor}) @var{divisor})) -@end group -@end example - -@noindent -always equals @var{dividend}. @end defun @defun mod dividend divisor @@ -697,10 +700,9 @@ in other words, the remainder after division of @var{dividend} by @var{divisor}, but with the same sign as @var{divisor}. The arguments must be numbers or markers. -Unlike @code{%}, @code{mod} returns a well-defined result for negative -arguments. It also permits floating point arguments; it rounds the -quotient downward (towards minus infinity) to an integer, and uses that -quotient to compute the remainder. +Unlike @code{%}, @code{mod} permits floating point arguments; it +rounds the quotient downward (towards minus infinity) to an integer, +and uses that quotient to compute the remainder. If @var{divisor} is zero, @code{mod} signals an @code{arith-error} error if both arguments are integers, and returns a NaN otherwise. @@ -1086,8 +1088,8 @@ numbers as arguments. @defun sin arg @defunx cos arg @defunx tan arg -These are the ordinary trigonometric functions, with argument measured -in radians. +These are the basic trigonometric functions, with argument @var{arg} +measured in radians. @end defun @defun asin arg @@ -1154,20 +1156,6 @@ This function returns the logarithm of @var{arg}, with base returns a NaN. @end defun -@ignore -@defun expm1 arg -This function returns @code{(1- (exp @var{arg}))}, but it is more -accurate than that when @var{arg} is negative and @code{(exp @var{arg})} -is close to 1. -@end defun - -@defun log1p arg -This function returns @code{(log (1+ @var{arg}))}, but it is more -accurate than that when @var{arg} is so small that adding 1 to it would -lose accuracy. -@end defun -@end ignore - @defun log10 arg This function returns the logarithm of @var{arg}, with base 10: @code{(log10 @var{x})} @equiv{} @code{(log @var{x} 10)}. @@ -1201,20 +1189,20 @@ The mathematical constant @math{pi} (3.14159@dots{}). @section Random Numbers @cindex random numbers -A deterministic computer program cannot generate true random numbers. -For most purposes, @dfn{pseudo-random numbers} suffice. A series of -pseudo-random numbers is generated in a deterministic fashion. The -numbers are not truly random, but they have certain properties that -mimic a random series. For example, all possible values occur equally -often in a pseudo-random series. + A deterministic computer program cannot generate true random +numbers. For most purposes, @dfn{pseudo-random numbers} suffice. A +series of pseudo-random numbers is generated in a deterministic +fashion. The numbers are not truly random, but they have certain +properties that mimic a random series. For example, all possible +values occur equally often in a pseudo-random series. -In Emacs, pseudo-random numbers are generated from a ``seed''. -Starting from any given seed, the @code{random} function always -generates the same sequence of numbers. Emacs typically starts with a -different seed each time, so the sequence of values of @code{random} -typically differs in each Emacs run. + Pseudo-random numbers are generated from a ``seed''. Starting from +any given seed, the @code{random} function always generates the same +sequence of numbers. By default, Emacs initializes the random seed at +startup, in such a way that the sequence of values of @code{random} +(with overwhelming likelihood) differs in each Emacs run. -Sometimes you want the random number sequence to be repeatable. For + Sometimes you want the random number sequence to be repeatable. For example, when debugging a program whose behavior depends on the random number sequence, it is helpful to get the same behavior in each program run. To make the sequence repeat, execute @code{(random "")}. @@ -1227,8 +1215,10 @@ This function returns a pseudo-random integer. Repeated calls return a series of pseudo-random integers. If @var{limit} is a positive integer, the value is chosen to be -nonnegative and less than @var{limit}. Otherwise, the value -might be any integer representable in Lisp. +nonnegative and less than @var{limit}. Otherwise, the value might be +any integer representable in Lisp, i.e.@: an integer between +@code{most-negative-fixnum} and @code{most-positive-fixnum} +(@pxref{Integer Basics}). If @var{limit} is @code{t}, it means to choose a new seed based on the current time of day and on Emacs's process @acronym{ID} number. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 68e53c78972..54754f8e5e9 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -70,13 +70,11 @@ in their turn. The files @file{subdirs.el} are normally generated automatically when Emacs is installed. @item -It registers input methods by loading any @file{leim-list.el} file -found in the @code{load-path}. - -@c It removes PWD from the environment if it is not accurate. -@c It abbreviates default-directory. - -@c Now normal-top-level calls command-line. +If the library @file{leim-list.el} exists, Emacs loads it. This +optional library is intended for registering input methods; Emacs +looks for it in @code{load-path} (@pxref{Library Search}), skipping +those directories containing the standard Emacs libraries (since +@file{leim-list.el} should not exist in those directories). @vindex before-init-time @item @@ -1159,6 +1157,20 @@ This function returns the effective @acronym{UID} of the user. The value may be a floating point number. @end defun +@defun system-users +This function returns a list of strings, listing the user names on the +system. If Emacs cannot retrieve this information, the return value +is a list containing just the value of @code{user-real-login-name}. +@end defun + +@cindex user groups +@defun system-groups +This function returns a list of strings, listing the names of user +groups on the system. If Emacs cannot retrieve this information, the +return value is @code{nil}. +@end defun + + @node Time of Day @section Time of Day @@ -1812,6 +1824,29 @@ minutes, and even if there have been garbage collections and autosaves. input. Then it becomes idle again, and all the idle timers that are set up to repeat will subsequently run another time, one by one. + Do not write an idle timer function containing a loop which does a +certain amount of processing each time around, and exits when +@code{(input-pending-p)} is non-@code{nil}. This approach seems very +natural but has two problems: + +@itemize +@item +It blocks out all process output (since Emacs accepts process output +only while waiting). + +@item +It blocks out any idle timers that ought to run during that time. +@end itemize + +@noindent +Similarly, do not write an idle timer function that sets up another +idle timer (including the same idle timer) with @var{secs} argument +less than or equal to the current idleness time. Such a timer will +run almost immediately, and continue running again and again, instead +of waiting for the next time Emacs becomes idle. The correct approach +is to reschedule with an appropriate increment of the current value of +the idleness time, as described below. + @defun current-idle-time If Emacs is idle, this function returns the length of time Emacs has been idle, as a list of four integers: @code{(@var{sec-high} @@ -1820,60 +1855,34 @@ been idle, as a list of four integers: @code{(@var{sec-high} When Emacs is not idle, @code{current-idle-time} returns @code{nil}. This is a convenient way to test whether Emacs is idle. +@end defun -The main use of this function is when an idle timer function wants to -``take a break'' for a while. It can set up another idle timer to -call the same function again, after a few seconds more idleness. -Here's an example: + The main use of @code{current-idle-time} is when an idle timer +function wants to ``take a break'' for a while. It can set up another +idle timer to call the same function again, after a few seconds more +idleness. Here's an example: -@smallexample -(defvar resume-timer nil - "Timer that `timer-function' used to reschedule itself, or nil.") +@example +(defvar my-resume-timer nil + "Timer for `my-timer-function' to reschedule itself, or nil.") -(defun timer-function () - ;; @r{If the user types a command while @code{resume-timer}} +(defun my-timer-function () + ;; @r{If the user types a command while @code{my-resume-timer}} ;; @r{is active, the next time this function is called from} - ;; @r{its main idle timer, deactivate @code{resume-timer}.} - (when resume-timer - (cancel-timer resume-timer)) + ;; @r{its main idle timer, deactivate @code{my-resume-timer}.} + (when my-resume-timer + (cancel-timer my-resume-timer)) ...@var{do the work for a while}... (when @var{taking-a-break} - (setq resume-timer + (setq my-resume-timer (run-with-idle-timer ;; Compute an idle time @var{break-length} ;; more than the current value. (time-add (current-idle-time) (seconds-to-time @var{break-length})) nil - 'timer-function)))) -@end smallexample -@end defun - - Do not write an idle timer function containing a loop which does a -certain amount of processing each time around, and exits when -@code{(input-pending-p)} is non-@code{nil}. This approach seems very -natural but has two problems: - -@itemize -@item -It blocks out all process output (since Emacs accepts process output -only while waiting). - -@item -It blocks out any idle timers that ought to run during that time. -@end itemize - -@noindent -For similar reasons, do not write an idle timer function that sets -up another idle time (including the same idle timer) with the -@var{secs} argument less or equal to the current idleness time. Such -a timer will run almost immediately, and continue running again and -again, instead of waiting for the next time Emacs becomes idle. - -@noindent -The correct approach is for the idle timer to reschedule itself after -a brief pause, using the method in the @code{timer-function} example -above. + 'my-timer-function)))) +@end example @node Terminal Input @section Terminal Input @@ -1907,7 +1916,6 @@ If @var{flow} is non-@code{nil}, then Emacs uses @sc{xon/xoff} (@kbd{C-q}, @kbd{C-s}) flow control for output to the terminal. This has no effect except in @sc{cbreak} mode. -@c Emacs 19 feature The argument @var{meta} controls support for input character codes above 127. If @var{meta} is @code{t}, Emacs converts characters with the 8th bit set into Meta characters. If @var{meta} is @code{nil}, @@ -1916,7 +1924,6 @@ it as a parity bit. If @var{meta} is neither @code{t} nor @code{nil}, Emacs uses all 8 bits of input unchanged. This is good for terminals that use 8-bit character sets. -@c Emacs 19 feature If @var{quit-char} is non-@code{nil}, it specifies the character to use for quitting. Normally this character is @kbd{C-g}. @xref{Quitting}. @@ -1925,7 +1932,6 @@ use for quitting. Normally this character is @kbd{C-g}. The @code{current-input-mode} function returns the input mode settings Emacs is currently using. -@c Emacs 19 feature @defun current-input-mode This function returns the current mode for reading keyboard input. It returns a list, corresponding to the arguments of @code{set-input-mode}, diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index b7097e057c0..865435c91b3 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -35,28 +35,31 @@ keyboard character events. @node String Basics @section String and Character Basics - Characters are represented in Emacs Lisp as integers; -whether an integer is a character or not is determined only by how it is -used. Thus, strings really contain integers. @xref{Character Codes}, -for details about character representation in Emacs. - - The length of a string (like any array) is fixed, and cannot be -altered once the string exists. Strings in Lisp are @emph{not} -terminated by a distinguished character code. (By contrast, strings in -C are terminated by a character with @acronym{ASCII} code 0.) + A character is a Lisp object which represents a single character of +text. In Emacs Lisp, characters are simply integers; whether an +integer is a character or not is determined only by how it is used. +@xref{Character Codes}, for details about character representation in +Emacs. + + A string is a fixed sequence of characters. It is a type of +sequence called a @dfn{array}, meaning that its length is fixed and +cannot be altered once it is created (@pxref{Sequences Arrays +Vectors}). Unlike in C, Emacs Lisp strings are @emph{not} terminated +by a distinguished character code. Since strings are arrays, and therefore sequences as well, you can -operate on them with the general array and sequence functions. -(@xref{Sequences Arrays Vectors}.) For example, you can access or -change individual characters in a string using the functions @code{aref} -and @code{aset} (@pxref{Array Functions}). However, note that -@code{length} should @emph{not} be used for computing the width of a -string on display; use @code{string-width} (@pxref{Width}) instead. - - There are two text representations for non-@acronym{ASCII} characters in -Emacs strings (and in buffers): unibyte and multibyte (@pxref{Text -Representations}). For most Lisp programming, you don't need to be -concerned with these two representations. +operate on them with the general array and sequence functions +documented in @ref{Sequences Arrays Vectors}. For example, you can +access or change individual characters in a string using the functions +@code{aref} and @code{aset} (@pxref{Array Functions}). However, note +that @code{length} should @emph{not} be used for computing the width +of a string on display; use @code{string-width} (@pxref{Width}) +instead. + + There are two text representations for non-@acronym{ASCII} +characters in Emacs strings (and in buffers): unibyte and multibyte. +For most Lisp programming, you don't need to be concerned with these +two representations. @xref{Text Representations}, for details. Sometimes key sequences are represented as unibyte strings. When a unibyte string is a key sequence, string elements in the range 128 to @@ -88,7 +91,7 @@ for information about the syntax of characters and strings. representations and to encode and decode character codes. @node Predicates for Strings -@section The Predicates for Strings +@section Predicates for Strings For more information about general sequence and array predicates, see @ref{Sequences Arrays Vectors}, and @ref{Arrays}. diff --git a/etc/ChangeLog b/etc/ChangeLog index 6f2b178fcd7..2c1e3758ea0 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,7 @@ +2012-09-30 Jan Djärv <jan.h.d@swipnet.se> + + * NEWS: The NS port supports fullscreen. + 2012-09-17 Glenn Morris <rgm@gnu.org> * refcards/emacsver.tex: New file. @@ -76,6 +76,7 @@ You can explicitly require a specific version by passing * Startup Changes in Emacs 24.3 ++++ ** Emacs no longer searches for `leim-list.el' files beneath the standard lisp/ directory. There should not be any there anyway. If you have been adding them there, put them somewhere else, eg site-lisp. @@ -86,15 +87,20 @@ been adding them there, put them somewhere else, eg site-lisp. * Changes in Emacs 24.3 +** minibuffer-electric-default-mode can rewrite (default ...) to [...]. +Just set minibuffer-eldef-shorten-default to t before enabling the mode. + ++++ ** Most y-or-n prompts now allow you to scroll the selected window. Typing C-v or M-v at a y-or-n prompt scrolls forward or backward respectively, without exiting from the prompt. +--- ** In minibuffer filename prompts, `C-M-f' and `C-M-b' now move to the next and previous path separator, respectively. ** Mode line changes - +--- *** New option `mode-line-default-help-echo' specifies the help text (shown in a tooltip or in the echo area) for any part of the mode line that does not have its own specialized help text. @@ -104,12 +110,14 @@ invokes `set-buffer-file-coding-system'. ** Help changes ++++ *** `C-h f' (describe-function) can now perform autoloading. When this command is called for an autoloaded function whose docstring contains a key substitution construct, that function's library is automatically loaded, so that the documentation can be shown correctly. To disable this, set `help-enable-auto-load' to nil. +--- *** `C-h f' now reports previously-autoloaded functions as "autoloaded", even after their associated libraries have been loaded (and the autoloads have been redefined as functions). @@ -133,16 +141,17 @@ treated as images. :background image spec property. ** Server and client changes - ++++ *** emacsclient now obeys string values for `initial-buffer-choice', if it is told to open a new frame without specifying any file to visit or expression to evaluate. - +--- *** New option `server-auth-key' specifies a shared server key. ** In the Package Menu, newly-available packages are listed as "new", and sorted above the other "available" packages by default. ++++ ** `C-x C-q' is now bound to the new minor mode `read-only-mode'. This minor mode replaces `toggle-read-only', which is now obsolete. @@ -151,6 +160,7 @@ On encountering a fatal error, Emacs now outputs a textual description of the fatal signal, and a short backtrace on platforms like glibc that support backtraces. +--- ** If your Emacs was built from a bzr checkout, the new variable `emacs-bzr-version' contains information about the bzr revision used. @@ -177,33 +187,31 @@ The PCL-CVS commands are still available via the keyboard. --- *** New input method `vietnamese-vni'. +** The NS port supports fullscreen. + * Editing Changes in Emacs 24.3 +** Navigation command changes +++ -** `C-x 8 RET' is now bound to `insert-char', which is now a command. -`ucs-insert' is now an obsolete alias for `insert-char'. - ---- -** The `z' key no longer has a binding in most special modes. -It used to be bound to `kill-this-buffer', but `z' is too easy to -accidentally type. - -** New option `delete-trailing-lines' specifies whether -M-x delete-trailing-whitespace should delete trailing lines at the end -of the buffer. It defaults to t. +*** New binding `M-g c' for `goto-char'. ++++ +*** New binding `M-g TAB' for `move-to-column'. ++++ +*** `M-g TAB' (`move-to-column') prompts for a column number if called +interactively with no prefix arg. Previously, it moved to column 1. ** Search and Replace changes - ++++ *** Non-regexp Isearch now performs "lax" space matching. Each sequence of spaces in the supplied search string may match any sequence of one or more whitespace characters, as specified by the variable `search-whitespace-regexp'. (This variable is also used by a similar existing feature for regexp Isearch). - ++++ *** New Isearch command `M-s SPC' toggles lax space matching. This applies to both ordinary and regexp Isearch. - ++++ *** New option `replace-lax-whitespace'. If non-nil, `query-replace' uses flexible whitespace matching too. The default is nil. @@ -212,6 +220,20 @@ The default is nil. and `M-s _' in Isearch toggles symbol search mode. `M-s c' in Isearch toggles search case-sensitivity. ++++ +** `C-x 8 RET' is now bound to `insert-char', which is now a command. +`ucs-insert' is now an obsolete alias for `insert-char'. + +--- +** The `z' key no longer has a binding in most special modes. +It used to be bound to `kill-this-buffer', but `z' is too easy to +accidentally type. + ++++ +** New option `delete-trailing-lines' specifies whether +M-x delete-trailing-whitespace should delete trailing lines at the end +of the buffer. It defaults to t. + ** Register changes +++ *** `C-x r +' is now overloaded to invoke `append-to-register. @@ -220,13 +242,10 @@ and `M-s _' in Isearch toggles symbol search mode. the text to put between collected texts for use with M-x append-to-register and M-x prepend-to-register. ++++ ** `C-u M-=' now counts lines/words/characters in the entire buffer. -** New binding `M-g c' for `goto-char'. - -** M-x move-to-column, if called interactively with no prefix arg, now -prompts for a column number. - ++++ ** New command `C-x r M-w' (copy-rectangle-as-kill). It copies the region-rectangle as the last rectangle kill. @@ -238,17 +257,17 @@ just removing them, as done by `yank-excluded-properties'. * Changes in Specialized Modes and Packages in Emacs 24.3 ** Apropos - +--- *** The faces used by Apropos are now directly customizable. These faces are named `apropos-symbol', `apropos-keybinding', and so on; see the `apropos' Custom group for details. - -**** The old options whose values specified faces to use were removed +--- +*** The old options whose values specified faces to use were removed (i.e. `apropos-symbol-face', `apropos-keybinding-face', etc.). ** Buffer Menu This package has been rewritten to use Tabulated List mode. - +--- *** Option `Buffer-menu-buffer+size-width' is now obsolete. Use `Buffer-menu-name-width' and `Buffer-menu-size-width' instead. @@ -410,6 +429,8 @@ server properties. ** In Perl mode, new option `perl-indent-parens-as-block' causes non-block closing brackets to be aligned with the line of the opening bracket. +** In Proced mode, new command `proced-renice' renices marked processes. + ** Python mode A new version of python.el, which provides several new features, including: @@ -562,27 +583,30 @@ in case that is not properly encoded. ** which-function-mode now applies to all applicable major modes by default. +--- +** winner-mode-hook now runs when the mode is disabled, as well as when it is +enabled. ** FIXME something happened to ses.el, 2012-04-17. ** Obsolete packages: - ++++ *** assoc.el In most cases, assoc+member+push+delq work just as well. And in any case it's just a terrible package: ugly semantics, terrible inefficiency, and not namespace-clean. - +--- *** bruce.el - +--- *** ledit.el - +--- *** mailpost.el - ++++ *** mouse-sel.el - +--- *** patcomp.el - ++++ *** cust-print.el @@ -590,11 +614,13 @@ inefficiency, and not namespace-clean. * Incompatible Lisp Changes in Emacs 24.3 ++++ ** (random) by default now returns a different random sequence in every Emacs run. Use (random S), where S is a string, to set the random seed to a value based on S, in order to get a repeatable sequence in later calls. +--- ** The function `x-select-font' can return a font spec, instead of a font name as a string. Whether it returns a font spec or a font name depends on the graphical library. @@ -615,6 +641,7 @@ and are now undefined. For backwards compatibility, defun and defmacro currently return the name of the newly defined function/macro but this should not be relied upon. +--- ** `face-spec-set' no longer sets frame-specific attributes when the third argument is a frame (that usage was obsolete since Emacs 22.2). @@ -652,15 +679,34 @@ are deprecated and will be removed eventually. **** inactivate-current-input-method-function -> deactivate-current-input-method-function -** Some obsolete variables and variable aliases were removed: +** Some obsolete functions and variables were removed: *** `facemenu-unlisted-faces' *** `rmail-decode-mime-charset' *** `last-input-char', `last-command-char', `unread-command-char'. +*** `iswitchb-read-buffer' +*** `sc-version', `sc-submit-bug-report' +*** `set-char-table-default' +*** `string-to-sequence' (use `string-to-list' or `string-to-vector'). +*** `compile-internal' +*** `mode-line-inverse-video' +*** `cvs-commit-buffer-require-final-newline' +(use `'log-edit-require-final-newline'instead) +*** `cvs-changelog-full-paragraphs' +(use `log-edit-changelog-full-paragraphs' instead) +*** `cvs-diff-ignore-marks', `cvs-diff-buffer-name' +*** `vc-ignore-vc-files' (use `vc-handled-backends' instead) +*** `vc-master-templates' (use `vc-handled-backends' instead) +*** `vc-checkout-carefully' * Lisp changes in Emacs 24.3 +** New sampling-based Elisp profiler. +Try M-x profiler-start ... M-x profiler-stop; and then M-x profiler-report. +The sampling rate can be based on CPU time (only supported on some +systems), or based on memory allocations. + ** CL-style generalized variables are now in core Elisp. `setf' is autoloaded; `push' and `pop' accept generalized variables. @@ -706,14 +752,11 @@ now accept a third argument to avoid choosing the selected window. *** New macro `with-temp-buffer-window'. -*** New options `temp-buffer-resize-frames' and -`temp-buffer-resize-regexps'. - *** `temp-buffer-resize-mode' no longer resizes windows that have been reused. -*** New function `fit-frame-to-buffer' and new option -`fit-frame-to-buffer-bottom-margin'. +*** New function `fit-frame-to-buffer' and new options +`fit-frame-to-buffer' and `fit-frame-to-buffer-bottom-margin'. *** New display action functions `display-buffer-below-selected', `display-buffer-at-bottom' and `display-buffer-in-previous-window'. @@ -728,6 +771,9 @@ non-nil, specifies frame parameters to give any newly-created frame. *** New display action alist entry `previous-window', if non-nil, specifies window to reuse in `display-buffer-in-previous-window'. +*** New display action alist entries `window-height' and `window-width' +to specify size of new window created by `display-buffer'. + *** The following variables are obsolete, as they can be replaced by appropriate entries in the `display-buffer-alist' function introduced in Emacs 24.1: @@ -740,23 +786,24 @@ in Emacs 24.1: **** `display-buffer-function' ** Time - +--- *** `current-time-string' no longer requires that its argument's year must be in the range 1000..9999. It now works with any year supported by the underlying C implementation. - +--- *** `current-time' now returns extended-format time stamps (HIGH LOW USEC PSEC), where the new PSEC slot specifies picoseconds. PSEC is typically a multiple of 1000 on current machines. Other functions that use this format, such as file-attributes and format-time-string, have been changed accordingly. Old-format time stamps are still accepted. - +--- *** The format of timers in timer-list and timer-idle-list is now [TRIGGERED-P HI-SECS LO-SECS USECS REPEAT-DELAY FUNCTION ARGS IDLE-DELAY PSECS]. The PSECS slot is new, and uses picosecond resolution. It can be accessed via the new timer--psecs accessor. ++++ ** Floating point functions now always return special values like NaN, instead of signaling errors, if given invalid args, e.g. (log -1.0). Previously, they returned NaNs on some platforms but signaled errors @@ -774,18 +821,22 @@ result in a warning describing the cycle. *** `autoloadp' *** `autoload-do-load'. ++++ *** `buffer-narrowed-p' tests if the buffer is narrowed. *** `file-name-base' returns a file name sans directory and extension. *** `function-get' fetches a function property, following aliases. ++++ *** `posnp' tests if an object is a `posn'. *** `set-temporary-overlay-map' sets up a temporary overlay map. ++++ *** `system-users' returns the user names on the system. ++++ *** `system-groups' returns the group names on the system. *** `tty-top-frame' returns the topmost frame of a text terminal. ** New macros `setq-local' and `defvar-local'. -** New fringe bitmap exclamation-mark. +** New fringe bitmap `exclamation-mark'. ** Face underlining can now use a wave. See the "Face Attributes" section of the Elisp manual. diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index 3f1e287db34..4c25f54545d 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,7 @@ +2012-09-26 Juanma Barranquero <lekktu@gmail.com> + + * makefile.w32-in (obj): Add profiler.o. + 2012-09-17 Glenn Morris <rgm@gnu.org> * ebrowse.c (version): @@ -1038,7 +1042,7 @@ (Asm_help, default_C_suffixes, default_C_help, Cplusplus_suffixes) (Cplusplus_help, Cjava_suffixes, Cobol_suffixes, Cstar_suffixes) (Erlang_suffixes, Erlang_help, Forth_suffixes, Forth_help) - (Fortran_suffixes, Fortran_help, HTML_suffixes, HTML_help) + (Fortran_suffixes, Fortran_help, HTML_suffixes, HTML_help) (Lisp_suffixes, Lisp_help, Lua_suffixes, Lua_help) (Makefile_filenames, Makefile_help, Objc_suffixes, Objc_help) (Pascal_suffixes, Pascal_help, Perl_suffixes, Perl_interpreters) diff --git a/lib-src/makefile.w32-in b/lib-src/makefile.w32-in index 64974b88b6f..23ef71de10c 100644 --- a/lib-src/makefile.w32-in +++ b/lib-src/makefile.w32-in @@ -140,7 +140,7 @@ obj = dosfns.o msdos.o \ process.o callproc.o unexw32.o \ region-cache.o sound.o atimer.o \ doprnt.o intervals.o textprop.o composite.o \ - gnutls.o xml.o + gnutls.o xml.o profiler.o # # These are the lisp files that are loaded up in loadup.el diff --git a/lib/gnulib.mk b/lib/gnulib.mk index d49eb4fdf7a..e79fe35622c 100644 --- a/lib/gnulib.mk +++ b/lib/gnulib.mk @@ -21,7 +21,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=errno --avoid=fcntl --avoid=fcntl-h --avoid=fstat --avoid=msvc-inval --avoid=msvc-nothrow --avoid=raise --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt c-ctype c-strcase careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo filemode getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings mktime pselect pthread_sigmask readlink socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timespec-add timespec-sub utimens warnings +# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=errno --avoid=fcntl --avoid=fcntl-h --avoid=fstat --avoid=msvc-inval --avoid=msvc-nothrow --avoid=raise --avoid=select --avoid=sigprocmask --avoid=sys_types --avoid=threadlib --makefile-name=gnulib.mk --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt c-ctype c-strcase careadlinkat crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 dtoastr dtotimespec dup2 environ execinfo filemode getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings mktime pselect pthread_sigmask readlink socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timer-time timespec-add timespec-sub utimens warnings MOSTLYCLEANFILES += core *.stackdump diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 351b6ea6cb8..255b8924784 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,484 @@ +2012-09-30 Juanma Barranquero <lekktu@gmail.com> + + * ido.el (ido-max-directory-size): Default to nil; the current + default is small for POSIX systems, and impractical on Windows 7 + now that lstat returns directory sizes for NTFS. + +2012-09-30 Martin Rudalics <rudalics@gmx.at> + + In buffer display functions handle window-height/window-width + alist entries. Suggested by Juri Linkov as fix for Bug#1806. + * window.el (window--display-buffer): New argument ALIST. Obey + window-height and window-width alist entries. + (window--try-to-split-window): New argument ALIST. Bind + window-combination-limit to t when the window's size shall be + changed and window-combination-limit equals `window-size'. + (display-buffer-in-atom-window) + (display-buffer-in-major-side-window) + (display-buffer-in-side-window, display-buffer-same-window) + (display-buffer-reuse-window, display-buffer-pop-up-frame) + (display-buffer-pop-up-window, display-buffer-below-selected) + (display-buffer-at-bottom, display-buffer-in-previous-window) + (display-buffer-use-some-window): Adjust all callers of + window--display-buffer and window--try-to-split-window. + (fit-frame-to-buffer): New option. + (fit-window-to-buffer): Can resize frames if fit-frame-to-buffer + is non-nil. + (display-buffer-in-major-side-window): Evaluate window-height / + window-width alist entries. + + * help.el (temp-buffer-resize-frames) + (temp-buffer-resize-regexps): Remove options. + (temp-buffer-resize-mode): Adjust doc-string. + (resize-temp-buffer-window): Don't consult + temp-buffer-resize-regexps. Use fit-frame-to-buffer instead of + temp-buffer-resize-frames. + + * dired.el (dired-mark-pop-up): Call + display-buffer-below-selected with a fit-window-to-buffer alist + entry. + +2012-09-30 Chong Yidong <cyd@gnu.org> + + * server.el (server-host): Document the security implications. + (server-auth-key): Doc fix. + + * startup.el (initial-buffer-choice): Doc fix. + + * minibuffer.el (minibuffer-local-filename-syntax): Doc fix. + + * simple.el (delete-trailing-whitespace): Avoid an unnecessary + restriction change. + + * bindings.el (goto-map): Bind M-g TAB to move-to-column. + + * help-fns.el (help-fns--obsolete): Fix last change. + +2012-09-30 Stefan Monnier <monnier@iro.umontreal.ca> + + * winner.el (winner-mode-map): Obey winner-dont-bind-my-keys here. + (minor-mode-map-alist): Remove redundant code. + + * vc/pcvs.el (cvs-cleanup-collection): Keep entries that are currently + visited in a buffer. + (cvs-insert-visited-file): New function. + (find-file-hook): Use it. + + * vc/pcvs-info.el (cvs-fileinfo-pp): Don't use non-existent faces. + + * vc/log-edit.el (log-edit-font-lock-keywords): Ignore case to + chose face. + (log-edit-empty-buffer-p): Don't require a space after a header. + + * vc/ediff-util.el (ediff-diff-at-point): Don't assume point-min==1. + + * tutorial.el (help-with-tutorial): Use minibuffer-with-setup-hook. + + * textmodes/text-mode.el (paragraph-indent-minor-mode): Make it + a proper minor-mode. + + * textmodes/tex-mode.el (tex-mode-map): Don't bind paren keys. + +2012-09-29 Glenn Morris <rgm@gnu.org> + + * winner.el (winner-mode): Remove variable (let define-minor-mode + handle it). + (winner-dont-bind-my-keys, winner-boring-buffers, winner-mode-hook): + Doc fixes. + (winner-mode-leave-hook): Rename to winner-mode-off-hook. + (winner-mode): Use define-minor-mode. + + * vc/vc-sccs.el (vc-sccs-registered): Use the progn trick to get + the full definition in loaddefs, rather than duplicating it. + + * help-macro.el (three-step-help): No need to autoload defcustom. + + * progmodes/inf-lisp.el (inferior-lisp-filter-regexp) + (inferior-lisp-program, inferior-lisp-load-command) + (inferior-lisp-prompt, inferior-lisp-mode-hook): + No need to autoload defcustoms. + + * hippie-exp.el (hippie-expand-try-functions-list) + (hippie-expand-verbose, hippie-expand-dabbrev-skip-space) + (hippie-expand-dabbrev-as-symbol, hippie-expand-no-restriction) + (hippie-expand-max-buffers, hippie-expand-ignore-buffers) + (hippie-expand-only-buffers): No need to autoload defcustoms. + * progmodes/vhdl-mode.el (vhdl-line-expand): + Explicitly load hippie-exp, so it does not get autoloaded + while hippie-expand-try-functions-list is let-bound. + +2012-09-28 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/cl.el (flet): Fix case of obsolescence message. + + * emacs-lisp/bytecomp.el (byte-compile-cl-file-p): + Only "cl.el" counts as cl these days. + +2012-09-28 Juri Linkov <juri@jurta.org> + + Display archive errors in the echo area instead of inserting + to the file buffer. + + * arc-mode.el (archive-extract-by-stdout): Change arg STDERR-FILE + to STDERR-TEST that can be a regexp matching a successful output. + Create a temporary file and redirect stderr to it. Search for + STDERR-TEST in the stderr output and display it in the echo area + if no match is found. + (archive-extract-by-file): New function like + `archive-extract-by-stdout' but extracting archives to files + and looking for successful matches in stdout. Function body is + mostly copied from `archive-rar-extract'. + (archive-rar-extract): Use `archive-extract-by-file'. + (archive-7z-extract): Use `archive-extract-by-stdout'. (Bug#10347) + +2012-09-28 Leo Liu <sdl.web@gmail.com> + + * pcomplete.el (pcomplete-show-completions): Use + minibuffer-message to make pcomplete usable in minibuffer. + + * ido.el (ido-set-matches-1): Fix 2012-09-11 change. + +2012-09-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * type-break.el: Use lexical-binding. + (type-break-mode): Use define-minor-mode. + + * emacs-lisp/pcase.el (pcase--mark-used): New. + (pcase--u1): Use it (bug#12512). + + * custom.el (load-theme): Set buffer-file-name so the load is recorded + in load-history with the right file name. + +2012-09-28 Tassilo Horn <tsdh@gnu.org> + + * doc-view.el (doc-view-current-cache-doc-pdf): New function. + (doc-view-doc->txt, doc-view-convert-current-doc): Use it. + (doc-view-get-bounding-box): Make bounding box slicing work for + ODF and DVI documents. + +2012-09-28 Glenn Morris <rgm@gnu.org> + + * type-break.el (type-break-mode, type-break-interval) + (type-break-good-rest-interval, type-break-keystroke-threshold): + No need to autoload. + (type-break-good-rest-interval, type-break-keystroke-threshold): + Add :set-after. + +2012-09-28 Chong Yidong <cyd@gnu.org> + + * progmodes/verilog-mode.el (verilog-auto-inst-interfaced-ports): + Add :version tag. + +2012-09-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * json.el (json-encode-char): Codes 127-160 aren't "ASCII printable". + +2012-09-27 Glenn Morris <rgm@gnu.org> + + * faces.el (x-display-name): Declare (for without-x builds). + + * linum.el (linum-format): Don't autoload it. Improve :type. + + * progmodes/tcl.el: Don't require outline when compiling. + (outline-regexp, outline-level): Declare. + * textmodes/sgml-mode.el: Don't require outline when compiling. + (outline-regexp, outline-heading-end-regexp, outline-level): Declare. + + * term.el (term-ansi-reset): + Try setting term-ansi-face-already-done to nil. (Bug#11785) + + * vc/vc.el (vc-next-action): Only gripe about committing read-only + files for RCS and SCCS. (Bug#9781) + +2012-09-27 Chong Yidong <cyd@gnu.org> + + * progmodes/verilog-mode.el (verilog-mode-release-emacs): Fix last + change; value should be t. + +2012-09-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * image-mode.el: Use lexical-binding. + (image-mode-winprops): Use t to stand for the window of + a buffer that's not displayed. + * doc-view.el (doc-view-new-window-function): Handle the new + t in winprops. + (doc-view-enlarge): Make it a real nop if the size is not changed. + (doc-view-display): Handle the case where the buffer is not (yet?) + displayed in any window. + (doc-view-saved-settings): New var. + (doc-view-mode): Use it. + (doc-view-fallback-mode): Set it. + + * minibuf-eldef.el: Make it possible to replace (default ...) with [...]. + Set lexical-binding. + (minibuffer-eldef-shorten-default): New var. + (minibuffer-default-in-prompt-regexps): Use it for new default. + (minibuf-eldef-setup-minibuffer): Add replacement functionality. + +2012-09-26 Juanma Barranquero <lekktu@gmail.com> + + * international/uni-bidi.el: + * international/uni-category.el: + * international/uni-name.el: + * international/uni-numeric.el: Regenerate. + +2012-09-26 Tomohiro Matsuyama <tomo@cx4a.org> + Stefan Monnier <monnier@iro.umontreal.ca> + + * profiler.el: New file. + +2012-09-26 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/testcover.el (testcover-after): Add gv-expander. + (testcover-reinstrument): Simplify with CSE. + +2012-09-26 Juanma Barranquero <lekktu@gmail.com> + + * window.el (temp-buffer-window-setup): Fix typo in docstring. + +2012-09-25 Wilson Snyder <wsnyder@wsnyder.org> + + * verilog-mode.el (verilog-auto-ascii-enum, verilog-auto-inout) + (verilog-auto-input, verilog-auto-insert-lisp) + (verilog-auto-output, verilog-auto-output-every, verilog-auto-reg) + (verilog-auto-reg-input, verilog-auto-tieoff, verilog-auto-undef) + (verilog-auto-unused, verilog-auto-wire) + (verilog-forward-or-insert-line): Fix AUTOs with no trailing + newline. Reported by Andrew Jones. + (verilog-auto-inst) Support expanding $clog2 in AUTOINST. + Reported by Brad Dobbie. + (verilog-batch-delete-trailing-whitespace): + Create verilog-batch-delete-trailing-whitespace. + Reported by Brad Dobbie. + (verilog-auto-inout-param): Support AUTOINOUTPARAM for copying + parameters from another module. Reported by Dan Katz. + (verilog-auto, verilog-auto-assign-modport) + (verilog-auto-inout-modport): Add AUTOASSIGNMODPORT and + AUTOINOUTMODPORT for UVM interface module shell generation. + Reported by Brad Dobbie. + (verilog-auto-inst-interfaced-ports): Make default nil, as more + standard behavior. + (verilog-auto): Fix AUTO parameters with parenthesis arguments. + Reported by Matt Martin. + +2012-09-25 Martin Rudalics <rudalics@gmx.at> + + * window.el (window--resize-child-windows): When resizing child + windows proportionally, process them in reverse order to + preserve the "when splitting a window the new one gets the odd + line" behavior. + (window--resize-root-window-vertically): When resizing the + minibuffer window try to affect only windows at the bottom of the + frame. (Bug#12419) + +2012-09-25 Chong Yidong <cyd@gnu.org> + + * subr.el (declare): Doc fix. + + * help-fns.el (help-fns--obsolete): Handle macros properly. + +2012-09-25 Chong Yidong <cyd@gnu.org> + + * bookmark.el (bookmark-jump-noselect): Use a declare form to mark + this function obsolete. + + * calendar/cal-x.el (calendar-two-frame-setup) + (calendar-only-one-frame-setup, calendar-one-frame-setup): + * calendar/calendar.el (american-calendar, european-calendar) + (calendar-for-loop): + * comint.el (comint-dynamic-simple-complete) + (comint-dynamic-complete-as-filename, comint-unquote-filename): + * desktop.el (desktop-load-default): + * dired-x.el (dired-omit-here-always) + (dired-hack-local-variables, dired-default-directory): + * emacs-lisp/derived.el (derived-mode-class): + * emacs-lisp/timer.el (timer-set-time-with-usecs): + * emacs-lock.el (toggle-emacs-lock): + * epa.el (epa-display-verify-result): + * epg.el (epg-sign-keys, epg-start-sign-keys) + (epg-passphrase-callback-function): + * eshell/esh-util.el (eshell-for): + * eshell/eshell.el (eshell-remove-from-window-buffer-names) + (eshell-add-to-window-buffer-names): + * files.el (locate-file-completion): + * imenu.el (imenu-example--create-c-index) + (imenu-example--create-lisp-index) + (imenu-example--lisp-extract-index-name) + (imenu-example--name-and-position): + * international/mule-cmds.el (princ-list): + * international/mule-diag.el (decode-codepage-char): + * international/mule-util.el (detect-coding-with-priority): + * iswitchb.el (iswitchb-read-buffer): + * mail/mailalias.el (mail-complete): + * mail/sendmail.el (mail-sent-via): + * mouse.el (mouse-popup-menubar-stuff, mouse-popup-menubar) + (mouse-major-mode-menu): + * password-cache.el (password-read-and-add): + * pcomplete.el (pcomplete-parse-comint-arguments): + * progmodes/sh-script.el (sh-maybe-here-document): + * replace.el (query-replace-regexp-eval): + * savehist.el (savehist-load): + * simple.el (choose-completion-delete-max-match): + * term.el (term-dynamic-simple-complete): + * vc/ediff-init.el (ediff-check-version): + * vc/ediff-wind.el (ediff-choose-window-setup-function-automatically): + * vc/vc.el (vc-diff-switches-list): + * view.el (view-return-to-alist-update): Likewise. + + * subr.el (eval-next-after-load, makehash, insert-string) + (assoc-ignore-representation, assoc-ignore-case): Use declare to + mark obsolete. + (mode-line-inverse-video): Variable deleted. + + * international/mule-util.el (string-to-sequence): Remove. + + * calendar/calendar.el (calendar-version): + * calendar/icalendar.el (icalendar-extract-ical-from-buffer) + (icalendar-convert-diary-to-ical): + * cus-edit.el (custom-mode): + * ansi-color.el (ansi-color-unfontify-region): + * international/latin1-disp.el (latin1-char-displayable-p): + * progmodes/cwarn.el (turn-on-cwarn-mode): + * progmodes/which-func.el (which-func-update-1): + Use define-obsolete-function-alias. + + * net/newst-backend.el (newsticker-cache-filename): + * net/newst-treeview.el (newsticker-groups-filename): + Fix incorrect obsolescence declaration. + + * allout.el (allout-passphrase-hint-string): Likewise. + (allout-init): Use a declare form to mark obsolete. + + * emacs-lisp/byte-run.el (make-obsolete): Doc fix; emphasize that + this applies to functions. + + * iswitchb.el (iswitchb-read-buffer): Move code of + iswitchb-define-mode-map here, and delete that obsolete function. + + * net/snmp-mode.el (snmp-font-lock-keywords-3): Don't use obsolete + font-lock-reference-face. + +2012-09-25 Glenn Morris <rgm@gnu.org> + + * buff-menu.el (Buffer-menu-name-width, Buffer-menu-size-width): + Doc fixes. + + * eshell/em-term.el (eshell-term-name): + Default to term-term-name. (Bug#12485) + +2012-09-24 Fabián Ezequiel Gallina <fgallina@cuca> + + * progmodes/python.el (python-shell-send-buffer): Better handling + of "if __name__ == '__main__':" conditionals when sending the buffer. + +2012-09-24 Glenn Morris <rgm@gnu.org> + + * eshell/esh-cmd.el (eshell-find-alias-function): + Tighten up file-name regexp. (Bug#12499) + +2012-09-24 Fabián Ezequiel Gallina <fgallina@cuca> + + Enhancements for triple-quote string syntax. + * progmodes/python.el (python-quote-syntax): Remove. + (python-syntax-propertize-function): New value. + (python-syntax-count-quotes, python-syntax-stringify): + New functions. + +2012-09-24 Chong Yidong <cyd@gnu.org> + + * mail/supercite.el (sc-version): Remove obsolete function. + (sc-describe): Don't mark as obsolete, since it is bound. + (sc-submit-bug-report): Remove. + + * vc/log-edit.el (cvs-changelog-full-paragraphs) + (cvs-commit-buffer-require-final-newline): Remove. + (log-edit-require-final-newline) + (log-edit-changelog-full-paragraphs): Default to t. + + * vc/pcvs-defs.el (cvs-diff-buffer-name, cvs-diff-ignore-marks) + * vc/vc-hooks.el (vc-ignore-vc-files, vc-master-templates) + * vc/vc.el (vc-checkout-carefully): Likewise. + + * vc/emerge.el (emerge-mode): Make it an obsolete alias. + (emerge-version): Remove. + + * progmodes/compile.el (compile-internal): Remove. + (compilation-parse-errors-function): Fix typo. + + * international/mule.el (set-char-table-default): Remove. + (set-coding-priority, make-coding-system, generic-char-p) + (charset-list, charset-bytes, charset-id): Use declare to mark + functions as obsolete. + + * vc/pcvs-defs.el (cvs-buffer-name-alist) + (cvs-invert-ignore-marks): Remove references to obsolete vars. + * vc/vc-hooks.el (vc-default-registered): Don't use + vc-master-templates. + + * font-lock.el (font-lock-reference-face): + Use define-obsolete-variable-alias. + + * generic-x.el (rul-generic-mode): Use font-lock-constant-face. + * calendar/calendar.el (calendar-font-lock-keywords): + * calendar/diary-lib.el (diary-font-lock-keywords) + (diary-fancy-font-lock-keywords): + * textmodes/reftex-sel.el (reftex-insert-docstruct): + * textmodes/reftex-index.el (reftex-insert-index): + * textmodes/reftex-cite.el (reftex-format-bib-entry): + * progmodes/ruby-mode.el (ruby-font-lock-keywords): + * progmodes/ps-mode.el (ps-mode-font-lock-keywords-1): + * progmodes/prolog.el (prolog-font-lock-keywords): + * progmodes/idlwave.el (idlwave-idl-keywords): + * progmodes/ada-mode.el (ada-font-lock-keywords): + * net/snmp-mode.el (snmp-font-lock-keywords-3): Likewise. + +2012-09-24 Glenn Morris <rgm@gnu.org> + + * mail/emacsbug.el (report-emacs-bug): Include `lsb_release -d'. + +2012-09-23 Fabián Ezequiel Gallina <fgallina@cuca> + + * progmodes/python.el (python-indent-line): More consistent cursor + movement behavior. + +2012-09-23 Stefan Merten <smerten@oekonux.de> + + * textmodes/rst.el: Fix compiler warning. + +2012-09-23 Roland Winkler <winkler@gnu.org> + + * textmodes/bibtex.el (bibtex-autokey-transcriptions): + Transcribe also LaTeX hyphenation. + (bibtex-reformat): Bug fix. Do not quote twice the elements of + bibtex-reformat-previous-options. + +2012-09-23 Roland Winkler <winkler@gnu.org> + + * proced.el (proced-renice-command): New variable. + (proced-marked-processes): New function. + (proced-with-processes-buffer): New macro. + (proced-send-signal): Use them. + (proced-renice): New command bound to r. + +2012-09-23 Roland Winkler <winkler@gnu.org> + + * ibuf-ext.el (ibuffer-switch-to-saved-filter-groups): If list + ibuffer-saved-filter-groups has one element, shortcut the call of + completing-read. (Bug#12331) + +2012-09-23 Chong Yidong <cyd@gnu.org> + + * bindings.el (mode-line-toggle-read-only): + * bs.el (bs-toggle-readonly): + * buff-menu.el (Buffer-menu-toggle-read-only): + * dired.el (dired-toggle-read-only): + * ibuffer.el (ibuffer-do-toggle-read-only): Use read-only-mode. + +2012-09-23 Chong Yidong <cyd@gnu.org> + + * image.el (image-type-available-p): Adapt to init-image-library + argument changes. + 2012-09-22 Juri Linkov <juri@jurta.org> * dired.el (dired-mode-map): Add [remap read-only-mode] for @@ -45,7 +526,7 @@ 2012-09-22 Stefan Merten <smerten@oekonux.de> - * rst.el: Revamp section title faces. + * textmodes/rst.el: Revamp section title faces. (rst-official-version) (rst-package-emacs-version-alist): Sync with official version V1.4.0. @@ -120,15 +601,15 @@ 2012-09-20 Stefan Merten <smerten@oekonux.de> - * rst.el: Integrate support for `imenu' and `which-function'. + * textmodes/rst.el: Integrate support for `imenu' and `which-function'. Fixes feature request bug#11711. (rst-mode): Create `imenu-create-index-function'. (rst-get-stripped-line): Delete after refactoring. (rst-section-tree, rst-section-tree-rec) (rst-section-tree-point): Refactor and document properly. (rst-imenu-find-adornments-for-position) - (rst-imenu-convert-cell, rst-imenu-create-index): New - function. + (rst-imenu-convert-cell, rst-imenu-create-index): + New function. 2012-09-20 Stefan Monnier <monnier@iro.umontreal.ca> @@ -260,7 +741,7 @@ 2012-09-17 Stefan Merten <smerten@oekonux.de> - * rst.el: Add support for `testcover'. + * textmodes/rst.el: Add support for `testcover'. (rst-defcustom-testcover, rst-testcover-add-compose) (rst-testcover-add-1value): New functions. (rst-portable-mark-active-p): Replace by `use-region-p'. @@ -2096,7 +2577,7 @@ 2012-07-30 Stefan Merten <smerten@oekonux.de> - * rst.el: Silence `checkdoc-ispell'. + * textmodes/rst.el: Silence `checkdoc-ispell'. (rst-cvs-header, rst-svn-rev, rst-svn-timestamp) (rst-official-version, rst-official-cvs-rev) (rst-package-emacs-version-alist): Update to upstream V1.3.1. @@ -9488,7 +9969,7 @@ Declare as obsolete. (ns-get-pasteboard, ns-paste-secondary): Use ns-get-selection-internal. - (ns-set-pasteboard, ns-copy-including-secondary): + (ns-set-pasteboard, ns-copy-including-secondary): Use ns-store-selection-internal. 2011-12-17 Chong Yidong <cyd@gnu.org> diff --git a/lisp/ChangeLog.8 b/lisp/ChangeLog.8 index 0380fb117db..db5c2f84511 100644 --- a/lisp/ChangeLog.8 +++ b/lisp/ChangeLog.8 @@ -2372,7 +2372,7 @@ (sh-mode-map): Added new bindings. (sh-mode): Updated mode doc-string for new commands, added make-local-variable calls, initialize mode-specific variables. - (sh-indent-line): Renamed to sh-basic-indent-line; sh-indent-line + (sh-indent-line): Renamed to sh-basic-indent-line; sh-indent-line is now a different function. (sh-header-marker): Changed docstring. (sh-set-shell): Initialize mode-specific variables. diff --git a/lisp/ChangeLog.9 b/lisp/ChangeLog.9 index 5c01f872994..5c71fb860ec 100644 --- a/lisp/ChangeLog.9 +++ b/lisp/ChangeLog.9 @@ -569,7 +569,7 @@ Don't bind mouse events or tab/backtab. (help-function, help-variable, help-face, help-coding-system) (help-input-method, help-character-set, help-back, help-info) - (help-customize-variable, help-function-def, help-variable-def): + (help-customize-variable, help-function-def, help-variable-def): New button types. (help-button-action): New function. (describe-function-1): Pass help button-types to @@ -20671,7 +20671,7 @@ * term/tty-colors.el (tty-defined-color-alist): Renamed from tty-color-alist. (tty-color-alist, tty-modify-color-alist): New functions. - (tty-color-define, tty-color-clear, tty-color-approximate) + (tty-color-define, tty-color-clear, tty-color-approximate) (tty-color-translate, tty-color-by-index, tty-color-desc): Accept an optional parameter FRAME. diff --git a/lisp/allout.el b/lisp/allout.el index acf0b7d75b6..04de853ebe0 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -1522,8 +1522,8 @@ The verifier string is retained as an Emacs file variable, as well as in the Emacs buffer state, if file variable adjustments are enabled. See `allout-enable-file-variable-adjustment' for details about that.") (make-variable-buffer-local 'allout-passphrase-verifier-string) -(make-obsolete 'allout-passphrase-verifier-string - 'allout-passphrase-verifier-string "23.3") +(make-obsolete-variable 'allout-passphrase-verifier-string + 'allout-passphrase-verifier-string "23.3") ;;;###autoload (put 'allout-passphrase-verifier-string 'safe-local-variable 'stringp) ;;;_ = allout-passphrase-hint-string @@ -1538,8 +1538,8 @@ state, if file variable adjustments are enabled. See `allout-enable-file-variable-adjustment' for details about that.") (make-variable-buffer-local 'allout-passphrase-hint-string) (setq-default allout-passphrase-hint-string "") -(make-obsolete 'allout-passphrase-hint-string - 'allout-passphrase-hint-string "23.3") +(make-obsolete-variable 'allout-passphrase-hint-string + 'allout-passphrase-hint-string "23.3") ;;;###autoload (put 'allout-passphrase-hint-string 'safe-local-variable 'stringp) ;;;_ = allout-after-save-decrypt @@ -1688,11 +1688,10 @@ from what it did before, for backwards compatibility. MODE is the activation mode - see `allout-auto-activation' for valid values." - + (declare (obsolete allout-auto-activation "23.3")) (custom-set-variables (list 'allout-auto-activation (format "%s" mode))) (format "%s" mode)) -(make-obsolete 'allout-init - "customize 'allout-auto-activation' instead." "23.3") + ;;;_ > allout-setup-menubar () (defun allout-setup-menubar () "Populate the current buffer's menubar with `allout-mode' stuff." diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index 8305aaf1199..047b4b944b9 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -230,8 +230,8 @@ This is a good function to put in `comint-output-filter-functions'." (t (ansi-color-apply-on-region start-marker end-marker))))) -(defalias 'ansi-color-unfontify-region 'font-lock-default-unfontify-region) -(make-obsolete 'ansi-color-unfontify-region "not needed any more" "24.1") +(define-obsolete-function-alias 'ansi-color-unfontify-region + 'font-lock-default-unfontify-region "24.1") ;; Working with strings (defvar ansi-color-context nil diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index c776a3f8b5c..a97a052dc08 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -1117,13 +1117,54 @@ using `make-temp-file', and the generated name is returned." (archive-delete-local tmpfile) success)) -(defun archive-extract-by-stdout (archive name command &optional stderr-file) - (apply 'call-process - (car command) - nil - (if stderr-file (list t stderr-file) t) - nil - (append (cdr command) (list archive name)))) +(defun archive-extract-by-stdout (archive name command &optional stderr-test) + (let ((stderr-file (make-temp-file "arc-stderr"))) + (unwind-protect + (prog1 + (apply 'call-process + (car command) + nil + (if stderr-file (list t stderr-file) t) + nil + (append (cdr command) (list archive name))) + (with-temp-buffer + (insert-file-contents stderr-file) + (goto-char (point-min)) + (when (if (stringp stderr-test) + (not (re-search-forward stderr-test nil t)) + (> (buffer-size) 0)) + (message "%s" (buffer-string))))) + (if (file-exists-p stderr-file) + (delete-file stderr-file))))) + +(defun archive-extract-by-file (archive name command &optional stdout-test) + (let ((dest (make-temp-file "arc-dir" 'dir)) + (stdout-file (make-temp-file "arc-stdout"))) + (unwind-protect + (prog1 + (apply 'call-process + (car command) + nil + `(:file ,stdout-file) + nil + (append (cdr command) (list archive name dest))) + (with-temp-buffer + (insert-file-contents stdout-file) + (goto-char (point-min)) + (when (if (stringp stdout-test) + (not (re-search-forward stdout-test nil t)) + (> (buffer-size) 0)) + (message "%s" (buffer-string)))) + (if (file-exists-p (expand-file-name name dest)) + (insert-file-contents-literally (expand-file-name name dest)))) + (if (file-exists-p stdout-file) + (delete-file stdout-file)) + (if (file-exists-p (expand-file-name name dest)) + (delete-file (expand-file-name name dest))) + (while (file-name-directory name) + (setq name (directory-file-name (file-name-directory name))) + (delete-directory (expand-file-name name dest))) + (delete-directory dest)))) (defun archive-extract-other-window () "In archive mode, find this member in another window." @@ -2006,17 +2047,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." ;; The code below assumes the name is relative and may do undesirable ;; things otherwise. (error "Can't extract files with non-relative names") - (let ((dest (make-temp-file "arc-rar" 'dir))) - (unwind-protect - (progn - (call-process "unrar-free" nil nil nil - "--extract" archive name dest) - (insert-file-contents-literally (expand-file-name name dest))) - (delete-file (expand-file-name name dest)) - (while (file-name-directory name) - (setq name (directory-file-name (file-name-directory name))) - (delete-directory (expand-file-name name dest))) - (delete-directory dest))))) + (archive-extract-by-file archive name '("unrar-free" "--extract") "All OK"))) ;;; Section: Rar self-extracting .exe archives. @@ -2099,17 +2130,11 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (apply 'vector files)))) (defun archive-7z-extract (archive name) - (let ((tmpfile (make-temp-file "7z-stderr"))) - ;; 7z doesn't provide a `quiet' option to suppress non-essential - ;; stderr messages. So redirect stderr to a temp file and display it - ;; in the echo area when it contains error messages. - (prog1 (archive-extract-by-stdout - archive name archive-7z-extract tmpfile) - (with-temp-buffer - (insert-file-contents tmpfile) - (unless (search-forward "Everything is Ok" nil t) - (message "%s" (buffer-string))) - (delete-file tmpfile))))) + ;; 7z doesn't provide a `quiet' option to suppress non-essential + ;; stderr messages. So redirect stderr to a temp file and display it + ;; in the echo area when it contains no message indicating success. + (archive-extract-by-stdout + archive name archive-7z-extract "Everything is Ok")) (defun archive-7z-write-file-member (archive descr) (archive-*-write-file-member diff --git a/lisp/bindings.el b/lisp/bindings.el index c20a7f30eea..b4f9d29fe52 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -40,7 +40,7 @@ corresponding to the mode line clicked." (interactive "e") (save-selected-window (select-window (posn-window (event-start event))) - (call-interactively 'toggle-read-only))) + (read-only-mode 'toggle))) (defun mode-line-toggle-modified (event) "Toggle the buffer-modified flag from the mode-line." @@ -898,6 +898,7 @@ if `inhibit-field-text-motion' is non-nil." (define-key goto-map "\M-n" 'next-error) (define-key goto-map "p" 'previous-error) (define-key goto-map "\M-p" 'previous-error) +(define-key goto-map "\t" 'move-to-column) (defvar search-map (make-sparse-keymap) "Keymap for search related commands.") diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 31bbc13acf9..26ba1dec00f 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1048,12 +1048,11 @@ The return value has the form (BUFFER . POINT). Note: this function is deprecated and is present for Emacs 22 compatibility only." + (declare (obsolete bookmark-handle-bookmark "23.1")) (save-excursion (bookmark-handle-bookmark bookmark) (cons (current-buffer) (point)))) -(make-obsolete 'bookmark-jump-noselect 'bookmark-handle-bookmark "23.1") - (defun bookmark-handle-bookmark (bookmark-name-or-record) "Call BOOKMARK-NAME-OR-RECORD's handler or `bookmark-default-handler' if it has none. This changes current buffer and point and returns nil, diff --git a/lisp/bs.el b/lisp/bs.el index 09aefee416e..a84c951acfe 100644 --- a/lisp/bs.el +++ b/lisp/bs.el @@ -962,7 +962,7 @@ Default is `bs--current-sort-function'." Uses function `toggle-read-only'." (interactive) (with-current-buffer (bs--current-buffer) - (call-interactively 'toggle-read-only)) + (read-only-mode 'toggle)) (bs--update-current-line)) (defun bs-clear-modified () diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 589b6ebc47a..6ab6e548ab5 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -64,13 +64,13 @@ minus `Buffer-menu-size-width'. This use is deprecated." "24.3") (defcustom Buffer-menu-name-width 19 - "Width of buffer size column in the Buffer Menu." + "Width of buffer name column in the Buffer Menu." :type 'number :group 'Buffer-menu :version "24.3") (defcustom Buffer-menu-size-width 7 - "Width of buffer name column in the Buffer Menu." + "Width of buffer size column in the Buffer Menu." :type 'number :group 'Buffer-menu :version "24.3") @@ -520,7 +520,7 @@ This behaves like invoking \\[toggle-read-only] in that buffer." (interactive) (let ((read-only (with-current-buffer (Buffer-menu-buffer t) - (call-interactively 'toggle-read-only) + (read-only-mode 'toggle) buffer-read-only))) (tabulated-list-set-col 1 (if read-only "%" " ") t))) diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el index 9c01ab40c0c..325ac3e8146 100644 --- a/lisp/calendar/cal-tex.el +++ b/lisp/calendar/cal-tex.el @@ -1097,7 +1097,7 @@ shown are hard-coded to 8-12, 13-17." (cal-tex-longday "leftday" "2.75in")) (cal-tex-b-document) (cal-tex-cmd "\\pagestyle" "empty") - ;; Let's assume this is something to with twopage documents. + ;; Let's assume this is something to do with twopage documents. ;; It has the downside that we start with a blank page. ;; It doesn't make obvious sense when oddside and evenside margins ;; are the same (non-filofax), but consider the left and right diff --git a/lisp/calendar/cal-x.el b/lisp/calendar/cal-x.el index 0f2d43b2237..6fba7fb7423 100644 --- a/lisp/calendar/cal-x.el +++ b/lisp/calendar/cal-x.el @@ -155,29 +155,23 @@ If PROMPT is non-nil, prompt for the month and year to use." (defun calendar-one-frame-setup (&optional prompt) "Display calendar and diary in a single dedicated frame. See `calendar-frame-setup' for more information." + (declare (obsolete calendar-frame-setup "23.1")) (calendar-frame-setup 'one-frame prompt)) -(make-obsolete 'calendar-one-frame-setup 'calendar-frame-setup "23.1") - - ;;;###cal-autoload (defun calendar-only-one-frame-setup (&optional prompt) "Display calendar in a dedicated frame. See `calendar-frame-setup' for more information." + (declare (obsolete calendar-frame-setup "23.1")) (calendar-frame-setup 'calendar-only prompt)) -(make-obsolete 'calendar-only-one-frame-setup 'calendar-frame-setup "23.1") - - ;;;###cal-autoload (defun calendar-two-frame-setup (&optional prompt) "Display calendar and diary in separate, dedicated frames. See `calendar-frame-setup' for more information." + (declare (obsolete calendar-frame-setup "23.1")) (calendar-frame-setup 'two-frames prompt)) -(make-obsolete 'calendar-two-frame-setup 'calendar-frame-setup "23.1") - - ;; Undocumented and probably useless. (defvar cal-x-load-hook nil "Hook run on loading of the `cal-x' package.") diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 93ef440541e..6f8311f4c55 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -1001,18 +1001,16 @@ The valid styles are described in the documentation of `calendar-date-style'." (defun european-calendar () "Set the interpretation and display of dates to the European style." + (declare (obsolete calendar-set-date-style "23.1")) (interactive) (calendar-set-date-style 'european)) -(make-obsolete 'european-calendar 'calendar-set-date-style "23.1") - (defun american-calendar () "Set the interpretation and display of dates to the American style." + (declare (obsolete calendar-set-date-style "23.1")) (interactive) (calendar-set-date-style 'american)) -(make-obsolete 'american-calendar 'calendar-set-date-style "23.1") - (define-obsolete-variable-alias 'holidays-in-diary-buffer 'diary-show-holidays-flag "23.1") @@ -1148,14 +1146,13 @@ MON defaults to `displayed-month'. YR defaults to `displayed-year'." "Execute a for loop. Evaluate BODY with VAR bound to successive integers from INIT to FINAL, inclusive. The standard macro `dotimes' is preferable in most cases." - (declare (debug (symbolp "from" form "to" form "do" body)) + (declare (obsolete "use `dotimes' or `while' instead." "23.1") + (debug (symbolp "from" form "to" form "do" body)) (indent defun)) `(let ((,var (1- ,init))) (while (>= ,final (setq ,var (1+ ,var))) ,@body))) -(make-obsolete 'calendar-for-loop "use `dotimes' or `while' instead." "23.1") - (defmacro calendar-sum (index initial condition expression) "For INDEX = INITIAL, +1, ... (as long as CONDITION holds), sum EXPRESSION." (declare (debug (symbolp form form form))) @@ -2298,7 +2295,7 @@ Negative years are interpreted as years BC; -1 being 1 BC, and so on." ;; First two chars of each day are used in the calendar. (,(regexp-opt (mapcar (lambda (x) (substring x 0 calendar-day-header-width)) calendar-day-name-array)) - . font-lock-reference-face)) + . font-lock-constant-face)) "Default keywords to highlight in Calendar mode.") (defun calendar-day-name (date &optional abbrev absolute) @@ -2655,13 +2652,7 @@ If called by a mouse-event, pops up a menu with the result." "---") (calendar-string-spread (list str) ?- width))))) -(defun calendar-version () - "Display the Calendar version." - (interactive) - (message "GNU Emacs %s" emacs-version)) - -(make-obsolete 'calendar-version 'emacs-version "23.1") - +(define-obsolete-function-alias 'calendar-version 'emacs-version "23.1") (run-hooks 'calendar-load-hook) diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 4bce8ec0927..27c6f76581c 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -2400,10 +2400,10 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL." (cons (format "^%s?\\(%s\\)" (regexp-quote diary-nonmarking-symbol) (regexp-quote diary-sexp-entry-symbol)) - '(1 font-lock-reference-face)) + '(1 font-lock-constant-face)) (cons (format "^%s" (regexp-quote diary-nonmarking-symbol)) - 'font-lock-reference-face) + 'font-lock-constant-face) (cons (format "^%s?%s" (regexp-quote diary-nonmarking-symbol) (regexp-opt (mapcar 'regexp-quote @@ -2411,7 +2411,7 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL." diary-islamic-entry-symbol diary-bahai-entry-symbol)) t)) - '(1 font-lock-reference-face)) + '(1 font-lock-constant-face)) '(diary-font-lock-sexps . font-lock-keyword-face) ;; Don't need to worry about space around "-" because the first ;; match takes care of that. It does mean the "-" itself may or @@ -2482,7 +2482,7 @@ This depends on the calendar date style." (defvar diary-fancy-font-lock-keywords `((diary-fancy-date-matcher . diary-face) ("^.*\\([aA]nniversary\\|[bB]irthday\\).*$" . 'diary-anniversary) - ("^.*Yahrzeit.*$" . font-lock-reference-face) + ("^.*Yahrzeit.*$" . font-lock-constant-face) ("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face) ("^Day.*omer.*$" . font-lock-builtin-face) ("^Parashat.*$" . font-lock-comment-face) diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index 7326aa530ad..39b83d4c831 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -931,8 +931,8 @@ Finto iCalendar file: ") (set-buffer (find-file diary-filename)) (icalendar-export-region (point-min) (point-max) ical-filename))) -(defalias 'icalendar-convert-diary-to-ical 'icalendar-export-file) -(make-obsolete 'icalendar-convert-diary-to-ical 'icalendar-export-file "22.1") +(define-obsolete-function-alias 'icalendar-convert-diary-to-ical + 'icalendar-export-file "22.1") (defvar icalendar--uid-count 0 "Auxiliary counter for creating unique ids.") @@ -1881,8 +1881,8 @@ buffer `*icalendar-errors*'." ;; return nil, i.e. import did not work nil))) -(defalias 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer) -(make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer "22.1") +(define-obsolete-function-alias 'icalendar-extract-ical-from-buffer + 'icalendar-import-buffer "22.1") (defun icalendar--format-ical-event (event) "Create a string representation of an iCalendar EVENT." diff --git a/lisp/comint.el b/lisp/comint.el index 994d81a375a..fea9cecfa03 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -3069,11 +3069,11 @@ Magic characters are those in `comint-file-name-quote-list'." (defun comint-unquote-filename (filename) "Return FILENAME with quoted characters unquoted." + (declare (obsolete nil "24.3")) (if (null comint-file-name-quote-list) filename (save-match-data (replace-regexp-in-string "\\\\\\(.\\)" "\\1" filename t)))) -(make-obsolete 'comint-unquote-filename nil "24.3") (defun comint--requote-argument (upos qstr) ;; See `completion-table-with-quoting'. @@ -3170,10 +3170,9 @@ See `completion-table-with-quoting' and `comint-unquote-function'.") (defun comint-dynamic-complete-as-filename () "Dynamically complete at point as a filename. See `comint-dynamic-complete-filename'. Returns t if successful." + (declare (obsolete comint-filename-completion "24.1")) (let ((data (comint--complete-file-name-data))) (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)))) -(make-obsolete 'comint-dynamic-complete-as-filename - 'comint-filename-completion "24.1") (defun comint-replace-by-expanded-filename () "Dynamically expand and complete the filename at point. @@ -3204,6 +3203,7 @@ Return `partial' if completed as far as possible. Return `listed' if a completion listing was shown. See also `comint-dynamic-complete-filename'." + (declare (obsolete completion-in-region "24.1")) (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt cygwin))) (minibuffer-p (window-minibuffer-p (selected-window))) (suffix (cond ((not comint-completion-addsuffix) "") @@ -3246,8 +3246,6 @@ See also `comint-dynamic-complete-filename'." (unless minibuffer-p (message "Partially completed")) 'partial))))))) -(make-obsolete 'comint-dynamic-simple-complete 'completion-in-region "24.1") - (defun comint-dynamic-list-filename-completions () "Display a list of possible completions for the filename at point." diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 2e6f2b14625..8e06b16bd12 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -2228,9 +2228,9 @@ and `face'." (setq widget nil))))) (widget-setup)) -(make-obsolete 'custom-show "this widget type is no longer supported." "24.1") (defun custom-show (widget value) "Non-nil if WIDGET should be shown with VALUE by default." + (declare (obsolete "this widget type is no longer supported." "24.1")) (let ((show (widget-get widget :custom-show))) (if (functionp show) (funcall show widget value) @@ -4823,12 +4823,7 @@ if that value is non-nil." (put 'Custom-mode 'mode-class 'special) -;; backward-compatibility -(defun custom-mode () - "Non-interactive variant of `Custom-mode'." - (Custom-mode)) -(make-obsolete 'custom-mode 'Custom-mode "23.1") -(put 'custom-mode 'mode-class 'special) +(define-obsolete-function-alias 'custom-mode 'Custom-mode "23.1") (add-to-list 'debug-ignored-errors "^Invalid face:? ") diff --git a/lisp/cus-start.el b/lisp/cus-start.el index a91a479b054..28c1d3e3026 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -443,7 +443,6 @@ since it could result in memory overflow and make Emacs crash." (hscroll-step windows number "22.1") (truncate-partial-width-windows display boolean "23.1") (make-cursor-line-fully-visible windows boolean) - (mode-line-inverse-video mode-line boolean) (mode-line-in-non-selected-windows mode-line boolean "22.1") (line-number-display-limit display (choice integer diff --git a/lisp/custom.el b/lisp/custom.el index dfc8e631152..dc810e3c97d 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1193,7 +1193,8 @@ Return t if THEME was successfully loaded, nil otherwise." (expand-file-name "themes/" data-directory))) (member hash custom-safe-themes) (custom-theme-load-confirm hash)) - (let ((custom--inhibit-theme-enable t)) + (let ((custom--inhibit-theme-enable t) + (buffer-file-name fn)) ;For load-history. (eval-buffer)) ;; Optimization: if the theme changes the `default' face, put that ;; entry first. This avoids some `frame-set-background-mode' rigmarole diff --git a/lisp/desktop.el b/lisp/desktop.el index 75deb58b4d8..c8023bb43ed 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -1045,11 +1045,10 @@ Using it may cause conflicts. Use it anyway? " owner))))) (defun desktop-load-default () "Load the `default' start-up library manually. Also inhibit further loading of it." + (declare (obsolete desktop-save-mode "22.1")) (unless inhibit-default-init ; safety check (load "default" t t) (setq inhibit-default-init t))) -(make-obsolete 'desktop-load-default - 'desktop-save-mode "22.1") ;; ---------------------------------------------------------------------------- ;;;###autoload diff --git a/lisp/dired-x.el b/lisp/dired-x.el index f176cf7dbe0..1237eef86cf 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -723,15 +723,13 @@ determine a default directory.") (defun dired-default-directory () "Return the `dired-default-directory-alist' entry for the current major-mode. If none, return `default-directory'." + ;; It looks like this was intended to be something of a "general" + ;; feature, but it only ever seems to have been used in + ;; dired-smart-shell-command, and doesn't seem worth keeping around. + (declare (obsolete nil "24.1")) (or (eval (cdr (assq major-mode dired-default-directory-alist))) default-directory)) -;; It looks like this was intended to be something of a "general" feature, -;; but it only ever seems to have been used in dired-smart-shell-command, -;; and does not seem worth keeping around (?). -(make-obsolete 'dired-default-directory - "this feature is due to be removed." "24.1") - (defun dired-smart-shell-command (command &optional output-buffer error-buffer) "Like function `shell-command', but in the current Virtual Dired directory." (interactive @@ -782,6 +780,7 @@ See also `dired-enable-local-variables'." (defun dired-hack-local-variables () "Evaluate local variables in `dired-local-variables-file' for dired buffer." + (declare (obsolete hack-dir-local-variables-non-file-buffer "24.1")) (and (stringp dired-local-variables-file) (file-exists-p dired-local-variables-file) (let ((opoint (point-max)) @@ -803,14 +802,12 @@ See also `dired-enable-local-variables'." ;; Make sure that the mode line shows the proper information. (dired-sort-set-mode-line)))) -(make-obsolete 'dired-hack-local-variables - 'hack-dir-local-variables-non-file-buffer "24.1") - ;; Does not seem worth a dedicated command. ;; See the more general features in files-x.el. (defun dired-omit-here-always () "Create `dir-locals-file' setting `dired-omit-mode' to t in `dired-mode'. If in a Dired buffer, reverts it." + (declare (obsolete add-dir-local-variable "24.1")) (interactive) (if (file-exists-p dired-local-variables-file) (error "Old-style dired-local-variables-file `./%s' found; @@ -830,8 +827,6 @@ replace it with a dir-locals-file `./%s'" (dired-extra-startup) (dired-revert)))) -(make-obsolete 'dired-omit-here-always 'add-dir-local-variable "24.1") - ;;; GUESS SHELL COMMAND. diff --git a/lisp/dired.el b/lisp/dired.el index 6defd6c4877..8cb3902161a 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1964,7 +1964,7 @@ Otherwise, call `toggle-read-only'." (interactive) (if (derived-mode-p 'dired-mode) (wdired-change-to-wdired-mode) - (call-interactively 'toggle-read-only))) + (read-only-mode 'toggle))) (defun dired-next-line (arg) "Move down lines then position at filename. @@ -2997,7 +2997,8 @@ argument or confirmation)." (let ((split-height-threshold 0)) (with-temp-buffer-window buffer - (cons 'display-buffer-below-selected nil) + (cons 'display-buffer-below-selected + '((window-height . fit-window-to-buffer))) #'(lambda (window _value) (with-selected-window window (unwind-protect @@ -4268,7 +4269,7 @@ instead. ;;;*** ;;;### (autoloads (dired-do-relsymlink dired-jump-other-window dired-jump) -;;;;;; "dired-x" "dired-x.el" "d2461aa6efb8c1d7de8f245728ab448e") +;;;;;; "dired-x" "dired-x.el" "a4e6844421c2c5e6fde90e959fbcc26f") ;;; Generated autoloads from dired-x.el (autoload 'dired-jump "dired-x" "\ diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 158d447a1d4..f8975a57b7b 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -255,20 +255,23 @@ of the page moves to the previous page." ;;;; Internal Variables (defun doc-view-new-window-function (winprops) + ;; (message "New window %s for buf %s" (car winprops) (current-buffer)) + (cl-assert (or (eq t (car winprops)) + (eq (window-buffer (car winprops)) (current-buffer)))) (let ((ol (image-mode-window-get 'overlay winprops))) - (when (and ol (not (overlay-buffer ol))) - ;; I've seen `ol' be a dead overlay. I do not yet know how this - ;; happened, so maybe the bug is elsewhere, but in the mean time, - ;; this seems like a safe approach. - (setq ol nil)) (if ol (progn - (cl-assert (eq (overlay-buffer ol) (current-buffer))) - (setq ol (copy-overlay ol))) - (cl-assert (not (get-char-property (point-min) 'display))) + (setq ol (copy-overlay ol)) + ;; `ol' might actually be dead. + (move-overlay ol (point-min) (point-max))) (setq ol (make-overlay (point-min) (point-max) nil t)) (overlay-put ol 'doc-view t)) (overlay-put ol 'window (car winprops)) + (unless (windowp (car winprops)) + ;; It's a pseudo entry. Let's make sure it's not displayed (the + ;; `window' property is only effective if its value is a window). + (cl-assert (eq t (car winprops))) + (delete-overlay ol)) (image-mode-window-put 'overlay ol winprops))) (defvar doc-view-current-files nil @@ -560,7 +563,8 @@ at the top edge of the page moves to the previous page." "Kill the current converter process(es)." (interactive) (while (consp doc-view-current-converter-processes) - (ignore-errors ;; Maybe it's dead already? + (ignore-errors ;; Some entries might not be processes, and maybe + ;; some are dead already? (kill-process (pop doc-view-current-converter-processes)))) (when doc-view-current-timer (cancel-timer doc-view-current-timer) @@ -663,19 +667,21 @@ OpenDocument format)." (defvar doc-view-shrink-factor 1.125) (defun doc-view-enlarge (factor) - "Enlarge the document." + "Enlarge the document by FACTOR." (interactive (list doc-view-shrink-factor)) (if (eq (plist-get (cdr (doc-view-current-image)) :type) 'imagemagick) - ;; ImageMagick supports on-the-fly-rescaling - (progn - (set (make-local-variable 'doc-view-image-width) - (ceiling (* factor doc-view-image-width))) - (doc-view-insert-image (plist-get (cdr (doc-view-current-image)) :file) - :width doc-view-image-width)) - (set (make-local-variable 'doc-view-resolution) - (ceiling (* factor doc-view-resolution))) - (doc-view-reconvert-doc))) + ;; ImageMagick supports on-the-fly-rescaling. + (let ((new (ceiling (* factor doc-view-image-width)))) + (unless (equal new doc-view-image-width) + (set (make-local-variable 'doc-view-image-width) new) + (doc-view-insert-image + (plist-get (cdr (doc-view-current-image)) :file) + :width doc-view-image-width))) + (let ((new (ceiling (* factor doc-view-resolution)))) + (unless (equal new doc-view-resolution) + (set (make-local-variable 'doc-view-resolution) new) + (doc-view-reconvert-doc))))) (defun doc-view-shrink (factor) "Shrink the document." @@ -743,12 +749,14 @@ min {(window-width / image-width), (window-height / image-height)} times." (img-height (cdr (image-display-size (image-get-display-property) t)))) (doc-view-enlarge (min (/ (float win-width) (float img-width)) - (/ (float (- win-height 1)) (float img-height))))) + (/ (float (- win-height 1)) + (float img-height))))) ;; If slice is set (let* ((slice-width (nth 2 slice)) (slice-height (nth 3 slice)) (scale-factor (min (/ (float win-width) (float slice-width)) - (/ (float (- win-height 1)) (float slice-height)))) + (/ (float (- win-height 1)) + (float slice-height)))) (new-slice (mapcar (lambda (x) (ceiling (* scale-factor x))) slice))) (doc-view-enlarge scale-factor) (setf (doc-view-current-slice) new-slice) @@ -762,6 +770,7 @@ Should be invoked when the cached images aren't up-to-date." ;; Clear the old cached files (when (file-exists-p (doc-view-current-cache-dir)) (delete-directory (doc-view-current-cache-dir) 'recursive)) + (kill-local-variable 'doc-view-last-page-number) (doc-view-initiate-display)) (defun doc-view-sentinel (proc event) @@ -895,6 +904,11 @@ Start by converting PAGES, and then the rest." (list "-raw" pdf txt) callback)) +(defun doc-view-current-cache-doc-pdf () + "Return the name of the doc.pdf in the current cache dir. + This file exists only if the current document isn't a PDF or PS file already." + (expand-file-name "doc.pdf" (doc-view-current-cache-dir))) + (defun doc-view-doc->txt (txt callback) "Convert the current document to text and call CALLBACK when done." (make-directory (doc-view-current-cache-dir) t) @@ -905,22 +919,17 @@ Start by converting PAGES, and then the rest." (`ps ;; Doc is a PS, so convert it to PDF (which will be converted to ;; TXT thereafter). - (let ((pdf (expand-file-name "doc.pdf" - (doc-view-current-cache-dir)))) + (let ((pdf (doc-view-current-cache-doc-pdf))) (doc-view-ps->pdf doc-view-buffer-file-name pdf (lambda () (doc-view-pdf->txt pdf txt callback))))) (`dvi ;; Doc is a DVI. This means that a doc.pdf already exists in its ;; cache subdirectory. - (doc-view-pdf->txt (expand-file-name "doc.pdf" - (doc-view-current-cache-dir)) - txt callback)) + (doc-view-pdf->txt (doc-view-current-cache-doc-pdf) txt callback)) (`odf ;; Doc is some ODF (or MS Office) doc. This means that a doc.pdf ;; already exists in its cache subdirectory. - (doc-view-pdf->txt (expand-file-name "doc.pdf" - (doc-view-current-cache-dir)) - txt callback)) + (doc-view-pdf->txt (doc-view-current-cache-doc-pdf) txt callback)) (_ (error "DocView doesn't know what to do")))) (defun doc-view-ps->pdf (ps pdf callback) @@ -960,13 +969,13 @@ Those files are saved in the directory given by the function (`dvi ;; DVI files have to be converted to PDF before Ghostscript can process ;; it. - (let ((pdf (expand-file-name "doc.pdf" doc-view-current-cache-dir))) + (let ((pdf (doc-view-current-cache-doc-pdf))) (doc-view-dvi->pdf doc-view-buffer-file-name pdf (lambda () (doc-view-pdf/ps->png pdf png-file))))) (`odf ;; ODF files have to be converted to PDF before Ghostscript can ;; process it. - (let ((pdf (expand-file-name "doc.pdf" doc-view-current-cache-dir)) + (let ((pdf (doc-view-current-cache-doc-pdf)) (opdf (expand-file-name (concat (file-name-base doc-view-buffer-file-name) ".pdf") doc-view-current-cache-dir)) @@ -1033,12 +1042,15 @@ dragging it to its bottom-right corner. See also (defun doc-view-get-bounding-box () "Get the BoundingBox information of the current page." (let* ((page (doc-view-current-page)) + (doc (let ((cache-doc (doc-view-current-cache-doc-pdf))) + (if (file-exists-p cache-doc) + cache-doc + doc-view-buffer-file-name))) (o (shell-command-to-string (concat doc-view-ghostscript-program " -dSAFER -dBATCH -dNOPAUSE -q -sDEVICE=bbox " (format "-dFirstPage=%s -dLastPage=%s %s" - page page - doc-view-buffer-file-name))))) + page page doc))))) (save-match-data (when (string-match (concat "%%BoundingBox: " "\\([[:digit:]]+\\) \\([[:digit:]]+\\) " @@ -1169,24 +1181,23 @@ Predicate for sorting `doc-view-current-files'." If FORCE is non-nil, start viewing even if the document does not have the page we want to view." (with-current-buffer buffer - (let ((prev-pages doc-view-current-files) - (windows (get-buffer-window-list buffer nil t))) + (let ((prev-pages doc-view-current-files)) (setq doc-view-current-files (sort (directory-files (doc-view-current-cache-dir) t "page-[0-9]+\\.png" t) 'doc-view-sort)) - (unless windows - (switch-to-buffer buffer) - (setq windows (get-buffer-window-list buffer nil t))) - (dolist (win windows) + (dolist (win (or (get-buffer-window-list buffer nil t) + (list t))) (let* ((page (doc-view-current-page win)) (pagefile (expand-file-name (format "page-%d.png" page) (doc-view-current-cache-dir)))) (when (or force (and (not (member pagefile prev-pages)) (member pagefile doc-view-current-files))) - (with-selected-window win - (cl-assert (eq (current-buffer) buffer) t) + (if (windowp win) + (with-selected-window win + (cl-assert (eq (current-buffer) buffer) t) + (doc-view-goto-page page)) (doc-view-goto-page page)))))))) (defun doc-view-buffer-message () @@ -1231,6 +1242,10 @@ For now these keys are useful: ;;;;; Toggle between editing and viewing +(defvar-local doc-view-saved-settings nil + "Doc-view settings saved while in some other mode.") +(put 'doc-view-saved-settings 'permanent-local t) + (defun doc-view-toggle-display () "Toggle between editing a document as text or viewing it." (interactive) @@ -1483,13 +1498,16 @@ toggle between displaying the document or editing it as text. ;; returns nil for tar members. (doc-view-fallback-mode) - (let* ((prev-major-mode (if (eq major-mode 'doc-view-mode) + (let* ((prev-major-mode (if (derived-mode-p 'doc-view-mode) doc-view-previous-major-mode - (when (not (memq major-mode - '(doc-view-mode fundamental-mode))) + (unless (eq major-mode 'fundamental-mode) major-mode)))) (kill-all-local-variables) - (set (make-local-variable 'doc-view-previous-major-mode) prev-major-mode)) + (set (make-local-variable 'doc-view-previous-major-mode) + prev-major-mode)) + + (dolist (var doc-view-saved-settings) + (set (make-local-variable (car var)) (cdr var))) ;; Figure out the document type. (unless doc-view-doc-type @@ -1563,13 +1581,20 @@ toggle between displaying the document or editing it as text. (defun doc-view-fallback-mode () "Fallback to the previous or next best major mode." - (if doc-view-previous-major-mode - (funcall doc-view-previous-major-mode) - (let ((auto-mode-alist (rassq-delete-all - 'doc-view-mode-maybe - (rassq-delete-all 'doc-view-mode - (copy-alist auto-mode-alist))))) - (normal-mode)))) + (let ((vars (if (derived-mode-p 'doc-view-mode) + (mapcar (lambda (var) (cons var (symbol-value var))) + '(doc-view-resolution + image-mode-winprops-alist))))) + (if doc-view-previous-major-mode + (funcall doc-view-previous-major-mode) + (let ((auto-mode-alist + (rassq-delete-all + 'doc-view-mode-maybe + (rassq-delete-all 'doc-view-mode + (copy-alist auto-mode-alist))))) + (normal-mode))) + (when vars + (setq-local doc-view-saved-settings vars)))) ;;;###autoload (defun doc-view-mode-maybe () diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 93e890a20c9..d740574f1e4 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -253,7 +253,9 @@ convention was modified." advertised-signature-table)) (defun make-obsolete (obsolete-name current-name &optional when) - "Make the byte-compiler warn that OBSOLETE-NAME is obsolete. + "Make the byte-compiler warn that function OBSOLETE-NAME is obsolete. +OBSOLETE-NAME should be a function name or macro name (a symbol). + The warning will say that CURRENT-NAME should be used instead. If CURRENT-NAME is a string, that is the `use instead' message \(it should end with a period, and not start with a capital). diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 7a229750178..d49e56bd2ba 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -846,7 +846,7 @@ CONST2 may be evaluated multiple times." (defun byte-compile-cl-file-p (file) "Return non-nil if FILE is one of the CL files." (and (stringp file) - (string-match "^cl\\>" (file-name-nondirectory file)))) + (string-match "^cl\\.el" (file-name-nondirectory file)))) (defun byte-compile-eval (form) "Eval FORM and mark the functions defined therein. diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index ea5e1cf9beb..913ebf2015f 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -689,7 +689,6 @@ PROPLIST is a list of the sort returned by `symbol-plist'. ;; Local variables: ;; byte-compile-dynamic: t -;; byte-compile-warnings: (not cl-functions) ;; generated-autoload-file: "cl-loaddefs.el" ;; End: diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 5749ff91b40..2eda628e262 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -745,7 +745,6 @@ If ALIST is non-nil, the new pairs are prepended to it." ;; Local variables: ;; byte-compile-dynamic: t -;; byte-compile-warnings: (not cl-functions) ;; End: ;;; cl-lib.el ends here diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index c12e8ccacb1..922c9856208 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -11,7 +11,7 @@ ;;;;;; cl--map-overlays cl--map-intervals cl--map-keymap-recursively ;;;;;; cl-notevery cl-notany cl-every cl-some cl-mapcon cl-mapcan ;;;;;; cl-mapl cl-maplist cl-map cl--mapcar-many cl-equalp cl-coerce) -;;;;;; "cl-extra" "cl-extra.el" "535a24c1cff55a16e3d51219498a7858") +;;;;;; "cl-extra" "cl-extra.el" "1572ae52fa4fbd9c4bf89b49a068a865") ;;; Generated autoloads from cl-extra.el (autoload 'cl-coerce "cl-extra" "\ @@ -260,7 +260,7 @@ Remove from SYMBOL's plist the property PROPNAME and its value. ;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when ;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp ;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*) -;;;;;; "cl-macs" "cl-macs.el" "6d0676869af66e5b5a671f95ee069461") +;;;;;; "cl-macs" "cl-macs.el" "da92f58f688ff6fb4d0098eb0f3acf0b") ;;; Generated autoloads from cl-macs.el (autoload 'cl--compiler-macro-list* "cl-macs" "\ @@ -748,7 +748,7 @@ surrounded by (cl-block NAME ...). ;;;;;; cl-nsubstitute-if cl-nsubstitute cl-substitute-if-not cl-substitute-if ;;;;;; cl-substitute cl-delete-duplicates cl-remove-duplicates cl-delete-if-not ;;;;;; cl-delete-if cl-delete cl-remove-if-not cl-remove-if cl-remove -;;;;;; cl-replace cl-fill cl-reduce) "cl-seq" "cl-seq.el" "b444601641dcbd14a23ca5182bc80ffa") +;;;;;; cl-replace cl-fill cl-reduce) "cl-seq" "cl-seq.el" "4c1e1191e82dc8d5449a5ec4d59efc10") ;;; Generated autoloads from cl-seq.el (autoload 'cl-reduce "cl-seq" "\ diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 16ac14f8fe9..56e698bec0a 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2686,7 +2686,6 @@ surrounded by (cl-block NAME ...). ;; Local variables: ;; byte-compile-dynamic: t -;; byte-compile-warnings: (not cl-functions) ;; generated-autoload-file: "cl-loaddefs.el" ;; End: diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index b55f1df5ba5..1fa562e328a 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el @@ -1010,7 +1010,6 @@ Atoms are compared by `eql'; cons cells are compared recursively. ;; Local variables: ;; byte-compile-dynamic: t -;; byte-compile-warnings: (not cl-functions) ;; generated-autoload-file: "cl-loaddefs.el" ;; End: diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index ae0852d6c87..34beed0d9ef 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -452,7 +452,7 @@ definitions, or lack thereof). \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" (declare (indent 1) (debug cl-flet) - (obsolete "Use either `cl-flet' or `cl-letf'." "24.3")) + (obsolete "use either `cl-flet' or `cl-letf'." "24.3")) `(letf ,(mapcar (lambda (x) (if (or (and (fboundp (car x)) diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index ea72e9492f0..8c8d37b2194 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -276,10 +276,10 @@ A mode's class is the first ancestor which is NOT a derived mode. Use the `derived-mode-parent' property of the symbol to trace backwards. Since major-modes might all derive from `fundamental-mode', this function is not very useful." + (declare (obsolete derived-mode-p "22.1")) (while (get mode 'derived-mode-parent) (setq mode (get mode 'derived-mode-parent))) mode) -(make-obsolete 'derived-mode-class 'derived-mode-p "22.1") ;;; PRIVATE diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index a7916354c91..c3b8e5e10d4 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -7,18 +7,18 @@ ;; This file is part of GNU Emacs. -;; 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. -;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `http://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index ad5e20cb8a4..ff00be7a237 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -7,18 +7,18 @@ ;; This file is part of GNU Emacs. -;; 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. -;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `http://www.gnu.org/licenses/'. +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index 4caa0a73866..7858c183e4b 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -1,22 +1,25 @@ -;;; gv.el --- Generalized variables -*- lexical-binding: t -*- +;;; gv.el --- generalized variables -*- lexical-binding: t -*- ;; Copyright (C) 2012 Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> ;; Keywords: extensions +;; Package: emacs -;; This program is free software; you can redistribute it and/or modify +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; This program is distributed in the hope that it will be useful, +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: @@ -266,7 +269,7 @@ The return value is the last VAL in the list. ;;;###autoload (put 'gv-place 'edebug-form-spec 'edebug-match-form) ;; CL did the equivalent of: -;;(gv-define-expand edebug-after (lambda (before index place) place)) +;;(gv-define-macroexpand edebug-after (lambda (before index place) place)) (put 'edebug-after 'gv-expander (lambda (do before index place) diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el index 761d27a2e28..0b6fd277ae2 100644 --- a/lisp/emacs-lisp/package-x.el +++ b/lisp/emacs-lisp/package-x.el @@ -10,10 +10,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -21,9 +21,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index b01cdbc7b8e..28d166271fb 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -9,10 +9,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -20,9 +20,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Change Log: diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 09e47b69b91..1312fc3731d 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -517,6 +517,10 @@ MATCH is the pattern that needs to be matched, of the form: (defun pcase--self-quoting-p (upat) (or (keywordp upat) (numberp upat) (stringp upat))) +(defsubst pcase--mark-used (sym) + ;; Exceptionally, `sym' may be a constant expression rather than a symbol. + (if (symbolp sym) (put sym 'pcase-used t))) + ;; It's very tempting to use `pcase' below, tho obviously, it'd create ;; bootstrapping problems. (defun pcase--u1 (matches code vars rest) @@ -581,7 +585,7 @@ Otherwise, it defers to REST which is a list of branches of the form ((memq upat '(t _)) (pcase--u1 matches code vars rest)) ((eq upat 'pcase--dontcare) :pcase--dontcare) ((memq (car-safe upat) '(guard pred)) - (if (eq (car upat) 'pred) (put sym 'pcase-used t)) + (if (eq (car upat) 'pred) (pcase--mark-used sym)) (let* ((splitrest (pcase--split-rest sym (lambda (pat) (pcase--split-pred upat pat)) rest)) @@ -614,10 +618,10 @@ Otherwise, it defers to REST which is a list of branches of the form (pcase--u1 matches code vars then-rest) (pcase--u else-rest)))) ((pcase--self-quoting-p upat) - (put sym 'pcase-used t) + (pcase--mark-used sym) (pcase--q1 sym upat matches code vars rest)) ((symbolp upat) - (put sym 'pcase-used t) + (pcase--mark-used sym) (if (not (assq upat vars)) (pcase--u1 matches code (cons (cons upat sym) vars) rest) ;; Non-linear pattern. Turn it into an `eq' test. @@ -640,7 +644,7 @@ Otherwise, it defers to REST which is a list of branches of the form (pcase--u1 (cons `(match ,sym . ,(nth 1 upat)) matches) code vars rest))) ((eq (car-safe upat) '\`) - (put sym 'pcase-used t) + (pcase--mark-used sym) (pcase--q1 sym (cadr upat) matches code vars rest)) ((eq (car-safe upat) 'or) (let ((all (> (length (cdr upat)) 1)) @@ -662,7 +666,7 @@ Otherwise, it defers to REST which is a list of branches of the form sym (lambda (pat) (pcase--split-member elems pat)) rest)) (then-rest (car splitrest)) (else-rest (cdr splitrest))) - (put sym 'pcase-used t) + (pcase--mark-used sym) (pcase--if `(,(if memq-fine #'memq #'member) ,sym ',elems) (pcase--u1 matches code vars then-rest) (pcase--u else-rest))) diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index a56a7619ea9..8aa722521eb 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -7,10 +7,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el index 3999529f7ac..5fdc8c55a85 100644 --- a/lisp/emacs-lisp/testcover.el +++ b/lisp/emacs-lisp/testcover.el @@ -270,9 +270,9 @@ value, 'maybe if either is acceptable." (setq id (nth 2 form)) (setcdr form (nthcdr 2 form)) (setq val (testcover-reinstrument (nth 2 form))) - (if (eq val t) - (setcar form 'testcover-1value) - (setcar form 'testcover-after)) + (setcar form (if (eq val t) + 'testcover-1value + 'testcover-after)) (when val ;;1-valued or potentially 1-valued (aset testcover-vector id '1value)) @@ -359,9 +359,9 @@ value, 'maybe if either is acceptable." ,(nth 3 (cadr form)))) t) (t - (if (eq (car (cadr form)) 'edebug-after) - (setq id (car (nth 3 (cadr form)))) - (setq id (car (cadr form)))) + (setq id (car (if (eq (car (cadr form)) 'edebug-after) + (nth 3 (cadr form)) + (cadr form)))) (let ((testcover-1value-functions (cons id testcover-1value-functions))) (testcover-reinstrument (cadr form)))))) @@ -379,9 +379,9 @@ value, 'maybe if either is acceptable." ,(nth 3 (cadr form)))) 'maybe) (t - (if (eq (car (cadr form)) 'edebug-after) - (setq id (car (nth 3 (cadr form)))) - (setq id (car (cadr form)))) + (setq id (car (if (eq (car (cadr form)) 'edebug-after) + (nth 3 (cadr form)) + (cadr form)))) (let ((testcover-noreturn-functions (cons id testcover-noreturn-functions))) (testcover-reinstrument (cadr form)))))) @@ -447,6 +447,12 @@ binding `testcover-vector' to the code-coverage vector for TESTCOVER-SYM (defun testcover-after (idx val) "Internal function for coverage testing. Returns VAL after installing it in `testcover-vector' at offset IDX." + (declare (gv-expander (lambda (do) + (gv-letplace (getter setter) val + (funcall do getter + (lambda (store) + `(progn (testcover-after ,idx ,getter) + ,(funcall setter store)))))))) (cond ((eq (aref testcover-vector idx) 'unknown) (aset testcover-vector idx val)) diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index bcd582a6f88..494d8a87e0e 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -146,14 +146,13 @@ TIME must be in the internal format returned by, e.g., `current-time'. The microsecond count from TIME is ignored, and USECS is used instead. If optional fourth argument DELTA is a positive number, make the timer fire repeatedly that many seconds apart." + (declare (obsolete "use `timer-set-time' and `timer-inc-time' instead." + "22.1")) (setf (timer--time timer) time) (setf (timer--usecs timer) usecs) (setf (timer--psecs timer) 0) (setf (timer--repeat-delay timer) (and (numberp delta) (> delta 0) delta)) timer) -(make-obsolete 'timer-set-time-with-usecs - "use `timer-set-time' and `timer-inc-time' instead." - "22.1") (defun timer-set-function (timer function &optional args) "Make TIMER call FUNCTION with optional ARGS when triggering." diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el index 5343d499efb..b20ec13fa81 100644 --- a/lisp/emacs-lock.el +++ b/lisp/emacs-lock.el @@ -249,9 +249,9 @@ Other values are interpreted as usual." (defun toggle-emacs-lock () "Toggle `emacs-lock-from-exiting' for the current buffer." + (declare (obsolete emacs-lock-mode "24.1")) (interactive) (call-interactively 'emacs-lock-mode)) -(make-obsolete 'toggle-emacs-lock 'emacs-lock-mode "24.1") (provide 'emacs-lock) diff --git a/lisp/epa.el b/lisp/epa.el index b796f5fa77c..ecc27c4d299 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -585,8 +585,8 @@ If SECRET is non-nil, list secret keys instead of public keys." (message "%s" info))) (defun epa-display-verify-result (verify-result) + (declare (obsolete epa-display-info "23.1")) (epa-display-info (epg-verify-result-to-string verify-result))) -(make-obsolete 'epa-display-verify-result 'epa-display-info "23.1") (defun epa-passphrase-callback-function (context key-id handback) (if (eq key-id 'SYM) diff --git a/lisp/epg.el b/lisp/epg.el index 6529afb2d3c..b0e01bc3721 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -1779,6 +1779,7 @@ This function is for internal use only." (epg-context-set-result-for context 'import-status nil))) (defun epg-passphrase-callback-function (context key-id _handback) + (declare (obsolete epa-passphrase-callback-function "23.1")) (if (eq key-id 'SYM) (read-passwd "Passphrase for symmetric encryption: " (eq (epg-context-operation context) 'encrypt)) @@ -1790,9 +1791,6 @@ This function is for internal use only." (format "Passphrase for %s %s: " key-id (cdr entry)) (format "Passphrase for %s: " key-id))))))) -(make-obsolete 'epg-passphrase-callback-function - 'epa-passphrase-callback-function "23.1") - (defun epg--list-keys-1 (context name mode) (let ((args (append (if epg-gpg-home-directory (list "--homedir" epg-gpg-home-directory)) @@ -2562,6 +2560,7 @@ If you use this function, you will need to wait for the completion of `epg-reset' to clear a temporary output file. If you are unsure, use synchronous version of this function `epg-sign-keys' instead." + (declare (obsolete nil "23.1")) (epg-context-set-operation context 'sign-keys) (epg-context-set-result context nil) (epg--start context (cons (if local @@ -2572,10 +2571,10 @@ If you are unsure, use synchronous version of this function (epg-sub-key-id (car (epg-key-sub-key-list key)))) keys)))) -(make-obsolete 'epg-start-sign-keys "do not use." "23.1") (defun epg-sign-keys (context keys &optional local) "Sign KEYS from the key ring." + (declare (obsolete nil "23.1")) (unwind-protect (progn (epg-start-sign-keys context keys local) @@ -2586,7 +2585,6 @@ If you are unsure, use synchronous version of this function (list "Sign keys failed" (epg-errors-to-string errors)))))) (epg-reset context))) -(make-obsolete 'epg-sign-keys "do not use." "23.1") (defun epg-start-generate-key (context parameters) "Initiate a key generation. diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index 674a6c97eec..348765036ea 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,3 +1,7 @@ +2012-09-25 Chong Yidong <cyd@gnu.org> + + * erc.el (erc-send-command): Use define-obsolete-function-alias. + 2012-09-17 Chong Yidong <cyd@gnu.org> * erc-page.el (erc-page-function): diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index feef75940f3..7feadc50aca 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -139,8 +139,8 @@ (message (concat "ERC: The function `defvaralias' is not bound. See the " "NEWS file for variable name changes since ERC 5.0.4."))) -(defalias 'erc-send-command 'erc-server-send) -(erc-make-obsolete 'erc-send-command 'erc-server-send "ERC 5.1") +(define-obsolete-function-alias 'erc-send-command + 'erc-server-send "ERC 5.1") ;; tunable connection and authentication parameters diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el index 37fa939cc10..ef59f6d1d35 100644 --- a/lisp/eshell/em-term.el +++ b/lisp/eshell/em-term.el @@ -63,10 +63,13 @@ which commands are considered visual in nature." :type '(repeat string) :group 'eshell-term) -(defcustom eshell-term-name "eterm" +;; If you change this from term-term-name, you need to ensure that the +;; value you choose exists in the system's terminfo database. (Bug#12485) +(defcustom eshell-term-name term-term-name "Name to use for the TERM variable when running visual commands. See `term-term-name' in term.el for more information on how this is used." + :version "24.3" ; eterm -> term-term-name = eterm-color :type 'string :group 'eshell-term) diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 515a23f81d7..5a10721387b 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -1216,11 +1216,12 @@ COMMAND may result in an alias being executed, or a plain command." (let* ((sym (intern-soft (concat "eshell/" name))) (file (symbol-file sym 'defun))) ;; If the function exists, but is defined in an eshell module - ;; that's not currently enabled, don't report it as found + ;; that's not currently enabled, don't report it as found. (if (and file - (string-match "\\(em\\|esh\\)-\\(.*\\)\\(\\.el\\)?\\'" file)) + (setq file (file-name-base file)) + (string-match "\\`\\(em\\|esh\\)-\\([[:alnum:]]+\\)\\'" file)) (let ((module-sym - (intern (file-name-base (concat "eshell-" (match-string 2 file)))))) + (intern (concat "eshell-" (match-string 2 file))))) (if (and (functionp sym) (or (null module-sym) (eshell-using-module module-sym) diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index fa0336232f9..01df5fced62 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -275,6 +275,7 @@ Prepend remote identification of `default-directory', if any." (defmacro eshell-for (for-var for-list &rest forms) "Iterate through a list." + (declare (obsolete dolist "24.1")) (declare (indent 2)) `(let ((list-iter ,for-list)) (while list-iter @@ -282,9 +283,6 @@ Prepend remote identification of `default-directory', if any." ,@forms) (setq list-iter (cdr list-iter))))) - -(make-obsolete 'eshell-for 'dolist "24.1") - (defun eshell-flatten-list (args) "Flatten any lists within ARGS, so that there are no sublists." (let ((new-list (list t))) diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el index c663de3f40d..a9a854221a4 100644 --- a/lisp/eshell/eshell.el +++ b/lisp/eshell/eshell.el @@ -243,16 +243,14 @@ shells such as bash, zsh, rc, 4dos." (defun eshell-add-to-window-buffer-names () "Add `eshell-buffer-name' to `same-window-buffer-names'." + (declare (obsolete nil "24.3")) (add-to-list 'same-window-buffer-names eshell-buffer-name)) -(make-obsolete 'eshell-add-to-window-buffer-names - "no longer needed." "24.3") (defun eshell-remove-from-window-buffer-names () "Remove `eshell-buffer-name' from `same-window-buffer-names'." + (declare (obsolete nil "24.3")) (setq same-window-buffer-names (delete eshell-buffer-name same-window-buffer-names))) -(make-obsolete 'eshell-remove-from-window-buffer-names - "no longer needed." "24.3") (defcustom eshell-load-hook nil "A hook run once Eshell has been loaded." diff --git a/lisp/faces.el b/lisp/faces.el index 6a477e172e1..3ee859305a5 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1867,6 +1867,7 @@ Return nil if it has no specified face." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (declare-function x-parse-geometry "frame.c" (string)) +(defvar x-display-name) (defun x-handle-named-frame-geometry (parameters) "Add geometry parameters for a named frame to parameter list PARAMETERS. diff --git a/lisp/files.el b/lisp/files.el index 66c526266e6..76a13f6cefd 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -821,10 +821,10 @@ one or more of those symbols." (defun locate-file-completion (string path-and-suffixes action) "Do completion for file names passed to `locate-file'. PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." + (declare (obsolete locate-file-completion-table "23.1")) (locate-file-completion-table (car path-and-suffixes) (cdr path-and-suffixes) string nil action)) -(make-obsolete 'locate-file-completion 'locate-file-completion-table "23.1") (defvar locate-dominating-stop-dir-regexp (purecopy "\\`\\(?:[\\/][\\/][^\\/]+[\\/]\\|/\\(?:net\\|afs\\|\\.\\.\\.\\)/\\)\\'") diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 6404af7703a..78760c015ff 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -340,8 +340,8 @@ This can be an \"!\" or the \"n\" in \"ifndef\".") (defvar font-lock-preprocessor-face 'font-lock-preprocessor-face "Face name to use for preprocessor directives.") -(defvar font-lock-reference-face 'font-lock-constant-face) -(make-obsolete-variable 'font-lock-reference-face 'font-lock-constant-face "20.3") +(define-obsolete-variable-alias + 'font-lock-reference-face 'font-lock-constant-face "20.3") ;; Fontification variables: diff --git a/lisp/generic-x.el b/lisp/generic-x.el index a97c5649c95..ce1599b9010 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -1531,15 +1531,15 @@ like an INI file. You can add this hook to `find-file-hook'." '("#[ \t]*include[ \t]+\\(<[^>\"\n]+>\\)" 1 font-lock-string-face) '("#[ \t]*\\(\\sw+\\)\\>[ \t]*\\(\\sw+\\)?" - (1 font-lock-reference-face) + (1 font-lock-constant-face) (2 font-lock-variable-name-face nil t)) ;; indirect string constants '("\\(@[A-Za-z][A-Za-z0-9_]+\\)" 1 font-lock-builtin-face) ;; gotos - '("[ \t]*\\(\\sw+:\\)" 1 font-lock-reference-face) + '("[ \t]*\\(\\sw+:\\)" 1 font-lock-constant-face) '("\\<\\(goto\\)\\>[ \t]*\\(\\sw+\\)?" (1 font-lock-keyword-face) - (2 font-lock-reference-face nil t)) + (2 font-lock-constant-face nil t)) ;; system variables (generic-make-keywords-list installshield-system-variables-list diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 45f23a6d99c..983d09e2589 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,8 @@ +2012-09-25 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-browse-delete-temp-files): Never ask again + a user about whether to delete temp files if once a user answered as n. + 2012-09-17 Richard Stallman <rms@gnu.org> * message.el (message-in-body-p): Don't set mark or modify buffer. diff --git a/lisp/gnus/ChangeLog.2 b/lisp/gnus/ChangeLog.2 index 5a3612c4d1c..e75506956bb 100644 --- a/lisp/gnus/ChangeLog.2 +++ b/lisp/gnus/ChangeLog.2 @@ -11974,7 +11974,7 @@ 2001-12-18 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu> - * ChangeLog, ChangeLog.1, nnwfm.el, gnus-smiley.el: + * ChangeLog, ChangeLog.1, nnwfm.el, gnus-smiley.el: * gnus-cite.el, gnus-delay.el, gnus-spec.el, message.el: * mml1991.el, nnultimate.el: Add `coding'. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 7dcbd61316f..6c827e070cb 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -2760,11 +2760,12 @@ summary buffer." (or how (setq how gnus-article-browse-delete-temp)) (if (eq how 'ask) (let ((files (length gnus-article-browse-html-temp-list))) - (gnus-y-or-n-p - (if (= files 1) - "Delete the temporary HTML file? " - (format "Delete all %s temporary HTML files? " - files)))) + (or (gnus-y-or-n-p + (if (= files 1) + "Delete the temporary HTML file? " + (format "Delete all %s temporary HTML files? " + files))) + (setq gnus-article-browse-html-temp-list nil))) how))) (dolist (file gnus-article-browse-html-temp-list) (cond ((file-directory-p file) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index fa0484ff4e5..ef482f8f0e9 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -488,13 +488,16 @@ suitable file is found, return nil." (insert "'.\n")))) (defun help-fns--obsolete (function) - (let* ((obsolete (and - ;; `function' might be a lambda construct. - (symbolp function) - (get function 'byte-obsolete-info))) + ;; Ignore lambda constructs, keyboard macros, etc. + (let* ((obsolete (and (symbolp function) + (get function 'byte-obsolete-info))) (use (car obsolete))) (when obsolete - (insert "\nThis function is obsolete") + (insert "\nThis " + (if (eq (car-safe (symbol-function function)) 'macro) + "macro" + "function") + " is obsolete") (when (nth 2 obsolete) (insert (format " since %s" (nth 2 obsolete)))) (insert (cond ((stringp use) (concat ";\n" use)) @@ -611,7 +614,7 @@ FILE is the file where FUNCTION was probably defined." (fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point)) (point))) (terpri)(terpri) - + (let* ((doc-raw (condition-case err (documentation function t) (error (format "No Doc! %S" err)))) diff --git a/lisp/help-macro.el b/lisp/help-macro.el index 112c72778bc..0600484b6df 100644 --- a/lisp/help-macro.el +++ b/lisp/help-macro.el @@ -69,7 +69,6 @@ (require 'backquote) -;;;###autoload (defcustom three-step-help nil "Non-nil means give more info about Help command in three steps. The three steps are simple prompt, prompt with all options, and diff --git a/lisp/help.el b/lisp/help.el index 707c8e3c84f..0df9c607f69 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -981,26 +981,6 @@ function is called, the window to be resized is selected." :group 'help :version "24.2") -(defcustom temp-buffer-resize-frames nil - "Non-nil means `temp-buffer-resize-mode' can resize frames. -A frame can be resized if and only if its root window is a live -window. The height of the root window is subject to the values of -`temp-buffer-max-height' and `window-min-height'." - :type 'boolean - :version "24.2" - :group 'help) - -(defcustom temp-buffer-resize-regexps nil - "List of regexps that inhibit Temp Buffer Resize mode. -Any window of a buffer whose name matches one of these regular -expressions is left alone by Temp Buffer Resize mode." - :type '(repeat - :tag "Buffer" - :value "" - (regexp :format "%v")) - :version "24.3" - :group 'help) - (define-minor-mode temp-buffer-resize-mode "Toggle auto-resizing temporary buffer windows (Temp Buffer Resize Mode). With a prefix argument ARG, enable Temp Buffer Resize mode if ARG @@ -1014,9 +994,8 @@ fit the buffer's contents, but never more than A window is resized only if it has been specially created for the buffer. Windows that have shown another buffer before are not -resized. A window showing a buffer whose name matches any of the -expressions in `temp-buffer-resize-regexps' is not resized. A -frame is resized only if `temp-buffer-resize-frames' is non-nil. +resized. A frame is resized only if `fit-frame-to-buffer' is +non-nil. This mode is used by `help', `apropos' and `completion' buffers, and some others." @@ -1034,33 +1013,28 @@ WINDOW can be any live window and defaults to the selected one. Do not make WINDOW higher than `temp-buffer-max-height' nor smaller than `window-min-height'. Do nothing if WINDOW is not vertically combined or some of its contents are scrolled out of -view. Do nothing if the name of WINDOW's buffer matches an -expression in `temp-buffer-resize-regexps'." +view." (setq window (window-normalize-window window t)) (let ((buffer-name (buffer-name (window-buffer window)))) - (unless (catch 'found - (dolist (regexp temp-buffer-resize-regexps) - (when (string-match regexp buffer-name) - (throw 'found t)))) - (let ((height (if (functionp temp-buffer-max-height) - (with-selected-window window - (funcall temp-buffer-max-height (window-buffer))) - temp-buffer-max-height)) - (quit-cadr (cadr (window-parameter window 'quit-restore)))) - (cond - ;; Don't resize WINDOW if it showed another buffer before. - ((and (eq quit-cadr 'window) - (pos-visible-in-window-p (point-min) window) - (window-combined-p window)) - (fit-window-to-buffer window height)) - ((and temp-buffer-resize-frames - (eq quit-cadr 'frame) - (eq window (frame-root-window window))) - (let ((frame (window-frame window))) - (fit-frame-to-buffer - frame (+ (frame-height frame) - (- (window-total-size window)) - height))))))))) + (let ((height (if (functionp temp-buffer-max-height) + (with-selected-window window + (funcall temp-buffer-max-height (window-buffer))) + temp-buffer-max-height)) + (quit-cadr (cadr (window-parameter window 'quit-restore)))) + (cond + ;; Don't resize WINDOW if it showed another buffer before. + ((and (eq quit-cadr 'window) + (pos-visible-in-window-p (point-min) window) + (window-combined-p window)) + (fit-window-to-buffer window height)) + ((and fit-frame-to-buffer + (eq quit-cadr 'frame) + (eq window (frame-root-window window))) + (let ((frame (window-frame window))) + (fit-frame-to-buffer + frame (+ (frame-height frame) + (- (window-total-size window)) + height)))))))) ;;; Help windows. (defcustom help-window-select 'other diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el index f787319fb0c..2f0a6e3af59 100644 --- a/lisp/hippie-exp.el +++ b/lisp/hippie-exp.el @@ -199,7 +199,6 @@ (defvar he-search-window ()) -;;;###autoload (defcustom hippie-expand-try-functions-list '(try-complete-file-name-partially try-complete-file-name @@ -217,31 +216,26 @@ or insert functions in this list." :type '(repeat function) :group 'hippie-expand) -;;;###autoload (defcustom hippie-expand-verbose t "Non-nil makes `hippie-expand' output which function it is trying." :type 'boolean :group 'hippie-expand) -;;;###autoload (defcustom hippie-expand-dabbrev-skip-space nil "Non-nil means tolerate trailing spaces in the abbreviation to expand." :group 'hippie-expand :type 'boolean) -;;;###autoload (defcustom hippie-expand-dabbrev-as-symbol t "Non-nil means expand as symbols, i.e. syntax `_' is considered a letter." :group 'hippie-expand :type 'boolean) -;;;###autoload (defcustom hippie-expand-no-restriction t "Non-nil means that narrowed buffers are widened during search." :group 'hippie-expand :type 'boolean) -;;;###autoload (defcustom hippie-expand-max-buffers () "The maximum number of buffers (apart from the current) searched. If nil, all buffers are searched." @@ -249,15 +243,13 @@ If nil, all buffers are searched." integer) :group 'hippie-expand) -;;;###autoload -(defcustom hippie-expand-ignore-buffers (list (purecopy "^ \\*.*\\*$") 'dired-mode) +(defcustom hippie-expand-ignore-buffers '("^ \\*.*\\*$" dired-mode) "A list specifying which buffers not to search (if not current). Can contain both regexps matching buffer names (as strings) and major modes \(as atoms)" :type '(repeat (choice regexp (symbol :tag "Major Mode"))) :group 'hippie-expand) -;;;###autoload (defcustom hippie-expand-only-buffers () "A list specifying the only buffers to search (in addition to current). Can contain both regexps matching buffer names (as strings) and major modes diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index fbf7a672ff6..b0bc5b6b3b3 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -1052,8 +1052,6 @@ haven't encountered them yet. Returns a `hfy-style-assoc'." (hfy-face-attr-for-class fn hfy-display-class)) ((and (symbolp fn) (facep (symbol-value fn))) - ;; Obsolete faces like `font-lock-reference-face' are defined as - ;; aliases for another face. (hfy-face-attr-for-class (symbol-value fn) hfy-display-class)) (t nil))) diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 97df90a65af..ee5bd0f357a 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -755,10 +755,16 @@ They are removed from `ibuffer-saved-filter-groups'." The value from `ibuffer-saved-filter-groups' is used." (interactive (list - (if (null ibuffer-saved-filter-groups) - (error "No saved filters") - (completing-read "Switch to saved filter group: " - ibuffer-saved-filter-groups nil t)))) + (cond ((null ibuffer-saved-filter-groups) + (error "No saved filters")) + ;; `ibuffer-saved-filter-groups' is a user variable that defaults + ;; to nil. We assume that with one element in this list the user + ;; knows what she wants. See bug#12331. + ((null (cdr ibuffer-saved-filter-groups)) + (caar ibuffer-saved-filter-groups)) + (t + (completing-read "Switch to saved filter group: " + ibuffer-saved-filter-groups nil t))))) (setq ibuffer-filter-groups (cdr (assoc name ibuffer-saved-filter-groups)) ibuffer-hidden-filter-groups nil) (ibuffer-update nil t)) diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 77461469044..c9dcff41618 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -1283,7 +1283,7 @@ With optional ARG, make read-only only if ARG is not negative." (:opstring "toggled read only status in" :interactive "P" :modifier-p t) - (call-interactively 'toggle-read-only)) + (read-only-mode 'toggle)) (define-ibuffer-op ibuffer-do-delete () "Kill marked buffers as with `kill-this-buffer'." @@ -2641,7 +2641,7 @@ will be inserted before the group at point." ;;;;;; ibuffer-backward-filter-group ibuffer-forward-filter-group ;;;;;; ibuffer-toggle-filter-group ibuffer-mouse-toggle-filter-group ;;;;;; ibuffer-interactive-filter-by-mode ibuffer-mouse-filter-by-mode -;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "c255d1ebe80ccabd8385f40bdd0b5451") +;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "f03bae226325c7320d41ddb78896665a") ;;; Generated autoloads from ibuf-ext.el (autoload 'ibuffer-auto-mode "ibuf-ext" "\ diff --git a/lisp/ido.el b/lisp/ido.el index d48e7ba858b..94818fe57b0 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -714,7 +714,7 @@ See also `ido-dir-file-cache' and `ido-save-directory-list-file'." :type 'integer :group 'ido) -(defcustom ido-max-directory-size 30000 +(defcustom ido-max-directory-size nil "Maximum size (in bytes) for directories to use ido completion. 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." @@ -3701,14 +3701,14 @@ This is to make them appear as if they were \"virtual buffers\"." (rexq (concat rex0 (if slash ".*/" ""))) (re (if ido-enable-prefix (concat "\\`" rexq) rexq)) (full-re (and do-full - (and (eq ido-cur-item 'buffer) - (not ido-buffer-disable-smart-matches)) + (not (and (eq ido-cur-item 'buffer) + ido-buffer-disable-smart-matches)) (not ido-enable-regexp) (not (string-match "\$\\'" rex0)) (concat "\\`" rex0 (if slash "/" "") "\\'"))) (suffix-re (and do-full slash - (and (eq ido-cur-item 'buffer) - (not ido-buffer-disable-smart-matches)) + (not (and (eq ido-cur-item 'buffer) + ido-buffer-disable-smart-matches)) (not ido-enable-regexp) (not (string-match "\$\\'" rex0)) (concat rex0 "/\\'"))) diff --git a/lisp/image-mode.el b/lisp/image-mode.el index fabc12c0219..4ac62fbb6fc 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -1,4 +1,4 @@ -;;; image-mode.el --- support for visiting image files +;;; image-mode.el --- support for visiting image files -*- lexical-binding: t -*- ;; ;; Copyright (C) 2005-2012 Free Software Foundation, Inc. ;; @@ -31,6 +31,11 @@ ;; resulting buffer file is saved to another name it will correctly save ;; the image data to the new file. +;; Todo: + +;; Consolidate with doc-view to make them work on directories of images or on +;; image files containing various "pages". + ;;; Code: (require 'image) @@ -38,8 +43,7 @@ ;;; Image mode window-info management. -(defvar image-mode-winprops-alist t) -(make-variable-buffer-local 'image-mode-winprops-alist) +(defvar-local image-mode-winprops-alist t) (defvar image-mode-new-window-functions nil "Special hook run when image data is requested in a new window. @@ -47,9 +51,13 @@ It is called with one argument, the initial WINPROPS.") (defun image-mode-winprops (&optional window cleanup) "Return winprops of WINDOW. -A winprops object has the shape (WINDOW . ALIST)." +A winprops object has the shape (WINDOW . ALIST). +WINDOW defaults to `selected-window' if it displays the current buffer, and +otherwise it defaults to t, used for times when the buffer is not displayed." (cond ((null window) - (setq window (selected-window))) + (setq window + (if (eq (current-buffer) (window-buffer)) (selected-window) t))) + ((eq window t)) ((not (windowp window)) (error "Not a window: %s" window))) (when cleanup diff --git a/lisp/image.el b/lisp/image.el index 99c0a74a512..72dc654757a 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -346,7 +346,7 @@ Optional DATA-P non-nil means SOURCE is a string containing image data." "Return non-nil if image type TYPE is available. Image types are symbols like `xbm' or `jpeg'." (and (fboundp 'init-image-library) - (init-image-library type dynamic-library-alist))) + (init-image-library type))) ;;;###autoload diff --git a/lisp/imenu.el b/lisp/imenu.el index c2a80d69675..47a2f1e3b40 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -326,6 +326,7 @@ PREVPOS is the variable in which we store the last position displayed." (defun imenu-example--name-and-position () "Return the current/previous sexp and its (beginning) location. Don't move point." + (declare (obsolete "use your own function instead." "23.2")) (save-excursion (forward-sexp -1) ;; [ydi] modified for imenu-use-markers @@ -333,8 +334,6 @@ Don't move point." (end (progn (forward-sexp) (point)))) (cons (buffer-substring beg end) beg)))) -(make-obsolete 'imenu-example--name-and-position - "use your own function instead." "23.2") ;;; ;;; Lisp @@ -343,6 +342,7 @@ Don't move point." (defun imenu-example--lisp-extract-index-name () ;; Example of a candidate for `imenu-extract-index-name-function'. ;; This will generate a flat index of definitions in a lisp file. + (declare (obsolete nil "23.2")) (save-match-data (and (looking-at "(def") (condition-case nil @@ -353,11 +353,11 @@ Don't move point." (end (progn (forward-sexp -1) (point)))) (buffer-substring beg end))) (error nil))))) -(make-obsolete 'imenu-example--lisp-extract-index-name "your own" "23.2") (defun imenu-example--create-lisp-index () ;; Example of a candidate for `imenu-create-index-function'. ;; It will generate a nested index of definitions. + (declare (obsolete nil "23.2")) (let ((index-alist '()) (index-var-alist '()) (index-type-alist '()) @@ -401,7 +401,6 @@ Don't move point." (push (cons "Syntax-unknown" index-unknown-alist) index-alist)) index-alist)) -(make-obsolete 'imenu-example--create-lisp-index "your own" "23.2") ;; Regular expression to find C functions (defvar imenu-example--function-name-regexp-c @@ -414,6 +413,7 @@ Don't move point." )) (defun imenu-example--create-c-index (&optional regexp) + (declare (obsolete nil "23.2")) (let ((index-alist '()) char) (goto-char (point-min)) @@ -430,7 +430,6 @@ Don't move point." (if (not (eq char ?\;)) (push (imenu-example--name-and-position) index-alist)))) (nreverse index-alist))) -(make-obsolete 'imenu-example--create-c-index "your own" "23.2") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; diff --git a/lisp/international/latin1-disp.el b/lisp/international/latin1-disp.el index 964f01c982c..5041f45ba97 100644 --- a/lisp/international/latin1-disp.el +++ b/lisp/international/latin1-disp.el @@ -202,8 +202,8 @@ character set: `latin-2', `hebrew' etc." (and char (char-displayable-p char)))) ;; Backwards compatibility. -(defalias 'latin1-char-displayable-p 'char-displayable-p) -(make-obsolete 'latin1-char-displayable-p 'char-displayable-p "22.1") +(define-obsolete-function-alias 'latin1-char-displayable-p + 'char-displayable-p "22.1") (defun latin1-display-setup (set &optional force) "Set up Latin-1 display for characters in the given SET. diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 2fc9759972e..a32c69a691e 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -2058,9 +2058,9 @@ See `set-language-info-alist' for use in programs." (defun princ-list (&rest args) "Print all arguments with `princ', then print \"\\n\"." + (declare (obsolete "use mapc and princ instead." "23.3")) (mapc #'princ args) (princ "\n")) -(make-obsolete 'princ-list "use mapc and princ instead" "23.3") (put 'describe-specified-language-support 'apropos-inhibit t) diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el index bd7257bbc0f..43af785cc2f 100644 --- a/lisp/international/mule-diag.el +++ b/lisp/international/mule-diag.el @@ -208,8 +208,8 @@ Character sets for defining other charsets, or for backward compatibility "Decode a character that has code CODE in CODEPAGE. Return a decoded character string. Each CODEPAGE corresponds to a coding system cpCODEPAGE." + (declare (obsolete decode-char "23.1")) (decode-char (intern (format "cp%d" codepage)) code)) -(make-obsolete 'decode-codepage-char 'decode-char "23.1") ;; A variable to hold charset input history. (defvar charset-history nil) diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el index 7b152a47727..3dc0b54421a 100644 --- a/lisp/international/mule-util.el +++ b/lisp/international/mule-util.el @@ -34,39 +34,6 @@ ;;; characters. ;;;###autoload -(defun string-to-sequence (string type) - "Convert STRING to a sequence of TYPE which contains characters in STRING. -TYPE should be `list' or `vector'." -;;; (let ((len (length string)) -;;; (i 0) -;;; val) - (cond ((eq type 'list) - ;; Applicable post-Emacs 20.2 and asymptotically ~10 times - ;; faster than the code below: - (append string nil)) -;;; (setq val (make-list len 0)) -;;; (let ((l val)) -;;; (while (< i len) -;;; (setcar l (aref string i)) -;;; (setq l (cdr l) i (1+ i)))))) - ((eq type 'vector) - ;; As above. - (vconcat string)) -;;; (setq val (make-vector len 0)) -;;; (while (< i len) -;;; (aset val i (aref string i)) -;;; (setq i (1+ i)))) - (t - (error "Invalid type: %s" type))) -;;; val) -) - -;;;###autoload -(make-obsolete 'string-to-sequence - "use `string-to-list' or `string-to-vector'." - "22.1") - -;;;###autoload (defsubst string-to-list (string) "Return a list of characters in STRING." (append string nil)) @@ -330,10 +297,9 @@ operations such as `find-coding-systems-region'." "Detect a coding system of the text between FROM and TO with PRIORITY-LIST. PRIORITY-LIST is an alist of coding categories vs the corresponding coding systems ordered by priority." + (declare (obsolete with-coding-priority "23.1")) `(with-coding-priority (mapcar #'cdr ,priority-list) (detect-coding-region ,from ,to))) -(make-obsolete 'detect-coding-with-priority - "use `with-coding-priority' and `detect-coding-region'." "23.1") ;;;###autoload (defun detect-coding-with-language-environment (from to lang-env) diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 4d567a6e9d8..e6e3f045a9e 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -409,13 +409,13 @@ PLIST (property list) may contain any type of information a user (defun charset-id (charset) "Always return 0. This is provided for backward compatibility." + (declare (obsolete nil "23.1")) 0) -(make-obsolete 'charset-id "do not use it." "23.1") (defmacro charset-bytes (charset) "Always return 0. This is provided for backward compatibility." + (declare (obsolete nil "23.1")) 0) -(make-obsolete 'charset-bytes "do not use it." "23.1") (defun get-charset-property (charset propname) "Return the value of CHARSET's PROPNAME property. @@ -464,8 +464,8 @@ Return -1 if charset isn't an ISO 2022 one." (defun charset-list () "Return list of all charsets ever defined." + (declare (obsolete charset-list "23.1")) charset-list) -(make-obsolete 'charset-list "use variable `charset-list'." "23.1") ;;; CHARACTER @@ -473,8 +473,8 @@ Return -1 if charset isn't an ISO 2022 one." (defun generic-char-p (char) "Always return nil. This is provided for backward compatibility." + (declare (obsolete nil "23.1")) nil) -(make-obsolete 'generic-char-p "generic characters no longer exist." "23.1") (defun make-char-internal (charset-id &optional code1 code2) (let ((charset (aref emacs-mule-charset-table charset-id))) @@ -1012,6 +1012,7 @@ Value is a list of transformed arguments." eol-type) "Define a new coding system CODING-SYSTEM (symbol). This function is provided for backward compatibility." + (declare (obsolete define-coding-system "23.1")) ;; For compatibility with XEmacs, we check the type of TYPE. If it ;; is a symbol, perhaps, this function is called with XEmacs-style ;; arguments. Here, try to transform that kind of arguments to @@ -1104,8 +1105,6 @@ This function is provided for backward compatibility." (apply 'define-coding-system coding-system doc-string properties)) -(make-obsolete 'make-coding-system 'define-coding-system "23.1") - (defun merge-coding-systems (first second) "Fill in any unspecified aspects of coding system FIRST from SECOND. Return the resulting coding system." @@ -1449,9 +1448,9 @@ This setting is effective for the next communication only." ARG is a list of coding categories ordered by priority. This function is provided for backward compatibility." + (declare (obsolete set-coding-system-priority "23.1")) (apply 'set-coding-system-priority (mapcar #'(lambda (x) (symbol-value x)) arg))) -(make-obsolete 'set-coding-priority 'set-coding-system-priority "23.1") ;;; X selections @@ -2356,9 +2355,6 @@ Analogous to `define-translation-table', but updates (setq ignore-relative-composition (make-char-table 'ignore-relative-composition)) -(make-obsolete 'set-char-table-default - "generic characters no longer exist." "23.1") - ;;; Built-in auto-coding-functions: (defun sgml-xml-auto-coding-function (size) diff --git a/lisp/international/uni-bidi.el b/lisp/international/uni-bidi.el index 0dfabdd65da..ba1bd436b23 100644 --- a/lisp/international/uni-bidi.el +++ b/lisp/international/uni-bidi.el @@ -5,7 +5,7 @@ (define-char-code-property 'bidi-class #^[1 nil char-code-property-table #^^[3 0 5 5 5 5 5 5 5 5 5 17 6 17 18 6 5 5 5 5 5 5 5 5 5 5 5 5 5 5 6 6 6 17 18 19 19 14 14 14 19 19 19 19 19 13 15 13 15 15 3 3 3 3 3 3 3 3 3 3 15 19 19 19 19 19 19 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 19 19 19 19 19 19 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 19 19 19 19 5] #^^[1 0 #^^[2 0 #^^[3 0 5 5 5 5 5 5 5 5 5 17 6 17 18 6 5 5 5 5 5 5 5 5 5 5 5 5 5 5 6 6 6 17 18 19 19 14 14 14 19 19 19 19 19 13 15 13 15 15 3 3 3 3 3 3 3 3 3 3 15 19 19 19 19 19 19 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 19 19 19 19 19 19 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 19 19 19 19 5] "
" 1 1 1 "¹
" "ð" "î" 1 "ö" 1 "¸" "
°" "Ö" "³" "¦«" "
«¤" " ·" "·" "º" "¹" "¹
" "º" "½¥
" "¾
" "¼" "Á" "Ê©" "±±" "±²" "³" "
¤¹"] #^^[2 4096 "" "â" 1 1 1 1 "Ý " "æ" "ÿ" 1 1 1 1 "ã" "" "´" "ñ" "©Ö" " º" "Þ¢" "½" 1 "°
¨" " º" "¬È" "Ð" 1 "À§" 1 1 1 "½"] #^^[2 8192 " -
" "
¡" "
" "ð" "
ì" 19 "¶Å
" "Þ" "§ " "Î" 19 19 19 "¬Ó" "ÿ" 19 1 1 19 19 19 19 "ͦ" 1 1 "å" "ÿ" "à " "¼Ä" "Ù" 19 "Ö"] #^^[2 12288 "
À" "Ú" 1 "À¤" "±" "±°" "÷
" "Þ" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 16384 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "ÀÀ" 1 1 1 1] 1 1 1 1 #^^[2 36864 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +
" "
¡" "
" "ð" "
ì" 19 "¶Å
" "Þ" "§ " "Î" 19 19 19 "¬Ó" "ÿ" 19 1 1 19 19 19 19 "ͦ" 1 1 "å" "ÿ" "à " "¼Ä" "Ù" 19 "Ö"] #^^[2 12288 "
À" "Ú" 1 "À¤" "±" "±°" "÷
" "Þ" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 16384 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "ÀÀ" 1 1 1 1] 1 1 1 1 #^^[2 36864 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 #^^[3 40832 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]] #^^[2 40960 1 1 1 1 1 1 1 1 1 "·¹" 1 1 "ß" "Ð" "¢Þ" "÷" "º" "Ä" "¦®" "°Ã" "©³" "°
ª" 1 "å" 1 1 1 1 1 1 1 1] 1 1 #^^[2 53248 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 #^^[2 61440 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "
¦°" 7 7 7 "¾À" "ý" "
" "ÿ" "
" "à
"]] #^^[1 65536 #^^[2 65536 1 1 "¾À" "
á" 1 1 1 1 1 1 1 1 1 1 1 1 2 2 "à" 2 "
¨À" 2 "¹À" 2 2 2 2 2 "à" 2 2 2] #^^[2 69632 "¶" "±Å" "¤
Ë" "´Á" 1 1 1 1 1 1 1 1 1 "«È" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 73728 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 77824 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 #^^[2 90112 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 "í"] 1 1 1 1 #^^[2 110592 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 #^^[2 118784 1 1 "ç
" "Ò" "º" 1 "ש" 1 1 1 1 1 1 "Û¤" "¹°" "¹²" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 122880 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 "" "
´" 2 2] #^^[2 126976 "¬Ð" " " "ß" 1 1 1 "¡Æ" "¥
" "¿¾" "ø" "¾" "û
" "Á°" "ƺ" "ô" 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]] #^^[1 131072 1 1 1 1 1 1 1 1 1 1 #^^[2 172032 1 1 1 1 1 1 1 1 1 1 1 1 1 #^^[3 173696 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] #^^[2 176128 1 1 1 1 1 1 1 1 1 1 1 1 1 1 #^^[3 177920 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] 1 diff --git a/lisp/international/uni-category.el b/lisp/international/uni-category.el index f0ccde477cc..75ebc04c98f 100644 --- a/lisp/international/uni-category.el +++ b/lisp/international/uni-category.el @@ -5,7 +5,7 @@ (define-char-code-property 'general-category #^[30 nil char-code-property-table #^^[3 0 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 23 18 18 18 20 18 18 18 14 15 18 19 18 13 18 18 9 9 9 9 9 9 9 9 9 9 18 18 19 19 19 18 18 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 14 18 15 21 12 21 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 14 19 15 19 26] #^^[1 0 #^^[2 0 #^^[3 0 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 26 23 18 18 18 20 18 18 18 14 15 18 19 18 13 18 18 9 9 9 9 9 9 9 9 9 9 18 18 19 19 19 18 18 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 14 18 15 21 12 21 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 14 19 15 19 26] " " "" "" "±" "
" "ð " " £
" "°°" "
" " ¦ " "
" "
" "Ô " " ³" "¦ ¡
" "
¡" " · " "¶ " " " " " "
" "
" "
" "
" "
" " © " " " " ° ¤" "
" " ¤ " "
¤
¥"] #^^[2 4096 "« " " ¦
«" 5 5 "É " " ¡ ¨" " Ã " " Õ " "
ÿ" 5 5 5 "í" " Ë - " " " "´ " "
£´ " "©
Æ " "
" "¬ ¢" " µ " " Ò" "¯
" " ¬ " "¤
" " À " "¬¿" "¥§ " "" "" " " "
"] #^^[2 8192 "
" " " "
+ " " " "´ " "
£´ " "©
Æ " "
" "¬ ¢" " µ " " Ò" "¯
" " ¬ " "¤
" " À " "¬¿" "¥§ " "" "" " " "
"] #^^[2 8192 "
" " " "
" "
" 19 19 "Ñ" "¨ " "§ " " Î " 22 "·¶" "ï" 22 " ç " " ¬
" 22 22 19 "¿ " 19 19 "° ¦" 30 "¯ ¯ " "
" "¦
¸ " " " "
Ä" " Ù " 22 "Ö "] #^^[2 12288 " diff --git a/lisp/international/uni-name.el b/lisp/international/uni-name.el Binary files differindex 458957ef366..cf37db39b48 100644 --- a/lisp/international/uni-name.el +++ b/lisp/international/uni-name.el diff --git a/lisp/international/uni-numeric.el b/lisp/international/uni-numeric.el Binary files differindex 9f0d3079259..7c0be5b438a 100644 --- a/lisp/international/uni-numeric.el +++ b/lisp/international/uni-numeric.el diff --git a/lisp/iswitchb.el b/lisp/iswitchb.el index 624c3500939..13ab41cf83a 100644 --- a/lisp/iswitchb.el +++ b/lisp/iswitchb.el @@ -527,33 +527,6 @@ selected.") ;;; FUNCTIONS -;;; ISWITCHB KEYMAP -(defun iswitchb-define-mode-map () - "Set up the keymap for `iswitchb-buffer'." - (interactive) - (let (map) - ;; generated every time so that it can inherit new functions. - ;;(or iswitchb-mode-map - - (setq map (copy-keymap minibuffer-local-map)) - (define-key map "?" 'iswitchb-completion-help) - (define-key map "\C-s" 'iswitchb-next-match) - (define-key map "\C-r" 'iswitchb-prev-match) - (define-key map "\t" 'iswitchb-complete) - (define-key map "\C-j" 'iswitchb-select-buffer-text) - (define-key map "\C-t" 'iswitchb-toggle-regexp) - (define-key map "\C-x\C-f" 'iswitchb-find-file) - (define-key map "\C-n" 'iswitchb-toggle-ignore) - (define-key map "\C-c" 'iswitchb-toggle-case) - (define-key map "\C-k" 'iswitchb-kill-buffer) - (define-key map "\C-m" 'iswitchb-exit-minibuffer) - (setq iswitchb-mode-map map) - (run-hooks 'iswitchb-define-mode-map-hook))) - -(make-obsolete 'iswitchb-define-mode-map - "use M-x iswitchb-mode or customize the variable `iswitchb-mode'." - "21.1") - ;;; MAIN FUNCTION (defun iswitchb () "Switch to buffer matching a substring. @@ -619,14 +592,25 @@ If START is a string, the selection process is started with that string. If MATCHES-SET is non-nil, the buflist is not updated before the selection process begins. Used by isearchb.el." - (let - ( - buf-sel - iswitchb-final-text - (icomplete-mode nil) ;; prevent icomplete starting up - ) - - (iswitchb-define-mode-map) + ;; The map is generated every time so that it can inherit new + ;; functions. + (let ((map (copy-keymap minibuffer-local-map)) + buf-sel iswitchb-final-text map + icomplete-mode) ; prevent icomplete starting up + (define-key map "?" 'iswitchb-completion-help) + (define-key map "\C-s" 'iswitchb-next-match) + (define-key map "\C-r" 'iswitchb-prev-match) + (define-key map "\t" 'iswitchb-complete) + (define-key map "\C-j" 'iswitchb-select-buffer-text) + (define-key map "\C-t" 'iswitchb-toggle-regexp) + (define-key map "\C-x\C-f" 'iswitchb-find-file) + (define-key map "\C-n" 'iswitchb-toggle-ignore) + (define-key map "\C-c" 'iswitchb-toggle-case) + (define-key map "\C-k" 'iswitchb-kill-buffer) + (define-key map "\C-m" 'iswitchb-exit-minibuffer) + (setq iswitchb-mode-map map) + (run-hooks 'iswitchb-define-mode-map-hook) + (setq iswitchb-exit nil) (setq iswitchb-default (if (bufferp default) diff --git a/lisp/json.el b/lisp/json.el index f1ee3a52032..8167bfe93f2 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -311,13 +311,13 @@ representation will be parsed correctly." (setq char (json-encode-char0 char 'ucs)) (let ((control-char (car (rassoc char json-special-chars)))) (cond - ;; Special JSON character (\n, \r, etc.) + ;; Special JSON character (\n, \r, etc.). (control-char (format "\\%c" control-char)) - ;; ASCIIish printable character - ((and (> char 31) (< char 161)) + ;; ASCIIish printable character. + ((and (> char 31) (< char 127)) (format "%c" char)) - ;; Fallback: UCS code point in \uNNNN form + ;; Fallback: UCS code point in \uNNNN form. (t (format "\\u%04x" char))))) diff --git a/lisp/linum.el b/lisp/linum.el index 162dc19f437..3c278dbbf3b 100644 --- a/lisp/linum.el +++ b/lisp/linum.el @@ -44,7 +44,6 @@ "Show line numbers in the left margin." :group 'convenience) -;;;###autoload (defcustom linum-format 'dynamic "Format used to display line numbers. Either a format string like \"%7d\", `dynamic' to adapt the width @@ -52,7 +51,9 @@ as needed, or a function that is called with a line number as its argument and should evaluate to a string to be shown on that line. See also `linum-before-numbering-hook'." :group 'linum - :type 'sexp) + :type '(choice (string :tag "Format string") + (const :tag "Dynamic width" dynamic) + (function :tag "Function"))) (defface linum '((t :inherit (shadow default))) diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index ca9bc6b8676..0066847e995 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -248,6 +248,13 @@ usually do not have translators for other languages.\n\n"))) "', version " (mapconcat 'number-to-string (x-server-version) ".") "\n") (error t))) + (let ((lsb (with-temp-buffer + (if (eq 0 (ignore-errors + (call-process "lsb_release" nil '(t nil) + nil "-d"))) + (buffer-string))))) + (if (stringp lsb) + (insert "System " lsb "\n"))) (when (and system-configuration-options (not (equal system-configuration-options ""))) (insert "Configured using:\n `configure " diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el index 0b55fe42e42..c7943fe40c8 100644 --- a/lisp/mail/mailalias.el +++ b/lisp/mail/mailalias.el @@ -427,6 +427,7 @@ For use on `completion-at-point-functions'." "Perform completion on header field or word preceding point. Completable headers are according to `mail-complete-alist'. If none matches current header, calls `mail-complete-function' and passes prefix ARG if any." + (declare (obsolete mail-completion-at-point-function "24.1")) (interactive "P") ;; Read the defaults first, if we have not done so. (sendmail-sync-aliases) @@ -439,7 +440,6 @@ current header, calls `mail-complete-function' and passes prefix ARG if any." (if data (apply #'completion-in-region data) (funcall mail-complete-function arg)))) -(make-obsolete 'mail-complete 'mail-completion-at-point-function "24.1") (defun mail-completion-expand (table) "Build new completion table that expands aliases. diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index b75841489c9..331754fb1b5 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -1414,6 +1414,7 @@ just append to the file, in Babyl format if necessary." (defun mail-sent-via () "Make a Sent-via header line from each To or CC header line." + (declare (obsolete "nobody can remember what it is for." "24.1")) (interactive) (save-excursion ;; put a marker at the end of the header @@ -1433,9 +1434,6 @@ just append to the file, in Babyl format if necessary." (point))))) ;; Insert a copy, with altered header field name. (insert-before-markers "Sent-via:" to-line)))))) - -(make-obsolete 'mail-sent-via "nobody can remember what it is for." "24.1") - (defun mail-to () "Move point to end of To field, creating it if necessary." diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el index d10b073eb12..99e5df82bef 100644 --- a/lisp/mail/supercite.el +++ b/lisp/mail/supercite.el @@ -506,8 +506,6 @@ string." ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ;; end user configuration variables -(define-obsolete-variable-alias 'sc-version 'emacs-version "23.1") - (defvar sc-mail-info nil "Alist of mail header information gleaned from reply buffer.") (defvar sc-attributions nil @@ -559,10 +557,8 @@ string." (define-key map "r" 'sc-recite-region) (define-key map "\C-p" 'sc-raw-mode-toggle) (define-key map "u" 'sc-uncite-region) - (define-key map "v" 'sc-version) (define-key map "w" 'sc-insert-reference) (define-key map "\C-t" sc-T-keymap) - (define-key map "\C-b" 'sc-submit-bug-report) (define-key map "?" 'sc-describe) map) "Keymap for Supercite quasi-mode.") @@ -1969,29 +1965,11 @@ cited." (insert (sc-mail-field "sc-citation")) (error "Line is already cited")))) -;; The argument logic here is crazy. -(defun sc-version (message) - "Return the current Supercite version. -If MESSAGE is non-nil (interactively, with no prefix argument), -echoes the version in the minibuffer. Otherwise, inserts the -version at point." - (interactive (list (not current-prefix-arg))) - (let ((verstr (format "Using Supercite.el %s" emacs-version))) - (if message - (message verstr) - (insert "`sc-version' says: " verstr)))) - -(make-obsolete 'sc-version 'emacs-version "23.1") - (defun sc-describe () "Read the Supercite info node." (interactive) (info "(SC)top")) -(make-obsolete 'sc-describe "read the SC manual using `info'." "23.1") - -(define-obsolete-function-alias 'sc-submit-bug-report 'report-emacs-bug "23.1") - ;; useful stuff (provide 'supercite) diff --git a/lisp/mh-e/ChangeLog.1 b/lisp/mh-e/ChangeLog.1 index 15b7380b737..eb60392c32c 100644 --- a/lisp/mh-e/ChangeLog.1 +++ b/lisp/mh-e/ChangeLog.1 @@ -10930,7 +10930,7 @@ * mh-utils.el (mh-prompt-for-folder): Exit with error if no folder specified, otherwise mh-refile-msg may try to create a folder with - empty name, and this creates problems; even mh-undo can't handle + empty name, and this creates problems; even mh-undo can't handle it (Closes SF #476824). * mh-comp.el (mh-letter-tool-bar-map): Info button needed to diff --git a/lisp/minibuf-eldef.el b/lisp/minibuf-eldef.el index 4387fc625c6..92d5ec821b0 100644 --- a/lisp/minibuf-eldef.el +++ b/lisp/minibuf-eldef.el @@ -1,4 +1,4 @@ -;;; minibuf-eldef.el --- Only show defaults in prompts when applicable +;;; minibuf-eldef.el --- Only show defaults in prompts when applicable -*- lexical-binding: t -*- ;; ;; Copyright (C) 2000-2012 Free Software Foundation, Inc. ;; @@ -33,16 +33,22 @@ ;;; Code: +(defvar minibuffer-eldef-shorten-default nil + "If non-nil, shorten \"(default ...)\" to \"[...]\" in minibuffer prompts.") + (defvar minibuffer-default-in-prompt-regexps - '(("\\( (default\\>.*)\\):? \\'" . 1) ("\\( \\[.*\\]\\):? *\\'" . 1)) + `(("\\( (default\\(?: is\\)? \\(.*\\))\\):? \\'" + 1 ,(if minibuffer-eldef-shorten-default " [\\2]")) + ("\\( \\[.*\\]\\):? *\\'" 1)) "A list of regexps matching the parts of minibuffer prompts showing defaults. When `minibuffer-electric-default-mode' is active, these regexps are used to identify the portions of prompts to elide. -Each entry is either a string, which should be a regexp matching the -default portion of the prompt, or a cons cell, who's car is a regexp -matching the default part of the prompt, and who's cdr indicates the -regexp subexpression that matched.") +Each entry is of the form (REGEXP MATCH-NUM &optional REWRITE), +where REGEXP should match the default part of the prompt, +MATCH-NUM is the subgroup that matched the actual default indicator, +and REWRITE, if present, is a string to pass to `replace-match' that +should be displayed in its place.") ;;; Internal variables @@ -79,21 +85,42 @@ The prompt and initial input should already have been inserted." (inhibit-point-motion-hooks t)) (save-excursion (save-restriction - ;; Narrow to only the prompt + ;; Narrow to only the prompt. (goto-char (point-min)) (narrow-to-region (point) (minibuffer-prompt-end)) - ;; See the prompt contains a default input indicator + ;; See if the prompt contains a default input indicator. (while regexps (setq match (pop regexps)) - (if (re-search-forward (if (stringp match) match (car match)) nil t) - (setq regexps nil) - (setq match nil))))) + (cond + ((not (re-search-forward (if (stringp match) match (car match)) + nil t)) + ;; No match yet, try the next rule. + (setq match nil)) + ((and (consp (cdr-safe match)) (nth 2 match)) + ;; Matched a replacement rule. + (let* ((inhibit-read-only t) + (buffer-undo-list t) + (submatch (nth 1 match)) + (replacement (nth 2 match)) + (props (text-properties-at (match-beginning submatch)))) + (replace-match replacement nil nil nil submatch) + (set-text-properties (match-beginning submatch) + (match-end submatch) + props) + ;; Replacement done, now keep trying with subsequent rules. + (setq match nil) + (goto-char (point-min)))) + ;; Matched a non-replacement (i.e. electric hide) rule, no need to + ;; keep trying. + (t (setq regexps nil)))))) (if (not match) - ;; Nope, so just make sure our post-command-hook isn't left around. + ;; No match for electric hiding, so just make sure our + ;; post-command-hook isn't left around. (remove-hook 'post-command-hook #'minibuf-eldef-update-minibuffer t) ;; Yup; set things up so we can frob the prompt as the state of ;; the input string changes. (setq match (if (consp match) (cdr match) 0)) + (setq match (if (consp match) (car match) match)) (setq minibuf-eldef-overlay (make-overlay (match-beginning match) (match-end match))) (setq minibuf-eldef-showing-default-in-prompt t) @@ -124,10 +151,6 @@ been set up by `minibuf-eldef-setup-minibuffer'." (overlay-put minibuf-eldef-overlay 'intangible t))))) -;;; Note this definition must be at the end of the file, because -;;; `define-minor-mode' actually calls the mode-function if the -;;; associated variable is non-nil, which requires that all needed -;;; functions be already defined. [This is arguably a bug in d-m-m] ;;;###autoload (define-minor-mode minibuffer-electric-default-mode "Toggle Minibuffer Electric Default mode. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 27c53744d54..cf990019abc 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2332,7 +2332,7 @@ and `read-file-name-function'." (modify-syntax-entry c "." table)) '(?/ ?: ?\\)) table) - "Syntax table to be used in minibuffer for reading file name.") + "Syntax table used when reading a file name in the minibuffer.") ;; minibuffer-completing-file-name is a variable used internally in minibuf.c ;; to determine whether to use minibuffer-local-filename-completion-map or diff --git a/lisp/mouse.el b/lisp/mouse.el index 4ea84288f69..74bb97b3086 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -284,23 +284,24 @@ not it is actually displayed." (defun mouse-major-mode-menu (event &optional prefix) "Pop up a mode-specific menu of mouse commands. Default to the Edit menu if the major mode doesn't define a menu." + (declare (obsolete mouse-menu-major-mode-map "23.1")) (interactive "@e\nP") (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) (popup-menu (mouse-menu-major-mode-map) event prefix)) -(make-obsolete 'mouse-major-mode-menu 'mouse-menu-major-mode-map "23.1") (defun mouse-popup-menubar (event prefix) "Pop up a menu equivalent to the menu bar for keyboard EVENT with PREFIX. The contents are the items that would be in the menu bar whether or not it is actually displayed." + (declare (obsolete mouse-menu-bar-map "23.1")) (interactive "@e \nP") (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) (popup-menu (mouse-menu-bar-map) (unless (integerp event) event) prefix)) -(make-obsolete 'mouse-popup-menubar 'mouse-menu-bar-map "23.1") (defun mouse-popup-menubar-stuff (event prefix) "Popup a menu like either `mouse-major-mode-menu' or `mouse-popup-menubar'. Use the former if the menu bar is showing, otherwise the latter." + (declare (obsolete nil "23.1")) (interactive "@e\nP") (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) (popup-menu @@ -308,7 +309,6 @@ Use the former if the menu bar is showing, otherwise the latter." (mouse-menu-bar-map) (mouse-menu-major-mode-map)) event prefix)) -(make-obsolete 'mouse-popup-menubar-stuff nil "23.1") ;; Commands that operate on windows. diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index c78249ced0f..bc6fd38f713 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -421,7 +421,7 @@ headline after it has been retrieved for the first time." "Name of the newsticker cache file." :type 'string :group 'newsticker-miscellaneous) -(make-obsolete 'newsticker-cache-filename 'newsticker-dir "23.1") +(make-obsolete-variable 'newsticker-cache-filename 'newsticker-dir "23.1") (defcustom newsticker-dir (locate-user-emacs-file "newsticker/" ".newsticker/") diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el index b44f1f9c86d..fc356a303e2 100644 --- a/lisp/net/newst-treeview.el +++ b/lisp/net/newst-treeview.el @@ -128,7 +128,7 @@ Example: (\"Topmost group\" \"feed1\" (\"subgroup1\" \"feed 2\") "Name of the newsticker groups settings file." :type 'string :group 'newsticker-treeview) -(make-obsolete 'newsticker-groups-filename 'newsticker-dir "23.1") +(make-obsolete-variable 'newsticker-groups-filename 'newsticker-dir "23.1") ;; ====================================================================== ;;; internal variables diff --git a/lisp/net/snmp-mode.el b/lisp/net/snmp-mode.el index c155d53b6d0..217f9dc8b30 100644 --- a/lisp/net/snmp-mode.el +++ b/lisp/net/snmp-mode.el @@ -175,9 +175,9 @@ This is used during Tempo template completion." (defvar snmp-font-lock-keywords-3 (append '(("\\([^\n]+\\)[ \t]+::=[ \t]+\\(SEQUENCE\\)[ \t]+{" - (1 font-lock-reference-face) (2 font-lock-keyword-face)) + (1 font-lock-constant-face) (2 font-lock-keyword-face)) ("::=[ \t]*{[ \t]*\\([a-z0-9].*[ \t]+\\)?\\([0-9]+\\)[ \t]*}" - (1 font-lock-reference-face nil t) (2 font-lock-variable-name-face))) + (1 font-lock-constant-face nil t) (2 font-lock-variable-name-face))) snmp-font-lock-keywords-2) "Gaudy SNMP MIB mode expression highlighting.") diff --git a/lisp/org/ob-fortran.el b/lisp/org/ob-fortran.el index 491dde3e070..fe38edbce1e 100644 --- a/lisp/org/ob-fortran.el +++ b/lisp/org/ob-fortran.el @@ -7,20 +7,20 @@ ;; Keywords: literate programming, reproducible research, fortran ;; Homepage: http://orgmode.org -;; This program is free software; you can redistribute it and/or modify +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. -;; + ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/password-cache.el b/lisp/password-cache.el index 9f5c18f3415..83815a6a270 100644 --- a/lisp/password-cache.el +++ b/lisp/password-cache.el @@ -102,13 +102,12 @@ Warning: the password is cached without checking that it is correct. It is better to check the password before caching. If you must use this function, take care to check passwords and remove incorrect ones from the cache." + (declare (obsolete password-read "23.1")) (let ((password (password-read prompt key))) (when (and password key) (password-cache-add key password)) password)) -(make-obsolete 'password-read-and-add 'password-read "23.1") - (defun password-cache-remove (key) "Remove password indexed by KEY from password cache. This is typically run by a timer setup from `password-cache-add', diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 3f120961486..9e55976a8bd 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -724,6 +724,7 @@ this is `comint-dynamic-complete-functions'." (defun pcomplete-parse-comint-arguments () "Parse whitespace separated arguments in the current region." + (declare (obsolete comint-parse-pcomplete-arguments "24.1")) (let ((begin (save-excursion (comint-bol nil) (point))) (end (point)) begins args) @@ -743,8 +744,6 @@ this is `comint-dynamic-complete-functions'." (push (buffer-substring-no-properties (car begins) (point)) args)) (cons (nreverse args) (nreverse begins))))) -(make-obsolete 'pcomplete-parse-comint-arguments - 'comint-parse-pcomplete-arguments "24.1") (defun pcomplete-parse-arguments (&optional expand-p) "Parse the command line arguments. Most completions need this info." @@ -1090,7 +1089,7 @@ Typing SPC flushes the help buffer." (setq pcomplete-last-window-config (current-window-configuration))) (with-output-to-temp-buffer "*Completions*" (display-completion-list completions)) - (message "Hit space to flush") + (minibuffer-message "Hit space to flush") (let (event) (prog1 (catch 'done diff --git a/lisp/proced.el b/lisp/proced.el index d98bf7d2c5b..be6cae2ef08 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -28,8 +28,11 @@ ;; listed. See `proced-mode' for getting started. ;; ;; To do: -;; - interactive temporary customizability of flags in `proced-grammar-alist' -;; - allow "sudo kill PID", "renice PID" +;; - Interactive temporary customizability of flags in `proced-grammar-alist' +;; - Allow "sudo kill PID", "sudo renice PID" +;; `proced-send-signal' operates on multiple processes one by one. +;; With "sudo" we want to execute one "kill" or "renice" command +;; for all marked processes. Is there a `sudo-call-process'? ;; ;; Thoughts and Ideas ;; - Currently, `process-attributes' returns the list of @@ -62,6 +65,11 @@ the external command (usually \"kill\")." :type '(choice (function :tag "function") (string :tag "command"))) +(defcustom proced-renice-command "renice" + "Name of renice command." + :group 'proced + :type '(string :tag "command")) + (defcustom proced-signal-list '( ;; signals supported on all POSIX compliant systems ("HUP" . " (1. Hangup)") @@ -491,6 +499,7 @@ Important: the match ends just after the marker.") (define-key km "o" 'proced-omit-processes) (define-key km "x" 'proced-send-signal) ; Dired compatibility (define-key km "k" 'proced-send-signal) ; kill processes + (define-key km "r" 'proced-renice) ; renice processes ;; misc (define-key km "h" 'describe-mode) (define-key km "?" 'proced-help) @@ -561,8 +570,11 @@ Important: the match ends just after the marker.") :style toggle :selected (eval proced-auto-update-flag) :help "Auto Update of Proced Buffer"] + "--" ["Send signal" proced-send-signal - :help "Send Signal to Marked Processes"])) + :help "Send Signal to Marked Processes"] + ["Renice" proced-renice + :help "Renice Marked Processes"])) ;; helper functions (defun proced-marker-regexp () @@ -1686,14 +1698,11 @@ After updating a displayed Proced buffer run the normal hook Preserves point and marks." (proced-update t)) -(defun proced-send-signal (&optional signal) - "Send a SIGNAL to the marked processes. -If no process is marked, operate on current process. -SIGNAL may be a string (HUP, INT, TERM, etc.) or a number. -If SIGNAL is nil display marked processes and query interactively for SIGNAL. -After sending the signal, this command runs the normal hook -`proced-after-send-signal-hook'." - (interactive) +(defun proced-marked-processes () + "Return marked processes as alist of PIDs. +If no process is marked return alist with the PID of the process point is on. +The cdrs of the alist are the text strings displayed by Proced for these +processes. They are used for error messages." (let ((regexp (proced-marker-regexp)) process-alist) ;; collect marked processes @@ -1706,102 +1715,183 @@ After sending the signal, this command runs the normal hook (+ 2 (line-beginning-position)) (line-end-position))) process-alist))) - (setq process-alist - (if process-alist - (nreverse process-alist) - ;; take current process - (list (cons (proced-pid-at-point) + (if process-alist + (nreverse process-alist) + ;; take current process + (let ((pid (proced-pid-at-point))) + (if pid + (list (cons pid (buffer-substring-no-properties (+ 2 (line-beginning-position)) - (line-end-position)))))) + (line-end-position))))))))) + +(defmacro proced-with-processes-buffer (process-alist &rest body) + "Execute the forms in BODY in a temporary buffer displaying PROCESS-ALIST. +PROCESS-ALIST is an alist of process PIDs as in `proced-process-alist'. +The value returned is the value of the last form in BODY." + (declare (indent 1) (debug t)) + ;; Use leading space in buffer name to make this buffer ephemeral + `(let ((bufname " *Marked Processes*") + (header-line (substring-no-properties proced-header-line))) + (with-current-buffer (get-buffer-create bufname) + (setq truncate-lines t + proced-header-line header-line ; inherit header line + header-line-format '(:eval (proced-header-line))) + (add-hook 'post-command-hook 'force-mode-line-update nil t) + (let ((inhibit-read-only t)) + (erase-buffer) + (buffer-disable-undo) + (setq buffer-read-only t) + (dolist (process ,process-alist) + (insert " " (cdr process) "\n")) + (delete-char -1) + (goto-char (point-min))) + (save-window-excursion + ;; Analogous to `dired-pop-to-buffer' + ;; Don't split window horizontally. (Bug#1806) + (let (split-width-threshold) + (pop-to-buffer (current-buffer))) + (fit-window-to-buffer (get-buffer-window) nil 1) + ,@body)))) + +(defun proced-send-signal (&optional signal process-alist) + "Send a SIGNAL to processes in PROCESS-ALIST. +PROCESS-ALIST is an alist as returned by `proced-marked-processes'. +Interactively, PROCESS-ALIST contains the marked processes. +If no process is marked, it contains the process point is on, +SIGNAL may be a string (HUP, INT, TERM, etc.) or a number. +After sending SIGNAL to all processes in PROCESS-ALIST, this command +runs the normal hook `proced-after-send-signal-hook'. + +For backward compatibility SIGNAL and PROCESS-ALIST may be nil. +Then PROCESS-ALIST contains the marked processes or the process point is on +and SIGNAL is queried interactively. This noninteractive usage is still +supported but discouraged. It will be removed in a future version of Emacs." + (interactive + (let* ((process-alist (proced-marked-processes)) + (pnum (if (= 1 (length process-alist)) + "1 process" + (format "%d processes" (length process-alist)))) + (completion-ignore-case t) + (completion-extra-properties + '(:annotation-function + (lambda (s) (cdr (assoc s proced-signal-list)))))) + (proced-with-processes-buffer process-alist + (list (completing-read (concat "Send signal [" pnum + "] (default TERM): ") + proced-signal-list + nil nil nil nil "TERM") + process-alist)))) + + (unless (and signal process-alist) + ;; Discouraged usge (supported for backward compatibility): + ;; The new calling sequence separates more cleanly between the parts + ;; of the code required for interactive and noninteractive calls so that + ;; the command can be used more flexibly in noninteractive ways, too. + (unless (get 'proced-send-signal 'proced-outdated) + (put 'proced-send-signal 'proced-outdated t) + (message "Outdated usage of `proced-send-signal'") + (sit-for 2)) + (setq process-alist (proced-marked-processes)) (unless signal - ;; Display marked processes (code taken from `dired-mark-pop-up'). - (let ((bufname " *Marked Processes*") ; use leading space in buffer name - ; to make this buffer ephemeral - (header-line (substring-no-properties proced-header-line))) - (with-current-buffer (get-buffer-create bufname) - (setq truncate-lines t - proced-header-line header-line ; inherit header line - header-line-format '(:eval (proced-header-line))) - (add-hook 'post-command-hook 'force-mode-line-update nil t) - (let ((inhibit-read-only t)) - (erase-buffer) - (buffer-disable-undo) - (setq buffer-read-only t) - (dolist (process process-alist) - (insert " " (cdr process) "\n")) - (delete-char -1) - (goto-char (point-min))) - (save-window-excursion - ;; Analogous to `dired-pop-to-buffer' - ;; Don't split window horizontally. (Bug#1806) - (let (split-width-threshold) - (pop-to-buffer (current-buffer))) - (fit-window-to-buffer (get-buffer-window) nil 1) - (let* ((completion-ignore-case t) - (pnum (if (= 1 (length process-alist)) - "1 process" - (format "%d processes" (length process-alist)))) - (completion-extra-properties - '(:annotation-function - (lambda (s) (cdr (assoc s proced-signal-list)))))) - (setq signal - (completing-read (concat "Send signal [" pnum - "] (default TERM): ") - proced-signal-list - nil nil nil nil "TERM"))))))) - ;; send signal - (let ((count 0) - failures) - ;; Why not always use `signal-process'? See - ;; http://lists.gnu.org/archive/html/emacs-devel/2008-03/msg02955.html - (if (functionp proced-signal-function) - ;; use built-in `signal-process' - (let ((signal (if (stringp signal) - (if (string-match "\\`[0-9]+\\'" signal) - (string-to-number signal) - (make-symbol signal)) - signal))) ; number - (dolist (process process-alist) - (condition-case err - (if (zerop (funcall - proced-signal-function (car process) signal)) - (setq count (1+ count)) - (proced-log "%s\n" (cdr process)) - (push (cdr process) failures)) - (error ; catch errors from failed signals - (proced-log "%s\n" err) - (proced-log "%s\n" (cdr process)) - (push (cdr process) failures))))) - ;; use external system call - (let ((signal (concat "-" (if (numberp signal) - (number-to-string signal) signal)))) + (let ((pnum (if (= 1 (length process-alist)) + "1 process" + (format "%d processes" (length process-alist)))) + (completion-ignore-case t) + (completion-extra-properties + '(:annotation-function + (lambda (s) (cdr (assoc s proced-signal-list)))))) + (proced-with-processes-buffer process-alist + (setq signal (completing-read (concat "Send signal [" pnum + "] (default TERM): ") + proced-signal-list + nil nil nil nil "TERM")))))) + + (let (failures) + ;; Why not always use `signal-process'? See + ;; http://lists.gnu.org/archive/html/emacs-devel/2008-03/msg02955.html + (if (functionp proced-signal-function) + ;; use built-in `signal-process' + (let ((signal (if (stringp signal) + (if (string-match "\\`[0-9]+\\'" signal) + (string-to-number signal) + (make-symbol signal)) + signal))) ; number (dolist (process process-alist) - (with-temp-buffer - (condition-case nil - (if (zerop (call-process - proced-signal-function nil t nil - signal (number-to-string (car process)))) - (setq count (1+ count)) - (proced-log (current-buffer)) - (proced-log "%s\n" (cdr process)) - (push (cdr process) failures)) - (error ; catch errors from failed signals - (proced-log (current-buffer)) - (proced-log "%s\n" (cdr process)) - (push (cdr process) failures))))))) - (if failures - ;; Proced error message are not always very precise. - ;; Can we issue a useful one-line summary in the - ;; message area (using FAILURES) if only one signal failed? - (proced-log-summary - signal - (format "%d of %d signal%s failed" - (length failures) (length process-alist) - (if (= 1 (length process-alist)) "" "s"))) - (proced-success-message "Sent signal to" count))) - ;; final clean-up - (run-hooks 'proced-after-send-signal-hook))) + (condition-case err + (unless (zerop (funcall + proced-signal-function (car process) signal)) + (proced-log "%s\n" (cdr process)) + (push (cdr process) failures)) + (error ; catch errors from failed signals + (proced-log "%s\n" err) + (proced-log "%s\n" (cdr process)) + (push (cdr process) failures))))) + ;; use external system call + (let ((signal (format "-%s" signal))) + (dolist (process process-alist) + (with-temp-buffer + (condition-case nil + (unless (zerop (call-process + proced-signal-function nil t nil + signal (number-to-string (car process)))) + (proced-log (current-buffer)) + (proced-log "%s\n" (cdr process)) + (push (cdr process) failures)) + (error ; catch errors from failed signals + (proced-log (current-buffer)) + (proced-log "%s\n" (cdr process)) + (push (cdr process) failures))))))) + (if failures + ;; Proced error message are not always very precise. + ;; Can we issue a useful one-line summary in the + ;; message area (using FAILURES) if only one signal failed? + (proced-log-summary + (format "Signal %s" signal) + (format "%d of %d signal%s failed" + (length failures) (length process-alist) + (if (= 1 (length process-alist)) "" "s"))) + (proced-success-message "Sent signal to" (length process-alist)))) + ;; final clean-up + (run-hooks 'proced-after-send-signal-hook)) + +(defun proced-renice (priority process-alist) + "Renice the processes in PROCESS-ALIST to PRIORITY. +PROCESS-ALIST is an alist as returned by `proced-marked-processes'. +Interactively, PROCESS-ALIST contains the marked processes. +If no process is marked, it contains the process point is on, +After renicing all processes in PROCESS-ALIST, this command runs +the normal hook `proced-after-send-signal-hook'." + (interactive + (let ((process-alist (proced-marked-processes))) + (proced-with-processes-buffer process-alist + (list (read-number "New priority: ") + process-alist)))) + (if (numberp priority) + (setq priority (number-to-string priority))) + (let (failures) + (dolist (process process-alist) + (with-temp-buffer + (condition-case nil + (unless (zerop (call-process + proced-renice-command nil t nil + priority (number-to-string (car process)))) + (proced-log (current-buffer)) + (proced-log "%s\n" (cdr process)) + (push (cdr process) failures)) + (error ; catch errors from failed renice + (proced-log (current-buffer)) + (proced-log "%s\n" (cdr process)) + (push (cdr process) failures))))) + (if failures + (proced-log-summary + (format "Renice %s" priority) + (format "%d of %d renice%s failed" + (length failures) (length process-alist) + (if (= 1 (length process-alist)) "" "s"))) + (proced-success-message "Reniced" (length process-alist)))) + ;; final clean-up + (run-hooks 'proced-after-send-signal-hook)) ;; similar to `dired-why' (defun proced-why () diff --git a/lisp/profiler.el b/lisp/profiler.el new file mode 100644 index 00000000000..5fc74573262 --- /dev/null +++ b/lisp/profiler.el @@ -0,0 +1,665 @@ +;;; profiler.el --- UI and helper functions for Emacs's native profiler -*- lexical-binding: t -*- + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; Author: Tomohiro Matsuyama <tomo@cx4a.org> +;; Keywords: lisp + +;; 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: + +(eval-when-compile + (require 'cl-lib)) + +(defgroup profiler nil + "Emacs profiler." + :group 'lisp + :prefix "profiler-") + +(defcustom profiler-sample-interval 1 + "Default sample interval in millisecond." + :type 'integer + :group 'profiler) + +;;; Utilities + +(defun profiler-ensure-string (object) + (cond ((stringp object) + object) + ((symbolp object) + (symbol-name object)) + ((numberp object) + (number-to-string object)) + (t + (format "%s" object)))) + +(defun profiler-format (fmt &rest args) + (cl-loop for (width align subfmt) in fmt + for arg in args + for str = (cond + ((consp subfmt) + (apply 'profiler-format subfmt arg)) + ((stringp subfmt) + (format subfmt arg)) + ((and (symbolp subfmt) + (fboundp subfmt)) + (funcall subfmt arg)) + (t + (profiler-ensure-string arg))) + for len = (length str) + if (< width len) + collect (substring str 0 width) into frags + else + collect + (let ((padding (make-string (- width len) ?\s))) + (cl-ecase align + (left (concat str padding)) + (right (concat padding str)))) + into frags + finally return (apply #'concat frags))) + +(defun profiler-format-percent (number divisor) + (concat (number-to-string (/ (* number 100) divisor)) "%")) + +(defun profiler-format-nbytes (nbytes) + "Format NBYTES in humarn readable string." + (if (and (integerp nbytes) (> nbytes 0)) + (cl-loop with i = (% (1+ (floor (log10 nbytes))) 3) + for c in (append (number-to-string nbytes) nil) + if (= i 0) + collect ?, into s + and do (setq i 3) + collect c into s + do (cl-decf i) + finally return + (apply 'string (if (eq (car s) ?,) (cdr s) s))) + (profiler-ensure-string nbytes))) + + +;;; Entries + +(defun profiler-entry-format (entry) + "Format ENTRY in human readable string. ENTRY would be a +function name of a function itself." + (cond ((memq (car-safe entry) '(closure lambda)) + (format "#<lambda 0x%x>" (sxhash entry))) + ((byte-code-function-p entry) + (format "#<compiled 0x%x>" (sxhash entry))) + ((or (subrp entry) (symbolp entry) (stringp entry)) + (format "%s" entry)) + (t + (format "#<unknown 0x%x>" (sxhash entry))))) + +;;; Log data structure + +;; The C code returns the log in the form of a hash-table where the keys are +;; vectors (of size profiler-max-stack-depth, holding truncated +;; backtraces, where the first element is the top of the stack) and +;; the values are integers (which count how many times this backtrace +;; has been seen, multiplied by a "weight factor" which is either the +;; sample-interval or the memory being allocated). +;; We extend it by adding a few other entries to the hash-table, most notably: +;; - Key `type' has a value indicating the kind of log (`memory' or `cpu'). +;; - Key `timestamp' has a value giving the time when the log was obtained. +;; - Key `diff-p' indicates if this log represents a diff between two logs. + +(defun profiler-log-timestamp (log) (gethash 'timestamp log)) +(defun profiler-log-type (log) (gethash 'type log)) +(defun profiler-log-diff-p (log) (gethash 'diff-p log)) + +(defun profiler-log-diff (log1 log2) + "Compare LOG1 with LOG2 and return a diff log. Both logs must +be same type." + (unless (eq (profiler-log-type log1) + (profiler-log-type log2)) + (error "Can't compare different type of logs")) + (let ((newlog (make-hash-table :test 'equal))) + ;; Make a copy of `log1' into `newlog'. + (maphash (lambda (backtrace count) (puthash backtrace count newlog)) + log1) + (puthash 'diff-p t newlog) + (maphash (lambda (backtrace count) + (when (vectorp backtrace) + (puthash backtrace (- (gethash backtrace log1 0) count) + newlog))) + log2) + newlog)) + +(defun profiler-log-fixup-entry (entry) + (if (symbolp entry) + entry + (profiler-entry-format entry))) + +(defun profiler-log-fixup-backtrace (backtrace) + (mapcar 'profiler-log-fixup-entry backtrace)) + +(defun profiler-log-fixup (log) + "Fixup LOG so that the log could be serialized into file." + (let ((newlog (make-hash-table :test 'equal))) + (maphash (lambda (backtrace count) + (puthash (if (not (vectorp backtrace)) + backtrace + (profiler-log-fixup-backtrace backtrace)) + count newlog)) + log) + newlog)) + +(defun profiler-log-write-file (log filename &optional confirm) + "Write LOG into FILENAME." + (with-temp-buffer + (let (print-level print-length) + (print (profiler-log-fixup log) (current-buffer))) + (write-file filename confirm))) + +(defun profiler-log-read-file (filename) + "Read log from FILENAME." + (with-temp-buffer + (insert-file-contents filename) + (goto-char (point-min)) + (read (current-buffer)))) + + +;;; Calltree data structure + +(cl-defstruct (profiler-calltree (:constructor profiler-make-calltree)) + entry + (count 0) (count-percent "") + parent children) + +(defun profiler-calltree-leaf-p (tree) + (null (profiler-calltree-children tree))) + +(defun profiler-calltree-count< (a b) + (cond ((eq (profiler-calltree-entry a) t) t) + ((eq (profiler-calltree-entry b) t) nil) + (t (< (profiler-calltree-count a) + (profiler-calltree-count b))))) + +(defun profiler-calltree-count> (a b) + (not (profiler-calltree-count< a b))) + +(defun profiler-calltree-depth (tree) + (let ((parent (profiler-calltree-parent tree))) + (if (null parent) + 0 + (1+ (profiler-calltree-depth parent))))) + +(defun profiler-calltree-find (tree entry) + "Return a child tree of ENTRY under TREE." + ;; OPTIMIZED + (let (result (children (profiler-calltree-children tree))) + ;; FIXME: Use `assoc'. + (while (and children (null result)) + (let ((child (car children))) + (when (equal (profiler-calltree-entry child) entry) + (setq result child)) + (setq children (cdr children)))) + result)) + +(defun profiler-calltree-walk (calltree function) + (funcall function calltree) + (dolist (child (profiler-calltree-children calltree)) + (profiler-calltree-walk child function))) + +(defun profiler-calltree-build-1 (tree log &optional reverse) + ;; FIXME: Do a better job of reconstructing a complete call-tree + ;; when the backtraces have been truncated. Ideally, we should be + ;; able to reduce profiler-max-stack-depth to 3 or 4 and still + ;; get a meaningful call-tree. + (maphash + (lambda (backtrace count) + (when (vectorp backtrace) + (let ((node tree) + (max (length backtrace))) + (dotimes (i max) + (let ((entry (aref backtrace (if reverse i (- max i 1))))) + (when entry + (let ((child (profiler-calltree-find node entry))) + (unless child + (setq child (profiler-make-calltree + :entry entry :parent node)) + (push child (profiler-calltree-children node))) + (cl-incf (profiler-calltree-count child) count) + (setq node child)))))))) + log)) + +(defun profiler-calltree-compute-percentages (tree) + (let ((total-count 0)) + ;; FIXME: the memory profiler's total wraps around all too easily! + (dolist (child (profiler-calltree-children tree)) + (cl-incf total-count (profiler-calltree-count child))) + (unless (zerop total-count) + (profiler-calltree-walk + tree (lambda (node) + (setf (profiler-calltree-count-percent node) + (profiler-format-percent (profiler-calltree-count node) + total-count))))))) + +(cl-defun profiler-calltree-build (log &key reverse) + (let ((tree (profiler-make-calltree))) + (profiler-calltree-build-1 tree log reverse) + (profiler-calltree-compute-percentages tree) + tree)) + +(defun profiler-calltree-sort (tree predicate) + (let ((children (profiler-calltree-children tree))) + (setf (profiler-calltree-children tree) (sort children predicate)) + (dolist (child (profiler-calltree-children tree)) + (profiler-calltree-sort child predicate)))) + + +;;; Report rendering + +(defcustom profiler-report-closed-mark "+" + "An indicator of closed calltrees." + :type 'string + :group 'profiler) + +(defcustom profiler-report-open-mark "-" + "An indicator of open calltrees." + :type 'string + :group 'profiler) + +(defcustom profiler-report-leaf-mark " " + "An indicator of calltree leaves." + :type 'string + :group 'profiler) + +(defvar profiler-report-sample-line-format + '((60 left) + (14 right ((9 right) + (5 right))))) + +(defvar profiler-report-memory-line-format + '((55 left) + (19 right ((14 right profiler-format-nbytes) + (5 right))))) + +(defvar-local profiler-report-log nil + "The current profiler log.") + +(defvar-local profiler-report-reversed nil + "True if calltree is rendered in bottom-up. Do not touch this +variable directly.") + +(defvar-local profiler-report-order nil + "The value can be `ascending' or `descending'. Do not touch +this variable directly.") + +(defun profiler-report-make-entry-part (entry) + (let ((string (cond + ((eq entry t) + "Others") + ((and (symbolp entry) + (fboundp entry)) + (propertize (symbol-name entry) + 'face 'link + 'mouse-face 'highlight + 'help-echo "mouse-2 or RET jumps to definition")) + (t + (profiler-entry-format entry))))) + (propertize string 'profiler-entry entry))) + +(defun profiler-report-make-name-part (tree) + (let* ((entry (profiler-calltree-entry tree)) + (depth (profiler-calltree-depth tree)) + (indent (make-string (* (1- depth) 2) ?\s)) + (mark (if (profiler-calltree-leaf-p tree) + profiler-report-leaf-mark + profiler-report-closed-mark)) + (entry (profiler-report-make-entry-part entry))) + (format "%s%s %s" indent mark entry))) + +(defun profiler-report-header-line-format (fmt &rest args) + (let* ((header (apply 'profiler-format fmt args)) + (escaped (replace-regexp-in-string "%" "%%" header))) + (concat " " escaped))) + +(defun profiler-report-line-format (tree) + (let ((diff-p (profiler-log-diff-p profiler-report-log)) + (name-part (profiler-report-make-name-part tree)) + (count (profiler-calltree-count tree)) + (count-percent (profiler-calltree-count-percent tree))) + (profiler-format (cl-ecase (profiler-log-type profiler-report-log) + (cpu profiler-report-sample-line-format) + (memory profiler-report-memory-line-format)) + name-part + (if diff-p + (list (if (> count 0) + (format "+%s" count) + count) + "") + (list count count-percent))))) + +(defun profiler-report-insert-calltree (tree) + (let ((line (profiler-report-line-format tree))) + (insert (propertize (concat line "\n") 'calltree tree)))) + +(defun profiler-report-insert-calltree-children (tree) + (mapc 'profiler-report-insert-calltree + (profiler-calltree-children tree))) + + +;;; Report mode + +(defvar profiler-report-mode-map + (let ((map (make-sparse-keymap))) + ;; FIXME: Add menu. + (define-key map "n" 'profiler-report-next-entry) + (define-key map "p" 'profiler-report-previous-entry) + ;; I find it annoying more than helpful to not be able to navigate + ;; normally with the cursor keys. --Stef + ;; (define-key map [down] 'profiler-report-next-entry) + ;; (define-key map [up] 'profiler-report-previous-entry) + (define-key map "\r" 'profiler-report-toggle-entry) + (define-key map "\t" 'profiler-report-toggle-entry) + (define-key map "i" 'profiler-report-toggle-entry) + (define-key map "f" 'profiler-report-find-entry) + (define-key map "j" 'profiler-report-find-entry) + (define-key map [mouse-2] 'profiler-report-find-entry) + (define-key map "d" 'profiler-report-describe-entry) + (define-key map "C" 'profiler-report-render-calltree) + (define-key map "B" 'profiler-report-render-reversed-calltree) + (define-key map "A" 'profiler-report-ascending-sort) + (define-key map "D" 'profiler-report-descending-sort) + (define-key map "=" 'profiler-report-compare-log) + (define-key map (kbd "C-x C-w") 'profiler-report-write-log) + (define-key map "q" 'quit-window) + map)) + +(defun profiler-report-make-buffer-name (log) + (format "*%s-Profiler-Report %s*" + (cl-ecase (profiler-log-type log) (cpu 'CPU) (memory 'Memory)) + (format-time-string "%Y-%m-%d %T" (profiler-log-timestamp log)))) + +(defun profiler-report-setup-buffer (log) + "Make a buffer for LOG and return it." + (let* ((buf-name (profiler-report-make-buffer-name log)) + (buffer (get-buffer-create buf-name))) + (with-current-buffer buffer + (profiler-report-mode) + (setq profiler-report-log log + profiler-report-reversed nil + profiler-report-order 'descending)) + buffer)) + +(define-derived-mode profiler-report-mode special-mode "Profiler-Report" + "Profiler Report Mode." + (setq buffer-read-only t + buffer-undo-list t + truncate-lines t)) + + +;;; Report commands + +(defun profiler-report-calltree-at-point () + (get-text-property (point) 'calltree)) + +(defun profiler-report-move-to-entry () + (let ((point (next-single-property-change (line-beginning-position) + 'profiler-entry))) + (if point + (goto-char point) + (back-to-indentation)))) + +(defun profiler-report-next-entry () + "Move cursor to next entry." + (interactive) + (forward-line) + (profiler-report-move-to-entry)) + +(defun profiler-report-previous-entry () + "Move cursor to previous entry." + (interactive) + (forward-line -1) + (profiler-report-move-to-entry)) + +(defun profiler-report-expand-entry () + "Expand entry at point." + (interactive) + (save-excursion + (beginning-of-line) + (when (search-forward (concat profiler-report-closed-mark " ") + (line-end-position) t) + (let ((tree (profiler-report-calltree-at-point))) + (when tree + (let ((inhibit-read-only t)) + (replace-match (concat profiler-report-open-mark " ")) + (forward-line) + (profiler-report-insert-calltree-children tree) + t)))))) + +(defun profiler-report-collapse-entry () + "Collpase entry at point." + (interactive) + (save-excursion + (beginning-of-line) + (when (search-forward (concat profiler-report-open-mark " ") + (line-end-position) t) + (let* ((tree (profiler-report-calltree-at-point)) + (depth (profiler-calltree-depth tree)) + (start (line-beginning-position 2)) + d) + (when tree + (let ((inhibit-read-only t)) + (replace-match (concat profiler-report-closed-mark " ")) + (while (and (eq (forward-line) 0) + (let ((child (get-text-property (point) 'calltree))) + (and child + (numberp (setq d (profiler-calltree-depth child))))) + (> d depth))) + (delete-region start (line-beginning-position))))) + t))) + +(defun profiler-report-toggle-entry () + "Expand entry at point if the tree is collapsed, +otherwise collapse." + (interactive) + (or (profiler-report-expand-entry) + (profiler-report-collapse-entry))) + +(defun profiler-report-find-entry (&optional event) + "Find entry at point." + (interactive (list last-nonmenu-event)) + (if event (posn-set-point (event-end event))) + (let ((tree (profiler-report-calltree-at-point))) + (when tree + (let ((entry (profiler-calltree-entry tree))) + (find-function entry))))) + +(defun profiler-report-describe-entry () + "Describe entry at point." + (interactive) + (let ((tree (profiler-report-calltree-at-point))) + (when tree + (let ((entry (profiler-calltree-entry tree))) + (require 'help-fns) + (describe-function entry))))) + +(cl-defun profiler-report-render-calltree-1 + (log &key reverse (order 'descending)) + (let ((calltree (profiler-calltree-build profiler-report-log + :reverse reverse))) + (setq header-line-format + (cl-ecase (profiler-log-type log) + (cpu + (profiler-report-header-line-format + profiler-report-sample-line-format + "Function" (list "Time (ms)" "%"))) + (memory + (profiler-report-header-line-format + profiler-report-memory-line-format + "Function" (list "Bytes" "%"))))) + (let ((predicate (cl-ecase order + (ascending #'profiler-calltree-count<) + (descending #'profiler-calltree-count>)))) + (profiler-calltree-sort calltree predicate)) + (let ((inhibit-read-only t)) + (erase-buffer) + (profiler-report-insert-calltree-children calltree) + (goto-char (point-min)) + (profiler-report-move-to-entry)))) + +(defun profiler-report-rerender-calltree () + (profiler-report-render-calltree-1 profiler-report-log + :reverse profiler-report-reversed + :order profiler-report-order)) + +(defun profiler-report-render-calltree () + "Render calltree view." + (interactive) + (setq profiler-report-reversed nil) + (profiler-report-rerender-calltree)) + +(defun profiler-report-render-reversed-calltree () + "Render reversed calltree view." + (interactive) + (setq profiler-report-reversed t) + (profiler-report-rerender-calltree)) + +(defun profiler-report-ascending-sort () + "Sort calltree view in ascending order." + (interactive) + (setq profiler-report-order 'ascending) + (profiler-report-rerender-calltree)) + +(defun profiler-report-descending-sort () + "Sort calltree view in descending order." + (interactive) + (setq profiler-report-order 'descending) + (profiler-report-rerender-calltree)) + +(defun profiler-report-log (log) + (let ((buffer (profiler-report-setup-buffer log))) + (with-current-buffer buffer + (profiler-report-render-calltree)) + (pop-to-buffer buffer))) + +(defun profiler-report-compare-log (buffer) + "Compare the current profiler log with another." + (interactive (list (read-buffer "Compare to: "))) + (let* ((log1 (with-current-buffer buffer profiler-report-log)) + (log2 profiler-report-log) + (diff-log (profiler-log-diff log1 log2))) + (profiler-report-log diff-log))) + +(defun profiler-report-write-log (filename &optional confirm) + "Write the current profiler log into FILENAME." + (interactive + (list (read-file-name "Write log: " default-directory) + (not current-prefix-arg))) + (profiler-log-write-file profiler-report-log + filename + confirm)) + + +;;; Profiler commands + +;;;###autoload +(defun profiler-start (mode) + "Start/restart profilers. +MODE can be one of `cpu', `mem', or `cpu+mem'. +If MODE is `cpu' or `cpu+mem', time-based profiler will be started. +Also, if MODE is `mem' or `cpu+mem', then memory profiler will be started." + (interactive + (list (if (not (fboundp 'profiler-cpu-start)) 'mem + (intern (completing-read "Mode (default cpu): " + '("cpu" "mem" "cpu+mem") + nil t nil nil "cpu"))))) + (cl-ecase mode + (cpu + (profiler-cpu-start profiler-sample-interval) + (message "CPU profiler started")) + (mem + (profiler-memory-start) + (message "Memory profiler started")) + (cpu+mem + (profiler-cpu-start profiler-sample-interval) + (profiler-memory-start) + (message "CPU and memory profiler started")))) + +(defun profiler-stop () + "Stop started profilers. Profiler logs will be kept." + (interactive) + (let ((cpu (if (fboundp 'profiler-cpu-stop) (profiler-cpu-stop))) + (mem (profiler-memory-stop))) + (message "%s profiler stopped" + (cond ((and mem cpu) "CPU and memory") + (mem "Memory") + (cpu "CPU") + (t "No"))))) + +(defun profiler-reset () + "Reset profiler log." + (interactive) + (when (fboundp 'profiler-cpu-log) + (ignore (profiler-cpu-log))) + (ignore (profiler-memory-log)) + t) + +(defun profiler--report-cpu () + (let ((log (if (fboundp 'profiler-cpu-log) (profiler-cpu-log)))) + (when log + (puthash 'type 'cpu log) + (puthash 'timestamp (current-time) log) + (profiler-report-log log)))) + +(defun profiler--report-memory () + (let ((log (profiler-memory-log))) + (when log + (puthash 'type 'memory log) + (puthash 'timestamp (current-time) log) + (profiler-report-log log)))) + +(defun profiler-report () + "Report profiling results." + (interactive) + (profiler--report-cpu) + (profiler--report-memory)) + +;;;###autoload +(defun profiler-find-log (filename) + "Read a profiler log from FILENAME and report it." + (interactive + (list (read-file-name "Find log: " default-directory))) + (profiler-report-log (profiler-log-read-file filename))) + + +;;; Profiling helpers + +;; (cl-defmacro with-sample-profiling ((&key interval) &rest body) +;; `(unwind-protect +;; (progn +;; (ignore (profiler-cpu-log)) +;; (profiler-cpu-start ,interval) +;; ,@body) +;; (profiler-cpu-stop) +;; (profiler--report-cpu))) + +;; (defmacro with-memory-profiling (&rest body) +;; `(unwind-protect +;; (progn +;; (ignore (profiler-memory-log)) +;; (profiler-memory-start) +;; ,@body) +;; (profiler-memory-stop) +;; (profiler--report-memory))) + +(provide 'profiler) +;;; profiler.el ends here diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el index 1825098a55e..745320b6eb2 100644 --- a/lisp/progmodes/ada-mode.el +++ b/lisp/progmodes/ada-mode.el @@ -5218,11 +5218,11 @@ Return nil if no body was found." ;; correctly highlight a with_clause that spans multiple lines. (list (concat "\\<\\(goto\\|raise\\|use\\|with\\)" "[ \t]+\\([a-zA-Z0-9_., \t]+\\)\\W") - '(1 font-lock-keyword-face) '(2 font-lock-reference-face nil t)) + '(1 font-lock-keyword-face) '(2 font-lock-constant-face nil t)) ;; ;; Goto tags. - '("<<\\(\\sw+\\)>>" 1 font-lock-reference-face) + '("<<\\(\\sw+\\)>>" 1 font-lock-constant-face) ;; Highlight based-numbers (R. Reagan <robin-reply@reagans.org>) (list "\\([0-9]+#[0-9a-fA-F_]+#\\)" '(1 font-lock-constant-face t)) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 95b8758ba80..09fba380f15 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -748,12 +748,10 @@ Faces `compilation-error-face', `compilation-warning-face', (defvar compilation-leave-directory-face 'font-lock-builtin-face "Face name to use for leaving directory messages.") - - ;; Used for compatibility with the old compile.el. (defvar compilation-parse-errors-function nil) -(make-obsolete 'compilation-parse-errors-function - 'compilation-error-regexp-alist "24.1") +(make-obsolete-variable 'compilation-parse-errors-function + 'compilation-error-regexp-alist "24.1") (defcustom compilation-auto-jump-to-first-error nil "If non-nil, automatically jump to the first error during compilation." @@ -1499,24 +1497,6 @@ Otherwise, construct a buffer name from NAME-OF-MODE." (t (concat "*" (downcase name-of-mode) "*")))) -;; This is a rough emulation of the old hack, until the transition to new -;; compile is complete. -(defun compile-internal (command error-message - &optional _name-of-mode parser - error-regexp-alist name-function - _enter-regexp-alist _leave-regexp-alist - file-regexp-alist _nomessage-regexp-alist - _no-async highlight-regexp _local-map) - (if parser - (error "Compile now works very differently, see `compilation-error-regexp-alist'")) - (let ((compilation-error-regexp-alist - (append file-regexp-alist (or error-regexp-alist - compilation-error-regexp-alist))) - (compilation-error (replace-regexp-in-string "^No more \\(.+\\)s\\.?" - "\\1" error-message))) - (compilation-start command nil name-function highlight-regexp))) -(make-obsolete 'compile-internal 'compilation-start "22.1") - (defcustom compilation-always-kill nil "If t, always kill a running compilation process before starting a new one. If nil, ask to kill it." diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el index 9ea71ad36f5..becbcb7a3de 100644 --- a/lisp/progmodes/cwarn.el +++ b/lisp/progmodes/cwarn.el @@ -191,13 +191,7 @@ if ARG is omitted or nil." (if font-lock-mode (font-lock-fontify-buffer))) ;;;###autoload -(defun turn-on-cwarn-mode () - "Turn on CWarn mode. - -This function is designed to be added to hooks, for example: - (add-hook 'c-mode-hook 'turn-on-cwarn-mode)" - (cwarn-mode 1)) -(make-obsolete 'turn-on-cwarn-mode 'cwarn-mode "24.1") +(define-obsolete-function-alias 'turn-on-cwarn-mode 'cwarn-mode "24.1") ;;}}} ;;{{{ Help functions diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 9b634328fa7..e58fb2b3eab 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -1151,7 +1151,7 @@ As a user, you should not set this to t.") (common-blocks '("\\<\\(common\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*,?" (1 font-lock-keyword-face) ; "common" - (2 font-lock-reference-face nil t) ; block name + (2 font-lock-constant-face nil t) ; block name ("[ \t]*\\(\\sw+\\)[ ,]*" ;; Start with point after block name and comma (goto-char (match-end 0)) ; needed for XEmacs, could be nil @@ -1169,20 +1169,20 @@ As a user, you should not set this to t.") ;; Labels (label - '("^[ \t]*\\([a-zA-Z]\\sw*:\\)" (1 font-lock-reference-face))) + '("^[ \t]*\\([a-zA-Z]\\sw*:\\)" (1 font-lock-constant-face))) ;; The goto statement and its label (goto '("\\(goto\\)[ \t]*,[ \t]*\\([a-zA-Z]\\sw*\\)" (1 font-lock-keyword-face) - (2 font-lock-reference-face))) + (2 font-lock-constant-face))) ;; Tags in structure definitions. Note that this definition ;; actually collides with labels, so we have to use the same ;; face. It also matches named subscript ranges, ;; e.g. vec{bottom:top]. No good way around this. (structtag - '("\\<\\([a-zA-Z][a-zA-Z0-9_]*:\\)[^:]" (1 font-lock-reference-face))) + '("\\<\\([a-zA-Z][a-zA-Z0-9_]*:\\)[^:]" (1 font-lock-constant-face))) ;; Structure names (structname @@ -1195,7 +1195,7 @@ As a user, you should not set this to t.") ;; fontification. Slow, use it only in fancy fontification. (keyword-parameters '("\\(,\\|[a-zA-Z0-9_](\\)[ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\([ \t]*\\(;.*\\)?\n\\)*[ \t]*\\)?\\(/[a-zA-Z_]\\sw*\\|[a-zA-Z_]\\sw*[ \t]*=\\)" - (6 font-lock-reference-face))) + (6 font-lock-constant-face))) ;; System variables start with a bang. (system-variables diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el index 401970b2ce8..f2578c14066 100644 --- a/lisp/progmodes/inf-lisp.el +++ b/lisp/progmodes/inf-lisp.el @@ -69,9 +69,8 @@ :group 'lisp :version "22.1") -;;;###autoload (defcustom inferior-lisp-filter-regexp - (purecopy "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'") + "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'" "What not to save on inferior Lisp's input history. Input matching this regexp is not saved on the input history in Inferior Lisp mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword @@ -137,14 +136,12 @@ mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword (define-key inferior-lisp-mode-map "\C-cv" 'lisp-show-variable-documentation)) -;;;###autoload -(defcustom inferior-lisp-program (purecopy "lisp") +(defcustom inferior-lisp-program "lisp" "Program name for invoking an inferior Lisp in Inferior Lisp mode." :type 'string :group 'inferior-lisp) -;;;###autoload -(defcustom inferior-lisp-load-command (purecopy "(load \"%s\")\n") +(defcustom inferior-lisp-load-command "(load \"%s\")\n" "Format-string for building a Lisp expression to load a file. This format string should use `%s' to substitute a file name and should result in a Lisp expression that will command the inferior Lisp @@ -155,8 +152,7 @@ but it works only in Common Lisp." :type 'string :group 'inferior-lisp) -;;;###autoload -(defcustom inferior-lisp-prompt (purecopy "^[^> \n]*>+:? *") +(defcustom inferior-lisp-prompt "^[^> \n]*>+:? *" "Regexp to recognize prompts in the Inferior Lisp mode. Defaults to \"^[^> \\n]*>+:? *\", which works pretty good for Lucid, kcl, and franz. This variable is used to initialize `comint-prompt-regexp' in the @@ -207,7 +203,6 @@ one process, this does the right thing. If you run multiple processes, you can change `inferior-lisp-buffer' to another process buffer with \\[set-variable].") -;;;###autoload (defvar inferior-lisp-mode-hook '() "Hook for customizing Inferior Lisp mode.") diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 33d43cb3d5a..99df94d3805 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -2110,7 +2110,7 @@ Argument BOUND is a buffer position limiting searching." (if (eq prolog-system 'mercury) (list (prolog-make-keywords-regexp prolog-mode-specificators-i t) - 0 'font-lock-reference-face))) + 0 'font-lock-constant-face))) (directives (if (eq prolog-system 'mercury) (list diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el index bf52eff8f9a..a8fc11f71c0 100644 --- a/lisp/progmodes/ps-mode.el +++ b/lisp/progmodes/ps-mode.el @@ -213,9 +213,9 @@ If nil, use `temporary-file-directory'." ;; - 8bit characters (warning face) ;; Multiline strings are not supported. Strings with nested brackets are. (defconst ps-mode-font-lock-keywords-1 - '(("\\`%!PS.*" . font-lock-reference-face) + '(("\\`%!PS.*" . font-lock-constant-face) ("^%%BoundingBox:[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]*$" - . font-lock-reference-face) + . font-lock-constant-face) (ps-mode-match-string-or-comment (1 font-lock-comment-face nil t) (2 font-lock-string-face nil t)) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index ffc6c1ac885..e99e6bda4b8 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -497,52 +497,68 @@ The type returned can be `comment', `string' or `paren'." (1 font-lock-variable-name-face nil nil)))) (defconst python-syntax-propertize-function - ;; Make outer chars of matching triple-quote sequences into generic - ;; string delimiters. Fixme: Is there a better way? - ;; First avoid a sequence preceded by an odd number of backslashes. (syntax-propertize-rules - (;; ¡Backrefs don't work in syntax-propertize-rules! - (concat "\\(?:\\([RUru]\\)[Rr]?\\|^\\|[^\\]\\(?:\\\\.\\)*\\)" ;Prefix. - "\\(?:\\('\\)'\\('\\)\\|\\(?2:\"\\)\"\\(?3:\"\\)\\)") - (3 (ignore (python-quote-syntax)))))) - -(defun python-quote-syntax () - "Put `syntax-table' property correctly on triple quote. -Used for syntactic keywords. N is the match number (1, 2 or 3)." - ;; Given a triple quote, we have to check the context to know - ;; whether this is an opening or closing triple or whether it's - ;; quoted anyhow, and should be ignored. (For that we need to do - ;; the same job as `syntax-ppss' to be correct and it seems to be OK - ;; to use it here despite initial worries.) We also have to sort - ;; out a possible prefix -- well, we don't _have_ to, but I think it - ;; should be treated as part of the string. - - ;; Test cases: - ;; ur"""ar""" x='"' # """ - ;; x = ''' """ ' a - ;; ''' - ;; x '"""' x """ \"""" x - (save-excursion - (goto-char (match-beginning 0)) - (let ((syntax (save-match-data (syntax-ppss)))) - (cond - ((eq t (nth 3 syntax)) ; after unclosed fence - ;; Consider property for the last char if in a fenced string. - (goto-char (nth 8 syntax)) ; fence position - (skip-chars-forward "uUrR") ; skip any prefix - ;; Is it a matching sequence? - (if (eq (char-after) (char-after (match-beginning 2))) - (put-text-property (match-beginning 3) (match-end 3) - 'syntax-table (string-to-syntax "|")))) - ((match-end 1) - ;; Consider property for initial char, accounting for prefixes. - (put-text-property (match-beginning 1) (match-end 1) - 'syntax-table (string-to-syntax "|"))) - (t - ;; Consider property for initial char, accounting for prefixes. - (put-text-property (match-beginning 2) (match-end 2) - 'syntax-table (string-to-syntax "|")))) - ))) + ((rx + ;; Match even number of backslashes. + (or (not (any ?\\ ?\' ?\")) point) (* ?\\ ?\\) + ;; Match single or triple quotes of any kind. + (group (or "\"" "\"\"\"" "'" "'''"))) + (1 (ignore (python-syntax-stringify)))) + ((rx + ;; Match odd number of backslashes. + (or (not (any ?\\)) point) ?\\ (* ?\\ ?\\) + ;; Followed by even number of equal quotes. + (group (or "\"\"" "\"\"\"\"" "''" "''''"))) + (1 (ignore (python-syntax-stringify)))))) + +(defsubst python-syntax-count-quotes (quote-char &optional point limit) + "Count number of quotes around point (max is 3). +QUOTE-CHAR is the quote char to count. Optional argument POINT is +the point where scan starts (defaults to current point) and LIMIT +is used to limit the scan." + (let ((i 0)) + (while (and (< i 3) + (or (not limit) (< (+ point i) limit)) + (eq (char-after (+ point i)) quote-char)) + (incf i)) + i)) + +(defun python-syntax-stringify () + "Put `syntax-table' property correctly on single/triple quotes." + (let* ((num-quotes + (let ((n (length (match-string-no-properties 1)))) + ;; This corrects the quote count when matching odd number + ;; of backslashes followed by even number of quotes. + (or (and (= 1 (logand n 1)) n) (1- n)))) + (ppss (prog2 + (backward-char num-quotes) + (syntax-ppss) + (forward-char num-quotes))) + (string-start (and (not (nth 4 ppss)) (nth 8 ppss))) + (quote-starting-pos (- (point) num-quotes)) + (quote-ending-pos (point)) + (num-closing-quotes + (and string-start + (python-syntax-count-quotes + (char-before) string-start quote-starting-pos)))) + (cond ((and string-start (= num-closing-quotes 0)) + ;; This set of quotes doesn't match the string starting + ;; kind. Do nothing. + nil) + ((not string-start) + ;; This set of quotes delimit the start of a string. + (put-text-property quote-starting-pos (1+ quote-starting-pos) + 'syntax-table (string-to-syntax "|"))) + ((= num-quotes num-closing-quotes) + ;; This set of quotes delimit the end of a string. + (put-text-property (1- quote-ending-pos) quote-ending-pos + 'syntax-table (string-to-syntax "|"))) + ((> num-quotes num-closing-quotes) + ;; This may only happen whenever a triple quote is closing + ;; a single quoted string. Add string delimiter syntax to + ;; all three quotes. + (put-text-property quote-starting-pos quote-ending-pos + 'syntax-table (string-to-syntax "|")))))) (defvar python-mode-syntax-table (let ((table (make-syntax-table))) @@ -897,16 +913,27 @@ possible indentation levels and saves it in the variable `python-indent-levels'. Afterwards it sets the variable `python-indent-current-level' correctly so offset is equal to (`nth' `python-indent-current-level' `python-indent-levels')" - (if (or (and (eq this-command 'indent-for-tab-command) - (eq last-command this-command)) - force-toggle) - (if (not (equal python-indent-levels '(0))) - (python-indent-toggle-levels) - (python-indent-calculate-levels)) - (python-indent-calculate-levels)) - (beginning-of-line) - (delete-horizontal-space) - (indent-to (nth python-indent-current-level python-indent-levels)) + (or + (and (or (and (eq this-command 'indent-for-tab-command) + (eq last-command this-command)) + force-toggle) + (not (equal python-indent-levels '(0))) + (or (python-indent-toggle-levels) t)) + (python-indent-calculate-levels)) + (let* ((starting-pos (point-marker)) + (indent-ending-position + (+ (line-beginning-position) (current-indentation))) + (follow-indentation-p + (or (bolp) + (and (<= (line-beginning-position) starting-pos) + (>= indent-ending-position starting-pos)))) + (next-indent (nth python-indent-current-level python-indent-levels))) + (unless (= next-indent (current-indentation)) + (beginning-of-line) + (delete-horizontal-space) + (indent-to next-indent) + (goto-char starting-pos)) + (and follow-indentation-p (back-to-indentation))) (python-info-closing-block-message)) (defun python-indent-line-function () @@ -1892,19 +1919,18 @@ Returns the output. See `python-shell-send-string-no-output'." (defun python-shell-send-buffer (&optional arg) "Send the entire buffer to inferior Python process. - -With prefix ARG include lines surrounded by \"if __name__ == '__main__':\"" +With prefix ARG allow execution of code inside blocks delimited +by \"if __name__== '__main__':\"" (interactive "P") (save-restriction (widen) - (python-shell-send-region - (point-min) - (or (and - (not arg) - (save-excursion - (re-search-forward (python-rx if-name-main) nil t)) - (match-beginning 0)) - (point-max))))) + (let ((str (buffer-substring (point-min) (point-max)))) + (and + (not arg) + (setq str (replace-regexp-in-string + (python-rx if-name-main) + "if __name__ == '__main__ ':" str))) + (python-shell-send-string str)))) (defun python-shell-send-defun (arg) "Send the current defun to inferior Python process. diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 0f02e81cbad..84cf7308d75 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -1567,7 +1567,7 @@ See `font-lock-syntax-table'.") 2 font-lock-variable-name-face) ;; symbols '("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\|@?\\(\\w\\|_\\)+\\([!?=]\\|\\b_*\\)\\|#{[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\)\\)" - 2 font-lock-reference-face) + 2 font-lock-constant-face) ;; variables '("\\(\\$\\([^a-zA-Z0-9 \n]\\|[0-9]\\)\\)\\W" 1 font-lock-variable-name-face) @@ -1576,7 +1576,7 @@ See `font-lock-syntax-table'.") ;; constants '("\\(^\\|[^_]\\)\\b\\([A-Z]+\\(\\w\\|_\\)*\\)" 2 font-lock-type-face) - '("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-reference-face) + '("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-constant-face) ;; expression expansion '(ruby-match-expression-expansion 0 font-lock-variable-name-face t) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index b4d550bcee0..e94919ee2a9 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -4079,11 +4079,10 @@ option followed by a colon `:' if the option accepts an argument." (defun sh-maybe-here-document (arg) "Insert self. Without prefix, following unquoted `<' inserts here document. The document is bounded by `sh-here-document-word'." + (declare (obsolete sh-electric-here-document-mode "24.3")) (interactive "*P") (self-insert-command (prefix-numeric-value arg)) (or arg (sh--maybe-here-document))) -(make-obsolete 'sh--maybe-here-document - 'sh-electric-here-document-mode "24.3") (defun sh--maybe-here-document () (or (not (looking-back "[^<]<<")) diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index f1ab01fd07f..c82566ca5b6 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -104,7 +104,6 @@ (eval-when-compile (require 'imenu) - (require 'outline) (require 'dabbrev) (require 'add-log)) @@ -544,6 +543,9 @@ Uses variables `tcl-proc-regexp' and `tcl-keyword-list'." ;; The mode itself. ;; +(defvar outline-regexp) +(defvar outline-level) + ;;;###autoload (define-derived-mode tcl-mode prog-mode "Tcl" "Major mode for editing Tcl code. diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el index 31f2fc1fe31..a2f71ff2ab8 100644 --- a/lisp/progmodes/vera-mode.el +++ b/lisp/progmodes/vera-mode.el @@ -587,12 +587,6 @@ Key bindings: ;;; Font locking ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; XEmacs compatibility -(when (featurep 'xemacs) - (require 'font-lock) - (copy-face 'font-lock-reference-face 'font-lock-constant-face) - (copy-face 'font-lock-preprocessor-face 'font-lock-builtin-face)) - (defun vera-font-lock-match-item (limit) "Match, and move over, any declaration item after point. Adapted from `font-lock-match-c-style-declaration-item-and-skip-to-next'." diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 835d548c19f..86ffdf535a0 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -123,9 +123,9 @@ ;;; Code: ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "800" +(defconst verilog-mode-version (substring "$$Revision: 820 $$" 12 -3) "Version of this Verilog mode.") -(defconst verilog-mode-release-date "2012-04-23-GNU" +(defconst verilog-mode-release-date (substring "$$Date: 2012-09-17 20:43:10 -0400 (Mon, 17 Sep 2012) $$" 8 -3) "Release date of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -1127,10 +1127,11 @@ won't merge conflict." :type 'integer) (put 'verilog-auto-inst-column 'safe-local-variable 'integerp) -(defcustom verilog-auto-inst-interfaced-ports t +(defcustom verilog-auto-inst-interfaced-ports nil "Non-nil means include interfaced ports in AUTOINST expansions." :group 'verilog-mode-auto - :type 'boolean) + :type 'boolean + :version "24.3") (put 'verilog-auto-inst-interfaced-ports 'safe-local-variable 'verilog-booleanp) (defcustom verilog-auto-input-ignore-regexp nil @@ -1431,12 +1432,18 @@ If set will become buffer local.") :help "Help on AUTOARG - declaring module port list"] ["AUTOASCIIENUM" (describe-function 'verilog-auto-ascii-enum) :help "Help on AUTOASCIIENUM - creating ASCII for enumerations"] + ["AUTOASSIGNMODPORT" (describe-function 'verilog-auto-assign-modport) + :help "Help on AUTOASSIGNMODPORT - creating assignments to/from modports"] ["AUTOINOUTCOMP" (describe-function 'verilog-auto-inout-comp) :help "Help on AUTOINOUTCOMP - copying complemented i/o from another file"] ["AUTOINOUTIN" (describe-function 'verilog-auto-inout-in) - :help "Help on AUTOINOUTCOMP - copying i/o from another file as all inputs"] + :help "Help on AUTOINOUTIN - copying i/o from another file as all inputs"] + ["AUTOINOUTMODPORT" (describe-function 'verilog-auto-inout-modport) + :help "Help on AUTOINOUTMODPORT - copying i/o from an interface modport"] ["AUTOINOUTMODULE" (describe-function 'verilog-auto-inout-module) :help "Help on AUTOINOUTMODULE - copying i/o from another file"] + ["AUTOINOUTPARAM" (describe-function 'verilog-auto-inout-param) + :help "Help on AUTOINOUTPARAM - copying parameters from another file"] ["AUTOINSERTLISP" (describe-function 'verilog-auto-insert-lisp) :help "Help on AUTOINSERTLISP - insert text from a lisp function"] ["AUTOINOUT" (describe-function 'verilog-auto-inout) @@ -1706,12 +1713,19 @@ This speeds up complicated regexp matches." ;;(verilog-re-search-backward-substr "-end" "get-end-of" nil t) ;;-end (test bait) (defun verilog-delete-trailing-whitespace () - "Delete trailing spaces or tabs, but not newlines nor linefeeds." + "Delete trailing spaces or tabs, but not newlines nor linefeeds. +Also add missing final newline. + +To call this from the command line, see \\[verilog-batch-diff-auto]. + +To call on \\[verilog-auto], set `verilog-auto-delete-trailing-whitespace'." ;; Similar to `delete-trailing-whitespace' but that's not present in XEmacs (save-excursion (goto-char (point-min)) (while (re-search-forward "[ \t]+$" nil t) ;; Not syntactic WS as no formfeed - (replace-match "" nil nil)))) + (replace-match "" nil nil)) + (goto-char (point-max)) + (unless (bolp) (insert "\n")))) (defvar compile-command) @@ -5128,6 +5142,15 @@ with \\[verilog-delete-auto] on all command-line files, and saves the buffers." (error "Use verilog-batch-delete-auto only with --batch")) ;; Otherwise we'd mess up buffer modes (verilog-batch-execute-func `verilog-delete-auto)) +(defun verilog-batch-delete-trailing-whitespace () + "For use with --batch, perform whitespace deletion as a stand-alone tool. +This sets up the appropriate Verilog mode environment, removes +whitespace with \\[verilog-delete-trailing-whitespace] on all +command-line files, and saves the buffers." + (unless noninteractive + (error "Use verilog-batch-delete-trailing-whitepace only with --batch")) ;; Otherwise we'd mess up buffer modes + (verilog-batch-execute-func `verilog-delete-trailing-whitespace)) + (defun verilog-batch-diff-auto () "For use with --batch, perform automatic differences as a stand-alone tool. This sets up the appropriate Verilog mode environment, expand automatics @@ -7479,6 +7502,19 @@ See also `verilog-sk-header' for an alternative format." (defsubst verilog-alw-get-uses-delayed (sigs) (aref sigs 0)) +(defsubst verilog-modport-new (name clockings decls) + (list name clockings decls)) +(defsubst verilog-modport-name (sig) + (car sig)) +(defsubst verilog-modport-clockings (sig) + (nth 1 sig)) ;; Returns list of names +(defsubst verilog-modport-clockings-add (sig val) + (setcar (nthcdr 1 sig) (cons val (nth 1 sig)))) +(defsubst verilog-modport-decls (sig) + (nth 2 sig)) ;; Returns verilog-decls-* structure +(defsubst verilog-modport-decls-set (sig val) + (setcar (nthcdr 2 sig) val)) + (defsubst verilog-modi-new (name fob pt type) (vector name fob pt type)) (defsubst verilog-modi-name (modi) @@ -7496,8 +7532,15 @@ See also `verilog-sk-header' for an alternative format." ;; Signal reading for given module ;; Note these all take modi's - as returned from verilog-modi-current -(defsubst verilog-decls-new (out inout in vars unuseds assigns consts gparams interfaces) - (vector out inout in vars unuseds assigns consts gparams interfaces)) +(defsubst verilog-decls-new (out inout in vars modports assigns consts gparams interfaces) + (vector out inout in vars modports assigns consts gparams interfaces)) +(defsubst verilog-decls-append (a b) + (cond ((not a) b) ((not b) a) + (t (vector (append (aref a 0) (aref b 0)) (append (aref a 1) (aref b 1)) + (append (aref a 2) (aref b 2)) (append (aref a 3) (aref b 3)) + (append (aref a 4) (aref b 4)) (append (aref a 5) (aref b 5)) + (append (aref a 6) (aref b 6)) (append (aref a 7) (aref b 7)) + (append (aref a 8) (aref b 8)))))) (defsubst verilog-decls-get-outputs (decls) (aref decls 0)) (defsubst verilog-decls-get-inouts (decls) @@ -7506,8 +7549,8 @@ See also `verilog-sk-header' for an alternative format." (aref decls 2)) (defsubst verilog-decls-get-vars (decls) (aref decls 3)) -;;(defsubst verilog-decls-get-unused (decls) -;; (aref decls 4)) +(defsubst verilog-decls-get-modports (decls) ;; Also for clocking blocks; contains another verilog-decls struct + (aref decls 4)) ;; Returns verilog-modport* structure (defsubst verilog-decls-get-assigns (decls) (aref decls 5)) (defsubst verilog-decls-get-consts (decls) @@ -7517,6 +7560,7 @@ See also `verilog-sk-header' for an alternative format." (defsubst verilog-decls-get-interfaces (decls) (aref decls 8)) + (defsubst verilog-subdecls-new (out inout in intf intfd) (vector out inout in intf intfd)) (defsubst verilog-subdecls-get-outputs (subdecls) @@ -7535,6 +7579,36 @@ See also `verilog-sk-header' for an alternative format." (mapcar (lambda (name) (verilog-sig-new name nil nil nil nil nil nil nil nil)) signame-list)) +(defun verilog-signals-in (in-list not-list) + "Return list of signals in IN-LIST that are also in NOT-LIST. +Also remove any duplicates in IN-LIST. +Signals must be in standard (base vector) form." + ;; This function is hot, so implemented as O(1) + (cond ((eval-when-compile (fboundp 'make-hash-table)) + (let ((ht (make-hash-table :test 'equal :rehash-size 4.0)) + (ht-not (make-hash-table :test 'equal :rehash-size 4.0)) + out-list) + (while not-list + (puthash (car (car not-list)) t ht-not) + (setq not-list (cdr not-list))) + (while in-list + (when (and (gethash (verilog-sig-name (car in-list)) ht-not) + (not (gethash (verilog-sig-name (car in-list)) ht))) + (setq out-list (cons (car in-list) out-list)) + (puthash (verilog-sig-name (car in-list)) t ht)) + (setq in-list (cdr in-list))) + (nreverse out-list))) + ;; Slower Fallback if no hash tables (pre Emacs 21.1/XEmacs 21.4) + (t + (let (out-list) + (while in-list + (if (and (assoc (verilog-sig-name (car in-list)) not-list) + (not (assoc (verilog-sig-name (car in-list)) out-list))) + (setq out-list (cons (car in-list) out-list))) + (setq in-list (cdr in-list))) + (nreverse out-list))))) +;;(verilog-signals-in '(("A" "") ("B" "") ("DEL" "[2:3]")) '(("DEL" "") ("C" ""))) + (defun verilog-signals-not-in (in-list not-list) "Return list of signals in IN-LIST that aren't also in NOT-LIST. Also remove any duplicates in IN-LIST. @@ -7556,8 +7630,8 @@ Signals must be in standard (base vector) form." (t (let (out-list) (while in-list - (if (not (or (assoc (verilog-sig-name (car in-list)) not-list) - (assoc (verilog-sig-name (car in-list)) out-list))) + (if (and (not (assoc (verilog-sig-name (car in-list)) not-list)) + (not (assoc (verilog-sig-name (car in-list)) out-list))) (setq out-list (cons (car in-list) out-list))) (setq in-list (cdr in-list))) (nreverse out-list))))) @@ -7702,30 +7776,35 @@ Tieoff value uses `verilog-active-low-regexp' and ;; Dumping ;; -(defun verilog-decls-princ (decls) +(defun verilog-decls-princ (decls &optional header prefix) "For debug, dump the `verilog-read-decls' structure DECLS." - (verilog-signals-princ (verilog-decls-get-outputs decls) - "Outputs:\n" " ") - (verilog-signals-princ (verilog-decls-get-inouts decls) - "Inout:\n" " ") - (verilog-signals-princ (verilog-decls-get-inputs decls) - "Inputs:\n" " ") - (verilog-signals-princ (verilog-decls-get-vars decls) - "Vars:\n" " ") - (verilog-signals-princ (verilog-decls-get-assigns decls) - "Assigns:\n" " ") - (verilog-signals-princ (verilog-decls-get-consts decls) - "Consts:\n" " ") - (verilog-signals-princ (verilog-decls-get-gparams decls) - "Gparams:\n" " ") - (verilog-signals-princ (verilog-decls-get-interfaces decls) - "Interfaces:\n" " ") - (princ "\n")) + (when decls + (if header (princ header)) + (setq prefix (or prefix "")) + (verilog-signals-princ (verilog-decls-get-outputs decls) + (concat prefix "Outputs:\n") (concat prefix " ")) + (verilog-signals-princ (verilog-decls-get-inouts decls) + (concat prefix "Inout:\n") (concat prefix " ")) + (verilog-signals-princ (verilog-decls-get-inputs decls) + (concat prefix "Inputs:\n") (concat prefix " ")) + (verilog-signals-princ (verilog-decls-get-vars decls) + (concat prefix "Vars:\n") (concat prefix " ")) + (verilog-signals-princ (verilog-decls-get-assigns decls) + (concat prefix "Assigns:\n") (concat prefix " ")) + (verilog-signals-princ (verilog-decls-get-consts decls) + (concat prefix "Consts:\n") (concat prefix " ")) + (verilog-signals-princ (verilog-decls-get-gparams decls) + (concat prefix "Gparams:\n") (concat prefix " ")) + (verilog-signals-princ (verilog-decls-get-interfaces decls) + (concat prefix "Interfaces:\n") (concat prefix " ")) + (verilog-modport-princ (verilog-decls-get-modports decls) + (concat prefix "Modports:\n") (concat prefix " ")) + (princ "\n"))) (defun verilog-signals-princ (signals &optional header prefix) "For debug, dump internal SIGNALS structures, with HEADER and PREFIX." (when signals - (princ header) + (if header (princ header)) (while signals (let ((sig (car signals))) (setq signals (cdr signals)) @@ -7741,6 +7820,21 @@ Tieoff value uses `verilog-active-low-regexp' and (princ " modp=") (princ (verilog-sig-modport sig)) (princ "\n"))))) +(defun verilog-modport-princ (modports &optional header prefix) + "For debug, dump internal MODPORT structures, with HEADER and PREFIX." + (when modports + (if header (princ header)) + (while modports + (let ((sig (car modports))) + (setq modports (cdr modports)) + (princ prefix) + (princ "\"") (princ (verilog-modport-name sig)) (princ "\"") + (princ " clockings=") (princ (verilog-modport-clockings sig)) + (princ "\n") + (verilog-decls-princ (verilog-modport-decls sig) + (concat prefix " syms:\n") + (concat prefix " ")))))) + ;; ;; Port/Wire/Etc Reading ;; @@ -7851,11 +7945,12 @@ Optional NUM-PARAM and MAX-PARAM check for a specific number of parameters." Return an array of [outputs inouts inputs wire reg assign const]." (let ((end-mod-point (or (verilog-get-end-of-defun t) (point-max))) (functask 0) (paren 0) (sig-paren 0) (v2kargs-ok t) - in-modport ptype ign-prop + in-modport in-clocking ptype ign-prop sigs-in sigs-out sigs-inout sigs-var sigs-assign sigs-const - sigs-gparam sigs-intf + sigs-gparam sigs-intf sigs-modports vec expect-signal keywd newsig rvalue enum io signed typedefed multidim - modport) + modport + varstack tmp) (save-excursion (verilog-beg-of-defun-quick) (setq sigs-const (verilog-read-auto-constants (point) end-mod-point)) @@ -7881,6 +7976,17 @@ Return an array of [outputs inouts inputs wire reg assign const]." (or (re-search-forward "[^\\]\"" nil t) ;; don't forward-char first, since we look for a non backslash first (error "%s: Unmatched quotes, at char %d" (verilog-point-text) (point)))) ((eq ?\; (following-char)) + (when (and in-modport (not (eq in-modport t))) ;; end of a modport declaration + (verilog-modport-decls-set + in-modport + (verilog-decls-new sigs-out sigs-inout sigs-in + nil nil nil nil nil nil)) + ;; Pop from varstack to restore state to pre-clocking + (setq tmp (car varstack) + varstack (cdr varstack) + sigs-out (aref tmp 0) + sigs-inout (aref tmp 1) + sigs-in (aref tmp 2))) (setq vec nil io nil expect-signal nil newsig nil paren 0 rvalue nil v2kargs-ok nil in-modport nil ign-prop nil) (forward-char 1)) @@ -7974,15 +8080,17 @@ Return an array of [outputs inouts inputs wire reg assign const]." (setq signed keywd)) ((member keywd '("assert" "assume" "cover" "expect" "restrict")) (setq ign-prop t)) - ((member keywd '("class" "clocking" "covergroup" "function" + ((member keywd '("class" "covergroup" "function" "property" "randsequence" "sequence" "task")) (unless ign-prop (setq functask (1+ functask)))) - ((member keywd '("endclass" "endclocking" "endgroup" "endfunction" + ((member keywd '("endclass" "endgroup" "endfunction" "endproperty" "endsequence" "endtask")) (setq functask (1- functask))) ((equal keywd "modport") (setq in-modport t)) + ((equal keywd "clocking") + (setq in-clocking t)) ((equal keywd "type") (setq ptype t)) ;; Ifdef? Ignore name of define @@ -8008,11 +8116,47 @@ Return an array of [outputs inouts inputs wire reg assign const]." (goto-char (match-end 0)) (when (not rvalue) (setq expect-signal nil))) + ;; "modport <keywd>" + ((and (eq in-modport t) + (not (member keywd verilog-keywords))) + (setq in-modport (verilog-modport-new keywd nil nil)) + (setq sigs-modports (cons in-modport sigs-modports)) + ;; Push old sig values to stack and point to new signal list + (setq varstack (cons (vector sigs-out sigs-inout sigs-in) + varstack)) + (setq sigs-in nil sigs-inout nil sigs-out nil)) + ;; "modport x (clocking <keywd>)" + ((and in-modport in-clocking) + (verilog-modport-clockings-add in-modport keywd) + (setq in-clocking nil)) + ;; endclocking + ((and in-clocking + (equal keywd "endclocking")) + (unless (eq in-clocking t) + (verilog-modport-decls-set + in-clocking + (verilog-decls-new sigs-out sigs-inout sigs-in + nil nil nil nil nil nil)) + ;; Pop from varstack to restore state to pre-clocking + (setq tmp (car varstack) + varstack (cdr varstack) + sigs-out (aref tmp 0) + sigs-inout (aref tmp 1) + sigs-in (aref tmp 2))) + (setq in-clocking nil)) + ;; "clocking <keywd>" + ((and (eq in-clocking t) + (not (member keywd verilog-keywords))) + (setq in-clocking (verilog-modport-new keywd nil nil)) + (setq sigs-modports (cons in-clocking sigs-modports)) + ;; Push old sig values to stack and point to new signal list + (setq varstack (cons (vector sigs-out sigs-inout sigs-in) + varstack)) + (setq sigs-in nil sigs-inout nil sigs-out nil)) ;; New signal, maybe? ((and expect-signal (not rvalue) (eq functask 0) - (not in-modport) (not (member keywd verilog-keywords))) ;; Add new signal to expect-signal's variable (setq newsig (verilog-sig-new keywd vec nil nil enum signed typedefed multidim modport)) @@ -8022,15 +8166,17 @@ Return an array of [outputs inouts inputs wire reg assign const]." (forward-char 1))) (skip-syntax-forward " ")) ;; Return arguments - (verilog-decls-new (nreverse sigs-out) - (nreverse sigs-inout) - (nreverse sigs-in) - (nreverse sigs-var) - nil - (nreverse sigs-assign) - (nreverse sigs-const) - (nreverse sigs-gparam) - (nreverse sigs-intf))))) + (setq tmp (verilog-decls-new (nreverse sigs-out) + (nreverse sigs-inout) + (nreverse sigs-in) + (nreverse sigs-var) + (nreverse sigs-modports) + (nreverse sigs-assign) + (nreverse sigs-const) + (nreverse sigs-gparam) + (nreverse sigs-intf))) + ;;(if dbg (verilog-decls-princ tmp)) + tmp))) (defvar verilog-read-sub-decls-in-interfaced nil "For `verilog-read-sub-decls', process next signal as under interfaced block.") @@ -9352,12 +9498,12 @@ Return modi if successful, else print message unless IGNORE-ERROR is true." ;;(message "verilog-modi-lookup: HIT %S" modi) modi) ;; Miss - (t (let* ((realmod (verilog-symbol-detick module t)) - (orig-filenames (verilog-module-filenames realmod current)) + (t (let* ((realname (verilog-symbol-detick module t)) + (orig-filenames (verilog-module-filenames realname current)) (filenames orig-filenames) mif) (while (and filenames (not mif)) - (if (not (setq mif (verilog-module-inside-filename-p realmod (car filenames)))) + (if (not (setq mif (verilog-module-inside-filename-p realname (car filenames)))) (setq filenames (cdr filenames)))) ;; mif has correct form to become later elements of modi (cond (mif (setq modi mif)) @@ -9365,8 +9511,8 @@ Return modi if successful, else print message unless IGNORE-ERROR is true." (or ignore-error (error (concat (verilog-point-text) ": Can't locate " module " module definition" - (if (not (equal module realmod)) - (concat " (Expanded macro to " realmod ")") + (if (not (equal module realname)) + (concat " (Expanded macro to " realname ")") "") "\n Check the verilog-library-directories variable." "\n I looked in (if not listed, doesn't exist):\n\t" @@ -9465,6 +9611,45 @@ and invalidating the cache." (progn ,@body))) +(defun verilog-modi-modport-lookup-one (modi name &optional ignore-error) + "Given a MODI, return the declarations related to the given modport NAME." + ;; Recursive routine - see below + (let* ((realname (verilog-symbol-detick name t)) + (modport (assoc name (verilog-decls-get-modports (verilog-modi-get-decls modi))))) + (or modport ignore-error + (error (concat (verilog-point-text) + ": Can't locate " name " modport definition" + (if (not (equal name realname)) + (concat " (Expanded macro to " realname ")") + "")))) + (let* ((decls (verilog-modport-decls modport)) + (clks (verilog-modport-clockings modport))) + ;; Now expand any clocking's + (while clks + (setq decls (verilog-decls-append + decls + (verilog-modi-modport-lookup-one modi (car clks) ignore-error))) + (setq clks (cdr clks))) + decls))) + +(defun verilog-modi-modport-lookup (modi name-re &optional ignore-error) + "Given a MODI, return the declarations related to the given modport NAME-RE. +If the modport points to any clocking blocks, expand the signals to include +those clocking block's signals." + ;; Recursive routine - see below + (let* ((mod-decls (verilog-modi-get-decls modi)) + (clks (verilog-decls-get-modports mod-decls)) + (name-re (concat "^" name-re "$")) + (decls (verilog-decls-new nil nil nil nil nil nil nil nil nil))) + ;; Pull in all modports + (while clks + (when (string-match name-re (verilog-modport-name (car clks))) + (setq decls (verilog-decls-append + decls + (verilog-modi-modport-lookup-one modi (verilog-modport-name (car clks)) ignore-error)))) + (setq clks (cdr clks))) + decls)) + (defun verilog-signals-matching-enum (in-list enum) "Return all signals in IN-LIST matching the given ENUM." (let (out-list) @@ -9544,6 +9729,13 @@ if non-nil." (verilog-decls-get-inouts decls) (verilog-decls-get-inputs decls))) +(defun verilog-decls-get-iovars (decls) + (append + (verilog-decls-get-vars decls) + (verilog-decls-get-outputs decls) + (verilog-decls-get-inouts decls) + (verilog-decls-get-inputs decls))) + (defsubst verilog-modi-cache-add-outputs (modi sig-list) (verilog-modi-cache-add modi 'verilog-read-decls 0 sig-list)) (defsubst verilog-modi-cache-add-inouts (modi sig-list) @@ -9552,6 +9744,8 @@ if non-nil." (verilog-modi-cache-add modi 'verilog-read-decls 2 sig-list)) (defsubst verilog-modi-cache-add-vars (modi sig-list) (verilog-modi-cache-add modi 'verilog-read-decls 3 sig-list)) +(defsubst verilog-modi-cache-add-gparams (modi sig-list) + (verilog-modi-cache-add modi 'verilog-read-decls 7 sig-list)) ;; @@ -9608,6 +9802,8 @@ When MODI is non-null, also add to modi-cache, for tracking." (when verilog-auto-declare-nettype (verilog-modi-cache-add-vars modi sigs))) ((equal direction "interface")) + ((equal direction "parameter") + (verilog-modi-cache-add-gparams modi sigs)) (t (error "Unsupported verilog-insert-definition direction: %s" direction)))) (or dont-sort @@ -9654,6 +9850,11 @@ Presumes that any newlines end a list element." stuff (cdr stuff))))) ;;(let ((indent-pt 10)) (verilog-insert-indent "hello\n" "addon" "there\n")) +(defun verilog-forward-or-insert-line () + "Move forward a line, unless at EOB, then insert a newline." + (if (eobp) (insert "\n") + (forward-line))) + (defun verilog-repair-open-comma () "Insert comma if previous argument is other than an open parenthesis or endif." ;; We can't just search backward for ) as it might be inside another expression. @@ -9741,6 +9942,17 @@ This repairs those mis-inserted by an AUTOARG." "\\([])}:*+-]\\)") out) (setq out (replace-match "\\1\\2\\3" nil nil out))) + (while (string-match + (concat "\\([[({:*+-]\\)" ; - must be last + "\\$clog2\\s *(\\<\\([0-9]+\\))" + "\\([])}:*+-]\\)") + out) + (setq out (replace-match + (concat + (match-string 1 out) + (int-to-string (verilog-clog2 (string-to-number (match-string 2 out)))) + (match-string 3 out)) + nil nil out))) ;; For precedence do * before +/- (while (string-match (concat "\\([[({:*+-]\\)" @@ -9777,6 +9989,7 @@ This repairs those mis-inserted by an AUTOARG." post) nil nil out)) ))) out))) + ;;(verilog-simplify-range-expression "[1:3]") ;; 1 ;;(verilog-simplify-range-expression "[(1):3]") ;; 1 ;;(verilog-simplify-range-expression "[(((16)+1)+1+(1+1))]") ;;20 @@ -9785,6 +9998,14 @@ This repairs those mis-inserted by an AUTOARG." ;;(verilog-simplify-range-expression "[(FOO*4+1-1)]") ;; FOO*4+0 ;;(verilog-simplify-range-expression "[(func(BAR))]") ;; func(BAR) ;;(verilog-simplify-range-expression "[FOO-1+1-1+1]") ;; FOO-0 +;;(verilog-simplify-range-expression "[$clog2(2)]") ;; 1 +;;(verilog-simplify-range-expression "[$clog2(7)]") ;; 3 + +(defun verilog-clog2 (value) + "Compute $clog2 - ceiling log2 of VALUE." + (if (< value 1) + 0 + (ceiling (/ (log value) (log 2))))) (defun verilog-typedef-name-p (variable-name) "Return true if the VARIABLE-NAME is a type definition." @@ -10348,6 +10569,86 @@ Avoid declaring ports manually, as it makes code harder to maintain." (insert "\n")) (indent-to verilog-indent-level-declaration)))) +(defun verilog-auto-assign-modport () + "Expand AUTOASSIGNMODPORT statements, as part of \\[verilog-auto]. +Take input/output/inout statements from the specified interface +and modport and use to build assignments into the modport, for +making verification modules that connect to UVM interfaces. + + The first parameter is the name of an interface. + + The second parameter is a regexp of modports to read from in + that interface. + + The third parameter is the instance name to use to dot reference into. + + The optional fourth parameter is a regular expression, and only + signals matching the regular expression will be included. + +Limitations: + + Interface names must be resolvable to filenames. See `verilog-auto-inst'. + + Inouts are not supported, as assignments must be unidirectional. + + If a signal is part of the interface header and in both a + modport and the interface itself, it will not be listed. (As + this would result in a syntax error when the connections are + made.) + +See the example in `verilog-auto-inout-modport'." + (save-excursion + (let* ((params (verilog-read-auto-params 3 4)) + (submod (nth 0 params)) + (modport-re (nth 1 params)) + (inst-name (nth 2 params)) + (regexp (nth 3 params)) + direction-re submodi) ;; direction argument not supported until requested + ;; Lookup position, etc of co-module + ;; Note this may raise an error + (when (setq submodi (verilog-modi-lookup submod t)) + (let* ((indent-pt (current-indentation)) + (modi (verilog-modi-current)) + (submoddecls (verilog-modi-get-decls submodi)) + (submodportdecls (verilog-modi-modport-lookup submodi modport-re)) + (sig-list-i (verilog-signals-in ;; Decls doesn't have data types, must resolve + (verilog-decls-get-vars submoddecls) + (verilog-signals-not-in + (verilog-decls-get-inputs submodportdecls) + (verilog-decls-get-ports submoddecls)))) + (sig-list-o (verilog-signals-in ;; Decls doesn't have data types, must resolve + (verilog-decls-get-vars submoddecls) + (verilog-signals-not-in + (verilog-decls-get-outputs submodportdecls) + (verilog-decls-get-ports submoddecls))))) + (forward-line 1) + (setq sig-list-i (verilog-signals-edit-wire-reg + (verilog-signals-matching-dir-re + (verilog-signals-matching-regexp sig-list-i regexp) + "input" direction-re)) + sig-list-o (verilog-signals-edit-wire-reg + (verilog-signals-matching-dir-re + (verilog-signals-matching-regexp sig-list-o regexp) + "output" direction-re))) + (setq sig-list-i (sort (copy-alist sig-list-i) `verilog-signals-sort-compare)) + (setq sig-list-o (sort (copy-alist sig-list-o) `verilog-signals-sort-compare)) + (when (or sig-list-i sig-list-o) + (verilog-insert-indent "// Beginning of automatic assignments from modport\n") + ;; Don't sort them so an upper AUTOINST will match the main module + (let ((sigs sig-list-o)) + (while sigs + (verilog-insert-indent "assign " (verilog-sig-name (car sigs)) + " = " inst-name + "." (verilog-sig-name (car sigs)) ";\n") + (setq sigs (cdr sigs)))) + (let ((sigs sig-list-i)) + (while sigs + (verilog-insert-indent "assign " inst-name + "." (verilog-sig-name (car sigs)) + " = " (verilog-sig-name (car sigs)) ";\n") + (setq sigs (cdr sigs)))) + (verilog-insert-indent "// End of automatics\n"))))))) + (defun verilog-auto-inst-port-map (port-st) nil) @@ -11067,8 +11368,8 @@ Typing \\[verilog-auto] will make this into: (verilog-subdecls-get-interfaced modsubdecls) (verilog-subdecls-get-outputs modsubdecls) (verilog-subdecls-get-inouts modsubdecls))))) - (forward-line 1) (when sig-list + (verilog-forward-or-insert-line) (verilog-insert-indent "// Beginning of automatic regs (for this module's undeclared outputs)\n") (verilog-insert-definition modi sig-list "reg" indent-pt nil) (verilog-insert-indent "// End of automatics\n"))))) @@ -11122,8 +11423,8 @@ Typing \\[verilog-auto] will make this into: (verilog-subdecls-get-inouts modsubdecls)) (append (verilog-decls-get-signals moddecls) (verilog-decls-get-assigns moddecls)))))) - (forward-line 1) (when sig-list + (verilog-forward-or-insert-line) (verilog-insert-indent "// Beginning of automatic reg inputs (for undeclared instantiated-module inputs)\n") (verilog-insert-definition modi sig-list "reg" indent-pt nil) (verilog-insert-indent "// End of automatics\n"))))) @@ -11210,8 +11511,8 @@ Typing \\[verilog-auto] will make this into: (append (verilog-subdecls-get-outputs modsubdecls) (verilog-subdecls-get-inouts modsubdecls)) (verilog-decls-get-signals moddecls))))) - (forward-line 1) (when sig-list + (verilog-forward-or-insert-line) (verilog-insert-indent "// Beginning of automatic wires (for undeclared instantiated-module outputs)\n") (verilog-insert-definition modi sig-list "wire" indent-pt nil) (verilog-insert-indent "// End of automatics\n") @@ -11221,7 +11522,7 @@ Typing \\[verilog-auto] will make this into: ;; syntax-ppss which is broken when change hooks are disabled. )))) -(defun verilog-auto-output (&optional with-params) +(defun verilog-auto-output () "Expand AUTOOUTPUT statements, as part of \\[verilog-auto]. Make output statements for any output signal from an /*AUTOINST*/ that isn't an input to another AUTOINST. This is useful for modules which @@ -11273,8 +11574,8 @@ same expansion will result from only extracting outputs starting with ov: (save-excursion ;; Point must be at insertion point. (let* ((indent-pt (current-indentation)) - (regexp (and with-params - (nth 0 (verilog-read-auto-params 1)))) + (params (verilog-read-auto-params 0 1)) + (regexp (nth 0 params)) (v2k (verilog-in-paren-quick)) (modi (verilog-modi-current)) (moddecls (verilog-modi-get-decls modi)) @@ -11290,7 +11591,7 @@ same expansion will result from only extracting outputs starting with ov: sig-list regexp))) (setq sig-list (verilog-signals-not-matching-regexp sig-list verilog-auto-output-ignore-regexp)) - (forward-line 1) + (verilog-forward-or-insert-line) (when v2k (verilog-repair-open-comma)) (when sig-list (verilog-insert-indent "// Beginning of automatic outputs (from unused autoinst outputs)\n") @@ -11340,7 +11641,7 @@ Typing \\[verilog-auto] will make this into: (verilog-signals-not-in (verilog-decls-get-signals moddecls) (verilog-decls-get-ports moddecls))))) - (forward-line 1) + (verilog-forward-or-insert-line) (when v2k (verilog-repair-open-comma)) (when sig-list (verilog-insert-indent "// Beginning of automatic outputs (every signal)\n") @@ -11348,7 +11649,7 @@ Typing \\[verilog-auto] will make this into: (verilog-insert-indent "// End of automatics\n")) (when v2k (verilog-repair-close-comma))))) -(defun verilog-auto-input (&optional with-params) +(defun verilog-auto-input () "Expand AUTOINPUT statements, as part of \\[verilog-auto]. Make input statements for any input signal into an /*AUTOINST*/ that isn't declared elsewhere inside the module. This is useful for modules which @@ -11399,8 +11700,8 @@ same expansion will result from only extracting inputs starting with i: /*AUTOINPUT(\"^i\")*/" (save-excursion (let* ((indent-pt (current-indentation)) - (regexp (and with-params - (nth 0 (verilog-read-auto-params 1)))) + (params (verilog-read-auto-params 0 1)) + (regexp (nth 0 params)) (v2k (verilog-in-paren-quick)) (modi (verilog-modi-current)) (moddecls (verilog-modi-get-decls modi)) @@ -11420,7 +11721,7 @@ same expansion will result from only extracting inputs starting with i: sig-list regexp))) (setq sig-list (verilog-signals-not-matching-regexp sig-list verilog-auto-input-ignore-regexp)) - (forward-line 1) + (verilog-forward-or-insert-line) (when v2k (verilog-repair-open-comma)) (when sig-list (verilog-insert-indent "// Beginning of automatic inputs (from unused autoinst inputs)\n") @@ -11428,7 +11729,7 @@ same expansion will result from only extracting inputs starting with i: (verilog-insert-indent "// End of automatics\n")) (when v2k (verilog-repair-close-comma))))) -(defun verilog-auto-inout (&optional with-params) +(defun verilog-auto-inout () "Expand AUTOINOUT statements, as part of \\[verilog-auto]. Make inout statements for any inout signal in an /*AUTOINST*/ that isn't declared elsewhere inside the module. @@ -11479,8 +11780,8 @@ same expansion will result from only extracting inouts starting with i: (save-excursion ;; Point must be at insertion point. (let* ((indent-pt (current-indentation)) - (regexp (and with-params - (nth 0 (verilog-read-auto-params 1)))) + (params (verilog-read-auto-params 0 1)) + (regexp (nth 0 params)) (v2k (verilog-in-paren-quick)) (modi (verilog-modi-current)) (moddecls (verilog-modi-get-decls modi)) @@ -11497,7 +11798,7 @@ same expansion will result from only extracting inouts starting with i: sig-list regexp))) (setq sig-list (verilog-signals-not-matching-regexp sig-list verilog-auto-inout-ignore-regexp)) - (forward-line 1) + (verilog-forward-or-insert-line) (when v2k (verilog-repair-open-comma)) (when sig-list (verilog-insert-indent "// Beginning of automatic inouts (from unused autoinst inouts)\n") @@ -11739,6 +12040,225 @@ same expansion will result from only extracting signals starting with i: /*AUTOINOUTCOMP(\"ExampMain\",\"^i\")*/" (verilog-auto-inout-module nil t)) +(defun verilog-auto-inout-param () + "Expand AUTOINOUTPARAM statements, as part of \\[verilog-auto]. +Take input/output/inout statements from the specified module and insert +into the current module. This is useful for making null templates and +shell modules which need to have identical I/O with another module. +Any I/O which are already defined in this module will not be redefined. +For the complement of this function, see `verilog-auto-inout-comp', +and to make monitors with all inputs, see `verilog-auto-inout-in'. + +Limitations: + If placed inside the parenthesis of a module declaration, it creates + Verilog 2001 style, else uses Verilog 1995 style. + + Concatenation and outputting partial buses is not supported. + + Module names must be resolvable to filenames. See `verilog-auto-inst'. + + Signals are not inserted in the same order as in the original module, + though they will appear to be in the same order to an AUTOINST + instantiating either module. + + Signals declared as \"output reg\" or \"output wire\" etc will + lose the wire/reg declaration so that shell modules may + generate those outputs differently. However, \"output logic\" + is propagated. + +An example: + + module ExampShell (/*AUTOARG*/); + /*AUTOINOUTMODULE(\"ExampMain\")*/ + endmodule + + module ExampMain (i,o,io); + input i; + output o; + inout io; + endmodule + +Typing \\[verilog-auto] will make this into: + + module ExampShell (/*AUTOARG*/i,o,io); + /*AUTOINOUTMODULE(\"ExampMain\")*/ + // Beginning of automatic in/out/inouts (from specific module) + output o; + inout io; + input i; + // End of automatics + endmodule + +You may also provide an optional regular expression, in which case only +signals matching the regular expression will be included. For example the +same expansion will result from only extracting signals starting with i: + + /*AUTOINOUTMODULE(\"ExampMain\",\"^i\")*/ + +You may also provide an optional second regular expression, in +which case only signals which have that pin direction and data +type will be included. This matches against everything before +the signal name in the declaration, for example against +\"input\" (single bit), \"output logic\" (direction and type) or +\"output [1:0]\" (direction and implicit type). You also +probably want to skip spaces in your regexp. + +For example, the below will result in matching the output \"o\" +against the previous example's module: + + /*AUTOINOUTMODULE(\"ExampMain\",\"\",\"^output.*\")*/ + +You may also provide an optional third regular expression, in +which case any parameter names that match the given regexp will +be included. Including parameters is off by default. To include +all signals and parameters, use: + + /*AUTOINOUTMODULE(\"ExampMain\",\".*\",\".*\",\".*\")*/" + (save-excursion + (let* ((params (verilog-read-auto-params 1 2)) + (submod (nth 0 params)) + (regexp (nth 1 params)) + submodi) + ;; Lookup position, etc of co-module + ;; Note this may raise an error + (when (setq submodi (verilog-modi-lookup submod t)) + (let* ((indent-pt (current-indentation)) + (v2k (verilog-in-paren-quick)) + (modi (verilog-modi-current)) + (moddecls (verilog-modi-get-decls modi)) + (submoddecls (verilog-modi-get-decls submodi)) + (sig-list-p (verilog-signals-not-in + (verilog-decls-get-gparams submoddecls) + (append (verilog-decls-get-gparams moddecls))))) + (forward-line 1) + (setq sig-list-p (verilog-signals-matching-regexp sig-list-p regexp)) + (when v2k (verilog-repair-open-comma)) + (when sig-list-p + (verilog-insert-indent "// Beginning of automatic parameters (from specific module)\n") + ;; Don't sort them so an upper AUTOINST will match the main module + (verilog-insert-definition modi sig-list-p "parameter" indent-pt v2k t) + (verilog-insert-indent "// End of automatics\n")) + (when v2k (verilog-repair-close-comma))))))) + +(defun verilog-auto-inout-modport () + "Expand AUTOINOUTMODPORT statements, as part of \\[verilog-auto]. +Take input/output/inout statements from the specified interface +and modport and insert into the current module. This is useful +for making verification modules that connect to UVM interfaces. + + The first parameter is the name of an interface. + + The second parameter is a regexp of modports to read from in + that interface. + + The optional third parameter is a regular expression, and only + signals matching the regular expression will be included. + +Limitations: + If placed inside the parenthesis of a module declaration, it creates + Verilog 2001 style, else uses Verilog 1995 style. + + Interface names must be resolvable to filenames. See `verilog-auto-inst'. + +As with other autos, any inputs/outputs declared in the module +will suppress the AUTO from redeclarating an inputs/outputs by +the same name. + +An example: + + interface ExampIf + ( input logic clk ); + logic req_val; + logic [7:0] req_dat; + clocking mon_clkblk @(posedge clk); + input req_val; + input req_dat; + endclocking + modport mp(clocking mon_clkblk); + endinterface + + module ExampMain + ( input clk, + /*AUTOINOUTMODPORT(\"ExampIf\" \"mp\")*/ + // Beginning of automatic in/out/inouts (from modport) + input [7:0] req_dat, + input req_val + // End of automatics + ); + /*AUTOASSIGNMODPORT(\"ExampIf\" \"mp\")*/ + endmodule + +Typing \\[verilog-auto] will make this into: + + ... + module ExampMain + ( input clk, + /*AUTOINOUTMODPORT(\"ExampIf\" \"mp\")*/ + // Beginning of automatic in/out/inouts (from modport) + input req_dat, + input req_val + // End of automatics + ); + +If the modport is part of a UVM monitor/driver class, this +creates a wrapper module that may be used to instantiate the +driver/monitor using AUTOINST in the testbench." + (save-excursion + (let* ((params (verilog-read-auto-params 2 3)) + (submod (nth 0 params)) + (modport-re (nth 1 params)) + (regexp (nth 2 params)) + direction-re submodi) ;; direction argument not supported until requested + ;; Lookup position, etc of co-module + ;; Note this may raise an error + (when (setq submodi (verilog-modi-lookup submod t)) + (let* ((indent-pt (current-indentation)) + (v2k (verilog-in-paren-quick)) + (modi (verilog-modi-current)) + (moddecls (verilog-modi-get-decls modi)) + (submoddecls (verilog-modi-get-decls submodi)) + (submodportdecls (verilog-modi-modport-lookup submodi modport-re)) + (sig-list-i (verilog-signals-in ;; Decls doesn't have data types, must resolve + (verilog-decls-get-vars submoddecls) + (verilog-signals-not-in + (verilog-decls-get-inputs submodportdecls) + (append (verilog-decls-get-ports submoddecls) + (verilog-decls-get-ports moddecls))))) + (sig-list-o (verilog-signals-in ;; Decls doesn't have data types, must resolve + (verilog-decls-get-vars submoddecls) + (verilog-signals-not-in + (verilog-decls-get-outputs submodportdecls) + (append (verilog-decls-get-ports submoddecls) + (verilog-decls-get-ports moddecls))))) + (sig-list-io (verilog-signals-in ;; Decls doesn't have data types, must resolve + (verilog-decls-get-vars submoddecls) + (verilog-signals-not-in + (verilog-decls-get-inouts submodportdecls) + (append (verilog-decls-get-ports submoddecls) + (verilog-decls-get-ports moddecls)))))) + (forward-line 1) + (setq sig-list-i (verilog-signals-edit-wire-reg + (verilog-signals-matching-dir-re + (verilog-signals-matching-regexp sig-list-i regexp) + "input" direction-re)) + sig-list-o (verilog-signals-edit-wire-reg + (verilog-signals-matching-dir-re + (verilog-signals-matching-regexp sig-list-o regexp) + "output" direction-re)) + sig-list-io (verilog-signals-edit-wire-reg + (verilog-signals-matching-dir-re + (verilog-signals-matching-regexp sig-list-io regexp) + "inout" direction-re))) + (when v2k (verilog-repair-open-comma)) + (when (or sig-list-i sig-list-o sig-list-io) + (verilog-insert-indent "// Beginning of automatic in/out/inouts (from modport)\n") + ;; Don't sort them so an upper AUTOINST will match the main module + (verilog-insert-definition modi sig-list-o "output" indent-pt v2k t) + (verilog-insert-definition modi sig-list-io "inout" indent-pt v2k t) + (verilog-insert-definition modi sig-list-i "input" indent-pt v2k t) + (verilog-insert-indent "// End of automatics\n")) + (when v2k (verilog-repair-close-comma))))))) + (defun verilog-auto-insert-lisp () "Expand AUTOINSERTLISP statements, as part of \\[verilog-auto]. The Lisp code provided is called, and the Lisp code calls @@ -11789,7 +12309,7 @@ text: (backward-sexp 1) ;; Inside comment (point))) ;; Beginning paren (cmd (buffer-substring-no-properties cmd-beg-pt cmd-end-pt))) - (forward-line 1) + (verilog-forward-or-insert-line) ;; Some commands don't move point (like insert-file) so we always ;; add the begin/end comments, then delete it if not needed (verilog-insert-indent "// Beginning of automatic insert lisp\n") @@ -12042,6 +12562,7 @@ value's width is generated. An example of making a stub for another module: module ExampStub (/*AUTOINST*/); + /*AUTOINOUTPARAM(\"Foo\")*/ /*AUTOINOUTMODULE(\"Foo\")*/ /*AUTOTIEOFF*/ // verilator lint_off UNUSED @@ -12054,6 +12575,7 @@ An example of making a stub for another module: Typing \\[verilog-auto] will make this into: module ExampStub (/*AUTOINST*/...); + /*AUTOINOUTPARAM(\"Foo\")*/ /*AUTOINOUTMODULE(\"Foo\")*/ // Beginning of autotieoff output [2:0] foo; @@ -12084,7 +12606,7 @@ Typing \\[verilog-auto] will make this into: (setq sig-list (verilog-signals-not-matching-regexp sig-list verilog-auto-tieoff-ignore-regexp)) (when sig-list - (forward-line 1) + (verilog-forward-or-insert-line) (verilog-insert-indent "// Beginning of automatic tieoffs (for this module's unterminated outputs)\n") (setq sig-list (sort (copy-alist sig-list) `verilog-signals-sort-compare)) (verilog-modi-cache-add-vars modi sig-list) ; Before we trash list @@ -12161,7 +12683,7 @@ defines the regular expression will be undefed." ;; Insert (setq defs (sort defs 'string<)) (when defs - (forward-line 1) + (verilog-forward-or-insert-line) (verilog-insert-indent "// Beginning of automatic undefs\n") (while defs (verilog-insert-indent "`undef " (car defs) "\n") @@ -12198,6 +12720,7 @@ You can add signals you do not want included in AUTOUNUSED with An example of making a stub for another module: module ExampStub (/*AUTOINST*/); + /*AUTOINOUTPARAM(\"Examp\")*/ /*AUTOINOUTMODULE(\"Examp\")*/ /*AUTOTIEOFF*/ // verilator lint_off UNUSED @@ -12236,7 +12759,7 @@ Typing \\[verilog-auto] will make this into: (setq sig-list (verilog-signals-not-matching-regexp sig-list verilog-auto-unused-ignore-regexp)) (when sig-list - (forward-line 1) + (verilog-forward-or-insert-line) (verilog-insert-indent "// Beginning of automatic unused inputs\n") (setq sig-list (sort (copy-alist sig-list) `verilog-signals-sort-compare)) (while sig-list @@ -12335,10 +12858,7 @@ Typing \\[verilog-auto] will make this into: ;; (sig-list-consts (append (verilog-decls-get-consts moddecls) (verilog-decls-get-gparams moddecls))) - (sig-list-all (append (verilog-decls-get-vars moddecls) - (verilog-decls-get-outputs moddecls) - (verilog-decls-get-inouts moddecls) - (verilog-decls-get-inputs moddecls))) + (sig-list-all (verilog-decls-get-iovars moddecls)) ;; (undecode-sig (or (assoc undecode-name sig-list-all) (error "%s: Signal %s not found in design" (verilog-point-text) undecode-name))) @@ -12371,7 +12891,7 @@ Typing \\[verilog-auto] will make this into: elim-regexp))) tmp-sigs (cdr tmp-sigs)))) ;; - (forward-line 1) + (verilog-forward-or-insert-line) (verilog-insert-indent "// Beginning of automatic ASCII enum decoding\n") (let ((decode-sig-list (list (list ascii-name (format "[%d:0]" (- (* ascii-chars 8) 1)) (concat "Decode of " undecode-name) nil nil)))) @@ -12506,9 +13026,12 @@ Or check if AUTOs have the same expansion Using \\[describe-function], see also: `verilog-auto-arg' for AUTOARG module instantiations `verilog-auto-ascii-enum' for AUTOASCIIENUM enumeration decoding + `verilog-auto-assign-modport' for AUTOASSIGNMODPORT assignment to/from modport `verilog-auto-inout-comp' for AUTOINOUTCOMP copy complemented i/o `verilog-auto-inout-in' for AUTOINOUTIN inputs for all i/o + `verilog-auto-inout-modport' for AUTOINOUTMODPORT i/o from an interface modport `verilog-auto-inout-module' for AUTOINOUTMODULE copying i/o from elsewhere + `verilog-auto-inout-param' for AUTOINOUTPARAM copying params from elsewhere `verilog-auto-inout' for AUTOINOUT making hierarchy inouts `verilog-auto-input' for AUTOINPUT making hierarchy inputs `verilog-auto-insert-lisp' for AUTOINSERTLISP insert code from lisp function @@ -12598,27 +13121,24 @@ Wilson Snyder (wsnyder@wsnyder.org)." (verilog-auto-re-search-do "/\\*\\(AUTOSENSE\\|AS\\)\\*/" 'verilog-auto-sense) (verilog-auto-re-search-do "/\\*AUTORESET\\*/" 'verilog-auto-reset) ;; Must be done before autoin/out as creates a reg - (verilog-auto-re-search-do "/\\*AUTOASCIIENUM([^)]*)\\*/" 'verilog-auto-ascii-enum) + (verilog-auto-re-search-do "/\\*AUTOASCIIENUM(.*?)\\*/" 'verilog-auto-ascii-enum) ;; ;; first in/outs from other files - (verilog-auto-re-search-do "/\\*AUTOINOUTMODULE([^)]*)\\*/" 'verilog-auto-inout-module) - (verilog-auto-re-search-do "/\\*AUTOINOUTCOMP([^)]*)\\*/" 'verilog-auto-inout-comp) - (verilog-auto-re-search-do "/\\*AUTOINOUTIN([^)]*)\\*/" 'verilog-auto-inout-in) + (verilog-auto-re-search-do "/\\*AUTOINOUTMODPORT(.*?)\\*/" 'verilog-auto-inout-modport) + (verilog-auto-re-search-do "/\\*AUTOINOUTMODULE(.*?)\\*/" 'verilog-auto-inout-module) + (verilog-auto-re-search-do "/\\*AUTOINOUTCOMP(.*?)\\*/" 'verilog-auto-inout-comp) + (verilog-auto-re-search-do "/\\*AUTOINOUTIN(.*?)\\*/" 'verilog-auto-inout-in) + (verilog-auto-re-search-do "/\\*AUTOINOUTPARAM(.*?)\\*/" 'verilog-auto-inout-param) ;; next in/outs which need previous sucked inputs first - (verilog-auto-re-search-do "/\\*AUTOOUTPUT\\((\"[^\"]*\")\\)\\*/" - (lambda () (verilog-auto-output t))) - (verilog-auto-re-search-do "/\\*AUTOOUTPUT\\*/" 'verilog-auto-output) - (verilog-auto-re-search-do "/\\*AUTOINPUT\\((\"[^\"]*\")\\)\\*/" - (lambda () (verilog-auto-input t))) - (verilog-auto-re-search-do "/\\*AUTOINPUT\\*/" 'verilog-auto-input) - (verilog-auto-re-search-do "/\\*AUTOINOUT\\((\"[^\"]*\")\\)\\*/" - (lambda () (verilog-auto-inout t))) - (verilog-auto-re-search-do "/\\*AUTOINOUT\\*/" 'verilog-auto-inout) + (verilog-auto-re-search-do "/\\*AUTOOUTPUT\\((.*?)\\)?\\*/" 'verilog-auto-output) + (verilog-auto-re-search-do "/\\*AUTOINPUT\\((.*?)\\)?\\*/" 'verilog-auto-input) + (verilog-auto-re-search-do "/\\*AUTOINOUT\\((.*?)\\)?\\*/" 'verilog-auto-inout) ;; Then tie off those in/outs (verilog-auto-re-search-do "/\\*AUTOTIEOFF\\*/" 'verilog-auto-tieoff) ;; These can be anywhere after AUTOINSERTLISP - (verilog-auto-re-search-do "/\\*AUTOUNDEF\\((\"[^\"]*\")\\)?\\*/" 'verilog-auto-undef) + (verilog-auto-re-search-do "/\\*AUTOUNDEF\\((.*?)\\)?\\*/" 'verilog-auto-undef) ;; Wires/regs must be after inputs/outputs + (verilog-auto-re-search-do "/\\*AUTOASSIGNMODPORT(.*?)\\*/" 'verilog-auto-assign-modport) (verilog-auto-re-search-do "/\\*AUTOLOGIC\\*/" 'verilog-auto-logic) (verilog-auto-re-search-do "/\\*AUTOWIRE\\*/" 'verilog-auto-wire) (verilog-auto-re-search-do "/\\*AUTOREG\\*/" 'verilog-auto-reg) @@ -12696,7 +13216,7 @@ Wilson Snyder (wsnyder@wsnyder.org)." ;; ;; Place the templates into Verilog Mode. They may be inserted under any key. ;; C-c C-t will be the default. If you use templates a lot, you -;; may want to consider moving the binding to another key in your .emacs +;; may want to consider moving the binding to another key in your init ;; file. ;; ;; Note \C-c and letter are reserved for users diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 0ca3439dd60..52757b9eede 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -12522,6 +12522,7 @@ options vhdl-upper-case-{keywords,types,attributes,enum-values}." (defun vhdl-line-expand (&optional prefix-arg) "Hippie-expand current line." (interactive "P") + (require 'hippie-exp) (let ((case-fold-search t) (case-replace nil) (hippie-expand-try-functions-list '(try-expand-line try-expand-line-all-buffers))) diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 02340425dfa..4819149bdf6 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -234,9 +234,7 @@ It creates the Imenu index for the buffer, if necessary." (error "Error in which-func-update: %S" info)))))) ;;;###autoload -(defun which-func-mode (&optional arg) - (which-function-mode arg)) -(make-obsolete 'which-func-mode 'which-function-mode "24.1") +(define-obsolete-function-alias 'which-func-mode 'which-function-mode "24.1") (defvar which-func-update-timer nil) diff --git a/lisp/replace.el b/lisp/replace.el index f192574a7e2..82edb0037fb 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -378,35 +378,33 @@ regexp in `search-whitespace-regexp'. Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace only matches that are surrounded by word boundaries. Fourth and fifth arg START and END specify the region to operate on." + (declare (obsolete "use the `\\,' feature of `query-replace-regexp' +for interactive calls, and `search-forward-regexp'/`replace-match' +for Lisp calls." "22.1")) (interactive (progn - (barf-if-buffer-read-only) - (let* ((from - ;; Let-bind the history var to disable the "foo -> bar" default. - ;; Maybe we shouldn't disable this default, but for now I'll - ;; leave it off. --Stef - (let ((query-replace-to-history-variable nil)) - (query-replace-read-from "Query replace regexp" t))) - (to (list (read-from-minibuffer - (format "Query replace regexp %s with eval: " - (query-replace-descr from)) - nil nil t query-replace-to-history-variable from t)))) - ;; We make TO a list because replace-match-string-symbols requires one, - ;; and the user might enter a single token. - (replace-match-string-symbols to) - (list from (car to) current-prefix-arg - (if (and transient-mark-mode mark-active) - (region-beginning)) - (if (and transient-mark-mode mark-active) - (region-end)))))) + (barf-if-buffer-read-only) + (let* ((from + ;; Let-bind the history var to disable the "foo -> bar" + ;; default. Maybe we shouldn't disable this default, but + ;; for now I'll leave it off. --Stef + (let ((query-replace-to-history-variable nil)) + (query-replace-read-from "Query replace regexp" t))) + (to (list (read-from-minibuffer + (format "Query replace regexp %s with eval: " + (query-replace-descr from)) + nil nil t query-replace-to-history-variable from t)))) + ;; We make TO a list because replace-match-string-symbols requires one, + ;; and the user might enter a single token. + (replace-match-string-symbols to) + (list from (car to) current-prefix-arg + (if (and transient-mark-mode mark-active) + (region-beginning)) + (if (and transient-mark-mode mark-active) + (region-end)))))) (perform-replace regexp (cons 'replace-eval-replacement to-expr) t 'literal delimited nil nil start end)) -(make-obsolete 'query-replace-regexp-eval - "for interactive use, use the special `\\,' feature of -`query-replace-regexp' instead. Non-interactively, a loop -using `search-forward-regexp' and `replace-match' is preferred." "22.1") - (defun map-query-replace-regexp (regexp to-strings &optional n start end) "Replace some matches for REGEXP with various strings, in rotation. The second argument TO-STRINGS contains the replacement strings, separated diff --git a/lisp/savehist.el b/lisp/savehist.el index 215314d7053..cca958ff0a1 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -209,6 +209,7 @@ histories, which is probably undesirable." If `savehist-file' is in the old format that doesn't record the value of `savehist-minibuffer-history-variables', that value is deducted from the contents of the file." + (declare (obsolete savehist-mode "22.1")) (savehist-mode 1) ;; Old versions of savehist distributed with XEmacs didn't save ;; savehist-minibuffer-history-variables. If that variable is nil @@ -225,7 +226,6 @@ value is deducted from the contents of the file." ;; Collect VAR, i.e. (nth form 1). (push (nth 1 form) vars)) vars))))) -(make-obsolete 'savehist-load 'savehist-mode "22.1") (defun savehist-install () "Hook savehist into Emacs. diff --git a/lisp/server.el b/lisp/server.el index 4fd55bcf6d1..73c253a87a6 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -101,7 +101,12 @@ (defcustom server-host nil "The name or IP address to use as host address of the server process. -If set, the server accepts remote connections; otherwise it is local." +If set, the server accepts remote connections; otherwise it is local. + +DO NOT give this a non-nil value unless you know what you are +doing! On unsecured networks, accepting remote connections is +very dangerous, because server-client communication (including +session authentication) is not encrypted." :group 'server :type '(choice (string :tag "Name or IP address") @@ -140,12 +145,12 @@ directory residing in a NTFS partition instead." (defcustom server-auth-key nil "Server authentication key. +This is only used if `server-use-tcp' is non-nil. Normally, the authentication key is randomly generated when the -server starts, which guarantees some level of security. It is -recommended to leave it that way. Using a long-lived shared key -will decrease security (especially since the key is transmitted as -plain text). +server starts. It is recommended to leave it that way. Using a +long-lived shared key will decrease security (especially since +the key is transmitted as plain-text). In some situations however, it can be difficult to share randomly generated passwords with remote hosts (eg. no shared directory), @@ -153,11 +158,13 @@ so you can set the key with this variable and then copy the server file to the remote host (with possible changes to IP address and/or port if that applies). -The key must consist of 64 ASCII printable characters except for -space (this means characters from ! to ~; or from code 33 to 126). +Note that the usual security risks of using the server over +remote TCP, arising from the fact that client-server +communications are unencrypted, still apply. -You can use \\[server-generate-key] to get a random authentication -key." +The key must consist of 64 ASCII printable characters except for +space (this means characters from ! to ~; or from code 33 to +126). You can use \\[server-generate-key] to get a random key." :group 'server :type '(choice (const :tag "Random" nil) diff --git a/lisp/simple.el b/lisp/simple.el index e1b8f37e46c..616a4d7b1ea 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -606,7 +606,7 @@ buffer if the variable `delete-trailing-lines' is non-nil." (when (and (not end) delete-trailing-lines ;; Really the end of buffer. - (save-restriction (widen) (eobp)) + (= (point-max) (1+ (buffer-size))) (<= (skip-chars-backward "\n") -2)) (delete-region (1+ (point)) end-marker)) (set-marker end-marker nil)))) @@ -6380,9 +6380,8 @@ With prefix argument N, move N items (negative N means move backward)." (point)))) (defun choose-completion-delete-max-match (string) + (declare (obsolete choose-completion-guess-base-position "23.2")) (delete-region (choose-completion-guess-base-position string) (point))) -(make-obsolete 'choose-completion-delete-max-match - 'choose-completion-guess-base-position "23.2") (defvar choose-completion-string-functions nil "Functions that may override the normal insertion of a completion choice. diff --git a/lisp/startup.el b/lisp/startup.el index 243c9621752..6658e16683b 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -43,7 +43,10 @@ If the value is nil and `inhibit-startup-screen' is nil, show the startup screen. If the value is a string, visit the specified file or directory using `find-file'. If t, open the `*scratch*' -buffer." +buffer. + +A string value also causes emacsclient to open the specified file +or directory when no target file is specified." :type '(choice (const :tag "Startup screen" nil) (directory :tag "Directory" :value "~/") diff --git a/lisp/subr.el b/lisp/subr.el index b9b8e627672..8dfe78d8c75 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -271,9 +271,14 @@ the return value (nil if RESULT is omitted). ,@(cdr (cdr spec)))))) (defmacro declare (&rest _specs) - "Do not evaluate any arguments and return nil. -Treated as a declaration when used at the right place in a -`defmacro' form. \(See Info anchor `(elisp)Definition of declare'.)" + "Do not evaluate any arguments, and return nil. +If a `declare' form appears as the first form in the body of a +`defun' or `defmacro' form, SPECS specifies various additional +information about the function or macro; these go into effect +during the evaluation of the `defun' or `defmacro' form. + +The possible values of SPECS are specified by +`defun-declarations-alist' and `macro-declarations-alist'." ;; FIXME: edebug spec should pay attention to defun-declarations-alist. nil) )) @@ -461,18 +466,18 @@ If TEST is omitted or nil, `equal' is used." (setq tail (cdr tail))) value)) -(make-obsolete 'assoc-ignore-case 'assoc-string "22.1") (defun assoc-ignore-case (key alist) "Like `assoc', but ignores differences in case and text representation. KEY must be a string. Upper-case and lower-case letters are treated as equal. Unibyte strings are converted to multibyte for comparison." + (declare (obsolete assoc-string "22.1")) (assoc-string key alist t)) -(make-obsolete 'assoc-ignore-representation 'assoc-string "22.1") (defun assoc-ignore-representation (key alist) "Like `assoc', but ignores differences in text representation. KEY must be a string. Unibyte strings are converted to multibyte for comparison." + (declare (obsolete assoc-string "22.1")) (assoc-string key alist nil)) (defun member-ignore-case (elt list) @@ -1179,12 +1184,13 @@ be a list of the form returned by `event-start' and `event-end'." "Mocklisp-compatibility insert function. Like the function `insert' except that any argument that is a number is converted into a string by expressing it in decimal." + (declare (obsolete insert "22.1")) (dolist (el args) (insert (if (integerp el) (number-to-string el) el)))) -(make-obsolete 'insert-string 'insert "22.1") -(defun makehash (&optional test) (make-hash-table :test (or test 'eql))) -(make-obsolete 'makehash 'make-hash-table "22.1") +(defun makehash (&optional test) + (declare (obsolete make-hash-table "22.1")) + (make-hash-table :test (or test 'eql))) ;; These are used by VM and some old programs (defalias 'focus-frame 'ignore "") @@ -1250,11 +1256,6 @@ is converted into a string by expressing it in decimal." (make-obsolete 'process-filter-multibyte-p nil "23.1") (make-obsolete 'set-process-filter-multibyte nil "23.1") -(make-obsolete-variable - 'mode-line-inverse-video - "use the appropriate faces instead." - "21.1") - ;; Lisp manual only updated in 22.1. (define-obsolete-variable-alias 'executing-macro 'executing-kbd-macro "before 19.34") @@ -1911,8 +1912,8 @@ This function is called directly from the C code." "Read the following input sexp, and run it whenever FILE is loaded. This makes or adds to an entry on `after-load-alist'. FILE should be the name of a library, with no directory name." + (declare (obsolete eval-after-load "23.2")) (eval-after-load file (read))) -(make-obsolete 'eval-next-after-load `eval-after-load "23.2") (defun display-delayed-warnings () "Display delayed warnings from `delayed-warnings-list'. diff --git a/lisp/term.el b/lisp/term.el index d5f35006357..7567bd38f5a 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -994,7 +994,10 @@ is buffer-local." (setq term-ansi-current-reverse nil) (setq term-ansi-current-color 0) (setq term-ansi-current-invisible nil) - (setq term-ansi-face-already-done t) + ;; Stefan thought this should be t, but could not remember why. + ;; Setting it to t seems to cause bug#11785. Setting it to nil + ;; again to see if there are other consequences... + (setq term-ansi-face-already-done nil) (setq term-ansi-current-bg-color 0)) (define-derived-mode term-mode fundamental-mode "Term" @@ -4048,6 +4051,7 @@ Returns `partial' if completed as far as possible with the completion matches. Returns `listed' if a completion listing was shown. See also `term-dynamic-complete-filename'." + (declare (obsolete completion-in-region "23.2")) (let* ((completion-ignore-case nil) (candidates (mapcar (function (lambda (x) (list x))) candidates)) (completions (all-completions stub candidates))) @@ -4081,8 +4085,6 @@ See also `term-dynamic-complete-filename'." (t (message "Partially completed") 'partial))))))) -(make-obsolete 'term-dynamic-simple-complete 'completion-in-region "23.2") - (defun term-dynamic-list-filename-completions () "List in help buffer possible completions of the filename at point." diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 31656918fad..e0d93b68056 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -1002,6 +1002,7 @@ See `bibtex-generate-autokey' for details." ("\\\\`\\|\\\\'\\|\\\\\\^\\|\\\\~\\|\\\\=\\|\\\\\\.\\|\\\\u\\|\\\\v\\|\\\\H\\|\\\\t\\|\\\\c\\|\\\\d\\|\\\\b" . "") ;; braces, quotes, concatenation. ("[`'\"{}#]" . "") + ("\\\\-" . "") ; \- -> ;; spaces ("\\\\?[ \t\n]+\\|~" . " ")) "Alist of (OLD-REGEXP . NEW-STRING) pairs. @@ -4893,21 +4894,22 @@ If mark is active reformat entries in region, if not in whole buffer." (if use-previous-options bibtex-reformat-previous-options (setq bibtex-reformat-previous-options - (mapcar (lambda (option) - (if (y-or-n-p (car option)) (cdr option))) - `(("Realign entries (recommended)? " . 'realign) - ("Remove empty optional and alternative fields? " . 'opts-or-alts) - ("Remove delimiters around pure numerical fields? " . 'numerical-fields) - (,(concat (if bibtex-comma-after-last-field "Insert" "Remove") - " comma at end of entry? ") . 'last-comma) - ("Replace double page dashes by single ones? " . 'page-dashes) - ("Delete whitespace at the beginning and end of fields? " . 'whitespace) - ("Inherit booktitle? " . 'inherit-booktitle) - ("Force delimiters? " . 'delimiters) - ("Unify case of entry types and field names? " . 'unify-case) - ("Enclose parts of field entries by braces? " . 'braces) - ("Replace parts of field entries by string constants? " . 'strings) - ("Sort fields? " . 'sort-fields)))))) + (delq nil + (mapcar (lambda (option) + (if (y-or-n-p (car option)) (cdr option))) + `(("Realign entries (recommended)? " . realign) + ("Remove empty optional and alternative fields? " . opts-or-alts) + ("Remove delimiters around pure numerical fields? " . numerical-fields) + (,(concat (if bibtex-comma-after-last-field "Insert" "Remove") + " comma at end of entry? ") . last-comma) + ("Replace double page dashes by single ones? " . page-dashes) + ("Delete whitespace at the beginning and end of fields? " . whitespace) + ("Inherit booktitle? " . inherit-booktitle) + ("Force delimiters? " . delimiters) + ("Unify case of entry types and field names? " . unify-case) + ("Enclose parts of field entries by braces? " . braces) + ("Replace parts of field entries by string constants? " . strings) + ("Sort fields? " . sort-fields))))))) ;; Do not include required-fields because `bibtex-reformat' ;; cannot handle the error messages of `bibtex-format-entry'. ;; Use `bibtex-validate' to check for required fields. diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el index 31001c78e54..229d12b2906 100644 --- a/lisp/textmodes/reftex-cite.el +++ b/lisp/textmodes/reftex-cite.el @@ -542,10 +542,7 @@ (t "")))) (setq authors (reftex-truncate authors 30 t t)) (when (reftex-use-fonts) - (put-text-property 0 (length key) 'face - (reftex-verified-face reftex-label-face - 'font-lock-constant-face - 'font-lock-reference-face) + (put-text-property 0 (length key) 'face reftex-label-face key) (put-text-property 0 (length authors) 'face reftex-bib-author-face authors) diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index 2d395fe3df2..1d15dfbed7e 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -585,9 +585,7 @@ SPC=view TAB=goto RET=goto+hide [e]dit [q]uit [r]escan [f]ollow [?]Help (if (memq reftex-highlight-selection '(mouse both)) reftex-mouse-selected-face nil)) - (index-face (reftex-verified-face reftex-label-face - 'font-lock-constant-face - 'font-lock-reference-face)) + (index-face reftex-label-face) sublist cell from to first-char) ;; Make the sublist and sort it diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el index 627dfba0071..1a400436311 100644 --- a/lisp/textmodes/reftex-sel.el +++ b/lisp/textmodes/reftex-sel.el @@ -245,12 +245,8 @@ During a selection process, these are the local bindings. (if (memq reftex-highlight-selection '(mouse both)) reftex-mouse-selected-face nil)) - (label-face (reftex-verified-face reftex-label-face - 'font-lock-constant-face - 'font-lock-reference-face)) - (index-face (reftex-verified-face reftex-index-face - 'font-lock-constant-face - 'font-lock-reference-face)) + (label-face reftex-label-face) + (index-face reftex-index-face) all cell text label typekey note comment master-dir-re prev-inserted offset from to index-tag docstruct-symbol) diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index 8584c496a97..8318dc0d5f3 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -2311,9 +2311,7 @@ IGNORE-WORDS List of words which should be removed from the string." ;; Return the first valid face in FACES, or nil if none is valid. ;; Also, when finding a nil element in FACES, return nil. This ;; function is just a safety net to catch name changes of builtin - ;; fonts. Currently it is only used for reftex-label-face, which has - ;; as default font-lock-reference-face, which was recently renamed - ;; to font-lock-constant-face. + ;; fonts. Currently it is only used for reftex-label-face. (let (face) (catch 'exit (while (setq face (pop faces)) diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index eeafe586c27..869da63064a 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -118,7 +118,8 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Support for `testcover' -(when (boundp 'testcover-1value-functions) +(when (and (boundp 'testcover-1value-functions) + (boundp 'testcover-compose-functions)) ;; Below `lambda' is used in a loop with varying parameters and is thus not ;; 1valued. (setq testcover-1value-functions @@ -217,7 +218,7 @@ and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match." ;; Use CVSHeader to really get information from CVS and not other version ;; control systems. (defconst rst-cvs-header - "$CVSHeader: sm/rst_el/rst.el,v 1.327.2.1 2012-09-22 09:06:56 stefan Exp $") + "$CVSHeader: sm/rst_el/rst.el,v 1.327.2.2 2012-09-23 14:44:25 stefan Exp $") (defconst rst-cvs-rev (rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+" " .*" rst-cvs-header "0.0") @@ -246,7 +247,7 @@ SVN revision is the upstream (docutils) revision.") "Official version of the package.") (defconst rst-official-cvs-rev (rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " - "$Revision: 1.327.2.1 $") + "$Revision: 1.327.2.2 $") "CVS revision of this file in the official version.") (defconst rst-version diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 67d7f8c01f9..46c65b25b37 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -34,7 +34,6 @@ (eval-when-compile (require 'skeleton) - (require 'outline) (require 'cl-lib)) (defgroup sgml nil @@ -1938,6 +1937,10 @@ This takes effect when first loading the library.") ("wbr" . "Enable <br> within <nobr>")) "Value of `sgml-tag-help' for HTML mode.") +(defvar outline-regexp) +(defvar outline-heading-end-regexp) +(defvar outline-level) + ;;;###autoload (define-derived-mode html-mode sgml-mode '(sgml-xml-mode "XHTML" "HTML") diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 620a1da633e..a324daa9283 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -860,10 +860,6 @@ START is the position of the \\ and DELIM is the delimiter char." (set-keymap-parent map text-mode-map) (tex-define-common-keys map) (define-key map "\"" 'tex-insert-quote) - (define-key map "(" 'skeleton-pair-insert-maybe) - (define-key map "{" 'skeleton-pair-insert-maybe) - (define-key map "[" 'skeleton-pair-insert-maybe) - (define-key map "$" 'skeleton-pair-insert-maybe) (define-key map "\n" 'tex-terminate-paragraph) (define-key map "\M-\r" 'latex-insert-item) (define-key map "\C-c}" 'up-list) diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el index 30e5390a3e1..301f69f45be 100644 --- a/lisp/textmodes/text-mode.el +++ b/lisp/textmodes/text-mode.el @@ -80,18 +80,29 @@ Turning on Paragraph-Indent Text mode runs the normal hooks :abbrev-table nil :syntax-table nil (paragraph-indent-minor-mode)) -(defun paragraph-indent-minor-mode () +(define-minor-mode paragraph-indent-minor-mode "Minor mode for editing text, with leading spaces starting a paragraph. In this mode, you do not need blank lines between paragraphs when the first line of the following paragraph starts with whitespace, as with `paragraph-indent-text-mode'. Turning on Paragraph-Indent minor mode runs the normal hook `paragraph-indent-text-mode-hook'." - (interactive) - (set (make-local-variable 'paragraph-start) - (concat "[ \t\n\f]\\|" paragraph-start)) - (set (make-local-variable 'indent-line-function) 'indent-to-left-margin) - (run-hooks 'paragraph-indent-text-mode-hook)) + :initial-value nil + ;; Change the definition of a paragraph start. + (let ((ps-re "[ \t\n\f]\\|")) + (if (eq t (compare-strings ps-re nil nil + paragraph-start nil (length ps-re))) + (if (not paragraph-indent-minor-mode) + (set (make-local-variable 'paragraph-start) + (substring paragraph-start (length ps-re)))) + (if paragraph-indent-minor-mode + (set (make-local-variable 'paragraph-start) + (concat ps-re paragraph-start))))) + ;; Change the indentation function. + (if paragraph-indent-minor-mode + (set (make-local-variable 'indent-line-function) 'indent-to-left-margin) + (if (eq indent-line-function 'indent-to-left-margin) + (set (make-local-variable 'indent-line-function) 'indent-region)))) (defalias 'indented-text-mode 'text-mode) diff --git a/lisp/tutorial.el b/lisp/tutorial.el index 64879e5cfd5..6f76068ea9d 100644 --- a/lisp/tutorial.el +++ b/lisp/tutorial.el @@ -765,14 +765,13 @@ Run the Viper tutorial? ")) (funcall 'viper-tutorial 0)) (message "Tutorial aborted by user")) (message prompt1))) - (let* ((lang (if arg - (let ((minibuffer-setup-hook minibuffer-setup-hook)) - (add-hook 'minibuffer-setup-hook - 'minibuffer-completion-help) - (read-language-name 'tutorial "Language: " "English")) - (if (get-language-info current-language-environment 'tutorial) - current-language-environment - "English"))) + (let* ((lang (cond + (arg + (minibuffer-with-setup-hook #'minibuffer-completion-help + (read-language-name 'tutorial "Language: " "English"))) + ((get-language-info current-language-environment 'tutorial) + current-language-environment) + (t "English"))) (filename (get-language-info lang 'tutorial)) (tut-buf-name filename) (old-tut-buf (get-buffer tut-buf-name)) diff --git a/lisp/type-break.el b/lisp/type-break.el index 8a95508d939..949b3b720a0 100644 --- a/lisp/type-break.el +++ b/lisp/type-break.el @@ -1,4 +1,4 @@ -;;; type-break.el --- encourage rests from typing at appropriate intervals +;;; type-break.el --- encourage rests from typing at appropriate intervals -*- lexical-binding: t -*- ;; Copyright (C) 1994-1995, 1997, 2000-2012 Free Software Foundation, Inc. @@ -69,26 +69,11 @@ :prefix "type-break" :group 'keyboard) -;;;###autoload -(defcustom type-break-mode nil - "Toggle typing break mode. -See the docstring for the `type-break-mode' command for more information. -Setting this variable directly does not take effect; -use either \\[customize] or the function `type-break-mode'." - :set (lambda (_symbol value) - (type-break-mode (if value 1 -1))) - :initialize 'custom-initialize-default - :type 'boolean - :group 'type-break - :require 'type-break) - -;;;###autoload (defcustom type-break-interval (* 60 60) "Number of seconds between scheduled typing breaks." :type 'integer :group 'type-break) -;;;###autoload (defcustom type-break-good-rest-interval (/ type-break-interval 6) "Number of seconds of idle time considered to be an adequate typing rest. @@ -98,10 +83,10 @@ rest from typing, then the next typing break is simply rescheduled for later. If a break is interrupted before this much time elapses, the user will be asked whether or not really to interrupt the break." + :set-after '(type-break-interval) :type 'integer :group 'type-break) -;;;###autoload (defcustom type-break-good-break-interval nil "Number of seconds considered to be an adequate explicit typing rest. @@ -112,7 +97,6 @@ break interruptions when `type-break-good-rest-interval' is nil." :type 'integer :group 'type-break) -;;;###autoload (defcustom type-break-keystroke-threshold ;; Assuming typing speed is 35wpm (on the average, do you really ;; type more than that in a minute? I spend a lot of time reading mail @@ -147,6 +131,7 @@ keystroke even though they really require multiple keys to generate them. The command `type-break-guesstimate-keystroke-threshold' can be used to guess a reasonably good pair of values for this variable." + :set-after '(type-break-interval) :type 'sexp :group 'type-break) @@ -288,7 +273,7 @@ It will be either \"seconds\" or \"keystrokes\".") ;;;###autoload -(defun type-break-mode (&optional prefix) +(define-minor-mode type-break-mode "Enable or disable typing-break mode. This is a minor mode, but it is global to all buffers by default. @@ -361,74 +346,61 @@ Finally, a file (named `type-break-file-name') is used to store information across Emacs sessions. This provides recovery of the break status between sessions and after a crash. Manual changes to the file may result in problems." - (interactive "P") - (type-break-check-post-command-hook) + :lighter type-break-mode-line-format + :global t - (let ((already-enabled type-break-mode)) - (setq type-break-mode (>= (prefix-numeric-value prefix) 0)) + (type-break-check-post-command-hook) - (cond - ((and already-enabled type-break-mode) - (and (called-interactively-p 'interactive) - (message "Type Break mode is already enabled"))) - (type-break-mode - (when type-break-file-name - (with-current-buffer (find-file-noselect type-break-file-name 'nowarn) - (setq buffer-save-without-query t))) - - (or global-mode-string - (setq global-mode-string '(""))) - (or (assq 'type-break-mode-line-message-mode - minor-mode-alist) - (setq minor-mode-alist - (cons type-break-mode-line-format - minor-mode-alist))) - (type-break-keystroke-reset) - (type-break-mode-line-countdown-or-break nil) - - (setq type-break-time-last-break - (or (type-break-get-previous-time) - (current-time))) - - ;; schedule according to break time from session file - (type-break-schedule - (let (diff) - (if (and type-break-time-last-break - (< (setq diff (type-break-time-difference - type-break-time-last-break - (current-time))) - type-break-interval)) - ;; use the file's value - (progn - (setq type-break-keystroke-count - (type-break-get-previous-count)) - ;; file the time, in case it was read from the auto-save file - (type-break-file-time type-break-interval-start) - (setq type-break-interval-start type-break-time-last-break) - (- type-break-interval diff)) - ;; schedule from now - (setq type-break-interval-start (current-time)) - (type-break-file-time type-break-interval-start) - type-break-interval)) - type-break-interval-start - type-break-interval) - - (and (called-interactively-p 'interactive) - (message "Type Break mode is enabled and set"))) - (t - (type-break-keystroke-reset) - (type-break-mode-line-countdown-or-break nil) - (type-break-cancel-schedule) - (do-auto-save) - (when type-break-file-name - (with-current-buffer (find-file-noselect type-break-file-name - 'nowarn) - (set-buffer-modified-p nil) - (unlock-buffer) - (kill-this-buffer))) - (and (called-interactively-p 'interactive) - (message "Type Break mode is disabled"))))) - type-break-mode) + (cond + ;; ((and already-enabled type-break-mode) + ;; (and (called-interactively-p 'interactive) + ;; (message "Type Break mode is already enabled"))) + (type-break-mode + (when type-break-file-name + (with-current-buffer (find-file-noselect type-break-file-name 'nowarn) + (setq buffer-save-without-query t))) + + (or global-mode-string (setq global-mode-string '(""))) ;FIXME: Why? + (type-break-keystroke-reset) + (type-break-mode-line-countdown-or-break nil) + + (setq type-break-time-last-break + (or (type-break-get-previous-time) + (current-time))) + + ;; Schedule according to break time from session file. + (type-break-schedule + (let (diff) + (if (and type-break-time-last-break + (< (setq diff (type-break-time-difference + type-break-time-last-break + (current-time))) + type-break-interval)) + ;; Use the file's value. + (progn + (setq type-break-keystroke-count + (type-break-get-previous-count)) + ;; File the time, in case it was read from the auto-save file. + (type-break-file-time type-break-interval-start) + (setq type-break-interval-start type-break-time-last-break) + (- type-break-interval diff)) + ;; Schedule from now. + (setq type-break-interval-start (current-time)) + (type-break-file-time type-break-interval-start) + type-break-interval)) + type-break-interval-start + type-break-interval)) + (t + (type-break-keystroke-reset) + (type-break-mode-line-countdown-or-break nil) + (type-break-cancel-schedule) + (do-auto-save) + (when type-break-file-name + (with-current-buffer (find-file-noselect type-break-file-name + 'nowarn) + (set-buffer-modified-p nil) + (unlock-buffer) + (kill-this-buffer)))))) (define-minor-mode type-break-mode-line-message-mode "Toggle warnings about typing breaks in the mode line. @@ -997,10 +969,11 @@ FRAC should be the inverse of the fractional value; for example, a value of ;; "low" bits and format the time incorrectly. (defun type-break-time-sum (&rest tmlist) (let ((sum '(0 0 0))) - (dolist (tem tmlist sum) + (dolist (tem tmlist) (setq sum (time-add sum (if (integerp tem) (list (floor tem 65536) (mod tem 65536)) - tem)))))) + tem)))) + sum)) (defun type-break-time-stamp (&optional when) (if (fboundp 'format-time-string) diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index a72f12ccb9b..a00d748a4a4 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,22 @@ +2012-09-30 Stefan Monnier <monnier@iro.umontreal.ca> + + * url-handlers.el (url-file-handler): Don't assume any url-FOO function + is a good handler for FOO. + (url-copy-file, url-file-local-copy, url-insert-file-contents) + (url-file-name-completion, url-file-name-all-completions) + (url-handlers-create-wrapper): Explicitly register as handler. + +2012-09-29 Bastien Guerry <bzg@gnu.org> + + * url-util.el (url-insert-entities-in-string) + (url-build-query-string): Fix docstrings. + +2012-09-25 Chong Yidong <cyd@gnu.org> + + * url-parse.el (url-recreate-url-attributes): + * url-util.el (url-generate-unique-filename): Use declare to mark + obsolete. + 2012-08-14 Stefan Monnier <monnier@iro.umontreal.ca> * url-http.el (url-http-parse-headers): Re-enable file-name-handlers diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index f731f614d13..796980afbd5 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -137,11 +137,13 @@ like URLs \(Gnus is particularly bad at this\)." "Function called from the `file-name-handler-alist' routines. OPERATION is what needs to be done (`file-exists-p', etc). ARGS are the arguments that would have been passed to OPERATION." - (let ((fn (or (get operation 'url-file-handlers) - (intern-soft (format "url-%s" operation)))) + (let ((fn (get operation 'url-file-handlers)) (val nil) (hooked nil)) - (if (and fn (fboundp fn)) + (if (and (not fn) (intern-soft (format "url-%s" operation)) + (fboundp (intern-soft (format "url-%s" operation)))) + (error "Missing URL handler mapping for %s" operation)) + (if fn (setq hooked t val (save-match-data (apply fn args))) (setq hooked nil @@ -249,6 +251,7 @@ A prefix arg makes KEEP-TIME non-nil." (mm-save-part-to-file handle newname) (kill-buffer buffer) (mm-destroy-parts handle))) +(put 'copy-file 'url-file-handlers 'url-copy-file) ;;;###autoload (defun url-file-local-copy (url &rest ignored) @@ -258,6 +261,7 @@ accessible." (let ((filename (make-temp-file "url"))) (url-copy-file url filename 'ok-if-already-exists) filename)) +(put 'file-local-copy 'url-file-handlers 'url-file-local-copy) (defun url-insert (buffer &optional beg end) "Insert the body of a URL object. @@ -300,22 +304,29 @@ They count bytes from the beginning of the body." ;; usual heuristic/rules that we apply to files. (decode-coding-inserted-region start (point) url visit beg end replace)) (list url (car size-and-charset)))))) +(put 'insert-file-contents 'url-file-handlers 'url-insert-file-contents) (defun url-file-name-completion (url directory &optional predicate) (error "Unimplemented")) +(put 'file-name-completion 'url-file-handlers 'url-file-name-completion) (defun url-file-name-all-completions (file directory) (error "Unimplemented")) +(put 'file-name-all-completions + 'url-file-handlers 'url-file-name-all-completions) ;; All other handlers map onto their respective backends. (defmacro url-handlers-create-wrapper (method args) - `(defun ,(intern (format "url-%s" method)) ,args - ,(format "URL file-name-handler wrapper for `%s' call.\n---\n%s" method - (or (documentation method t) "No original documentation.")) - (setq url (url-generic-parse-url url)) - (when (url-type url) - (funcall (url-scheme-get-property (url-type url) (quote ,method)) - ,@(remove '&rest (remove '&optional args)))))) + `(progn + (defun ,(intern (format "url-%s" method)) ,args + ,(format "URL file-name-handler wrapper for `%s' call.\n---\n%s" method + (or (documentation method t) "No original documentation.")) + (setq url (url-generic-parse-url url)) + (when (url-type url) + (funcall (url-scheme-get-property (url-type url) (quote ,method)) + ,@(remove '&rest (remove '&optional args))))) + (unless (get ',method 'url-file-handlers) + (put ',method 'url-file-handlers ',(intern (format "url-%s" method)))))) (url-handlers-create-wrapper file-exists-p (url)) (url-handlers-create-wrapper file-attributes (url &optional id-format)) diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el index 4007d1f35b3..cb61a021251 100644 --- a/lisp/url/url-parse.el +++ b/lisp/url/url-parse.el @@ -98,6 +98,7 @@ If the specified port number is the default, return nil." (defun url-recreate-url-attributes (urlobj) "Recreate the attributes of an URL string from the parsed URLOBJ." + (declare (obsolete nil "24.3")) (when (url-attributes urlobj) (concat ";" (mapconcat (lambda (x) @@ -105,7 +106,6 @@ If the specified port number is the default, return nil." (concat (car x) "=" (cdr x)) (car x))) (url-attributes urlobj) ";")))) -(make-obsolete 'url-recreate-url-attributes nil "24.3") ;;;###autoload (defun url-generic-parse-url (url) diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index f654830e387..038b7fcf7fe 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -132,8 +132,8 @@ If a list, it is a list of the types of messages to be logged." (defun url-insert-entities-in-string (string) "Convert HTML markup-start characters to entity references in STRING. Also replaces the \" character, so that the result may be safely used as - an attribute value in a tag. Returns a new string with the result of the - conversion. Replaces these characters as follows: +an attribute value in a tag. Returns a new string with the result of the +conversion. Replaces these characters as follows: & ==> & < ==> < > ==> > @@ -294,7 +294,7 @@ Given a QUERY in the form: (key2 val2) (key3 val1 val2) (key4) - (key5 "")) + (key5 \"\")) \(This is the same format as produced by `url-parse-query-string') @@ -593,6 +593,7 @@ Has a preference for looking backward when not directly on a symbol." (defun url-generate-unique-filename (&optional fmt) "Generate a unique filename in `url-temporary-directory'." + (declare (obsolete make-temp-file "23.1")) ;; This variable is obsolete, but so is this function. (let ((tempdir (with-no-warnings url-temporary-directory))) (if (not fmt) @@ -614,7 +615,6 @@ Has a preference for looking backward when not directly on a symbol." (setq x (1+ x) fname (format fmt (concat base (int-to-string x))))) (expand-file-name fname tempdir))))) -(make-obsolete 'url-generate-unique-filename 'make-temp-file "23.1") (defun url-extract-mime-headers () "Set `url-current-mime-headers' in current buffer." diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index 674688df1c2..2c41ce8c457 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -753,6 +753,7 @@ to temp files in buffer jobs and when Ediff needs to find fine differences." "Check the current version against MAJOR and MINOR version numbers. The comparison uses operator OP, which may be any of: =, >, >=, <, <=. TYPE-OF-EMACS is either 'xemacs or 'emacs." + (declare (obsolete version< "23.1")) (and (cond ((eq type-of-emacs 'xemacs) (featurep 'xemacs)) ((eq type-of-emacs 'emacs) (featurep 'emacs)) (t)) @@ -767,9 +768,6 @@ TYPE-OF-EMACS is either 'xemacs or 'emacs." (t (error "%S: Invalid op in ediff-check-version" op))))) -;; ediff-check-version seems to be totally unused anyway. -(make-obsolete 'ediff-check-version 'version< "23.1") - (defun ediff-color-display-p () (condition-case nil (if (featurep 'xemacs) diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index 78a2163f653..86293ade580 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -1907,8 +1907,8 @@ in the specified buffer." (cond ((eq which-diff 'after) (1+ diff-no)) ((eq which-diff 'before) diff-no) - ((< (abs (count-lines pos (max 1 prev-end))) - (abs (count-lines pos (max 1 beg)))) + ((< (abs (count-lines pos (max (point-min) prev-end))) + (abs (count-lines pos (max (point-min) beg)))) diff-no) ; choose prev difference (t (1+ diff-no))) ; choose next difference diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el index eee3f40fd96..d7118ad7970 100644 --- a/lisp/vc/ediff-wind.el +++ b/lisp/vc/ediff-wind.el @@ -63,13 +63,11 @@ ;; Determine which window setup function to use based on current window system. (defun ediff-choose-window-setup-function-automatically () + (declare (obsolete ediff-setup-windows-default "24.3")) (if (ediff-window-display-p) 'ediff-setup-windows-multiframe 'ediff-setup-windows-plain)) -(make-obsolete 'ediff-choose-window-setup-function-automatically - 'ediff-setup-windows-default "24.3") - (defcustom ediff-window-setup-function 'ediff-setup-windows-default "Function called to set up windows. Ediff provides a choice of three functions: diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el index f6942bc538d..0a1bd044125 100644 --- a/lisp/vc/emerge.el +++ b/lisp/vc/emerge.el @@ -76,18 +76,6 @@ Commands: Commands must be prefixed by \\<emerge-fast-keymap>\\[emerge-basic-keymap] in `edit' mode, but can be invoked directly in `fast' mode.") -(define-obsolete-variable-alias 'emerge-version 'emacs-version "23.2") - -(defun emerge-version () - "Return string describing the version of Emerge. -When called interactively, displays the version." - (interactive) - (if (called-interactively-p 'interactive) - (message "Emerge version %s" emacs-version) - emacs-version)) - -(make-obsolete 'emerge-version 'emacs-version "23.2") - ;;; Emerge configuration variables (defgroup emerge nil diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 7ee000a8aea..932abb9818c 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -104,13 +104,7 @@ If 'changed, only request confirmation if the list of files has :group 'log-edit :type 'boolean) -(defvar cvs-commit-buffer-require-final-newline t) -(make-obsolete-variable 'cvs-commit-buffer-require-final-newline - 'log-edit-require-final-newline - "21.1") - -(defcustom log-edit-require-final-newline - cvs-commit-buffer-require-final-newline +(defcustom log-edit-require-final-newline t "Enforce a newline at the end of commit log messages. Enforce it silently if t, query if non-nil and don't do anything if nil." :group 'log-edit @@ -154,12 +148,7 @@ can be obtained from `log-edit-files'." :group 'log-edit :version "24.1") -(defvar cvs-changelog-full-paragraphs t) -(make-obsolete-variable 'cvs-changelog-full-paragraphs - 'log-edit-changelog-full-paragraphs - "21.1") - -(defvar log-edit-changelog-full-paragraphs cvs-changelog-full-paragraphs +(defvar log-edit-changelog-full-paragraphs t "If non-nil, include full ChangeLog paragraphs in the log. This may be set in the ``local variables'' section of a ChangeLog, to indicate the policy for that ChangeLog. @@ -354,14 +343,17 @@ automatically." `((log-edit-match-to-eoh (,(concat "^\\(\\([[:alpha:]]+\\):\\)" log-edit-header-contents-regexp) (progn (goto-char (match-beginning 0)) (match-end 0)) nil - (1 (if (assoc (match-string 2) log-edit-headers-alist) + (1 (if (assoc-string (match-string 2) log-edit-headers-alist t) 'log-edit-header 'log-edit-unknown-header) nil lax) ;; From `log-edit-header-contents-regexp': - (3 (or (cdr (assoc (match-string 2) log-edit-headers-alist)) + (3 (or (cdr (assoc-string (match-string 2) log-edit-headers-alist t)) 'log-edit-header) - nil lax))))) + nil lax)) + ("^\n" + (progn (goto-char (match-end 0)) (1+ (match-end 0))) nil + (0 '(:height 0.1 :inverse-video t)))))) (defvar log-edit-font-lock-gnu-style nil "If non-nil, highlight common failures to follow the GNU coding standards.") @@ -585,7 +577,7 @@ If you want to abort the commit, simply delete the buffer." (or (= (point-min) (point-max)) (save-excursion (goto-char (point-min)) - (while (and (looking-at "^\\([a-zA-Z]+: \\)?$") + (while (and (looking-at "^\\([a-zA-Z]+: ?\\)?$") (zerop (forward-line 1)))) (eobp)))) @@ -818,7 +810,7 @@ where LOGBUFFER is the name of the ChangeLog buffer, and each change-log-default-name) ;; `find-change-log' uses `change-log-default-name' if set ;; and sets it before exiting, so we need to work around - ;; that memoizing which is undesired here + ;; that memoizing which is undesired here. (setq change-log-default-name nil) (find-change-log))))) (with-current-buffer (find-file-noselect changelog-file-name) diff --git a/lisp/vc/pcvs-defs.el b/lisp/vc/pcvs-defs.el index fc65d62c67d..b3c1f8c1343 100644 --- a/lisp/vc/pcvs-defs.el +++ b/lisp/vc/pcvs-defs.el @@ -133,14 +133,9 @@ current line. See also `cvs-invert-ignore-marks'" :group 'pcl-cvs :type '(boolean)) -(defvar cvs-diff-ignore-marks t) -(make-obsolete-variable 'cvs-diff-ignore-marks - 'cvs-invert-ignore-marks - "21.1") - (defcustom cvs-invert-ignore-marks (let ((l ())) - (unless (equal cvs-diff-ignore-marks cvs-default-ignore-marks) + (unless (equal cvs-default-ignore-marks t) (push "diff" l)) (when (and cvs-force-dir-tag (not cvs-default-ignore-marks)) (push "tag" l)) @@ -171,11 +166,6 @@ If set to nil, `cvs-mode-add' will always prompt for a message." :type '(choice (const :tag "Prompt" nil) (string))) -(defvar cvs-diff-buffer-name "*cvs-diff*") -(make-obsolete-variable 'cvs-diff-buffer-name - 'cvs-buffer-name-alist - "21.1") - (defcustom cvs-find-file-and-jump nil "Jump to the modified area when finding a file. If non-nil, `cvs-mode-find-file' will place the cursor at the beginning of @@ -185,7 +175,7 @@ have no effect." :type '(boolean)) (defcustom cvs-buffer-name-alist - '(("diff" cvs-diff-buffer-name diff-mode) + '(("diff" "*cvs-diff*" diff-mode) ("status" "*cvs-info*" cvs-status-mode) ("tree" "*cvs-info*" cvs-status-mode) ("message" "*cvs-commit*" nil log-edit) diff --git a/lisp/vc/pcvs-info.el b/lisp/vc/pcvs-info.el index 36572640cfc..e863096d587 100644 --- a/lisp/vc/pcvs-info.el +++ b/lisp/vc/pcvs-info.el @@ -124,7 +124,7 @@ to confuse some users sometimes." (define-obsolete-face-alias 'cvs-marked-face 'cvs-marked "22.1") (defface cvs-msg - '((t (:slant italic))) + '((t :slant italic)) "PCL-CVS face used to highlight CVS messages." :group 'pcl-cvs) (define-obsolete-face-alias 'cvs-msg-face 'cvs-msg "22.1") @@ -358,7 +358,7 @@ For use by the cookie package." ;;(MOD-CONFLICT "Not Removed") (`DEAD "") (_ (capitalize (symbol-name type))))) - (face (let ((sym (intern + (face (let ((sym (intern-soft (concat "cvs-fi-" (downcase (symbol-name type)) "-face")))) diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el index 659151a31e9..4bc3eaf8c2c 100644 --- a/lisp/vc/pcvs.el +++ b/lisp/vc/pcvs.el @@ -60,8 +60,6 @@ ;; - rework the displaying of error messages. ;; - allow to flush messages only ;; - allow to protect files like ChangeLog from flushing -;; - automatically cvs-mode-insert files from find-file-hook -;; (and don't flush them as long as they are visited) ;; - query the user for cvs-get-marked (for some cmds or if nothing's selected) ;; - don't return the first (resp last) FI if the cursor is before ;; (resp after) it. @@ -877,7 +875,10 @@ RM-MSGS if non-nil means remove messages." ;; remove entries (`DEAD nil) ;; handled also? - (`UP-TO-DATE (not rm-handled)) + (`UP-TO-DATE + (if (find-buffer-visiting (cvs-fileinfo->full-name fi)) + t + (not rm-handled))) ;; keep the rest (_ (not (run-hook-with-args-until-success 'cvs-cleanup-functions fi)))))) @@ -1617,7 +1618,8 @@ With prefix argument, prompt for cvs flags." (defun-cvs-mode (cvs-mode-diff . DOUBLE) (flags) "Diff the selected files against the repository. This command compares the files in your working area against the -revision which they are based upon." +revision which they are based upon. +See also `cvs-diff-ignore-marks'." (interactive (list (cvs-add-branch-prefix (cvs-add-secondary-branch-prefix @@ -2435,6 +2437,21 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (add-hook 'after-save-hook 'cvs-mark-buffer-changed) +(defun cvs-insert-visited-file () + (let* ((file (expand-file-name buffer-file-name)) + (version (and (fboundp 'vc-backend) + (eq (vc-backend file) 'CVS) + (vc-working-revision file)))) + (when version + (save-current-buffer + (dolist (cvs-buf (buffer-list)) + (set-buffer cvs-buf) + ;; look for a corresponding pcl-cvs buffer + (when (and (eq major-mode 'cvs-mode) + (string-prefix-p default-directory file)) + (cvs-insert-file file))))))) + +(add-hook 'find-file-hook 'cvs-insert-visited-file 'append) (provide 'pcvs) diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 1eb33776f6a..74a61548d8b 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -150,12 +150,6 @@ Use the current Bzr root directory as the ROOT argument to (defconst vc-bzr-admin-branchconf (concat vc-bzr-admin-dirname "/branch/branch.conf")) -;;;###autoload (defun vc-bzr-registered (file) -;;;###autoload (if (vc-find-root file vc-bzr-admin-checkout-format-file) -;;;###autoload (progn -;;;###autoload (load "vc-bzr") -;;;###autoload (vc-bzr-registered file)))) - (defun vc-bzr-root (file) "Return the root directory of the bzr repository containing FILE." ;; Cache technique copied from vc-arch.el. @@ -291,6 +285,14 @@ in the repository root directory of FILE." (message "Falling back on \"slow\" status detection (%S)" err) (vc-bzr-state file)))))) +;; This is a cheap approximation that is autoloaded. If it finds a +;; possible match it loads this file and runs the real function. +;; It requires vc-bzr-admin-checkout-format-file to be autoloaded too. +;;;###autoload (defun vc-bzr-registered (file) +;;;###autoload (if (vc-find-root file vc-bzr-admin-checkout-format-file) +;;;###autoload (progn +;;;###autoload (load "vc-bzr") +;;;###autoload (vc-bzr-registered file)))) (defun vc-bzr-registered (file) "Return non-nil if FILE is registered with bzr." diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 54c33769267..cac3eb559a1 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -34,18 +34,6 @@ ;; Customization Variables (the rest is in vc.el) -(defvar vc-ignore-vc-files nil) -(make-obsolete-variable 'vc-ignore-vc-files - "set `vc-handled-backends' to nil to disable VC." - "21.1") - -(defvar vc-master-templates ()) -(make-obsolete-variable 'vc-master-templates - "to define master templates for a given BACKEND, use -vc-BACKEND-master-templates. To enable or disable VC for a given -BACKEND, use `vc-handled-backends'." - "21.1") - (defcustom vc-ignore-dir-regexp ;; Stop SMB, automounter, AFS, and DFS host lookups. locate-dominating-stop-dir-regexp @@ -586,16 +574,7 @@ If FILE is not registered, this function always returns nil." "Check if FILE is registered in BACKEND using vc-BACKEND-master-templates." (let ((sym (vc-make-backend-sym backend 'master-templates))) (unless (get backend 'vc-templates-grabbed) - (put backend 'vc-templates-grabbed t) - (set sym (append (delq nil - (mapcar - (lambda (template) - (and (consp template) - (eq (cdr template) backend) - (car template))) - (with-no-warnings - vc-master-templates))) - (symbol-value sym)))) + (put backend 'vc-templates-grabbed t)) (let ((result (vc-check-master-templates file (symbol-value sym)))) (if (stringp result) (vc-file-setprop file 'vc-name result) diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el index ecd7b826437..baaf0c3a926 100644 --- a/lisp/vc/vc-rcs.el +++ b/lisp/vc/vc-rcs.el @@ -89,6 +89,9 @@ to use --brief and sets this variable to remember whether it worked." :type '(choice (const :tag "Work out" nil) (const yes) (const no)) :group 'vc-rcs) +;; This needs to be autoloaded because vc-rcs-registered uses it (via +;; vc-default-registered), and vc-hooks needs to be able to check +;; for a registered backend without loading every backend. ;;;###autoload (defcustom vc-rcs-master-templates (purecopy '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")) diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el index a34222f7236..c4f6fd10bdb 100644 --- a/lisp/vc/vc-sccs.el +++ b/lisp/vc/vc-sccs.el @@ -74,6 +74,9 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." :version "24.1" ; no longer consult the obsolete vc-header-alist :group 'vc-sccs) +;; This needs to be autoloaded because vc-sccs-registered uses it (via +;; vc-default-registered), and vc-hooks needs to be able to check +;; for a registered backend without loading every backend. ;;;###autoload (defcustom vc-sccs-master-templates (purecopy '("%sSCCS/s.%s" "%ss.%s" vc-sccs-search-project-dir)) @@ -106,11 +109,10 @@ For a description of possible values, see `vc-check-master-templates'." ;; The autoload cookie below places vc-sccs-registered directly into ;; loaddefs.el, so that vc-sccs.el does not need to be loaded for -;; every file that is visited. The definition is repeated below -;; so that Help and etags can find it. - -;;;###autoload (defun vc-sccs-registered(f) (vc-default-registered 'SCCS f)) -(defun vc-sccs-registered (f) (vc-default-registered 'SCCS f)) +;; every file that is visited. +;;;###autoload +(progn +(defun vc-sccs-registered (f) (vc-default-registered 'SCCS f))) (defun vc-sccs-state (file) "SCCS-specific function to compute the version control state." diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 47800bd4aac..2da721b41d8 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -808,16 +808,6 @@ is sensitive to blank lines." (string :tag "Comment End"))) :group 'vc) -(defcustom vc-checkout-carefully (= (user-uid) 0) - "Non-nil means be extra-careful in checkout. -Verify that the file really is not locked -and that its contents match what the repository version says." - :type 'boolean - :group 'vc) -(make-obsolete-variable 'vc-checkout-carefully - "the corresponding checks are always done now." - "21.1") - ;; Variables users don't need to see @@ -1115,24 +1105,27 @@ For old-style locking-based version control systems, like RCS: ;; Files have local changes ((vc-compatible-state state 'edited) (let ((ready-for-commit files)) - ;; If files are edited but read-only, give user a chance to correct. - (dolist (file files) - ;; If committing a mix of removed and edited files, the - ;; fileset has state = 'edited. Rather than checking the - ;; state of each individual file in the fileset, it seems - ;; simplest to just check if the file exists. Bug#9781. - (when (and (file-exists-p file) (not (file-writable-p file))) - ;; Make the file+buffer read-write. - (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue? " file)) - (error "Aborted")) - ;; Maybe we somehow lost permissions on the directory. - (condition-case nil - (set-file-modes file (logior (file-modes file) 128)) - (error (error "Unable to make file writable"))) - (let ((visited (get-file-buffer file))) - (when visited - (with-current-buffer visited - (read-only-mode -1)))))) + ;; CVS, SVN and bzr don't care about read-only (bug#9781). + ;; RCS does, SCCS might (someone should check...). + (when (memq backend '(RCS SCCS)) + ;; If files are edited but read-only, give user a chance to correct. + (dolist (file files) + ;; If committing a mix of removed and edited files, the + ;; fileset has state = 'edited. Rather than checking the + ;; state of each individual file in the fileset, it seems + ;; simplest to just check if the file exists. Bug#9781. + (when (and (file-exists-p file) (not (file-writable-p file))) + ;; Make the file+buffer read-write. + (unless (y-or-n-p (format "%s is edited but read-only; make it writable and continue? " file)) + (error "Aborted")) + ;; Maybe we somehow lost permissions on the directory. + (condition-case nil + (set-file-modes file (logior (file-modes file) 128)) + (error (error "Unable to make file writable"))) + (let ((visited (get-file-buffer file))) + (when visited + (with-current-buffer visited + (read-only-mode -1))))))) ;; Allow user to revert files with no changes (save-excursion (dolist (file files) @@ -1516,8 +1509,9 @@ to override the value of `vc-diff-switches' and `diff-switches'." (when (listp switches) switches)))) ;; Old def for compatibility with Emacs-21.[123]. -(defmacro vc-diff-switches-list (backend) `(vc-switches ',backend 'diff)) -(make-obsolete 'vc-diff-switches-list 'vc-switches "22.1") +(defmacro vc-diff-switches-list (backend) + (declare (obsolete vc-switches "22.1")) + `(vc-switches ',backend 'diff)) (defun vc-diff-finish (buffer messages) ;; The empty sync output case has already been handled, so the only diff --git a/lisp/view.el b/lisp/view.el index 41cb9752288..7ed42bf7ddc 100644 --- a/lisp/view.el +++ b/lisp/view.el @@ -513,6 +513,7 @@ that can be added see the RETURN-TO-ALIST argument of the function `view-mode-exit'. If `view-return-to-alist' contains an entry for the selected window, purge that entry from `view-return-to-alist' before adding ITEM." + (declare (obsolete "this function has no effect." "24.1")) (with-current-buffer buffer (when view-return-to-alist (let* ((list view-return-to-alist) @@ -535,7 +536,6 @@ entry for the selected window, purge that entry from (when item (setq view-return-to-alist (cons item view-return-to-alist))))) -(make-obsolete 'view-return-to-alist-update "this function has no effect." "24.1") ;;;###autoload (defun view-mode-enter (&optional quit-restore exit-action) diff --git a/lisp/window.el b/lisp/window.el index 87817fb8773..811b1781b4c 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -84,7 +84,7 @@ This hook is run by `with-temp-buffer-window' with the buffer displayed and current and its window selected.") (defun temp-buffer-window-setup (buffer-or-name) - "Set up temporary buffer specified by BUFFER-OR-NAME + "Set up temporary buffer specified by BUFFER-OR-NAME. Return the buffer." (let ((old-dir default-directory) (buffer (get-buffer-create buffer-or-name))) @@ -508,7 +508,7 @@ failed." (window-make-atom (window-parent window)) ;; Display BUFFER in NEW and return NEW. (window--display-buffer - buffer new 'window display-buffer-mark-dedicated)))) + buffer new 'window alist display-buffer-mark-dedicated)))) (defun window--atom-check-1 (window) "Subroutine of `window--atom-check'." @@ -677,12 +677,6 @@ The new window automatically becomes the \"major\" side window on SIDE. Return the new window, nil if its creation window failed." (let* ((root (frame-root-window)) (left-or-right (memq side '(left right))) - (size (or (assq 'size alist) - (/ (window-total-size (frame-root-window) left-or-right) - ;; By default use a fourth of the size of the - ;; frame's root window. This has to be made - ;; customizable via ALIST. - 4))) (major (window--major-side-window side)) (selected-window (selected-window)) (on-side (cond @@ -694,7 +688,7 @@ SIDE. Return the new window, nil if its creation window failed." ;; parent window unless needed. (window-combination-resize 'side) (window-combination-limit nil) - (new (split-window major (- size) on-side)) + (new (split-window major nil on-side)) fun) (when new ;; Initialize `window-side' parameter of new window to SIDE. @@ -705,8 +699,22 @@ SIDE. Return the new window, nil if its creation window failed." ;; the new window is deleted, a side window on the opposite side ;; does not get resized. (set-window-parameter new 'delete-window 'delete-side-window) + ;; Auto-adjust height/width of new window unless a size has been + ;; explicitly requested. + (unless (if left-or-right + (cdr (assq 'window-width alist)) + (cdr (assq 'window-height alist))) + (setq alist + (cons + (cons + (if left-or-right 'window-width 'window-height) + (/ (window-total-size (frame-root-window) left-or-right) + ;; By default use a fourth of the size of the + ;; frame's root window. + 4)) + alist))) ;; Install BUFFER in new window and return NEW. - (window--display-buffer buffer new 'window 'side)))) + (window--display-buffer buffer new 'window alist 'side)))) (defun delete-side-window (window) "Delete side window WINDOW." @@ -814,7 +822,7 @@ following symbols can be used: ;; ALIST (or, better, avoided in the "other" functions). (or (and this-window ;; Reuse `this-window'. - (window--display-buffer buffer this-window 'reuse 'side)) + (window--display-buffer buffer this-window 'reuse alist 'side)) (and (or (not max-slots) (< slots max-slots)) (or (and next-window ;; Make new window before `next-window'. @@ -839,13 +847,14 @@ following symbols can be used: window 'delete-window 'delete-side-window) window))) (set-window-parameter window 'window-slot slot) - (window--display-buffer buffer window 'window 'side)) + (window--display-buffer buffer window 'window alist 'side)) (and best-window ;; Reuse `best-window'. (progn ;; Give best-window the new slot value. (set-window-parameter best-window 'window-slot slot) - (window--display-buffer buffer best-window 'reuse 'side))))))))) + (window--display-buffer + buffer best-window 'reuse alist 'side))))))))) (defun window--side-check (&optional frame) "Check the side window configuration of FRAME. @@ -903,7 +912,7 @@ of all windows on FRAME to nil." (if right (throw 'reset t) (setq right t))) ((eq side 'bottom) (if bottom (throw 'reset t) (setq bottom t))) - (t + (t (throw 'reset t)))) frame t)) ;; If there's a side window, there must be at least one @@ -2079,9 +2088,9 @@ preferably only resize windows adjacent to EDGE. Return the symbol `normalized' if new normal sizes have been already set by this routine." (let* ((first (window-child parent)) - (sub first) + (last (window-last-child parent)) (parent-total (+ (window-total-size parent horizontal) delta)) - best-window best-value) + sub best-window best-value) (if (and edge (memq trail '(before after)) (progn @@ -2125,7 +2134,7 @@ already set by this routine." ;; normal sizes have been already set. 'normalized) ;; Resize all windows proportionally. - (setq sub first) + (setq sub last) (while sub (cond ((or (window--resize-child-windows-skip-p sub) @@ -2154,14 +2163,14 @@ already set by this routine." parent-total) (window-normal-size sub horizontal))))) - (setq sub (window-right sub))) + (setq sub (window-left sub))) (cond ((< delta 0) ;; Shrink windows by delta. (setq best-window t) (while (and best-window (not (zerop delta))) - (setq sub first) + (setq sub last) (setq best-window nil) (setq best-value most-negative-fixnum) (while sub @@ -2171,7 +2180,7 @@ already set by this routine." (setq best-window sub) (setq best-value (cdr (window-new-normal sub)))) - (setq sub (window-right sub))) + (setq sub (window-left sub))) (when best-window (setq delta (1+ delta))) @@ -2188,7 +2197,7 @@ already set by this routine." ;; Enlarge windows by delta. (setq best-window t) (while (and best-window (not (zerop delta))) - (setq sub first) + (setq sub last) (setq best-window nil) (setq best-value most-positive-fixnum) (while sub @@ -2197,7 +2206,7 @@ already set by this routine." (setq best-window sub) (setq best-value (window-new-normal sub))) - (setq sub (window-right sub))) + (setq sub (window-left sub))) (when best-window (setq delta (1- delta))) @@ -2209,7 +2218,7 @@ already set by this routine." (window-normal-size best-window horizontal)))))) (when best-window - (setq sub first) + (setq sub last) (while sub (when (or (consp (window-new-normal sub)) (numberp (window-new-normal sub))) @@ -2227,7 +2236,7 @@ already set by this routine." ;; recursively even if it's size does not change. (window--resize-this-window sub delta horizontal ignore nil trail edge)))) - (setq sub (window-right sub))))))) + (setq sub (window-left sub))))))) (defun window--resize-siblings (window delta &optional horizontal ignore trail edge) "Resize other windows when WINDOW is resized vertically by DELTA lines. @@ -2406,27 +2415,33 @@ Return the number of lines that were recovered. This function is only called by the minibuffer window resizing routines. It resizes windows proportionally and never deletes any windows." - (when (numberp delta) - (let (ignore) - (cond - ((< delta 0) - (setq delta (window-sizable window delta))) - ((> delta 0) - (unless (window-sizable window delta) - (setq ignore t)))) - - (window--resize-reset (window-frame window)) - ;; Ideally, we would resize just the last window in a combination - ;; but that's not feasible for the following reason: If we grow - ;; the minibuffer window and the last window cannot be shrunk any - ;; more, we shrink another window instead. But if we then shrink - ;; the minibuffer window again, the last window might get enlarged - ;; and the state after shrinking is not the state before growing. - ;; So, in practice, we'd need a history variable to record how to - ;; proceed. But I'm not sure how such a variable could work with - ;; repeated minibuffer window growing steps. - (window--resize-this-window window delta nil ignore t) - delta))) + (let ((frame (window-frame window)) + ignore) + (cond + ((not (numberp delta)) + (setq delta 0)) + ((zerop delta)) + ((< delta 0) + (setq delta (window-sizable window delta)) + (window--resize-reset frame) + ;; When shrinking the root window, emulate an edge drag in order + ;; to not resize other windows if we can avoid it (Bug#12419). + (window--resize-this-window + window delta nil ignore t 'before + (+ (window-top-line window) (window-total-size window))) + ;; Don't record new normal sizes to make sure that shrinking back + ;; proportionally works as intended. + (walk-window-tree + (lambda (window) (set-window-new-normal window 'ignore)) frame t)) + ((> delta 0) + (window--resize-reset frame) + (unless (window-sizable window delta) + (setq ignore t)) + ;; When growing the root window, resize proportionally. This + ;; should give windows back their original sizes (hopefully). + (window--resize-this-window window delta nil ignore t))) + ;; Return the possibly adjusted DELTA. + delta)) (defun adjust-window-trailing-edge (window delta &optional horizontal) "Move WINDOW's bottom edge by DELTA lines. @@ -5071,7 +5086,7 @@ split." (with-selected-window window (split-window-below)))))))) -(defun window--try-to-split-window (window) +(defun window--try-to-split-window (window &optional alist) "Try to split WINDOW. Return value returned by `split-window-preferred-function' if it represents a live window, nil otherwise." @@ -5079,9 +5094,14 @@ represents a live window, nil otherwise." (not (frame-parameter (window-frame window) 'unsplittable)) (let* ((window-combination-limit ;; When `window-combination-limit' equals - ;; `display-buffer' bind it to t so resizing steals - ;; space preferably from the window that was split. - (if (eq window-combination-limit 'display-buffer) + ;; `display-buffer' or equals `resize-window' and a + ;; `window-height' or `window-width' alist entry are + ;; present, bind it to t so resizing steals space + ;; preferably from the window that was split. + (if (or (eq window-combination-limit 'display-buffer) + (and (eq window-combination-limit 'window-size) + (or (cdr (assq 'window-height alist)) + (cdr (assq 'window-width alist))))) t window-combination-limit)) (new-window @@ -5138,7 +5158,7 @@ is higher than WINDOW." (/ (- (window-total-height window) (window-total-height)) 2)) (error nil)))) -(defun window--display-buffer (buffer window type &optional dedicated) +(defun window--display-buffer (buffer window type &optional alist dedicated) "Display BUFFER in WINDOW and make its frame visible. TYPE must be one of the symbols `reuse', `window' or `frame' and is passed unaltered to `display-buffer-record-window'. Set @@ -5153,6 +5173,58 @@ BUFFER and WINDOW are live." (set-window-dedicated-p window dedicated)) (when (memq type '(window frame)) (set-window-prev-buffers window nil))) + (let ((parameter (window-parameter window 'quit-restore)) + (height (cdr (assq 'window-height alist))) + (width (cdr (assq 'window-width alist)))) + (when (or (memq type '(window frame)) + (and (eq (car parameter) 'same) + (memq (nth 1 parameter) '(window frame)))) + ;; Adjust height of new window or frame. + (cond + ((not height)) + ((numberp height) + (let* ((new-height + (if (integerp height) + height + (round + (* (window-total-size (frame-root-window window)) + height)))) + (delta (- new-height (window-total-size window)))) + (cond + ((and (window--resizable-p window delta nil 'safe) + (window-combined-p window)) + (window-resize window delta nil 'safe)) + ((or (eq type 'frame) + (and (eq (car parameter) 'same) + (eq (nth 1 parameter) 'frame))) + (set-frame-height + (window-frame window) + (+ (frame-height (window-frame window)) delta)))))) + ((functionp height) + (ignore-errors (funcall height window)))) + ;; Adjust width of a window or frame. + (cond + ((not width)) + ((numberp width) + (let* ((new-width + (if (integerp width) + width + (round + (* (window-total-size (frame-root-window window) t) + width)))) + (delta (- new-width (window-total-size window t)))) + (cond + ((and (window--resizable-p window delta t 'safe) + (window-combined-p window t)) + (window-resize window delta t 'safe)) + ((or (eq type 'frame) + (and (eq (car parameter) 'same) + (eq (nth 1 parameter) 'frame))) + (set-frame-width + (window-frame window) + (+ (frame-width (window-frame window)) delta)))))) + ((functionp width) + (ignore-errors (funcall width window)))))) window)) (defun window--maybe-raise-frame (frame) @@ -5394,7 +5466,7 @@ selected window." (unless (or (cdr (assq 'inhibit-same-window alist)) (window-minibuffer-p) (window-dedicated-p)) - (window--display-buffer buffer (selected-window) 'reuse))) + (window--display-buffer buffer (selected-window) 'reuse alist))) (defun display-buffer--maybe-same-window (buffer alist) "Conditionally display BUFFER in the selected window. @@ -5442,7 +5514,7 @@ that frame." (get-buffer-window-list buffer 'nomini frames)))))) (when (window-live-p window) - (prog1 (window--display-buffer buffer window 'reuse) + (prog1 (window--display-buffer buffer window 'reuse alist) (unless (cdr (assq 'inhibit-switch-frame alist)) (window--maybe-raise-frame (window-frame window))))))) @@ -5479,8 +5551,8 @@ new frame." (when (and fun (setq frame (funcall fun)) (setq window (frame-selected-window frame))) - (prog1 (window--display-buffer buffer window - 'frame display-buffer-mark-dedicated) + (prog1 (window--display-buffer + buffer window 'frame alist display-buffer-mark-dedicated) (unless (cdr (assq 'inhibit-switch-frame alist)) (window--maybe-raise-frame frame)))))) @@ -5505,11 +5577,11 @@ raising the frame." (not (frame-parameter frame 'unsplittable)))) ;; Attempt to split largest or least recently used window. (setq window (or (window--try-to-split-window - (get-largest-window frame t)) + (get-largest-window frame t) alist) (window--try-to-split-window - (get-lru-window frame t))))) - (prog1 (window--display-buffer buffer window - 'window display-buffer-mark-dedicated) + (get-lru-window frame t) alist)))) + (prog1 (window--display-buffer + buffer window 'window alist display-buffer-mark-dedicated) (unless (cdr (assq 'inhibit-switch-frame alist)) (window--maybe-raise-frame (window-frame window))))))) @@ -5528,21 +5600,21 @@ again with `display-buffer-pop-up-window'." (and pop-up-windows (display-buffer-pop-up-window buffer alist)))) -(defun display-buffer-below-selected (buffer _alist) +(defun display-buffer-below-selected (buffer alist) "Try displaying BUFFER in a window below the selected window. This either splits the selected window or reuses the window below the selected one." (let (window) (or (and (not (frame-parameter nil 'unsplittable)) - (setq window (window--try-to-split-window (selected-window))) + (setq window (window--try-to-split-window (selected-window) alist)) (window--display-buffer - buffer window 'window display-buffer-mark-dedicated)) + buffer window 'window alist display-buffer-mark-dedicated)) (and (setq window (window-in-direction 'below)) (not (window-dedicated-p window)) (window--display-buffer - buffer window 'reuse display-buffer-mark-dedicated))))) + buffer window 'reuse alist display-buffer-mark-dedicated))))) -(defun display-buffer-at-bottom (buffer _alist) +(defun display-buffer-at-bottom (buffer alist) "Try displaying BUFFER in a window at the botom of the selected frame. This either splits the window at the bottom of the frame or the frame's root window, or reuses an existing window at the bottom @@ -5550,20 +5622,20 @@ of the selected frame." (let (bottom-window window) (walk-window-tree (lambda (window) (setq bottom-window window))) (or (and (not (frame-parameter nil 'unsplittable)) - (setq window (window--try-to-split-window bottom-window)) + (setq window (window--try-to-split-window bottom-window alist)) (window--display-buffer - buffer window 'window display-buffer-mark-dedicated)) + buffer window 'window alist display-buffer-mark-dedicated)) (and (not (frame-parameter nil 'unsplittable)) (setq window (condition-case nil (split-window (frame-root-window)) (error nil))) (window--display-buffer - buffer window 'window display-buffer-mark-dedicated)) + buffer window 'window alist display-buffer-mark-dedicated)) (and (setq window bottom-window) (not (window-dedicated-p window)) (window--display-buffer - buffer window 'reuse display-buffer-mark-dedicated))))) + buffer window 'reuse alist display-buffer-mark-dedicated))))) (defun display-buffer-in-previous-window (buffer alist) "Display BUFFER in a window previously showing it. @@ -5619,7 +5691,7 @@ above, even if that window never showed BUFFER before." (setq best-window window))) ;; Return best or second best window found. (when (setq window (or best-window second-best-window)) - (window--display-buffer buffer window 'reuse)))) + (window--display-buffer buffer window 'reuse alist)))) (defun display-buffer-use-some-window (buffer alist) "Display BUFFER in an existing window. @@ -5647,7 +5719,7 @@ that frame." (get-largest-window 0 not-this-window)))) (when (window-live-p window) (prog1 - (window--display-buffer buffer window 'reuse) + (window--display-buffer buffer window 'reuse alist) (window--even-window-heights window) (unless (cdr (assq 'inhibit-switch-frame alist)) (window--maybe-raise-frame (window-frame window))))))) @@ -5917,6 +5989,97 @@ WINDOW must be a live window and defaults to the selected one." window)))) ;;; Resizing buffers to fit their contents exactly. +(defcustom fit-frame-to-buffer nil + "Non-nil means `fit-window-to-buffer' can resize frames. +A frame can be resized if and only if its root window is a live +window. The height of the root window is subject to the values +of `fit-frame-to-buffer-max-height' and `window-min-height'." + :type 'boolean + :version "24.2" + :group 'help) + +(defcustom fit-frame-to-buffer-bottom-margin 4 + "Bottom margin for `fit-frame-to-buffer'. +This is the number of lines `fit-frame-to-buffer' leaves free at the +bottom of the display in order to not obscure the system task bar." + :type 'integer + :version "24.2" + :group 'windows) + +(defun fit-frame-to-buffer (&optional frame max-height min-height) + "Adjust height of FRAME to display its buffer's contents exactly. +FRAME can be any live frame and defaults to the selected one. + +Optional argument MAX-HEIGHT specifies the maximum height of +FRAME and defaults to the height of the display below the current +top line of FRAME minus FIT-FRAME-TO-BUFFER-BOTTOM-MARGIN. +Optional argument MIN-HEIGHT specifies the minimum height of +FRAME." + (interactive) + (setq frame (window-normalize-frame frame)) + (let* ((root (frame-root-window frame)) + (frame-min-height + (+ (- (frame-height frame) (window-total-size root)) + window-min-height)) + (frame-top (frame-parameter frame 'top)) + (top (if (consp frame-top) + (funcall (car frame-top) (cadr frame-top)) + frame-top)) + (frame-max-height + (- (/ (- (x-display-pixel-height frame) top) + (frame-char-height frame)) + fit-frame-to-buffer-bottom-margin)) + (compensate 0) + delta) + (when (and (window-live-p root) (not (window-size-fixed-p root))) + (with-selected-window root + (cond + ((not max-height) + (setq max-height frame-max-height)) + ((numberp max-height) + (setq max-height (min max-height frame-max-height))) + (t + (error "%s is an invalid maximum height" max-height))) + (cond + ((not min-height) + (setq min-height frame-min-height)) + ((numberp min-height) + (setq min-height (min min-height frame-min-height))) + (t + (error "%s is an invalid minimum height" min-height))) + ;; When tool-bar-mode is enabled and we have just created a new + ;; frame, reserve lines for toolbar resizing. This is needed + ;; because for reasons unknown to me Emacs (1) reserves one line + ;; for the toolbar when making the initial frame and toolbars + ;; are enabled, and (2) later adds the remaining lines needed. + ;; Our code runs IN BETWEEN (1) and (2). YMMV when you're on a + ;; system that behaves differently. + (let ((quit-restore (window-parameter root 'quit-restore)) + (lines (tool-bar-lines-needed frame))) + (when (and quit-restore (eq (car quit-restore) 'frame) + (not (zerop lines))) + (setq compensate (1- lines)))) + (message "%s" compensate) + (setq delta + ;; Always count a final newline - we don't do any + ;; post-processing, so let's play safe. + (+ (count-screen-lines nil nil t) + (- (window-body-size)) + compensate))) + ;; Move away from final newline. + (when (and (eobp) (bolp) (not (bobp))) + (set-window-point root (line-beginning-position 0))) + (set-window-start root (point-min)) + (set-window-vscroll root 0) + (condition-case nil + (set-frame-height + frame + (min (max (+ (frame-height frame) delta) + min-height) + max-height)) + (error (setq delta nil)))) + delta)) + (defun fit-window-to-buffer (&optional window max-height min-height) "Adjust height of WINDOW to display its buffer's contents exactly. WINDOW must be a live window and defaults to the selected one. @@ -5937,9 +6100,12 @@ _all_ lines of its buffer you might not see the first lines when WINDOW was scrolled." (interactive) (setq window (window-normalize-window window t)) - ;; Can't resize a full height or fixed-size window. - (unless (or (window-size-fixed-p window) - (window-full-height-p window)) + (cond + ((window-size-fixed-p window)) + ((window-full-height-p window) + (when fit-frame-to-buffer + (fit-frame-to-buffer (window-frame window)))) + (t (with-selected-window window (let* ((height (window-total-size)) (min-height @@ -5955,7 +6121,7 @@ WINDOW was scrolled." ;; Can't get larger than height of frame. (min max-height (window-total-size (frame-root-window window))) - ;, Don't delete other windows. + ;; Don't delete other windows. (+ height (window-max-delta nil nil window)))) ;; Make `desired-height' the height necessary to show ;; all of WINDOW's buffer, constrained by MIN-HEIGHT @@ -6018,89 +6184,7 @@ WINDOW was scrolled." (window-resize window 1 nil window) (setq desired-height (1+ desired-height))))) (error (setq delta nil))) - delta)))) - -(defcustom fit-frame-to-buffer-bottom-margin 4 - "Bottom margin for `fit-frame-to-buffer'. -This is the number of lines `fit-frame-to-buffer' leaves free at the -bottom of the display in order to not obscure the system task bar." - :type 'integer - :version "24.2" - :group 'windows) - -(defun fit-frame-to-buffer (&optional frame max-height min-height) - "Adjust height of FRAME to display its buffer's contents exactly. -FRAME can be any live frame and defaults to the selected one. - -Optional argument MAX-HEIGHT specifies the maximum height of -FRAME and defaults to the height of the display below the current -top line of FRAME minus FIT-FRAME-TO-BUFFER-BOTTOM-MARGIN. -Optional argument MIN-HEIGHT specifies the minimum height of -FRAME." - (interactive) - (setq frame (window-normalize-frame frame)) - (let* ((root (frame-root-window frame)) - (frame-min-height - (+ (- (frame-height frame) (window-total-size root)) - window-min-height)) - (frame-top (frame-parameter frame 'top)) - (top (if (consp frame-top) - (funcall (car frame-top) (cadr frame-top)) - frame-top)) - (frame-max-height - (- (/ (- (x-display-pixel-height frame) top) - (frame-char-height frame)) - fit-frame-to-buffer-bottom-margin)) - (compensate 0) - delta) - (when (and (window-live-p root) (not (window-size-fixed-p root))) - (with-selected-window root - (cond - ((not max-height) - (setq max-height frame-max-height)) - ((numberp max-height) - (setq max-height (min max-height frame-max-height))) - (t - (error "%s is an invalid maximum height" max-height))) - (cond - ((not min-height) - (setq min-height frame-min-height)) - ((numberp min-height) - (setq min-height (min min-height frame-min-height))) - (t - (error "%s is an invalid minimum height" min-height))) - ;; When tool-bar-mode is enabled and we have just created a new - ;; frame, reserve lines for toolbar resizing. This is needed - ;; because for reasons unknown to me Emacs (1) reserves one line - ;; for the toolbar when making the initial frame and toolbars - ;; are enabled, and (2) later adds the remaining lines needed. - ;; Our code runs IN BETWEEN (1) and (2). YMMV when you're on a - ;; system that behaves differently. - (let ((quit-restore (window-parameter root 'quit-restore)) - (lines (tool-bar-lines-needed frame))) - (when (and quit-restore (eq (car quit-restore) 'frame) - (not (zerop lines))) - (setq compensate (1- lines)))) - (message "%s" compensate) - (setq delta - ;; Always count a final newline - we don't do any - ;; post-processing, so let's play safe. - (+ (count-screen-lines nil nil t) - (- (window-body-size)) - compensate))) - ;; Move away from final newline. - (when (and (eobp) (bolp) (not (bobp))) - (set-window-point root (line-beginning-position 0))) - (set-window-start root (point-min)) - (set-window-vscroll root 0) - (condition-case nil - (set-frame-height - frame - (min (max (+ (frame-height frame) delta) - min-height) - max-height)) - (error (setq delta nil)))) - delta)) + delta))))) (defun window-safely-shrinkable-p (&optional window) "Return t if WINDOW can be shrunk without shrinking other windows. diff --git a/lisp/winner.el b/lisp/winner.el index d808a54a10e..65b3d30a80c 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -63,19 +63,8 @@ "Restoring window configurations." :group 'windows) -;;;###autoload -(defcustom winner-mode nil - "Toggle Winner mode. -Setting this variable directly does not take effect; -use either \\[customize] or the function `winner-mode'." - :set #'(lambda (symbol value) (funcall symbol (or value 0))) - :initialize 'custom-initialize-default - :type 'boolean - :group 'winner - :require 'winner) - (defcustom winner-dont-bind-my-keys nil - "If non-nil: Do not use `winner-mode-map' in Winner mode." + "Non-nil means do not bind keys in Winner mode." :type 'boolean :group 'winner) @@ -85,15 +74,13 @@ use either \\[customize] or the function `winner-mode'." :group 'winner) (defcustom winner-boring-buffers '("*Completions*") - "`winner-undo' will not restore windows displaying any of these buffers. + "List of buffer names whose windows `winner-undo' will not restore. You may want to include buffer names such as *Help*, *Apropos*, *Buffer List*, *info* and *Compile-Log*." :type '(repeat string) :group 'winner) - - ;;;; Saving old configurations (internal variables and subroutines) @@ -337,19 +324,23 @@ You may want to include buffer names such as *Help*, *Apropos*, ;;;; Winner mode (a minor mode) (defcustom winner-mode-hook nil - "Functions to run whenever Winner mode is turned on." + "Functions to run whenever Winner mode is turned on or off." :type 'hook :group 'winner) -(defcustom winner-mode-leave-hook nil +(define-obsolete-variable-alias 'winner-mode-leave-hook + 'winner-mode-off-hook "24.3") + +(defcustom winner-mode-off-hook nil "Functions to run whenever Winner mode is turned off." :type 'hook :group 'winner) (defvar winner-mode-map (let ((map (make-sparse-keymap))) - (define-key map [(control c) left] 'winner-undo) - (define-key map [(control c) right] 'winner-redo) + (unless winner-dont-bind-my-keys + (define-key map [(control c) left] 'winner-undo) + (define-key map [(control c) right] 'winner-redo)) map) "Keymap for Winner mode.") @@ -364,37 +355,21 @@ You may want to include buffer names such as *Help*, *Apropos*, ;;;###autoload -(defun winner-mode (&optional arg) - "Toggle Winner mode. -With arg, turn Winner mode on if and only if arg is positive." - (interactive "P") - (let ((on-p (if arg (> (prefix-numeric-value arg) 0) - (not winner-mode)))) - (cond - ;; Turn mode on - (on-p - (setq winner-mode t) - (cond - ((winner-hook-installed-p) - (add-hook 'window-configuration-change-hook 'winner-change-fun) - (add-hook 'post-command-hook 'winner-save-old-configurations)) - (t (add-hook 'post-command-hook 'winner-save-conditionally))) - (add-hook 'minibuffer-setup-hook 'winner-save-unconditionally) - (setq winner-modified-list (frame-list)) - (winner-save-old-configurations) - (run-hooks 'winner-mode-hook) - (when (called-interactively-p 'interactive) - (message "Winner mode enabled"))) - ;; Turn mode off - (winner-mode - (setq winner-mode nil) - (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) - (run-hooks 'winner-mode-leave-hook) - (when (called-interactively-p 'interactive) - (message "Winner mode disabled")))))) +(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 '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) @@ -461,12 +436,5 @@ In other words, \"undo\" changes in window configuration." (message "Winner undid undo"))) (t (error "Previous command was not a `winner-undo'")))) -;;; To be evaluated when the package is loaded: - -(unless (or (assq 'winner-mode minor-mode-map-alist) - winner-dont-bind-my-keys) - (push (cons 'winner-mode winner-mode-map) - minor-mode-map-alist)) - (provide 'winner) ;;; winner.el ends here diff --git a/m4/extern-inline.m4 b/m4/extern-inline.m4 index 12f24fab95f..600c8d3fa17 100644 --- a/m4/extern-inline.m4 +++ b/m4/extern-inline.m4 @@ -18,7 +18,9 @@ AC_DEFUN([gl_EXTERN_INLINE], <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=54113>. _GL_INLINE_HEADER_END contains useful stuff to put in the same include file, after uses of _GL_INLINE. */ -#if __GNUC__ ? __GNUC_STDC_INLINE__ : 199901L <= __STDC_VERSION__ +#if (__GNUC__ \ + ? defined __GNUC_STDC_INLINE__ && __GNUC_STDC_INLINE__ \ + : 199901L <= __STDC_VERSION__) # define _GL_INLINE inline # define _GL_EXTERN_INLINE extern inline #elif 2 < __GNUC__ + (7 <= __GNUC_MINOR__) @@ -35,7 +37,7 @@ AC_DEFUN([gl_EXTERN_INLINE], #endif #if 4 < __GNUC__ + (6 <= __GNUC_MINOR__) -# if __GNUC_STDC_INLINE__ +# if defined __GNUC_STDC_INLINE__ && __GNUC_STDC_INLINE__ # define _GL_INLINE_HEADER_CONST_PRAGMA # else # define _GL_INLINE_HEADER_CONST_PRAGMA \ diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 0d73faee8d1..de2355d87c3 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -111,6 +111,7 @@ AC_DEFUN([gl_EARLY], # Code from module sys_time: # Code from module time: # Code from module time_r: + # Code from module timer-time: # Code from module timespec: # Code from module timespec-add: # Code from module timespec-sub: @@ -263,6 +264,7 @@ AC_DEFUN([gl_INIT], gl_PREREQ_TIME_R fi gl_TIME_MODULE_INDICATOR([time_r]) + gl_TIMER_TIME gl_TIMESPEC gl_UNISTD_H gl_UTIMENS @@ -661,6 +663,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/sys_time_h.m4 m4/time_h.m4 m4/time_r.m4 + m4/timer_time.m4 m4/timespec.m4 m4/tm_gmtoff.m4 m4/unistd_h.m4 diff --git a/m4/timer_time.m4 b/m4/timer_time.m4 new file mode 100644 index 00000000000..bc84554b789 --- /dev/null +++ b/m4/timer_time.m4 @@ -0,0 +1,39 @@ +# timer_time.m4 serial 2 +dnl Copyright (C) 2011-2012 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +# Check for timer_settime, and set LIB_TIMER_TIME. + +AC_DEFUN([gl_TIMER_TIME], +[ + dnl Based on clock_time.m4. See details there. + + AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) + AC_REQUIRE([gl_THREADLIB]) + + LIB_TIMER_TIME= + AC_SUBST([LIB_TIMER_TIME]) + gl_saved_libs=$LIBS + AC_SEARCH_LIBS([timer_settime], [rt posix4], + [test "$ac_cv_search_timer_settime" = "none required" || + LIB_TIMER_TIME=$ac_cv_search_timer_settime]) + dnl GLIBC uses threads to emulate posix timers when kernel support + dnl is not available (like Linux < 2.6 or when used with kFreeBSD) + dnl Now the pthread lib is linked automatically in the normal case, + dnl but when linking statically, it needs to be explicitly specified. + AC_EGREP_CPP([Thread], + [ +#include <features.h> +#ifdef __GNU_LIBRARY__ + #if ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 2) || (__GLIBC__ > 2)) \ + && !defined __UCLIBC__ + Thread emulation available + #endif +#endif + ], + [LIB_TIMER_TIME="$LIB_TIMER_TIME $LIBMULTITHREAD"]) + AC_CHECK_FUNCS([timer_settime]) + LIBS=$gl_saved_libs +]) diff --git a/msdos/ChangeLog b/msdos/ChangeLog index 45666a335de..525868b2c70 100644 --- a/msdos/ChangeLog +++ b/msdos/ChangeLog @@ -1,3 +1,8 @@ +2012-09-27 Paul Eggert <eggert@cs.ucla.edu> + + Check more robustly for timer_settime. + * sed1v2.inp, sed3v2.inp (LIB_TIMER_TIME): New macro. + 2012-08-04 Eli Zaretskii <eliz@gnu.org> * sedlibmk.inp (allocator.$(OBJEXT), careadlinkat.$(OBJEXT)): Fix diff --git a/msdos/sed1v2.inp b/msdos/sed1v2.inp index 0ed88931691..fbee1dd03f9 100644 --- a/msdos/sed1v2.inp +++ b/msdos/sed1v2.inp @@ -106,6 +106,7 @@ s/\.h\.in/.h-in/ /^LIBSELINUX_LIBS *=/s/@LIBSELINUX_LIBS@// /^LIB_PTHREAD_SIGMASK *=/s/@[^@\n]*@// /^LIB_CLOCK_GETTIME *=/s/@[^@\n]*@//g +/^LIB_TIMER_TIME *=/s/@[^@\n]*@//g /^LIBGNUTLS_LIBS *=/s/@[^@\n]*@// /^LIBGNUTLS_CFLAGS *=/s/@[^@\n]*@// /^GETLOADAVG_LIBS *=/s/@[^@\n]*@// diff --git a/msdos/sed3v2.inp b/msdos/sed3v2.inp index bfa008b3e81..cd58e47305c 100644 --- a/msdos/sed3v2.inp +++ b/msdos/sed3v2.inp @@ -36,6 +36,7 @@ s/-DVERSION[^ ]* // /^LIBS_MAIL *=/s/@[^@\n]*@//g /^LIBS_SYSTEM *=/s/@[^@\n]*@//g /^LIB_CLOCK_GETTIME *=/s/@[^@\n]*@//g +/^LIB_TIMER_TIME *=/s/@[^@\n]*@//g /^CFLAGS *=/s!=.*$!=-O2 -g! /^C_SWITCH_SYSTEM *=/s!=.*$!=-DMSDOS -I../msdos! /^C_SWITCH_MACHINE *=/s/@C_SWITCH_MACHINE@// diff --git a/nt/ChangeLog b/nt/ChangeLog index 311a10f66c5..7e064cc3e42 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,21 @@ +2012-09-30 Juanma Barranquero <lekktu@gmail.com> + + * config.nt: Sync with autogen/config.in. + +2012-09-29 Juanma Barranquero <lekktu@gmail.com> + + * config.nt: Sync with autogen/config.in. + (HAVE_TIMER_SETTIME): New macro. + +2012-09-23 Eli Zaretskii <eliz@gnu.org> + + * inc/ms-w32.h (emacs_raise): Redefine to invoke emacs_abort. + +2012-09-23 Paul Eggert <eggert@cs.ucla.edu> + + Simplify and avoid signal-handling races (Bug#12471). + * inc/ms-w32.h (emacs_raise): New macro. + 2012-09-18 Eli Zaretskii <eliz@gnu.org> * configure.bat: Include stddef.h before gif_lib.h, to have size_t diff --git a/nt/config.nt b/nt/config.nt index 23b33731a36..3b398eae04c 100644 --- a/nt/config.nt +++ b/nt/config.nt @@ -968,6 +968,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define to 1 if you have the tiff library (-ltiff). */ #undef HAVE_TIFF +/* Define to 1 if you have the `timer_settime' function. */ +#undef HAVE_TIMER_SETTIME + /* Define if struct tm has the tm_gmtoff member. */ #undef HAVE_TM_GMTOFF @@ -1528,7 +1531,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=54113>. _GL_INLINE_HEADER_END contains useful stuff to put in the same include file, after uses of _GL_INLINE. */ -#if __GNUC__ ? __GNUC_STDC_INLINE__ : 199901L <= __STDC_VERSION__ +#if (__GNUC__ \ + ? defined __GNUC_STDC_INLINE__ && __GNUC_STDC_INLINE__ \ + : 199901L <= __STDC_VERSION__) # define _GL_INLINE inline # define _GL_EXTERN_INLINE extern inline #elif 2 < __GNUC__ + (7 <= __GNUC_MINOR__) @@ -1545,7 +1550,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #endif #if 4 < __GNUC__ + (6 <= __GNUC_MINOR__) -# if __GNUC_STDC_INLINE__ +# if defined __GNUC_STDC_INLINE__ && __GNUC_STDC_INLINE__ # define _GL_INLINE_HEADER_CONST_PRAGMA # else # define _GL_INLINE_HEADER_CONST_PRAGMA \ diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h index 22255843f13..107ab6e788b 100644 --- a/nt/inc/ms-w32.h +++ b/nt/inc/ms-w32.h @@ -203,6 +203,9 @@ struct sigaction { #define kill sys_kill #define signal sys_signal +/* Internal signals. */ +#define emacs_raise(sig) emacs_abort() + /* termcap.c calls that are emulated. */ #define tputs sys_tputs #define tgetstr sys_tgetstr diff --git a/src/.gdbinit b/src/.gdbinit index 74f44cc1007..7a6bfb07fed 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -1214,8 +1214,8 @@ show environment DISPLAY show environment TERM # When debugging, it is handy to be able to "return" from -# fatal_error_backtrace when an assertion failure is non-fatal. -break fatal_error_backtrace +# terminate_due_to_signal when an assertion failure is non-fatal. +break terminate_due_to_signal # x_error_quitter is defined only on X. But window-system is set up # only at run time, during Emacs startup, so we need to defer setting diff --git a/src/ChangeLog b/src/ChangeLog index 508ac9925a8..f69ab42bd90 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -3,6 +3,547 @@ * coding.c (decode_coding_ccl, encode_coding_ccl): Pay attention to the buffer relocation which may be caused by ccl_driver. +2012-09-30 Jan Djärv <jan.h.d@swipnet.se> + + * nsfns.m (ns_frame_parm_handlers): Add x_set_fullscreen. + + * nsterm.m (NEW_STYLE_FS): New define. + (ns_fullscreen_hook, windowWillEnterFullScreen) + (windowDidEnterFullScreen, windowWillExitFullScreen) + (windowDidExitFullScreen, toggleFullScreen, handleFS) + (setFSValue): New functions. + (EmacsFSWindow): New implementation. + (canBecomeKeyWindow): New function for EmacsFSWindow. + (ns_create_terminal): Set fullscreen_hook to ns_fullscreen_hook. + (dealloc): Release nonfs_window if in fullscreen. + (updateFrameSize:): Call windowDidMove to update top/left. + (windowWillResize:toSize:): Check if frame is still maximized. + (initFrameFromEmacs:): Initialize fs_state, fs_before_fs, + next_maximized, maximized_width, maximized_height and nonfs_window. + Call setCollectionBehavior if NEW_STYLE_FS. Initialize bwidth and + tbar_height. + (windowWillUseStandardFrame:defaultFrame:): Update frame parameter + fullscreen. Set maximized_width/height. Act on next_maximized. + + * nsterm.h (MAC_OS_X_VERSION_10_7, MAC_OS_X_VERSION_10_8): New. + (EmacsView): Add variables for fullscreen. + (handleFS, setFSValue, toggleFullScreen): New in EmacsView. + (EmacsFSWindow): New interface for fullscreen. + +2012-09-30 Juanma Barranquero <lekktu@gmail.com> + + * makefile.w32-in ($(BLD)/profiler.$(O)): Update dependencies. + +2012-09-30 Chong Yidong <cyd@gnu.org> + + * fns.c (Frandom): Doc fix. + +2012-09-30 Martin Rudalics <rudalics@gmx.at> + + * window.c (Vwindow_combination_limit): New default value. + (Qwindow_size): New symbol replacing Qtemp_buffer_resize. + +2012-09-30 Paul Eggert <eggert@cs.ucla.edu> + + * syssignal.h (PROFILER_CPU_SUPPORT): Don't define if PROFILING. + Suggested by Eli Zaretskii in + <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00811.html>. + +2012-09-30 Eli Zaretskii <eliz@gnu.org> + + * profiler.c (Fprofiler_cpu_stop): Use timer_settime only if + HAVE_TIMER_SETTIME is defined. + +2012-09-30 Paul Eggert <eggert@cs.ucla.edu> + + Profiler improvements: more-accurate timers, overflow checks. + * profiler.c: Don't include stdio.h, limits.h, sys/time.h, + signal.h, setjmp.h. Include systime.h instead. + (saturated_add): New function. + (record_backtrace, current_sample_interval): Use EMACS_INT, not size_t. + (record_backtrace, handle_profiler_signal): Saturate on fixnum overflow. + (profiler_timer, profiler_timer_ok) [HAVE_TIMER_SETTIME]: + New static vars. + (enum profiler_cpu_running): New enum. + (profiler_cpu_running): Now of that enum type, not bool. + All uses changed to store the new value. + (handle_profiler_signal): Rename from sigprof_handler_1, + for consistency with other handlers. Do not check whether + cpu_log is a hash-table if garbage collecting, since it + doesn't matter in that case. + (deliver_profiler_signal): Rename from sigprof_handler, + for consistency with other handlers. + (setup_cpu_timer): New function, with much of what used to be in + Fprofiler_cpu_start. Check for out-of-range argument. + Prefer timer_settime if available, and prefer + thread cputime clocks, then process cputime clocks, then + monotonic clocks, to the old realtime clock. Use make_timeval + to round more-correctly when falling back to setitimer. + (Fprofiler_cpu_start): Use it. + (Fprofiler_cpu_stop): Prefer timer_settime if available. + Don't assume that passing NULL as the 2nd argument of setitimer + is the same as passing a pointer to all-zero storage. + Ignore SIGPROF afterwards. + (malloc_probe): Saturate at MOST_POSITIVE_FIXNUM. + * sysdep.c (emacs_sigaction_init): Also mask out SIGPROF in + non-fatal signal handlers. Ignore SIGPROF on startup. + * syssignal.h (PROFILER_CPU_SUPPORT): Define this macro here, not + in profiler.c, since sysdep.c now uses it. + + * sysdep.c (handle_fatal_signal): Bump backtrace size to 40. + Suggested by Eli Zaretskii in + <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00796.html>. + +2012-09-29 Juanma Barranquero <lekktu@gmail.com> + + * makefile.w32-in ($(BLD)/profiler.$(O)): Update dependencies. + +2012-09-29 Stefan Monnier <monnier@iro.umontreal.ca> + + * lisp.h (struct backtrace): Remove indirection for `function' field. + * xdisp.c (redisplay_internal): + * profiler.c (record_backtrace, sigprof_handler_1): + * alloc.c (Fgarbage_collect): + * eval.c (interactive_p, Fsignal, eval_sub, Ffuncall, Fbacktrace) + (Fbacktrace_frame): Adjust accordingly. + +2012-09-28 Glenn Morris <rgm@gnu.org> + + * eval.c (Frun_hook_with_args, Frun_hook_with_args_until_success) + (Frun_hook_with_args_until_failure): Doc fixes. + +2012-09-28 Eli Zaretskii <eliz@gnu.org> + + * xdisp.c (syms_of_xdisp) <Qredisplay_internal>: Rename from + Qautomatic_redisplay and change the symbol name. All users changed. + +2012-09-28 Tomohiro Matsuyama <tomo@cx4a.org> + + * profiler.c (sigprof_handler): Fix race condition. + +2012-09-28 Glenn Morris <rgm@gnu.org> + + * lread.c (lisp_file_lexically_bound_p): Handle #! lines. (Bug#12528) + +2012-09-27 Paul Eggert <eggert@cs.ucla.edu> + + Check more robustly for timer_settime. + * Makefile.in (LIB_TIMER_TIME): New macro. + (LIBES): Add it. + * atimer.c (alarm_timer, alarm_timer_ok, set_alarm, init_atimer): + Use HAVE_TIMER_SETTIME, not SIGEV_SIGNAL, to decide whether to + call timer_settime. + +2012-09-26 Tomohiro Matsuyama <tomo@cx4a.org> + + * profiler.c (Fprofiler_cpu_start): Remove unnecessary flag SA_SIGINFO. + +2012-09-26 Juanma Barranquero <lekktu@gmail.com> + + * makefile.w32-in ($(BLD)/profiler.$(O)): Update dependencies. + +2012-09-26 Paul Eggert <eggert@cs.ucla.edu> + + * character.h (MAYBE_UNIFY_CHAR): Remove. + * charset.c, charset.h (maybe_unify_char): Now static. + * charset.c (decode_char): Use maybe_unify_char, not MAYBE_UNIFY_CHAR. + Since this stuff is now private to charset.c, there's no need for + a public macro and no need to inline by hand. + +2012-09-26 Tomohiro Matsuyama <tomo@cx4a.org> + Stefan Monnier <monnier@iro.umontreal.ca> + Juanma Barranquero <lekktu@gmail.com> + + * profiler.c: New file. + * Makefile.in (base_obj): Add profiler.o. + * makefile.w32-in (OBJ2, GLOBAL_SOURCES): Add profiler.c. + ($(BLD)/profiler.$(O)): New target. + * emacs.c (main): Call syms_of_profiler. + * alloc.c (Qautomatic_gc): New constant. + (MALLOC_PROBE): New macro. + (xmalloc, xzalloc, xrealloc, lisp_malloc, lisp_align_malloc): Use it. + (total_bytes_of_live_objects): New function. + (Fgarbage_collect): Use it. Record itself in backtrace_list. + Call malloc_probe for the memory profiler. + (syms_of_alloc): Define Qautomatic_gc. + * eval.c (eval_sub, Ffuncall): Reorder assignments to avoid + race condition. + (struct backtrace): Move definition... + * lisp.h (struct backtrace): ..here. + (Qautomatic_gc, profiler_memory_running): Declare vars. + (malloc_probe, syms_of_profiler): Declare functions. + * xdisp.c (Qautomatic_redisplay): New constant. + (redisplay_internal): Record itself in backtrace_list. + (syms_of_xdisp): Define Qautomatic_redisplay. + +2012-09-25 Eli Zaretskii <eliz@gnu.org> +2012-09-25 Juanma Barranquero <lekktu@gmail.com> + + * makefile.w32-in ($(BLD)/callproc.$(O)): Update dependencies. + +2012-09-25 Paul Eggert <eggert@cs.ucla.edu> + + Prefer POSIX timers if available. + They avoid a race if the timer is too close to the current time. + * atimer.c (alarm_timer, alarm_timer_ok) [SIGEV_SIGNAL]: New static vars. + (set_alarm) [SIGEV_SIGNAL]: Use POSIX timers if available. + (init_atimer) [SIGEV_SIGNAL]: Initialize them. + +2012-09-25 Eli Zaretskii <eliz@gnu.org> + + * coding.c (CHAR_STRING_ADVANCE_NO_UNIFY): Make it an alias of + CHAR_STRING_ADVANCE. + (STRING_CHAR_ADVANCE_NO_UNIFY): Make it an alias of + STRING_CHAR_ADVANCE. + +2012-09-25 Juanma Barranquero <lekktu@gmail.com> + + Move Vlibrary_cache to emacs.c and reset before dumping. + + * lisp.h (reset_image_types): Declare. + [WINDOWSNT] (Vlibrary_cache): Declare. + + * image.c (reset_image_types): New function. + + * emacs.c [WINDOWSNT] (Vlibrary_cache): Move from w32.c. + (syms_of_emacs) [WINDOWSNT] <Vlibrary_cache>: Initialize and staticpro. + (Fdump_emacs): Reset Vlibrary_cache and image_types. + + * w32.c (Vlibrary_cache): Do not define; moved to emacs.c + (globals_of_w32) <Vlibrary_cache>: Do not initialize. + + * w32.h (Vlibrary_cache): Do not declare. + +2012-09-25 Eli Zaretskii <eliz@gnu.org> + + * w32proc.c (sys_signal): Handle all signals defined by the + MS-Windows runtime, not just SIGCHLD. Actually install the signal + handlers for signals supported by Windows. Don't override + term_ntproc as the handler for SIGABRT. + (sigaction): Rewrite to call sys_signal instead of duplicating its + code. + (sys_kill): Improve commentary. + + * w32.c (term_ntproc): Accept (and ignore) one argument, for + consistency with a signature of a signal handler. All callers + changed. + (init_ntproc): Accept an argument DUMPING. If dumping, don't + install term_ntproc as a signal handler for SIGABRT, as that + should be done by the dumped Emacs. + + * w32.h (init_ntproc, term_ntproc): Adjust prototypes. + + * w32select.c (term_w32select): Protect against repeated + invocation by setting clipboard_owner to NULL after calling + DestroyWindow. + + * emacs.c (shut_down_emacs, main): Adapt the calls to init_ntproc + and term_ntproc to their modified signatures. + + * character.c (char_string, string_char): Remove calls to + MAYBE_UNIFY_CHAR. See the discussion starting at + http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00433.html + for the details. + +2012-09-25 Chong Yidong <cyd@gnu.org> + + * xdisp.c (mode_line_inverse_video): Delete obsolete variable. + +2012-09-24 Stefan Monnier <monnier@iro.umontreal.ca> + + * bytecode.c (exec_byte_code): Signal an error instead of aborting, + when encountering an unknown bytecode. + +2012-09-24 Paul Eggert <eggert@cs.ucla.edu> + + image.c, indent.c: Use bool for booleans. + * dispextern.h (struct image_type): Members valid_p, load, init + now return bool, not int. All uses changed. + * image.c: Omit unnecessary static decls. + (x_create_bitmap_mask, x_build_heuristic_mask): + Return void, not int, since callers don't care about the return value. + (x_create_bitmap_mask, define_image_type, valid_image_p) + (struct image_keyword, parse_image_spec, image_spec_value) + (check_image_size, image_background) + (image_background_transparent, x_clear_image_1) + (postprocess_image, lookup_image, x_check_image_size) + (x_create_x_image_and_pixmap, xbm_image_p) + (Create_Pixmap_From_Bitmap_Data, xbm_read_bitmap_data) + (xbm_load_image, xbm_file_p, xbm_load, xpm_lookup_color) + (init_xpm_functions, xpm_valid_color_symbols_p, xpm_image_p) + (xpm_load, xpm_load_image, lookup_rgb_color, lookup_pixel_color) + (x_to_xcolors, x_build_heuristic_mask, pbm_image_p, pbm_load) + (png_image_p, init_png_functions, png_load_body, png_load) + (jpeg_image_p, init_jpeg_functions, jpeg_load_body, jpeg_load) + (tiff_image_p, init_tiff_functions, tiff_load, gif_image_p) + (init_gif_functions, gif_load, imagemagick_image_p) + (imagemagick_load_image, imagemagick_load, svg_image_p) + (init_svg_functions, svg_load, svg_load_image, gs_image_p) + (gs_load): + * nsimage.m (ns_load_image): + * nsterm.m (ns_defined_color): + * xfaces.c (tty_lookup_color, tty_defined_color, defined_color): + * xfns.c (x_defined_color): + * xterm.c (x_alloc_lighter_color_for_widget) + (x_alloc_nearest_color_1, x_alloc_nearest_color) + (x_alloc_lighter_color): + * indent.c (disptab_matches_widthtab, current_column) + (scan_for_column, string_display_width, indented_beyond_p) + (compute_motion, vmotion, Fvertical_motion): + Use bool for booleans. + +2012-09-24 Chong Yidong <cyd@gnu.org> + + * chartab.c (Fset_char_table_default): Obsolete function removed. + +2012-09-23 Paul Eggert <eggert@cs.ucla.edu> + + Move pid_t related decls out of lisp.h. + * lisp.h, syswait.h (record_child_status_change, wait_for_termination) + (interruptible_wait_for_termination): + Move these decls from lisp.h to syswait.h, since they use pid_t. + Needed on FreeBSD; see Herbert J. Skuhra in + <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00571.html>. + * callproc.c: Include syswait.h. + + gnutls.c, gtkutil.c: Use bool for boolean. + * gnutls.c (gnutls_global_initialized, init_gnutls_functions) + (emacs_gnutls_handle_error): + * gtkutil.c (xg_check_special_colors, xg_prepare_tooltip) + (xg_hide_tooltip, xg_create_frame_widgets) + (create_dialog, xg_uses_old_file_dialog) + (xg_get_file_with_chooser, xg_get_file_with_selection) + (xg_get_file_name, xg_have_tear_offs, create_menus, xg_create_widget) + (xg_item_label_same_p, xg_update_menubar) + (xg_modify_menubar_widgets, xg_event_is_for_menubar) + (xg_ignore_gtk_scrollbar, xg_set_toolkit_scroll_bar_thumb) + (xg_event_is_for_scrollbar, xg_pack_tool_bar, xg_make_tool_item) + (is_box_type, xg_tool_item_stale_p, xg_update_tool_bar_sizes) + (update_frame_tool_bar, free_frame_tool_bar): + * gtkutil.c, w32term.c, xterm.c (x_wm_set_size_hint): + * nsmenu.m (ns_update_menubar): + * nsmenu.m, w32menu.c, xmenu.c (set_frame_menubar): + * xfns.c (Fx_show_tip) [USE_GTK]: + Use bool for boolean. + * gtkutil.c (xg_update_frame_menubar): + * xmenu.c (update_frame_menubar): + Return void, not int, since caller ignores return value. + * gtkutil.c (xg_change_toolbar_position): + Return void, not 1. + +2012-09-23 Juanma Barranquero <lekktu@gmail.com> + + * makefile.w32-in (BLOCKINPUT_H): Remove. + (SYSSIGNAL_H): New macro. + ($(BLD)/alloc.$(O), $(BLD)/atimer.$(O), $(BLD)/buffer.$(O)) + ($(BLD)/callproc.$(O), $(BLD)/data.$(O), $(BLD)/dired.$(O)) + ($(BLD)/dispnew.$(O), $(BLD)/editfns.$(O), $(BLD)/emacs.$(O)) + ($(BLD)/eval.$(O), $(BLD)/fileio.$(O), $(BLD)/floatfns.$(O)) + ($(BLD)/fns.$(O), $(BLD)/fontset.$(O), $(BLD)/frame.$(O)) + ($(BLD)/fringe.$(O), $(BLD)/image.$(O), $(BLD)/insdel.$(O)) + ($(BLD)/keyboard.$(O), $(BLD)/keymap.$(O), $(BLD)/lread.$(O)) + ($(BLD)/menu.$(O), $(BLD)/w32inevt.$(O), $(BLD)/w32proc.$(O)) + ($(BLD)/print.$(O), $(BLD)/process.$(O), $(BLD)/ralloc.$(O)) + ($(BLD)/search.$(O), $(BLD)/sound.$(O), $(BLD)/sysdep.$(O)) + ($(BLD)/term.$(O), $(BLD)/window.$(O), $(BLD)/xdisp.$(O)) + ($(BLD)/xfaces.$(O), $(BLD)/w32fns.$(O), $(BLD)/w32menu.$(O)) + ($(BLD)/w32term.$(O), $(BLD)/w32select.$(O), $(BLD)/w32reg.$(O)) + ($(BLD)/w32xfns.$(O)): Update dependencies. + +2012-09-23 Eli Zaretskii <eliz@gnu.org> + + * .gdbinit: Set breakpoint on terminate_due_to_signal, not on + fatal_error_backtrace. + + * w32proc.c (sys_kill): Undo last change: don't do anything when + invoked to deliver SIGABRT to our own process. This is now + handled by emacs_raise. + +2012-09-23 Juanma Barranquero <lekktu@gmail.com> + + * w32term.c (w32_read_socket): Remove leftover reference to + interrupt_input_pending. + +2012-09-23 Paul Eggert <eggert@cs.ucla.edu> + + Do not use SA_NODEFER. + Problem reported by Dani Moncayo in + <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00557.html>. + * alloc.c (die): + * sysdep.c (emacs_abort): Do not reset signal handler. + * emacs.c (terminate_due_to_signal): Reset signal handler here. + * sysdep.c (init_signals): Do not use SA_NODEFER. It wasn't + wanted even on POSIXish hosts, and it doesn't work on Windows. + +2012-09-23 Jan Djärv <jan.h.d@swipnet.se> + + * xterm.c (x_term_init): Call fixup_locale before and after calling + gtk_init (Bug#12392). + +2012-09-23 Chong Yidong <cyd@gnu.org> + + * w32.c (w32_delayed_load): Remove LIBRARIES argument; always use + Vdynamic_library_alist. + + * gnutls.c (init_gnutls_functions): Caller changed; remove arg. + (Fgnutls_available_p): Caller changed. + + * xml.c (init_libxml2_functions, Flibxml_parse_html_region) + (Flibxml_parse_xml_region): Likewise. + + * dispextern.h (struct image_type): Remove arg from init function. + + * image.c (Finit_image_library, lookup_image_type) + (define_image_type): Remove now-unneeded second arg. + (init_xpm_functions, init_png_functions, init_jpeg_functions) + (init_tiff_functions, init_gif_functions, init_svg_functions): + Arglist and w32_delayed_load calling convention changed. + (gs_type): Remove init_gs_functions; there is no such function. + (valid_image_p, make_image): Fix caller to lookup_image_type. + +2012-09-23 Paul Eggert <eggert@cs.ucla.edu> + + Simplify and avoid signal-handling races (Bug#12471). + * alloc.c (die): + * sysdep.c (emacs_abort) [HAVE_NTGUI]: + Avoid recursive loop if there's a fatal error in the function itself. + * atimer.c (pending_atimers): + * blockinput.h: Don't include "atimer.h"; no longer needed. + (interrupt_input_pending): Remove. All uses removed. + pending_signals now counts both atimers and ordinary interrupts. + This is less racy than having three separate pending-signal flags. + (block_input, unblock_input, totally_unblock_input, unblock_input_to) + (input_blocked_p): + Rename from their upper-case counterparts BLOCK_INPUT, + UNBLOCK_INPUT, TOTALLY_UNBLOCK_INPUT, UNBLOCK_INPUT_TO, + INPUT_BLOCKED_P, and turn into functions. All uses changed. + This makes it easier to access volatile variables more accurately. + (BLOCK_INPUT_RESIGNAL): Remove. All uses replaced by unblock_input (). + (input_blocked_p): Prefer this to 'interrupt_input_blocked', as + that's more reliable if the code is buggy and sets + interrupt_input_blocked to a negative value. All uses changed. + * atimer.c (deliver_alarm_signal): + Remove. No need to deliver this to the parent; any thread can + handle this signal now. All uses replaced by underlying handler. + * atimer.c (turn_on_atimers): + * dispnew.c (handle_window_change_signal): + * emacs.c (handle_danger_signal): + * keyboard.c (kbd_buffer_get_event): + Don't reestablish signal handler; not needed with sigaction. + * blockinput.h (UNBLOCK_INPUT_TO, TOTALLY_UNBLOCK_INPUT) + (UNBLOCK_INPUT_TO): + Rework to avoid unnecessary accesses to volatile variables. + (UNBLOCK_INPUT_TO): Now a function. + (totally_unblock_input, unblock_input): New decls. + * data.c (handle_arith_signal, deliver_arith_signal): Move to sysdep.c + (init_data): Remove. Necessary stuff now done in init_signal. + * emacs.c, xdisp.c: Include "atimer.h", since we invoke atimer functions. + * emacs.c (handle_fatal_signal, deliver_fatal_signal): Move to sysdep.c. + (fatal_error_code): Remove; no longer needed. + (terminate_due_to_signal): Rename from fatal_error_backtrace, since + it doesn't always backtrace. All uses changed. No need to reset + signal to default, since sigaction and/or die does that for us now. + Use emacs_raise (FOO), not kill (getpid (), FOO). + (main): Check more-accurately whether we're dumping. + Move fatal-error setup to sysdep.c + * floatfns.c: Do not include "syssignal.h"; no longer needed. + * gtkutil.c (xg_get_file_name, xg_get_font): + Remove no-longer-needed signal-mask manipulation. + * keyboard.c, process.c (POLL_FOR_INPUT): + Don't depend on USE_ASYNC_EVENTS, a symbol that is never defined. + * keyboard.c (read_avail_input): Remove. + All uses replaced by gobble_input. + (Ftop_level): Use TOTALLY_UNBLOCK_INPUT rather than open code. + (kbd_buffer_store_event_hold, gobble_input): + (record_asynch_buffer_change) [USABLE_SIGIO]: + (store_user_signal_events): + No need to mess with signal mask. + (gobble_input): If blocking input and there are terminals, simply + set pending_signals to 1 and return. All hooks changed to not + worry about whether input is blocked. + (process_pending_signals): Clear pending_signals before processing + them, in case a signal comes in while we're processing. + By convention callers now test pending_signals before calling us. + (UNBLOCK_INPUT_TO, unblock_input, totally_unblock_input): + New functions, to support changes to blockinput.h. + (handle_input_available_signal): Now extern. + (reinvoke_input_signal): Remove. All uses replaced by + handle_async_input. + (quit_count): Now volatile, since a signal handler uses it. + (handle_interrupt): Now takes bool IN_SIGNAL_HANDLER as arg. + All callers changed. Block SIGINT only if not already blocked. + Clear sigmask reliably, even if Fsignal returns, which it can. + Omit unnecessary accesses to volatile var. + (quit_throw_to_read_char): No need to restore sigmask. + * keyboard.c (gobble_input, handle_user_signal): + * process.c (wait_reading_process_output): + Call signal-handling code rather than killing ourselves. + * lisp.h: Include <float.h>, for... + (IEEE_FLOATING_POINT): New macro, moved here to avoid duplication. + (pending_signals): Now volatile. + (syms_of_data): Now const if IEEE floating point. + (handle_input_available_signal) [USABLE_SIGIO]: + (terminate_due_to_signal, record_child_status_change): New decls. + * process.c (create_process): Avoid disaster if memory is exhausted + while we're processing a vfork, by tightening the critical section + around the vfork. + (send_process_frame, process_sent_to, handle_pipe_signal) + (deliver_pipe_signal): Remove. No longer needed, as Emacs now + ignores SIGPIPE. + (send_process): No need for setjmp/longjmp any more, since the + SIGPIPE stuff is now gone. Instead, report an error if errno + is EPIPE. + (record_child_status_change): Now extern. PID and W are now args. + Return void, not bool. All callers changed. + * sysdep.c (wait_debugging) [(BSD_SYSTEM || HPUX) && !defined (__GNU__)]: + Remove. All uses removed. This bug should be fixed now in a + different way. + (wait_for_termination_1): Use waitpid rather than sigsuspend, + and record the child status change directly. This avoids the + need to futz with the signal mask. + (process_fatal_action): Move here from emacs.c. + (emacs_sigaction_flags): New function, containing + much of what used to be in emacs_sigaction_init. + (emacs_sigaction_init): Use it. Block nonfatal system signals that are + caught by emacs, to make races less likely. + (deliver_process_signal): Rename from handle_on_main_thread. + All uses changed. + (BACKTRACE_LIMIT_MAX): Now at top level. + (thread_backtrace_buffer, threadback_backtrace_pointers): + New static vars. + (deliver_thread_signal, deliver_fatal_thread_signal): + New functions, for more-accurate delivery of thread-specific signals. + (handle_fatal_signal, deliver_fatal_signal): Move here from emacs.c. + (deliver_arith_signal): Handle in this thread, not + in the main thread, since it's triggered by this thread. + (maybe_fatal_sig): New function. + (init_signals): New arg DUMPING so that we can be more accurate + about whether we're dumping. Caller changed. + Treat thread-specific signals differently from process-general signals. + Block all signals while handling fatal error; that's safer. + xsignal from SIGFPE only on non-IEEE hosts, treating it as fatal + on IEEE hosts. + When batch, ignore SIGHUP, SIGINT, SIGTERM if they were already ignored. + Ignore SIGPIPE unless batch. + (emacs_backtrace): Output backtrace for the appropriate thread, + which is not necessarily the main thread. + * syssignal.h: Include <stdbool.h>. + (emacs_raise): New macro. + * xterm.c (x_connection_signal): Remove; no longer needed + now that we use sigaction. + (x_connection_closed): No need to mess with sigmask now. + (x_initialize): No need to reset SIGPIPE handler here, since + init_signals does this for us now. + +2012-09-23 Jan Djärv <jan.h.d@swipnet.se> + + * nsterm.m (ns_dumpglyphs_image): dr is a new rect to draw image into, + background rect may be larger (Bug#12245). + +2012-09-23 Chong Yidong <cyd@gnu.org> + + * keyboard.c (timer_check): Avoid quitting during Fcopy_sequence. + 2012-09-22 Paul Eggert <eggert@cs.ucla.edu> * .gdbinit: Just stop at fatal_error_backtrace. @@ -30,8 +571,8 @@ if it is defined. Arguments and return value changed. (valid_image_p, make_image): Callers changed. (xbm_type, xpm_type, pbm_type, png_type, jpeg_type, tiff_type) - (gif_type, imagemagick_type, svg_type, gs_type): Add - initialization functions. + (gif_type, imagemagick_type, svg_type, gs_type): + Add initialization functions. (Finit_image_library): Call lookup_image_type. (CHECK_LIB_AVAILABLE): Macro deleted. (lookup_image_type): Call define_image_type here, rather than via @@ -53,8 +594,8 @@ * window.c (Fsplit_window_internal): Handle only Qt value of Vwindow_combination_limit separately. (Qtemp_buffer_resize): New symbol. - (Vwindow_combination_limit): New default value. Rewrite - doc-string. + (Vwindow_combination_limit): New default value. + Rewrite doc-string. 2012-09-22 Eli Zaretskii <eliz@gnu.org> @@ -153,7 +694,7 @@ (Fx_create_frame): Call x_set_offset to correctly interpret top_pos in geometry. - * frame.c (read_integer, XParseGeometry): Moved from w32xfns.c. + * frame.c (read_integer, XParseGeometry): Move from w32xfns.c. (Fx_parse_geometry): If there is a space in string, call Qns_parse_geometry, otherwise do as on other terms (Bug#12368). @@ -254,8 +795,8 @@ 2012-09-16 Martin Rudalics <rudalics@gmx.at> - * window.c (Fwindow_parameter, Fset_window_parameter): Accept - any window as argument (Bug#12452). + * window.c (Fwindow_parameter, Fset_window_parameter): + Accept any window as argument (Bug#12452). 2012-09-16 Jan Djärv <jan.h.d@swipnet.se> @@ -330,8 +871,8 @@ 2012-09-14 Dmitry Antipov <dmantipov@yandex.ru> Avoid out-of-range marker position (Bug#12426). - * insdel.c (replace_range, replace_range_2): Adjust - markers before overlays, as suggested by comments. + * insdel.c (replace_range, replace_range_2): + Adjust markers before overlays, as suggested by comments. (insert_1_both, insert_from_buffer_1, adjust_after_replace): Remove redundant check before calling offset_intervals. @@ -630,8 +1171,8 @@ in the internal border. (x_set_window_size): Remove static variables and their usage. (ns_redraw_scroll_bars): Fix NSTRACE arg. - (ns_after_update_window_line, ns_draw_fringe_bitmap): Remove - fringe/internal border adjustment (Bug#11052). + (ns_after_update_window_line, ns_draw_fringe_bitmap): + Remove fringe/internal border adjustment (Bug#11052). (ns_draw_fringe_bitmap): Make code more like other terms (xterm.c). (ns_draw_window_cursor): Remove fringe/internal border adjustment. (ns_fix_rect_ibw): Remove. @@ -848,8 +1389,8 @@ (init_signals) [FORWARD_SIGNAL_TO_MAIN_THREAD]: Initialize it; code moved here from emacs.c's main function. * sysdep.c, syssignal.h (handle_on_main_thread): New function, - replacing the old SIGNAL_THREAD_CHECK. All uses changed. This - lets callers save and restore errno properly. + replacing the old SIGNAL_THREAD_CHECK. All uses changed. + This lets callers save and restore errno properly. 2012-09-05 Dmitry Antipov <dmantipov@yandex.ru> @@ -1158,8 +1699,8 @@ * process.c: Include TERM_HEADER instead of listing all possible window-system headers. - * nsterm.h: Remove declarations now in frame.h. Define - FRAME_X_SCREEN, FRAME_X_VISUAL. + * nsterm.h: Remove declarations now in frame.h. + Define FRAME_X_SCREEN, FRAME_X_VISUAL. * menu.c: Include TERM_HEADER instead of listing all possible window-system headers. @@ -1355,8 +1896,8 @@ * nsterm.h (NSPanel): New class variable dialog_return. - * nsmenu.m (initWithContentRect:styleMask:backing:defer:): Initialize - dialog_return. + * nsmenu.m (initWithContentRect:styleMask:backing:defer:): + Initialize dialog_return. (windowShouldClose:): Use stop instead of stopModalWithCode. (clicked:): Ditto, and also set dialog_return (Bug#12258). (timeout_handler:): Use stop instead of abortModal. Send a dummy diff --git a/src/ChangeLog.11 b/src/ChangeLog.11 index d3b0a8284b5..1f444b9292c 100644 --- a/src/ChangeLog.11 +++ b/src/ChangeLog.11 @@ -5532,7 +5532,7 @@ (update_frame_tool_bar): Remove old_req, new_req. Do not get tool bar height, call xg_update_tool_bar_sizes instead. (free_frame_tool_bar): Remove from hbox or vbox depending on - toolbar_in_hbox, Set all FRAME_TOOLBAR_*_(WIDTH|HEIGHT) to zero. + toolbar_in_hbox. Set all FRAME_TOOLBAR_*_(WIDTH|HEIGHT) to zero. (xg_change_toolbar_position): New function. * frame.h (struct frame): Add tool_bar_position. diff --git a/src/ChangeLog.2 b/src/ChangeLog.2 index 1a9728f6896..0806106836e 100644 --- a/src/ChangeLog.2 +++ b/src/ChangeLog.2 @@ -2680,7 +2680,7 @@ 1986-12-11 Richard Mlynarik (mly@prep) - * emacs.c, dispnew.c: + * emacs.c, dispnew.c: Rename inhibit_x_windows inhibit_window_system. Understand "-nw" command-line option. Reorganize init_display a little to make other window-system diff --git a/src/ChangeLog.3 b/src/ChangeLog.3 index 6c580fe4b52..4f6e02ff8d3 100644 --- a/src/ChangeLog.3 +++ b/src/ChangeLog.3 @@ -11154,7 +11154,7 @@ (classify_object): Removed code to look up a function key in the global and local function key keymaps, since this will be done more generally. - (Fexecute_mouse_event): Elided this function with a #if 0; I + (Fexecute_mouse_event): Elided this function with a #if 0; I think it will go away once the more general keymap stuff is implemented, but I'm not sure. (syms_of_keyboard): Removed defsubr for Sexecute_mouse_event. diff --git a/src/Makefile.in b/src/Makefile.in index 37da170edbd..f8da0091711 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -153,6 +153,7 @@ M17N_FLT_CFLAGS = @M17N_FLT_CFLAGS@ M17N_FLT_LIBS = @M17N_FLT_LIBS@ LIB_CLOCK_GETTIME=@LIB_CLOCK_GETTIME@ +LIB_TIMER_TIME=@LIB_TIMER_TIME@ DBUS_CFLAGS = @DBUS_CFLAGS@ DBUS_LIBS = @DBUS_LIBS@ @@ -339,6 +340,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ process.o gnutls.o callproc.o \ region-cache.o sound.o atimer.o \ doprnt.o intervals.o textprop.o composite.o xml.o \ + profiler.o \ $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \ $(WINDOW_SYSTEM_OBJ) obj = $(base_obj) $(NS_OBJC_OBJ) @@ -384,8 +386,8 @@ otherobj= $(TERMCAP_OBJ) $(PRE_ALLOC_OBJ) $(GMALLOC_OBJ) $(RALLOC_OBJ) \ ## duplicated symbols. If the standard libraries were compiled ## with GCC, we might need LIB_GCC again after them. LIBES = $(LIBS) $(LIBX_BASE) $(LIBX_OTHER) $(LIBSOUND) \ - $(RSVG_LIBS) $(IMAGEMAGICK_LIBS) $(LIB_CLOCK_GETTIME) $(DBUS_LIBS) \ - $(LIB_EXECINFO) \ + $(RSVG_LIBS) $(IMAGEMAGICK_LIBS) $(LIB_CLOCK_GETTIME) $(LIB_TIMER_TIME) \ + $(DBUS_LIBS) $(LIB_EXECINFO) \ $(LIBXML2_LIBS) $(LIBGPM) $(LIBRESOLV) $(LIBS_SYSTEM) \ $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \ $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ diff --git a/src/alloc.c b/src/alloc.c index 02ba2f5f9e3..df166b4924a 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -205,6 +205,7 @@ static Lisp_Object Qintervals; static Lisp_Object Qbuffers; static Lisp_Object Qstring_bytes, Qvector_slots, Qheap; static Lisp_Object Qgc_cons_threshold; +Lisp_Object Qautomatic_gc; Lisp_Object Qchar_table_extra_slots; /* Hook run after GC has finished. */ @@ -633,13 +634,13 @@ static void malloc_block_input (void) { if (block_input_in_memory_allocators) - BLOCK_INPUT; + block_input (); } static void malloc_unblock_input (void) { if (block_input_in_memory_allocators) - UNBLOCK_INPUT; + unblock_input (); } # define MALLOC_BLOCK_INPUT malloc_block_input () # define MALLOC_UNBLOCK_INPUT malloc_unblock_input () @@ -648,6 +649,13 @@ malloc_unblock_input (void) # define MALLOC_UNBLOCK_INPUT ((void) 0) #endif +#define MALLOC_PROBE(size) \ + do { \ + if (profiler_memory_running) \ + malloc_probe (size); \ + } while (0) + + /* Like malloc but check for no memory and block interrupt input.. */ void * @@ -661,6 +669,7 @@ xmalloc (size_t size) if (!val && size) memory_full (size); + MALLOC_PROBE (size); return val; } @@ -678,6 +687,7 @@ xzalloc (size_t size) if (!val && size) memory_full (size); memset (val, 0, size); + MALLOC_PROBE (size); return val; } @@ -699,6 +709,7 @@ xrealloc (void *block, size_t size) if (!val && size) memory_full (size); + MALLOC_PROBE (size); return val; } @@ -888,6 +899,7 @@ lisp_malloc (size_t nbytes, enum mem_type type) MALLOC_UNBLOCK_INPUT; if (!val && nbytes) memory_full (nbytes); + MALLOC_PROBE (nbytes); return val; } @@ -1093,6 +1105,8 @@ lisp_align_malloc (size_t nbytes, enum mem_type type) MALLOC_UNBLOCK_INPUT; + MALLOC_PROBE (nbytes); + eassert (0 == ((uintptr_t) val) % BLOCK_ALIGN); return val; } @@ -5043,6 +5057,23 @@ bounded_number (EMACS_INT number) return make_number (min (MOST_POSITIVE_FIXNUM, number)); } +/* Calculate total bytes of live objects. */ + +static size_t +total_bytes_of_live_objects (void) +{ + size_t tot = 0; + tot += total_conses * sizeof (struct Lisp_Cons); + tot += total_symbols * sizeof (struct Lisp_Symbol); + tot += total_markers * sizeof (union Lisp_Misc); + tot += total_string_bytes; + tot += total_vector_slots * word_size; + tot += total_floats * sizeof (struct Lisp_Float); + tot += total_intervals * sizeof (struct interval); + tot += total_strings * sizeof (struct Lisp_String); + return tot; +} + DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "", doc: /* Reclaim storage for Lisp objects no longer needed. Garbage collection happens automatically if you cons more than @@ -5068,6 +5099,8 @@ See Info node `(elisp)Garbage Collection'. */) ptrdiff_t count = SPECPDL_INDEX (); EMACS_TIME start; Lisp_Object retval = Qnil; + size_t tot_before = 0; + struct backtrace backtrace; if (abort_on_gc) emacs_abort (); @@ -5077,6 +5110,14 @@ See Info node `(elisp)Garbage Collection'. */) if (pure_bytes_used_before_overflow) return Qnil; + /* Record this function, so it appears on the profiler's backtraces. */ + backtrace.next = backtrace_list; + backtrace.function = Qautomatic_gc; + backtrace.args = &Qnil; + backtrace.nargs = 0; + backtrace.debug_on_exit = 0; + backtrace_list = &backtrace; + check_cons_list (); /* Don't keep undo information around forever. @@ -5084,6 +5125,9 @@ See Info node `(elisp)Garbage Collection'. */) FOR_EACH_BUFFER (nextb) compact_buffer (nextb); + if (profiler_memory_running) + tot_before = total_bytes_of_live_objects (); + start = current_emacs_time (); /* In case user calls debug_print during GC, @@ -5125,7 +5169,7 @@ See Info node `(elisp)Garbage Collection'. */) if (garbage_collection_messages) message1_nolog ("Garbage collecting..."); - BLOCK_INPUT; + block_input (); shrink_regexp_cache (); @@ -5242,7 +5286,7 @@ See Info node `(elisp)Garbage Collection'. */) dump_zombies (); #endif - UNBLOCK_INPUT; + unblock_input (); check_cons_list (); @@ -5255,16 +5299,7 @@ See Info node `(elisp)Garbage Collection'. */) gc_relative_threshold = 0; if (FLOATP (Vgc_cons_percentage)) { /* Set gc_cons_combined_threshold. */ - double tot = 0; - - tot += total_conses * sizeof (struct Lisp_Cons); - tot += total_symbols * sizeof (struct Lisp_Symbol); - tot += total_markers * sizeof (union Lisp_Misc); - tot += total_string_bytes; - tot += total_vector_slots * word_size; - tot += total_floats * sizeof (struct Lisp_Float); - tot += total_intervals * sizeof (struct interval); - tot += total_strings * sizeof (struct Lisp_String); + double tot = total_bytes_of_live_objects (); tot *= XFLOAT_DATA (Vgc_cons_percentage); if (0 < tot) @@ -5367,6 +5402,17 @@ See Info node `(elisp)Garbage Collection'. */) gcs_done++; + /* Collect profiling data. */ + if (profiler_memory_running) + { + size_t swept = 0; + size_t tot_after = total_bytes_of_live_objects (); + if (tot_before > tot_after) + swept = tot_before - tot_after; + malloc_probe (swept); + } + + backtrace_list = backtrace.next; return retval; } @@ -6395,7 +6441,7 @@ die (const char *msg, const char *file, int line) { fprintf (stderr, "\r\n%s:%d: Emacs fatal error: %s\r\n", file, line, msg); - fatal_error_backtrace (SIGABRT, INT_MAX); + terminate_due_to_signal (SIGABRT, INT_MAX); } #endif @@ -6527,6 +6573,7 @@ do hash-consing of the objects allocated to pure space. */); DEFSYM (Qstring_bytes, "string-bytes"); DEFSYM (Qvector_slots, "vector-slots"); DEFSYM (Qheap, "heap"); + DEFSYM (Qautomatic_gc, "Automatic GC"); DEFSYM (Qgc_cons_threshold, "gc-cons-threshold"); DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots"); diff --git a/src/atimer.c b/src/atimer.c index 5dbd807872a..048c62798ef 100644 --- a/src/atimer.c +++ b/src/atimer.c @@ -40,13 +40,12 @@ static struct atimer *stopped_atimers; static struct atimer *atimers; -/* Non-zero means alarm signal handler has found ripe timers but - interrupt_input_blocked was non-zero. In this case, timer - functions are not called until the next UNBLOCK_INPUT because timer - functions are expected to call X, and X cannot be assumed to be - reentrant. */ - -int pending_atimers; +/* The alarm timer and whether it was properly initialized, if + POSIX timers are available. */ +#ifdef HAVE_TIMER_SETTIME +static timer_t alarm_timer; +static bool alarm_timer_ok; +#endif /* Block/unblock SIGALRM. */ @@ -295,14 +294,25 @@ set_alarm (void) #ifdef HAVE_SETITIMER struct itimerval it; #endif + EMACS_TIME now, interval; - /* Determine s/us till the next timer is ripe. */ - EMACS_TIME now = current_emacs_time (); +#ifdef HAVE_TIMER_SETTIME + if (alarm_timer_ok) + { + struct itimerspec ispec; + ispec.it_value = atimers->expiration; + ispec.it_interval.tv_sec = ispec.it_interval.tv_nsec = 0; + if (timer_settime (alarm_timer, 0, &ispec, 0) == 0) + return; + } +#endif - /* Don't set the interval to 0; this disables the timer. */ - EMACS_TIME interval = (EMACS_TIME_LE (atimers->expiration, now) - ? make_emacs_time (0, 1000 * 1000) - : sub_emacs_time (atimers->expiration, now)); + /* Determine interval till the next timer is ripe. + Don't set the interval to 0; this disables the timer. */ + now = current_emacs_time (); + interval = (EMACS_TIME_LE (atimers->expiration, now) + ? make_emacs_time (0, 1000 * 1000) + : sub_emacs_time (atimers->expiration, now)); #ifdef HAVE_SETITIMER @@ -341,16 +351,11 @@ schedule_atimer (struct atimer *t) static void run_timers (void) { - EMACS_TIME now; + EMACS_TIME now = current_emacs_time (); - while (atimers - && (pending_atimers = interrupt_input_blocked) == 0 - && (now = current_emacs_time (), - EMACS_TIME_LE (atimers->expiration, now))) + while (atimers && EMACS_TIME_LE (atimers->expiration, now)) { - struct atimer *t; - - t = atimers; + struct atimer *t = atimers; atimers = atimers->next; t->fn (t); @@ -366,16 +371,7 @@ run_timers (void) } } - if (! atimers) - pending_atimers = 0; - - if (pending_atimers) - pending_signals = 1; - else - { - pending_signals = interrupt_input_pending; - set_alarm (); - } + set_alarm (); } @@ -385,23 +381,16 @@ run_timers (void) static void handle_alarm_signal (int sig) { - pending_atimers = 1; pending_signals = 1; } -static void -deliver_alarm_signal (int sig) -{ - handle_on_main_thread (sig, handle_alarm_signal); -} - -/* Call alarm signal handler for pending timers. */ +/* Do pending timers. */ void do_pending_atimers (void) { - if (pending_atimers) + if (atimers) { block_atimers (); run_timers (); @@ -417,12 +406,7 @@ void turn_on_atimers (bool on) { if (on) - { - struct sigaction action; - emacs_sigaction_init (&action, deliver_alarm_signal); - sigaction (SIGALRM, &action, 0); - set_alarm (); - } + set_alarm (); else alarm (0); } @@ -432,9 +416,15 @@ void init_atimer (void) { struct sigaction action; +#ifdef HAVE_TIMER_SETTIME + struct sigevent sigev; + sigev.sigev_notify = SIGEV_SIGNAL; + sigev.sigev_signo = SIGALRM; + sigev.sigev_value.sival_ptr = &alarm_timer; + alarm_timer_ok = timer_create (CLOCK_REALTIME, &sigev, &alarm_timer) == 0; +#endif free_atimers = stopped_atimers = atimers = NULL; - pending_atimers = 0; /* pending_signals is initialized in init_keyboard.*/ - emacs_sigaction_init (&action, deliver_alarm_signal); + emacs_sigaction_init (&action, handle_alarm_signal); sigaction (SIGALRM, &action, 0); } diff --git a/src/blockinput.h b/src/blockinput.h index 7501bfc91a0..70822e29be7 100644 --- a/src/blockinput.h +++ b/src/blockinput.h @@ -19,103 +19,57 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #ifndef EMACS_BLOCKINPUT_H #define EMACS_BLOCKINPUT_H -#include "atimer.h" +INLINE_HEADER_BEGIN +#ifndef BLOCKINPUT_INLINE +# define BLOCKINPUT_INLINE INLINE +#endif -/* When Emacs is using signal-driven input, the processing of those - input signals can get pretty hairy. For example, when Emacs is - running under X windows, handling an input signal can entail - retrieving events from the X event queue, or making other X calls. - - If an input signal occurs while Emacs is in the midst of some - non-reentrant code, and the signal processing invokes that same - code, we lose. For example, malloc and the Xlib functions aren't - usually re-entrant, and both are used by the X input signal handler - - if we try to process an input signal in the midst of executing - any of these functions, we'll lose. +/* Emacs should avoid doing anything hairy in a signal handler, because + so many system functions are non-reentrant. For example, malloc + and the Xlib functions aren't usually re-entrant, so if they were + used by the SIGIO handler, we'd lose. To avoid this, we make the following requirements: - * Everyone must evaluate BLOCK_INPUT before entering these functions, - and then call UNBLOCK_INPUT after performing them. Calls - BLOCK_INPUT and UNBLOCK_INPUT may be nested. + * Everyone must evaluate BLOCK_INPUT before performing actions that + might conflict with a signal handler, and then call UNBLOCK_INPUT + after performing them. Calls BLOCK_INPUT and UNBLOCK_INPUT may be + nested. * Any complicated interrupt handling code should test - interrupt_input_blocked, and put off its work until later. + INPUT_BLOCKED_P, and put off its work until later. * If the interrupt handling code wishes, it may set - interrupt_input_pending to a non-zero value. If that flag is set - when input becomes unblocked, UNBLOCK_INPUT will send a new SIGIO. */ - -extern volatile int interrupt_input_blocked; - -/* Nonzero means an input interrupt has arrived - during the current critical section. */ -extern int interrupt_input_pending; + pending_signals to a non-zero value. If that flag is set + when input becomes unblocked, UNBLOCK_INPUT will then read + input and process timers. + Historically, Emacs signal handlers did much more than they do now, + and this caused many BLOCK_INPUT calls to be sprinkled around the code. + FIXME: Remove calls that aren't needed now. */ -/* Non-zero means asynchronous timers should be run when input is - unblocked. */ +extern volatile int interrupt_input_blocked; -extern int pending_atimers; +/* Begin critical section. */ +BLOCKINPUT_INLINE void +block_input (void) +{ + interrupt_input_blocked++; +} -/* Begin critical section. */ -#define BLOCK_INPUT (interrupt_input_blocked++) - -/* End critical section. - - If doing signal-driven input, and a signal came in when input was - blocked, reinvoke the signal handler now to deal with it. - - Always test interrupt_input_pending; that's not too expensive, and - it'll never get set if we don't need to resignal. This is simpler - than dealing here with every configuration option that might affect - whether interrupt_input_pending can be nonzero. */ - -#define UNBLOCK_INPUT \ - do \ - { \ - --interrupt_input_blocked; \ - if (interrupt_input_blocked == 0) \ - { \ - if (interrupt_input_pending) \ - reinvoke_input_signal (); \ - if (pending_atimers) \ - do_pending_atimers (); \ - } \ - else if (interrupt_input_blocked < 0) \ - emacs_abort (); \ - } \ - while (0) - -/* Undo any number of BLOCK_INPUT calls, - and also reinvoke any pending signal. */ - -#define TOTALLY_UNBLOCK_INPUT \ - do if (interrupt_input_blocked != 0) \ - { \ - interrupt_input_blocked = 1; \ - UNBLOCK_INPUT; \ - } \ - while (0) - -/* Undo any number of BLOCK_INPUT calls down to level LEVEL, - and also (if the level is now 0) reinvoke any pending signal. */ - -#define UNBLOCK_INPUT_TO(LEVEL) \ - do \ - { \ - interrupt_input_blocked = (LEVEL) + 1; \ - UNBLOCK_INPUT; \ - } \ - while (0) - -#define UNBLOCK_INPUT_RESIGNAL UNBLOCK_INPUT +extern void unblock_input (void); +extern void totally_unblock_input (void); +extern void unblock_input_to (int); /* In critical section ? */ -#define INPUT_BLOCKED_P (interrupt_input_blocked > 0) -/* Defined in keyboard.c */ -extern void reinvoke_input_signal (void); +BLOCKINPUT_INLINE bool +input_blocked_p (void) +{ + return 0 < interrupt_input_blocked; +} + +INLINE_HEADER_END #endif /* EMACS_BLOCKINPUT_H */ diff --git a/src/buffer.c b/src/buffer.c index 22624e33a4b..356a308fce6 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -550,11 +550,11 @@ even if it is dead. The return value is never nil. */) b->indirections = 0; BUF_GAP_SIZE (b) = 20; - BLOCK_INPUT; + block_input (); /* We allocate extra 1-byte at the tail and keep it always '\0' for anchoring a search. */ alloc_buffer_text (b, BUF_GAP_SIZE (b) + 1); - UNBLOCK_INPUT; + unblock_input (); if (! BUF_BEG_ADDR (b)) buffer_memory_full (BUF_GAP_SIZE (b) + 1); @@ -1923,7 +1923,7 @@ cleaning up all windows currently displaying the buffer to be killed. */) bset_name (b, Qnil); - BLOCK_INPUT; + block_input (); if (b->base_buffer) { /* Notify our base buffer that we don't share the text anymore. */ @@ -1946,7 +1946,7 @@ cleaning up all windows currently displaying the buffer to be killed. */) b->width_run_cache = 0; } bset_width_table (b, Qnil); - UNBLOCK_INPUT; + unblock_input (); bset_undo_list (b, Qnil); /* Run buffer-list-update-hook. */ @@ -5032,7 +5032,7 @@ alloc_buffer_text (struct buffer *b, ptrdiff_t nbytes) { void *p; - BLOCK_INPUT; + block_input (); #if defined USE_MMAP_FOR_BUFFERS p = mmap_alloc ((void **) &b->text->beg, nbytes); #elif defined REL_ALLOC @@ -5043,12 +5043,12 @@ alloc_buffer_text (struct buffer *b, ptrdiff_t nbytes) if (p == NULL) { - UNBLOCK_INPUT; + unblock_input (); memory_full (nbytes); } b->text->beg = (unsigned char *) p; - UNBLOCK_INPUT; + unblock_input (); } /* Enlarge buffer B's text buffer by DELTA bytes. DELTA < 0 means @@ -5060,7 +5060,7 @@ enlarge_buffer_text (struct buffer *b, ptrdiff_t delta) void *p; ptrdiff_t nbytes = (BUF_Z_BYTE (b) - BUF_BEG_BYTE (b) + BUF_GAP_SIZE (b) + 1 + delta); - BLOCK_INPUT; + block_input (); #if defined USE_MMAP_FOR_BUFFERS p = mmap_realloc ((void **) &b->text->beg, nbytes); #elif defined REL_ALLOC @@ -5071,12 +5071,12 @@ enlarge_buffer_text (struct buffer *b, ptrdiff_t delta) if (p == NULL) { - UNBLOCK_INPUT; + unblock_input (); memory_full (nbytes); } BUF_BEG_ADDR (b) = (unsigned char *) p; - UNBLOCK_INPUT; + unblock_input (); } @@ -5085,7 +5085,7 @@ enlarge_buffer_text (struct buffer *b, ptrdiff_t delta) static void free_buffer_text (struct buffer *b) { - BLOCK_INPUT; + block_input (); #if defined USE_MMAP_FOR_BUFFERS mmap_free ((void **) &b->text->beg); @@ -5096,7 +5096,7 @@ free_buffer_text (struct buffer *b) #endif BUF_BEG_ADDR (b) = NULL; - UNBLOCK_INPUT; + unblock_input (); } diff --git a/src/bytecode.c b/src/bytecode.c index 5f4fdcc5eff..648813aed86 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1876,7 +1876,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, /* Actually this is Bstack_ref with offset 0, but we use Bdup for that instead. */ /* CASE (Bstack_ref): */ - emacs_abort (); + error ("Invalid byte opcode"); /* Handy byte-codes for lexical binding. */ CASE (Bstack_ref1): diff --git a/src/callproc.c b/src/callproc.c index 2604d295f3e..b33882e54c2 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -51,6 +51,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "process.h" #include "syssignal.h" #include "systty.h" +#include "syswait.h" #include "blockinput.h" #include "frame.h" #include "termhooks.h" @@ -582,7 +583,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) 0, current_dir); #else /* not WINDOWSNT */ - BLOCK_INPUT; + block_input (); /* vfork, and prevent local vars from being clobbered by the vfork. */ { @@ -626,15 +627,14 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) setpgrp (pid, pid); #endif /* USG */ - /* GConf causes us to ignore SIGPIPE, make sure it is restored - in the child. */ + /* Emacs ignores SIGPIPE, but the child should not. */ signal (SIGPIPE, SIG_DFL); child_setup (filefd, fd1, fd_error, (char **) new_argv, 0, current_dir); } - UNBLOCK_INPUT; + unblock_input (); #endif /* not WINDOWSNT */ @@ -976,9 +976,9 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r { int fd; - BLOCK_INPUT; + block_input (); fd = mkstemp (tempfile); - UNBLOCK_INPUT; + unblock_input (); if (fd == -1) report_file_error ("Failed to open temporary file", Fcons (build_string (tempfile), Qnil)); diff --git a/src/character.c b/src/character.c index def1ad090fd..5808d48a235 100644 --- a/src/character.c +++ b/src/character.c @@ -126,8 +126,6 @@ char_string (unsigned int c, unsigned char *p) c &= ~CHAR_MODIFIER_MASK; } - MAYBE_UNIFY_CHAR (c); - if (c <= MAX_3_BYTE_CHAR) { bytes = CHAR_STRING (c, p); @@ -195,8 +193,6 @@ string_char (const unsigned char *p, const unsigned char **advanced, int *len) p += 5; } - MAYBE_UNIFY_CHAR (c); - if (len) *len = p - saved_p; if (advanced) diff --git a/src/character.h b/src/character.h index 70d4e67a978..b2cdcb76699 100644 --- a/src/character.h +++ b/src/character.h @@ -554,23 +554,6 @@ INLINE_HEADER_BEGIN } while (0) -/* If C is a character to be unified with a Unicode character, return - the unified Unicode character. */ - -#define MAYBE_UNIFY_CHAR(c) \ - do { \ - if (c > MAX_UNICODE_CHAR && c <= MAX_5_BYTE_CHAR) \ - { \ - Lisp_Object val; \ - val = CHAR_TABLE_REF (Vchar_unify_table, c); \ - if (INTEGERP (val)) \ - c = XFASTINT (val); \ - else if (! NILP (val)) \ - c = maybe_unify_char (c, val); \ - } \ - } while (0) - - /* Return a non-outlandish value for the tab width. */ #define SANE_TAB_WIDTH(buf) \ diff --git a/src/charset.c b/src/charset.c index d8c38e5ea3b..b0915ffde9c 100644 --- a/src/charset.c +++ b/src/charset.c @@ -1617,7 +1617,7 @@ only `ascii', `eight-bit-control', and `eight-bit-graphic'. */) /* Return a unified character code for C (>= 0x110000). VAL is a value of Vchar_unify_table for C; i.e. it is nil, an integer, or a charset symbol. */ -int +static int maybe_unify_char (int c, Lisp_Object val) { struct charset *charset; @@ -1723,8 +1723,12 @@ decode_char (struct charset *charset, unsigned int code) { c = char_index + CHARSET_CODE_OFFSET (charset); if (CHARSET_UNIFIED_P (charset) - && c > MAX_UNICODE_CHAR) - MAYBE_UNIFY_CHAR (c); + && MAX_UNICODE_CHAR < c && c <= MAX_5_BYTE_CHAR) + { + /* Unify C with a Unicode character if possible. */ + Lisp_Object val = CHAR_TABLE_REF (Vchar_unify_table, c); + c = maybe_unify_char (c, val); + } } } diff --git a/src/charset.h b/src/charset.h index 50d230489fe..b5fa36290c8 100644 --- a/src/charset.h +++ b/src/charset.h @@ -538,7 +538,6 @@ extern int charset_unibyte; extern struct charset *char_charset (int, Lisp_Object, unsigned *); extern Lisp_Object charset_attributes (int); -extern int maybe_unify_char (int, Lisp_Object); extern int decode_char (struct charset *, unsigned); extern unsigned encode_char (struct charset *, int); extern int string_xstring_p (Lisp_Object); diff --git a/src/chartab.c b/src/chartab.c index e864514e336..7430235b4af 100644 --- a/src/chartab.c +++ b/src/chartab.c @@ -655,15 +655,6 @@ or a character code. Return VALUE. */) return value; } -DEFUN ("set-char-table-default", Fset_char_table_default, - Sset_char_table_default, 3, 3, 0, - doc: /* -This function is obsolete and has no effect. */) - (Lisp_Object char_table, Lisp_Object ch, Lisp_Object value) -{ - return Qnil; -} - /* Look up the element in TABLE at index CH, and return it as an integer. If the element is not a character, return CH itself. */ @@ -1415,7 +1406,6 @@ syms_of_chartab (void) defsubr (&Sset_char_table_extra_slot); defsubr (&Schar_table_range); defsubr (&Sset_char_table_range); - defsubr (&Sset_char_table_default); defsubr (&Soptimize_char_table); defsubr (&Smap_char_table); defsubr (&Sunicode_property_table_internal); diff --git a/src/coding.c b/src/coding.c index 40e67b9a6c8..32d300b9923 100644 --- a/src/coding.c +++ b/src/coding.c @@ -920,65 +920,18 @@ record_conversion_result (struct coding_system *coding, /* Store multibyte form of the character C in P, and advance P to the - end of the multibyte form. This is like CHAR_STRING_ADVANCE but it - never calls MAYBE_UNIFY_CHAR. */ - -#define CHAR_STRING_ADVANCE_NO_UNIFY(c, p) \ - do { \ - if ((c) <= MAX_1_BYTE_CHAR) \ - *(p)++ = (c); \ - else if ((c) <= MAX_2_BYTE_CHAR) \ - *(p)++ = (0xC0 | ((c) >> 6)), \ - *(p)++ = (0x80 | ((c) & 0x3F)); \ - else if ((c) <= MAX_3_BYTE_CHAR) \ - *(p)++ = (0xE0 | ((c) >> 12)), \ - *(p)++ = (0x80 | (((c) >> 6) & 0x3F)), \ - *(p)++ = (0x80 | ((c) & 0x3F)); \ - else if ((c) <= MAX_4_BYTE_CHAR) \ - *(p)++ = (0xF0 | (c >> 18)), \ - *(p)++ = (0x80 | ((c >> 12) & 0x3F)), \ - *(p)++ = (0x80 | ((c >> 6) & 0x3F)), \ - *(p)++ = (0x80 | (c & 0x3F)); \ - else if ((c) <= MAX_5_BYTE_CHAR) \ - *(p)++ = 0xF8, \ - *(p)++ = (0x80 | ((c >> 18) & 0x0F)), \ - *(p)++ = (0x80 | ((c >> 12) & 0x3F)), \ - *(p)++ = (0x80 | ((c >> 6) & 0x3F)), \ - *(p)++ = (0x80 | (c & 0x3F)); \ - else \ - (p) += BYTE8_STRING ((c) - 0x3FFF80, p); \ - } while (0) + end of the multibyte form. This used to be like CHAR_STRING_ADVANCE + without ever calling MAYBE_UNIFY_CHAR, but nowadays we don't call + MAYBE_UNIFY_CHAR in CHAR_STRING_ADVANCE. */ +#define CHAR_STRING_ADVANCE_NO_UNIFY(c, p) CHAR_STRING_ADVANCE(c, p) /* Return the character code of character whose multibyte form is at - P, and advance P to the end of the multibyte form. This is like - STRING_CHAR_ADVANCE, but it never calls MAYBE_UNIFY_CHAR. */ - -#define STRING_CHAR_ADVANCE_NO_UNIFY(p) \ - (!((p)[0] & 0x80) \ - ? *(p)++ \ - : ! ((p)[0] & 0x20) \ - ? ((p) += 2, \ - ((((p)[-2] & 0x1F) << 6) \ - | ((p)[-1] & 0x3F) \ - | ((unsigned char) ((p)[-2]) < 0xC2 ? 0x3FFF80 : 0))) \ - : ! ((p)[0] & 0x10) \ - ? ((p) += 3, \ - ((((p)[-3] & 0x0F) << 12) \ - | (((p)[-2] & 0x3F) << 6) \ - | ((p)[-1] & 0x3F))) \ - : ! ((p)[0] & 0x08) \ - ? ((p) += 4, \ - ((((p)[-4] & 0xF) << 18) \ - | (((p)[-3] & 0x3F) << 12) \ - | (((p)[-2] & 0x3F) << 6) \ - | ((p)[-1] & 0x3F))) \ - : ((p) += 5, \ - ((((p)[-4] & 0x3F) << 18) \ - | (((p)[-3] & 0x3F) << 12) \ - | (((p)[-2] & 0x3F) << 6) \ - | ((p)[-1] & 0x3F)))) + P, and advance P to the end of the multibyte form. This used to be + like STRING_CHAR_ADVANCE without ever calling MAYBE_UNIFY_CHAR, but + nowadays STRING_CHAR_ADVANCE doesn't call MAYBE_UNIFY_CHAR. */ +#define STRING_CHAR_ADVANCE_NO_UNIFY(p) STRING_CHAR_ADVANCE(p) /* Set coding->source from coding->src_object. */ diff --git a/src/data.c b/src/data.c index 72d7c8ccf9a..abcdd4dca0d 100644 --- a/src/data.c +++ b/src/data.c @@ -34,14 +34,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "font.h" #include "keymap.h" -#include <float.h> -#if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ - && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) -#define IEEE_FLOATING_POINT 1 -#else -#define IEEE_FLOATING_POINT 0 -#endif - Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound; static Lisp_Object Qsubr; Lisp_Object Qerror_conditions, Qerror_message, Qtop_level; @@ -3179,32 +3171,3 @@ syms_of_data (void) Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM); XSYMBOL (intern_c_string ("most-negative-fixnum"))->constant = 1; } - -static _Noreturn void -handle_arith_signal (int sig) -{ - pthread_sigmask (SIG_SETMASK, &empty_mask, 0); - xsignal0 (Qarith_error); -} - -static void -deliver_arith_signal (int sig) -{ - handle_on_main_thread (sig, handle_arith_signal); -} - -void -init_data (void) -{ - struct sigaction action; - /* Don't do this if just dumping out. - We don't want to call `signal' in this case - so that we don't have trouble with dumping - signal-delivering routines in an inconsistent state. */ -#ifndef CANNOT_DUMP - if (!initialized) - return; -#endif /* CANNOT_DUMP */ - emacs_sigaction_init (&action, deliver_arith_signal); - sigaction (SIGFPE, &action, 0); -} diff --git a/src/dired.c b/src/dired.c index 3aa27ecf920..4986f845101 100644 --- a/src/dired.c +++ b/src/dired.c @@ -101,9 +101,9 @@ static Lisp_Object directory_files_internal_unwind (Lisp_Object dh) { DIR *d = (DIR *) XSAVE_VALUE (dh)->pointer; - BLOCK_INPUT; + block_input (); closedir (d); - UNBLOCK_INPUT; + unblock_input (); return Qnil; } @@ -164,9 +164,9 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, /* Now *bufp is the compiled form of MATCH; don't call anything which might compile a new regexp until we're done with the loop! */ - BLOCK_INPUT; + block_input (); d = opendir (SSDATA (dirfilename)); - UNBLOCK_INPUT; + unblock_input (); if (d == NULL) report_file_error ("Opening directory", Fcons (directory, Qnil)); @@ -310,9 +310,9 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, } } - BLOCK_INPUT; + block_input (); closedir (d); - UNBLOCK_INPUT; + unblock_input (); #ifdef WINDOWSNT if (attrs) Vw32_get_true_file_attributes = w32_save; @@ -486,9 +486,9 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, encoded_dir = ENCODE_FILE (dirname); - BLOCK_INPUT; + block_input (); d = opendir (SSDATA (Fdirectory_file_name (encoded_dir))); - UNBLOCK_INPUT; + unblock_input (); if (!d) report_file_error ("Opening directory", Fcons (dirname, Qnil)); @@ -962,10 +962,10 @@ so last access time will always be midnight of that day. */) if (!(NILP (id_format) || EQ (id_format, Qinteger))) { - BLOCK_INPUT; + block_input (); uname = stat_uname (&s); gname = stat_gname (&s); - UNBLOCK_INPUT; + unblock_input (); } if (uname) values[2] = DECODE_SYSTEM (build_string (uname)); diff --git a/src/dispextern.h b/src/dispextern.h index 1faeeb19d5b..3c42d7abb9d 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -2757,19 +2757,19 @@ struct image_type Lisp_Object *type; /* Check that SPEC is a valid image specification for the given - image type. Value is non-zero if SPEC is valid. */ - int (* valid_p) (Lisp_Object spec); + image type. Value is true if SPEC is valid. */ + bool (* valid_p) (Lisp_Object spec); /* Load IMG which is used on frame F from information contained in - IMG->spec. Value is non-zero if successful. */ - int (* load) (struct frame *f, struct image *img); + IMG->spec. Value is true if successful. */ + bool (* load) (struct frame *f, struct image *img); /* Free resources of image IMG which is used on frame F. */ void (* free) (struct frame *f, struct image *img); /* Initialization function (used for dynamic loading of image libraries on Windows), or NULL if none. */ - int (* init) (Lisp_Object); + bool (* init) (void); /* Next in list of all supported image types. */ struct image_type *next; @@ -3169,7 +3169,7 @@ extern ptrdiff_t x_create_bitmap_from_xpm_data (struct frame *, const char **); extern void x_destroy_bitmap (struct frame *, ptrdiff_t); #endif extern void x_destroy_all_bitmaps (Display_Info *); -extern int x_create_bitmap_mask (struct frame *, ptrdiff_t); +extern void x_create_bitmap_mask (struct frame *, ptrdiff_t); extern Lisp_Object x_find_image_file (Lisp_Object); void x_kill_gs_process (Pixmap, struct frame *); @@ -3177,7 +3177,7 @@ struct image_cache *make_image_cache (void); void free_image_cache (struct frame *); void clear_image_caches (Lisp_Object); void mark_image_cache (struct image_cache *); -int valid_image_p (Lisp_Object); +bool valid_image_p (Lisp_Object); void prepare_image_for_display (struct frame *, struct image *); ptrdiff_t lookup_image (struct frame *, Lisp_Object); diff --git a/src/dispnew.c b/src/dispnew.c index fc966581adb..555136d785c 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -1834,7 +1834,7 @@ adjust_glyphs (struct frame *f) { /* Block input so that expose events and other events that access glyph matrices are not processed while we are changing them. */ - BLOCK_INPUT; + block_input (); if (f) adjust_frame_glyphs (f); @@ -1846,7 +1846,7 @@ adjust_glyphs (struct frame *f) adjust_frame_glyphs (XFRAME (lisp_frame)); } - UNBLOCK_INPUT; + unblock_input (); } @@ -2242,7 +2242,7 @@ free_glyphs (struct frame *f) { /* Block interrupt input so that we don't get surprised by an X event while we're in an inconsistent state. */ - BLOCK_INPUT; + block_input (); f->glyphs_initialized_p = 0; /* Release window sub-matrices. */ @@ -2287,7 +2287,7 @@ free_glyphs (struct frame *f) f->desired_pool = f->current_pool = NULL; } - UNBLOCK_INPUT; + unblock_input (); } } @@ -5563,10 +5563,6 @@ handle_window_change_signal (int sig) int width, height; struct tty_display_info *tty; - struct sigaction action; - emacs_sigaction_init (&action, deliver_window_change_signal); - sigaction (SIGWINCH, &action, 0); - /* The frame size change obviously applies to a single termcap-controlled terminal, but we can't decide which. Therefore, we resize the frames corresponding to each tty. @@ -5599,7 +5595,7 @@ handle_window_change_signal (int sig) static void deliver_window_change_signal (int sig) { - handle_on_main_thread (sig, handle_window_change_signal); + deliver_process_signal (sig, handle_window_change_signal); } #endif /* SIGWINCH */ @@ -5708,7 +5704,7 @@ change_frame_size_1 (struct frame *f, int newheight, int newwidth, && new_frame_total_cols == FRAME_TOTAL_COLS (f)) return; - BLOCK_INPUT; + block_input (); #ifdef MSDOS /* We only can set screen dimensions to certain values supported @@ -5760,7 +5756,7 @@ change_frame_size_1 (struct frame *f, int newheight, int newwidth, SET_FRAME_GARBAGED (f); f->resized_p = 1; - UNBLOCK_INPUT; + unblock_input (); record_unwind_current_buffer (); @@ -5791,9 +5787,9 @@ FILE = nil means just close any termscript file currently open. */) if (tty->termscript != 0) { - BLOCK_INPUT; + block_input (); fclose (tty->termscript); - UNBLOCK_INPUT; + unblock_input (); } tty->termscript = 0; @@ -5824,7 +5820,7 @@ when TERMINAL is nil. */) /* ??? Perhaps we should do something special for multibyte strings here. */ CHECK_STRING (string); - BLOCK_INPUT; + block_input (); if (!t) error ("Unknown terminal device"); @@ -5849,7 +5845,7 @@ when TERMINAL is nil. */) } fwrite (SDATA (string), 1, SBYTES (string), out); fflush (out); - UNBLOCK_INPUT; + unblock_input (); return Qnil; } diff --git a/src/dosfns.c b/src/dosfns.c index 3c649f4d534..ce1ec4a4f93 100644 --- a/src/dosfns.c +++ b/src/dosfns.c @@ -480,9 +480,9 @@ x_set_title (struct frame *f, Lisp_Object name) if (FRAME_MSDOS_P (f)) { - BLOCK_INPUT; + block_input (); w95_set_virtual_machine_title (SDATA (name)); - UNBLOCK_INPUT; + unblock_input (); } } #endif /* !HAVE_X_WINDOWS */ diff --git a/src/editfns.c b/src/editfns.c index acf9c48e7a0..fc6465a3d46 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -1219,9 +1219,9 @@ of the user with that uid, or nil if there is no such user. */) return Vuser_login_name; CONS_TO_INTEGER (uid, uid_t, id); - BLOCK_INPUT; + block_input (); pw = getpwuid (id); - UNBLOCK_INPUT; + unblock_input (); return (pw ? build_string (pw->pw_name) : Qnil); } @@ -1279,15 +1279,15 @@ name, or nil if there is no such user. */) { uid_t u; CONS_TO_INTEGER (uid, uid_t, u); - BLOCK_INPUT; + block_input (); pw = getpwuid (u); - UNBLOCK_INPUT; + unblock_input (); } else if (STRINGP (uid)) { - BLOCK_INPUT; + block_input (); pw = getpwnam (SSDATA (uid)); - UNBLOCK_INPUT; + unblock_input (); } else error ("Invalid UID specification"); @@ -1763,14 +1763,14 @@ format_time_string (char const *format, ptrdiff_t formatlen, while (1) { time_t *taddr = emacs_secs_addr (&t); - BLOCK_INPUT; + block_input (); synchronize_system_time_locale (); tm = ut ? gmtime (taddr) : localtime (taddr); if (! tm) { - UNBLOCK_INPUT; + unblock_input (); time_overflow (); } *tmp = *tm; @@ -1782,14 +1782,14 @@ format_time_string (char const *format, ptrdiff_t formatlen, /* Buffer was too small, so make it bigger and try again. */ len = emacs_nmemftime (NULL, SIZE_MAX, format, formatlen, tm, ut, ns); - UNBLOCK_INPUT; + unblock_input (); if (STRING_BYTES_BOUND <= len) string_overflow (); size = len + 1; buf = SAFE_ALLOCA (size); } - UNBLOCK_INPUT; + unblock_input (); bufstring = make_unibyte_string (buf, len); SAFE_FREE (); return code_convert_string_norecord (bufstring, Vlocale_coding_system, 0); @@ -1817,11 +1817,11 @@ DOW and ZONE.) */) struct tm *decoded_time; Lisp_Object list_args[9]; - BLOCK_INPUT; + block_input (); decoded_time = localtime (&time_spec); if (decoded_time) save_tm = *decoded_time; - UNBLOCK_INPUT; + unblock_input (); if (! (decoded_time && MOST_NEGATIVE_FIXNUM - TM_YEAR_BASE <= save_tm.tm_year && save_tm.tm_year <= MOST_POSITIVE_FIXNUM - TM_YEAR_BASE)) @@ -1837,13 +1837,13 @@ DOW and ZONE.) */) XSETFASTINT (list_args[6], save_tm.tm_wday); list_args[7] = save_tm.tm_isdst ? Qt : Qnil; - BLOCK_INPUT; + block_input (); decoded_time = gmtime (&time_spec); if (decoded_time == 0) list_args[8] = Qnil; else XSETINT (list_args[8], tm_diff (&save_tm, decoded_time)); - UNBLOCK_INPUT; + unblock_input (); return Flist (9, list_args); } @@ -1901,9 +1901,9 @@ usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */) zone = XCAR (zone); if (NILP (zone)) { - BLOCK_INPUT; + block_input (); value = mktime (&tm); - UNBLOCK_INPUT; + unblock_input (); } else { @@ -1928,7 +1928,7 @@ usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */) else error ("Invalid time zone specification"); - BLOCK_INPUT; + block_input (); /* Set TZ before calling mktime; merely adjusting mktime's returned value doesn't suffice, since that would mishandle leap seconds. */ @@ -1942,7 +1942,7 @@ usage: (encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE) */) #ifdef LOCALTIME_CACHE tzset (); #endif - UNBLOCK_INPUT; + unblock_input (); xfree (newenv); } @@ -1978,7 +1978,7 @@ but this is considered obsolete. */) newline, and without the 4-digit year limit. Don't use asctime or ctime, as they might dump core if the year is outside the range -999 .. 9999. */ - BLOCK_INPUT; + block_input (); tm = localtime (&value); if (tm) { @@ -1994,7 +1994,7 @@ but this is considered obsolete. */) tm->tm_hour, tm->tm_min, tm->tm_sec, tm->tm_year + year_base); } - UNBLOCK_INPUT; + unblock_input (); if (! tm) time_overflow (); @@ -2050,11 +2050,11 @@ the data it can't find. */) zone_offset = Qnil; value = make_emacs_time (lisp_seconds_argument (specified_time), 0); zone_name = format_time_string ("%Z", sizeof "%Z" - 1, value, 0, &localtm); - BLOCK_INPUT; + block_input (); t = gmtime (emacs_secs_addr (&value)); if (t) offset = tm_diff (&localtm, t); - UNBLOCK_INPUT; + unblock_input (); if (t) { @@ -2101,7 +2101,7 @@ only the former. */) if (! (NILP (tz) || EQ (tz, Qt))) CHECK_STRING (tz); - BLOCK_INPUT; + block_input (); /* When called for the first time, save the original TZ. */ old_environbuf = environbuf; @@ -2118,7 +2118,7 @@ only the former. */) set_time_zone_rule (tzstring); environbuf = environ; - UNBLOCK_INPUT; + unblock_input (); xfree (old_environbuf); return Qnil; diff --git a/src/emacs.c b/src/emacs.c index 52f38925b32..05affeefde7 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -54,6 +54,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "window.h" #include "systty.h" +#include "atimer.h" #include "blockinput.h" #include "syssignal.h" #include "process.h" @@ -95,6 +96,11 @@ static const char emacs_copyright[] = COPYRIGHT; /* Empty lisp strings. To avoid having to build any others. */ Lisp_Object empty_unibyte_string, empty_multibyte_string; +#ifdef WINDOWSNT +/* Cache for externally loaded libraries. */ +Lisp_Object Vlibrary_cache; +#endif + /* Set after Emacs has started up the first time. Prevents reinitialization of the Lisp world and keymaps on subsequent starts. */ @@ -269,9 +275,6 @@ Report bugs to bug-gnu-emacs@gnu.org. First, please see the Bugs\n\ section of the Emacs manual or the file BUGS.\n" -/* Signal code for the fatal signal that was received. */ -static int fatal_error_code; - /* True if handling a fatal error already. */ bool fatal_error_in_progress; @@ -282,28 +285,13 @@ static void *ns_pool; -/* Handle bus errors, invalid instruction, etc. */ -static void -handle_fatal_signal (int sig) -{ - fatal_error_backtrace (sig, 10); -} - -static void -deliver_fatal_signal (int sig) -{ - handle_on_main_thread (sig, handle_fatal_signal); -} - /* Report a fatal error due to signal SIG, output a backtrace of at most BACKTRACE_LIMIT lines, and exit. */ _Noreturn void -fatal_error_backtrace (int sig, int backtrace_limit) +terminate_due_to_signal (int sig, int backtrace_limit) { - fatal_error_code = sig; signal (sig, SIG_DFL); - - TOTALLY_UNBLOCK_INPUT; + totally_unblock_input (); /* If fatal error occurs in code below, avoid infinite recursion. */ if (! fatal_error_in_progress) @@ -318,19 +306,18 @@ fatal_error_backtrace (int sig, int backtrace_limit) } /* Signal the same code; this time it will really be fatal. - Remember that since we're in a signal handler, the signal we're - going to send is probably blocked, so we have to unblock it if we - want to really receive it. */ + Since we're in a signal handler, the signal is blocked, so we + have to unblock it if we want to really receive it. */ #ifndef MSDOS { sigset_t unblocked; sigemptyset (&unblocked); - sigaddset (&unblocked, fatal_error_code); + sigaddset (&unblocked, sig); pthread_sigmask (SIG_UNBLOCK, &unblocked, 0); } #endif - kill (getpid (), fatal_error_code); + emacs_raise (sig); /* This shouldn't be executed, but it prevents a warning. */ exit (1); @@ -339,15 +326,9 @@ fatal_error_backtrace (int sig, int backtrace_limit) #ifdef SIGDANGER /* Handler for SIGDANGER. */ -static void deliver_danger_signal (int); - static void handle_danger_signal (int sig) { - struct sigaction action; - emacs_sigaction_init (&action, deliver_danger_signal); - sigaction (sig, &action, 0); - malloc_warning ("Operating system warns that virtual memory is running low.\n"); /* It might be unsafe to call do_auto_save now. */ @@ -357,7 +338,7 @@ handle_danger_signal (int sig) static void deliver_danger_signal (int sig) { - handle_on_main_thread (sig, handle_danger_signal); + deliver_process_signal (sig, handle_danger_signal); } #endif @@ -680,6 +661,7 @@ main (int argc, char **argv) #endif char stack_bottom_variable; bool do_initial_setlocale; + bool dumping; int skip_args = 0; #ifdef HAVE_SETRLIMIT struct rlimit rlim; @@ -691,7 +673,6 @@ main (int argc, char **argv) char dname_arg2[80]; #endif char *ch_to_dir; - struct sigaction fatal_error_action; #if GC_MARK_STACK stack_base = &dummy; @@ -777,12 +758,11 @@ main (int argc, char **argv) exit (1); } + dumping = !initialized && (strcmp (argv[argc - 1], "dump") == 0 + || strcmp (argv[argc - 1], "bootstrap") == 0); #ifdef HAVE_PERSONALITY_LINUX32 - if (!initialized - && (strcmp (argv[argc-1], "dump") == 0 - || strcmp (argv[argc-1], "bootstrap") == 0) - && ! getenv ("EMACS_HEAP_EXEC")) + if (dumping && ! getenv ("EMACS_HEAP_EXEC")) { static char heapexec[] = "EMACS_HEAP_EXEC=true"; /* Set this so we only do this once. */ @@ -1107,119 +1087,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem #endif } - init_signals (); - emacs_sigaction_init (&fatal_error_action, deliver_fatal_signal); - - /* Don't catch SIGHUP if dumping. */ - if (1 -#ifndef CANNOT_DUMP - && initialized -#endif - ) - { - /* In --batch mode, don't catch SIGHUP if already ignored. - That makes nohup work. */ - bool catch_SIGHUP = !noninteractive; - if (!catch_SIGHUP) - { - struct sigaction old_action; - sigaction (SIGHUP, 0, &old_action); - catch_SIGHUP = old_action.sa_handler != SIG_IGN; - } - if (catch_SIGHUP) - sigaction (SIGHUP, &fatal_error_action, 0); - } - - if ( -#ifndef CANNOT_DUMP - ! noninteractive || initialized -#else - 1 -#endif - ) - { - /* Don't catch these signals in batch mode if dumping. - On some machines, this sets static data that would make - signal fail to work right when the dumped Emacs is run. */ - sigaction (SIGQUIT, &fatal_error_action, 0); - sigaction (SIGILL, &fatal_error_action, 0); - sigaction (SIGTRAP, &fatal_error_action, 0); -#ifdef SIGUSR1 - add_user_signal (SIGUSR1, "sigusr1"); -#endif -#ifdef SIGUSR2 - add_user_signal (SIGUSR2, "sigusr2"); -#endif -#ifdef SIGABRT - sigaction (SIGABRT, &fatal_error_action, 0); -#endif -#ifdef SIGHWE - sigaction (SIGHWE, &fatal_error_action, 0); -#endif -#ifdef SIGPRE - sigaction (SIGPRE, &fatal_error_action, 0); -#endif -#ifdef SIGORE - sigaction (SIGORE, &fatal_error_action, 0); -#endif -#ifdef SIGUME - sigaction (SIGUME, &fatal_error_action, 0); -#endif -#ifdef SIGDLK - sigaction (SIGDLK, &fatal_error_action, 0); -#endif -#ifdef SIGCPULIM - sigaction (SIGCPULIM, &fatal_error_action, 0); -#endif -#ifdef SIGIOT - /* This is missing on some systems - OS/2, for example. */ - sigaction (SIGIOT, &fatal_error_action, 0); -#endif -#ifdef SIGEMT - sigaction (SIGEMT, &fatal_error_action, 0); -#endif - sigaction (SIGFPE, &fatal_error_action, 0); -#ifdef SIGBUS - sigaction (SIGBUS, &fatal_error_action, 0); -#endif - sigaction (SIGSEGV, &fatal_error_action, 0); -#ifdef SIGSYS - sigaction (SIGSYS, &fatal_error_action, 0); -#endif - /* May need special treatment on MS-Windows. See - http://lists.gnu.org/archive/html/emacs-devel/2010-09/msg01062.html - Please update the doc of kill-emacs, kill-emacs-hook, and - NEWS if you change this. - */ - if (noninteractive) - sigaction (SIGINT, &fatal_error_action, 0); - sigaction (SIGTERM, &fatal_error_action, 0); -#ifdef SIGXCPU - sigaction (SIGXCPU, &fatal_error_action, 0); -#endif -#ifdef SIGXFSZ - sigaction (SIGXFSZ, &fatal_error_action, 0); -#endif /* SIGXFSZ */ - -#ifdef SIGDANGER - /* This just means available memory is getting low. */ - { - struct sigaction action; - emacs_sigaction_init (&action, deliver_danger_signal); - sigaction (SIGDANGER, &action, 0); - } -#endif - -#ifdef AIX -/* 20 is SIGCHLD, 21 is SIGTTIN, 22 is SIGTTOU. */ - sigaction (SIGXCPU, &fatal_error_action, 0); - sigaction (SIGIOINT, &fatal_error_action, 0); - sigaction (SIGGRANT, &fatal_error_action, 0); - sigaction (SIGRETRACT, &fatal_error_action, 0); - sigaction (SIGSOUND, &fatal_error_action, 0); - sigaction (SIGMSG, &fatal_error_action, 0); -#endif /* AIX */ - } + init_signals (dumping); noninteractive1 = noninteractive; @@ -1281,7 +1149,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem } init_eval (); - init_data (); init_atimer (); running_asynch_code = 0; init_random (); @@ -1396,7 +1263,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem globals_of_w32 (); /* Initialize environment from registry settings. */ init_environment (argv); - init_ntproc (); /* must precede init_editfns. */ + init_ntproc (dumping); /* must precede init_editfns. */ #endif /* Initialize and GC-protect Vinitial_environment and @@ -1407,8 +1274,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem /* egetenv is a pretty low-level facility, which may get called in many circumstances; it seems flimsy to put off initializing it until calling init_callproc. Do not do it when dumping. */ - if (initialized || ((strcmp (argv[argc-1], "dump") != 0 - && strcmp (argv[argc-1], "bootstrap") != 0))) + if (! dumping) set_initial_environment (); /* AIX crashes are reported in system versions 3.2.3 and 3.2.4 @@ -1553,6 +1419,8 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem syms_of_ntterm (); #endif /* WINDOWSNT */ + syms_of_profiler (); + keys_of_casefiddle (); keys_of_cmds (); keys_of_buffer (); @@ -2045,7 +1913,7 @@ shut_down_emacs (int sig, Lisp_Object stuff) ignore_sigio (); #ifdef WINDOWSNT - term_ntproc (); + term_ntproc (0); #endif /* Do this only if terminating normally, we want glyph matrices @@ -2164,6 +2032,13 @@ You must run Emacs in batch mode in order to dump it. */) free (malloc_state_ptr); #endif +#ifdef WINDOWSNT + Vlibrary_cache = Qnil; +#endif +#ifdef HAVE_WINDOW_SYSTEM + reset_image_types (); +#endif + Vpurify_flag = tem; return unbind_to (count, Qnil); @@ -2496,6 +2371,11 @@ libraries; only those already known by Emacs will be loaded. */); Vdynamic_library_alist = Qnil; Fput (intern_c_string ("dynamic-library-alist"), Qrisky_local_variable, Qt); +#ifdef WINDOWSNT + Vlibrary_cache = Qnil; + staticpro (&Vlibrary_cache); +#endif + /* Make sure IS_DAEMON starts up as false. */ daemon_pipe[1] = 0; } diff --git a/src/eval.c b/src/eval.c index e47478bb1f1..561ba922482 100644 --- a/src/eval.c +++ b/src/eval.c @@ -31,17 +31,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "xterm.h" #endif -struct backtrace -{ - struct backtrace *next; - Lisp_Object *function; - Lisp_Object *args; /* Points to vector of args. */ - ptrdiff_t nargs; /* Length of vector. */ - /* Nonzero means call value of debugger when done with this operation. */ - unsigned int debug_on_exit : 1; -}; - -static struct backtrace *backtrace_list; +struct backtrace *backtrace_list; #if !BYTE_MARK_STACK static @@ -562,7 +552,7 @@ interactive_p (void) /* If this isn't a byte-compiled function, there may be a frame at the top for Finteractive_p. If so, skip it. */ - fun = Findirect_function (*btp->function, Qnil); + fun = Findirect_function (btp->function, Qnil); if (SUBRP (fun) && (XSUBR (fun) == &Sinteractive_p || XSUBR (fun) == &Scalled_interactively_p)) btp = btp->next; @@ -575,7 +565,7 @@ interactive_p (void) If this isn't a byte-compiled function, then we may now be looking at several frames for special forms. Skip past them. */ while (btp - && (EQ (*btp->function, Qbytecode) + && (EQ (btp->function, Qbytecode) || btp->nargs == UNEVALLED)) btp = btp->next; @@ -583,13 +573,13 @@ interactive_p (void) a special form, ignoring frames for Finteractive_p and/or Fbytecode at the top. If this frame is for a built-in function (such as load or eval-region) return false. */ - fun = Findirect_function (*btp->function, Qnil); + fun = Findirect_function (btp->function, Qnil); if (SUBRP (fun)) return 0; /* `btp' points to the frame of a Lisp function that called interactive-p. Return t if that function was called interactively. */ - if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively)) + if (btp && btp->next && EQ (btp->next->function, Qcall_interactively)) return 1; return 0; } @@ -1076,7 +1066,7 @@ internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object /* Unwind the specbind, catch, and handler stacks back to CATCH, and jump to that CATCH, returning VALUE as the value of that catch. - This is the guts Fthrow and Fsignal; they differ only in the way + This is the guts of Fthrow and Fsignal; they differ only in the way they choose the catch tag to throw to. A catch tag for a condition-case form has a TAG of Qnil. @@ -1085,7 +1075,7 @@ internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object the handler stack as we go, so that the proper handlers are in effect for each unwind-protect clause we run. At the end, restore some static info saved in CATCH, and longjmp to the location - specified in the + specified there. This is used for correct unwinding in Fthrow and Fsignal. */ @@ -1099,7 +1089,7 @@ unwind_to_catch (struct catchtag *catch, Lisp_Object value) /* Restore certain special C variables. */ set_poll_suppress_count (catch->poll_suppress_count); - UNBLOCK_INPUT_TO (catch->interrupt_input_blocked); + unblock_input_to (catch->interrupt_input_blocked); immediate_quit = 0; do @@ -1114,16 +1104,6 @@ unwind_to_catch (struct catchtag *catch, Lisp_Object value) } while (! last_time); -#if HAVE_X_WINDOWS - /* If x_catch_errors was done, turn it off now. - (First we give unbind_to a chance to do that.) */ -#if 0 /* This would disable x_catch_errors after x_connection_closed. - The catch must remain in effect during that delicate - state. --lorentey */ - x_fully_uncatch_errors (); -#endif -#endif - byte_stack_list = catch->byte_stack; gcprolist = catch->gcpro; #ifdef DEBUG_GCPRO @@ -1516,10 +1496,10 @@ See also the function `condition-case'. */) if (backtrace_list && !NILP (error_symbol)) { bp = backtrace_list->next; - if (bp && bp->function && EQ (*bp->function, Qerror)) + if (bp && EQ (bp->function, Qerror)) bp = bp->next; - if (bp && bp->function) - Vsignaling_function = *bp->function; + if (bp) + Vsignaling_function = bp->function; } for (h = handlerlist; h; h = h->next) @@ -1530,7 +1510,7 @@ See also the function `condition-case'. */) } if (/* Don't run the debugger for a memory-full error. - (There is no room in memory to do that!) */ + (There is no room in memory to do that!) */ !NILP (error_symbol) && (!NILP (Vdebug_on_signal) /* If no handler is present now, try to run the debugger. */ @@ -1713,7 +1693,7 @@ maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data) if ( /* Don't try to run the debugger with interrupts blocked. The editing loop would return anyway. */ - ! INPUT_BLOCKED_P + ! input_blocked_p () && NILP (Vinhibit_debugger) /* Does user want to enter debugger for this kind of error? */ && (EQ (sig, Qquit) @@ -2065,11 +2045,11 @@ eval_sub (Lisp_Object form) original_args = XCDR (form); backtrace.next = backtrace_list; - backtrace_list = &backtrace; - backtrace.function = &original_fun; /* This also protects them from gc. */ + backtrace.function = original_fun; /* This also protects them from gc. */ backtrace.args = &original_args; backtrace.nargs = UNEVALLED; backtrace.debug_on_exit = 0; + backtrace_list = &backtrace; if (debug_on_next_call) do_debug_on_call (Qt); @@ -2371,14 +2351,10 @@ usage: (run-hooks &rest HOOKS) */) DEFUN ("run-hook-with-args", Frun_hook_with_args, Srun_hook_with_args, 1, MANY, 0, doc: /* Run HOOK with the specified arguments ARGS. -HOOK should be a symbol, a hook variable. If HOOK has a non-nil -value, that value may be a function or a list of functions to be -called to run the hook. If the value is a function, it is called with -the given arguments and its return value is returned. If it is a list -of functions, those functions are called, in order, -with the given arguments ARGS. -It is best not to depend on the value returned by `run-hook-with-args', -as that may change. +HOOK should be a symbol, a hook variable. The value of HOOK +may be nil, a function, or a list of functions. Call each +function in order with arguments ARGS. The final return value +is unspecified. Do not use `make-local-variable' to make a hook variable buffer-local. Instead, use `add-hook' and specify t for the LOCAL argument. @@ -2388,18 +2364,18 @@ usage: (run-hook-with-args HOOK &rest ARGS) */) return run_hook_with_args (nargs, args, funcall_nil); } +/* NB this one still documents a specific non-nil return value. + (As did run-hook-with-args and run-hook-with-args-until-failure + until they were changed in 24.1.) */ DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success, Srun_hook_with_args_until_success, 1, MANY, 0, doc: /* Run HOOK with the specified arguments ARGS. -HOOK should be a symbol, a hook variable. If HOOK has a non-nil -value, that value may be a function or a list of functions to be -called to run the hook. If the value is a function, it is called with -the given arguments and its return value is returned. -If it is a list of functions, those functions are called, in order, -with the given arguments ARGS, until one of them -returns a non-nil value. Then we return that value. -However, if they all return nil, we return nil. -If the value of HOOK is nil, this function returns nil. +HOOK should be a symbol, a hook variable. The value of HOOK +may be nil, a function, or a list of functions. Call each +function in order with arguments ARGS, stopping at the first +one that returns non-nil, and return that value. Otherwise (if +all functions return nil, or if there are no functions to call), +return nil. Do not use `make-local-variable' to make a hook variable buffer-local. Instead, use `add-hook' and specify t for the LOCAL argument. @@ -2418,15 +2394,12 @@ funcall_not (ptrdiff_t nargs, Lisp_Object *args) DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure, Srun_hook_with_args_until_failure, 1, MANY, 0, doc: /* Run HOOK with the specified arguments ARGS. -HOOK should be a symbol, a hook variable. If HOOK has a non-nil -value, that value may be a function or a list of functions to be -called to run the hook. If the value is a function, it is called with -the given arguments. Then we return nil if the function returns nil, -and t if it returns non-nil. -If it is a list of functions, those functions are called, in order, -with the given arguments ARGS, until one of them returns nil. -Then we return nil. However, if they all return non-nil, we return t. -If the value of HOOK is nil, this function returns t. +HOOK should be a symbol, a hook variable. The value of HOOK +may be nil, a function, or a list of functions. Call each +function in order with arguments ARGS, stopping at the first +one that returns nil, and return nil. Otherwise (if all functions +return non-nil, or if there are no functions to call), return non-nil +\(do not rely on the precise return value in this case). Do not use `make-local-variable' to make a hook variable buffer-local. Instead, use `add-hook' and specify t for the LOCAL argument. @@ -2740,11 +2713,11 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) } backtrace.next = backtrace_list; - backtrace_list = &backtrace; - backtrace.function = &args[0]; + backtrace.function = args[0]; backtrace.args = &args[1]; /* This also GCPROs them. */ backtrace.nargs = nargs - 1; backtrace.debug_on_exit = 0; + backtrace_list = &backtrace; /* Call GC after setting up the backtrace, so the latter GCPROs the args. */ maybe_gc (); @@ -3316,12 +3289,12 @@ Output stream used is value of `standard-output'. */) write_string (backlist->debug_on_exit ? "* " : " ", 2); if (backlist->nargs == UNEVALLED) { - Fprin1 (Fcons (*backlist->function, *backlist->args), Qnil); + Fprin1 (Fcons (backlist->function, *backlist->args), Qnil); write_string ("\n", -1); } else { - tem = *backlist->function; + tem = backlist->function; Fprin1 (tem, Qnil); /* This can QUIT. */ write_string ("(", -1); if (backlist->nargs == MANY) @@ -3379,7 +3352,7 @@ If NFRAMES is more than the number of frames, the value is nil. */) if (!backlist) return Qnil; if (backlist->nargs == UNEVALLED) - return Fcons (Qnil, Fcons (*backlist->function, *backlist->args)); + return Fcons (Qnil, Fcons (backlist->function, *backlist->args)); else { if (backlist->nargs == MANY) /* FIXME: Can this happen? */ @@ -3387,7 +3360,7 @@ If NFRAMES is more than the number of frames, the value is nil. */) else tem = Flist (backlist->nargs, backlist->args); - return Fcons (Qt, Fcons (*backlist->function, tem)); + return Fcons (Qt, Fcons (backlist->function, tem)); } } diff --git a/src/fileio.c b/src/fileio.c index 6c4e34d7312..9d8a0dc8b45 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -1025,9 +1025,9 @@ filesystem tree, not (expand-file-name ".." dirname). */) memcpy (o, nm, p - nm); o [p - nm] = 0; - BLOCK_INPUT; + block_input (); pw = (struct passwd *) getpwnam (o + 1); - UNBLOCK_INPUT; + unblock_input (); if (pw) { newdir = pw->pw_dir; @@ -1413,9 +1413,9 @@ See also the function `substitute-in-file-name'.") o[len] = 0; /* Look up the user name. */ - BLOCK_INPUT; + block_input (); pw = (struct passwd *) getpwnam (o + 1); - UNBLOCK_INPUT; + unblock_input (); if (!pw) error ("\"%s\" isn't a registered user", o + 1); @@ -1531,9 +1531,9 @@ search_embedded_absfilename (char *nm, char *endp) /* If we have ~user and `user' exists, discard everything up to ~. But if `user' does not exist, leave ~user alone, it might be a literal file name. */ - BLOCK_INPUT; + block_input (); pw = getpwnam (o + 1); - UNBLOCK_INPUT; + unblock_input (); if (pw) return p; } @@ -2999,10 +2999,10 @@ The value is an integer. */) mode_t realmask; Lisp_Object value; - BLOCK_INPUT; + block_input (); realmask = umask (0); umask (realmask); - UNBLOCK_INPUT; + unblock_input (); XSETINT (value, (~ realmask) & 0777); return value; @@ -5235,9 +5235,9 @@ do_auto_save_unwind (Lisp_Object arg) /* used as unwind-protect function */ auto_saving = 0; if (stream != NULL) { - BLOCK_INPUT; + block_input (); fclose (stream); - UNBLOCK_INPUT; + unblock_input (); } return Qnil; } @@ -5368,7 +5368,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) if (STRINGP (BVAR (b, auto_save_file_name)) && stream != NULL && do_handled_files == 0) { - BLOCK_INPUT; + block_input (); if (!NILP (BVAR (b, filename))) { fwrite (SDATA (BVAR (b, filename)), 1, @@ -5378,7 +5378,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) fwrite (SDATA (BVAR (b, auto_save_file_name)), 1, SBYTES (BVAR (b, auto_save_file_name)), stream); putc ('\n', stream); - UNBLOCK_INPUT; + unblock_input (); } if (!NILP (current_only) diff --git a/src/floatfns.c b/src/floatfns.c index 4fe209fcb61..645a5957609 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -31,15 +31,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <config.h> #include "lisp.h" -#include "syssignal.h" - -#include <float.h> -#if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ - && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) -#define IEEE_FLOATING_POINT 1 -#else -#define IEEE_FLOATING_POINT 0 -#endif #include <math.h> diff --git a/src/fns.c b/src/fns.c index 42c4f817f29..6d6f019b311 100644 --- a/src/fns.c +++ b/src/fns.c @@ -61,8 +61,9 @@ DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, DEFUN ("random", Frandom, Srandom, 0, 1, 0, doc: /* Return a pseudo-random number. -All integers representable in Lisp are equally likely. - On most systems, this is 29 bits' worth. +All integers representable in Lisp, i.e. between `most-negative-fixnum' +and `most-positive-fixnum', inclusive, are equally likely. + With positive integer LIMIT, return random number in interval [0,LIMIT). With argument t, set the random number seed from the current time and pid. Other values of LIMIT are ignored. */) @@ -1838,13 +1839,6 @@ properties on the list. This function never signals an error. */) halftail = XCDR (halftail); if (EQ (tail, halftail)) break; - -#if 0 /* Unsafe version. */ - /* This function can be called asynchronously - (setup_coding_system). Don't QUIT in that case. */ - if (!interrupt_input_blocked) - QUIT; -#endif } return Qnil; diff --git a/src/fontset.c b/src/fontset.c index 35d4bfb367e..7b051cbe1f3 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -1275,7 +1275,7 @@ free_realized_fontsets (Lisp_Object base) doesn't remove FACE from a cache. Until we find a solution, we suppress this code, and simply use Fclear_face_cache even though that is not efficient. */ - BLOCK_INPUT; + block_input (); for (id = 0; id < ASIZE (Vfontset_table); id++) { Lisp_Object this = AREF (Vfontset_table, id); @@ -1296,7 +1296,7 @@ free_realized_fontsets (Lisp_Object base) } } } - UNBLOCK_INPUT; + unblock_input (); #else /* not 0 */ /* But, we don't have to call Fclear_face_cache if no fontset has been realized from BASE. */ diff --git a/src/frame.c b/src/frame.c index f3d16171516..4bcacef39c5 100644 --- a/src/frame.c +++ b/src/frame.c @@ -3533,9 +3533,9 @@ x_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval) f->alpha[i] = newval[i]; #if defined (HAVE_X_WINDOWS) || defined (HAVE_NTGUI) || defined (NS_IMPL_COCOA) - BLOCK_INPUT; + block_input (); x_set_frame_alpha (f); - UNBLOCK_INPUT; + unblock_input (); #endif return; diff --git a/src/frame.h b/src/frame.h index 661ea2ea67c..26235cc036e 100644 --- a/src/frame.h +++ b/src/frame.h @@ -1203,7 +1203,7 @@ extern Lisp_Object Qrun_hook_with_args; extern void x_set_scroll_bar_default_width (struct frame *); extern void x_set_offset (struct frame *, int, int, int); extern void x_wm_set_icon_position (struct frame *, int, int); -extern void x_wm_set_size_hint (FRAME_PTR f, long flags, int user_position); +extern void x_wm_set_size_hint (FRAME_PTR f, long flags, bool user_position); extern Lisp_Object x_new_font (struct frame *, Lisp_Object, int); @@ -1249,7 +1249,7 @@ extern Lisp_Object display_x_get_resource (Display_Info *, Lisp_Object component, Lisp_Object subclass); -extern void set_frame_menubar (struct frame *f, int first_time, int deep_p); +extern void set_frame_menubar (struct frame *f, bool first_time, bool deep_p); extern void x_set_window_size (struct frame *f, int change_grav, int cols, int rows); extern void x_sync (struct frame *); @@ -1283,9 +1283,6 @@ extern char *x_get_resource_string (const char *, const char *); extern void x_query_colors (struct frame *f, XColor *, int); -/* In xmenu.c */ -extern void set_frame_menubar (FRAME_PTR, int, int); - #endif /* HAVE_WINDOW_SYSTEM */ INLINE_HEADER_END diff --git a/src/fringe.c b/src/fringe.c index 6e6deeddb08..d788503e91e 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -872,7 +872,7 @@ draw_fringe_bitmap (struct window *w, struct glyph_row *row, int left_p) void draw_row_fringe_bitmaps (struct window *w, struct glyph_row *row) { - eassert (interrupt_input_blocked); + eassert (input_blocked_p ()); /* If row is completely invisible, because of vscrolling, we don't have to draw anything. */ diff --git a/src/ftxfont.c b/src/ftxfont.c index 466250bd43f..5effe6e9104 100644 --- a/src/ftxfont.c +++ b/src/ftxfont.c @@ -98,7 +98,7 @@ ftxfont_get_gcs (FRAME_PTR f, long unsigned int foreground, long unsigned int ba new->colors[0].pixel = background; new->colors[1].pixel = foreground; - BLOCK_INPUT; + block_input (); XQueryColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), new->colors, 2); for (i = 1; i < 7; i++) { @@ -115,14 +115,14 @@ ftxfont_get_gcs (FRAME_PTR f, long unsigned int foreground, long unsigned int ba new->gcs[i - 1] = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), GCForeground, &xgcv); } - UNBLOCK_INPUT; + unblock_input (); if (i < 7) { - BLOCK_INPUT; + block_input (); for (i--; i >= 0; i--) XFreeGC (FRAME_X_DISPLAY (f), new->gcs[i]); - UNBLOCK_INPUT; + unblock_input (); if (prev) prev->next = new->next; else if (data) @@ -282,7 +282,7 @@ ftxfont_draw (struct glyph_string *s, int from, int to, int x, int y, n[0] = n[1] = n[2] = n[3] = n[4] = n[5] = n[6] = 0; - BLOCK_INPUT; + block_input (); if (with_background) ftxfont_draw_background (f, font, s->gc, x, y, s->width); code = alloca (sizeof (unsigned) * len); @@ -332,7 +332,7 @@ ftxfont_draw (struct glyph_string *s, int from, int to, int x, int y, } } - UNBLOCK_INPUT; + unblock_input (); return len; } @@ -342,7 +342,7 @@ ftxfont_end_for_frame (FRAME_PTR f) { struct ftxfont_frame_data *data = font_get_frame_data (f, &ftxfont_driver); - BLOCK_INPUT; + block_input (); while (data) { struct ftxfont_frame_data *next = data->next; @@ -353,7 +353,7 @@ ftxfont_end_for_frame (FRAME_PTR f) free (data); data = next; } - UNBLOCK_INPUT; + unblock_input (); font_put_frame_data (f, &ftxfont_driver, NULL); return 0; } diff --git a/src/gnutls.c b/src/gnutls.c index 1c4693aee32..e3d84a0b61b 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -30,15 +30,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "w32.h" #endif -static int -emacs_gnutls_handle_error (gnutls_session_t, int err); +static bool emacs_gnutls_handle_error (gnutls_session_t, int); static Lisp_Object Qgnutls_dll; static Lisp_Object Qgnutls_code; static Lisp_Object Qgnutls_anon, Qgnutls_x509pki; static Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again, Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake; -static int gnutls_global_initialized; +static bool gnutls_global_initialized; /* The following are for the property list of `gnutls-boot'. */ static Lisp_Object QCgnutls_bootprop_priority; @@ -141,13 +140,13 @@ DEF_GNUTLS_FN (int, gnutls_x509_crt_import, gnutls_x509_crt_fmt_t)); DEF_GNUTLS_FN (int, gnutls_x509_crt_init, (gnutls_x509_crt_t *)); -static int -init_gnutls_functions (Lisp_Object libraries) +static bool +init_gnutls_functions (void) { HMODULE library; int max_log_level = 1; - if (!(library = w32_delayed_load (libraries, Qgnutls_dll))) + if (!(library = w32_delayed_load (Qgnutls_dll))) { GNUTLS_LOG (1, max_log_level, "GnuTLS library not found"); return 0; @@ -438,7 +437,7 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte) else if (rtnval == GNUTLS_E_UNEXPECTED_PACKET_LENGTH) /* The peer closed the connection. */ return 0; - else if (emacs_gnutls_handle_error (state, rtnval) == 0) + else if (emacs_gnutls_handle_error (state, rtnval)) /* non-fatal error */ return -1; else { @@ -447,19 +446,19 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte) } } -/* report a GnuTLS error to the user. - Returns zero if the error code was successfully handled. */ -static int +/* Report a GnuTLS error to the user. + Return true if the error code was successfully handled. */ +static bool emacs_gnutls_handle_error (gnutls_session_t session, int err) { int max_log_level = 0; - int ret; + bool ret; const char *str; /* TODO: use a Lisp_Object generated by gnutls_make_error? */ if (err >= 0) - return 0; + return 1; max_log_level = global_gnutls_log_level; @@ -471,12 +470,12 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err) if (fn_gnutls_error_is_fatal (err)) { - ret = err; + ret = 0; GNUTLS_LOG2 (0, max_log_level, "fatal error:", str); } else { - ret = 0; + ret = 1; GNUTLS_LOG2 (1, max_log_level, "non-fatal error:", str); /* TODO: EAGAIN AKA Qgnutls_e_again should be level 2. */ } @@ -656,7 +655,7 @@ DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0, else { Lisp_Object status; - status = init_gnutls_functions (Vdynamic_library_alist) ? Qt : Qnil; + status = init_gnutls_functions () ? Qt : Qnil; Vlibrary_cache = Fcons (Fcons (Qgnutls_dll, status), Vlibrary_cache); return status; } diff --git a/src/gtkutil.c b/src/gtkutil.c index 1eb4b2cabdf..1bf2b533b41 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -576,21 +576,21 @@ get_utf8_string (const char *str) /* Check for special colors used in face spec for region face. The colors are fetched from the Gtk+ theme. - Return 1 if color was found, 0 if not. */ + Return true if color was found, false if not. */ -int +bool xg_check_special_colors (struct frame *f, const char *color_name, XColor *color) { - int success_p = 0; - int get_bg = strcmp ("gtk_selection_bg_color", color_name) == 0; - int get_fg = !get_bg && strcmp ("gtk_selection_fg_color", color_name) == 0; + bool success_p = 0; + bool get_bg = strcmp ("gtk_selection_bg_color", color_name) == 0; + bool get_fg = !get_bg && strcmp ("gtk_selection_fg_color", color_name) == 0; if (! FRAME_GTK_WIDGET (f) || ! (get_bg || get_fg)) return success_p; - BLOCK_INPUT; + block_input (); { #ifdef HAVE_GTK3 GtkStyleContext *gsty @@ -604,8 +604,9 @@ xg_check_special_colors (struct frame *f, gtk_style_context_get_background_color (gsty, state, &col); sprintf (buf, "rgbi:%lf/%lf/%lf", col.red, col.green, col.blue); - success_p = XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), - buf, color); + success_p = (XParseColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), + buf, color) + != 0); #else GtkStyle *gsty = gtk_widget_get_style (FRAME_GTK_WIDGET (f)); GdkColor *grgb = get_bg @@ -620,7 +621,7 @@ xg_check_special_colors (struct frame *f, #endif } - UNBLOCK_INPUT; + unblock_input (); return success_p; } @@ -703,9 +704,9 @@ qttip_cb (GtkWidget *widget, #endif /* USE_GTK_TOOLTIP */ /* Prepare a tooltip to be shown, i.e. calculate WIDTH and HEIGHT. - Return zero if no system tooltip available, non-zero otherwise. */ + Return true if a system tooltip is available. */ -int +bool xg_prepare_tooltip (FRAME_PTR f, Lisp_Object string, int *width, @@ -725,7 +726,7 @@ xg_prepare_tooltip (FRAME_PTR f, if (!x->ttip_lbl) return 0; - BLOCK_INPUT; + block_input (); encoded_string = ENCODE_UTF_8 (string); widget = GTK_WIDGET (x->ttip_lbl); gwin = gtk_widget_get_window (GTK_WIDGET (x->ttip_window)); @@ -753,7 +754,7 @@ xg_prepare_tooltip (FRAME_PTR f, if (width) *width = req.width; if (height) *height = req.height; - UNBLOCK_INPUT; + unblock_input (); return 1; #endif /* USE_GTK_TOOLTIP */ @@ -769,27 +770,27 @@ xg_show_tooltip (FRAME_PTR f, int root_x, int root_y) struct x_output *x = f->output_data.x; if (x->ttip_window) { - BLOCK_INPUT; + block_input (); gtk_window_move (x->ttip_window, root_x, root_y); gtk_widget_show_all (GTK_WIDGET (x->ttip_window)); - UNBLOCK_INPUT; + unblock_input (); } #endif } /* Hide tooltip if shown. Do nothing if not shown. - Return non-zero if tip was hidden, non-zero if not (i.e. not using + Return true if tip was hidden, false if not (i.e. not using system tooltips). */ -int +bool xg_hide_tooltip (FRAME_PTR f) { - int ret = 0; + bool ret = 0; #ifdef USE_GTK_TOOLTIP if (f->output_data.x->ttip_window) { GtkWindow *win = f->output_data.x->ttip_window; - BLOCK_INPUT; + block_input (); gtk_widget_hide (GTK_WIDGET (win)); if (g_object_get_data (G_OBJECT (win), "restore-tt")) @@ -799,7 +800,7 @@ xg_hide_tooltip (FRAME_PTR f) GtkSettings *settings = gtk_settings_get_for_screen (screen); g_object_set (settings, "gtk-enable-tooltips", TRUE, NULL); } - UNBLOCK_INPUT; + unblock_input (); ret = 1; } @@ -1007,7 +1008,7 @@ xg_win_to_widget (Display *dpy, Window wdesc) gpointer gdkwin; GtkWidget *gwdesc = 0; - BLOCK_INPUT; + block_input (); gdkwin = gdk_x11_window_lookup_for_display (gdk_x11_lookup_xdisplay (dpy), wdesc); @@ -1019,7 +1020,7 @@ xg_win_to_widget (Display *dpy, Window wdesc) gwdesc = gtk_get_event_widget (&event); } - UNBLOCK_INPUT; + unblock_input (); return gwdesc; } @@ -1110,9 +1111,9 @@ delete_cb (GtkWidget *widget, } /* Create and set up the GTK widgets for frame F. - Return 0 if creation failed, non-zero otherwise. */ + Return true if creation succeeded. */ -int +bool xg_create_frame_widgets (FRAME_PTR f) { GtkWidget *wtop; @@ -1123,7 +1124,7 @@ xg_create_frame_widgets (FRAME_PTR f) #endif char *title = 0; - BLOCK_INPUT; + block_input (); if (FRAME_X_EMBEDDED_P (f)) { @@ -1161,7 +1162,7 @@ xg_create_frame_widgets (FRAME_PTR f) if (whbox) gtk_widget_destroy (whbox); if (wfixed) gtk_widget_destroy (wfixed); - UNBLOCK_INPUT; + unblock_input (); return 0; } @@ -1275,7 +1276,7 @@ xg_create_frame_widgets (FRAME_PTR f) } } - UNBLOCK_INPUT; + unblock_input (); return 1; } @@ -1309,11 +1310,11 @@ xg_free_frame_widgets (FRAME_PTR f) /* Set the normal size hints for the window manager, for frame F. FLAGS is the flags word to use--or 0 meaning preserve the flags that the window now has. - If USER_POSITION is nonzero, we set the User Position + If USER_POSITION, set the User Position flag (this is useful when FLAGS is 0). */ void -x_wm_set_size_hint (FRAME_PTR f, long int flags, int user_position) +x_wm_set_size_hint (FRAME_PTR f, long int flags, bool user_position) { /* Must use GTK routines here, otherwise GTK resets the size hints to its own defaults. */ @@ -1397,12 +1398,12 @@ x_wm_set_size_hint (FRAME_PTR f, long int flags, int user_position) &f->output_data.x->size_hints, sizeof (size_hints)) != 0) { - BLOCK_INPUT; + block_input (); gtk_window_set_geometry_hints (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), NULL, &size_hints, hint_flags); f->output_data.x->size_hints = size_hints; f->output_data.x->hint_flags = hint_flags; - UNBLOCK_INPUT; + unblock_input (); } } @@ -1417,9 +1418,9 @@ xg_set_background_color (FRAME_PTR f, long unsigned int bg) { if (FRAME_GTK_WIDGET (f)) { - BLOCK_INPUT; + block_input (); xg_set_widget_bg (f, FRAME_GTK_WIDGET (f), FRAME_BACKGROUND_PIXEL (f)); - UNBLOCK_INPUT; + unblock_input (); } } @@ -1519,7 +1520,7 @@ create_dialog (widget_value *wv, /* If the number of buttons is greater than 4, make two rows of buttons instead. This looks better. */ - int make_two_rows = total_buttons > 4; + bool make_two_rows = total_buttons > 4; if (right_buttons == 0) right_buttons = total_buttons/2; left_buttons = total_buttons - right_buttons; @@ -1637,14 +1638,14 @@ pop_down_dialog (Lisp_Object arg) struct Lisp_Save_Value *p = XSAVE_VALUE (arg); struct xg_dialog_data *dd = (struct xg_dialog_data *) p->pointer; - BLOCK_INPUT; + block_input (); if (dd->w) gtk_widget_destroy (dd->w); if (dd->timerid != 0) g_source_remove (dd->timerid); g_main_loop_quit (dd->loop); g_main_loop_unref (dd->loop); - UNBLOCK_INPUT; + unblock_input (); return Qnil; } @@ -1716,10 +1717,9 @@ xg_dialog_run (FRAME_PTR f, GtkWidget *w) /*********************************************************************** File dialog functions ***********************************************************************/ -/* Return non-zero if the old file selection dialog is being used. - Return zero if not. */ +/* Return true if the old file selection dialog is being used. */ -int +bool xg_uses_old_file_dialog (void) { #ifdef HAVE_GTK_FILE_SELECTION_NEW @@ -1790,7 +1790,7 @@ xg_toggle_notify_cb (GObject *gobject, GParamSpec *arg1, gpointer user_data) F is the current frame. PROMPT is a prompt to show to the user. May not be NULL. DEFAULT_FILENAME is a default selection to be displayed. May be NULL. - If MUSTMATCH_P is non-zero, the returned file name must be an existing + If MUSTMATCH_P, the returned file name must be an existing file. (Actually, this only has cosmetic effects, the user can still enter a non-existing file.) *FUNC is set to a function that can be used to retrieve the selected file name from the returned widget. @@ -1801,7 +1801,7 @@ static GtkWidget * xg_get_file_with_chooser (FRAME_PTR f, char *prompt, char *default_filename, - int mustmatch_p, int only_dir_p, + bool mustmatch_p, bool only_dir_p, xg_get_file_func *func) { char msgbuf[1024]; @@ -1913,7 +1913,7 @@ xg_get_file_name_from_selector (GtkWidget *w) F is the current frame. PROMPT is a prompt to show to the user. May not be NULL. DEFAULT_FILENAME is a default selection to be displayed. May be NULL. - If MUSTMATCH_P is non-zero, the returned file name must be an existing + If MUSTMATCH_P, the returned file name must be an existing file. *FUNC is set to a function that can be used to retrieve the selected file name from the returned widget. @@ -1923,7 +1923,7 @@ static GtkWidget * xg_get_file_with_selection (FRAME_PTR f, char *prompt, char *default_filename, - int mustmatch_p, int only_dir_p, + bool mustmatch_p, bool only_dir_p, xg_get_file_func *func) { GtkWidget *filewin; @@ -1955,7 +1955,7 @@ xg_get_file_with_selection (FRAME_PTR f, F is the current frame. PROMPT is a prompt to show to the user. May not be NULL. DEFAULT_FILENAME is a default selection to be displayed. May be NULL. - If MUSTMATCH_P is non-zero, the returned file name must be an existing + If MUSTMATCH_P, the returned file name must be an existing file. Returns a file name or NULL if no file was selected. @@ -1965,24 +1965,14 @@ char * xg_get_file_name (FRAME_PTR f, char *prompt, char *default_filename, - int mustmatch_p, - int only_dir_p) + bool mustmatch_p, + bool only_dir_p) { GtkWidget *w = 0; char *fn = 0; int filesel_done = 0; xg_get_file_func func; -#if defined (HAVE_PTHREAD) && defined (__SIGRTMIN) - /* I really don't know why this is needed, but without this the GLIBC add on - library linuxthreads hangs when the Gnome file chooser backend creates - threads. */ - sigset_t blocked; - sigemptyset (&blocked); - sigaddset (&blocked, __SIGRTMIN); - pthread_sigmask (SIG_BLOCK, &blocked, 0); -#endif /* HAVE_PTHREAD */ - #ifdef HAVE_GTK_FILE_SELECTION_NEW if (xg_uses_old_file_dialog ()) @@ -2000,11 +1990,6 @@ xg_get_file_name (FRAME_PTR f, gtk_widget_set_name (w, "emacs-filedialog"); filesel_done = xg_dialog_run (f, w); - -#if defined (HAVE_PTHREAD) && defined (__SIGRTMIN) - pthread_sigmask (SIG_UNBLOCK, &blocked, 0); -#endif - if (filesel_done == GTK_RESPONSE_OK) fn = (*func) (w); @@ -2057,13 +2042,6 @@ xg_get_font (FRAME_PTR f, const char *default_name) int done = 0; Lisp_Object font = Qnil; -#if defined (HAVE_PTHREAD) && defined (__SIGRTMIN) - sigset_t blocked; - sigemptyset (&blocked); - sigaddset (&blocked, __SIGRTMIN); - pthread_sigmask (SIG_BLOCK, &blocked, 0); -#endif /* HAVE_PTHREAD */ - w = gtk_font_chooser_dialog_new ("Pick a font", GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f))); @@ -2088,11 +2066,6 @@ xg_get_font (FRAME_PTR f, const char *default_name) gtk_widget_set_name (w, "emacs-fontdialog"); done = xg_dialog_run (f, w); - -#if defined (HAVE_PTHREAD) && defined (__SIGRTMIN) - pthread_sigmask (SIG_UNBLOCK, &blocked, 0); -#endif - if (done == GTK_RESPONSE_OK) { #if USE_NEW_GTK_FONT_CHOOSER @@ -2430,9 +2403,9 @@ make_menu_item (const char *utf8_label, static int xg_detached_menus; -/* Returns non-zero if there are detached menus. */ +/* Return true if there are detached menus. */ -int +bool xg_have_tear_offs (void) { return xg_detached_menus > 0; @@ -2536,10 +2509,9 @@ xg_create_one_menuitem (widget_value *item, SELECT_CB is the callback to use when a menu item is selected. DEACTIVATE_CB is the callback to use when a sub menu is not shown anymore. HIGHLIGHT_CB is the callback to call when entering/leaving menu items. - POP_UP_P is non-zero if we shall create a popup menu. - MENU_BAR_P is non-zero if we shall create a menu bar. - ADD_TEAROFF_P is non-zero if we shall add a tearoff menu item. Ignored - if MENU_BAR_P is non-zero. + If POP_UP_P, create a popup menu. + If MENU_BAR_P, create a menu bar. + If ADD_TEAROFF_P, add a tearoff menu item. Ignored if MENU_BAR_P. TOPMENU is the topmost GtkWidget that others shall be placed under. It may be NULL, in that case we create the appropriate widget (menu bar or menu item depending on POP_UP_P and MENU_BAR_P) @@ -2559,9 +2531,9 @@ create_menus (widget_value *data, GCallback select_cb, GCallback deactivate_cb, GCallback highlight_cb, - int pop_up_p, - int menu_bar_p, - int add_tearoff_p, + bool pop_up_p, + bool menu_bar_p, + bool add_tearoff_p, GtkWidget *topmenu, xg_menu_cb_data *cl_data, const char *name) @@ -2701,8 +2673,8 @@ xg_create_widget (const char *type, const char *name, FRAME_PTR f, widget_value GCallback highlight_cb) { GtkWidget *w = 0; - int menu_bar_p = strcmp (type, "menubar") == 0; - int pop_up_p = strcmp (type, "popup") == 0; + bool menu_bar_p = strcmp (type, "menubar") == 0; + bool pop_up_p = strcmp (type, "popup") == 0; if (strcmp (type, "dialog") == 0) { @@ -2755,12 +2727,12 @@ xg_get_menu_item_label (GtkMenuItem *witem) return gtk_label_get_label (wlabel); } -/* Return non-zero if the menu item WITEM has the text LABEL. */ +/* Return true if the menu item WITEM has the text LABEL. */ -static int +static bool xg_item_label_same_p (GtkMenuItem *witem, const char *label) { - int is_same = 0; + bool is_same = 0; char *utf8_label = get_utf8_string (label); const char *old_label = witem ? xg_get_menu_item_label (witem) : 0; @@ -2851,8 +2823,8 @@ xg_update_menubar (GtkWidget *menubar, { GtkMenuItem *witem = GTK_MENU_ITEM (iter->data); GtkMenuItem *witem2 = 0; - int val_in_menubar = 0; - int iter_in_new_menubar = 0; + bool val_in_menubar = 0; + bool iter_in_new_menubar = 0; GList *iter2; widget_value *cur; @@ -3130,7 +3102,7 @@ xg_update_submenu (GtkWidget *submenu, GList *list = 0; GList *iter; widget_value *cur; - int has_tearoff_p = 0; + bool has_tearoff_p = 0; GList *first_radio = 0; if (submenu) @@ -3252,7 +3224,7 @@ xg_update_submenu (GtkWidget *submenu, /* Update the MENUBAR. F is the frame the menu bar belongs to. VAL describes the contents of the menu bar. - If DEEP_P is non-zero, rebuild all but the top level menu names in + If DEEP_P, rebuild all but the top level menu names in the MENUBAR. If DEEP_P is zero, just rebuild the names in the menubar. SELECT_CB is the callback to use when a menu item is selected. DEACTIVATE_CB is the callback to use when a sub menu is not shown anymore. @@ -3260,7 +3232,7 @@ xg_update_submenu (GtkWidget *submenu, void xg_modify_menubar_widgets (GtkWidget *menubar, FRAME_PTR f, widget_value *val, - int deep_p, + bool deep_p, GCallback select_cb, GCallback deactivate_cb, GCallback highlight_cb) { @@ -3344,21 +3316,21 @@ menubar_map_cb (GtkWidget *w, gpointer user_data) } /* Recompute all the widgets of frame F, when the menu bar has been - changed. Value is non-zero if widgets were updated. */ + changed. */ -int +void xg_update_frame_menubar (FRAME_PTR f) { struct x_output *x = f->output_data.x; GtkRequisition req; if (!x->menubar_widget || gtk_widget_get_mapped (x->menubar_widget)) - return 0; + return; if (x->menubar_widget && gtk_widget_get_parent (x->menubar_widget)) - return 0; /* Already done this, happens for frames created invisible. */ + return; /* Already done this, happens for frames created invisible. */ - BLOCK_INPUT; + block_input (); gtk_box_pack_start (GTK_BOX (x->vbox_widget), x->menubar_widget, FALSE, FALSE, 0); @@ -3378,9 +3350,7 @@ xg_update_frame_menubar (FRAME_PTR f) FRAME_MENUBAR_HEIGHT (f) = req.height; xg_height_or_width_changed (f); } - UNBLOCK_INPUT; - - return 1; + unblock_input (); } /* Get rid of the menu bar of frame F, and free its storage. @@ -3393,7 +3363,7 @@ free_frame_menubar (FRAME_PTR f) if (x->menubar_widget) { - BLOCK_INPUT; + block_input (); gtk_container_remove (GTK_CONTAINER (x->vbox_widget), x->menubar_widget); /* The menubar and its children shall be deleted when removed from @@ -3401,11 +3371,11 @@ free_frame_menubar (FRAME_PTR f) x->menubar_widget = 0; FRAME_MENUBAR_HEIGHT (f) = 0; xg_height_or_width_changed (f); - UNBLOCK_INPUT; + unblock_input (); } } -int +bool xg_event_is_for_menubar (FRAME_PTR f, XEvent *event) { struct x_output *x = f->output_data.x; @@ -3452,7 +3422,7 @@ xg_event_is_for_menubar (FRAME_PTR f, XEvent *event) break; } g_list_free (list); - return iter == 0 ? 0 : 1; + return iter != 0; } @@ -3465,7 +3435,7 @@ xg_event_is_for_menubar (FRAME_PTR f, XEvent *event) /* Setting scroll bar values invokes the callback. Use this variable to indicate that callback should do nothing. */ -int xg_ignore_gtk_scrollbar; +bool xg_ignore_gtk_scrollbar; /* The width of the scroll bar for the current theme. */ @@ -3791,7 +3761,7 @@ xg_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int size, value; int old_size; int new_step; - int changed = 0; + bool changed = 0; adj = gtk_range_get_adjustment (GTK_RANGE (wscroll)); @@ -3838,7 +3808,7 @@ xg_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, if (changed || int_gtk_range_get_value (GTK_RANGE (wscroll)) != value) { - BLOCK_INPUT; + block_input (); /* gtk_range_set_value invokes the callback. Set ignore_gtk_scrollbar to make the callback do nothing */ @@ -3851,22 +3821,20 @@ xg_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, xg_ignore_gtk_scrollbar = 0; - UNBLOCK_INPUT; + unblock_input (); } } } -/* Return non-zero if EVENT is for a scroll bar in frame F. +/* Return true if EVENT is for a scroll bar in frame F. When the same X window is used for several Gtk+ widgets, we cannot say for sure based on the X window alone if an event is for the - frame. This function does additional checks. + frame. This function does additional checks. */ - Return non-zero if the event is for a scroll bar, zero otherwise. */ - -int +bool xg_event_is_for_scrollbar (FRAME_PTR f, XEvent *event) { - int retval = 0; + bool retval = 0; if (f && event->type == ButtonPress && event->xbutton.button < 4) { @@ -4297,7 +4265,7 @@ static void xg_pack_tool_bar (FRAME_PTR f, Lisp_Object pos) { struct x_output *x = f->output_data.x; - int into_hbox = EQ (pos, Qleft) || EQ (pos, Qright); + bool into_hbox = EQ (pos, Qleft) || EQ (pos, Qright); toolbar_set_orientation (x->toolbar_widget, into_hbox @@ -4329,7 +4297,7 @@ xg_pack_tool_bar (FRAME_PTR f, Lisp_Object pos) } else { - int vbox_pos = x->menubar_widget ? 1 : 0; + bool vbox_pos = x->menubar_widget != 0; gtk_handle_box_set_handle_position (GTK_HANDLE_BOX (x->handlebox_widget), GTK_POS_LEFT); gtk_box_pack_start (GTK_BOX (x->vbox_widget), x->handlebox_widget, @@ -4420,7 +4388,7 @@ xg_make_tool_item (FRAME_PTR f, GtkWidget *wimage, GtkWidget **wbutton, const char *label, - int i, int horiz, int text_image) + int i, bool horiz, bool text_image) { GtkToolItem *ti = gtk_tool_item_new (); GtkWidget *vb = gtk_box_new (horiz @@ -4515,11 +4483,11 @@ xg_make_tool_item (FRAME_PTR f, return ti; } -static int -is_box_type (GtkWidget *vb, int is_horizontal) +static bool +is_box_type (GtkWidget *vb, bool is_horizontal) { #ifdef HAVE_GTK3 - int ret = 0; + bool ret = 0; if (GTK_IS_BOX (vb)) { GtkOrientation ori = gtk_orientable_get_orientation (GTK_ORIENTABLE (vb)); @@ -4533,10 +4501,10 @@ is_box_type (GtkWidget *vb, int is_horizontal) } -static int +static bool xg_tool_item_stale_p (GtkWidget *wbutton, const char *stock_name, const char *icon_name, const struct image *img, - const char *label, int horiz) + const char *label, bool horiz) { gpointer old; GtkWidget *wimage; @@ -4578,7 +4546,7 @@ xg_tool_item_stale_p (GtkWidget *wbutton, const char *stock_name, return 0; } -static int +static bool xg_update_tool_bar_sizes (FRAME_PTR f) { struct x_output *x = f->output_data.x; @@ -4634,15 +4602,15 @@ update_frame_tool_bar (FRAME_PTR f) GtkToolbar *wtoolbar; GtkToolItem *ti; GtkTextDirection dir; - int pack_tool_bar = x->handlebox_widget == NULL; + bool pack_tool_bar = x->handlebox_widget == NULL; Lisp_Object style; - int text_image, horiz; + bool text_image, horiz; struct xg_frame_tb_info *tbinfo; if (! FRAME_GTK_WIDGET (f)) return; - BLOCK_INPUT; + block_input (); if (RANGED_INTEGERP (1, Vtool_bar_button_margin, INT_MAX)) { @@ -4684,7 +4652,7 @@ update_frame_tool_bar (FRAME_PTR f) && ! NILP (Fequal (tbinfo->style, style)) && ! NILP (Fequal (tbinfo->last_tool_bar, f->tool_bar_items))) { - UNBLOCK_INPUT; + unblock_input (); return; } @@ -4700,8 +4668,8 @@ update_frame_tool_bar (FRAME_PTR f) for (i = j = 0; i < f->n_tool_bar_items; ++i) { - int enabled_p = !NILP (PROP (TOOL_BAR_ITEM_ENABLED_P)); - int selected_p = !NILP (PROP (TOOL_BAR_ITEM_SELECTED_P)); + bool enabled_p = !NILP (PROP (TOOL_BAR_ITEM_ENABLED_P)); + bool selected_p = !NILP (PROP (TOOL_BAR_ITEM_SELECTED_P)); int idx; ptrdiff_t img_id; int icon_size = 0; @@ -4714,7 +4682,7 @@ update_frame_tool_bar (FRAME_PTR f) Lisp_Object rtl; GtkWidget *wbutton = NULL; Lisp_Object specified_file; - int vert_only = ! NILP (PROP (TOOL_BAR_ITEM_VERT_ONLY)); + bool vert_only = ! NILP (PROP (TOOL_BAR_ITEM_VERT_ONLY)); const char *label = (EQ (style, Qimage) || (vert_only && horiz)) ? NULL : STRINGP (PROP (TOOL_BAR_ITEM_LABEL)) @@ -4895,7 +4863,7 @@ update_frame_tool_bar (FRAME_PTR f) xg_height_or_width_changed (f); } - UNBLOCK_INPUT; + unblock_input (); } /* Deallocate all resources for the tool bar on frame F. @@ -4909,8 +4877,8 @@ free_frame_tool_bar (FRAME_PTR f) if (x->toolbar_widget) { struct xg_frame_tb_info *tbinfo; - int is_packed = x->handlebox_widget != 0; - BLOCK_INPUT; + bool is_packed = x->handlebox_widget != 0; + block_input (); /* We may have created the toolbar_widget in xg_create_tool_bar, but not the x->handlebox_widget which is created in xg_pack_tool_bar. */ if (is_packed) @@ -4942,19 +4910,19 @@ free_frame_tool_bar (FRAME_PTR f) xg_height_or_width_changed (f); - UNBLOCK_INPUT; + unblock_input (); } } -int +void xg_change_toolbar_position (FRAME_PTR f, Lisp_Object pos) { struct x_output *x = f->output_data.x; if (! x->toolbar_widget || ! x->handlebox_widget) - return 1; + return; - BLOCK_INPUT; + block_input (); g_object_ref (x->handlebox_widget); if (x->toolbar_in_hbox) gtk_container_remove (GTK_CONTAINER (x->hbox_widget), @@ -4967,8 +4935,7 @@ xg_change_toolbar_position (FRAME_PTR f, Lisp_Object pos) if (xg_update_tool_bar_sizes (f)) xg_height_or_width_changed (f); - UNBLOCK_INPUT; - return 1; + unblock_input (); } diff --git a/src/gtkutil.h b/src/gtkutil.h index 926478dd728..43f2b237a68 100644 --- a/src/gtkutil.h +++ b/src/gtkutil.h @@ -79,13 +79,13 @@ struct _widget_value; extern struct _widget_value *malloc_widget_value (void); extern void free_widget_value (struct _widget_value *); -extern int xg_uses_old_file_dialog (void) ATTRIBUTE_CONST; +extern bool xg_uses_old_file_dialog (void) ATTRIBUTE_CONST; extern char *xg_get_file_name (FRAME_PTR f, char *prompt, char *default_filename, - int mustmatch_p, - int only_dir_p); + bool mustmatch_p, + bool only_dir_p); extern Lisp_Object xg_get_font (FRAME_PTR f, const char *); @@ -100,16 +100,16 @@ extern GtkWidget *xg_create_widget (const char *type, extern void xg_modify_menubar_widgets (GtkWidget *menubar, FRAME_PTR f, struct _widget_value *val, - int deep_p, + bool deep_p, GCallback select_cb, GCallback deactivate_cb, GCallback highlight_cb); -extern int xg_update_frame_menubar (FRAME_PTR f); +extern void xg_update_frame_menubar (FRAME_PTR f); -extern int xg_event_is_for_menubar (FRAME_PTR f, XEvent *event); +extern bool xg_event_is_for_menubar (FRAME_PTR f, XEvent *event); -extern int xg_have_tear_offs (void); +extern bool xg_have_tear_offs (void); extern ptrdiff_t xg_get_scroll_id_for_window (Display *dpy, Window wid); @@ -131,12 +131,12 @@ extern void xg_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int portion, int position, int whole); -extern int xg_event_is_for_scrollbar (FRAME_PTR f, XEvent *event); +extern bool xg_event_is_for_scrollbar (FRAME_PTR f, XEvent *event); extern int xg_get_default_scrollbar_width (void); extern void update_frame_tool_bar (FRAME_PTR f); extern void free_frame_tool_bar (FRAME_PTR f); -extern int xg_change_toolbar_position (FRAME_PTR f, Lisp_Object pos); +extern void xg_change_toolbar_position (FRAME_PTR f, Lisp_Object pos); extern void xg_frame_resized (FRAME_PTR f, int pixelwidth, @@ -148,23 +148,23 @@ extern void xg_display_open (char *display_name, Display **dpy); extern void xg_display_close (Display *dpy); extern GdkCursor * xg_create_default_cursor (Display *dpy); -extern int xg_create_frame_widgets (FRAME_PTR f); +extern bool xg_create_frame_widgets (FRAME_PTR f); extern void xg_free_frame_widgets (FRAME_PTR f); extern void xg_set_background_color (FRAME_PTR f, unsigned long bg); -extern int xg_check_special_colors (struct frame *f, - const char *color_name, - XColor *color); +extern bool xg_check_special_colors (struct frame *f, + const char *color_name, + XColor *color); extern void xg_set_frame_icon (FRAME_PTR f, Pixmap icon_pixmap, Pixmap icon_mask); -extern int xg_prepare_tooltip (FRAME_PTR f, - Lisp_Object string, - int *width, - int *height); +extern bool xg_prepare_tooltip (FRAME_PTR f, + Lisp_Object string, + int *width, + int *height); extern void xg_show_tooltip (FRAME_PTR f, int root_x, int root_y); -extern int xg_hide_tooltip (FRAME_PTR f); +extern bool xg_hide_tooltip (FRAME_PTR f); /* Mark all callback data that are Lisp_object:s during GC. */ @@ -175,7 +175,7 @@ extern void xg_initialize (void); /* Setting scrollbar values invokes the callback. Use this variable to indicate that the callback should do nothing. */ -extern int xg_ignore_gtk_scrollbar; +extern bool xg_ignore_gtk_scrollbar; #endif /* USE_GTK */ #endif /* GTKUTIL_H */ diff --git a/src/image.c b/src/image.c index 0060d0d4148..7901b95f236 100644 --- a/src/image.c +++ b/src/image.c @@ -407,9 +407,9 @@ x_destroy_bitmap (FRAME_PTR f, ptrdiff_t id) if (--bm->refcount == 0) { - BLOCK_INPUT; + block_input (); free_bitmap_record (dpyinfo, bm); - UNBLOCK_INPUT; + unblock_input (); } } } @@ -429,6 +429,9 @@ x_destroy_all_bitmaps (Display_Info *dpyinfo) dpyinfo->bitmaps_last = 0; } +static bool x_create_x_image_and_pixmap (struct frame *, int, int, int, + XImagePtr *, Pixmap *); +static void x_destroy_x_image (XImagePtr ximg); #ifdef HAVE_X_WINDOWS @@ -440,23 +443,17 @@ static unsigned long four_corners_best (XImagePtr ximg, unsigned long width, unsigned long height); -static int x_create_x_image_and_pixmap (struct frame *f, int width, int height, - int depth, XImagePtr *ximg, - Pixmap *pixmap); - -static void x_destroy_x_image (XImagePtr ximg); - /* Create a mask of a bitmap. Note is this not a perfect mask. It's nicer with some borders in this context */ -int +void x_create_bitmap_mask (struct frame *f, ptrdiff_t id) { Pixmap pixmap, mask; XImagePtr ximg, mask_img; unsigned long width, height; - int result; + bool result; unsigned long bg; unsigned long x, y, xp, xm, yp, ym; GC gc; @@ -464,29 +461,29 @@ x_create_bitmap_mask (struct frame *f, ptrdiff_t id) Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); if (!(id > 0)) - return -1; + return; pixmap = x_bitmap_pixmap (f, id); width = x_bitmap_width (f, id); height = x_bitmap_height (f, id); - BLOCK_INPUT; + block_input (); ximg = XGetImage (FRAME_X_DISPLAY (f), pixmap, 0, 0, width, height, ~0, ZPixmap); if (!ximg) { - UNBLOCK_INPUT; - return -1; + unblock_input (); + return; } result = x_create_x_image_and_pixmap (f, width, height, 1, &mask_img, &mask); - UNBLOCK_INPUT; + unblock_input (); if (!result) { XDestroyImage (ximg); - return -1; + return; } bg = four_corners_best (ximg, NULL, width, height); @@ -514,7 +511,7 @@ x_create_bitmap_mask (struct frame *f, ptrdiff_t id) } } - eassert (interrupt_input_blocked); + eassert (input_blocked_p ()); gc = XCreateGC (FRAME_X_DISPLAY (f), mask, 0, NULL); XPutImage (FRAME_X_DISPLAY (f), mask, gc, mask_img, 0, 0, 0, 0, width, height); @@ -525,8 +522,6 @@ x_create_bitmap_mask (struct frame *f, ptrdiff_t id) XDestroyImage (ximg); x_destroy_x_image (mask_img); - - return 0; } #endif /* HAVE_X_WINDOWS */ @@ -559,15 +554,13 @@ static Lisp_Object QCcrop, QCrotation; static Lisp_Object Qcount, Qextension_data, Qdelay; static Lisp_Object Qlaplace, Qemboss, Qedge_detection, Qheuristic; -/* Function prototypes. */ +/* Forward function prototypes. */ -static struct image_type *define_image_type (struct image_type *, Lisp_Object); -static struct image_type *lookup_image_type (Lisp_Object, Lisp_Object); -static void image_error (const char *format, Lisp_Object, Lisp_Object); +static struct image_type *lookup_image_type (Lisp_Object); static void x_laplace (struct frame *, struct image *); static void x_emboss (struct frame *, struct image *); -static int x_build_heuristic_mask (struct frame *, struct image *, - Lisp_Object); +static void x_build_heuristic_mask (struct frame *, struct image *, + Lisp_Object); #ifdef HAVE_NTGUI #define CACHE_IMAGE_TYPE(type, status) \ do { Vlibrary_cache = Fcons (Fcons (type, status), Vlibrary_cache); } while (0) @@ -579,21 +572,16 @@ static int x_build_heuristic_mask (struct frame *, struct image *, do { Vimage_types = Fcons (type, Vimage_types); } while (0) /* Define a new image type from TYPE. This adds a copy of TYPE to - image_types and caches the loading status of TYPE. - - LIBRARIES is an alist associating dynamic libraries to external - files implementing them, which is passed to the image library - initialization function if necessary. A nil value defaults to - Vdynamic_library_alist. */ + image_types and caches the loading status of TYPE. */ static struct image_type * -define_image_type (struct image_type *type, Lisp_Object libraries) +define_image_type (struct image_type *type) { struct image_type *p = NULL; Lisp_Object target_type = *type->type; - int type_valid = 1; + bool type_valid = 1; - BLOCK_INPUT; + block_input (); for (p = image_types; p; p = p->next) if (EQ (*p->type, target_type)) @@ -609,7 +597,7 @@ define_image_type (struct image_type *type, Lisp_Object libraries) else #endif { - type_valid = type->init (libraries); + type_valid = type->init (); CACHE_IMAGE_TYPE (target_type, type_valid ? Qt : Qnil); } } @@ -625,22 +613,22 @@ define_image_type (struct image_type *type, Lisp_Object libraries) } done: - UNBLOCK_INPUT; + unblock_input (); return p; } -/* Value is non-zero if OBJECT is a valid Lisp image specification. A +/* Value is true if OBJECT is a valid Lisp image specification. A valid image specification is a list whose car is the symbol `image', and whose rest is a property list. The property list must contain a value for key `:type'. That value must be the name of a supported image type. The rest of the property list depends on the image type. */ -int +bool valid_image_p (Lisp_Object object) { - int valid_p = 0; + bool valid_p = 0; if (IMAGEP (object)) { @@ -653,7 +641,7 @@ valid_image_p (Lisp_Object object) if (CONSP (tem) && SYMBOLP (XCAR (tem))) { struct image_type *type; - type = lookup_image_type (XCAR (tem), Qnil); + type = lookup_image_type (XCAR (tem)); if (type) valid_p = type->valid_p (object); } @@ -710,8 +698,8 @@ struct image_keyword /* The type of value allowed. */ enum image_value_type type; - /* Non-zero means key must be present. */ - int mandatory_p; + /* True means key must be present. */ + bool mandatory_p; /* Used to recognize duplicate keywords in a property list. */ int count; @@ -721,18 +709,13 @@ struct image_keyword }; -static int parse_image_spec (Lisp_Object, struct image_keyword *, - int, Lisp_Object); -static Lisp_Object image_spec_value (Lisp_Object, Lisp_Object, int *); - - /* Parse image spec SPEC according to KEYWORDS. A valid image spec has the format (image KEYWORD VALUE ...). One of the keyword/ value pairs must be `:type TYPE'. KEYWORDS is a vector of image_keywords structures of size NKEYWORDS describing other - allowed keyword/value pairs. Value is non-zero if SPEC is valid. */ + allowed keyword/value pairs. Value is true if SPEC is valid. */ -static int +static bool parse_image_spec (Lisp_Object spec, struct image_keyword *keywords, int nkeywords, Lisp_Object type) { @@ -864,11 +847,11 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords, /* Return the value of KEY in image specification SPEC. Value is nil - if KEY is not present in SPEC. if FOUND is not null, set *FOUND - to 1 if KEY was found in SPEC, set it to 0 otherwise. */ + if KEY is not present in SPEC. Set *FOUND depending on whether KEY + was found in SPEC. */ static Lisp_Object -image_spec_value (Lisp_Object spec, Lisp_Object key, int *found) +image_spec_value (Lisp_Object spec, Lisp_Object key, bool *found) { Lisp_Object tail; @@ -972,8 +955,6 @@ or omitted means use the selected frame. */) Image type independent image structures ***********************************************************************/ -static void free_image (struct frame *f, struct image *img); - #define MAX_IMAGE_SIZE 10.0 /* Allocate and return a new image structure for image specification SPEC. SPEC has a hash value of HASH. */ @@ -986,7 +967,7 @@ make_image (Lisp_Object spec, EMACS_UINT hash) eassert (valid_image_p (spec)); img->dependencies = NILP (file) ? Qnil : list1 (file); - img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL), Qnil); + img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL)); eassert (img->type != NULL); img->spec = spec; img->lisp_data = Qnil; @@ -1023,10 +1004,9 @@ free_image (struct frame *f, struct image *img) } } -/* Return 1 if the given widths and heights are valid for display; - otherwise, return 0. */ +/* Return true if the given widths and heights are valid for display. */ -static int +static bool check_image_size (struct frame *f, int width, int height) { int w, h; @@ -1065,7 +1045,7 @@ prepare_image_for_display (struct frame *f, struct image *img) /* If IMG doesn't have a pixmap yet, load it now, using the image type dependent loader function. */ if (img->pixmap == NO_PIXMAP && !img->load_failed_p) - img->load_failed_p = img->type->load (f, img) == 0; + img->load_failed_p = ! img->type->load (f, img); } @@ -1198,7 +1178,7 @@ image_background (struct image *img, struct frame *f, XImagePtr_or_DC ximg) if (! img->background_valid) /* IMG doesn't have a background yet, try to guess a reasonable value. */ { - int free_ximg = !ximg; + bool free_ximg = !ximg; #ifdef HAVE_NTGUI HGDIOBJ prev; #endif /* HAVE_NTGUI */ @@ -1239,7 +1219,7 @@ image_background_transparent (struct image *img, struct frame *f, XImagePtr_or_D { if (img->mask) { - int free_mask = !mask; + bool free_mask = !mask; #ifdef HAVE_NTGUI HGDIOBJ prev; #endif /* HAVE_NTGUI */ @@ -1277,23 +1257,13 @@ image_background_transparent (struct image *img, struct frame *f, XImagePtr_or_D Helper functions for X image types ***********************************************************************/ -static void x_clear_image_1 (struct frame *, struct image *, int, - int, int); -static void x_clear_image (struct frame *f, struct image *img); -static unsigned long x_alloc_image_color (struct frame *f, - struct image *img, - Lisp_Object color_name, - unsigned long dflt); - - -/* Clear X resources of image IMG on frame F. PIXMAP_P non-zero means - free the pixmap if any. MASK_P non-zero means clear the mask - pixmap if any. COLORS_P non-zero means free colors allocated for - the image, if any. */ +/* Clear X resources of image IMG on frame F. PIXMAP_P means free the + pixmap if any. MASK_P means clear the mask pixmap if any. + COLORS_P means free colors allocated for the image, if any. */ static void -x_clear_image_1 (struct frame *f, struct image *img, int pixmap_p, int mask_p, - int colors_p) +x_clear_image_1 (struct frame *f, struct image *img, bool pixmap_p, + bool mask_p, bool colors_p) { if (pixmap_p && img->pixmap) { @@ -1328,9 +1298,9 @@ x_clear_image_1 (struct frame *f, struct image *img, int pixmap_p, int mask_p, static void x_clear_image (struct frame *f, struct image *img) { - BLOCK_INPUT; + block_input (); x_clear_image_1 (f, img, 1, 1, 1); - UNBLOCK_INPUT; + unblock_input (); } @@ -1373,7 +1343,6 @@ x_alloc_image_color (struct frame *f, struct image *img, Lisp_Object color_name, ***********************************************************************/ static void cache_image (struct frame *f, struct image *img); -static void postprocess_image (struct frame *, struct image *); /* Return a new, initialized image cache that is allocated from the heap. Call free_image_cache to free an image cache. */ @@ -1485,7 +1454,7 @@ clear_image_cache (struct frame *f, Lisp_Object filter) /* Block input so that we won't be interrupted by a SIGIO while being in an inconsistent state. */ - BLOCK_INPUT; + block_input (); if (!NILP (filter)) { @@ -1551,7 +1520,7 @@ clear_image_cache (struct frame *f, Lisp_Object filter) ++windows_or_buffers_changed; } - UNBLOCK_INPUT; + unblock_input (); } } @@ -1646,7 +1615,7 @@ postprocess_image (struct frame *f, struct image *img) x_build_heuristic_mask (f, img, mask); else { - int found_p; + bool found_p; mask = image_spec_value (spec, QCmask, &found_p); @@ -1716,10 +1685,10 @@ lookup_image (struct frame *f, Lisp_Object spec) /* If not found, create a new image and cache it. */ if (img == NULL) { - BLOCK_INPUT; + block_input (); img = make_image (spec, hash); cache_image (f, img); - img->load_failed_p = img->type->load (f, img) == 0; + img->load_failed_p = ! img->type->load (f, img); img->frame_foreground = FRAME_FOREGROUND_PIXEL (f); img->frame_background = FRAME_BACKGROUND_PIXEL (f); @@ -1787,7 +1756,7 @@ lookup_image (struct frame *f, Lisp_Object spec) postprocess_image (f, img); } - UNBLOCK_INPUT; + unblock_input (); } /* We're using IMG, so set its timestamp to `now'. */ @@ -1878,16 +1847,11 @@ mark_image_cache (struct image_cache *c) #endif /* HAVE_NTGUI */ -static int x_create_x_image_and_pixmap (struct frame *, int, int, int, - XImagePtr *, Pixmap *); -static void x_destroy_x_image (XImagePtr); -static void x_put_x_image (struct frame *, XImagePtr, Pixmap, int, int); - -/* Return nonzero if XIMG's size WIDTH x HEIGHT doesn't break the +/* Return true if XIMG's size WIDTH x HEIGHT doesn't break the windowing system. WIDTH and HEIGHT must both be positive. If XIMG is null, assume it is a bitmap. */ -static int +static bool x_check_image_size (XImagePtr ximg, int width, int height) { #ifdef HAVE_X_WINDOWS @@ -1926,12 +1890,12 @@ x_check_image_size (XImagePtr ximg, int width, int height) frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created. Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated via xmalloc. Print error messages via image_error if an error - occurs. Value is non-zero if successful. + occurs. Value is true if successful. On W32, a DEPTH of zero signifies a 24 bit image, otherwise DEPTH should indicate the bit depth of the image. */ -static int +static bool x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth, XImagePtr *ximg, Pixmap *pixmap) { @@ -1940,7 +1904,7 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth, Window window = FRAME_X_WINDOW (f); Screen *screen = FRAME_X_SCREEN (f); - eassert (interrupt_input_blocked); + eassert (input_blocked_p ()); if (depth <= 0) depth = DefaultDepthOfScreen (screen); @@ -2078,7 +2042,7 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth, static void x_destroy_x_image (XImagePtr ximg) { - eassert (interrupt_input_blocked); + eassert (input_blocked_p ()); if (ximg) { #ifdef HAVE_X_WINDOWS @@ -2107,7 +2071,7 @@ x_put_x_image (struct frame *f, XImagePtr ximg, Pixmap pixmap, int width, int he #ifdef HAVE_X_WINDOWS GC gc; - eassert (interrupt_input_blocked); + eassert (input_blocked_p ()); gc = XCreateGC (FRAME_X_DISPLAY (f), pixmap, 0, NULL); XPutImage (FRAME_X_DISPLAY (f), pixmap, gc, ximg, 0, 0, 0, 0, width, height); XFreeGC (FRAME_X_DISPLAY (f), gc); @@ -2203,15 +2167,9 @@ slurp_file (char *file, ptrdiff_t *size) XBM images ***********************************************************************/ -static int xbm_scan (unsigned char **, unsigned char *, char *, int *); -static int xbm_load (struct frame *f, struct image *img); -static int xbm_load_image (struct frame *f, struct image *img, - unsigned char *, unsigned char *); -static int xbm_image_p (Lisp_Object object); -static int xbm_read_bitmap_data (struct frame *f, - unsigned char *, unsigned char *, - int *, int *, char **, int); -static int xbm_file_p (Lisp_Object); +static bool xbm_load (struct frame *f, struct image *img); +static bool xbm_image_p (Lisp_Object object); +static bool xbm_file_p (Lisp_Object); /* Indices of image specification fields in xbm_format, below. */ @@ -2275,10 +2233,10 @@ enum xbm_token }; -/* Return non-zero if OBJECT is a valid XBM-type image specification. +/* Return true if OBJECT is a valid XBM-type image specification. A valid specification is a list starting with the symbol `image' The rest of the list is a property list which must contain an - entry `:type xbm.. + entry `:type xbm'. If the specification specifies a file to load, it must contain an entry `:file FILENAME' where FILENAME is a string. @@ -2304,7 +2262,7 @@ enum xbm_token foreground and background of the frame on which the image is displayed is used. */ -static int +static bool xbm_image_p (Lisp_Object object) { struct image_keyword kw[XBM_LAST]; @@ -2562,7 +2520,7 @@ convert_mono_to_color_image (struct frame *f, struct image *img, static void Create_Pixmap_From_Bitmap_Data (struct frame *f, struct image *img, char *data, RGB_PIXEL_COLOR fg, RGB_PIXEL_COLOR bg, - int non_default_colors) + bool non_default_colors) { #ifdef HAVE_NTGUI img->pixmap @@ -2594,20 +2552,20 @@ Create_Pixmap_From_Bitmap_Data (struct frame *f, struct image *img, char *data, X versions. CONTENTS is a pointer to a buffer to parse; END is the buffer's end. Set *WIDTH and *HEIGHT to the width and height of the image. Return in *DATA the bitmap data allocated with xmalloc. - Value is non-zero if successful. DATA null means just test if - CONTENTS looks like an in-memory XBM file. If INHIBIT_IMAGE_ERROR - is non-zero, inhibit the call to image_error when the image size is - invalid (the bitmap remains unread). */ + Value is true if successful. DATA null means just test if + CONTENTS looks like an in-memory XBM file. If INHIBIT_IMAGE_ERROR, + inhibit the call to image_error when the image size is invalid (the + bitmap remains unread). */ -static int +static bool xbm_read_bitmap_data (struct frame *f, unsigned char *contents, unsigned char *end, int *width, int *height, char **data, - int inhibit_image_error) + bool inhibit_image_error) { unsigned char *s = contents; char buffer[BUFSIZ]; - int padding_p = 0; - int v10 = 0; + bool padding_p = 0; + bool v10 = 0; int bytes_per_line, i, nbytes; char *p; int value; @@ -2754,16 +2712,16 @@ xbm_read_bitmap_data (struct frame *f, unsigned char *contents, unsigned char *e /* Load XBM image IMG which will be displayed on frame F from buffer - CONTENTS. END is the end of the buffer. Value is non-zero if + CONTENTS. END is the end of the buffer. Value is true if successful. */ -static int +static bool xbm_load_image (struct frame *f, struct image *img, unsigned char *contents, unsigned char *end) { - int rc; + bool rc; char *data; - int success_p = 0; + bool success_p = 0; rc = xbm_read_bitmap_data (f, contents, end, &img->width, &img->height, &data, 0); @@ -2771,7 +2729,7 @@ xbm_load_image (struct frame *f, struct image *img, unsigned char *contents, { unsigned long foreground = FRAME_FOREGROUND_PIXEL (f); unsigned long background = FRAME_BACKGROUND_PIXEL (f); - int non_default_colors = 0; + bool non_default_colors = 0; Lisp_Object value; eassert (img->width > 0 && img->height > 0); @@ -2812,9 +2770,9 @@ xbm_load_image (struct frame *f, struct image *img, unsigned char *contents, } -/* Value is non-zero if DATA looks like an in-memory XBM file. */ +/* Value is true if DATA looks like an in-memory XBM file. */ -static int +static bool xbm_file_p (Lisp_Object data) { int w, h; @@ -2826,12 +2784,12 @@ xbm_file_p (Lisp_Object data) /* Fill image IMG which is used on frame F with pixmap data. Value is - non-zero if successful. */ + true if successful. */ -static int +static bool xbm_load (struct frame *f, struct image *img) { - int success_p = 0; + bool success_p = 0; Lisp_Object file_name; eassert (xbm_image_p (img->spec)); @@ -2867,10 +2825,10 @@ xbm_load (struct frame *f, struct image *img) Lisp_Object data; unsigned long foreground = FRAME_FOREGROUND_PIXEL (f); unsigned long background = FRAME_BACKGROUND_PIXEL (f); - int non_default_colors = 0; + bool non_default_colors = 0; char *bits; - int parsed_p; - int in_memory_file_p = 0; + bool parsed_p; + bool in_memory_file_p = 0; /* See if data looks like an in-memory XBM file. */ data = image_spec_value (img->spec, QCdata, NULL); @@ -2879,7 +2837,6 @@ xbm_load (struct frame *f, struct image *img) /* Parse the image specification. */ memcpy (fmt, xbm_format, sizeof fmt); parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm); - (void) parsed_p; eassert (parsed_p); /* Get specified width, and height. */ @@ -2984,9 +2941,8 @@ xbm_load (struct frame *f, struct image *img) #if defined (HAVE_XPM) || defined (HAVE_NS) -static int xpm_image_p (Lisp_Object object); -static int xpm_load (struct frame *f, struct image *img); -static int xpm_valid_color_symbols_p (Lisp_Object); +static bool xpm_image_p (Lisp_Object object); +static bool xpm_load (struct frame *f, struct image *img); #endif /* HAVE_XPM || HAVE_NS */ @@ -3053,7 +3009,7 @@ static const struct image_keyword xpm_format[XPM_LAST] = }; #ifdef HAVE_NTGUI -static int init_xpm_functions (Lisp_Object); +static bool init_xpm_functions (void); #else #define init_xpm_functions NULL #endif @@ -3084,10 +3040,6 @@ static struct image_type xpm_type = #ifdef ALLOC_XPM_COLORS -static void xpm_init_color_cache (struct frame *, XpmAttributes *); -static void xpm_free_color_cache (void); -static int xpm_lookup_color (struct frame *, char *, XColor *); -static int xpm_color_bucket (char *); static struct xpm_cached_color *xpm_cache_color (struct frame *, char *, XColor *, int); @@ -3194,10 +3146,10 @@ xpm_cache_color (struct frame *f, char *color_name, XColor *color, int bucket) /* Look up color COLOR_NAME for frame F in the color cache. If found, return the cached definition in *COLOR. Otherwise, make a new - entry in the cache and allocate the color. Value is zero if color + entry in the cache and allocate the color. Value is false if color allocation failed. */ -static int +static bool xpm_lookup_color (struct frame *f, char *color_name, XColor *color) { struct xpm_cached_color *p; @@ -3266,12 +3218,12 @@ DEF_IMGLIB_FN (int, XpmReadFileToImage, (Display *, char *, xpm_XImage **, xpm_XImage **, XpmAttributes *)); DEF_IMGLIB_FN (void, XImageFree, (xpm_XImage *)); -static int -init_xpm_functions (Lisp_Object libraries) +static bool +init_xpm_functions (void) { HMODULE library; - if (!(library = w32_delayed_load (libraries, Qxpm))) + if (!(library = w32_delayed_load (Qxpm))) return 0; LOAD_IMGLIB_FN (library, XpmFreeAttributes); @@ -3284,11 +3236,11 @@ init_xpm_functions (Lisp_Object libraries) #endif /* HAVE_NTGUI */ -/* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list +/* Value is true if COLOR_SYMBOLS is a valid color symbols list for XPM images. Such a list must consist of conses whose car and cdr are strings. */ -static int +static bool xpm_valid_color_symbols_p (Lisp_Object color_symbols) { while (CONSP (color_symbols)) @@ -3305,9 +3257,9 @@ xpm_valid_color_symbols_p (Lisp_Object color_symbols) } -/* Value is non-zero if OBJECT is a valid XPM image specification. */ +/* Value is true if OBJECT is a valid XPM image specification. */ -static int +static bool xpm_image_p (Lisp_Object object) { struct image_keyword fmt[XPM_LAST]; @@ -3364,11 +3316,11 @@ x_create_bitmap_from_xpm_data (struct frame *f, const char **bits) #endif /* defined (HAVE_XPM) && defined (HAVE_X_WINDOWS) */ /* Load image IMG which will be displayed on frame F. Value is - non-zero if successful. */ + true if successful. */ #ifdef HAVE_XPM -static int +static bool xpm_load (struct frame *f, struct image *img) { int rc; @@ -3822,7 +3774,7 @@ xpm_str_to_color_key (const char *s) return -1; } -static int +static bool xpm_load_image (struct frame *f, struct image *img, const unsigned char *contents, @@ -3837,7 +3789,8 @@ xpm_load_image (struct frame *f, void (*put_color_table) (Lisp_Object, const unsigned char *, int, Lisp_Object); Lisp_Object (*get_color_table) (Lisp_Object, const unsigned char *, int); Lisp_Object frame, color_symbols, color_table; - int best_key, have_mask = 0; + int best_key; + bool have_mask = 0; XImagePtr ximg = NULL, mask_img = NULL; #define match() \ @@ -4057,11 +4010,11 @@ xpm_load_image (struct frame *f, #undef expect_ident } -static int +static bool xpm_load (struct frame *f, struct image *img) { - int success_p = 0; + bool success_p = 0; Lisp_Object file_name; /* If IMG->spec specifies a file name, create a non-file spec from it. */ @@ -4232,7 +4185,7 @@ lookup_rgb_color (struct frame *f, int r, int g, int b) #ifdef HAVE_X_WINDOWS XColor color; Colormap cmap; - int rc; + bool rc; #else COLORREF color; #endif @@ -4300,7 +4253,7 @@ lookup_pixel_color (struct frame *f, unsigned long pixel) { XColor color; Colormap cmap; - int rc; + bool rc; if (ct_colors_allocated_max <= ct_colors_allocated) return FRAME_FOREGROUND_PIXEL (f); @@ -4311,12 +4264,12 @@ lookup_pixel_color (struct frame *f, unsigned long pixel) x_query_color (f, &color); rc = x_alloc_nearest_color (f, cmap, &color); #else - BLOCK_INPUT; + block_input (); cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f)); color.pixel = pixel; XQueryColor (NULL, cmap, &color); rc = x_alloc_nearest_color (f, cmap, &color); - UNBLOCK_INPUT; + unblock_input (); #endif /* HAVE_X_WINDOWS */ if (rc) @@ -4394,14 +4347,6 @@ init_color_table (void) Algorithms ***********************************************************************/ -static XColor *x_to_xcolors (struct frame *, struct image *, int); -static void x_from_xcolors (struct frame *, struct image *, XColor *); -static void x_detect_edges (struct frame *, struct image *, int[9], int); - -#ifdef HAVE_NTGUI -static void XPutPixel (XImagePtr , int, int, COLORREF); -#endif /* HAVE_NTGUI */ - /* Edge detection matrices for different edge-detection strategies. */ @@ -4427,12 +4372,12 @@ static int laplace_matrix[9] = { /* On frame F, return an array of XColor structures describing image IMG->pixmap. Each XColor structure has its pixel color set. RGB_P - non-zero means also fill the red/green/blue members of the XColor + means also fill the red/green/blue members of the XColor structures. Value is a pointer to the array of XColors structures, allocated with xmalloc; it must be freed by the caller. */ static XColor * -x_to_xcolors (struct frame *f, struct image *img, int rgb_p) +x_to_xcolors (struct frame *f, struct image *img, bool rgb_p) { int x, y; XColor *colors, *p; @@ -4808,9 +4753,9 @@ x_disable_image (struct frame *f, struct image *img) determine the background color of IMG. If it is a list '(R G B)', with R, G, and B being integers >= 0, take that as the color of the background. Otherwise, determine the background color of IMG - heuristically. Value is non-zero if successful. */ + heuristically. */ -static int +static void x_build_heuristic_mask (struct frame *f, struct image *img, Lisp_Object how) { XImagePtr_or_DC ximg; @@ -4822,7 +4767,8 @@ x_build_heuristic_mask (struct frame *f, struct image *img, Lisp_Object how) char *mask_img; int row_width; #endif /* HAVE_NTGUI */ - int x, y, rc, use_img_background; + int x, y; + bool rc, use_img_background; unsigned long bg = 0; if (img->mask) @@ -4838,7 +4784,7 @@ x_build_heuristic_mask (struct frame *f, struct image *img, Lisp_Object how) rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1, &mask_img, &img->mask); if (!rc) - return 0; + return; #endif /* !HAVE_NS */ /* Get the X image of IMG->pixmap. */ @@ -4928,8 +4874,6 @@ x_build_heuristic_mask (struct frame *f, struct image *img, Lisp_Object how) #endif /* HAVE_NTGUI */ Destroy_Image (ximg, prev); - - return 1; } @@ -4937,9 +4881,8 @@ x_build_heuristic_mask (struct frame *f, struct image *img, Lisp_Object how) PBM (mono, gray, color) ***********************************************************************/ -static int pbm_image_p (Lisp_Object object); -static int pbm_load (struct frame *f, struct image *img); -static int pbm_scan_number (unsigned char **, unsigned char *); +static bool pbm_image_p (Lisp_Object object); +static bool pbm_load (struct frame *f, struct image *img); /* The symbol `pbm' identifying images of this type. */ @@ -4994,9 +4937,9 @@ static struct image_type pbm_type = }; -/* Return non-zero if OBJECT is a valid PBM image specification. */ +/* Return true if OBJECT is a valid PBM image specification. */ -static int +static bool pbm_image_p (Lisp_Object object) { struct image_keyword fmt[PBM_LAST]; @@ -5089,10 +5032,11 @@ pbm_read_file (Lisp_Object file, int *size) /* Load PBM image IMG for use on frame F. */ -static int +static bool pbm_load (struct frame *f, struct image *img) { - int raw_p, x, y; + bool raw_p; + int x, y; int width, height, max_color_idx = 0; XImagePtr ximg; Lisp_Object file, specified_file; @@ -5355,8 +5299,8 @@ pbm_load (struct frame *f, struct image *img) /* Function prototypes. */ -static int png_image_p (Lisp_Object object); -static int png_load (struct frame *f, struct image *img); +static bool png_image_p (Lisp_Object object); +static bool png_load (struct frame *f, struct image *img); /* The symbol `png' identifying images of this type. */ @@ -5397,7 +5341,7 @@ static const struct image_keyword png_format[PNG_LAST] = }; #ifdef HAVE_NTGUI -static int init_png_functions (Lisp_Object); +static bool init_png_functions (void); #else #define init_png_functions NULL #endif @@ -5414,9 +5358,9 @@ static struct image_type png_type = NULL }; -/* Return non-zero if OBJECT is a valid PNG image specification. */ +/* Return true if OBJECT is a valid PNG image specification. */ -static int +static bool png_image_p (Lisp_Object object) { struct image_keyword fmt[PNG_LAST]; @@ -5468,12 +5412,12 @@ DEF_IMGLIB_FN (void, png_longjmp, (png_structp, int)); DEF_IMGLIB_FN (jmp_buf *, png_set_longjmp_fn, (png_structp, png_longjmp_ptr, size_t)); #endif /* libpng version >= 1.5 */ -static int -init_png_functions (Lisp_Object libraries) +static bool +init_png_functions (void) { HMODULE library; - if (!(library = w32_delayed_load (libraries, Qpng))) + if (!(library = w32_delayed_load (Qpng))) return 0; LOAD_IMGLIB_FN (library, png_get_io_ptr); @@ -5619,7 +5563,7 @@ png_read_from_file (png_structp png_ptr, png_bytep data, png_size_t length) } -/* Load PNG image IMG for use on frame F. Value is non-zero if +/* Load PNG image IMG for use on frame F. Value is true if successful. */ struct png_load_context @@ -5633,7 +5577,7 @@ struct png_load_context png_byte **rows; }; -static int +static bool png_load_body (struct frame *f, struct image *img, struct png_load_context *c) { Lisp_Object file, specified_file; @@ -5651,7 +5595,7 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c) int bit_depth, color_type, interlace_type; png_byte channels; png_uint_32 row_bytes; - int transparent_p; + bool transparent_p; struct png_memory_storage tbr; /* Data to be read */ /* Find out what file to load. */ @@ -5984,7 +5928,7 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c) return 1; } -static int +static bool png_load (struct frame *f, struct image *img) { struct png_load_context c; @@ -5994,7 +5938,7 @@ png_load (struct frame *f, struct image *img) #else /* HAVE_PNG */ #ifdef HAVE_NS -static int +static bool png_load (struct frame *f, struct image *img) { return ns_load_image (f, img, @@ -6014,8 +5958,8 @@ png_load (struct frame *f, struct image *img) #if defined (HAVE_JPEG) || defined (HAVE_NS) -static int jpeg_image_p (Lisp_Object object); -static int jpeg_load (struct frame *f, struct image *img); +static bool jpeg_image_p (Lisp_Object object); +static bool jpeg_load (struct frame *f, struct image *img); /* The symbol `jpeg' identifying images of this type. */ @@ -6056,7 +6000,7 @@ static const struct image_keyword jpeg_format[JPEG_LAST] = }; #ifdef HAVE_NTGUI -static int init_jpeg_functions (Lisp_Object); +static bool init_jpeg_functions (void); #else #define init_jpeg_functions NULL #endif @@ -6073,9 +6017,9 @@ static struct image_type jpeg_type = NULL }; -/* Return non-zero if OBJECT is a valid JPEG image specification. */ +/* Return true if OBJECT is a valid JPEG image specification. */ -static int +static bool jpeg_image_p (Lisp_Object object) { struct image_keyword fmt[JPEG_LAST]; @@ -6124,12 +6068,12 @@ DEF_IMGLIB_FN (JDIMENSION, jpeg_read_scanlines, (j_decompress_ptr, JSAMPARRAY, J DEF_IMGLIB_FN (struct jpeg_error_mgr *, jpeg_std_error, (struct jpeg_error_mgr *)); DEF_IMGLIB_FN (boolean, jpeg_resync_to_restart, (j_decompress_ptr, int)); -static int -init_jpeg_functions (Lisp_Object libraries) +static bool +init_jpeg_functions (void) { HMODULE library; - if (!(library = w32_delayed_load (libraries, Qjpeg))) + if (!(library = w32_delayed_load (Qjpeg))) return 0; LOAD_IMGLIB_FN (library, jpeg_finish_decompress); @@ -6394,7 +6338,7 @@ jpeg_file_src (j_decompress_ptr cinfo, FILE *fp) /* Load image IMG for use on frame F. Patterned after example.c from the JPEG lib. */ -static int +static bool jpeg_load_body (struct frame *f, struct image *img, struct my_jpeg_error_mgr *mgr) { @@ -6575,7 +6519,7 @@ jpeg_load_body (struct frame *f, struct image *img, return 1; } -static int +static bool jpeg_load (struct frame *f, struct image *img) { struct my_jpeg_error_mgr mgr; @@ -6585,7 +6529,7 @@ jpeg_load (struct frame *f, struct image *img) #else /* HAVE_JPEG */ #ifdef HAVE_NS -static int +static bool jpeg_load (struct frame *f, struct image *img) { return ns_load_image (f, img, @@ -6604,8 +6548,8 @@ jpeg_load (struct frame *f, struct image *img) #if defined (HAVE_TIFF) || defined (HAVE_NS) -static int tiff_image_p (Lisp_Object object); -static int tiff_load (struct frame *f, struct image *img); +static bool tiff_image_p (Lisp_Object object); +static bool tiff_load (struct frame *f, struct image *img); /* The symbol `tiff' identifying images of this type. */ @@ -6648,7 +6592,7 @@ static const struct image_keyword tiff_format[TIFF_LAST] = }; #ifdef HAVE_NTGUI -static int init_tiff_functions (Lisp_Object); +static bool init_tiff_functions (void); #else #define init_tiff_functions NULL #endif @@ -6665,9 +6609,9 @@ static struct image_type tiff_type = NULL }; -/* Return non-zero if OBJECT is a valid TIFF image specification. */ +/* Return true if OBJECT is a valid TIFF image specification. */ -static int +static bool tiff_image_p (Lisp_Object object) { struct image_keyword fmt[TIFF_LAST]; @@ -6701,12 +6645,12 @@ DEF_IMGLIB_FN (int, TIFFReadRGBAImage, (TIFF *, uint32, uint32, uint32 *, int)); DEF_IMGLIB_FN (void, TIFFClose, (TIFF *)); DEF_IMGLIB_FN (int, TIFFSetDirectory, (TIFF *, tdir_t)); -static int -init_tiff_functions (Lisp_Object libraries) +static bool +init_tiff_functions (void) { HMODULE library; - if (!(library = w32_delayed_load (libraries, Qtiff))) + if (!(library = w32_delayed_load (Qtiff))) return 0; LOAD_IMGLIB_FN (library, TIFFSetErrorHandler); @@ -6871,10 +6815,10 @@ tiff_warning_handler (const char *title, const char *format, va_list ap) } -/* Load TIFF image IMG for use on frame F. Value is non-zero if +/* Load TIFF image IMG for use on frame F. Value is true if successful. */ -static int +static bool tiff_load (struct frame *f, struct image *img) { Lisp_Object file, specified_file; @@ -7039,7 +6983,7 @@ tiff_load (struct frame *f, struct image *img) #else /* HAVE_TIFF */ #ifdef HAVE_NS -static int +static bool tiff_load (struct frame *f, struct image *img) { return ns_load_image (f, img, @@ -7058,8 +7002,8 @@ tiff_load (struct frame *f, struct image *img) #if defined (HAVE_GIF) || defined (HAVE_NS) -static int gif_image_p (Lisp_Object object); -static int gif_load (struct frame *f, struct image *img); +static bool gif_image_p (Lisp_Object object); +static bool gif_load (struct frame *f, struct image *img); static void gif_clear_image (struct frame *f, struct image *img); /* The symbol `gif' identifying images of this type. */ @@ -7103,7 +7047,7 @@ static const struct image_keyword gif_format[GIF_LAST] = }; #ifdef HAVE_NTGUI -static int init_gif_functions (Lisp_Object); +static bool init_gif_functions (void); #else #define init_gif_functions NULL #endif @@ -7129,9 +7073,9 @@ gif_clear_image (struct frame *f, struct image *img) x_clear_image (f, img); } -/* Return non-zero if OBJECT is a valid GIF image specification. */ +/* Return true if OBJECT is a valid GIF image specification. */ -static int +static bool gif_image_p (Lisp_Object object) { struct image_keyword fmt[GIF_LAST]; @@ -7174,12 +7118,12 @@ DEF_IMGLIB_FN (int, DGifSlurp, (GifFileType *)); DEF_IMGLIB_FN (GifFileType *, DGifOpen, (void *, InputFunc)); DEF_IMGLIB_FN (GifFileType *, DGifOpenFileName, (const char *)); -static int -init_gif_functions (Lisp_Object libraries) +static bool +init_gif_functions (void) { HMODULE library; - if (!(library = w32_delayed_load (libraries, Qgif))) + if (!(library = w32_delayed_load (Qgif))) return 0; LOAD_IMGLIB_FN (library, DGifCloseFile); @@ -7228,7 +7172,7 @@ gif_read_from_memory (GifFileType *file, GifByteType *buf, int len) } -/* Load GIF image IMG for use on frame F. Value is non-zero if +/* Load GIF image IMG for use on frame F. Value is true if successful. */ static const int interlace_start[] = {0, 4, 2, 1}; @@ -7236,7 +7180,7 @@ static const int interlace_increment[] = {8, 8, 4, 2}; #define GIF_LOCAL_DESCRIPTOR_EXTENSION 249 -static int +static bool gif_load (struct frame *f, struct image *img) { Lisp_Object file; @@ -7534,7 +7478,7 @@ gif_load (struct frame *f, struct image *img) #else /* !HAVE_GIF */ #ifdef HAVE_NS -static int +static bool gif_load (struct frame *f, struct image *img) { return ns_load_image (f, img, @@ -7553,8 +7497,8 @@ gif_load (struct frame *f, struct image *img) static Lisp_Object Qimagemagick; -static int imagemagick_image_p (Lisp_Object); -static int imagemagick_load (struct frame *, struct image *); +static bool imagemagick_image_p (Lisp_Object); +static bool imagemagick_load (struct frame *, struct image *); static void imagemagick_clear_image (struct frame *, struct image *); /* Indices of image specification fields in imagemagick_format. */ @@ -7600,7 +7544,7 @@ static struct image_keyword imagemagick_format[IMAGEMAGICK_LAST] = }; #ifdef HAVE_NTGUI -static int init_imagemagick_functions (Lisp_Object); +static bool init_imagemagick_functions (void); #else #define init_imagemagick_functions NULL #endif @@ -7627,11 +7571,11 @@ imagemagick_clear_image (struct frame *f, x_clear_image (f, img); } -/* Return non-zero if OBJECT is a valid IMAGEMAGICK image specification. Do +/* Return true if OBJECT is a valid IMAGEMAGICK image specification. Do this by calling parse_image_spec and supplying the keywords that identify the IMAGEMAGICK format. */ -static int +static bool imagemagick_image_p (Lisp_Object object) { struct image_keyword fmt[IMAGEMAGICK_LAST]; @@ -7683,9 +7627,9 @@ imagemagick_error (MagickWand *wand) be parsed; SIZE is the number of bytes of data; and FILENAME is either the file name or the image data. - Return non-zero if successful. */ + Return true if successful. */ -static int +static bool imagemagick_load_image (struct frame *f, struct image *img, unsigned char *contents, unsigned int size, char *filename) @@ -8023,14 +7967,14 @@ imagemagick_load_image (struct frame *f, struct image *img, } -/* Load IMAGEMAGICK image IMG for use on frame F. Value is non-zero if +/* Load IMAGEMAGICK image IMG for use on frame F. Value is true if successful. this function will go into the imagemagick_type structure, and the prototype thus needs to be compatible with that structure. */ -static int +static bool imagemagick_load (struct frame *f, struct image *img) { - int success_p = 0; + bool success_p = 0; Lisp_Object file_name; /* If IMG->spec specifies a file name, create a non-file spec from it. */ @@ -8109,11 +8053,11 @@ and `imagemagick-types-inhibit'. */) /* Function prototypes. */ -static int svg_image_p (Lisp_Object object); -static int svg_load (struct frame *f, struct image *img); +static bool svg_image_p (Lisp_Object object); +static bool svg_load (struct frame *f, struct image *img); -static int svg_load_image (struct frame *, struct image *, - unsigned char *, ptrdiff_t); +static bool svg_load_image (struct frame *, struct image *, + unsigned char *, ptrdiff_t); /* The symbol `svg' identifying images of this type. */ @@ -8154,7 +8098,7 @@ static const struct image_keyword svg_format[SVG_LAST] = }; #ifdef HAVE_NTGUI -static int init_svg_functions (Lisp_Object); +static bool init_svg_functions (void); #else #define init_svg_functions NULL #endif @@ -8174,11 +8118,11 @@ static struct image_type svg_type = }; -/* Return non-zero if OBJECT is a valid SVG image specification. Do +/* Return true if OBJECT is a valid SVG image specification. Do this by calling parse_image_spec and supplying the keywords that identify the SVG format. */ -static int +static bool svg_image_p (Lisp_Object object) { struct image_keyword fmt[SVG_LAST]; @@ -8217,15 +8161,15 @@ DEF_IMGLIB_FN (void, g_error_free); Lisp_Object Qgdk_pixbuf, Qglib, Qgobject; -static int -init_svg_functions (Lisp_Object libraries) +static bool +init_svg_functions (void) { HMODULE library, gdklib, glib, gobject; - if (!(glib = w32_delayed_load (libraries, Qglib)) - || !(gobject = w32_delayed_load (libraries, Qgobject)) - || !(gdklib = w32_delayed_load (libraries, Qgdk_pixbuf)) - || !(library = w32_delayed_load (libraries, Qsvg))) + if (!(glib = w32_delayed_load (Qglib)) + || !(gobject = w32_delayed_load (Qgobject)) + || !(gdklib = w32_delayed_load (Qgdk_pixbuf)) + || !(library = w32_delayed_load (Qsvg))) return 0; LOAD_IMGLIB_FN (library, rsvg_handle_new); @@ -8273,14 +8217,13 @@ init_svg_functions (Lisp_Object libraries) #define fn_g_error_free g_error_free #endif /* !HAVE_NTGUI */ -/* Load SVG image IMG for use on frame F. Value is non-zero if - successful. this function will go into the svg_type structure, and - the prototype thus needs to be compatible with that structure. */ +/* Load SVG image IMG for use on frame F. Value is true if + successful. */ -static int +static bool svg_load (struct frame *f, struct image *img) { - int success_p = 0; + bool success_p = 0; Lisp_Object file_name; /* If IMG->spec specifies a file name, create a non-file spec from it. */ @@ -8333,8 +8276,8 @@ svg_load (struct frame *f, struct image *img) Uses librsvg to do most of the image processing. - Returns non-zero when successful. */ -static int + Returns true when successful. */ +static bool svg_load_image (struct frame *f, /* Pointer to emacs frame structure. */ struct image *img, /* Pointer to emacs image structure. */ unsigned char *contents, /* String containing the SVG XML data to be parsed. */ @@ -8501,8 +8444,8 @@ svg_load_image (struct frame *f, /* Pointer to emacs frame structure. * #ifdef HAVE_GHOSTSCRIPT -static int gs_image_p (Lisp_Object object); -static int gs_load (struct frame *f, struct image *img); +static bool gs_image_p (Lisp_Object object); +static bool gs_load (struct frame *f, struct image *img); static void gs_clear_image (struct frame *f, struct image *img); /* Keyword symbols. */ @@ -8549,12 +8492,6 @@ static const struct image_keyword gs_format[GS_LAST] = {":background", IMAGE_STRING_OR_NIL_VALUE, 0} }; -#ifdef HAVE_NTGUI -static int init_gs_functions (Lisp_Object); -#else -#define init_gs_functions NULL -#endif - /* Structure describing the image type `ghostscript'. */ static struct image_type gs_type = @@ -8563,7 +8500,7 @@ static struct image_type gs_type = gs_image_p, gs_load, gs_clear_image, - init_gs_functions, + NULL, NULL }; @@ -8577,10 +8514,10 @@ gs_clear_image (struct frame *f, struct image *img) } -/* Return non-zero if OBJECT is a valid Ghostscript image +/* Return true if OBJECT is a valid Ghostscript image specification. */ -static int +static bool gs_image_p (Lisp_Object object) { struct image_keyword fmt[GS_LAST]; @@ -8617,10 +8554,10 @@ gs_image_p (Lisp_Object object) } -/* Load Ghostscript image IMG for use on frame F. Value is non-zero +/* Load Ghostscript image IMG for use on frame F. Value is true if successful. */ -static int +static bool gs_load (struct frame *f, struct image *img) { uprintmax_t printnum1, printnum2; @@ -8656,11 +8593,11 @@ gs_load (struct frame *f, struct image *img) if (x_check_image_size (0, img->width, img->height)) { /* Only W32 version did BLOCK_INPUT here. ++kfs */ - BLOCK_INPUT; + block_input (); img->pixmap = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), img->width, img->height, DefaultDepthOfScreen (FRAME_X_SCREEN (f))); - UNBLOCK_INPUT; + unblock_input (); } if (!img->pixmap) @@ -8736,7 +8673,7 @@ x_kill_gs_process (Pixmap pixmap, struct frame *f) { XImagePtr ximg; - BLOCK_INPUT; + block_input (); /* Try to get an XImage for img->pixmep. */ ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap, @@ -8779,15 +8716,15 @@ x_kill_gs_process (Pixmap pixmap, struct frame *f) image_error ("Cannot get X image of `%s'; colors will not be freed", img->spec, Qnil); - UNBLOCK_INPUT; + unblock_input (); } #endif /* HAVE_X_WINDOWS */ /* Now that we have the pixmap, compute mask and transform the image if requested. */ - BLOCK_INPUT; + block_input (); postprocess_image (f, img); - UNBLOCK_INPUT; + unblock_input (); } #endif /* HAVE_GHOSTSCRIPT */ @@ -8826,88 +8763,92 @@ DEFUN ("lookup-image", Flookup_image, Slookup_image, 1, 1, 0, "") Initialization ***********************************************************************/ -DEFUN ("init-image-library", Finit_image_library, Sinit_image_library, 2, 2, 0, +DEFUN ("init-image-library", Finit_image_library, Sinit_image_library, 1, 1, 0, doc: /* Initialize image library implementing image type TYPE. Return non-nil if TYPE is a supported image type. -Image types pbm and xbm are prebuilt; other types are loaded here. -Libraries to load are specified in alist LIBRARIES (usually, the value -of `dynamic-library-alist', which see). */) - (Lisp_Object type, Lisp_Object libraries) +If image libraries are loaded dynamically (currently only the case on +MS-Windows), load the library for TYPE if it is not yet loaded, using +the library file(s) specified by `dynamic-library-alist'. */) + (Lisp_Object type) { - return lookup_image_type (type, libraries) ? Qt : Qnil; + return lookup_image_type (type) ? Qt : Qnil; } /* Look up image type TYPE, and return a pointer to its image_type - structure. Return 0 if TYPE is not a known image type. - - LIBRARIES is an alist associating dynamic libraries to external - files implementing them, which is passed to the image library - initialization function if necessary. A nil value defaults to - Vdynamic_library_alist. */ + structure. Return 0 if TYPE is not a known image type. */ static struct image_type * -lookup_image_type (Lisp_Object type, Lisp_Object libraries) +lookup_image_type (Lisp_Object type) { - if (NILP (libraries)) - libraries = Vdynamic_library_alist; - /* Types pbm and xbm are built-in and always available. */ if (EQ (type, Qpbm)) - return define_image_type (&pbm_type, libraries); + return define_image_type (&pbm_type); if (EQ (type, Qxbm)) - return define_image_type (&xbm_type, libraries); + return define_image_type (&xbm_type); #if defined (HAVE_XPM) || defined (HAVE_NS) if (EQ (type, Qxpm)) - return define_image_type (&xpm_type, libraries); + return define_image_type (&xpm_type); #endif #if defined (HAVE_JPEG) || defined (HAVE_NS) if (EQ (type, Qjpeg)) - return define_image_type (&jpeg_type, libraries); + return define_image_type (&jpeg_type); #endif #if defined (HAVE_TIFF) || defined (HAVE_NS) if (EQ (type, Qtiff)) - return define_image_type (&tiff_type, libraries); + return define_image_type (&tiff_type); #endif #if defined (HAVE_GIF) || defined (HAVE_NS) if (EQ (type, Qgif)) - return define_image_type (&gif_type, libraries); + return define_image_type (&gif_type); #endif #if defined (HAVE_PNG) || defined (HAVE_NS) if (EQ (type, Qpng)) - return define_image_type (&png_type, libraries); + return define_image_type (&png_type); #endif #if defined (HAVE_RSVG) if (EQ (type, Qsvg)) - return define_image_type (&svg_type, libraries); + return define_image_type (&svg_type); #endif #if defined (HAVE_IMAGEMAGICK) if (EQ (type, Qimagemagick)) - return define_image_type (&imagemagick_type, libraries); + return define_image_type (&imagemagick_type); #endif #ifdef HAVE_GHOSTSCRIPT if (EQ (type, Qpostscript)) - return define_image_type (&gs_type, libraries); + return define_image_type (&gs_type); #endif return NULL; } +/* Reset image_types before dumping. + Called from Fdump_emacs. */ + +void +reset_image_types (void) +{ + while (image_types) + { + struct image_type *next = image_types->next; + xfree (image_types); + image_types = next; + } +} + void syms_of_image (void) { - /* Initialize this only once, since that's what we do with Vimage_types - and they are supposed to be in sync. Initializing here gives correct - operation on GNU/Linux of calling dump-emacs after loading some images. */ + /* Initialize this only once; it will be reset before dumping. */ image_types = NULL; /* Must be defined now because we're going to update it below, while diff --git a/src/indent.c b/src/indent.c index 053643e6319..b368a7aeb09 100644 --- a/src/indent.c +++ b/src/indent.c @@ -115,7 +115,7 @@ character_width (int c, struct Lisp_Char_Table *dp) for characters as WIDTHTAB. We use this to decide when to invalidate the buffer's width_run_cache. */ -int +bool disptab_matches_widthtab (struct Lisp_Char_Table *disptab, struct Lisp_Vector *widthtab) { int i; @@ -320,14 +320,14 @@ invalidate_current_column (void) ptrdiff_t current_column (void) { - register ptrdiff_t col; - register unsigned char *ptr, *stop; - register int tab_seen; + ptrdiff_t col; + unsigned char *ptr, *stop; + bool tab_seen; ptrdiff_t post_tab; - register int c; + int c; int tab_width = SANE_TAB_WIDTH (current_buffer); - int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow)); - register struct Lisp_Char_Table *dp = buffer_display_table (); + bool ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow)); + struct Lisp_Char_Table *dp = buffer_display_table (); if (PT == last_known_column_point && MODIFF == last_known_column_modified) @@ -512,9 +512,9 @@ static void scan_for_column (ptrdiff_t *endpos, EMACS_INT *goalcol, ptrdiff_t *prevcol) { int tab_width = SANE_TAB_WIDTH (current_buffer); - register int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow)); - register struct Lisp_Char_Table *dp = buffer_display_table (); - int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); + bool ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow)); + struct Lisp_Char_Table *dp = buffer_display_table (); + bool multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); struct composition_it cmp_it; Lisp_Object window; struct window *w; @@ -722,14 +722,14 @@ current_column_1 (void) static double string_display_width (Lisp_Object string, Lisp_Object beg, Lisp_Object end) { - register int col; - register unsigned char *ptr, *stop; - register int tab_seen; + int col; + unsigned char *ptr, *stop; + bool tab_seen; int post_tab; - register int c; + int c; int tab_width = SANE_TAB_WIDTH (current_buffer); - int ctl_arrow = !NILP (current_buffer->ctl_arrow); - register struct Lisp_Char_Table *dp = buffer_display_table (); + bool ctl_arrow = !NILP (current_buffer->ctl_arrow); + struct Lisp_Char_Table *dp = buffer_display_table (); int b, e; if (NILP (end)) @@ -945,7 +945,7 @@ position_indentation (ptrdiff_t pos_byte) Blank lines are treated as if they had the same indentation as the preceding line. */ -int +bool indented_beyond_p (ptrdiff_t pos, ptrdiff_t pos_byte, EMACS_INT column) { ptrdiff_t val; @@ -1047,11 +1047,11 @@ static struct position val_compute_motion; can't hit the requested column exactly (because of a tab or other multi-column character), overshoot. - DID_MOTION is 1 if FROMHPOS has already accounted for overlay strings + DID_MOTION is true if FROMHPOS has already accounted for overlay strings at FROM. This is the case if FROMVPOS and FROMVPOS came from an earlier call to compute_motion. The other common case is that FROMHPOS is zero and FROM is a position that "belongs" at column zero, but might - be shifted by overlay strings; in this case DID_MOTION should be 0. + be shifted by overlay strings; in this case DID_MOTION should be false. WIDTH is the number of columns available to display text; compute_motion uses this to handle continuation lines and such. @@ -1104,17 +1104,20 @@ static struct position val_compute_motion; the scroll bars if they are turned on. */ struct position * -compute_motion (ptrdiff_t from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_motion, ptrdiff_t to, EMACS_INT tovpos, EMACS_INT tohpos, EMACS_INT width, ptrdiff_t hscroll, int tab_offset, struct window *win) +compute_motion (ptrdiff_t from, EMACS_INT fromvpos, EMACS_INT fromhpos, + bool did_motion, ptrdiff_t to, + EMACS_INT tovpos, EMACS_INT tohpos, EMACS_INT width, + ptrdiff_t hscroll, int tab_offset, struct window *win) { - register EMACS_INT hpos = fromhpos; - register EMACS_INT vpos = fromvpos; + EMACS_INT hpos = fromhpos; + EMACS_INT vpos = fromvpos; - register ptrdiff_t pos; + ptrdiff_t pos; ptrdiff_t pos_byte; - register int c = 0; + int c = 0; int tab_width = SANE_TAB_WIDTH (current_buffer); - register int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow)); - register struct Lisp_Char_Table *dp = window_display_table (win); + bool ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow)); + struct Lisp_Char_Table *dp = window_display_table (win); EMACS_INT selective = (INTEGERP (BVAR (current_buffer, selective_display)) ? XINT (BVAR (current_buffer, selective_display)) @@ -1139,7 +1142,7 @@ compute_motion (ptrdiff_t from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_ ptrdiff_t next_width_run = from; Lisp_Object window; - int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); + bool multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); /* If previous char scanned was a wide character, this is the column where it ended. Otherwise, this is 0. */ EMACS_INT wide_column_end_hpos = 0; @@ -1308,7 +1311,7 @@ compute_motion (ptrdiff_t from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_ if (hpos > width) { EMACS_INT total_width = width + continuation_glyph_width; - int truncate = 0; + bool truncate = 0; if (!NILP (Vtruncate_partial_width_windows) && (total_width < FRAME_COLS (XFRAME (WINDOW_FRAME (win))))) @@ -1827,7 +1830,7 @@ vmotion (register ptrdiff_t from, register EMACS_INT vtarget, struct window *w) PTRDIFF_MAX) : !NILP (BVAR (current_buffer, selective_display)) ? -1 : 0); Lisp_Object window; - int did_motion; + bool did_motion; /* This is the object we use for fetching character properties. */ Lisp_Object text_prop_object; @@ -2017,8 +2020,8 @@ whether or not it is currently displayed in some window. */) { ptrdiff_t it_start, it_overshoot_count = 0; int first_x; - int overshoot_handled = 0; - int disp_string_at_start_p = 0; + bool overshoot_handled = 0; + bool disp_string_at_start_p = 0; itdata = bidi_shelve_cache (); SET_TEXT_POS (pt, PT, PT_BYTE); diff --git a/src/indent.h b/src/indent.h index e198137a756..abcd06036d1 100644 --- a/src/indent.h +++ b/src/indent.h @@ -27,7 +27,7 @@ struct position }; struct position *compute_motion (ptrdiff_t from, EMACS_INT fromvpos, - EMACS_INT fromhpos, int did_motion, + EMACS_INT fromhpos, bool did_motion, ptrdiff_t to, EMACS_INT tovpos, EMACS_INT tohpos, EMACS_INT width, ptrdiff_t hscroll, @@ -45,8 +45,8 @@ extern ptrdiff_t last_known_column_point; /* Return true if the display table DISPTAB specifies the same widths for characters as WIDTHTAB. We use this to decide when to invalidate the buffer's column_cache. */ -int disptab_matches_widthtab (struct Lisp_Char_Table *disptab, - struct Lisp_Vector *widthtab); +bool disptab_matches_widthtab (struct Lisp_Char_Table *disptab, + struct Lisp_Vector *widthtab); /* Recompute BUF's width table, using the display table DISPTAB. */ void recompute_width_table (struct buffer *buf, diff --git a/src/keyboard.c b/src/keyboard.c index 8b1113a026a..f3d7df5e98f 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -19,6 +19,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <config.h> +#define BLOCKINPUT_INLINE EXTERN_INLINE #define KEYBOARD_INLINE EXTERN_INLINE #include <stdio.h> @@ -72,19 +73,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Variables for blockinput.h: */ -/* Non-zero if interrupt input is blocked right now. */ +/* Positive if interrupt input is blocked right now. */ volatile int interrupt_input_blocked; -/* Nonzero means an input interrupt has arrived - during the current critical section. */ -int interrupt_input_pending; - -/* This var should be (interrupt_input_pending || pending_atimers). - The QUIT macro checks this instead of interrupt_input_pending and - pending_atimers separately, to reduce code size. So, any code that - changes interrupt_input_pending or pending_atimers should update - this too. */ -int pending_signals; +/* Nonzero means an input interrupt or alarm signal has arrived. + The QUIT macro checks this. */ +volatile int pending_signals; #define KBD_BUFFER_SIZE 4096 @@ -225,7 +219,11 @@ static Lisp_Object last_point_position_window; last event came from a macro. We use this to determine when to generate switch-frame events. This may be cleared by functions like Fselect_frame, to make sure that a switch-frame event is - generated by the next character. */ + generated by the next character. + + FIXME: This is modified by a signal handler so it should be volatile. + It's exported to Lisp, though, so it can't simply be marked + 'volatile' here. */ Lisp_Object internal_last_event_frame; /* The timestamp of the last input event we received from the X server. @@ -389,7 +387,7 @@ int interrupts_deferred; /* If we support a window system, turn on the code to poll periodically to detect C-g. It isn't actually used when doing interrupt input. */ -#if defined (HAVE_WINDOW_SYSTEM) && !defined (USE_ASYNC_EVENTS) +#ifdef HAVE_WINDOW_SYSTEM #define POLL_FOR_INPUT #endif @@ -413,7 +411,6 @@ static EMACS_TIME timer_last_idleness_start_time; /* Function for init_keyboard to call with no args (if nonzero). */ static void (*keyboard_init_hook) (void); -static int read_avail_input (void); static void get_input_pending (int *, int); static int readable_events (int); static Lisp_Object read_char_x_menu_prompt (ptrdiff_t, Lisp_Object *, @@ -440,7 +437,7 @@ static Lisp_Object restore_kboard_configuration (Lisp_Object); #ifdef USABLE_SIGIO static void deliver_input_available_signal (int signo); #endif -static void handle_interrupt (void); +static void handle_interrupt (bool); static _Noreturn void quit_throw_to_read_char (int); static void process_special_events (void); static void timer_start_idle (void); @@ -823,7 +820,7 @@ This function is called by the editor initialization to begin editing. */) /* If we enter while input is blocked, don't lock up here. This may happen through the debugger during redisplay. */ - if (INPUT_BLOCKED_P) + if (input_blocked_p ()) return Qnil; command_loop_level++; @@ -1216,8 +1213,7 @@ This also exits all active minibuffers. */) /* Unblock input if we enter with input blocked. This may happen if redisplay traps e.g. during tool-bar update with input blocked. */ - while (INPUT_BLOCKED_P) - UNBLOCK_INPUT; + totally_unblock_input (); Fthrow (Qtop_level, Qnil); } @@ -1460,15 +1456,6 @@ command_loop_1 (void) } } -#if 0 - /* Select the frame that the last event came from. Usually, - switch-frame events will take care of this, but if some lisp - code swallows a switch-frame event, we'll fix things up here. - Is this a good idea? */ - if (FRAMEP (internal_last_event_frame) - && !EQ (internal_last_event_frame, selected_frame)) - Fselect_frame (internal_last_event_frame, Qnil); -#endif /* If it has changed current-menubar from previous value, really recompute the menubar from the value. */ if (! NILP (Vlucid_menu_bar_dirty_flag) @@ -2008,9 +1995,9 @@ static struct atimer *poll_timer; void poll_for_input_1 (void) { - if (interrupt_input_blocked == 0 + if (! input_blocked_p () && !waiting_for_input) - read_avail_input (); + gobble_input (); } /* Timer callback function for poll_timer. TIMER is equal to @@ -2020,10 +2007,7 @@ static void poll_for_input (struct atimer *timer) { if (poll_suppress_count == 0) - { - interrupt_input_pending = 1; - pending_signals = 1; - } + pending_signals = 1; } #endif /* POLL_FOR_INPUT */ @@ -3344,7 +3328,7 @@ record_char (Lisp_Object c) If you, dear reader, have a better idea, you've got the source. :-) */ if (dribble) { - BLOCK_INPUT; + block_input (); if (INTEGERP (c)) { if (XUINT (c) < 0x100) @@ -3370,7 +3354,7 @@ record_char (Lisp_Object c) } fflush (dribble); - UNBLOCK_INPUT; + unblock_input (); } } @@ -3514,10 +3498,8 @@ kbd_buffer_store_event (register struct input_event *event) Else, if EVENT is a quit event, store the quit event in HOLD_QUIT, and return (thus ignoring further events). - This is used in read_avail_input to postpone the processing - of the quit event until all subsequent input events have been - parsed (and discarded). - */ + This is used to postpone the processing of the quit event until all + subsequent input events have been parsed (and discarded). */ void kbd_buffer_store_event_hold (register struct input_event *event, @@ -3587,7 +3569,8 @@ kbd_buffer_store_event_hold (register struct input_event *event, } last_event_timestamp = event->timestamp; - handle_interrupt (); + + handle_interrupt (0); return; } @@ -3643,7 +3626,6 @@ kbd_buffer_store_event_hold (register struct input_event *event, if (immediate_quit && NILP (Vinhibit_quit)) { immediate_quit = 0; - pthread_sigmask (SIG_SETMASK, &empty_mask, 0); QUIT; } } @@ -3793,14 +3775,6 @@ kbd_buffer_get_event (KBOARD **kbp, /* Start reading input again, we have processed enough so we can accept new events again. */ unhold_keyboard_input (); -#ifdef USABLE_SIGIO - if (!noninteractive) - { - struct sigaction action; - emacs_sigaction_init (&action, deliver_input_available_signal); - sigaction (SIGIO, &action, 0); - } -#endif start_polling (); } #endif /* subprocesses */ @@ -3869,7 +3843,7 @@ kbd_buffer_get_event (KBOARD **kbp, wait_reading_process_output (0, 0, -1, 1, Qnil, NULL, 0); if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr) - read_avail_input (); + gobble_input (); } if (CONSP (Vunread_command_events)) @@ -4496,6 +4470,9 @@ timer_check (void) Lisp_Object timers, idle_timers; struct gcpro gcpro1, gcpro2; + Lisp_Object tem = Vinhibit_quit; + Vinhibit_quit = Qt; + /* We use copies of the timers' lists to allow a timer to add itself again, without locking up Emacs if the newly added timer is already ripe when added. */ @@ -4508,6 +4485,8 @@ timer_check (void) else idle_timers = Qnil; + Vinhibit_quit = tem; + GCPRO2 (timers, idle_timers); do @@ -6747,41 +6726,6 @@ get_input_pending (int *addr, int flags) *addr = (!NILP (Vquit_flag) || readable_events (flags)); } -/* Interface to read_avail_input, blocking SIGIO or SIGALRM if necessary. */ - -void -gobble_input (void) -{ -#ifdef USABLE_SIGIO - if (interrupt_input) - { - sigset_t blocked, procmask; - sigemptyset (&blocked); - sigaddset (&blocked, SIGIO); - pthread_sigmask (SIG_BLOCK, &blocked, &procmask); - read_avail_input (); - pthread_sigmask (SIG_SETMASK, &procmask, 0); - } - else -#ifdef POLL_FOR_INPUT - /* XXX This condition was (read_socket_hook && !interrupt_input), - but read_socket_hook is not global anymore. Let's pretend that - it's always set. */ - if (!interrupt_input && poll_suppress_count == 0) - { - sigset_t blocked, procmask; - sigemptyset (&blocked); - sigaddset (&blocked, SIGALRM); - pthread_sigmask (SIG_BLOCK, &blocked, &procmask); - read_avail_input (); - pthread_sigmask (SIG_SETMASK, &procmask, 0); - } - else -#endif -#endif - read_avail_input (); -} - /* Put a BUFFER_SWITCH_EVENT in the buffer so that read_key_sequence will notice the new current buffer. */ @@ -6809,14 +6753,7 @@ record_asynch_buffer_change (void) /* Make sure no interrupt happens while storing the event. */ #ifdef USABLE_SIGIO if (interrupt_input) - { - sigset_t blocked, procmask; - sigemptyset (&blocked); - sigaddset (&blocked, SIGIO); - pthread_sigmask (SIG_BLOCK, &blocked, &procmask); - kbd_buffer_store_event (&event); - pthread_sigmask (SIG_SETMASK, &procmask, 0); - } + kbd_buffer_store_event (&event); else #endif { @@ -6829,13 +6766,11 @@ record_asynch_buffer_change (void) /* Read any terminal input already buffered up by the system into the kbd_buffer, but do not wait. - EXPECTED should be nonzero if the caller knows there is some input. - - Returns the number of keyboard chars read, or -1 meaning + Return the number of keyboard chars read, or -1 meaning this is a bad time to try to read input. */ -static int -read_avail_input (void) +int +gobble_input (void) { int nread = 0; int err = 0; @@ -6855,11 +6790,17 @@ read_avail_input (void) int nr; struct input_event hold_quit; + if (input_blocked_p ()) + { + pending_signals = 1; + break; + } + EVENT_INIT (hold_quit); hold_quit.kind = NO_EVENT; /* No need for FIONREAD or fcntl; just say don't wait. */ - while (0 < (nr = (*t->read_socket_hook) (t, &hold_quit))) + while (0 < (nr = (*t->read_socket_hook) (t, &hold_quit))) nread += nr; if (nr == -1) /* Not OK to read input now. */ @@ -6880,7 +6821,7 @@ read_avail_input (void) this process rather than to the whole process group? Perhaps on systems with FIONREAD Emacs is alone in its group. */ - kill (getpid (), SIGHUP); + terminate_due_to_signal (SIGHUP, 10); /* XXX Is calling delete_terminal safe here? It calls delete_frame. */ { @@ -7169,34 +7110,68 @@ tty_read_avail_input (struct terminal *terminal, static void handle_async_input (void) { - interrupt_input_pending = 0; - pending_signals = pending_atimers; - +#ifdef USABLE_SIGIO while (1) { - int nread = read_avail_input (); + int nread = gobble_input (); /* -1 means it's not ok to read the input now. UNBLOCK_INPUT will read it later; now, avoid infinite loop. 0 means there was no keyboard input available. */ if (nread <= 0) break; } +#endif } void process_pending_signals (void) { - if (interrupt_input_pending) - handle_async_input (); + pending_signals = 0; + handle_async_input (); do_pending_atimers (); } +/* Undo any number of BLOCK_INPUT calls down to level LEVEL, + and also (if the level is now 0) reinvoke any pending signal. */ + +void +unblock_input_to (int level) +{ + interrupt_input_blocked = level; + if (level == 0) + { + if (pending_signals) + process_pending_signals (); + } + else if (level < 0) + emacs_abort (); +} + +/* End critical section. + + If doing signal-driven input, and a signal came in when input was + blocked, reinvoke the signal handler now to deal with it. */ + +void +unblock_input (void) +{ + unblock_input_to (interrupt_input_blocked - 1); +} + +/* Undo any number of BLOCK_INPUT calls, + and also reinvoke any pending signal. */ + +void +totally_unblock_input (void) +{ + unblock_input_to (0); +} + #ifdef USABLE_SIGIO -static void +void handle_input_available_signal (int sig) { - interrupt_input_pending = 1; pending_signals = 1; if (input_available_clear_time) @@ -7206,25 +7181,10 @@ handle_input_available_signal (int sig) static void deliver_input_available_signal (int sig) { - handle_on_main_thread (sig, handle_input_available_signal); + deliver_process_signal (sig, handle_input_available_signal); } #endif /* USABLE_SIGIO */ -/* Send ourselves a SIGIO. - - This function exists so that the UNBLOCK_INPUT macro in - blockinput.h can have some way to take care of input we put off - dealing with, without assuming that every file which uses - UNBLOCK_INPUT also has #included the files necessary to get SIGIO. */ -void -reinvoke_input_signal (void) -{ -#ifdef USABLE_SIGIO - handle_async_input (); -#endif -} - - /* User signal events. */ @@ -7295,7 +7255,7 @@ handle_user_signal (int sig) p->npending++; #ifdef USABLE_SIGIO if (interrupt_input) - kill (getpid (), SIGIO); + handle_input_available_signal (sig); else #endif { @@ -7311,7 +7271,7 @@ handle_user_signal (int sig) static void deliver_user_signal (int sig) { - handle_on_main_thread (sig, handle_user_signal); + deliver_process_signal (sig, handle_user_signal); } static char * @@ -7336,8 +7296,6 @@ store_user_signal_events (void) for (p = user_signals; p; p = p->next) if (p->npending > 0) { - sigset_t blocked, procmask; - if (! buf_initialized) { memset (&buf, 0, sizeof buf); @@ -7346,10 +7304,6 @@ store_user_signal_events (void) buf_initialized = 1; } - sigemptyset (&blocked); - sigaddset (&blocked, p->sig); - pthread_sigmask (SIG_BLOCK, &blocked, &procmask); - do { buf.code = p->sig; @@ -7357,8 +7311,6 @@ store_user_signal_events (void) p->npending--; } while (p->npending > 0); - - pthread_sigmask (SIG_SETMASK, &procmask, 0); } } @@ -10563,9 +10515,9 @@ The file will be closed when Emacs exits. */) { if (dribble) { - BLOCK_INPUT; + block_input (); fclose (dribble); - UNBLOCK_INPUT; + unblock_input (); dribble = 0; } if (!NILP (file)) @@ -10754,21 +10706,21 @@ handle_interrupt_signal (int sig) from the controlling tty. */ internal_last_event_frame = terminal->display_info.tty->top_frame; - handle_interrupt (); + handle_interrupt (1); } } static void deliver_interrupt_signal (int sig) { - handle_on_main_thread (sig, handle_interrupt_signal); + deliver_process_signal (sig, handle_interrupt_signal); } /* If Emacs is stuck because `inhibit-quit' is true, then keep track of the number of times C-g has been requested. If C-g is pressed enough times, then quit anyway. See bug#6585. */ -static int force_quit_count; +static int volatile force_quit_count; /* This routine is called at interrupt level in response to C-g. @@ -10782,7 +10734,7 @@ static int force_quit_count; non-nil, it stops the job right away. */ static void -handle_interrupt (void) +handle_interrupt (bool in_signal_handler) { char c; @@ -10791,13 +10743,16 @@ handle_interrupt (void) /* XXX This code needs to be revised for multi-tty support. */ if (!NILP (Vquit_flag) && get_named_tty ("/dev/tty")) { - /* If SIGINT isn't blocked, don't let us be interrupted by - another SIGINT, it might be harmful due to non-reentrancy - in I/O functions. */ - sigset_t blocked; - sigemptyset (&blocked); - sigaddset (&blocked, SIGINT); - pthread_sigmask (SIG_BLOCK, &blocked, 0); + if (! in_signal_handler) + { + /* If SIGINT isn't blocked, don't let us be interrupted by + a SIGINT. It might be harmful due to non-reentrancy + in I/O functions. */ + sigset_t blocked; + sigemptyset (&blocked); + sigaddset (&blocked, SIGINT); + pthread_sigmask (SIG_BLOCK, &blocked, 0); + } fflush (stdout); reset_all_sys_modes (); @@ -10868,7 +10823,6 @@ handle_interrupt (void) #endif /* not MSDOS */ fflush (stdout); init_all_sys_modes (); - pthread_sigmask (SIG_SETMASK, &empty_mask, 0); } else { @@ -10886,15 +10840,14 @@ handle_interrupt (void) GCPRO4 (saved.object, saved.global_code, saved.current_syntax_table, saved.old_prop); Fsignal (Qquit, Qnil); - /* FIXME: AFAIK, `quit' can never return, so this code is dead! */ gl_state = saved; UNGCPRO; } else { /* Else request quit when it's safe. */ - if (NILP (Vquit_flag)) - force_quit_count = 0; - if (++force_quit_count == 3) + int count = NILP (Vquit_flag) ? 1 : force_quit_count + 1; + force_quit_count = count; + if (count == 3) { immediate_quit = 1; Vinhibit_quit = Qnil; @@ -10903,6 +10856,8 @@ handle_interrupt (void) } } + pthread_sigmask (SIG_SETMASK, &empty_mask, 0); + /* TODO: The longjmp in this call throws the NS event loop integration off, and it seems to do fine without this. Probably some attention needs to be paid to the setting of waiting_for_input in @@ -10912,7 +10867,7 @@ handle_interrupt (void) separate event loop thread like W32. */ #ifndef HAVE_NS if (waiting_for_input && !echoing) - quit_throw_to_read_char (1); + quit_throw_to_read_char (in_signal_handler); #endif } @@ -10926,22 +10881,12 @@ quit_throw_to_read_char (int from_signal) if (!from_signal && EQ (Vquit_flag, Qkill_emacs)) Fkill_emacs (Qnil); - pthread_sigmask (SIG_SETMASK, &empty_mask, 0); /* Prevent another signal from doing this before we finish. */ clear_waiting_for_input (); input_pending = 0; Vunread_command_events = Qnil; -#if 0 /* Currently, sit_for is called from read_char without turning - off polling. And that can call set_waiting_for_input. - It seems to be harmless. */ -#ifdef POLL_FOR_INPUT - /* May be > 1 if in recursive minibuffer. */ - if (poll_suppress_count == 0) - emacs_abort (); -#endif -#endif if (FRAMEP (internal_last_event_frame) && !EQ (internal_last_event_frame, selected_frame)) do_switch_frame (make_lispy_switch_frame (internal_last_event_frame), @@ -11332,7 +11277,6 @@ init_keyboard (void) #endif input_pending = 0; interrupt_input_blocked = 0; - interrupt_input_pending = 0; pending_signals = 0; /* This means that command_loop_1 won't try to select anything the first @@ -11353,7 +11297,7 @@ init_keyboard (void) /* Before multi-tty support, these handlers used to be installed only if the current session was a tty session. Now an Emacs session may have multiple display types, so we always handle - SIGINT. There is special code in interrupt_signal to exit + SIGINT. There is special code in handle_interrupt_signal to exit Emacs on SIGINT when there are no termcap frames on the controlling terminal. */ struct sigaction action; diff --git a/src/keyboard.h b/src/keyboard.h index 3601f68be9f..bc35bba4ecc 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -523,7 +523,7 @@ extern void input_poll_signal (int); extern void start_polling (void); extern void stop_polling (void); extern void set_poll_suppress_count (int); -extern void gobble_input (void); +extern int gobble_input (void); extern int input_polling_used (void); extern void clear_input_pending (void); extern int requeued_events_pending_p (void); diff --git a/src/keymap.c b/src/keymap.c index 66fb52061f9..6ea142651bf 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1477,7 +1477,7 @@ current_minor_maps (Lisp_Object **modeptr, Lisp_Object **mapptr) /* Use malloc here. See the comment above this function. Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */ - BLOCK_INPUT; + block_input (); newmodes = malloc (allocsize); if (newmodes) { @@ -1501,7 +1501,7 @@ current_minor_maps (Lisp_Object **modeptr, Lisp_Object **mapptr) } cmm_maps = newmaps; } - UNBLOCK_INPUT; + unblock_input (); if (newmodes == NULL || newmaps == NULL) break; diff --git a/src/lisp.h b/src/lisp.h index 3a473a60b48..c3cabe0af29 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -25,6 +25,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <stdarg.h> #include <stdbool.h> #include <stddef.h> +#include <float.h> #include <inttypes.h> #include <limits.h> @@ -1487,6 +1488,16 @@ struct Lisp_Float #define XFLOAT_DATA(f) (0 ? XFLOAT (f)->u.data : XFLOAT (f)->u.data) #define XFLOAT_INIT(f, n) (XFLOAT (f)->u.data = (n)) +/* Most hosts nowadays use IEEE floating point, so they use IEC 60559 + representations, have infinities and NaNs, and do not trap on + exceptions. Define IEEE_FLOATING_POINT if this host is one of the + typical ones. The C11 macro __STDC_IEC_559__ is close to what is + wanted here, but is not quite right because Emacs does not require + all the features of C11 Annex F (and does not require C11 at all, + for that matter). */ +#define IEEE_FLOATING_POINT (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ + && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) + /* A character, declared with the following typedef, is a member of some character set associated with the current buffer. */ #ifndef _UCHAR_T /* Protect against something in ctab.h on AIX. */ @@ -2020,6 +2031,18 @@ extern ptrdiff_t specpdl_size; #define SPECPDL_INDEX() (specpdl_ptr - specpdl) +struct backtrace +{ + struct backtrace *next; + Lisp_Object function; + Lisp_Object *args; /* Points to vector of args. */ + ptrdiff_t nargs; /* Length of vector. */ + /* Nonzero means call value of debugger when done with this operation. */ + unsigned int debug_on_exit : 1; +}; + +extern struct backtrace *backtrace_list; + /* Everything needed to describe an active condition case. Members are volatile if their values need to survive _longjmp when @@ -2108,7 +2131,7 @@ extern char *stack_bottom; a request to exit Emacs when it is safe to do. */ extern void process_pending_signals (void); -extern int pending_signals; +extern int volatile pending_signals; extern void process_quit_flag (void); #define QUIT \ @@ -2633,7 +2656,6 @@ extern _Noreturn Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object); extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *); extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, bool); extern void syms_of_data (void); -extern void init_data (void); extern void swap_in_global_binding (struct Lisp_Symbol *); /* Defined in cmds.c */ @@ -2721,6 +2743,7 @@ extern void init_fringe_once (void); extern Lisp_Object QCascent, QCmargin, QCrelief; extern Lisp_Object QCconversion; extern int x_bitmap_mask (struct frame *, ptrdiff_t); +extern void reset_image_types (void); extern void syms_of_image (void); /* Defined in insdel.c. */ @@ -2905,6 +2928,7 @@ build_string (const char *str) extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); extern void make_byte_code (struct Lisp_Vector *); +extern Lisp_Object Qautomatic_gc; extern Lisp_Object Qchar_table_extra_slots; extern struct Lisp_Vector *allocate_vector (EMACS_INT); extern struct Lisp_Vector *allocate_pseudovector (int memlen, int lisplen, int tag); @@ -3227,6 +3251,9 @@ extern int input_pending; extern Lisp_Object menu_bar_items (Lisp_Object); extern Lisp_Object tool_bar_items (Lisp_Object, int *); extern void discard_mouse_events (void); +#ifdef USABLE_SIGIO +void handle_input_available_signal (int); +#endif extern Lisp_Object pending_funcalls; extern int detect_input_pending (void); extern int detect_input_pending_ignore_squeezables (void); @@ -3244,7 +3271,7 @@ extern void keys_of_keyboard (void); /* Defined in indent.c. */ extern ptrdiff_t current_column (void); extern void invalidate_current_column (void); -extern int indented_beyond_p (ptrdiff_t, ptrdiff_t, EMACS_INT); +extern bool indented_beyond_p (ptrdiff_t, ptrdiff_t, EMACS_INT); extern void syms_of_indent (void); /* Defined in frame.c. */ @@ -3269,8 +3296,11 @@ extern bool display_arg; extern Lisp_Object decode_env_path (const char *, const char *); extern Lisp_Object empty_unibyte_string, empty_multibyte_string; extern Lisp_Object Qfile_name_handler_alist; -extern _Noreturn void fatal_error_backtrace (int, int); +extern _Noreturn void terminate_due_to_signal (int, int); extern Lisp_Object Qkill_emacs; +#ifdef WINDOWSNT +extern Lisp_Object Vlibrary_cache; +#endif #if HAVE_SETLOCALE void fixup_locale (void); void synchronize_system_messages_locale (void); @@ -3407,8 +3437,6 @@ extern void init_sys_modes (struct tty_display_info *); extern void reset_sys_modes (struct tty_display_info *); extern void init_all_sys_modes (void); extern void reset_all_sys_modes (void); -extern void wait_for_termination (pid_t); -extern void interruptible_wait_for_termination (pid_t); extern void flush_pending_output (int) ATTRIBUTE_CONST; extern void child_setup_tty (int); extern void setup_pty (int); @@ -3519,6 +3547,13 @@ extern int have_menus_p (void); void syms_of_dbusbind (void); #endif + +/* Defined in profiler.c. */ +extern bool profiler_memory_running; +extern void malloc_probe (size_t); +extern void syms_of_profiler (void); + + #ifdef DOS_NT /* Defined in msdos.c, w32.c. */ extern char *emacs_root_dir (void); diff --git a/src/lread.c b/src/lread.c index 08d5f97292b..d22011be7c8 100644 --- a/src/lread.c +++ b/src/lread.c @@ -408,9 +408,9 @@ unreadchar (Lisp_Object readcharfun, int c) { if (load_each_byte) { - BLOCK_INPUT; + block_input (); ungetc (c, instream); - UNBLOCK_INPUT; + unblock_input (); } else unread_char = c; @@ -431,28 +431,28 @@ readbyte_from_file (int c, Lisp_Object readcharfun) { if (c >= 0) { - BLOCK_INPUT; + block_input (); ungetc (c, instream); - UNBLOCK_INPUT; + unblock_input (); return 0; } - BLOCK_INPUT; + block_input (); c = getc (instream); #ifdef EINTR /* Interrupted reads have been observed while reading over the network. */ while (c == EOF && ferror (instream) && errno == EINTR) { - UNBLOCK_INPUT; + unblock_input (); QUIT; - BLOCK_INPUT; + block_input (); clearerr (instream); c = getc (instream); } #endif - UNBLOCK_INPUT; + unblock_input (); return (c == EOF ? -1 : c); } @@ -753,9 +753,9 @@ DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0, (void) { register Lisp_Object val; - BLOCK_INPUT; + block_input (); XSETINT (val, getc (instream)); - UNBLOCK_INPUT; + unblock_input (); return val; } @@ -764,13 +764,30 @@ DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0, /* Return true if the lisp code read using READCHARFUN defines a non-nil `lexical-binding' file variable. After returning, the stream is - positioned following the first line, if it is a comment, otherwise - nothing is read. */ + positioned following the first line, if it is a comment or #! line, + otherwise nothing is read. */ static int lisp_file_lexically_bound_p (Lisp_Object readcharfun) { int ch = READCHAR; + + if (ch == '#') + { + ch = READCHAR; + if (ch != '!') + { + UNREAD (ch); + UNREAD ('#'); + return 0; + } + while (ch != '\n' && ch != EOF) + ch = READCHAR; + if (ch == '\n') ch = READCHAR; + /* It is OK to leave the position after a #! line, since + that is what read1 does. */ + } + if (ch != ';') /* The first line isn't a comment, just give up. */ { @@ -1350,9 +1367,9 @@ load_unwind (Lisp_Object arg) /* Used as unwind-protect function in load. */ FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer; if (stream != NULL) { - BLOCK_INPUT; + block_input (); fclose (stream); - UNBLOCK_INPUT; + unblock_input (); } return Qnil; } diff --git a/src/makefile.w32-in b/src/makefile.w32-in index 24ecb2676da..3d1464cc742 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -125,6 +125,7 @@ OBJ2 = $(BLD)/sysdep.$(O) \ $(BLD)/terminal.$(O) \ $(BLD)/menu.$(O) \ $(BLD)/xml.$(O) \ + $(BLD)/profiler.$(O) \ $(BLD)/w32term.$(O) \ $(BLD)/w32xfns.$(O) \ $(BLD)/w32fns.$(O) \ @@ -222,7 +223,7 @@ GLOBAL_SOURCES = dosfns.c msdos.c \ process.c callproc.c unexw32.c \ region-cache.c sound.c atimer.c \ doprnt.c intervals.c textprop.c composite.c \ - gnutls.c xml.c + gnutls.c xml.c profiler.c SOME_MACHINE_OBJECTS = dosfns.o msdos.o \ xterm.o xfns.o xmenu.o xselect.o xrdb.o xsmfns.o dbusbind.o obj = $(GLOBAL_SOURCES:.c=.o) @@ -392,8 +393,6 @@ SYSTIME_H = $(SRC)/systime.h \ ATIMER_H = $(SRC)/atimer.h \ $(NT_INC)/stdbool.h \ $(SYSTIME_H) -BLOCKINPUT_H = $(SRC)/blockinput.h \ - $(ATIMER_H) BUFFER_H = $(SRC)/buffer.h \ $(SYSTIME_H) C_CTYPE_H = $(GNU_LIB)/c-ctype.h \ @@ -467,6 +466,8 @@ SOCKET_H = $(NT_INC)/sys/socket.h \ $(SRC)/w32.h STAT_TIME_H = $(GNU_LIB)/stat-time.h \ $(NT_INC)/sys/stat.h +SYSSIGNAL_H = $(SRC)/syssignal.h \ + $(NT_INC)/stdbool.h SYSTTY_H = $(SRC)/systty.h \ $(NT_INC)/sys/ioctl.h \ $(NT_INC)/unistd.h @@ -481,11 +482,11 @@ WINDOW_H = $(SRC)/window.h \ $(BLD)/alloc.$(O) : \ $(SRC)/alloc.c \ + $(SRC)/blockinput.h \ $(SRC)/puresize.h \ $(SRC)/w32.h \ $(NT_INC)/unistd.h \ $(GNU_LIB)/verify.h \ - $(BLOCKINPUT_H) \ $(BUFFER_H) \ $(CHARACTER_H) \ $(CONFIG_H) \ @@ -499,12 +500,12 @@ $(BLD)/alloc.$(O) : \ $(BLD)/atimer.$(O) : \ $(SRC)/atimer.c \ - $(SRC)/syssignal.h \ + $(SRC)/blockinput.h \ $(NT_INC)/unistd.h \ $(ATIMER_H) \ - $(BLOCKINPUT_H) \ $(CONFIG_H) \ $(LISP_H) \ + $(SYSSIGNAL_H) \ $(SYSTIME_H) $(BLD)/bidi.$(O) : \ @@ -517,6 +518,7 @@ $(BLD)/bidi.$(O) : \ $(BLD)/buffer.$(O) : \ $(SRC)/buffer.c \ + $(SRC)/blockinput.h \ $(SRC)/commands.h \ $(SRC)/indent.h \ $(SRC)/keymap.h \ @@ -525,7 +527,6 @@ $(BLD)/buffer.$(O) : \ $(NT_INC)/sys/stat.h \ $(NT_INC)/unistd.h \ $(GNU_LIB)/verify.h \ - $(BLOCKINPUT_H) \ $(BUFFER_H) \ $(CHARACTER_H) \ $(CONFIG_H) \ @@ -557,14 +558,14 @@ $(BLD)/callint.$(O) : \ $(BLD)/callproc.$(O) : \ $(SRC)/callproc.c \ + $(SRC)/blockinput.h \ $(SRC)/commands.h \ $(SRC)/composite.h \ $(SRC)/epaths.h \ - $(SRC)/syssignal.h \ + $(SRC)/syswait.h \ $(SRC)/w32.h \ $(NT_INC)/sys/file.h \ $(NT_INC)/unistd.h \ - $(BLOCKINPUT_H) \ $(BUFFER_H) \ $(CCL_H) \ $(CHARACTER_H) \ @@ -573,6 +574,7 @@ $(BLD)/callproc.$(O) : \ $(FRAME_H) \ $(LISP_H) \ $(PROCESS_H) \ + $(SYSSIGNAL_H) \ $(SYSTTY_H) \ $(TERMHOOKS_H) @@ -690,7 +692,6 @@ $(BLD)/data.$(O) : \ $(SRC)/data.c \ $(SRC)/keymap.h \ $(SRC)/puresize.h \ - $(SRC)/syssignal.h \ $(GNU_LIB)/intprops.h \ $(BUFFER_H) \ $(CHARACTER_H) \ @@ -699,16 +700,17 @@ $(BLD)/data.$(O) : \ $(FRAME_H) \ $(KEYBOARD_H) \ $(LISP_H) \ + $(SYSSIGNAL_H) \ $(TERMHOOKS_H) $(BLD)/dired.$(O) : \ $(SRC)/dired.c \ + $(SRC)/blockinput.h \ $(SRC)/commands.h \ $(SRC)/regex.h \ $(NT_INC)/pwd.h \ $(NT_INC)/sys/stat.h \ $(NT_INC)/unistd.h \ - $(BLOCKINPUT_H) \ $(BUFFER_H) \ $(CHARACTER_H) \ $(CHARSET_H) \ @@ -723,15 +725,14 @@ $(BLD)/dired.$(O) : \ $(BLD)/dispnew.$(O) : \ $(SRC)/dispnew.c \ + $(SRC)/blockinput.h \ $(SRC)/cm.h \ $(SRC)/commands.h \ $(SRC)/disptab.h \ $(SRC)/indent.h \ - $(SRC)/syssignal.h \ $(SRC)/termchar.h \ $(SRC)/termopts.h \ $(NT_INC)/unistd.h \ - $(BLOCKINPUT_H) \ $(BUFFER_H) \ $(CHARACTER_H) \ $(CONFIG_H) \ @@ -741,6 +742,7 @@ $(BLD)/dispnew.$(O) : \ $(KEYBOARD_H) \ $(LISP_H) \ $(PROCESS_H) \ + $(SYSSIGNAL_H) \ $(SYSTIME_H) \ $(TERMHOOKS_H) \ $(W32TERM_H) \ @@ -768,12 +770,12 @@ $(BLD)/doprnt.$(O) : \ $(BLD)/editfns.$(O) : \ $(SRC)/editfns.c \ + $(SRC)/blockinput.h \ $(NT_INC)/pwd.h \ $(NT_INC)/unistd.h \ $(GNU_LIB)/intprops.h \ $(GNU_LIB)/strftime.h \ $(GNU_LIB)/verify.h \ - $(BLOCKINPUT_H) \ $(BUFFER_H) \ $(CHARACTER_H) \ $(CODING_H) \ @@ -786,16 +788,17 @@ $(BLD)/editfns.$(O) : \ $(BLD)/emacs.$(O) : \ $(SRC)/emacs.c \ + $(SRC)/blockinput.h \ $(SRC)/commands.h \ $(SRC)/gnutls.h \ $(SRC)/keymap.h \ - $(SRC)/syssignal.h \ $(SRC)/unexec.h \ $(SRC)/w32.h \ $(SRC)/w32heap.h \ $(NT_INC)/sys/file.h \ $(NT_INC)/unistd.h \ - $(BLOCKINPUT_H) \ + $(GNU_LIB)/ignore-value.h \ + $(ATIMER_H) \ $(BUFFER_H) \ $(CHARACTER_H) \ $(CONFIG_H) \ @@ -804,6 +807,7 @@ $(BLD)/emacs.$(O) : \ $(KEYBOARD_H) \ $(LISP_H) \ $(PROCESS_H) \ + $(SYSSIGNAL_H) \ $(SYSTTY_H) \ $(TERMHOOKS_H) \ $(W32TERM_H) \ @@ -811,8 +815,8 @@ $(BLD)/emacs.$(O) : \ $(BLD)/eval.$(O) : \ $(SRC)/eval.c \ + $(SRC)/blockinput.h \ $(SRC)/commands.h \ - $(BLOCKINPUT_H) \ $(CONFIG_H) \ $(DISPEXTERN_H) \ $(FRAME_H) \ @@ -821,11 +825,11 @@ $(BLD)/eval.$(O) : \ $(BLD)/fileio.$(O) : \ $(SRC)/fileio.c \ + $(SRC)/blockinput.h \ $(SRC)/commands.h \ $(NT_INC)/pwd.h \ $(NT_INC)/sys/stat.h \ $(NT_INC)/unistd.h \ - $(BLOCKINPUT_H) \ $(BUFFER_H) \ $(CHARACTER_H) \ $(CODING_H) \ @@ -858,17 +862,16 @@ $(BLD)/firstfile.$(O) : \ $(BLD)/floatfns.$(O) : \ $(SRC)/floatfns.c \ - $(SRC)/syssignal.h \ $(CONFIG_H) \ $(LISP_H) $(BLD)/fns.$(O) : \ $(SRC)/fns.c \ + $(SRC)/blockinput.h \ $(SRC)/commands.h \ $(SRC)/keymap.h \ $(NT_INC)/unistd.h \ $(GNU_LIB)/intprops.h \ - $(BLOCKINPUT_H) \ $(BUFFER_H) \ $(CHARACTER_H) \ $(CODING_H) \ @@ -902,8 +905,8 @@ $(BLD)/font.$(O) : \ $(BLD)/fontset.$(O) : \ $(SRC)/fontset.c \ + $(SRC)/blockinput.h \ $(SRC)/fontset.h \ - $(BLOCKINPUT_H) \ $(BUFFER_H) \ $(CCL_H) \ $(CHARACTER_H) \ @@ -921,10 +924,10 @@ $(BLD)/fontset.$(O) : \ $(BLD)/frame.$(O) : \ $(SRC)/frame.c \ + $(SRC)/blockinput.h \ $(SRC)/commands.h \ $(SRC)/fontset.h \ $(SRC)/termchar.h \ - $(BLOCKINPUT_H) \ $(BUFFER_H) \ $(CHARACTER_H) \ $(CONFIG_H) \ @@ -940,7 +943,7 @@ $(BLD)/frame.$(O) : \ $(BLD)/fringe.$(O) : \ $(SRC)/fringe.c \ - $(BLOCKINPUT_H) \ + $(SRC)/blockinput.h \ $(BUFFER_H) \ $(CHARACTER_H) \ $(CONFIG_H) \ @@ -971,12 +974,19 @@ $(BLD)/xml.$(O) : \ $(CONFIG_H) \ $(LISP_H) +$(BLD)/profiler.$(O) : \ + $(SRC)/profiler.c \ + $(CONFIG_H) \ + $(LISP_H) \ + $(SYSSIGNAL_H) \ + $(SYSTIME_H) + $(BLD)/image.$(O) : \ $(SRC)/image.c \ + $(SRC)/blockinput.h \ $(SRC)/epaths.h \ $(SRC)/w32.h \ $(NT_INC)/unistd.h \ - $(BLOCKINPUT_H) \ $(CHARACTER_H) \ $(CODING_H) \ $(CONFIG_H) \ @@ -1011,9 +1021,9 @@ $(BLD)/indent.$(O) : \ $(BLD)/insdel.$(O) : \ $(SRC)/insdel.c \ + $(SRC)/blockinput.h \ $(SRC)/region-cache.h \ $(GNU_LIB)/intprops.h \ - $(BLOCKINPUT_H) \ $(BUFFER_H) \ $(CHARACTER_H) \ $(CONFIG_H) \ @@ -1035,19 +1045,18 @@ $(BLD)/intervals.$(O) : \ $(BLD)/keyboard.$(O) : \ $(SRC)/keyboard.c \ + $(SRC)/blockinput.h \ $(SRC)/commands.h \ $(SRC)/disptab.h \ $(SRC)/keymap.h \ $(SRC)/macros.h \ $(SRC)/puresize.h \ $(SRC)/syntax.h \ - $(SRC)/syssignal.h \ $(SRC)/termchar.h \ $(SRC)/termopts.h \ $(NT_INC)/sys/ioctl.h \ $(NT_INC)/unistd.h \ $(ATIMER_H) \ - $(BLOCKINPUT_H) \ $(BUFFER_H) \ $(CHARACTER_H) \ $(CONFIG_H) \ @@ -1057,6 +1066,7 @@ $(BLD)/keyboard.$(O) : \ $(KEYBOARD_H) \ $(LISP_H) \ $(PROCESS_H) \ + $(SYSSIGNAL_H) \ $(SYSTIME_H) \ $(TERMHOOKS_H) \ $(W32TERM_H) \ @@ -1064,10 +1074,10 @@ $(BLD)/keyboard.$(O) : \ $(BLD)/keymap.$(O) : \ $(SRC)/keymap.c \ + $(SRC)/blockinput.h \ $(SRC)/commands.h \ $(SRC)/keymap.h \ $(SRC)/puresize.h \ - $(BLOCKINPUT_H) \ $(BUFFER_H) \ $(CHARACTER_H) \ $(CHARSET_H) \ @@ -1085,12 +1095,12 @@ $(BLD)/lastfile.$(O) : \ $(BLD)/lread.$(O) : \ $(SRC)/lread.c \ + $(SRC)/blockinput.h \ $(SRC)/commands.h \ $(SRC)/epaths.h \ $(NT_INC)/sys/file.h \ $(NT_INC)/sys/stat.h \ $(NT_INC)/unistd.h \ - $(BLOCKINPUT_H) \ $(BUFFER_H) \ $(CHARACTER_H) \ $(CHARSET_H) \ @@ -1123,8 +1133,8 @@ $(BLD)/marker.$(O) : \ $(BLD)/menu.$(O) : \ $(SRC)/menu.c \ + $(SRC)/blockinput.h \ $(SRC)/keymap.h \ - $(BLOCKINPUT_H) \ $(CONFIG_H) \ $(DISPEXTERN_H) \ $(FRAME_H) \ @@ -1178,10 +1188,10 @@ $(BLD)/w32heap.$(O) : \ $(BLD)/w32inevt.$(O) : \ $(SRC)/w32inevt.c \ + $(SRC)/blockinput.h \ $(SRC)/termchar.h \ $(SRC)/w32heap.h \ $(SRC)/w32inevt.h \ - $(BLOCKINPUT_H) \ $(CONFIG_H) \ $(DISPEXTERN_H) \ $(FRAME_H) \ @@ -1193,7 +1203,6 @@ $(BLD)/w32inevt.$(O) : \ $(BLD)/w32proc.$(O) : \ $(SRC)/w32proc.c \ - $(SRC)/syssignal.h \ $(SRC)/syswait.h \ $(SRC)/w32.h \ $(SRC)/w32heap.h \ @@ -1205,6 +1214,7 @@ $(BLD)/w32proc.$(O) : \ $(LANGINFO_H) \ $(LISP_H) \ $(PROCESS_H) \ + $(SYSSIGNAL_H) \ $(SYSTIME_H) \ $(W32TERM_H) @@ -1225,8 +1235,8 @@ $(BLD)/w32console.$(O) : \ $(BLD)/print.$(O) : \ $(SRC)/print.c \ + $(SRC)/blockinput.h \ $(SRC)/termchar.h \ - $(BLOCKINPUT_H) \ $(BUFFER_H) \ $(CHARACTER_H) \ $(CHARSET_H) \ @@ -1244,11 +1254,11 @@ $(BLD)/print.$(O) : \ $(BLD)/process.$(O) : \ $(SRC)/process.c \ + $(SRC)/blockinput.h \ $(SRC)/commands.h \ $(SRC)/composite.h \ $(SRC)/gnutls.h \ $(SRC)/sysselect.h \ - $(SRC)/syssignal.h \ $(SRC)/syswait.h \ $(SRC)/termopts.h \ $(NT_INC)/arpa/inet.h \ @@ -1259,7 +1269,6 @@ $(BLD)/process.$(O) : \ $(NT_INC)/sys/stat.h \ $(NT_INC)/unistd.h \ $(ATIMER_H) \ - $(BLOCKINPUT_H) \ $(BUFFER_H) \ $(CHARACTER_H) \ $(CODING_H) \ @@ -1270,6 +1279,7 @@ $(BLD)/process.$(O) : \ $(LISP_H) \ $(PROCESS_H) \ $(SOCKET_H) \ + $(SYSSIGNAL_H) \ $(SYSTIME_H) \ $(SYSTTY_H) \ $(TERMHOOKS_H) \ @@ -1278,9 +1288,9 @@ $(BLD)/process.$(O) : \ $(BLD)/ralloc.$(O) : \ $(SRC)/ralloc.c \ + $(SRC)/blockinput.h \ $(SRC)/getpagesize.h \ $(NT_INC)/unistd.h \ - $(BLOCKINPUT_H) \ $(CONFIG_H) \ $(LISP_H) @@ -1315,12 +1325,12 @@ $(BLD)/scroll.$(O) : \ $(BLD)/search.$(O) : \ $(SRC)/search.c \ + $(SRC)/blockinput.h \ $(SRC)/category.h \ $(SRC)/commands.h \ $(SRC)/regex.h \ $(SRC)/region-cache.h \ $(SRC)/syntax.h \ - $(BLOCKINPUT_H) \ $(BUFFER_H) \ $(CHARACTER_H) \ $(CHARSET_H) \ @@ -1330,12 +1340,12 @@ $(BLD)/search.$(O) : \ $(BLD)/sound.$(O) : \ $(SRC)/sound.c \ - $(SRC)/syssignal.h \ $(NT_INC)/unistd.h \ $(ATIMER_H) \ $(CONFIG_H) \ $(DISPEXTERN_H) \ - $(LISP_H) + $(LISP_H) \ + $(SYSSIGNAL_H) $(BLD)/syntax.$(O) : \ $(SRC)/syntax.c \ @@ -1352,9 +1362,9 @@ $(BLD)/syntax.$(O) : \ $(BLD)/sysdep.$(O) : \ $(SRC)/sysdep.c \ + $(SRC)/blockinput.h \ $(SRC)/cm.h \ $(SRC)/sysselect.h \ - $(SRC)/syssignal.h \ $(SRC)/syswait.h \ $(SRC)/termchar.h \ $(SRC)/termopts.h \ @@ -1367,7 +1377,6 @@ $(BLD)/sysdep.$(O) : \ $(GNU_LIB)/execinfo.h \ $(GNU_LIB)/ignore-value.h \ $(GNU_LIB)/utimens.h \ - $(BLOCKINPUT_H) \ $(CAREADLINKAT_H) \ $(CONFIG_H) \ $(C_CTYPE_H) \ @@ -1378,6 +1387,7 @@ $(BLD)/sysdep.$(O) : \ $(LISP_H) \ $(PROCESS_H) \ $(SOCKET_H) \ + $(SYSSIGNAL_H) \ $(SYSTIME_H) \ $(SYSTTY_H) \ $(TERMHOOKS_H) \ @@ -1385,18 +1395,17 @@ $(BLD)/sysdep.$(O) : \ $(BLD)/term.$(O) : \ $(SRC)/term.c \ + $(SRC)/blockinput.h \ $(SRC)/cm.h \ $(SRC)/composite.h \ $(SRC)/disptab.h \ $(SRC)/keymap.h \ - $(SRC)/syssignal.h \ $(SRC)/termchar.h \ $(SRC)/termopts.h \ $(SRC)/tparam.h \ $(NT_INC)/sys/file.h \ $(NT_INC)/sys/time.h \ $(NT_INC)/unistd.h \ - $(BLOCKINPUT_H) \ $(BUFFER_H) \ $(CHARACTER_H) \ $(CHARSET_H) \ @@ -1407,6 +1416,7 @@ $(BLD)/term.$(O) : \ $(INTERVALS_H) \ $(KEYBOARD_H) \ $(LISP_H) \ + $(SYSSIGNAL_H) \ $(SYSTTY_H) \ $(TERMHOOKS_H) \ $(WINDOW_H) @@ -1461,12 +1471,12 @@ $(BLD)/vm-limit.$(O) : \ $(BLD)/window.$(O) : \ $(SRC)/window.c \ + $(SRC)/blockinput.h \ $(SRC)/commands.h \ $(SRC)/disptab.h \ $(SRC)/indent.h \ $(SRC)/keymap.h \ $(SRC)/termchar.h \ - $(BLOCKINPUT_H) \ $(BUFFER_H) \ $(CHARACTER_H) \ $(CONFIG_H) \ @@ -1481,6 +1491,7 @@ $(BLD)/window.$(O) : \ $(BLD)/xdisp.$(O) : \ $(SRC)/xdisp.c \ + $(SRC)/blockinput.h \ $(SRC)/commands.h \ $(SRC)/disptab.h \ $(SRC)/fontset.h \ @@ -1490,7 +1501,7 @@ $(BLD)/xdisp.$(O) : \ $(SRC)/region-cache.h \ $(SRC)/termchar.h \ $(SRC)/termopts.h \ - $(BLOCKINPUT_H) \ + $(ATIMER_H) \ $(BUFFER_H) \ $(CHARACTER_H) \ $(CHARSET_H) \ @@ -1509,10 +1520,10 @@ $(BLD)/xdisp.$(O) : \ $(BLD)/xfaces.$(O) : \ $(SRC)/xfaces.c \ + $(SRC)/blockinput.h \ $(SRC)/fontset.h \ $(SRC)/termchar.h \ $(NT_INC)/sys/stat.h \ - $(BLOCKINPUT_H) \ $(BUFFER_H) \ $(CHARACTER_H) \ $(CHARSET_H) \ @@ -1530,11 +1541,11 @@ $(BLD)/xfaces.$(O) : \ $(BLD)/w32fns.$(O) : \ $(SRC)/w32fns.c \ + $(SRC)/blockinput.h \ $(SRC)/epaths.h \ $(SRC)/fontset.h \ $(SRC)/w32.h \ $(SRC)/w32heap.h \ - $(BLOCKINPUT_H) \ $(BUFFER_H) \ $(CCL_H) \ $(CHARACTER_H) \ @@ -1555,9 +1566,9 @@ $(BLD)/w32fns.$(O) : \ $(BLD)/w32menu.$(O) : \ $(SRC)/w32menu.c \ + $(SRC)/blockinput.h \ $(SRC)/keymap.h \ $(SRC)/w32heap.h \ - $(BLOCKINPUT_H) \ $(BUFFER_H) \ $(CHARACTER_H) \ $(CHARSET_H) \ @@ -1574,6 +1585,7 @@ $(BLD)/w32menu.$(O) : \ $(BLD)/w32term.$(O) : \ $(SRC)/w32term.c \ + $(SRC)/blockinput.h \ $(SRC)/disptab.h \ $(SRC)/fontset.h \ $(SRC)/keymap.h \ @@ -1582,7 +1594,6 @@ $(BLD)/w32term.$(O) : \ $(SRC)/w32heap.h \ $(NT_INC)/sys/stat.h \ $(ATIMER_H) \ - $(BLOCKINPUT_H) \ $(BUFFER_H) \ $(CCL_H) \ $(CHARACTER_H) \ @@ -1605,9 +1616,9 @@ $(BLD)/w32term.$(O) : \ $(BLD)/w32select.$(O) : \ $(SRC)/w32select.c \ + $(SRC)/blockinput.h \ $(SRC)/composite.h \ $(SRC)/w32heap.h \ - $(BLOCKINPUT_H) \ $(CHARSET_H) \ $(CODING_H) \ $(CONFIG_H) \ @@ -1616,15 +1627,15 @@ $(BLD)/w32select.$(O) : \ $(BLD)/w32reg.$(O) : \ $(SRC)/w32reg.c \ - $(BLOCKINPUT_H) \ + $(SRC)/blockinput.h \ $(CONFIG_H) \ $(LISP_H) \ $(W32TERM_H) $(BLD)/w32xfns.$(O) : \ $(SRC)/w32xfns.c \ + $(SRC)/blockinput.h \ $(SRC)/fontset.h \ - $(BLOCKINPUT_H) \ $(CHARSET_H) \ $(CONFIG_H) \ $(FRAME_H) \ diff --git a/src/menu.c b/src/menu.c index 7b01d1faefc..5374aa9157a 100644 --- a/src/menu.c +++ b/src/menu.c @@ -573,9 +573,9 @@ xmalloc_widget_value (void) { widget_value *value; - BLOCK_INPUT; + block_input (); value = malloc_widget_value (); - UNBLOCK_INPUT; + unblock_input (); return value; } @@ -602,9 +602,9 @@ free_menubar_widget_value_tree (widget_value *wv) free_menubar_widget_value_tree (wv->next); wv->next = (widget_value *) 0xDEADBEEF; } - BLOCK_INPUT; + block_input (); free_widget_value (wv); - UNBLOCK_INPUT; + unblock_input (); } /* Create a tree of widget_value objects @@ -1313,7 +1313,7 @@ no quit occurs and `x-popup-menu' returns nil. */) #endif /* Display them in a menu. */ - BLOCK_INPUT; + block_input (); /* FIXME: Use a terminal hook! */ #if defined HAVE_NTGUI @@ -1332,7 +1332,7 @@ no quit occurs and `x-popup-menu' returns nil. */) last_event_timestamp); #endif - UNBLOCK_INPUT; + unblock_input (); #ifdef HAVE_NS unbind_to (specpdl_count, Qnil); diff --git a/src/msdos.c b/src/msdos.c index ed5d3240aa1..bac6b977fdf 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -1229,7 +1229,7 @@ IT_update_begin (struct frame *f) if (display_info->termscript) fprintf (display_info->termscript, "\n\n<UPDATE_BEGIN"); - BLOCK_INPUT; + block_input (); if (f && f == mouse_face_frame) { @@ -1279,7 +1279,7 @@ IT_update_begin (struct frame *f) hlinfo->mouse_face_mouse_frame = NULL; } - UNBLOCK_INPUT; + unblock_input (); } static void @@ -1302,13 +1302,13 @@ IT_frame_up_to_date (struct frame *f) if (hlinfo->mouse_face_deferred_gc || (f && f == hlinfo->mouse_face_mouse_frame)) { - BLOCK_INPUT; + block_input (); if (hlinfo->mouse_face_mouse_frame) note_mouse_highlight (hlinfo->mouse_face_mouse_frame, hlinfo->mouse_face_mouse_x, hlinfo->mouse_face_mouse_y); hlinfo->mouse_face_deferred_gc = 0; - UNBLOCK_INPUT; + unblock_input (); } /* Set the cursor type to whatever they wanted. In a minibuffer diff --git a/src/nsfns.m b/src/nsfns.m index e2c8c3722c0..c96ec99ed2e 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -615,7 +615,7 @@ ns_set_name_as_filename (struct frame *f) if (f->explicit_name || ! NILP (f->title) || ns_in_resize) return; - BLOCK_INPUT; + block_input (); pool = [[NSAutoreleasePool alloc] init]; filename = BVAR (XBUFFER (buf), filename); name = BVAR (XBUFFER (buf), name); @@ -640,7 +640,7 @@ ns_set_name_as_filename (struct frame *f) if (title && (! strcmp (title, SSDATA (encoded_name)))) { [pool release]; - UNBLOCK_INPUT; + unblock_input (); return; } @@ -678,7 +678,7 @@ ns_set_name_as_filename (struct frame *f) } [pool release]; - UNBLOCK_INPUT; + unblock_input (); } @@ -689,11 +689,11 @@ ns_set_doc_edited (struct frame *f, Lisp_Object arg) NSAutoreleasePool *pool; if (!MINI_WINDOW_P (XWINDOW (f->selected_window))) { - BLOCK_INPUT; + block_input (); pool = [[NSAutoreleasePool alloc] init]; [[view window] setDocumentEdited: !NILP (arg)]; [pool release]; - UNBLOCK_INPUT; + unblock_input (); } } @@ -771,14 +771,14 @@ ns_implicitly_set_icon_type (struct frame *f) NSTRACE (ns_implicitly_set_icon_type); - BLOCK_INPUT; + block_input (); pool = [[NSAutoreleasePool alloc] init]; if (f->output_data.ns->miniimage && [[NSString stringWithUTF8String: SSDATA (f->name)] isEqualToString: [(NSImage *)f->output_data.ns->miniimage name]]) { [pool release]; - UNBLOCK_INPUT; + unblock_input (); return; } @@ -786,7 +786,7 @@ ns_implicitly_set_icon_type (struct frame *f) if (CONSP (tem) && ! NILP (XCDR (tem))) { [pool release]; - UNBLOCK_INPUT; + unblock_input (); return; } @@ -826,7 +826,7 @@ ns_implicitly_set_icon_type (struct frame *f) f->output_data.ns->miniimage = image; [view setMiniwindowImage: setMini]; [pool release]; - UNBLOCK_INPUT; + unblock_input (); } @@ -1018,7 +1018,7 @@ frame_parm_handler ns_frame_parm_handlers[] = x_set_fringe_width, /* generic OK */ x_set_fringe_width, /* generic OK */ 0, /* x_set_wait_for_wm, will ignore */ - 0, /* x_set_fullscreen will ignore */ + x_set_fullscreen, /* generic OK */ x_set_font_backend, /* generic OK */ x_set_alpha, 0, /* x_set_sticky */ @@ -1232,7 +1232,7 @@ This function is an internal primitive--use `make-frame' instead. */) f->resx = dpyinfo->resx; f->resy = dpyinfo->resy; - BLOCK_INPUT; + block_input (); register_font_driver (&nsfont_driver, f); x_default_parameter (f, parms, Qfont_backend, Qnil, "fontBackend", "FontBackend", RES_TYPE_STRING); @@ -1247,7 +1247,7 @@ This function is an internal primitive--use `make-frame' instead. */) build_string ([[font fontName] UTF8String]), "font", "Font", RES_TYPE_STRING); } - UNBLOCK_INPUT; + unblock_input (); x_default_parameter (f, parms, Qborder_width, make_number (0), "borderwidth", "BorderWidth", RES_TYPE_NUMBER); @@ -1411,10 +1411,10 @@ FRAME nil means use the selected frame. */) if (dpyinfo->x_focus_frame != f) { EmacsView *view = FRAME_NS_VIEW (f); - BLOCK_INPUT; + block_input (); [NSApp activateIgnoringOtherApps: YES]; [[view window] makeKeyAndOrderFront: view]; - UNBLOCK_INPUT; + unblock_input (); } return Qnil; @@ -1511,7 +1511,7 @@ Optional arg INIT, if non-nil, provides a default file name to use. */) [panel setDelegate: fileDelegate]; panelOK = 0; - BLOCK_INPUT; + block_input (); if (NILP (mustmatch)) { ret = [panel runModalForDirectory: dirS file: initS]; @@ -1528,7 +1528,7 @@ Optional arg INIT, if non-nil, provides a default file name to use. */) fname = build_string ([[panel filename] UTF8String]); [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow]; - UNBLOCK_INPUT; + unblock_input (); return ret ? fname : Qnil; } @@ -1899,7 +1899,7 @@ The optional argument FRAME is currently ignored. */) error ("non-Nextstep frame used in `ns-list-colors'"); } - BLOCK_INPUT; + block_input (); colorlists = [[NSColorList availableColorLists] objectEnumerator]; while ((clist = [colorlists nextObject])) @@ -1917,7 +1917,7 @@ The optional argument FRAME is currently ignored. */) } } - UNBLOCK_INPUT; + unblock_input (); return list; } @@ -2115,7 +2115,7 @@ In case the execution fails, an error is signaled. */) CHECK_STRING (script); check_ns (); - BLOCK_INPUT; + block_input (); as_script = script; as_result = &result; @@ -2141,7 +2141,7 @@ In case the execution fails, an error is signaled. */) as_status = 0; as_script = Qnil; as_result = 0; - UNBLOCK_INPUT; + unblock_input (); if (status == 0) return result; else if (!STRINGP (result)) @@ -2548,7 +2548,7 @@ Text larger than the specified size is clipped. */) else CHECK_NUMBER (dy); - BLOCK_INPUT; + block_input (); if (ns_tooltip == nil) ns_tooltip = [[EmacsTooltip alloc] init]; else @@ -2563,7 +2563,7 @@ Text larger than the specified size is clipped. */) &root_x, &root_y); [ns_tooltip showAtX: root_x Y: root_y for: XINT (timeout)]; - UNBLOCK_INPUT; + unblock_input (); UNGCPRO; return unbind_to (count, Qnil); diff --git a/src/nsfont.m b/src/nsfont.m index eba1eb04765..b13c96aa6ed 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -821,7 +821,7 @@ nsfont_open (FRAME_PTR f, Lisp_Object font_entity, int pixel_size) font_info->glyphs = xzalloc (0x100 * sizeof *font_info->glyphs); font_info->metrics = xzalloc (0x100 * sizeof *font_info->metrics); - BLOCK_INPUT; + block_input (); /* for metrics */ sfont = [nsfont screenFont]; @@ -932,7 +932,7 @@ nsfont_open (FRAME_PTR f, Lisp_Object font_entity, int pixel_size) font->props[FONT_FULLNAME_INDEX] = make_unibyte_string (font_info->name, strlen (font_info->name)); } - UNBLOCK_INPUT; + unblock_input (); return font_object; } @@ -1316,7 +1316,7 @@ ns_uni_to_glyphs (struct nsfont_info *font_info, unsigned char block) fprintf (stderr, "%p\tFinding glyphs for glyphs in block %d\n", font_info, block); - BLOCK_INPUT; + block_input (); #ifdef NS_IMPL_COCOA if (firstTime) @@ -1373,7 +1373,7 @@ ns_uni_to_glyphs (struct nsfont_info *font_info, unsigned char block) #endif } - UNBLOCK_INPUT; + unblock_input (); xfree (unichars); } @@ -1398,7 +1398,7 @@ ns_glyph_metrics (struct nsfont_info *font_info, unsigned char block) numGlyphs = 0x10000; #endif - BLOCK_INPUT; + block_input (); sfont = [font_info->nsfont screenFont]; font_info->metrics[block] = xzalloc (0x100 * sizeof (struct font_metrics)); @@ -1427,7 +1427,7 @@ ns_glyph_metrics (struct nsfont_info *font_info, unsigned char block) metrics->ascent = r.size.height - metrics->descent; /*-lrint (hshrink* [sfont descender] - expand * hd/2); */ } - UNBLOCK_INPUT; + unblock_input (); } diff --git a/src/nsimage.m b/src/nsimage.m index 668664c7a20..370cf832c7c 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -78,7 +78,7 @@ ns_image_from_file (Lisp_Object file) return [EmacsImage allocInitFromFile: file]; } -int +bool ns_load_image (struct frame *f, struct image *img, Lisp_Object spec_file, Lisp_Object spec_data) { diff --git a/src/nsmenu.m b/src/nsmenu.m index 907d3eac622..b60cc005c5f 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -115,13 +115,13 @@ popup_activated (void) /* -------------------------------------------------------------------------- Update menubar. Three cases: - 1) deep_p = 0, submenu = nil: Fresh switch onto a frame -- either set up + 1) ! deep_p, submenu = nil: Fresh switch onto a frame -- either set up just top-level menu strings (OS X), or goto case (2) (GNUstep). - 2) deep_p = 1, submenu = nil: Recompute all submenus. - 3) deep_p = 1, submenu = non-nil: Update contents of a single submenu. + 2) deep_p, submenu = nil: Recompute all submenus. + 3) deep_p, submenu = non-nil: Update contents of a single submenu. -------------------------------------------------------------------------- */ void -ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu) +ns_update_menubar (struct frame *f, bool deep_p, EmacsMenu *submenu) { NSAutoreleasePool *pool; id menu = [NSApp mainMenu]; @@ -146,7 +146,7 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu) XSETFRAME (Vmenu_updating_frame, f); /*fprintf (stderr, "ns_update_menubar: frame: %p\tdeep: %d\tsub: %p\n", f, deep_p, submenu); */ - BLOCK_INPUT; + block_input (); pool = [[NSAutoreleasePool alloc] init]; /* Menu may have been created automatically; if so, discard it. */ @@ -271,7 +271,7 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu) discard_menu_items (); unbind_to (specpdl_count, Qnil); [pool release]; - UNBLOCK_INPUT; + unblock_input (); return; } @@ -333,7 +333,7 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu) discard_menu_items (); unbind_to (specpdl_count, Qnil); [pool release]; - UNBLOCK_INPUT; + unblock_input (); return; } } @@ -404,7 +404,7 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu) { free_menubar_widget_value_tree (first_wv); [pool release]; - UNBLOCK_INPUT; + unblock_input (); return; } @@ -435,7 +435,7 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu) { free_menubar_widget_value_tree (first_wv); [pool release]; - UNBLOCK_INPUT; + unblock_input (); return; } } @@ -498,7 +498,7 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu) [NSApp setMainMenu: menu]; [pool release]; - UNBLOCK_INPUT; + unblock_input (); } @@ -507,7 +507,7 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu) frame's menus have changed, and the *step representation should be updated from Lisp. */ void -set_frame_menubar (struct frame *f, int first_time, int deep_p) +set_frame_menubar (struct frame *f, bool first_time, bool deep_p) { ns_update_menubar (f, deep_p, nil); } @@ -1012,10 +1012,10 @@ free_frame_tool_bar (FRAME_PTR f) Under NS we just hide the toolbar until it might be needed again. -------------------------------------------------------------------------- */ { - BLOCK_INPUT; + block_input (); [[FRAME_NS_VIEW (f) toolbar] setVisible: NO]; FRAME_TOOLBAR_HEIGHT (f) = 0; - UNBLOCK_INPUT; + unblock_input (); } void @@ -1029,7 +1029,7 @@ update_frame_tool_bar (FRAME_PTR f) NSWindow *window = [view window]; EmacsToolbar *toolbar = [view toolbar]; - BLOCK_INPUT; + block_input (); [toolbar clearActive]; /* update EmacsToolbar as in GtkUtils, build items list */ @@ -1115,7 +1115,7 @@ update_frame_tool_bar (FRAME_PTR f) FRAME_TOOLBAR_HEIGHT (f) = NSHeight ([window frameRectForContentRect: NSMakeRect (0, 0, 0, 0)]) - FRAME_NS_TITLEBAR_HEIGHT (f); - UNBLOCK_INPUT; + unblock_input (); } @@ -1355,7 +1355,7 @@ pop_down_menu (Lisp_Object arg) struct Lisp_Save_Value *p = XSAVE_VALUE (arg); struct Popdown_data *unwind_data = (struct Popdown_data *) p->pointer; - BLOCK_INPUT; + block_input (); if (popup_activated_flag) { EmacsDialogPanel *panel = unwind_data->dialog; @@ -1366,7 +1366,7 @@ pop_down_menu (Lisp_Object arg) } xfree (unwind_data); - UNBLOCK_INPUT; + unblock_input (); return Qnil; } @@ -1434,7 +1434,7 @@ ns_popup_dialog (Lisp_Object position, Lisp_Object contents, Lisp_Object header) the dialog. */ contents = Fcons (title, Fcons (Fcons (build_string ("Ok"), Qt), Qnil)); - BLOCK_INPUT; + block_input (); pool = [[NSAutoreleasePool alloc] init]; dialog = [[EmacsDialogPanel alloc] initFromContents: contents isQuestion: isQ]; @@ -1452,7 +1452,7 @@ ns_popup_dialog (Lisp_Object position, Lisp_Object contents, Lisp_Object header) unbind_to (specpdl_count, Qnil); /* calls pop_down_menu */ } - UNBLOCK_INPUT; + unblock_input (); return tem; } @@ -1766,7 +1766,7 @@ ns_popup_dialog (Lisp_Object position, Lisp_Object contents, Lisp_Object header) } - + - (void)timeout_handler: (NSTimer *)timedEntry { NSEvent *nxev = [NSEvent otherEventWithType: NSApplicationDefined diff --git a/src/nsterm.h b/src/nsterm.h index f3adab883a1..f06e0cb0f7f 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -38,6 +38,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #ifndef MAC_OS_X_VERSION_10_6 #define MAC_OS_X_VERSION_10_6 1060 #endif +#ifndef MAC_OS_X_VERSION_10_7 +#define MAC_OS_X_VERSION_10_7 1070 +#endif +#ifndef MAC_OS_X_VERSION_10_8 +#define MAC_OS_X_VERSION_10_8 1080 +#endif #endif /* NS_IMPL_COCOA */ #ifdef __OBJC__ @@ -80,6 +86,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ BOOL windowClosing; NSString *workingText; BOOL processingCompose; + int fs_state, fs_before_fs, next_maximized, tbar_height, bwidth; + int maximized_width, maximized_height; + NSWindow *nonfs_window; @public struct frame *emacsframe; int rows, cols; @@ -104,6 +113,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ - (EmacsToolbar *) toolbar; - (void) deleteWorkingText; - (void) updateFrameSize: (BOOL) delay; +- (void) handleFS; +- (void) setFSValue: (int)value; +- (void) toggleFullScreen: (id) sender; #ifdef NS_IMPL_GNUSTEP /* Not declared, but useful. */ @@ -120,6 +132,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ @end +/* Fullscreen version of the above. */ +@interface EmacsFSWindow : EmacsWindow +{ +} +@end + /* ========================================================================== The main menu implementation @@ -749,11 +767,11 @@ extern Lisp_Object ns_cursor_type_to_lisp (int arg); extern void ns_set_name_as_filename (struct frame *f); extern void ns_set_doc_edited (struct frame *f, Lisp_Object arg); -extern int +extern bool ns_defined_color (struct frame *f, const char *name, - XColor *color_def, int alloc, - char makeIndex); + XColor *color_def, bool alloc, + bool makeIndex); extern void ns_query_color (void *col, XColor *color_def, int setPixel); @@ -799,8 +817,8 @@ struct image; extern void *ns_image_from_XBM (unsigned char *bits, int width, int height); extern void *ns_image_for_XPM (int width, int height, int depth); extern void *ns_image_from_file (Lisp_Object file); -extern int ns_load_image (struct frame *f, struct image *img, - Lisp_Object spec_file, Lisp_Object spec_data); +extern bool ns_load_image (struct frame *f, struct image *img, + Lisp_Object spec_file, Lisp_Object spec_data); extern int ns_image_width (void *img); extern int ns_image_height (void *img); extern unsigned long ns_get_pixel (void *img, int x, int y); diff --git a/src/nsterm.m b/src/nsterm.m index aa869e3ff44..d41c38f4e40 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -72,6 +72,11 @@ int term_trace_num = 0; #define NSTRACE(x) #endif +#if defined (NS_IMPL_COCOA) && \ + MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_7 +#define NEW_STYLE_FS +#endif + extern NSString *NSMenuDidBeginTrackingNotification; /* ========================================================================== @@ -581,7 +586,7 @@ ns_update_auto_hide_menu_bar (void) #endif #ifdef NS_IMPL_COCOA #if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6 - BLOCK_INPUT; + block_input (); NSTRACE (ns_update_auto_hide_menu_bar); @@ -612,7 +617,7 @@ ns_update_auto_hide_menu_bar (void) } } - UNBLOCK_INPUT; + unblock_input (); #endif #endif } @@ -662,7 +667,7 @@ ns_update_window_begin (struct window *w) updated_window = w; set_output_cursor (&w->cursor); - BLOCK_INPUT; + block_input (); if (f == hlinfo->mouse_face_mouse_frame) { @@ -677,7 +682,7 @@ ns_update_window_begin (struct window *w) /* (further code for mouse faces ifdef'd out in other terms elided) */ } - UNBLOCK_INPUT; + unblock_input (); } @@ -694,7 +699,7 @@ ns_update_window_end (struct window *w, int cursor_on_p, /* note: this fn is nearly identical in all terms */ if (!w->pseudo_window_p) { - BLOCK_INPUT; + block_input (); if (cursor_on_p) display_and_set_cursor (w, 1, @@ -704,7 +709,7 @@ ns_update_window_end (struct window *w, int cursor_on_p, if (draw_window_fringes (w, 1)) x_draw_vertical_border (w); - UNBLOCK_INPUT; + unblock_input (); } /* If a row with mouse-face was overwritten, arrange for @@ -733,7 +738,7 @@ ns_update_end (struct frame *f) /* if (f == MOUSE_HL_INFO (f)->mouse_face_mouse_frame) */ MOUSE_HL_INFO (f)->mouse_face_defer = 0; - BLOCK_INPUT; + block_input (); #ifdef NS_IMPL_GNUSTEP /* trigger flush only in the rectangle we tracked as being drawn */ @@ -745,7 +750,7 @@ ns_update_end (struct frame *f) [view unlockFocus]; [[view window] flushWindow]; - UNBLOCK_INPUT; + unblock_input (); ns_updating_frame = NULL; NSTRACE (ns_update_end); } @@ -902,7 +907,7 @@ ns_ring_bell (struct frame *f) struct frame *frame = SELECTED_FRAME (); NSView *view; - BLOCK_INPUT; + block_input (); pool = [[NSAutoreleasePool alloc] init]; view = FRAME_NS_VIEW (frame); @@ -929,7 +934,7 @@ ns_ring_bell (struct frame *f) ns_unfocus (frame); } [pool release]; - UNBLOCK_INPUT; + unblock_input (); } else { @@ -970,13 +975,13 @@ ns_raise_frame (struct frame *f) { NSView *view = FRAME_NS_VIEW (f); check_ns (); - BLOCK_INPUT; + block_input (); FRAME_SAMPLE_VISIBILITY (f); if (FRAME_VISIBLE_P (f)) { [[view window] makeKeyAndOrderFront: NSApp]; } - UNBLOCK_INPUT; + unblock_input (); } @@ -988,9 +993,9 @@ ns_lower_frame (struct frame *f) { NSView *view = FRAME_NS_VIEW (f); check_ns (); - BLOCK_INPUT; + block_input (); [[view window] orderBack: NSApp]; - UNBLOCK_INPUT; + unblock_input (); } @@ -1126,7 +1131,7 @@ x_free_frame_resources (struct frame *f) [(EmacsView *)view setWindowClosing: YES]; /* may not have been informed */ - BLOCK_INPUT; + block_input (); free_frame_menubar (f); @@ -1154,7 +1159,7 @@ x_free_frame_resources (struct frame *f) xfree (f->output_data.ns); - UNBLOCK_INPUT; + unblock_input (); } void @@ -1183,7 +1188,7 @@ x_set_offset (struct frame *f, int xoff, int yoff, int change_grav) NSTRACE (x_set_offset); - BLOCK_INPUT; + block_input (); f->left_pos = xoff; f->top_pos = yoff; @@ -1215,7 +1220,7 @@ x_set_offset (struct frame *f, int xoff, int yoff, int change_grav) f->size_hint_flags &= ~(XNegative|YNegative); } - UNBLOCK_INPUT; + unblock_input (); } @@ -1240,7 +1245,7 @@ x_set_window_size (struct frame *f, int change_grav, int cols, int rows) /*fprintf (stderr, "\tsetWindowSize: %d x %d, font size %d x %d\n", cols, rows, FRAME_COLUMN_WIDTH (f), FRAME_LINE_HEIGHT (f)); */ - BLOCK_INPUT; + block_input (); check_frame_size (f, &rows, &cols); @@ -1302,10 +1307,21 @@ x_set_window_size (struct frame *f, int change_grav, int cols, int rows) mark_window_cursors_off (XWINDOW (f->root_window)); cancel_mouse_face (f); - UNBLOCK_INPUT; + unblock_input (); } +static void +ns_fullscreen_hook (FRAME_PTR f) +{ + EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f); + + if (! f->async_visible) return; + + block_input (); + [view handleFS]; + unblock_input (); +} /* ========================================================================== @@ -1414,7 +1430,7 @@ ns_get_color (const char *name, NSColor **col) NSString *nsname = [NSString stringWithUTF8String: name]; /*fprintf (stderr, "ns_get_color: '%s'\n", name); */ - BLOCK_INPUT; + block_input (); if ([nsname isEqualToString: @"ns_selection_color"]) { @@ -1461,7 +1477,7 @@ ns_get_color (const char *name, NSColor **col) if (r >= 0.0) { *col = [NSColor colorWithCalibratedRed: r green: g blue: b alpha: 1.0]; - UNBLOCK_INPUT; + unblock_input (); return 0; } @@ -1493,7 +1509,7 @@ ns_get_color (const char *name, NSColor **col) if (new) *col = [new colorUsingColorSpaceName: NSCalibratedRGBColorSpace]; - UNBLOCK_INPUT; + unblock_input (); return new ? 0 : 1; } @@ -1524,12 +1540,12 @@ ns_color_to_lisp (NSColor *col) const char *str; NSTRACE (ns_color_to_lisp); - BLOCK_INPUT; + block_input (); if ([[col colorSpaceName] isEqualToString: NSNamedColorSpace]) if ((str =[[col colorNameComponent] UTF8String])) { - UNBLOCK_INPUT; + unblock_input (); return build_string ((char *)str); } @@ -1541,14 +1557,14 @@ ns_color_to_lisp (NSColor *col) getWhite: &gray alpha: &alpha]; snprintf (buf, sizeof (buf), "#%2.2lx%2.2lx%2.2lx", lrint (gray * 0xff), lrint (gray * 0xff), lrint (gray * 0xff)); - UNBLOCK_INPUT; + unblock_input (); return build_string (buf); } snprintf (buf, sizeof (buf), "#%2.2lx%2.2lx%2.2lx", lrint (red*0xff), lrint (green*0xff), lrint (blue*0xff)); - UNBLOCK_INPUT; + unblock_input (); return build_string (buf); } @@ -1575,33 +1591,33 @@ ns_query_color(void *col, XColor *color_def, int setPixel) } -int +bool ns_defined_color (struct frame *f, const char *name, XColor *color_def, - int alloc, - char makeIndex) + bool alloc, + bool makeIndex) /* -------------------------------------------------------------------------- - Return 1 if named color found, and set color_def rgb accordingly. + Return true if named color found, and set color_def rgb accordingly. If makeIndex and alloc are nonzero put the color in the color_table, and set color_def pixel to the resulting index. If makeIndex is zero, set color_def pixel to ARGB. - Return 0 if not found + Return false if not found -------------------------------------------------------------------------- */ { NSColor *col; NSTRACE (ns_defined_color); - BLOCK_INPUT; + block_input (); if (ns_get_color (name, &col) != 0) /* Color not found */ { - UNBLOCK_INPUT; + unblock_input (); return 0; } if (makeIndex && alloc) color_def->pixel = ns_index_color (col, f); ns_query_color (col, color_def, !makeIndex); - UNBLOCK_INPUT; + unblock_input (); return 1; } @@ -1767,7 +1783,7 @@ ns_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, dpyinfo = FRAME_NS_DISPLAY_INFO (*fp); - BLOCK_INPUT; + block_input (); if (last_mouse_scroll_bar != nil && insist == 0) { @@ -1812,7 +1828,7 @@ ns_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, } } - UNBLOCK_INPUT; + unblock_input (); } @@ -1832,7 +1848,7 @@ ns_frame_up_to_date (struct frame *f) if ((hlinfo->mouse_face_deferred_gc || f ==hlinfo->mouse_face_mouse_frame) /*&& hlinfo->mouse_face_mouse_frame*/) { - BLOCK_INPUT; + block_input (); ns_update_begin(f); if (hlinfo->mouse_face_mouse_frame) note_mouse_highlight (hlinfo->mouse_face_mouse_frame, @@ -1840,7 +1856,7 @@ ns_frame_up_to_date (struct frame *f) hlinfo->mouse_face_mouse_y); hlinfo->mouse_face_deferred_gc = 0; ns_update_end(f); - UNBLOCK_INPUT; + unblock_input (); } } } @@ -1955,7 +1971,7 @@ ns_clear_frame (struct frame *f) r = [view bounds]; - BLOCK_INPUT; + block_input (); ns_focus (f, &r, 1); [ns_lookup_indexed_color (NS_FACE_BACKGROUND (FRAME_DEFAULT_FACE (f)), f) set]; NSRectFill (r); @@ -1967,7 +1983,7 @@ ns_clear_frame (struct frame *f) /* as of 2006/11 or so this is now needed */ ns_redraw_scroll_bars (f); - UNBLOCK_INPUT; + unblock_input (); } @@ -2068,7 +2084,7 @@ ns_scroll_run (struct window *w, struct run *run) if (height == 0) return; - BLOCK_INPUT; + block_input (); updated_window = w; x_clear_cursor (w); @@ -2083,7 +2099,7 @@ ns_scroll_run (struct window *w, struct run *run) ns_unfocus (f); } - UNBLOCK_INPUT; + unblock_input (); } @@ -2117,12 +2133,12 @@ ns_after_update_window_line (struct glyph_row *desired_row) { int y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, desired_row->y)); - BLOCK_INPUT; + block_input (); ns_clear_frame_area (f, 0, y, width, height); ns_clear_frame_area (f, FRAME_PIXEL_WIDTH (f) - width, y, width, height); - UNBLOCK_INPUT; + unblock_input (); } } @@ -2489,12 +2505,12 @@ show_hourglass (struct atimer *timer) if (hourglass_shown_p) return; - BLOCK_INPUT; + block_input (); /* TODO: add NSProgressIndicator to selected frame (see macfns.c) */ hourglass_shown_p = 1; - UNBLOCK_INPUT; + unblock_input (); } @@ -2504,12 +2520,12 @@ hide_hourglass (void) if (!hourglass_shown_p) return; - BLOCK_INPUT; + block_input (); /* TODO: remove NSProgressIndicator from all frames */ hourglass_shown_p = 0; - UNBLOCK_INPUT; + unblock_input (); } @@ -2979,7 +2995,8 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r) if (img != nil) { #if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6 - [img drawInRect: br + NSRect dr = NSMakeRect (x, y, s->slice.width, s->slice.height); + [img drawInRect: dr fromRect: NSZeroRect operation: NSCompositeSourceOver fraction: 1.0 @@ -3351,17 +3368,7 @@ ns_read_socket (struct terminal *terminal, struct input_event *hold_quit) if ([NSApp modalWindow] != nil) return -1; - if (interrupt_input_blocked) - { - interrupt_input_pending = 1; - pending_signals = 1; - return -1; - } - - interrupt_input_pending = 0; - pending_signals = pending_atimers; - - BLOCK_INPUT; + block_input (); n_emacs_events_pending = 0; EVENT_INIT (ev); emacs_event = &ev; @@ -3406,7 +3413,7 @@ ns_read_socket (struct terminal *terminal, struct input_event *hold_quit) nevents = n_emacs_events_pending; n_emacs_events_pending = 0; emacs_event = q_event_ptr = NULL; - UNBLOCK_INPUT; + unblock_input (); return nevents; } @@ -3486,7 +3493,7 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds, } EVENT_INIT (event); - BLOCK_INPUT; + block_input (); emacs_event = &event; if (++apploopnr != 1) { @@ -3500,7 +3507,7 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds, c = 's'; write (selfds[1], &c, 1); } - UNBLOCK_INPUT; + unblock_input (); ev = last_appdefined_event; @@ -3612,7 +3619,7 @@ ns_set_vertical_scroll_bar (struct window *window, || WINDOW_RIGHT_MARGIN_COLS (window) == 0)); XSETWINDOW (win, window); - BLOCK_INPUT; + block_input (); /* we want at least 5 lines to display a scrollbar */ if (WINDOW_TOTAL_LINES (window) < 5) @@ -3624,7 +3631,7 @@ ns_set_vertical_scroll_bar (struct window *window, wset_vertical_scroll_bar (window, Qnil); } ns_clear_frame_area (f, sb_left, top, width, height); - UNBLOCK_INPUT; + unblock_input (); return; } @@ -3656,7 +3663,7 @@ ns_set_vertical_scroll_bar (struct window *window, } [bar setPosition: position portion: portion whole: whole]; - UNBLOCK_INPUT; + unblock_input (); } @@ -3900,11 +3907,11 @@ ns_delete_terminal (struct terminal *terminal) if (!terminal->name) return; - BLOCK_INPUT; + block_input (); x_destroy_all_bitmaps (dpyinfo); ns_delete_display (dpyinfo); - UNBLOCK_INPUT; + unblock_input (); } @@ -3941,7 +3948,7 @@ ns_create_terminal (struct ns_display_info *dpyinfo) terminal->frame_rehighlight_hook = ns_frame_rehighlight; terminal->frame_raise_lower_hook = ns_frame_raise_lower; - terminal->fullscreen_hook = 0; /* see XTfullscreen_hook */ + terminal->fullscreen_hook = ns_fullscreen_hook; terminal->set_vertical_scroll_bar_hook = ns_set_vertical_scroll_bar; terminal->condemn_scroll_bars_hook = ns_condemn_scroll_bars; @@ -3982,7 +3989,7 @@ ns_term_init (Lisp_Object display_name) /* count object allocs (About, click icon); on OS X use ObjectAlloc tool */ /*GSDebugAllocationActive (YES); */ - BLOCK_INPUT; + block_input (); baud_rate = 38400; Fset_input_interrupt_mode (Qnil); @@ -4051,7 +4058,7 @@ ns_term_init (Lisp_Object display_name) terminal->name = xstrdup (SSDATA (display_name)); - UNBLOCK_INPUT; + unblock_input (); if (!inhibit_x_resources) { @@ -4696,6 +4703,8 @@ not_in_argv (NSString *arg) { NSTRACE (EmacsView_dealloc); [toolbar release]; + if (fs_state == FULLSCREEN_BOTH) + [nonfs_window release]; [super dealloc]; } @@ -5414,6 +5423,7 @@ not_in_argv (NSString *arg) SET_FRAME_GARBAGED (emacsframe); cancel_mouse_face (emacsframe); [view setFrame: NSMakeRect (0, 0, neww, newh)]; + [self windowDidMove:nil]; // Update top/left. } } @@ -5423,6 +5433,19 @@ not_in_argv (NSString *arg) NSTRACE (windowWillResize); /*fprintf (stderr,"Window will resize: %.0f x %.0f\n",frameSize.width,frameSize.height); */ + if (fs_state == FULLSCREEN_MAXIMIZED + && (maximized_width != (int)frameSize.width + || maximized_height != (int)frameSize.height)) + [self setFSValue: FULLSCREEN_NONE]; + else if (fs_state == FULLSCREEN_WIDTH + && maximized_width != (int)frameSize.width) + [self setFSValue: FULLSCREEN_NONE]; + else if (fs_state == FULLSCREEN_HEIGHT + && maximized_height != (int)frameSize.height) + [self setFSValue: FULLSCREEN_NONE]; + if (fs_state == FULLSCREEN_NONE) + maximized_width = maximized_height = -1; + cols = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (emacsframe, #ifdef NS_IMPL_GNUSTEP frameSize.width + 3); @@ -5604,6 +5627,10 @@ not_in_argv (NSString *arg) windowClosing = NO; processingCompose = NO; scrollbarsNeedingUpdate = 0; + fs_state = FULLSCREEN_NONE; + fs_before_fs = next_maximized = -1; + maximized_width = maximized_height = -1; + nonfs_window = nil; /*fprintf (stderr,"init with %d, %d\n",f->text_cols, f->text_lines); */ @@ -5628,9 +5655,13 @@ not_in_argv (NSString *arg) backing: NSBackingStoreBuffered defer: YES]; +#ifdef NEW_STYLE_FS + [win setCollectionBehavior:NSWindowCollectionBehaviorFullScreenPrimary]; +#endif + wr = [win frame]; - f->border_width = wr.size.width - r.size.width; - FRAME_NS_TITLEBAR_HEIGHT (f) = wr.size.height - r.size.height; + bwidth = f->border_width = wr.size.width - r.size.width; + tbar_height = FRAME_NS_TITLEBAR_HEIGHT (f) = wr.size.height - r.size.height; [win setAcceptsMouseMovedEvents: YES]; [win setDelegate: self]; @@ -5736,27 +5767,50 @@ not_in_argv (NSString *arg) NSTRACE (windowWillUseStandardFrame); - if (abs (defaultFrame.size.height - result.size.height) - > FRAME_LINE_HEIGHT (emacsframe)) + if (fs_before_fs != -1) /* Entering fullscreen */ + { + result = defaultFrame; + } + else if (next_maximized == FULLSCREEN_HEIGHT + || (next_maximized == -1 + && abs (defaultFrame.size.height - result.size.height) + > FRAME_LINE_HEIGHT (emacsframe))) { /* first click */ ns_userRect = result; - result.size.height = defaultFrame.size.height; + maximized_height = result.size.height = defaultFrame.size.height; + maximized_width = -1; result.origin.y = defaultFrame.origin.y; + [self setFSValue: FULLSCREEN_HEIGHT]; + } + else if (next_maximized == FULLSCREEN_WIDTH) + { + ns_userRect = result; + maximized_width = result.size.width = defaultFrame.size.width; + maximized_height = -1; + result.origin.x = defaultFrame.origin.x; + [self setFSValue: FULLSCREEN_WIDTH]; + } + else if (next_maximized == FULLSCREEN_MAXIMIZED + || (next_maximized == -1 + && abs (defaultFrame.size.width - result.size.width) + > FRAME_COLUMN_WIDTH (emacsframe))) + { + result = defaultFrame; /* second click */ + maximized_width = result.size.width; + maximized_height = result.size.height; + [self setFSValue: FULLSCREEN_MAXIMIZED]; } else { - if (abs (defaultFrame.size.width - result.size.width) - > FRAME_COLUMN_WIDTH (emacsframe)) - result = defaultFrame; /* second click */ - else - { - /* restore */ - result = ns_userRect.size.height ? ns_userRect : result; - ns_userRect = NSMakeRect (0, 0, 0, 0); - } + /* restore */ + result = ns_userRect.size.height ? ns_userRect : result; + ns_userRect = NSMakeRect (0, 0, 0, 0); + [self setFSValue: FULLSCREEN_NONE]; + maximized_width = maximized_width = -1; } + if (fs_before_fs == -1) next_maximized = -1; [self windowWillResize: sender toSize: result.size]; return result; } @@ -5808,6 +5862,200 @@ not_in_argv (NSString *arg) } } +- (void)windowWillEnterFullScreen:(NSNotification *)notification +{ + fs_before_fs = fs_state; +} + +- (void)windowDidEnterFullScreen:(NSNotification *)notification +{ + [self setFSValue: FULLSCREEN_BOTH]; +#ifndef NEW_STYLE_FS + fprintf(stderr, "%s %d\n", __func__, FRAME_PIXEL_WIDTH (emacsframe)); + [self windowDidBecomeKey:notification]; +#endif +} + +- (void)windowWillExitFullScreen:(NSNotification *)notification +{ + if (next_maximized != -1) + fs_before_fs = next_maximized; +} + +- (void)windowDidExitFullScreen:(NSNotification *)notification +{ + [self setFSValue: fs_before_fs]; + fs_before_fs = -1; + if (next_maximized != -1) + [[self window] performZoom:self]; +} + +- (void)toggleFullScreen: (id)sender +{ + /* Bugs remain: + 1) Having fullscreen in initial/default frame alist. + 2) Fullscreen in default frame alist only applied to first frame. + */ + +#ifdef NEW_STYLE_FS + [[self window] toggleFullScreen:sender]; +#else + NSWindow *w = [self window], *fw; + BOOL onFirstScreen = [[w screen] + isEqual:[[NSScreen screens] objectAtIndex:0]]; + struct frame *f = emacsframe; + NSSize sz; + NSRect r; + NSColor *col = ns_lookup_indexed_color (NS_FACE_BACKGROUND + (FRAME_DEFAULT_FACE (f)), + f); + + sz.width = FRAME_COLUMN_WIDTH (f); + sz.height = FRAME_LINE_HEIGHT (f); + + if (fs_state != FULLSCREEN_BOTH) + { + /* Hide dock and menubar if we are on the primary screen. */ + if (onFirstScreen) + { +#if defined (NS_IMPL_COCOA) && \ + MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6 + NSApplicationPresentationOptions options + = NSApplicationPresentationAutoHideDock + | NSApplicationPresentationAutoHideMenuBar; + + [NSApp setPresentationOptions: options]; +#else + [NSMenu setMenuBarVisible:NO]; +#endif + } + + fw = [[EmacsFSWindow alloc] + initWithContentRect:[w contentRectForFrameRect:[w frame]] + styleMask:NSBorderlessWindowMask + backing:NSBackingStoreBuffered + defer:YES + screen:[w screen]]; + + [fw setContentView:[w contentView]]; + [fw setTitle:[w title]]; + [fw makeKeyAndOrderFront:NSApp]; + [fw setDelegate:self]; + [fw makeFirstResponder:self]; + [fw setAcceptsMouseMovedEvents: YES]; + [fw useOptimizedDrawing: YES]; + [fw setResizeIncrements: sz]; + [fw setBackgroundColor: col]; + if ([col alphaComponent] != 1.0) + [fw setOpaque: NO]; + + f->border_width = 0; + FRAME_NS_TITLEBAR_HEIGHT (f) = 0; + + nonfs_window = w; + [self windowWillEnterFullScreen:nil]; + [w orderOut:self]; + r = [fw frameRectForContentRect:[[fw screen] frame]]; + [fw setFrame: r display:YES animate:YES]; + [self windowDidEnterFullScreen:nil]; + } + else + { + fw = w; + w = nonfs_window; + + if (onFirstScreen) + { +#if defined (NS_IMPL_COCOA) && \ + MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6 + [NSApp setPresentationOptions: NSApplicationPresentationDefault]; +#else + [NSMenu setMenuBarVisible:YES]; +#endif + } + + [w setContentView:[fw contentView]]; + [w setResizeIncrements: sz]; + [w setBackgroundColor: col]; + if ([col alphaComponent] != 1.0) + [w setOpaque: NO]; + + f->border_width = bwidth; + FRAME_NS_TITLEBAR_HEIGHT (f) = tbar_height; + + [self windowWillExitFullScreen:nil]; + [fw setFrame: [w frame] display:YES animate:YES]; + [fw close]; + [w makeKeyAndOrderFront:NSApp]; + [self windowDidExitFullScreen:nil]; + } +#endif +} + +- (void)handleFS +{ + if (fs_state != emacsframe->want_fullscreen) + { + if (fs_state == FULLSCREEN_BOTH) + { + [self toggleFullScreen:self]; + } + + switch (emacsframe->want_fullscreen) + { + case FULLSCREEN_BOTH: + [self toggleFullScreen:self]; + break; + case FULLSCREEN_WIDTH: + next_maximized = FULLSCREEN_WIDTH; + if (fs_state != FULLSCREEN_BOTH) + [[self window] performZoom:self]; + break; + case FULLSCREEN_HEIGHT: + next_maximized = FULLSCREEN_HEIGHT; + if (fs_state != FULLSCREEN_BOTH) + [[self window] performZoom:self]; + break; + case FULLSCREEN_MAXIMIZED: + next_maximized = FULLSCREEN_MAXIMIZED; + if (fs_state != FULLSCREEN_BOTH) + [[self window] performZoom:self]; + break; + case FULLSCREEN_NONE: + if (fs_state != FULLSCREEN_BOTH) + { + next_maximized = FULLSCREEN_NONE; + [[self window] performZoom:self]; + } + break; + } + + emacsframe->want_fullscreen = FULLSCREEN_NONE; + } + +} + +- (void) setFSValue: (int)value +{ + Lisp_Object lval = Qnil; + switch (value) + { + case FULLSCREEN_BOTH: + lval = Qfullboth; + break; + case FULLSCREEN_WIDTH: + lval = Qfullwidth; + break; + case FULLSCREEN_HEIGHT: + lval = Qfullheight; + break; + case FULLSCREEN_MAXIMIZED: + lval = Qmaximized; + break; + } + store_frame_param (emacsframe, Qfullscreen, lval); + fs_state = value; +} - (void)mouseEntered: (NSEvent *)theEvent { @@ -6299,6 +6547,15 @@ not_in_argv (NSString *arg) @end /* EmacsWindow */ +@implementation EmacsFSWindow + +- (BOOL)canBecomeKeyWindow +{ + return YES; +} + +@end + /* ========================================================================== EmacsScroller implementation @@ -6369,13 +6626,13 @@ not_in_argv (NSString *arg) - (void)setFrame: (NSRect)newRect { NSTRACE (EmacsScroller_setFrame); -/* BLOCK_INPUT; */ +/* block_input (); */ pixel_height = NSHeight (newRect); if (pixel_height == 0) pixel_height = 1; min_portion = 20 / pixel_height; [super setFrame: newRect]; [self display]; -/* UNBLOCK_INPUT; */ +/* unblock_input (); */ } @@ -6410,14 +6667,14 @@ not_in_argv (NSString *arg) if (condemned) { EmacsView *view; - BLOCK_INPUT; + block_input (); /* ensure other scrollbar updates after deletion */ view = (EmacsView *)FRAME_NS_VIEW (frame); if (view != nil) view->scrollbarsNeedingUpdate++; [self removeFromSuperview]; [self release]; - UNBLOCK_INPUT; + unblock_input (); } return self; } diff --git a/src/print.c b/src/print.c index aae13bb6764..49b491faec8 100644 --- a/src/print.c +++ b/src/print.c @@ -753,9 +753,9 @@ append to existing target file. */) { if (initial_stderr_stream != NULL) { - BLOCK_INPUT; + block_input (); fclose (stderr); - UNBLOCK_INPUT; + unblock_input (); } stderr = initial_stderr_stream; initial_stderr_stream = NULL; diff --git a/src/process.c b/src/process.c index c654369627d..ab215766c07 100644 --- a/src/process.c +++ b/src/process.c @@ -255,11 +255,12 @@ static int keyboard_bit_set (SELECT_TYPE *); static void deactivate_process (Lisp_Object); static void status_notify (struct Lisp_Process *); static int read_process_output (Lisp_Object, int); +static void handle_child_signal (int); static void create_pty (Lisp_Object); /* If we support a window system, turn on the code to poll periodically to detect C-g. It isn't actually used when doing interrupt input. */ -#if defined (HAVE_WINDOW_SYSTEM) && !defined (USE_ASYNC_EVENTS) +#ifdef HAVE_WINDOW_SYSTEM #define POLL_FOR_INPUT #endif @@ -1610,11 +1611,16 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) int wait_child_setup[2]; #endif #ifdef SIGCHLD - sigset_t blocked, procmask; + sigset_t blocked; #endif /* Use volatile to protect variables from being clobbered by vfork. */ volatile int forkin, forkout; volatile int pty_flag = 0; + volatile Lisp_Object lisp_pty_name = Qnil; + volatile Lisp_Object encoded_current_dir; +#if HAVE_WORKING_VFORK + char **volatile save_environ; +#endif inchannel = outchannel = -1; @@ -1640,6 +1646,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) forkin = forkout = -1; #endif /* not USG, or USG_SUBTTY_WORKS */ pty_flag = 1; + lisp_pty_name = build_string (pty_name); } else #endif /* HAVE_PTYS */ @@ -1704,14 +1711,6 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) XPROCESS (process)->pty_flag = pty_flag; pset_status (XPROCESS (process), Qrun); -#ifdef SIGCHLD - /* Delay interrupts until we have a chance to store - the new fork's pid in its process structure */ - sigemptyset (&blocked); - sigaddset (&blocked, SIGCHLD); - pthread_sigmask (SIG_BLOCK, &blocked, &procmask); -#endif - FD_SET (inchannel, &input_wait_mask); FD_SET (inchannel, &non_keyboard_wait_mask); if (inchannel > max_process_desc) @@ -1729,89 +1728,99 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) error. */ setup_process_coding_systems (process); - BLOCK_INPUT; + encoded_current_dir = ENCODE_FILE (current_dir); - { - /* child_setup must clobber environ on systems with true vfork. - Protect it from permanent change. */ - char **save_environ = environ; - volatile Lisp_Object encoded_current_dir = ENCODE_FILE (current_dir); + block_input (); + +#ifdef SIGCHLD + /* Block SIGCHLD until we have a chance to store the new fork's + pid in its process structure. */ + sigemptyset (&blocked); + sigaddset (&blocked, SIGCHLD); + pthread_sigmask (SIG_BLOCK, &blocked, 0); +#endif + +#if HAVE_WORKING_VFORK + /* child_setup must clobber environ on systems with true vfork. + Protect it from permanent change. */ + save_environ = environ; +#endif #ifndef WINDOWSNT - pid = vfork (); - if (pid == 0) + pid = vfork (); + if (pid == 0) #endif /* not WINDOWSNT */ - { - int xforkin = forkin; - int xforkout = forkout; + { + int xforkin = forkin; + int xforkout = forkout; - /* Make the pty be the controlling terminal of the process. */ + /* Make the pty be the controlling terminal of the process. */ #ifdef HAVE_PTYS - /* First, disconnect its current controlling terminal. */ + /* First, disconnect its current controlling terminal. */ #ifdef HAVE_SETSID - /* We tried doing setsid only if pty_flag, but it caused - process_set_signal to fail on SGI when using a pipe. */ - setsid (); - /* Make the pty's terminal the controlling terminal. */ - if (pty_flag && xforkin >= 0) - { + /* We tried doing setsid only if pty_flag, but it caused + process_set_signal to fail on SGI when using a pipe. */ + setsid (); + /* Make the pty's terminal the controlling terminal. */ + if (pty_flag && xforkin >= 0) + { #ifdef TIOCSCTTY - /* We ignore the return value - because faith@cs.unc.edu says that is necessary on Linux. */ - ioctl (xforkin, TIOCSCTTY, 0); + /* We ignore the return value + because faith@cs.unc.edu says that is necessary on Linux. */ + ioctl (xforkin, TIOCSCTTY, 0); #endif - } + } #else /* not HAVE_SETSID */ #ifdef USG - /* It's very important to call setpgrp here and no time - afterwards. Otherwise, we lose our controlling tty which - is set when we open the pty. */ - setpgrp (); + /* It's very important to call setpgrp here and no time + afterwards. Otherwise, we lose our controlling tty which + is set when we open the pty. */ + setpgrp (); #endif /* USG */ #endif /* not HAVE_SETSID */ #if defined (LDISC1) - if (pty_flag && xforkin >= 0) - { - struct termios t; - tcgetattr (xforkin, &t); - t.c_lflag = LDISC1; - if (tcsetattr (xforkin, TCSANOW, &t) < 0) - emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39); - } + if (pty_flag && xforkin >= 0) + { + struct termios t; + tcgetattr (xforkin, &t); + t.c_lflag = LDISC1; + if (tcsetattr (xforkin, TCSANOW, &t) < 0) + emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39); + } #else #if defined (NTTYDISC) && defined (TIOCSETD) - if (pty_flag && xforkin >= 0) - { - /* Use new line discipline. */ - int ldisc = NTTYDISC; - ioctl (xforkin, TIOCSETD, &ldisc); - } + if (pty_flag && xforkin >= 0) + { + /* Use new line discipline. */ + int ldisc = NTTYDISC; + ioctl (xforkin, TIOCSETD, &ldisc); + } #endif #endif #ifdef TIOCNOTTY - /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you - can do TIOCSPGRP only to the process's controlling tty. */ - if (pty_flag) - { - /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here? - I can't test it since I don't have 4.3. */ - int j = emacs_open ("/dev/tty", O_RDWR, 0); - if (j >= 0) - { - ioctl (j, TIOCNOTTY, 0); - emacs_close (j); - } + /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you + can do TIOCSPGRP only to the process's controlling tty. */ + if (pty_flag) + { + /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here? + I can't test it since I don't have 4.3. */ + int j = emacs_open ("/dev/tty", O_RDWR, 0); + if (j >= 0) + { + ioctl (j, TIOCNOTTY, 0); + emacs_close (j); + } #ifndef USG - /* In order to get a controlling terminal on some versions - of BSD, it is necessary to put the process in pgrp 0 - before it opens the terminal. */ + /* In order to get a controlling terminal on some versions + of BSD, it is necessary to put the process in pgrp 0 + before it opens the terminal. */ #ifdef HAVE_SETPGID - setpgid (0, 0); + setpgid (0, 0); #else - setpgrp (0, 0); + setpgrp (0, 0); #endif #endif - } + } #endif /* TIOCNOTTY */ #if !defined (DONT_REOPEN_PTY) @@ -1823,70 +1832,79 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) both HAVE_SETSID and TIOCSCTTY are defined. */ /* Now close the pty (if we had it open) and reopen it. This makes the pty the controlling terminal of the subprocess. */ - if (pty_flag) - { + if (pty_flag) + { - /* I wonder if emacs_close (emacs_open (pty_name, ...)) - would work? */ - if (xforkin >= 0) - emacs_close (xforkin); - xforkout = xforkin = emacs_open (pty_name, O_RDWR, 0); + /* I wonder if emacs_close (emacs_open (pty_name, ...)) + would work? */ + if (xforkin >= 0) + emacs_close (xforkin); + xforkout = xforkin = emacs_open (pty_name, O_RDWR, 0); - if (xforkin < 0) - { - emacs_write (1, "Couldn't open the pty terminal ", 31); - emacs_write (1, pty_name, strlen (pty_name)); - emacs_write (1, "\n", 1); - _exit (1); - } + if (xforkin < 0) + { + emacs_write (1, "Couldn't open the pty terminal ", 31); + emacs_write (1, pty_name, strlen (pty_name)); + emacs_write (1, "\n", 1); + _exit (1); + } - } + } #endif /* not DONT_REOPEN_PTY */ #ifdef SETUP_SLAVE_PTY - if (pty_flag) - { - SETUP_SLAVE_PTY; - } + if (pty_flag) + { + SETUP_SLAVE_PTY; + } #endif /* SETUP_SLAVE_PTY */ #ifdef AIX - /* On AIX, we've disabled SIGHUP above once we start a child on a pty. - Now reenable it in the child, so it will die when we want it to. */ - if (pty_flag) - signal (SIGHUP, SIG_DFL); + /* On AIX, we've disabled SIGHUP above once we start a child on a pty. + Now reenable it in the child, so it will die when we want it to. */ + if (pty_flag) + signal (SIGHUP, SIG_DFL); #endif #endif /* HAVE_PTYS */ - signal (SIGINT, SIG_DFL); - signal (SIGQUIT, SIG_DFL); - /* GConf causes us to ignore SIGPIPE, make sure it is restored - in the child. */ - signal (SIGPIPE, SIG_DFL); + signal (SIGINT, SIG_DFL); + signal (SIGQUIT, SIG_DFL); + + /* Emacs ignores SIGPIPE, but the child should not. */ + signal (SIGPIPE, SIG_DFL); #ifdef SIGCHLD /* Stop blocking signals in the child. */ - pthread_sigmask (SIG_SETMASK, &procmask, 0); + pthread_sigmask (SIG_SETMASK, &empty_mask, 0); #endif - if (pty_flag) - child_setup_tty (xforkout); + if (pty_flag) + child_setup_tty (xforkout); #ifdef WINDOWSNT - pid = child_setup (xforkin, xforkout, xforkout, - new_argv, 1, encoded_current_dir); + pid = child_setup (xforkin, xforkout, xforkout, + new_argv, 1, encoded_current_dir); #else /* not WINDOWSNT */ #ifdef FD_CLOEXEC - emacs_close (wait_child_setup[0]); + emacs_close (wait_child_setup[0]); #endif - child_setup (xforkin, xforkout, xforkout, - new_argv, 1, encoded_current_dir); + child_setup (xforkin, xforkout, xforkout, + new_argv, 1, encoded_current_dir); #endif /* not WINDOWSNT */ - } - environ = save_environ; - } + } + + /* Back in the parent process. */ + +#if HAVE_WORKING_VFORK + environ = save_environ; +#endif + + XPROCESS (process)->pid = pid; - UNBLOCK_INPUT; + /* Stop blocking signals in the parent. */ +#ifdef SIGCHLD + pthread_sigmask (SIG_SETMASK, &empty_mask, 0); +#endif + unblock_input (); - /* This runs in the Emacs process. */ if (pid < 0) { if (forkin >= 0) @@ -1897,7 +1915,6 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) else { /* vfork succeeded. */ - XPROCESS (process)->pid = pid; #ifdef WINDOWSNT register_child (pid, inchannel); @@ -1923,12 +1940,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) if (forkin != forkout && forkout >= 0) emacs_close (forkout); -#ifdef HAVE_PTYS - if (pty_flag) - pset_tty_name (XPROCESS (process), build_string (pty_name)); - else -#endif - pset_tty_name (XPROCESS (process), Qnil); + pset_tty_name (XPROCESS (process), lisp_pty_name); #if !defined (WINDOWSNT) && defined (FD_CLOEXEC) /* Wait for child_setup to complete in case that vfork is @@ -1945,11 +1957,6 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) #endif } -#ifdef SIGCHLD - /* Stop blocking signals in the parent. */ - pthread_sigmask (SIG_SETMASK, &procmask, 0); -#endif - /* Now generate the error if vfork failed. */ if (pid < 0) report_file_error ("Doing vfork", Qnil); @@ -3402,9 +3409,9 @@ usage: (make-network-process &rest ARGS) */) #ifdef HAVE_GETADDRINFO if (res != &ai) { - BLOCK_INPUT; + block_input (); freeaddrinfo (res); - UNBLOCK_INPUT; + unblock_input (); } #endif @@ -4372,7 +4379,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, Otherwise, do pending quit if requested. */ if (read_kbd >= 0) QUIT; - else + else if (pending_signals) process_pending_signals (); /* Exit now if the cell we're waiting for became non-nil. */ @@ -4739,21 +4746,6 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, check_write = 0; } -#if 0 /* When polling is used, interrupt_input is 0, - so get_input_pending should read the input. - So this should not be needed. */ - /* If we are using polling for input, - and we see input available, make it get read now. - Otherwise it might not actually get read for a second. - And on hpux, since we turn off polling in wait_reading_process_output, - it might never get read at all if we don't spend much time - outside of wait_reading_process_output. */ - if (read_kbd && interrupt_input - && keyboard_bit_set (&Available) - && input_polling_used ()) - kill (getpid (), SIGALRM); -#endif - /* Check for keyboard input */ /* If there is any, return immediately to give it higher priority than subprocesses */ @@ -4817,7 +4809,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, if (read_kbd && interrupt_input && keyboard_bit_set (&Available) && ! noninteractive) - kill (getpid (), SIGIO); + handle_input_available_signal (SIGIO); #endif if (! wait_proc) @@ -4937,7 +4929,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, pset_status (p, Qfailed); } else - kill (getpid (), SIGCHLD); + handle_child_signal (SIGCHLD); } #endif /* HAVE_PTYS */ /* If we can detect process termination, don't consider the @@ -5393,25 +5385,6 @@ read_process_output (Lisp_Object proc, register int channel) /* Sending data to subprocess */ -static sys_jmp_buf send_process_frame; -static Lisp_Object process_sent_to; - -static _Noreturn void -handle_pipe_signal (int sig) -{ - sigset_t unblocked; - sigemptyset (&unblocked); - sigaddset (&unblocked, SIGPIPE); - pthread_sigmask (SIG_UNBLOCK, &unblocked, 0); - sys_longjmp (send_process_frame, 1); -} - -static void -deliver_pipe_signal (int sig) -{ - handle_on_main_thread (sig, handle_pipe_signal); -} - /* In send_process, when a write fails temporarily, wait_reading_process_output is called. It may execute user code, e.g. timers, that attempts to write new data to the same process. @@ -5495,14 +5468,12 @@ write_queue_pop (struct Lisp_Process *p, Lisp_Object *obj, This function can evaluate Lisp code and can garbage collect. */ static void -send_process (volatile Lisp_Object proc, const char *volatile buf, - volatile ptrdiff_t len, volatile Lisp_Object object) +send_process (Lisp_Object proc, const char *buf, ptrdiff_t len, + Lisp_Object object) { - /* Use volatile to protect variables from being clobbered by longjmp. */ struct Lisp_Process *p = XPROCESS (proc); ssize_t rv; struct coding_system *coding; - struct sigaction old_sigpipe_action; if (p->raw_status_new) update_status (p); @@ -5609,145 +5580,126 @@ send_process (volatile Lisp_Object proc, const char *volatile buf, pty_max_bytes--; } - /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2, - CFLAGS="-g -O": The value of the parameter `proc' is clobbered - when returning with longjmp despite being declared volatile. */ - if (!sys_setjmp (send_process_frame)) - { - p = XPROCESS (proc); /* Repair any setjmp clobbering. */ - process_sent_to = proc; + /* If there is already data in the write_queue, put the new data + in the back of queue. Otherwise, ignore it. */ + if (!NILP (p->write_queue)) + write_queue_push (p, object, buf, len, 0); - /* If there is already data in the write_queue, put the new data - in the back of queue. Otherwise, ignore it. */ - if (!NILP (p->write_queue)) - write_queue_push (p, object, buf, len, 0); + do /* while !NILP (p->write_queue) */ + { + ptrdiff_t cur_len = -1; + const char *cur_buf; + Lisp_Object cur_object; - do /* while !NILP (p->write_queue) */ + /* If write_queue is empty, ignore it. */ + if (!write_queue_pop (p, &cur_object, &cur_buf, &cur_len)) { - ptrdiff_t cur_len = -1; - const char *cur_buf; - Lisp_Object cur_object; + cur_len = len; + cur_buf = buf; + cur_object = object; + } - /* If write_queue is empty, ignore it. */ - if (!write_queue_pop (p, &cur_object, &cur_buf, &cur_len)) + while (cur_len > 0) + { + /* Send this batch, using one or more write calls. */ + ptrdiff_t written = 0; + int outfd = p->outfd; +#ifdef DATAGRAM_SOCKETS + if (DATAGRAM_CHAN_P (outfd)) { - cur_len = len; - cur_buf = buf; - cur_object = object; + rv = sendto (outfd, cur_buf, cur_len, + 0, datagram_address[outfd].sa, + datagram_address[outfd].len); + if (0 <= rv) + written = rv; + else if (errno == EMSGSIZE) + report_file_error ("sending datagram", Fcons (proc, Qnil)); } - - while (cur_len > 0) - { - /* Send this batch, using one or more write calls. */ - ptrdiff_t written = 0; - int outfd = p->outfd; - struct sigaction action; - emacs_sigaction_init (&action, deliver_pipe_signal); - sigaction (SIGPIPE, &action, &old_sigpipe_action); -#ifdef DATAGRAM_SOCKETS - if (DATAGRAM_CHAN_P (outfd)) - { - rv = sendto (outfd, cur_buf, cur_len, - 0, datagram_address[outfd].sa, - datagram_address[outfd].len); - if (0 <= rv) - written = rv; - else if (errno == EMSGSIZE) - { - sigaction (SIGPIPE, &old_sigpipe_action, 0); - report_file_error ("sending datagram", - Fcons (proc, Qnil)); - } - } - else + else #endif - { + { #ifdef HAVE_GNUTLS - if (p->gnutls_p) - written = emacs_gnutls_write (p, cur_buf, cur_len); - else + if (p->gnutls_p) + written = emacs_gnutls_write (p, cur_buf, cur_len); + else #endif - written = emacs_write (outfd, cur_buf, cur_len); - rv = (written ? 0 : -1); + written = emacs_write (outfd, cur_buf, cur_len); + rv = (written ? 0 : -1); #ifdef ADAPTIVE_READ_BUFFERING - if (p->read_output_delay > 0 - && p->adaptive_read_buffering == 1) - { - p->read_output_delay = 0; - process_output_delay_count--; - p->read_output_skip = 0; - } -#endif + if (p->read_output_delay > 0 + && p->adaptive_read_buffering == 1) + { + p->read_output_delay = 0; + process_output_delay_count--; + p->read_output_skip = 0; } - sigaction (SIGPIPE, &old_sigpipe_action, 0); +#endif + } - if (rv < 0) - { - if (0 + if (rv < 0) + { + if (0 #ifdef EWOULDBLOCK - || errno == EWOULDBLOCK + || errno == EWOULDBLOCK #endif #ifdef EAGAIN - || errno == EAGAIN + || errno == EAGAIN #endif - ) - /* Buffer is full. Wait, accepting input; - that may allow the program - to finish doing output and read more. */ - { + ) + /* Buffer is full. Wait, accepting input; + that may allow the program + to finish doing output and read more. */ + { #ifdef BROKEN_PTY_READ_AFTER_EAGAIN - /* A gross hack to work around a bug in FreeBSD. - In the following sequence, read(2) returns - bogus data: - - write(2) 1022 bytes - write(2) 954 bytes, get EAGAIN - read(2) 1024 bytes in process_read_output - read(2) 11 bytes in process_read_output - - That is, read(2) returns more bytes than have - ever been written successfully. The 1033 bytes - read are the 1022 bytes written successfully - after processing (for example with CRs added if - the terminal is set up that way which it is - here). The same bytes will be seen again in a - later read(2), without the CRs. */ - - if (errno == EAGAIN) - { - int flags = FWRITE; - ioctl (p->outfd, TIOCFLUSH, &flags); - } + /* A gross hack to work around a bug in FreeBSD. + In the following sequence, read(2) returns + bogus data: + + write(2) 1022 bytes + write(2) 954 bytes, get EAGAIN + read(2) 1024 bytes in process_read_output + read(2) 11 bytes in process_read_output + + That is, read(2) returns more bytes than have + ever been written successfully. The 1033 bytes + read are the 1022 bytes written successfully + after processing (for example with CRs added if + the terminal is set up that way which it is + here). The same bytes will be seen again in a + later read(2), without the CRs. */ + + if (errno == EAGAIN) + { + int flags = FWRITE; + ioctl (p->outfd, TIOCFLUSH, &flags); + } #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */ - /* Put what we should have written in wait_queue. */ - write_queue_push (p, cur_object, cur_buf, cur_len, 1); - wait_reading_process_output (0, 20 * 1000 * 1000, - 0, 0, Qnil, NULL, 0); - /* Reread queue, to see what is left. */ - break; - } - else - /* This is a real error. */ - report_file_error ("writing to process", Fcons (proc, Qnil)); + /* Put what we should have written in wait_queue. */ + write_queue_push (p, cur_object, cur_buf, cur_len, 1); + wait_reading_process_output (0, 20 * 1000 * 1000, + 0, 0, Qnil, NULL, 0); + /* Reread queue, to see what is left. */ + break; } - cur_buf += written; - cur_len -= written; + else if (errno == EPIPE) + { + p->raw_status_new = 0; + pset_status (p, list2 (Qexit, make_number (256))); + p->tick = ++process_tick; + deactivate_process (proc); + error ("process %s no longer connected to pipe; closed it", + SDATA (p->name)); + } + else + /* This is a real error. */ + report_file_error ("writing to process", Fcons (proc, Qnil)); } + cur_buf += written; + cur_len -= written; } - while (!NILP (p->write_queue)); - } - else - { - sigaction (SIGPIPE, &old_sigpipe_action, 0); - proc = process_sent_to; - p = XPROCESS (proc); - p->raw_status_new = 0; - pset_status (p, Fcons (Qexit, Fcons (make_number (256), Qnil))); - p->tick = ++process_tick; - deactivate_process (proc); - error ("SIGPIPE raised on process %s; closed it", SDATA (p->name)); } + while (!NILP (p->write_queue)); } DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region, @@ -6178,39 +6130,27 @@ SIGCODE may be an integer, or a symbol whose name is a signal name. */) #ifdef SIGUSR2 parse_signal ("usr2", SIGUSR2); #endif -#ifdef SIGTERM parse_signal ("term", SIGTERM); -#endif #ifdef SIGHUP parse_signal ("hup", SIGHUP); #endif -#ifdef SIGINT parse_signal ("int", SIGINT); -#endif #ifdef SIGQUIT parse_signal ("quit", SIGQUIT); #endif -#ifdef SIGILL parse_signal ("ill", SIGILL); -#endif -#ifdef SIGABRT parse_signal ("abrt", SIGABRT); -#endif #ifdef SIGEMT parse_signal ("emt", SIGEMT); #endif #ifdef SIGKILL parse_signal ("kill", SIGKILL); #endif -#ifdef SIGFPE parse_signal ("fpe", SIGFPE); -#endif #ifdef SIGBUS parse_signal ("bus", SIGBUS); #endif -#ifdef SIGSEGV parse_signal ("segv", SIGSEGV); -#endif #ifdef SIGSYS parse_signal ("sys", SIGSYS); #endif @@ -6375,27 +6315,15 @@ process has been transmitted to the serial port. */) ** Malloc WARNING: This should never call malloc either directly or indirectly; if it does, that is a bug */ -#ifdef SIGCHLD - -/* Record one child's changed status. Return true if a child was found. */ -static bool -record_child_status_change (void) +/* Record the changed status of the child process PID with wait status W. */ +void +record_child_status_change (pid_t pid, int w) { +#ifdef SIGCHLD Lisp_Object proc; struct Lisp_Process *p; - pid_t pid; - int w; Lisp_Object tail; - do - pid = waitpid (-1, &w, WNOHANG | WUNTRACED); - while (pid < 0 && errno == EINTR); - - /* PID == 0 means no processes found, PID == -1 means a real failure. - Either way, we have done all our job. */ - if (pid <= 0) - return false; - /* Find the process that signaled us, and record its status. */ /* The process can have been deleted by Fdelete_process. */ @@ -6406,7 +6334,7 @@ record_child_status_change (void) || (FLOATP (xpid) && pid == XFLOAT_DATA (xpid))) { XSETCAR (tail, Qnil); - return true; + return; } } @@ -6476,10 +6404,11 @@ record_child_status_change (void) if (input_available_clear_time) *input_available_clear_time = make_emacs_time (0, 0); } - - return true; +#endif } +#ifdef SIGCHLD + /* On some systems, the SIGCHLD handler must return right away. If any more processes want to signal us, we will get another signal. Otherwise, loop around to use up all the processes that have @@ -6495,14 +6424,29 @@ enum { CAN_HANDLE_MULTIPLE_CHILDREN = 1 }; static void handle_child_signal (int sig) { - while (record_child_status_change () && CAN_HANDLE_MULTIPLE_CHILDREN) - continue; + do + { + pid_t pid; + int status; + + do + pid = waitpid (-1, &status, WNOHANG | WUNTRACED); + while (pid < 0 && errno == EINTR); + + /* PID == 0 means no processes found, PID == -1 means a real failure. + Either way, we have done all our job. */ + if (pid <= 0) + break; + + record_child_status_change (pid, status); + } + while (CAN_HANDLE_MULTIPLE_CHILDREN); } static void deliver_child_signal (int sig) { - handle_on_main_thread (sig, handle_child_signal); + deliver_process_signal (sig, handle_child_signal); } #endif /* SIGCHLD */ diff --git a/src/profiler.c b/src/profiler.c new file mode 100644 index 00000000000..90a85c5230e --- /dev/null +++ b/src/profiler.c @@ -0,0 +1,518 @@ +/* Profiler implementation. + +Copyright (C) 2012 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ + +#include <config.h> +#include "lisp.h" +#include "syssignal.h" +#include "systime.h" + +/* Return A + B, but return the maximum fixnum if the result would overflow. + Assume A and B are nonnegative and in fixnum range. */ + +static EMACS_INT +saturated_add (EMACS_INT a, EMACS_INT b) +{ + return min (a + b, MOST_POSITIVE_FIXNUM); +} + +/* Logs. */ + +typedef struct Lisp_Hash_Table log_t; + +static Lisp_Object +make_log (int heap_size, int max_stack_depth) +{ + /* We use a standard Elisp hash-table object, but we use it in + a special way. This is OK as long as the object is not exposed + to Elisp, i.e. until it is returned by *-profiler-log, after which + it can't be used any more. */ + Lisp_Object log = make_hash_table (Qequal, make_number (heap_size), + make_float (DEFAULT_REHASH_SIZE), + make_float (DEFAULT_REHASH_THRESHOLD), + Qnil, Qnil, Qnil); + struct Lisp_Hash_Table *h = XHASH_TABLE (log); + + /* What is special about our hash-tables is that the keys are pre-filled + with the vectors we'll put in them. */ + int i = ASIZE (h->key_and_value) / 2; + while (0 < i) + set_hash_key_slot (h, --i, + Fmake_vector (make_number (max_stack_depth), Qnil)); + return log; +} + +/* Evict the least used half of the hash_table. + + When the table is full, we have to evict someone. + The easiest and most efficient is to evict the value we're about to add + (i.e. once the table is full, stop sampling). + + We could also pick the element with the lowest count and evict it, + but finding it is O(N) and for that amount of work we get very + little in return: for the next sample, this latest sample will have + count==1 and will hence be a prime candidate for eviction :-( + + So instead, we take O(N) time to eliminate more or less half of the + entries (the half with the lowest counts). So we get an amortized + cost of O(1) and we get O(N) time for a new entry to grow larger + than the other least counts before a new round of eviction. */ + +static EMACS_INT approximate_median (log_t *log, + ptrdiff_t start, ptrdiff_t size) +{ + eassert (size > 0); + if (size < 2) + return XINT (HASH_VALUE (log, start)); + if (size < 3) + /* Not an actual median, but better for our application than + choosing either of the two numbers. */ + return ((XINT (HASH_VALUE (log, start)) + + XINT (HASH_VALUE (log, start + 1))) + / 2); + else + { + ptrdiff_t newsize = size / 3; + ptrdiff_t start2 = start + newsize; + EMACS_INT i1 = approximate_median (log, start, newsize); + EMACS_INT i2 = approximate_median (log, start2, newsize); + EMACS_INT i3 = approximate_median (log, start2 + newsize, + size - 2 * newsize); + return (i1 < i2 + ? (i2 < i3 ? i2 : (i1 < i3 ? i3 : i1)) + : (i1 < i3 ? i1 : (i2 < i3 ? i3 : i2))); + } +} + +static void evict_lower_half (log_t *log) +{ + ptrdiff_t size = ASIZE (log->key_and_value) / 2; + EMACS_INT median = approximate_median (log, 0, size); + ptrdiff_t i; + + for (i = 0; i < size; i++) + /* Evict not only values smaller but also values equal to the median, + so as to make sure we evict something no matter what. */ + if (XINT (HASH_VALUE (log, i)) <= median) + { + Lisp_Object key = HASH_KEY (log, i); + { /* FIXME: we could make this more efficient. */ + Lisp_Object tmp; + XSET_HASH_TABLE (tmp, log); /* FIXME: Use make_lisp_ptr. */ + Fremhash (key, tmp); + } + eassert (EQ (log->next_free, make_number (i))); + { + int j; + eassert (VECTORP (key)); + for (j = 0; j < ASIZE (key); j++) + ASET (key, j, Qnil); + } + set_hash_key_slot (log, i, key); + } +} + +/* Record the current backtrace in LOG. COUNT is the weight of this + current backtrace: milliseconds for CPU counts, and the allocation + size for memory logs. */ + +static void +record_backtrace (log_t *log, EMACS_INT count) +{ + struct backtrace *backlist = backtrace_list; + Lisp_Object backtrace; + ptrdiff_t index, i = 0; + ptrdiff_t asize; + + if (!INTEGERP (log->next_free)) + /* FIXME: transfer the evicted counts to a special entry rather + than dropping them on the floor. */ + evict_lower_half (log); + index = XINT (log->next_free); + + /* Get a "working memory" vector. */ + backtrace = HASH_KEY (log, index); + asize = ASIZE (backtrace); + + /* Copy the backtrace contents into working memory. */ + for (; i < asize && backlist; i++, backlist = backlist->next) + /* FIXME: For closures we should ignore the environment. */ + ASET (backtrace, i, backlist->function); + + /* Make sure that unused space of working memory is filled with nil. */ + for (; i < asize; i++) + ASET (backtrace, i, Qnil); + + { /* We basically do a `gethash+puthash' here, except that we have to be + careful to avoid memory allocation since we're in a signal + handler, and we optimize the code to try and avoid computing the + hash+lookup twice. See fns.c:Fputhash for reference. */ + EMACS_UINT hash; + ptrdiff_t j = hash_lookup (log, backtrace, &hash); + if (j >= 0) + { + EMACS_INT old_val = XINT (HASH_VALUE (log, j)); + EMACS_INT new_val = saturated_add (old_val, count); + set_hash_value_slot (log, j, make_number (new_val)); + } + else + { /* BEWARE! hash_put in general can allocate memory. + But currently it only does that if log->next_free is nil. */ + int j; + eassert (!NILP (log->next_free)); + j = hash_put (log, backtrace, make_number (count), hash); + /* Let's make sure we've put `backtrace' right where it + already was to start with. */ + eassert (index == j); + + /* FIXME: If the hash-table is almost full, we should set + some global flag so that some Elisp code can offload its + data elsewhere, so as to avoid the eviction code. + There are 2 ways to do that, AFAICT: + - Set a flag checked in QUIT, such that QUIT can then call + Fprofiler_cpu_log and stash the full log for later use. + - Set a flag check in post-gc-hook, so that Elisp code can call + profiler-cpu-log. That gives us more flexibility since that + Elisp code can then do all kinds of fun stuff like write + the log to disk. Or turn it right away into a call tree. + Of course, using Elisp is generally preferable, but it may + take longer until we get a chance to run the Elisp code, so + there's more risk that the table will get full before we + get there. */ + } + } +} + +/* Sample profiler. */ + +/* FIXME: Add support for the CPU profiler in W32. */ + +#ifdef PROFILER_CPU_SUPPORT + +/* The profiler timer and whether it was properly initialized, if + POSIX timers are available. */ +#ifdef HAVE_TIMER_SETTIME +static timer_t profiler_timer; +static bool profiler_timer_ok; +#endif + +/* Status of sampling profiler. */ +static enum profiler_cpu_running + { NOT_RUNNING, TIMER_SETTIME_RUNNING, SETITIMER_RUNNING } + profiler_cpu_running; + +/* Hash-table log of CPU profiler. */ +static Lisp_Object cpu_log; + +/* Separate counter for the time spent in the GC. */ +static EMACS_INT cpu_gc_count; + +/* The current sample interval in milliseconds. */ +static EMACS_INT current_sample_interval; + +/* Signal handler for sample profiler. */ + +static void +handle_profiler_signal (int signal) +{ + if (backtrace_list && EQ (backtrace_list->function, Qautomatic_gc)) + /* Special case the time-count inside GC because the hash-table + code is not prepared to be used while the GC is running. + More specifically it uses ASIZE at many places where it does + not expect the ARRAY_MARK_FLAG to be set. We could try and + harden the hash-table code, but it doesn't seem worth the + effort. */ + cpu_gc_count = saturated_add (cpu_gc_count, current_sample_interval); + else + { + eassert (HASH_TABLE_P (cpu_log)); + record_backtrace (XHASH_TABLE (cpu_log), current_sample_interval); + } +} + +static void +deliver_profiler_signal (int signal) +{ + deliver_process_signal (signal, handle_profiler_signal); +} + +static enum profiler_cpu_running +setup_cpu_timer (Lisp_Object sample_interval) +{ + struct sigaction action; + struct itimerval timer; + struct timespec interval; + + if (! RANGED_INTEGERP (1, sample_interval, + (TYPE_MAXIMUM (time_t) < EMACS_INT_MAX / 1000 + ? (EMACS_INT) TYPE_MAXIMUM (time_t) * 1000 + 999 + : EMACS_INT_MAX))) + return NOT_RUNNING; + + current_sample_interval = XINT (sample_interval); + interval = make_emacs_time (current_sample_interval / 1000, + current_sample_interval % 1000 * 1000000); + emacs_sigaction_init (&action, deliver_profiler_signal); + sigaction (SIGPROF, &action, 0); + +#ifdef HAVE_TIMER_SETTIME + if (! profiler_timer_ok) + { + /* System clocks to try, in decreasing order of desirability. */ + static clockid_t const system_clock[] = { +#ifdef CLOCK_THREAD_CPUTIME_ID + CLOCK_THREAD_CPUTIME_ID, +#endif +#ifdef CLOCK_PROCESS_CPUTIME_ID + CLOCK_PROCESS_CPUTIME_ID, +#endif +#ifdef CLOCK_MONOTONIC + CLOCK_MONOTONIC, +#endif + CLOCK_REALTIME + }; + int i; + struct sigevent sigev; + sigev.sigev_value.sival_ptr = &profiler_timer; + sigev.sigev_signo = SIGPROF; + sigev.sigev_notify = SIGEV_SIGNAL; + + for (i = 0; i < sizeof system_clock / sizeof *system_clock; i++) + if (timer_create (system_clock[i], &sigev, &profiler_timer) == 0) + { + profiler_timer_ok = 1; + break; + } + } + + if (profiler_timer_ok) + { + struct itimerspec ispec; + ispec.it_value = ispec.it_interval = interval; + timer_settime (profiler_timer, 0, &ispec, 0); + return TIMER_SETTIME_RUNNING; + } +#endif + + timer.it_value = timer.it_interval = make_timeval (interval); + setitimer (ITIMER_PROF, &timer, 0); + return SETITIMER_RUNNING; +} + +DEFUN ("profiler-cpu-start", Fprofiler_cpu_start, Sprofiler_cpu_start, + 1, 1, 0, + doc: /* Start or restart the cpu profiler. +It takes call-stack samples each SAMPLE-INTERVAL milliseconds. +See also `profiler-log-size' and `profiler-max-stack-depth'. */) + (Lisp_Object sample_interval) +{ + if (profiler_cpu_running) + error ("Sample profiler is already running"); + + if (NILP (cpu_log)) + { + cpu_gc_count = 0; + cpu_log = make_log (profiler_log_size, + profiler_max_stack_depth); + } + + profiler_cpu_running = setup_cpu_timer (sample_interval); + if (! profiler_cpu_running) + error ("Invalid sample interval"); + + return Qt; +} + +DEFUN ("profiler-cpu-stop", Fprofiler_cpu_stop, Sprofiler_cpu_stop, + 0, 0, 0, + doc: /* Stop the cpu profiler. The profiler log is not affected. +Return non-nil if the profiler was running. */) + (void) +{ + switch (profiler_cpu_running) + { + case NOT_RUNNING: + return Qnil; + +#ifdef HAVE_TIMER_SETTIME + case TIMER_SETTIME_RUNNING: + { + struct itimerspec disable; + memset (&disable, 0, sizeof disable); + timer_settime (profiler_timer, 0, &disable, 0); + } + break; +#endif + + case SETITIMER_RUNNING: + { + struct itimerval disable; + memset (&disable, 0, sizeof disable); + setitimer (ITIMER_PROF, &disable, 0); + } + break; + } + + signal (SIGPROF, SIG_IGN); + profiler_cpu_running = NOT_RUNNING; + return Qt; +} + +DEFUN ("profiler-cpu-running-p", + Fprofiler_cpu_running_p, Sprofiler_cpu_running_p, + 0, 0, 0, + doc: /* Return non-nil iff cpu profiler is running. */) + (void) +{ + return profiler_cpu_running ? Qt : Qnil; +} + +DEFUN ("profiler-cpu-log", Fprofiler_cpu_log, Sprofiler_cpu_log, + 0, 0, 0, + doc: /* Return the current cpu profiler log. +The log is a hash-table mapping backtraces to counters which represent +the amount of time spent at those points. Every backtrace is a vector +of functions, where the last few elements may be nil. +Before returning, a new log is allocated for future samples. */) + (void) +{ + Lisp_Object result = cpu_log; + /* Here we're making the log visible to Elisp, so it's not safe any + more for our use afterwards since we can't rely on its special + pre-allocated keys anymore. So we have to allocate a new one. */ + cpu_log = (profiler_cpu_running + ? make_log (profiler_log_size, profiler_max_stack_depth) + : Qnil); + Fputhash (Fmake_vector (make_number (1), Qautomatic_gc), + make_number (cpu_gc_count), + result); + cpu_gc_count = 0; + return result; +} +#endif /* PROFILER_CPU_SUPPORT */ + +/* Memory profiler. */ + +/* True if memory profiler is running. */ +bool profiler_memory_running; + +static Lisp_Object memory_log; + +DEFUN ("profiler-memory-start", Fprofiler_memory_start, Sprofiler_memory_start, + 0, 0, 0, + doc: /* Start/restart the memory profiler. +The memory profiler will take samples of the call-stack whenever a new +allocation takes place. Note that most small allocations only trigger +the profiler occasionally. +See also `profiler-log-size' and `profiler-max-stack-depth'. */) + (void) +{ + if (profiler_memory_running) + error ("Memory profiler is already running"); + + if (NILP (memory_log)) + memory_log = make_log (profiler_log_size, + profiler_max_stack_depth); + + profiler_memory_running = true; + + return Qt; +} + +DEFUN ("profiler-memory-stop", + Fprofiler_memory_stop, Sprofiler_memory_stop, + 0, 0, 0, + doc: /* Stop the memory profiler. The profiler log is not affected. +Return non-nil if the profiler was running. */) + (void) +{ + if (!profiler_memory_running) + return Qnil; + profiler_memory_running = false; + return Qt; +} + +DEFUN ("profiler-memory-running-p", + Fprofiler_memory_running_p, Sprofiler_memory_running_p, + 0, 0, 0, + doc: /* Return non-nil if memory profiler is running. */) + (void) +{ + return profiler_memory_running ? Qt : Qnil; +} + +DEFUN ("profiler-memory-log", + Fprofiler_memory_log, Sprofiler_memory_log, + 0, 0, 0, + doc: /* Return the current memory profiler log. +The log is a hash-table mapping backtraces to counters which represent +the amount of memory allocated at those points. Every backtrace is a vector +of functions, where the last few elements may be nil. +Before returning, a new log is allocated for future samples. */) + (void) +{ + Lisp_Object result = memory_log; + /* Here we're making the log visible to Elisp , so it's not safe any + more for our use afterwards since we can't rely on its special + pre-allocated keys anymore. So we have to allocate a new one. */ + memory_log = (profiler_memory_running + ? make_log (profiler_log_size, profiler_max_stack_depth) + : Qnil); + return result; +} + + +/* Signals and probes. */ + +/* Record that the current backtrace allocated SIZE bytes. */ +void +malloc_probe (size_t size) +{ + eassert (HASH_TABLE_P (memory_log)); + record_backtrace (XHASH_TABLE (memory_log), min (size, MOST_POSITIVE_FIXNUM)); +} + +void +syms_of_profiler (void) +{ + DEFVAR_INT ("profiler-max-stack-depth", profiler_max_stack_depth, + doc: /* Number of elements from the call-stack recorded in the log. */); + profiler_max_stack_depth = 16; + DEFVAR_INT ("profiler-log-size", profiler_log_size, + doc: /* Number of distinct call-stacks that can be recorded in a profiler log. +If the log gets full, some of the least-seen call-stacks will be evicted +to make room for new entries. */); + profiler_log_size = 10000; + +#ifdef PROFILER_CPU_SUPPORT + profiler_cpu_running = NOT_RUNNING; + cpu_log = Qnil; + staticpro (&cpu_log); + defsubr (&Sprofiler_cpu_start); + defsubr (&Sprofiler_cpu_stop); + defsubr (&Sprofiler_cpu_running_p); + defsubr (&Sprofiler_cpu_log); +#endif + profiler_memory_running = false; + memory_log = Qnil; + staticpro (&memory_log); + defsubr (&Sprofiler_memory_start); + defsubr (&Sprofiler_memory_stop); + defsubr (&Sprofiler_memory_running_p); + defsubr (&Sprofiler_memory_log); +} diff --git a/src/ralloc.c b/src/ralloc.c index 9a4b1ada229..ab91baae5b5 100644 --- a/src/ralloc.c +++ b/src/ralloc.c @@ -1199,9 +1199,9 @@ r_alloc_init (void) #endif #ifdef DOUG_LEA_MALLOC - BLOCK_INPUT; + block_input (); mallopt (M_TOP_PAD, 64 * 4096); - UNBLOCK_INPUT; + unblock_input (); #else #ifndef SYSTEM_MALLOC /* Give GNU malloc's morecore some hysteresis so that we move all diff --git a/src/search.c b/src/search.c index 5224556fa17..7c084c62e28 100644 --- a/src/search.c +++ b/src/search.c @@ -156,7 +156,7 @@ compile_pattern_1 (struct regexp_cache *cp, Lisp_Object pattern, Lisp_Object tra re_set_whitespace_regexp (NULL); re_set_syntax (old); - /* UNBLOCK_INPUT; */ + /* unblock_input (); */ if (val) xsignal1 (Qinvalid_regexp, build_string (val)); diff --git a/src/sysdep.c b/src/sysdep.c index dbfd9efc7d4..b7141011d05 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -279,10 +279,6 @@ init_baud_rate (int fd) -/* Set nonzero to make following function work under dbx - (at least for bsd). */ -int wait_debugging EXTERNALLY_VISIBLE; - #ifndef MSDOS static void @@ -290,48 +286,24 @@ wait_for_termination_1 (pid_t pid, int interruptible) { while (1) { -#if (defined (BSD_SYSTEM) || defined (HPUX)) && !defined (__GNU__) - /* Note that kill returns -1 even if the process is just a zombie now. - But inevitably a SIGCHLD interrupt should be generated - and child_sig will do waitpid and make the process go away. */ - /* There is some indication that there is a bug involved with - termination of subprocesses, perhaps involving a kernel bug too, - but no idea what it is. Just as a hunch we signal SIGCHLD to see - if that causes the problem to go away or get worse. */ - sigset_t sigchild_mask; - sigemptyset (&sigchild_mask); - sigaddset (&sigchild_mask, SIGCHLD); - pthread_sigmask (SIG_SETMASK, &sigchild_mask, 0); - - if (0 > kill (pid, 0)) - { - pthread_sigmask (SIG_SETMASK, &empty_mask, 0); - kill (getpid (), SIGCHLD); - break; - } - if (wait_debugging) - sleep (1); - else - sigsuspend (&empty_mask); -#else /* not BSD_SYSTEM, and not HPUX version >= 6 */ #ifdef WINDOWSNT wait (0); break; #else /* not WINDOWSNT */ - sigset_t blocked; - sigemptyset (&blocked); - sigaddset (&blocked, SIGCHLD); - pthread_sigmask (SIG_BLOCK, &blocked, 0); - errno = 0; - if (kill (pid, 0) == -1 && errno == ESRCH) + int status; + int wait_result = waitpid (pid, &status, 0); + if (wait_result < 0) { - pthread_sigmask (SIG_UNBLOCK, &blocked, 0); + if (errno != EINTR) + break; + } + else + { + record_child_status_change (wait_result, status); break; } - sigsuspend (&empty_mask); #endif /* not WINDOWSNT */ -#endif /* not BSD_SYSTEM, and not HPUX version >= 6 */ if (interruptible) QUIT; } @@ -1438,40 +1410,80 @@ init_system_name (void) sigset_t empty_mask; -/* Store into *ACTION a signal action suitable for Emacs, with handler - HANDLER. */ -void -emacs_sigaction_init (struct sigaction *action, signal_handler_t handler) +static struct sigaction process_fatal_action; + +static int +emacs_sigaction_flags (void) { - sigemptyset (&action->sa_mask); - action->sa_handler = handler; - action->sa_flags = 0; -#if defined (SA_RESTART) +#ifdef SA_RESTART /* SA_RESTART causes interruptible functions with timeouts (e.g., 'select') to reset their timeout on some platforms (e.g., HP-UX 11), which is not what we want. Also, when Emacs is interactive, we don't want SA_RESTART because we need to poll for pending input so we need long-running syscalls to be interrupted - after a signal that sets the interrupt_input_pending flag. */ - /* Non-interactive keyboard input goes through stdio, where we always - want restartable system calls. */ + after a signal that sets pending_signals. + + Non-interactive keyboard input goes through stdio, where we + always want restartable system calls. */ if (noninteractive) - action->sa_flags = SA_RESTART; + return SA_RESTART; +#endif + return 0; +} + +/* Store into *ACTION a signal action suitable for Emacs, with handler + HANDLER. */ +void +emacs_sigaction_init (struct sigaction *action, signal_handler_t handler) +{ + sigemptyset (&action->sa_mask); + + /* When handling a signal, block nonfatal system signals that are caught + by Emacs. This makes race conditions less likely. */ + sigaddset (&action->sa_mask, SIGALRM); +#ifdef SIGCHLD + sigaddset (&action->sa_mask, SIGCHLD); +#endif +#ifdef SIGDANGER + sigaddset (&action->sa_mask, SIGDANGER); #endif +#ifdef PROFILER_CPU_SUPPORT + sigaddset (&action->sa_mask, SIGPROF); +#endif +#ifdef SIGWINCH + sigaddset (&action->sa_mask, SIGWINCH); +#endif + if (! noninteractive) + { + sigaddset (&action->sa_mask, SIGINT); + sigaddset (&action->sa_mask, SIGQUIT); +#ifdef USABLE_SIGIO + sigaddset (&action->sa_mask, SIGIO); +#endif + } + + if (! IEEE_FLOATING_POINT) + sigaddset (&action->sa_mask, SIGFPE); + + action->sa_handler = handler; + action->sa_flags = emacs_sigaction_flags (); } #ifdef FORWARD_SIGNAL_TO_MAIN_THREAD static pthread_t main_thread; #endif -/* If we are on the main thread, handle the signal SIG with HANDLER. +/* SIG has arrived at the current process. Deliver it to the main + thread, which should handle it with HANDLER. + + If we are on the main thread, handle the signal SIG with HANDLER. Otherwise, redirect the signal to the main thread, blocking it from this thread. POSIX says any thread can receive a signal that is associated with a process, process group, or asynchronous event. On GNU/Linux that is not true, but for other systems (FreeBSD at least) it is. */ void -handle_on_main_thread (int sig, signal_handler_t handler) +deliver_process_signal (int sig, signal_handler_t handler) { /* Preserve errno, to avoid race conditions with signal handlers that might change errno. Races can occur even in single-threaded hosts. */ @@ -1494,6 +1506,39 @@ handle_on_main_thread (int sig, signal_handler_t handler) errno = old_errno; } + +/* Static location to save a fatal backtrace in a thread. + FIXME: If two subsidiary threads fail simultaneously, the resulting + backtrace may be garbage. */ +enum { BACKTRACE_LIMIT_MAX = 500 }; +static void *thread_backtrace_buffer[BACKTRACE_LIMIT_MAX + 1]; +static int thread_backtrace_npointers; + +/* SIG has arrived at the current thread. + If we are on the main thread, handle the signal SIG with HANDLER. + Otherwise, this is a fatal error in the handling thread. */ +static void +deliver_thread_signal (int sig, signal_handler_t handler) +{ + int old_errno = errno; + +#ifdef FORWARD_SIGNAL_TO_MAIN_THREAD + if (! pthread_equal (pthread_self (), main_thread)) + { + thread_backtrace_npointers + = backtrace (thread_backtrace_buffer, BACKTRACE_LIMIT_MAX); + sigaction (sig, &process_fatal_action, 0); + pthread_kill (main_thread, sig); + + /* Avoid further damage while the main thread is exiting. */ + while (1) + sigsuspend (&empty_mask); + } +#endif + + handler (sig); + errno = old_errno; +} #if !defined HAVE_STRSIGNAL && !HAVE_DECL_SYS_SIGLIST static char *my_sys_siglist[NSIG]; @@ -1503,9 +1548,60 @@ static char *my_sys_siglist[NSIG]; # define sys_siglist my_sys_siglist #endif +/* Handle bus errors, invalid instruction, etc. */ +static void +handle_fatal_signal (int sig) +{ + terminate_due_to_signal (sig, 40); +} + +static void +deliver_fatal_signal (int sig) +{ + deliver_process_signal (sig, handle_fatal_signal); +} + +static void +deliver_fatal_thread_signal (int sig) +{ + deliver_thread_signal (sig, handle_fatal_signal); +} + +static _Noreturn void +handle_arith_signal (int sig) +{ + pthread_sigmask (SIG_SETMASK, &empty_mask, 0); + xsignal0 (Qarith_error); +} + +static void +deliver_arith_signal (int sig) +{ + deliver_thread_signal (sig, handle_arith_signal); +} + +/* Treat SIG as a terminating signal, unless it is already ignored and + we are in --batch mode. Among other things, this makes nohup work. */ +static void +maybe_fatal_sig (int sig) +{ + bool catch_sig = !noninteractive; + if (!catch_sig) + { + struct sigaction old_action; + sigaction (sig, 0, &old_action); + catch_sig = old_action.sa_handler != SIG_IGN; + } + if (catch_sig) + sigaction (sig, &process_fatal_action, 0); +} + void -init_signals (void) +init_signals (bool dumping) { + struct sigaction thread_fatal_action; + struct sigaction action; + sigemptyset (&empty_mask); #ifdef FORWARD_SIGNAL_TO_MAIN_THREAD @@ -1515,9 +1611,7 @@ init_signals (void) #if !defined HAVE_STRSIGNAL && !HAVE_DECL_SYS_SIGLIST if (! initialized) { -# ifdef SIGABRT sys_siglist[SIGABRT] = "Aborted"; -# endif # ifdef SIGAIO sys_siglist[SIGAIO] = "LAN I/O interrupt"; # endif @@ -1545,9 +1639,7 @@ init_signals (void) # ifdef SIGEMT sys_siglist[SIGEMT] = "Emulation trap"; # endif -# ifdef SIGFPE sys_siglist[SIGFPE] = "Arithmetic exception"; -# endif # ifdef SIGFREEZE sys_siglist[SIGFREEZE] = "SIGFREEZE"; # endif @@ -1557,12 +1649,8 @@ init_signals (void) # ifdef SIGHUP sys_siglist[SIGHUP] = "Hangup"; # endif -# ifdef SIGILL sys_siglist[SIGILL] = "Illegal instruction"; -# endif -# ifdef SIGINT sys_siglist[SIGINT] = "Interrupt"; -# endif # ifdef SIGIO sys_siglist[SIGIO] = "I/O possible"; # endif @@ -1611,9 +1699,7 @@ init_signals (void) # ifdef SIGSAK sys_siglist[SIGSAK] = "Secure attention"; # endif -# ifdef SIGSEGV sys_siglist[SIGSEGV] = "Segmentation violation"; -# endif # ifdef SIGSOUND sys_siglist[SIGSOUND] = "Sound completed"; # endif @@ -1626,9 +1712,7 @@ init_signals (void) # ifdef SIGSYS sys_siglist[SIGSYS] = "Bad argument to system call"; # endif -# ifdef SIGTERM sys_siglist[SIGTERM] = "Terminated"; -# endif # ifdef SIGTHAW sys_siglist[SIGTHAW] = "SIGTHAW"; # endif @@ -1673,6 +1757,129 @@ init_signals (void) # endif } #endif /* !defined HAVE_STRSIGNAL && !defined HAVE_DECL_SYS_SIGLIST */ + + /* Don't alter signal handlers if dumping. On some machines, + changing signal handlers sets static data that would make signals + fail to work right when the dumped Emacs is run. */ + if (dumping) + return; + + sigfillset (&process_fatal_action.sa_mask); + process_fatal_action.sa_handler = deliver_fatal_signal; + process_fatal_action.sa_flags = emacs_sigaction_flags (); + + sigfillset (&thread_fatal_action.sa_mask); + thread_fatal_action.sa_handler = deliver_fatal_thread_signal; + thread_fatal_action.sa_flags = process_fatal_action.sa_flags; + + /* SIGINT may need special treatment on MS-Windows. See + http://lists.gnu.org/archive/html/emacs-devel/2010-09/msg01062.html + Please update the doc of kill-emacs, kill-emacs-hook, and + NEWS if you change this. */ + + maybe_fatal_sig (SIGHUP); + maybe_fatal_sig (SIGINT); + maybe_fatal_sig (SIGTERM); + + /* Emacs checks for write errors, so it can safely ignore SIGPIPE. + However, in batch mode leave SIGPIPE alone, as that causes Emacs + to behave more like typical batch applications do. */ + if (! noninteractive) + signal (SIGPIPE, SIG_IGN); + + sigaction (SIGQUIT, &process_fatal_action, 0); + sigaction (SIGILL, &thread_fatal_action, 0); + sigaction (SIGTRAP, &thread_fatal_action, 0); + + /* Typically SIGFPE is thread-specific and is fatal, like SIGILL. + But on a non-IEEE host SIGFPE can come from a trap in the Lisp + interpreter's floating point operations, so treat SIGFPE as an + arith-error if it arises in the main thread. */ + if (IEEE_FLOATING_POINT) + sigaction (SIGFPE, &thread_fatal_action, 0); + else + { + emacs_sigaction_init (&action, deliver_arith_signal); + sigaction (SIGFPE, &action, 0); + } + +#ifdef SIGUSR1 + add_user_signal (SIGUSR1, "sigusr1"); +#endif +#ifdef SIGUSR2 + add_user_signal (SIGUSR2, "sigusr2"); +#endif + sigaction (SIGABRT, &thread_fatal_action, 0); +#ifdef SIGPRE + sigaction (SIGPRE, &thread_fatal_action, 0); +#endif +#ifdef SIGORE + sigaction (SIGORE, &thread_fatal_action, 0); +#endif +#ifdef SIGUME + sigaction (SIGUME, &thread_fatal_action, 0); +#endif +#ifdef SIGDLK + sigaction (SIGDLK, &process_fatal_action, 0); +#endif +#ifdef SIGCPULIM + sigaction (SIGCPULIM, &process_fatal_action, 0); +#endif +#ifdef SIGIOT + sigaction (SIGIOT, &thread_fatal_action, 0); +#endif +#ifdef SIGEMT + sigaction (SIGEMT, &thread_fatal_action, 0); +#endif +#ifdef SIGBUS + sigaction (SIGBUS, &thread_fatal_action, 0); +#endif + sigaction (SIGSEGV, &thread_fatal_action, 0); +#ifdef SIGSYS + sigaction (SIGSYS, &thread_fatal_action, 0); +#endif + sigaction (SIGTERM, &process_fatal_action, 0); +#ifdef SIGPROF + signal (SIGPROF, SIG_IGN); +#endif +#ifdef SIGVTALRM + sigaction (SIGVTALRM, &process_fatal_action, 0); +#endif +#ifdef SIGXCPU + sigaction (SIGXCPU, &process_fatal_action, 0); +#endif +#ifdef SIGXFSZ + sigaction (SIGXFSZ, &process_fatal_action, 0); +#endif + +#ifdef SIGDANGER + /* This just means available memory is getting low. */ + emacs_sigaction_init (&action, deliver_danger_signal); + sigaction (SIGDANGER, &action, 0); +#endif + + /* AIX-specific signals. */ +#ifdef SIGGRANT + sigaction (SIGGRANT, &process_fatal_action, 0); +#endif +#ifdef SIGMIGRATE + sigaction (SIGMIGRATE, &process_fatal_action, 0); +#endif +#ifdef SIGMSG + sigaction (SIGMSG, &process_fatal_action, 0); +#endif +#ifdef SIGRETRACT + sigaction (SIGRETRACT, &process_fatal_action, 0); +#endif +#ifdef SIGSAK + sigaction (SIGSAK, &process_fatal_action, 0); +#endif +#ifdef SIGSOUND + sigaction (SIGSOUND, &process_fatal_action, 0); +#endif +#ifdef SIGTALRM + sigaction (SIGTALRM, &thread_fatal_action, 0); +#endif } #ifndef HAVE_RANDOM @@ -1811,23 +2018,36 @@ snprintf (char *buf, size_t bufsize, char const *format, ...) void emacs_backtrace (int backtrace_limit) { - enum { BACKTRACE_LIMIT_MAX = 500 }; - void *buffer[BACKTRACE_LIMIT_MAX + 1]; + void *main_backtrace_buffer[BACKTRACE_LIMIT_MAX + 1]; int bounded_limit = min (backtrace_limit, BACKTRACE_LIMIT_MAX); - int npointers = backtrace (buffer, bounded_limit + 1); + void *buffer; + int npointers; + + if (thread_backtrace_npointers) + { + buffer = thread_backtrace_buffer; + npointers = thread_backtrace_npointers; + } + else + { + buffer = main_backtrace_buffer; + npointers = backtrace (buffer, bounded_limit + 1); + } + if (npointers) - ignore_value (write (STDERR_FILENO, "\nBacktrace:\n", 12)); - backtrace_symbols_fd (buffer, bounded_limit, STDERR_FILENO); - if (bounded_limit < npointers) - ignore_value (write (STDERR_FILENO, "...\n", 4)); + { + ignore_value (write (STDERR_FILENO, "\nBacktrace:\n", 12)); + backtrace_symbols_fd (buffer, npointers, STDERR_FILENO); + if (bounded_limit < npointers) + ignore_value (write (STDERR_FILENO, "...\n", 4)); + } } #ifndef HAVE_NTGUI -/* Using emacs_abort lets GDB return from a breakpoint here. */ void emacs_abort (void) { - fatal_error_backtrace (SIGABRT, 10); + terminate_due_to_signal (SIGABRT, 10); } #endif @@ -1910,7 +2130,8 @@ emacs_write (int fildes, const char *buf, ptrdiff_t nbyte) { /* I originally used `QUIT' but that might causes files to be truncated if you hit C-g in the middle of it. --Stef */ - process_pending_signals (); + if (pending_signals) + process_pending_signals (); continue; } else @@ -1975,11 +2196,11 @@ getwd (char *pathname) char *npath, *spath; extern char *getcwd (char *, size_t); - BLOCK_INPUT; /* getcwd uses malloc */ + block_input (); /* getcwd uses malloc */ spath = npath = getcwd ((char *) 0, MAXPATHLEN); if (spath == 0) { - UNBLOCK_INPUT; + unblock_input (); return spath; } /* On Altos 3068, getcwd can return @hostname/dir, so discard @@ -1988,7 +2209,7 @@ getwd (char *pathname) npath++; strcpy (pathname, npath); free (spath); /* getcwd uses malloc */ - UNBLOCK_INPUT; + unblock_input (); return pathname; } @@ -2422,7 +2643,7 @@ get_up_time (void) FILE *fup; EMACS_TIME up = make_emacs_time (0, 0); - BLOCK_INPUT; + block_input (); fup = fopen ("/proc/uptime", "r"); if (fup) @@ -2453,7 +2674,7 @@ get_up_time (void) } fclose (fup); } - UNBLOCK_INPUT; + unblock_input (); return up; } @@ -2467,7 +2688,7 @@ procfs_ttyname (int rdev) FILE *fdev = NULL; char name[PATH_MAX]; - BLOCK_INPUT; + block_input (); fdev = fopen ("/proc/tty/drivers", "r"); if (fdev) @@ -2499,7 +2720,7 @@ procfs_ttyname (int rdev) } fclose (fdev); } - UNBLOCK_INPUT; + unblock_input (); return build_string (name); } @@ -2509,7 +2730,7 @@ procfs_get_total_memory (void) FILE *fmem = NULL; unsigned long retval = 2 * 1024 * 1024; /* default: 2GB */ - BLOCK_INPUT; + block_input (); fmem = fopen ("/proc/meminfo", "r"); if (fmem) @@ -2528,7 +2749,7 @@ procfs_get_total_memory (void) } fclose (fmem); } - UNBLOCK_INPUT; + unblock_input (); return retval; } @@ -2574,17 +2795,17 @@ system_process_attributes (Lisp_Object pid) /* euid egid */ uid = st.st_uid; attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (uid)), attrs); - BLOCK_INPUT; + block_input (); pw = getpwuid (uid); - UNBLOCK_INPUT; + unblock_input (); if (pw) attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs); gid = st.st_gid; attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (gid)), attrs); - BLOCK_INPUT; + block_input (); gr = getgrgid (gid); - UNBLOCK_INPUT; + unblock_input (); if (gr) attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs); @@ -2812,17 +3033,17 @@ system_process_attributes (Lisp_Object pid) /* euid egid */ uid = st.st_uid; attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (uid)), attrs); - BLOCK_INPUT; + block_input (); pw = getpwuid (uid); - UNBLOCK_INPUT; + unblock_input (); if (pw) attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs); gid = st.st_gid; attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (gid)), attrs); - BLOCK_INPUT; + block_input (); gr = getgrgid (gid); - UNBLOCK_INPUT; + unblock_input (); if (gr) attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs); @@ -2943,17 +3164,17 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (proc.ki_uid)), attrs); - BLOCK_INPUT; + block_input (); pw = getpwuid (proc.ki_uid); - UNBLOCK_INPUT; + unblock_input (); if (pw) attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs); attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (proc.ki_svgid)), attrs); - BLOCK_INPUT; + block_input (); gr = getgrgid (proc.ki_svgid); - UNBLOCK_INPUT; + unblock_input (); if (gr) attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs); @@ -2993,9 +3214,9 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (proc.ki_pgid)), attrs); attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (proc.ki_sid)), attrs); - BLOCK_INPUT; + block_input (); ttyname = proc.ki_tdev == NODEV ? NULL : devname (proc.ki_tdev, S_IFCHR); - UNBLOCK_INPUT; + unblock_input (); if (ttyname) attrs = Fcons (Fcons (Qtty, build_string (ttyname)), attrs); diff --git a/src/syssignal.h b/src/syssignal.h index e309e6725b7..ece2515dec9 100644 --- a/src/syssignal.h +++ b/src/syssignal.h @@ -18,8 +18,9 @@ You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <signal.h> +#include <stdbool.h> -extern void init_signals (void); +extern void init_signals (bool); #ifdef HAVE_PTHREAD #include <pthread.h> @@ -28,6 +29,11 @@ extern void init_signals (void); #define FORWARD_SIGNAL_TO_MAIN_THREAD #endif +#if (defined SIGPROF && (defined HAVE_TIMER_SETTIME || defined HAVE_SETITIMER) \ + && !defined PROFILING) +# define PROFILER_CPU_SUPPORT +#endif + extern sigset_t empty_mask; typedef void (*signal_handler_t) (int); @@ -39,6 +45,10 @@ extern void emacs_sigaction_init (struct sigaction *, signal_handler_t); # define NSIG NSIG_MINIMUM #endif +#ifndef emacs_raise +# define emacs_raise(sig) raise (sig) +#endif + /* On bsd, [man says] kill does not accept a negative number to kill a pgrp. Must do that using the killpg call. */ #ifdef BSD_SYSTEM @@ -64,4 +74,4 @@ extern void emacs_sigaction_init (struct sigaction *, signal_handler_t); char *strsignal (int); #endif -void handle_on_main_thread (int, signal_handler_t); +void deliver_process_signal (int, signal_handler_t); diff --git a/src/syswait.h b/src/syswait.h index 9d84876d4be..aa4c4bcf527 100644 --- a/src/syswait.h +++ b/src/syswait.h @@ -51,4 +51,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #define WTERMSIG(status) ((status) & 0x7f) #endif +/* Defined in process.c. */ +extern void record_child_status_change (pid_t, int); + +/* Defined in sysdep.c. */ +extern void wait_for_termination (pid_t); +extern void interruptible_wait_for_termination (pid_t); + #endif /* EMACS_SYSWAIT_H */ diff --git a/src/term.c b/src/term.c index f4117d67dec..189fb783cbc 100644 --- a/src/term.c +++ b/src/term.c @@ -753,13 +753,13 @@ tty_write_glyphs (struct frame *f, struct glyph *string, int len) conversion_buffer = encode_terminal_code (string, n, coding); if (coding->produced > 0) { - BLOCK_INPUT; + block_input (); fwrite (conversion_buffer, 1, coding->produced, tty->output); if (ferror (tty->output)) clearerr (tty->output); if (tty->termscript) fwrite (conversion_buffer, 1, coding->produced, tty->termscript); - UNBLOCK_INPUT; + unblock_input (); } string += n; @@ -814,13 +814,13 @@ tty_write_glyphs_with_face (register struct frame *f, register struct glyph *str conversion_buffer = encode_terminal_code (string, len, coding); if (coding->produced > 0) { - BLOCK_INPUT; + block_input (); fwrite (conversion_buffer, 1, coding->produced, tty->output); if (ferror (tty->output)) clearerr (tty->output); if (tty->termscript) fwrite (conversion_buffer, 1, coding->produced, tty->termscript); - UNBLOCK_INPUT; + unblock_input (); } /* Turn appearance modes off. */ @@ -900,13 +900,13 @@ tty_insert_glyphs (struct frame *f, struct glyph *start, int len) if (coding->produced > 0) { - BLOCK_INPUT; + block_input (); fwrite (conversion_buffer, 1, coding->produced, tty->output); if (ferror (tty->output)) clearerr (tty->output); if (tty->termscript) fwrite (conversion_buffer, 1, coding->produced, tty->termscript); - UNBLOCK_INPUT; + unblock_input (); } OUTPUT1_IF (tty, tty->TS_pad_inserted_char); diff --git a/src/termhooks.h b/src/termhooks.h index 53e401de409..f35bd929af1 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -591,8 +591,7 @@ struct terminal /* Called to read input events. TERMINAL indicates which terminal device to read from. Input - events should be read into BUF, the size of which is given in - SIZE. + events should be read into HOLD_QUIT. A positive return value indicates that that many input events were read into BUF. diff --git a/src/w16select.c b/src/w16select.c index a3f6f1fb9ae..b8aaa3619ba 100644 --- a/src/w16select.c +++ b/src/w16select.c @@ -459,7 +459,7 @@ DEFUN ("w16-set-clipboard-data", Fw16_set_clipboard_data, Sw16_set_clipboard_dat if ( !FRAME_MSDOS_P (XFRAME (frame))) goto done; - BLOCK_INPUT; + block_input (); if (!open_clipboard ()) goto error; @@ -520,7 +520,7 @@ DEFUN ("w16-set-clipboard-data", Fw16_set_clipboard_data, Sw16_set_clipboard_dat unblock: xfree (dst); - UNBLOCK_INPUT; + unblock_input (); /* Notify user if the text is too large to fit into DOS memory. (This will happen somewhere after 600K bytes (470K in DJGPP v1.x), @@ -565,7 +565,7 @@ DEFUN ("w16-get-clipboard-data", Fw16_get_clipboard_data, Sw16_get_clipboard_dat if ( !FRAME_MSDOS_P (XFRAME (frame))) goto done; - BLOCK_INPUT; + block_input (); if (!open_clipboard ()) goto unblock; @@ -626,7 +626,7 @@ DEFUN ("w16-get-clipboard-data", Fw16_get_clipboard_data, Sw16_get_clipboard_dat close_clipboard (); unblock: - UNBLOCK_INPUT; + unblock_input (); done: diff --git a/src/w32.c b/src/w32.c index bcb0511e2fa..3154c725abf 100644 --- a/src/w32.c +++ b/src/w32.c @@ -6521,33 +6521,27 @@ sys_localtime (const time_t *t) -/* Delayed loading of libraries. */ - -Lisp_Object Vlibrary_cache; - -/* The argument LIBRARIES is an alist that associates a symbol - LIBRARY_ID, identifying an external DLL library known to Emacs, to - a list of filenames under which the library is usually found. In - most cases, the argument passed as LIBRARIES is the variable - `dynamic-library-alist', which is initialized to a list of common - library names. If the function loads the library successfully, it - returns the handle of the DLL, and records the filename in the - property :loaded-from of LIBRARY_ID; it returns NULL if the library - could not be found, or when it was already loaded (because the - handle is not recorded anywhere, and so is lost after use). It - would be trivial to save the handle too in :loaded-from, but - currently there's no use case for it. */ +/* Try loading LIBRARY_ID from the file(s) specified in + Vdynamic_library_alist. If the library is loaded successfully, + return the handle of the DLL, and record the filename in the + property :loaded-from of LIBRARY_ID. If the library could not be + found, or when it was already loaded (because the handle is not + recorded anywhere, and so is lost after use), return NULL. + + We could also save the handle in :loaded-from, but currently + there's no use case for it. */ HMODULE -w32_delayed_load (Lisp_Object libraries, Lisp_Object library_id) +w32_delayed_load (Lisp_Object library_id) { HMODULE library_dll = NULL; CHECK_SYMBOL (library_id); - if (CONSP (libraries) && NILP (Fassq (library_id, Vlibrary_cache))) + if (CONSP (Vdynamic_library_alist) + && NILP (Fassq (library_id, Vlibrary_cache))) { Lisp_Object found = Qnil; - Lisp_Object dlls = Fassq (library_id, libraries); + Lisp_Object dlls = Fassq (library_id, Vdynamic_library_alist); if (CONSP (dlls)) for (dlls = XCDR (dlls); CONSP (dlls); dlls = XCDR (dlls)) @@ -6626,8 +6620,9 @@ check_windows_init_file (void) } void -term_ntproc (void) +term_ntproc (int ignored) { + (void)ignored; /* shutdown the socket interface if necessary */ term_winsock (); @@ -6635,7 +6630,7 @@ term_ntproc (void) } void -init_ntproc (void) +init_ntproc (int dumping) { /* Initialize the socket interface now if available and requested by the user by defining PRELOAD_WINSOCK; otherwise loading will be @@ -6712,7 +6707,8 @@ init_ntproc (void) /* unfortunately, atexit depends on implementation of malloc */ /* atexit (term_ntproc); */ - signal (SIGABRT, term_ntproc); + if (!dumping) + signal (SIGABRT, term_ntproc); /* determine which drives are fixed, for GetCachedVolumeInformation */ { @@ -6769,9 +6765,6 @@ globals_of_w32 (void) DEFSYM (QCloaded_from, ":loaded-from"); - Vlibrary_cache = Qnil; - staticpro (&Vlibrary_cache); - g_b_init_is_windows_9x = 0; g_b_init_open_process_token = 0; g_b_init_get_token_information = 0; diff --git a/src/w32.h b/src/w32.h index 73d57a65a4a..a833c8f4315 100644 --- a/src/w32.h +++ b/src/w32.h @@ -127,8 +127,8 @@ extern void reset_standard_handles (int in, int out, /* Return the string resource associated with KEY of type TYPE. */ extern LPBYTE w32_get_resource (char * key, LPDWORD type); -extern void init_ntproc (void); -extern void term_ntproc (void); +extern void init_ntproc (int); +extern void term_ntproc (int); extern void globals_of_w32 (void); extern void syms_of_w32term (void); extern void syms_of_w32fns (void); @@ -145,8 +145,8 @@ extern void check_windows_init_file (void); extern int _sys_read_ahead (int fd); extern int _sys_wait_accept (int fd); -extern Lisp_Object Vlibrary_cache, QCloaded_from; -extern HMODULE w32_delayed_load (Lisp_Object, Lisp_Object); +extern Lisp_Object QCloaded_from; +extern HMODULE w32_delayed_load (Lisp_Object); #ifdef HAVE_GNUTLS #include <gnutls/gnutls.h> diff --git a/src/w32fns.c b/src/w32fns.c index be008bb18c8..808e19d0b66 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -364,7 +364,7 @@ if the entry is new. */) XSETINT (rgb, RGB (XUINT (red), XUINT (green), XUINT (blue))); - BLOCK_INPUT; + block_input (); /* replace existing entry in w32-color-map or add new entry. */ entry = Fassoc (name, Vw32_color_map); @@ -379,7 +379,7 @@ if the entry is new. */) Fsetcdr (entry, rgb); } - UNBLOCK_INPUT; + unblock_input (); return (oldrgb); } @@ -642,7 +642,7 @@ w32_default_color_map (void) colormap_t *pc = w32_color_map; Lisp_Object cmap; - BLOCK_INPUT; + block_input (); cmap = Qnil; @@ -652,7 +652,7 @@ w32_default_color_map (void) make_number (pc->colorref)), cmap); - UNBLOCK_INPUT; + unblock_input (); return (cmap); } @@ -669,7 +669,7 @@ w32_color_map_lookup (char *colorname) { Lisp_Object tail, ret = Qnil; - BLOCK_INPUT; + block_input (); for (tail = Vw32_color_map; CONSP (tail); tail = XCDR (tail)) { @@ -689,7 +689,7 @@ w32_color_map_lookup (char *colorname) QUIT; } - UNBLOCK_INPUT; + unblock_input (); return ret; } @@ -701,7 +701,7 @@ add_system_logical_colors_to_map (Lisp_Object *system_colors) HKEY colors_key; /* Other registry operations are done with input blocked. */ - BLOCK_INPUT; + block_input (); /* Look for "Control Panel/Colors" under User and Machine registry settings. */ @@ -739,7 +739,7 @@ add_system_logical_colors_to_map (Lisp_Object *system_colors) RegCloseKey (colors_key); } - UNBLOCK_INPUT; + unblock_input (); } @@ -748,7 +748,7 @@ x_to_w32_color (char * colorname) { register Lisp_Object ret = Qnil; - BLOCK_INPUT; + block_input (); if (colorname[0] == '#') { @@ -801,7 +801,7 @@ x_to_w32_color (char * colorname) pos += 0x8; if (i == 2) { - UNBLOCK_INPUT; + unblock_input (); XSETINT (ret, colorval); return ret; } @@ -855,7 +855,7 @@ x_to_w32_color (char * colorname) { if (*end != '\0') break; - UNBLOCK_INPUT; + unblock_input (); XSETINT (ret, colorval); return ret; } @@ -897,7 +897,7 @@ x_to_w32_color (char * colorname) { if (*end != '\0') break; - UNBLOCK_INPUT; + unblock_input (); XSETINT (ret, colorval); return ret; } @@ -932,7 +932,7 @@ x_to_w32_color (char * colorname) } } - UNBLOCK_INPUT; + unblock_input (); return ret; } @@ -1235,7 +1235,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) f->output_data.w32->mouse_pixel = FRAME_FOREGROUND_PIXEL (f); #if 0 /* TODO : Mouse cursor customization. */ - BLOCK_INPUT; + block_input (); /* It's not okay to crash if the user selects a screwy cursor. */ count = x_catch_errors (FRAME_W32_DISPLAY (f)); @@ -1358,7 +1358,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) f->output_data.w32->hand_cursor = hand_cursor; XFlush (FRAME_W32_DISPLAY (f)); - UNBLOCK_INPUT; + unblock_input (); update_face_from_frame_parameter (f, Qmouse_color, arg); #endif /* TODO */ @@ -1390,12 +1390,12 @@ x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (FRAME_W32_WINDOW (f) != 0) { - BLOCK_INPUT; + block_input (); /* Update frame's cursor_gc. */ f->output_data.w32->cursor_gc->foreground = fore_pixel; f->output_data.w32->cursor_gc->background = pixel; - UNBLOCK_INPUT; + unblock_input (); if (FRAME_VISIBLE_P (f)) { @@ -1466,16 +1466,16 @@ x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (SYMBOLP (arg) && SYMBOLP (oldval) && EQ (arg, oldval)) return; - BLOCK_INPUT; + block_input (); result = x_bitmap_icon (f, arg); if (result) { - UNBLOCK_INPUT; + unblock_input (); error ("No icon window available"); } - UNBLOCK_INPUT; + unblock_input (); } void @@ -1495,7 +1495,7 @@ x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (f->output_data.w32->icon_bitmap != 0) return; - BLOCK_INPUT; + block_input (); result = x_text_icon (f, SSDATA ((!NILP (f->icon_name) @@ -1506,7 +1506,7 @@ x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (result) { - UNBLOCK_INPUT; + unblock_input (); error ("No icon window available"); } @@ -1521,7 +1521,7 @@ x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) } XFlush (FRAME_W32_DISPLAY (f)); - UNBLOCK_INPUT; + unblock_input (); #endif } @@ -1623,13 +1623,13 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) int width = FRAME_PIXEL_WIDTH (f); int y = nlines * FRAME_LINE_HEIGHT (f); - BLOCK_INPUT; + block_input (); { HDC hdc = get_frame_dc (f); w32_clear_area (f, hdc, 0, y, width, height); release_frame_dc (f, hdc); } - UNBLOCK_INPUT; + unblock_input (); if (WINDOWP (f->tool_bar_window)) clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix); @@ -1697,9 +1697,9 @@ x_set_name (struct frame *f, Lisp_Object name, int explicit) if (STRING_MULTIBYTE (name)) name = ENCODE_SYSTEM (name); - BLOCK_INPUT; + block_input (); SetWindowText (FRAME_W32_WINDOW (f), SDATA (name)); - UNBLOCK_INPUT; + unblock_input (); } } @@ -1743,9 +1743,9 @@ x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name) if (STRING_MULTIBYTE (name)) name = ENCODE_SYSTEM (name); - BLOCK_INPUT; + block_input (); SetWindowText (FRAME_W32_WINDOW (f), SDATA (name)); - UNBLOCK_INPUT; + unblock_input (); } } @@ -3896,7 +3896,7 @@ my_create_tip_window (struct frame *f) static void w32_window (struct frame *f, long window_prompting, int minibuffer_only) { - BLOCK_INPUT; + block_input (); /* Use the resource name as the top-level window name for looking up resources. Make a non-Lisp copy @@ -3928,7 +3928,7 @@ w32_window (struct frame *f, long window_prompting, int minibuffer_only) x_set_name (f, name, explicit); } - UNBLOCK_INPUT; + unblock_input (); if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f)) initialize_frame_menubar (f); @@ -3959,7 +3959,7 @@ x_icon (struct frame *f, Lisp_Object parms) else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound)) error ("Both left and top icon corners of icon must be specified"); - BLOCK_INPUT; + block_input (); if (! EQ (icon_x, Qunbound)) x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y)); @@ -3976,7 +3976,7 @@ x_icon (struct frame *f, Lisp_Object parms) : f->name))); #endif - UNBLOCK_INPUT; + unblock_input (); } @@ -3985,7 +3985,7 @@ x_make_gc (struct frame *f) { XGCValues gc_values; - BLOCK_INPUT; + block_input (); /* Create the GC's of this frame. Note that many default values are used. */ @@ -4005,7 +4005,7 @@ x_make_gc (struct frame *f) f->output_data.w32->white_relief.gc = 0; f->output_data.w32->black_relief.gc = 0; - UNBLOCK_INPUT; + unblock_input (); } @@ -4351,9 +4351,9 @@ This function is an internal primitive--use `make-frame' instead. */) /* Tell the server what size and position, etc, we want, and how badly we want them. This should be done after we have the menu bar so that its size can be taken into account. */ - BLOCK_INPUT; + block_input (); x_wm_set_size_hint (f, window_prompting, 0); - UNBLOCK_INPUT; + unblock_input (); /* Make the window appear on the frame and enable display, unless the caller says not to. However, with explicit parent, Emacs @@ -4862,11 +4862,11 @@ If DISPLAY is nil, that stands for the selected frame's display. */) if (dpyinfo->reference_count > 0) error ("Display still has frames on it"); - BLOCK_INPUT; + block_input (); x_destroy_all_bitmaps (dpyinfo); x_delete_display (dpyinfo); - UNBLOCK_INPUT; + unblock_input (); return Qnil; } @@ -4935,7 +4935,7 @@ FRAME. Default is to change on the edit X window. */) CHECK_STRING (prop); CHECK_STRING (value); - BLOCK_INPUT; + block_input (); prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False); XChangeProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), prop_atom, XA_STRING, 8, PropModeReplace, @@ -4943,7 +4943,7 @@ FRAME. Default is to change on the edit X window. */) /* Make sure the property is set when we return. */ XFlush (FRAME_W32_DISPLAY (f)); - UNBLOCK_INPUT; + unblock_input (); return value; } @@ -4959,13 +4959,13 @@ FRAME nil or omitted means use the selected frame. Value is PROP. */) Atom prop_atom; CHECK_STRING (prop); - BLOCK_INPUT; + block_input (); prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False); XDeleteProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), prop_atom); /* Make sure the property is removed when we return. */ XFlush (FRAME_W32_DISPLAY (f)); - UNBLOCK_INPUT; + unblock_input (); return prop; } @@ -5001,7 +5001,7 @@ no value of TYPE (always string in the MS Windows case). */) unsigned long actual_size, bytes_remaining; CHECK_STRING (prop); - BLOCK_INPUT; + block_input (); prop_atom = XInternAtom (FRAME_W32_DISPLAY (f), SDATA (prop), False); rc = XGetWindowProperty (FRAME_W32_DISPLAY (f), FRAME_W32_WINDOW (f), prop_atom, 0, 0, False, XA_STRING, @@ -5026,7 +5026,7 @@ no value of TYPE (always string in the MS Windows case). */) XFree (tmp_data); } - UNBLOCK_INPUT; + unblock_input (); return prop_value; @@ -5349,9 +5349,9 @@ x_create_tip_frame (struct w32_display_info *dpyinfo, f->left_fringe_width = 0; f->right_fringe_width = 0; - BLOCK_INPUT; + block_input (); my_create_tip_window (f); - UNBLOCK_INPUT; + unblock_input (); x_make_gc (f); @@ -5457,11 +5457,11 @@ compute_tip_xy (struct frame *f, max_x = x_display_pixel_width (FRAME_W32_DISPLAY_INFO (f)); max_y = x_display_pixel_height (FRAME_W32_DISPLAY_INFO (f)); - BLOCK_INPUT; + block_input (); GetCursorPos (&pt); *root_x = pt.x; *root_y = pt.y; - UNBLOCK_INPUT; + unblock_input (); /* If multiple monitor support is available, constrain the tip onto the current monitor. This improves the above by allowing negative @@ -5596,7 +5596,7 @@ Text larger than the specified size is clipped. */) call1 (Qcancel_timer, timer); } - BLOCK_INPUT; + block_input (); compute_tip_xy (f, parms, dx, dy, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f), &root_x, &root_y); @@ -5610,7 +5610,7 @@ Text larger than the specified size is clipped. */) 0, 0, 0, 0, SWP_NOMOVE | SWP_NOSIZE | SWP_NOACTIVATE); - UNBLOCK_INPUT; + unblock_input (); goto start_timer; } } @@ -5637,7 +5637,7 @@ Text larger than the specified size is clipped. */) /* Block input until the tip has been fully drawn, to avoid crashes when drawing tips in menus. */ - BLOCK_INPUT; + block_input (); /* Create a frame for the tooltip, and record it in the global variable tip_frame. */ @@ -5809,7 +5809,7 @@ Text larger than the specified size is clipped. */) w->must_be_updated_p = 1; update_single_window (w, 1); - UNBLOCK_INPUT; + unblock_input (); /* Restore original current buffer. */ set_buffer_internal_1 (old_buffer); @@ -6002,7 +6002,7 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */) /* Prevent redisplay. */ specbind (Qinhibit_redisplay, Qt); - BLOCK_INPUT; + block_input (); memset (&new_file_details, 0, sizeof (new_file_details)); /* Apparently NT4 crashes if you give it an unexpected size. @@ -6041,7 +6041,7 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */) file_opened = GetOpenFileName (file_details); - UNBLOCK_INPUT; + unblock_input (); if (file_opened) { diff --git a/src/w32inevt.c b/src/w32inevt.c index a96d8d70483..ebb95dcace5 100644 --- a/src/w32inevt.c +++ b/src/w32inevt.c @@ -567,7 +567,7 @@ w32_console_mouse_position (FRAME_PTR *f, Lisp_Object *y, Time *time) { - BLOCK_INPUT; + block_input (); insist = insist; @@ -580,7 +580,7 @@ w32_console_mouse_position (FRAME_PTR *f, XSETINT (*y, movement_pos.Y); *time = movement_time; - UNBLOCK_INPUT; + unblock_input (); } /* Remember mouse motion and notify emacs. */ @@ -749,14 +749,7 @@ w32_console_read_socket (struct terminal *terminal, int nev, add; int isdead; - if (interrupt_input_blocked) - { - interrupt_input_pending = 1; - return -1; - } - - interrupt_input_pending = 0; - BLOCK_INPUT; + block_input (); for (;;) { @@ -818,6 +811,6 @@ w32_console_read_socket (struct terminal *terminal, if (!w32_use_full_screen_buffer) maybe_generate_resize_event (); - UNBLOCK_INPUT; + unblock_input (); return nev; } diff --git a/src/w32menu.c b/src/w32menu.c index fa7db64f147..fb1cb606940 100644 --- a/src/w32menu.c +++ b/src/w32menu.c @@ -85,7 +85,7 @@ MessageBoxW_Proc unicode_message_box = NULL; Lisp_Object Qdebug_on_next_call; -void set_frame_menubar (FRAME_PTR, int, int); +void set_frame_menubar (FRAME_PTR, bool, bool); #ifdef HAVE_DIALOGS static Lisp_Object w32_dialog_show (FRAME_PTR, int, Lisp_Object, char**); @@ -221,9 +221,9 @@ otherwise it is "Question". */) list_of_panes (Fcons (contents, Qnil)); /* Display them in a dialog box. */ - BLOCK_INPUT; + block_input (); selection = w32_dialog_show (f, 0, title, header, &error_name); - UNBLOCK_INPUT; + unblock_input (); discard_menu_items (); FRAME_X_DISPLAY_INFO (f)->grabbed = 0; @@ -356,7 +356,7 @@ menubar_selection_callback (FRAME_PTR f, void * client_data) it is set the first time this is called, from initialize_frame_menubar. */ void -set_frame_menubar (FRAME_PTR f, int first_time, int deep_p) +set_frame_menubar (FRAME_PTR f, bool first_time, bool deep_p) { HMENU menubar_widget = f->output_data.w32->menubar_widget; Lisp_Object items; @@ -571,7 +571,7 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p) /* Create or update the menu bar widget. */ - BLOCK_INPUT; + block_input (); if (menubar_widget) { @@ -601,7 +601,7 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p) x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f)); } - UNBLOCK_INPUT; + unblock_input (); } /* Called from Fx_create_frame to create the initial menubar of a frame @@ -624,7 +624,7 @@ initialize_frame_menubar (FRAME_PTR f) void free_frame_menubar (FRAME_PTR f) { - BLOCK_INPUT; + block_input (); { HMENU old = GetMenu (FRAME_W32_WINDOW (f)); @@ -633,7 +633,7 @@ free_frame_menubar (FRAME_PTR f) DestroyMenu (old); } - UNBLOCK_INPUT; + unblock_input (); } diff --git a/src/w32proc.c b/src/w32proc.c index 26a0925ad87..b367b42d8c6 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -86,19 +86,34 @@ typedef void (_CALLBACK_ *signal_handler) (int); /* Signal handlers...SIG_DFL == 0 so this is initialized correctly. */ static signal_handler sig_handlers[NSIG]; -/* Fake signal implementation to record the SIGCHLD handler. */ +/* Improve on the CRT 'signal' implementation so that we could record + the SIGCHLD handler. */ signal_handler sys_signal (int sig, signal_handler handler) { signal_handler old; - if (sig != SIGCHLD) + /* SIGCHLD is needed for supporting subprocesses, see sys_kill + below. All the others are the only ones supported by the MS + runtime. */ + if (!(sig == SIGCHLD || sig == SIGSEGV || sig == SIGILL + || sig == SIGFPE || sig == SIGABRT || sig == SIGTERM)) { errno = EINVAL; return SIG_ERR; } old = sig_handlers[sig]; - sig_handlers[sig] = handler; + /* SIGABRT is treated specially because w32.c installs term_ntproc + as its handler, so we don't want to override that afterwards. + Aborting Emacs works specially anyway: either by calling + emacs_abort directly or through terminate_due_to_signal, which + calls emacs_abort through emacs_raise. */ + if (!(sig == SIGABRT && old == term_ntproc)) + { + sig_handlers[sig] = handler; + if (sig != SIGCHLD) + signal (sig, handler); + } return old; } @@ -106,23 +121,26 @@ sys_signal (int sig, signal_handler handler) int sigaction (int sig, const struct sigaction *act, struct sigaction *oact) { - signal_handler old; + signal_handler old = SIG_DFL; + int retval = 0; - if (sig != SIGCHLD) + if (act) + old = sys_signal (sig, act->sa_handler); + else if (oact) + old = sig_handlers[sig]; + + if (old == SIG_ERR) { errno = EINVAL; - return -1; + retval = -1; } - old = sig_handlers[sig]; - if (act) - sig_handlers[sig] = act->sa_handler; if (oact) { oact->sa_handler = old; oact->sa_flags = 0; oact->sa_mask = empty_mask; } - return 0; + return retval; } /* Defined in <process.h> which conflicts with the local copy */ @@ -1420,6 +1438,7 @@ find_child_console (HWND hwnd, LPARAM arg) return TRUE; } +/* Emulate 'kill', but only for other processes. */ int sys_kill (int pid, int sig) { @@ -1428,9 +1447,6 @@ sys_kill (int pid, int sig) int need_to_free = 0; int rc = 0; - if (pid == getpid () && sig == SIGABRT) - emacs_abort (); - /* Only handle signals that will result in the process dying */ if (sig != SIGINT && sig != SIGKILL && sig != SIGQUIT && sig != SIGHUP) { @@ -1441,6 +1457,11 @@ sys_kill (int pid, int sig) cp = find_child_pid (pid); if (cp == NULL) { + /* We were passed a PID of something other than our subprocess. + If that is our own PID, we will send to ourself a message to + close the selected frame, which does not necessarily + terminates Emacs. But then we are not supposed to call + sys_kill with our own PID. */ proc_hand = OpenProcess (PROCESS_TERMINATE, 0, pid); if (proc_hand == NULL) { diff --git a/src/w32reg.c b/src/w32reg.c index 8a6a3c853b1..8b6c76503a6 100644 --- a/src/w32reg.c +++ b/src/w32reg.c @@ -84,7 +84,7 @@ w32_get_string_resource (char *name, char *class, DWORD dwexptype) trykey: - BLOCK_INPUT; + block_input (); /* Check both the current user and the local machine to see if we have any resources */ @@ -115,7 +115,7 @@ w32_get_string_resource (char *name, char *class, DWORD dwexptype) RegCloseKey (hrootkey); } - UNBLOCK_INPUT; + unblock_input (); if (!ok) { diff --git a/src/w32select.c b/src/w32select.c index 11c68c9c617..66f9f7ab041 100644 --- a/src/w32select.c +++ b/src/w32select.c @@ -391,7 +391,7 @@ run_protected (Lisp_Object (*code) (Lisp_Object), Lisp_Object arg) extern int waiting_for_input; /* from keyboard.c */ int owfi; - BLOCK_INPUT; + block_input (); /* Fsignal calls emacs_abort () if it sees that waiting_for_input is set. */ @@ -402,7 +402,7 @@ run_protected (Lisp_Object (*code) (Lisp_Object), Lisp_Object arg) waiting_for_input = owfi; - UNBLOCK_INPUT; + unblock_input (); } static Lisp_Object @@ -474,7 +474,10 @@ term_w32select (void) { /* This is needed to trigger WM_RENDERALLFORMATS. */ if (clipboard_owner != NULL) - DestroyWindow (clipboard_owner); + { + DestroyWindow (clipboard_owner); + clipboard_owner = NULL; + } } static void @@ -694,7 +697,7 @@ DEFUN ("w32-set-clipboard-data", Fw32_set_clipboard_data, current_num_nls = 0; current_requires_encoding = 0; - BLOCK_INPUT; + block_input (); /* Check for non-ASCII characters. While we are at it, count the number of LFs, so we know how many CRs we will have to add later @@ -782,7 +785,7 @@ DEFUN ("w32-set-clipboard-data", Fw32_set_clipboard_data, current_coding_system = Qnil; done: - UNBLOCK_INPUT; + unblock_input (); return (ok ? string : Qnil); } @@ -810,7 +813,7 @@ DEFUN ("w32-get-clipboard-data", Fw32_get_clipboard_data, setup_config (); actual_clipboard_type = cfg_clipboard_type; - BLOCK_INPUT; + block_input (); if (!OpenClipboard (clipboard_owner)) goto done; @@ -1000,7 +1003,7 @@ DEFUN ("w32-get-clipboard-data", Fw32_get_clipboard_data, CloseClipboard (); done: - UNBLOCK_INPUT; + unblock_input (); return (ret); } diff --git a/src/w32term.c b/src/w32term.c index b8227c52fed..5d5e572c475 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -197,7 +197,7 @@ static void w32_define_cursor (Window, Cursor); void x_lower_frame (struct frame *); void x_scroll_bar_clear (struct frame *); -void x_wm_set_size_hint (struct frame *, long, int); +void x_wm_set_size_hint (struct frame *, long, bool); void x_raise_frame (struct frame *); void x_set_window_size (struct frame *, int, int, int); void x_wm_set_window_state (struct frame *, int); @@ -563,7 +563,7 @@ x_update_window_begin (struct window *w) updated_window = w; set_output_cursor (&w->cursor); - BLOCK_INPUT; + block_input (); if (f == hlinfo->mouse_face_mouse_frame) { @@ -602,7 +602,7 @@ x_update_window_begin (struct window *w) #endif /* 0 */ } - UNBLOCK_INPUT; + unblock_input (); } /* Draw a vertical window border from (x,y0) to (x,y1) */ @@ -652,7 +652,7 @@ x_update_window_end (struct window *w, int cursor_on_p, if (!w->pseudo_window_p) { - BLOCK_INPUT; + block_input (); if (cursor_on_p) display_and_set_cursor (w, 1, output_cursor.hpos, @@ -662,7 +662,7 @@ x_update_window_end (struct window *w, int cursor_on_p, if (draw_window_fringes (w, 1)) x_draw_vertical_border (w); - UNBLOCK_INPUT; + unblock_input (); } /* If a row with mouse-face was overwritten, arrange for @@ -714,13 +714,13 @@ w32_frame_up_to_date (struct frame *f) if (hlinfo->mouse_face_deferred_gc || f == hlinfo->mouse_face_mouse_frame) { - BLOCK_INPUT; + block_input (); if (hlinfo->mouse_face_mouse_frame) note_mouse_highlight (hlinfo->mouse_face_mouse_frame, hlinfo->mouse_face_mouse_x, hlinfo->mouse_face_mouse_y); hlinfo->mouse_face_deferred_gc = 0; - UNBLOCK_INPUT; + unblock_input (); } } } @@ -761,7 +761,7 @@ x_after_update_window_line (struct glyph_row *desired_row) { int y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, desired_row->y)); - BLOCK_INPUT; + block_input (); { HDC hdc = get_frame_dc (f); w32_clear_area (f, hdc, 0, y, width, height); @@ -769,7 +769,7 @@ x_after_update_window_line (struct glyph_row *desired_row) y, width, height); release_frame_dc (f, hdc); } - UNBLOCK_INPUT; + unblock_input (); } } @@ -2646,7 +2646,7 @@ x_clear_frame (struct frame *f) /* We don't set the output cursor here because there will always follow an explicit cursor_to. */ - BLOCK_INPUT; + block_input (); w32_clear_window (f); @@ -2654,7 +2654,7 @@ x_clear_frame (struct frame *f) colors or something like that, then they should be notified. */ x_scroll_bar_clear (f); - UNBLOCK_INPUT; + unblock_input (); } @@ -2663,7 +2663,7 @@ x_clear_frame (struct frame *f) static void w32_ring_bell (struct frame *f) { - BLOCK_INPUT; + block_input (); if (FRAME_W32_P (f) && visible_bell) { @@ -2680,7 +2680,7 @@ w32_ring_bell (struct frame *f) else w32_sys_ring_bell (f); - UNBLOCK_INPUT; + unblock_input (); } @@ -2779,7 +2779,7 @@ x_scroll_run (struct window *w, struct run *run) expect_dirty = CreateRectRgn (x, y, x + width, to_y); } - BLOCK_INPUT; + block_input (); /* Cursor off. Will be switched on again in x_update_window_end. */ updated_window = w; @@ -2813,7 +2813,7 @@ x_scroll_run (struct window *w, struct run *run) DeleteObject (combined); } - UNBLOCK_INPUT; + unblock_input (); DeleteObject (expect_dirty); } @@ -2998,9 +2998,9 @@ x_get_keysym_name (int keysym) /* Make static so we can always return it */ static char value[100]; - BLOCK_INPUT; + block_input (); GetKeyNameText (keysym, value, 100); - UNBLOCK_INPUT; + unblock_input (); return value; } @@ -3308,7 +3308,7 @@ w32_mouse_position (FRAME_PTR *fp, int insist, Lisp_Object *bar_window, { FRAME_PTR f1; - BLOCK_INPUT; + block_input (); if (! NILP (last_mouse_scroll_bar) && insist == 0) x_scroll_bar_report_motion (fp, bar_window, part, x, y, time); @@ -3382,7 +3382,7 @@ w32_mouse_position (FRAME_PTR *fp, int insist, Lisp_Object *bar_window, } } - UNBLOCK_INPUT; + unblock_input (); } @@ -3480,12 +3480,12 @@ w32_set_scroll_bar_thumb (struct scroll_bar *bar, if (draggingp) { int near_bottom_p; - BLOCK_INPUT; + block_input (); si.cbSize = sizeof (si); si.fMask = SIF_POS | SIF_PAGE; GetScrollInfo (w, SB_CTL, &si); near_bottom_p = si.nPos + si.nPage >= range; - UNBLOCK_INPUT; + unblock_input (); if (!near_bottom_p) return; } @@ -3514,7 +3514,7 @@ w32_set_scroll_bar_thumb (struct scroll_bar *bar, sb_page = max (sb_page, VERTICAL_SCROLL_BAR_MIN_HANDLE); - BLOCK_INPUT; + block_input (); si.cbSize = sizeof (si); si.fMask = SIF_PAGE | SIF_POS; @@ -3523,7 +3523,7 @@ w32_set_scroll_bar_thumb (struct scroll_bar *bar, SetScrollInfo (w, SB_CTL, &si, TRUE); - UNBLOCK_INPUT; + unblock_input (); } @@ -3614,7 +3614,7 @@ x_scroll_bar_create (struct window *w, int top, int left, int width, int height) = XSCROLL_BAR (Fmake_vector (make_number (SCROLL_BAR_VEC_SIZE), Qnil)); Lisp_Object barobj; - BLOCK_INPUT; + block_input (); XSETWINDOW (bar->window, w); XSETINT (bar->top, top); @@ -3650,7 +3650,7 @@ x_scroll_bar_create (struct window *w, int top, int left, int width, int height) if (! NILP (bar->next)) XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar); - UNBLOCK_INPUT; + unblock_input (); return bar; } @@ -3664,7 +3664,7 @@ x_scroll_bar_remove (struct scroll_bar *bar) { FRAME_PTR f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); - BLOCK_INPUT; + block_input (); /* Destroy the window. */ my_destroy_window (f, SCROLL_BAR_W32_WINDOW (bar)); @@ -3672,7 +3672,7 @@ x_scroll_bar_remove (struct scroll_bar *bar) /* Dissociate this scroll bar from its window. */ wset_vertical_scroll_bar (XWINDOW (bar->window), Qnil); - UNBLOCK_INPUT; + unblock_input (); } /* Set the handle of the vertical scroll bar for WINDOW to indicate @@ -3727,7 +3727,7 @@ w32_set_vertical_scroll_bar (struct window *w, if (NILP (w->vertical_scroll_bar)) { HDC hdc; - BLOCK_INPUT; + block_input (); if (width > 0 && height > 0) { hdc = get_frame_dc (f); @@ -3737,7 +3737,7 @@ w32_set_vertical_scroll_bar (struct window *w, w32_clear_area (f, hdc, left, top, width, height); release_frame_dc (f, hdc); } - UNBLOCK_INPUT; + unblock_input (); bar = x_scroll_bar_create (w, top, sb_left, sb_width, height); } @@ -3765,7 +3765,7 @@ w32_set_vertical_scroll_bar (struct window *w, HDC hdc; SCROLLINFO si; - BLOCK_INPUT; + block_input (); if (width && height) { hdc = get_frame_dc (f); @@ -3801,7 +3801,7 @@ w32_set_vertical_scroll_bar (struct window *w, XSETINT (bar->width, sb_width); XSETINT (bar->height, height); - UNBLOCK_INPUT; + unblock_input (); } } bar->fringe_extended_p = fringe_extended_p ? Qt : Qnil; @@ -4043,7 +4043,7 @@ x_scroll_bar_report_motion (FRAME_PTR *fp, Lisp_Object *bar_window, int top_range = VERTICAL_SCROLL_BAR_TOP_RANGE (f, XINT (bar->height)); SCROLLINFO si; - BLOCK_INPUT; + block_input (); *fp = f; *bar_window = bar->window; @@ -4080,7 +4080,7 @@ x_scroll_bar_report_motion (FRAME_PTR *fp, Lisp_Object *bar_window, *time = last_mouse_movement_time; - UNBLOCK_INPUT; + unblock_input (); } @@ -4157,15 +4157,7 @@ w32_read_socket (struct terminal *terminal, struct w32_display_info *dpyinfo = &one_w32_display_info; Mouse_HLInfo *hlinfo = &dpyinfo->mouse_highlight; - if (interrupt_input_blocked) - { - interrupt_input_pending = 1; - pending_signals = 1; - return -1; - } - - interrupt_input_pending = 0; - BLOCK_INPUT; + block_input (); /* So people can tell when we have read the available input. */ input_signal_count++; @@ -4961,7 +4953,7 @@ w32_read_socket (struct terminal *terminal, } } - UNBLOCK_INPUT; + unblock_input (); return count; } @@ -5476,7 +5468,7 @@ x_set_offset (struct frame *f, register int xoff, register int yoff, } x_calc_absolute_position (f); - BLOCK_INPUT; + block_input (); x_wm_set_size_hint (f, (long) 0, 0); modified_left = f->left_pos; @@ -5487,7 +5479,7 @@ x_set_offset (struct frame *f, register int xoff, register int yoff, modified_left, modified_top, 0, 0, SWP_NOZORDER | SWP_NOSIZE | SWP_NOACTIVATE); - UNBLOCK_INPUT; + unblock_input (); } @@ -5528,7 +5520,7 @@ x_set_window_size (struct frame *f, int change_gravity, int cols, int rows) { int pixelwidth, pixelheight; - BLOCK_INPUT; + block_input (); check_frame_size (f, &rows, &cols); f->scroll_bar_actual_width @@ -5608,7 +5600,7 @@ x_set_window_size (struct frame *f, int change_gravity, int cols, int rows) cancel_mouse_face (f); #endif - UNBLOCK_INPUT; + unblock_input (); } /* Mouse warping. */ @@ -5638,7 +5630,7 @@ x_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y) RECT rect; POINT pt; - BLOCK_INPUT; + block_input (); GetClientRect (FRAME_W32_WINDOW (f), &rect); pt.x = rect.left + pix_x; @@ -5647,7 +5639,7 @@ x_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y) SetCursorPos (pt.x, pt.y); - UNBLOCK_INPUT; + unblock_input (); } @@ -5659,7 +5651,7 @@ x_focus_on_frame (struct frame *f) struct w32_display_info *dpyinfo = &one_w32_display_info; /* Give input focus to frame. */ - BLOCK_INPUT; + block_input (); #if 0 /* Try not to change its Z-order if possible. */ if (x_window_to_frame (dpyinfo, GetForegroundWindow ())) @@ -5667,7 +5659,7 @@ x_focus_on_frame (struct frame *f) else #endif my_set_foreground_window (FRAME_W32_WINDOW (f)); - UNBLOCK_INPUT; + unblock_input (); } void @@ -5679,7 +5671,7 @@ x_unfocus_frame (struct frame *f) void x_raise_frame (struct frame *f) { - BLOCK_INPUT; + block_input (); /* Strictly speaking, raise-frame should only change the frame's Z order, leaving input focus unchanged. This is reasonable behavior @@ -5734,19 +5726,19 @@ x_raise_frame (struct frame *f) my_bring_window_to_top (FRAME_W32_WINDOW (f)); } - UNBLOCK_INPUT; + unblock_input (); } /* Lower frame F. */ void x_lower_frame (struct frame *f) { - BLOCK_INPUT; + block_input (); my_set_window_pos (FRAME_W32_WINDOW (f), HWND_BOTTOM, 0, 0, 0, 0, SWP_NOSIZE | SWP_NOMOVE | SWP_NOACTIVATE); - UNBLOCK_INPUT; + unblock_input (); } static void @@ -5775,7 +5767,7 @@ x_make_frame_visible (struct frame *f) { Lisp_Object type; - BLOCK_INPUT; + block_input (); type = x_icon_type (f); if (!NILP (type)) @@ -5827,7 +5819,7 @@ x_make_frame_visible (struct frame *f) int count; /* This must come after we set COUNT. */ - UNBLOCK_INPUT; + unblock_input (); XSETFRAME (frame, f); @@ -5870,7 +5862,7 @@ x_make_frame_invisible (struct frame *f) if (FRAME_W32_DISPLAY_INFO (f)->x_highlight_frame == f) FRAME_W32_DISPLAY_INFO (f)->x_highlight_frame = 0; - BLOCK_INPUT; + block_input (); my_show_window (f, FRAME_W32_WINDOW (f), SW_HIDE); @@ -5884,7 +5876,7 @@ x_make_frame_invisible (struct frame *f) f->async_visible = 0; f->async_iconified = 0; - UNBLOCK_INPUT; + unblock_input (); } /* Change window state from mapped to iconified. */ @@ -5901,7 +5893,7 @@ x_iconify_frame (struct frame *f) if (f->async_iconified) return; - BLOCK_INPUT; + block_input (); type = x_icon_type (f); if (!NILP (type)) @@ -5910,7 +5902,7 @@ x_iconify_frame (struct frame *f) /* Simulate the user minimizing the frame. */ SendMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, SC_MINIMIZE, 0); - UNBLOCK_INPUT; + unblock_input (); } @@ -5922,7 +5914,7 @@ x_free_frame_resources (struct frame *f) struct w32_display_info *dpyinfo = FRAME_W32_DISPLAY_INFO (f); Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); - BLOCK_INPUT; + block_input (); /* We must free faces before destroying windows because some font-driver (e.g. xft) access a window while finishing a @@ -5970,7 +5962,7 @@ x_free_frame_resources (struct frame *f) hlinfo->mouse_face_mouse_frame = 0; } - UNBLOCK_INPUT; + unblock_input (); } @@ -5990,10 +5982,10 @@ x_destroy_window (struct frame *f) /* Set the normal size hints for the window manager, for frame F. FLAGS is the flags word to use--or 0 meaning preserve the flags that the window now has. - If USER_POSITION is nonzero, we set the USPosition + If USER_POSITION, set the USPosition flag (this is useful when FLAGS is 0). */ void -x_wm_set_size_hint (struct frame *f, long flags, int user_position) +x_wm_set_size_hint (struct frame *f, long flags, bool user_position) { Window window = FRAME_W32_WINDOW (f); @@ -6254,10 +6246,10 @@ x_delete_terminal (struct terminal *terminal) if (!terminal->name) return; - BLOCK_INPUT; + block_input (); x_delete_display (dpyinfo); - UNBLOCK_INPUT; + unblock_input (); } struct w32_display_info * @@ -6267,7 +6259,7 @@ w32_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) struct terminal *terminal; HDC hdc; - BLOCK_INPUT; + block_input (); if (!w32_initialized) { @@ -6329,7 +6321,7 @@ w32_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) init_sigio (connection); #endif /* ! defined (SIGIO) */ - UNBLOCK_INPUT; + unblock_input (); return dpyinfo; } diff --git a/src/widget.c b/src/widget.c index fd5ad167125..1f472c6231c 100644 --- a/src/widget.c +++ b/src/widget.c @@ -677,13 +677,13 @@ EmacsFrameDestroy (Widget widget) if (! s) emacs_abort (); if (! s->output_data.x) emacs_abort (); - BLOCK_INPUT; + block_input (); x_free_gcs (s); if (s->output_data.x->white_relief.gc) XFreeGC (XtDisplay (widget), s->output_data.x->white_relief.gc); if (s->output_data.x->black_relief.gc) XFreeGC (XtDisplay (widget), s->output_data.x->black_relief.gc); - UNBLOCK_INPUT; + unblock_input (); } static void diff --git a/src/window.c b/src/window.c index 6798be8231c..bb3b73f9acd 100644 --- a/src/window.c +++ b/src/window.c @@ -60,7 +60,7 @@ static Lisp_Object Qwindow_deletable_p, Qdelete_window, Qdisplay_buffer; static Lisp_Object Qreplace_buffer_in_windows, Qget_mru_window; static Lisp_Object Qwindow_resize_root_window, Qwindow_resize_root_window_vertically; static Lisp_Object Qscroll_up, Qscroll_down, Qscroll_command; -static Lisp_Object Qsafe, Qabove, Qbelow, Qtemp_buffer_resize, Qclone_of; +static Lisp_Object Qsafe, Qabove, Qbelow, Qwindow_size, Qclone_of; static int displayed_window_lines (struct window *); static int count_windows (struct window *); @@ -2819,7 +2819,7 @@ window-start value is reasonable when this function is called. */) } } - BLOCK_INPUT; + block_input (); if (!FRAME_INITIAL_P (f)) { Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); @@ -2961,7 +2961,7 @@ window-start value is reasonable when this function is called. */) } adjust_glyphs (f); - UNBLOCK_INPUT; + unblock_input (); run_window_configuration_change_hook (f); @@ -3696,14 +3696,14 @@ be applied on the Elisp level. */) (horflag ? r->total_cols : r->total_lines))) return Qnil; - BLOCK_INPUT; + block_input (); window_resize_apply (r, horflag); windows_or_buffers_changed++; FRAME_WINDOW_SIZES_CHANGED (f) = 1; adjust_glyphs (f); - UNBLOCK_INPUT; + unblock_input (); run_window_configuration_change_hook (f); @@ -3973,13 +3973,13 @@ set correctly. See the code of `split-window' for how this is done. */) wset_new_total (n, total_size); wset_new_normal (n, normal_size); - BLOCK_INPUT; + block_input (); window_resize_apply (p, horflag); adjust_glyphs (f); /* Set buffer of NEW to buffer of reference window. Don't run any hooks. */ set_window_buffer (new, r->buffer, 0, 1); - UNBLOCK_INPUT; + unblock_input (); /* Maybe we should run the scroll functions in Elisp (which already runs the configuration change hook). */ @@ -4060,7 +4060,7 @@ Signal an error when WINDOW is the only window on its frame. */) { /* Block input. */ - BLOCK_INPUT; + block_input (); window_resize_apply (p, horflag); /* If this window is referred to by the dpyinfo's mouse @@ -4132,7 +4132,7 @@ Signal an error when WINDOW is the only window on its frame. */) else fset_selected_window (f, new_selected_window); - UNBLOCK_INPUT; + unblock_input (); /* Now look whether `get-mru-window' gets us something. */ mru_window = call1 (Qget_mru_window, frame); @@ -4147,7 +4147,7 @@ Signal an error when WINDOW is the only window on its frame. */) fset_selected_window (f, new_selected_window); } else - UNBLOCK_INPUT; + unblock_input (); /* Must be run by the caller: run_window_configuration_change_hook (f); */ @@ -4197,7 +4197,7 @@ grow_mini_window (struct window *w, int delta) root, make_number (- delta)); if (INTEGERP (value) && window_resize_check (r, 0)) { - BLOCK_INPUT; + block_input (); window_resize_apply (r, 0); /* Grow the mini-window. */ @@ -4209,7 +4209,7 @@ grow_mini_window (struct window *w, int delta) w->last_overlay_modified = 0; adjust_glyphs (f); - UNBLOCK_INPUT; + unblock_input (); } } @@ -4234,7 +4234,7 @@ shrink_mini_window (struct window *w) root, make_number (size - 1)); if (INTEGERP (value) && window_resize_check (r, 0)) { - BLOCK_INPUT; + block_input (); window_resize_apply (r, 0); /* Shrink the mini-window. */ @@ -4246,7 +4246,7 @@ shrink_mini_window (struct window *w) w->last_overlay_modified = 0; adjust_glyphs (f); - UNBLOCK_INPUT; + unblock_input (); } /* If the above failed for whatever strange reason we must make a one window frame here. The same routine will be needed when @@ -4278,7 +4278,7 @@ DEFUN ("resize-mini-window-internal", Fresize_mini_window_internal, Sresize_mini && XINT (w->new_total) > 0 && height == XINT (r->new_total) + XINT (w->new_total)) { - BLOCK_INPUT; + block_input (); window_resize_apply (r, 0); wset_total_lines (w, w->new_total); @@ -4288,7 +4288,7 @@ DEFUN ("resize-mini-window-internal", Fresize_mini_window_internal, Sresize_mini windows_or_buffers_changed++; FRAME_WINDOW_SIZES_CHANGED (f) = 1; adjust_glyphs (f); - UNBLOCK_INPUT; + unblock_input (); run_window_configuration_change_hook (f); return Qt; @@ -5624,7 +5624,7 @@ the return value is nil. Otherwise the value is t. */) /* The mouse highlighting code could get screwed up if it runs during this. */ - BLOCK_INPUT; + block_input (); if (data->frame_lines != previous_frame_lines || data->frame_cols != previous_frame_cols) @@ -5875,7 +5875,7 @@ the return value is nil. Otherwise the value is t. */) } adjust_glyphs (f); - UNBLOCK_INPUT; + unblock_input (); /* Scan dead buffer windows. */ for (; CONSP (dead_windows); dead_windows = XCDR (dead_windows)) @@ -6704,7 +6704,7 @@ syms_of_window (void) DEFSYM (Qreplace_buffer_in_windows, "replace-buffer-in-windows"); DEFSYM (Qrecord_window_buffer, "record-window-buffer"); DEFSYM (Qget_mru_window, "get-mru-window"); - DEFSYM (Qtemp_buffer_resize, "temp-buffer-resize"); + DEFSYM (Qwindow_size, "window-size"); DEFSYM (Qtemp_buffer_show_hook, "temp-buffer-show-hook"); DEFSYM (Qabove, "above"); DEFSYM (Qbelow, "below"); @@ -6804,19 +6804,19 @@ This variable takes no effect if `window-combination-limit' is non-nil. */); The following values are recognized: nil means splitting a window will create a new parent window only if the - window has no parent window or the window shall become a combination - orthogonal to the one it is part of. + window has no parent window or the window shall become part of a + combination orthogonal to the one it is part of. -`temp-buffer-resize' means that splitting a window for displaying a - temporary buffer makes a new parent window provided - `temp-buffer-resize-mode' is enabled. Otherwise, this value is - handled like nil. +`window-size' means that splitting a window for displaying a buffer + makes a new parent window provided `display-buffer' is supposed to + explicitly set the window's size due to the presence of a + `window-height' or `window-width' entry in the alist used by + `display-buffer'. Otherwise, this value is handled like nil. `temp-buffer' means that splitting a window for displaying a temporary buffer always makes a new parent window. Otherwise, this value is handled like nil. - `display-buffer' means that splitting a window for displaying a buffer always makes a new parent window. Since temporary buffers are displayed by the function `display-buffer', this value is stronger @@ -6829,7 +6829,7 @@ t means that splitting a window always creates a new parent window. If sibling. Other values are reserved for future use. */); - Vwindow_combination_limit = Qtemp_buffer_resize; + Vwindow_combination_limit = Qwindow_size; DEFVAR_LISP ("window-persistent-parameters", Vwindow_persistent_parameters, doc: /* Alist of persistent window parameters. diff --git a/src/xdisp.c b/src/xdisp.c index c2032696a1c..b23a06ff3d1 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -275,6 +275,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <limits.h> #include "lisp.h" +#include "atimer.h" #include "keyboard.h" #include "frame.h" #include "window.h" @@ -332,10 +333,10 @@ static Lisp_Object Qinhibit_eval_during_redisplay; static Lisp_Object Qbuffer_position, Qposition, Qobject; static Lisp_Object Qright_to_left, Qleft_to_right; -/* Cursor shapes */ +/* Cursor shapes. */ Lisp_Object Qbar, Qhbar, Qbox, Qhollow; -/* Pointer shapes */ +/* Pointer shapes. */ static Lisp_Object Qarrow, Qhand; Lisp_Object Qtext; @@ -346,6 +347,7 @@ static Lisp_Object Qfontification_functions; static Lisp_Object Qwrap_prefix; static Lisp_Object Qline_prefix; +static Lisp_Object Qredisplay_internal; /* Non-nil means don't actually do any redisplay. */ @@ -11402,11 +11404,11 @@ x_cursor_to (int vpos, int hpos, int y, int x) This will also set the cursor position of W. */ if (updated_window == NULL) { - BLOCK_INPUT; + block_input (); display_and_set_cursor (w, 1, hpos, vpos, x, y); if (FRAME_RIF (SELECTED_FRAME ())->flush_display_optional) FRAME_RIF (SELECTED_FRAME ())->flush_display_optional (SELECTED_FRAME ()); - UNBLOCK_INPUT; + unblock_input (); } } @@ -11520,11 +11522,11 @@ update_tool_bar (struct frame *f, int save_match_data) /* Redisplay that happens asynchronously due to an expose event may access f->tool_bar_items. Make sure we update both variables within BLOCK_INPUT so no such event interrupts. */ - BLOCK_INPUT; + block_input (); fset_tool_bar_items (f, new_tool_bar); f->n_tool_bar_items = new_n_tool_bar; w->update_mode_line = 1; - UNBLOCK_INPUT; + unblock_input (); } UNGCPRO; @@ -12928,12 +12930,13 @@ redisplay_internal (void) struct frame *sf; int polling_stopped_here = 0; Lisp_Object old_frame = selected_frame; + struct backtrace backtrace; /* Non-zero means redisplay has to consider all windows on all frames. Zero means, only selected_window is considered. */ int consider_all_windows_p; - /* Non-zero means redisplay has to redisplay the miniwindow */ + /* Non-zero means redisplay has to redisplay the miniwindow. */ int update_miniwindow_p = 0; TRACE ((stderr, "redisplay_internal %d\n", redisplaying_p)); @@ -12970,6 +12973,14 @@ redisplay_internal (void) redisplaying_p = 1; specbind (Qinhibit_free_realized_faces, Qnil); + /* Record this function, so it appears on the profiler's backtraces. */ + backtrace.next = backtrace_list; + backtrace.function = Qredisplay_internal; + backtrace.args = &Qnil; + backtrace.nargs = 0; + backtrace.debug_on_exit = 0; + backtrace_list = &backtrace; + { Lisp_Object tail, frame; @@ -13667,6 +13678,7 @@ redisplay_internal (void) #endif /* HAVE_WINDOW_SYSTEM */ end_of_redisplay: + backtrace_list = backtrace.next; unbind_to (count, Qnil); RESUME_POLLING; } @@ -16205,10 +16217,10 @@ redisplay_window (Lisp_Object window, int just_this_one_p) || w->pseudo_window_p))) { update_begin (f); - BLOCK_INPUT; + block_input (); if (draw_window_fringes (w, 1)) x_draw_vertical_border (w); - UNBLOCK_INPUT; + unblock_input (); update_end (f); } #endif /* HAVE_WINDOW_SYSTEM */ @@ -20161,10 +20173,6 @@ display_menu_bar (struct window *w) this. */ it.paragraph_embedding = L2R; - if (! mode_line_inverse_video) - /* Force the menu-bar to be displayed in the default face. */ - it.base_face_id = it.face_id = DEFAULT_FACE_ID; - /* Clear all rows of the menu bar. */ for (i = 0; i < FRAME_MENU_BAR_LINES (f); ++i) { @@ -20334,10 +20342,6 @@ display_mode_line (struct window *w, enum face_id face_id, Lisp_Object format) it.glyph_row->mode_line_p = 1; - if (! mode_line_inverse_video) - /* Force the mode-line to be displayed in the default face. */ - it.base_face_id = it.face_id = DEFAULT_FACE_ID; - /* FIXME: This should be controlled by a user option. But supporting such an option is not trivial, since the mode line is made up of many separate strings. */ @@ -25327,7 +25331,7 @@ x_write_glyphs (struct glyph *start, int len) if (updated_row->reversed_p && chpos >= updated_row->used[TEXT_AREA]) chpos = updated_row->used[TEXT_AREA] - 1; - BLOCK_INPUT; + block_input (); /* Write glyphs. */ @@ -25345,7 +25349,7 @@ x_write_glyphs (struct glyph *start, int len) && chpos < hpos + len) updated_window->phys_cursor_on_p = 0; - UNBLOCK_INPUT; + unblock_input (); /* Advance the output cursor. */ output_cursor.hpos += len; @@ -25368,7 +25372,7 @@ x_insert_glyphs (struct glyph *start, int len) ptrdiff_t hpos; eassert (updated_window && updated_row); - BLOCK_INPUT; + block_input (); w = updated_window; f = XFRAME (WINDOW_FRAME (w)); @@ -25402,7 +25406,7 @@ x_insert_glyphs (struct glyph *start, int len) /* Advance the output cursor. */ output_cursor.hpos += len; output_cursor.x += shift_by_width; - UNBLOCK_INPUT; + unblock_input (); } @@ -25471,10 +25475,10 @@ x_clear_end_of_line (int to_x) /* Prevent inadvertently clearing to end of the X window. */ if (to_x > from_x && to_y > from_y) { - BLOCK_INPUT; + block_input (); FRAME_RIF (f)->clear_frame_area (f, from_x, from_y, to_x - from_x, to_y - from_y); - UNBLOCK_INPUT; + unblock_input (); } } @@ -25801,7 +25805,7 @@ x_fix_overlapping_area (struct window *w, struct glyph_row *row, { int i, x; - BLOCK_INPUT; + block_input (); x = 0; for (i = 0; i < row->used[area];) @@ -25829,7 +25833,7 @@ x_fix_overlapping_area (struct window *w, struct glyph_row *row, } } - UNBLOCK_INPUT; + unblock_input (); } @@ -26047,7 +26051,7 @@ display_and_set_cursor (struct window *w, int on, || (0 <= hpos && hpos < glyph_row->used[TEXT_AREA])) glyph = glyph_row->glyphs[TEXT_AREA] + hpos; - eassert (interrupt_input_blocked); + eassert (input_blocked_p ()); /* Set new_cursor_type to the cursor we want to be displayed. */ new_cursor_type = get_window_cursor_type (w, glyph, @@ -26117,10 +26121,10 @@ update_window_cursor (struct window *w, int on) if (row->reversed_p && hpos >= row->used[TEXT_AREA]) hpos = row->used[TEXT_AREA] - 1; - BLOCK_INPUT; + block_input (); display_and_set_cursor (w, on, hpos, vpos, w->phys_cursor.x, w->phys_cursor.y); - UNBLOCK_INPUT; + unblock_input (); } } @@ -26298,10 +26302,10 @@ show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw) if (row->reversed_p && hpos >= row->used[TEXT_AREA]) hpos = row->used[TEXT_AREA] - 1; - BLOCK_INPUT; + block_input (); display_and_set_cursor (w, 1, hpos, w->phys_cursor.vpos, w->phys_cursor.x, w->phys_cursor.y); - UNBLOCK_INPUT; + unblock_input (); } #endif /* HAVE_WINDOW_SYSTEM */ } @@ -28116,11 +28120,11 @@ x_clear_window_mouse_face (struct window *w) Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (XFRAME (w->frame)); Lisp_Object window; - BLOCK_INPUT; + block_input (); XSETWINDOW (window, w); if (EQ (window, hlinfo->mouse_face_window)) clear_mouse_face (hlinfo); - UNBLOCK_INPUT; + unblock_input (); } @@ -28690,6 +28694,7 @@ syms_of_xdisp (void) staticpro (&Vmessage_stack); DEFSYM (Qinhibit_redisplay, "inhibit-redisplay"); + DEFSYM (Qredisplay_internal, "redisplay_internal (C function)"); message_dolog_marker1 = Fmake_marker (); staticpro (&message_dolog_marker1); @@ -28929,12 +28934,6 @@ A value of nil means to respect the value of `truncate-lines'. If `word-wrap' is enabled, you might want to reduce this. */); Vtruncate_partial_width_windows = make_number (50); - DEFVAR_BOOL ("mode-line-inverse-video", mode_line_inverse_video, - doc: /* When nil, display the mode-line/header-line/menu-bar in the default face. -Any other value means to use the appropriate face, `mode-line', -`header-line', or `menu' respectively. */); - mode_line_inverse_video = 1; - DEFVAR_LISP ("line-number-display-limit", Vline_number_display_limit, doc: /* Maximum buffer size for which line number should be displayed. If the buffer is bigger than this, the line number does not appear @@ -29362,7 +29361,7 @@ init_xdisp (void) the following three functions in w32fns.c. */ #ifndef WINDOWSNT -/* Platform-independent portion of hourglass implementation. */ +/* Platform-independent portion of hourglass implementation. */ /* Cancel a currently active hourglass timer, and start a new one. */ void diff --git a/src/xfaces.c b/src/xfaces.c index c240a05c6c0..28be6aaf082 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -605,9 +605,9 @@ static inline GC x_create_gc (struct frame *f, long unsigned int mask, XGCValues *xgcv) { GC gc; - BLOCK_INPUT; + block_input (); gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), mask, xgcv); - UNBLOCK_INPUT; + unblock_input (); IF_DEBUG (++ngcs); return gc; } @@ -618,7 +618,7 @@ x_create_gc (struct frame *f, long unsigned int mask, XGCValues *xgcv) static inline void x_free_gc (struct frame *f, GC gc) { - eassert (interrupt_input_blocked); + eassert (input_blocked_p ()); IF_DEBUG (eassert (--ngcs >= 0)); XFreeGC (FRAME_X_DISPLAY (f), gc); } @@ -632,9 +632,9 @@ static inline GC x_create_gc (struct frame *f, unsigned long mask, XGCValues *xgcv) { GC gc; - BLOCK_INPUT; + block_input (); gc = XCreateGC (NULL, FRAME_W32_WINDOW (f), mask, xgcv); - UNBLOCK_INPUT; + unblock_input (); IF_DEBUG (++ngcs); return gc; } @@ -907,7 +907,7 @@ load_pixmap (FRAME_PTR f, Lisp_Object name, unsigned int *w_ptr, CHECK_TYPE (!NILP (Fbitmap_spec_p (name)), Qbitmap_spec_p, name); - BLOCK_INPUT; + block_input (); if (CONSP (name)) { /* Decode a bitmap spec into a bitmap. */ @@ -927,7 +927,7 @@ load_pixmap (FRAME_PTR f, Lisp_Object name, unsigned int *w_ptr, /* It must be a string -- a file name. */ bitmap_id = x_create_bitmap_from_file (f, name); } - UNBLOCK_INPUT; + unblock_input (); if (bitmap_id < 0) { @@ -991,7 +991,7 @@ parse_rgb_list (Lisp_Object rgb_list, XColor *color) non-zero, then the `standard' definition of the same color is returned in it. */ -static int +static bool tty_lookup_color (struct frame *f, Lisp_Object color, XColor *tty_color, XColor *std_color) { @@ -1052,11 +1052,11 @@ tty_lookup_color (struct frame *f, Lisp_Object color, XColor *tty_color, /* A version of defined_color for non-X frames. */ -static int +static bool tty_defined_color (struct frame *f, const char *color_name, - XColor *color_def, int alloc) + XColor *color_def, bool alloc) { - int status = 1; + bool status = 1; /* Defaults. */ color_def->pixel = FACE_TTY_DEFAULT_COLOR; @@ -1084,13 +1084,13 @@ tty_defined_color (struct frame *f, const char *color_name, /* Decide if color named COLOR_NAME is valid for the display associated with the frame F; if so, return the rgb values in - COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell. + COLOR_DEF. If ALLOC, allocate a new colormap cell. This does the right thing for any type of frame. */ -static int +static bool defined_color (struct frame *f, const char *color_name, XColor *color_def, - int alloc) + bool alloc) { if (!FRAME_WINDOW_P (f)) return tty_defined_color (f, color_name, color_def, alloc); @@ -1364,9 +1364,9 @@ unload_color (struct frame *f, long unsigned int pixel) #ifdef HAVE_X_WINDOWS if (pixel != -1) { - BLOCK_INPUT; + block_input (); x_free_colors (f, &pixel, 1); - UNBLOCK_INPUT; + unblock_input (); } #endif } @@ -1382,7 +1382,7 @@ free_face_colors (struct frame *f, struct face *face) if (face->colors_copied_bitwise_p) return; - BLOCK_INPUT; + block_input (); if (!face->foreground_defaulted_p) { @@ -1424,7 +1424,7 @@ free_face_colors (struct frame *f, struct face *face) IF_DEBUG (--ncolors_allocated); } - UNBLOCK_INPUT; + unblock_input (); #endif /* HAVE_X_WINDOWS */ } @@ -3438,10 +3438,10 @@ DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource, CHECK_STRING (resource); CHECK_STRING (class); CHECK_LIVE_FRAME (frame); - BLOCK_INPUT; + block_input (); value = display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame)), resource, class, Qnil, Qnil); - UNBLOCK_INPUT; + unblock_input (); return value; } @@ -4114,12 +4114,12 @@ free_realized_face (struct frame *f, struct face *face) free_face_fontset (f, face); if (face->gc) { - BLOCK_INPUT; + block_input (); if (face->font) font_done_for_face (f, face); x_free_gc (f, face->gc); face->gc = 0; - UNBLOCK_INPUT; + unblock_input (); } free_face_colors (f, face); @@ -4153,7 +4153,7 @@ prepare_face_for_display (struct frame *f, struct face *face) xgcv.graphics_exposures = False; #endif - BLOCK_INPUT; + block_input (); #ifdef HAVE_X_WINDOWS if (face->stipple) { @@ -4165,7 +4165,7 @@ prepare_face_for_display (struct frame *f, struct face *face) face->gc = x_create_gc (f, mask, &xgcv); if (face->font) font_prepare_for_face (f, face); - UNBLOCK_INPUT; + unblock_input (); } #endif /* HAVE_WINDOW_SYSTEM */ } @@ -4263,12 +4263,12 @@ clear_face_gcs (struct face_cache *c) struct face *face = c->faces_by_id[i]; if (face && face->gc) { - BLOCK_INPUT; + block_input (); if (face->font) font_done_for_face (c->f, face); x_free_gc (c->f, face->gc); face->gc = 0; - UNBLOCK_INPUT; + unblock_input (); } } #endif /* HAVE_WINDOW_SYSTEM */ @@ -4292,7 +4292,7 @@ free_realized_faces (struct face_cache *c) /* We must block input here because we can't process X events safely while only some faces are freed, or when the frame's current matrix still references freed faces. */ - BLOCK_INPUT; + block_input (); for (i = 0; i < c->used; ++i) { @@ -4314,7 +4314,7 @@ free_realized_faces (struct face_cache *c) ++windows_or_buffers_changed; } - UNBLOCK_INPUT; + unblock_input (); } } @@ -5275,7 +5275,7 @@ realize_basic_faces (struct frame *f) /* Block input here so that we won't be surprised by an X expose event, for instance, without having the faces set up. */ - BLOCK_INPUT; + block_input (); specbind (Qscalable_fonts_allowed, Qt); if (realize_default_face (f)) @@ -5306,7 +5306,7 @@ realize_basic_faces (struct frame *f) } unbind_to (count, Qnil); - UNBLOCK_INPUT; + unblock_input (); return success_p; } @@ -6352,7 +6352,7 @@ where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */) int red, green, blue; int num; - BLOCK_INPUT; + block_input (); while (fgets (buf, sizeof (buf), fp) != NULL) { if (sscanf (buf, "%u %u %u %n", &red, &green, &blue, &num) == 3) @@ -6372,7 +6372,7 @@ where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */) } fclose (fp); - UNBLOCK_INPUT; + unblock_input (); } return cmap; diff --git a/src/xfns.c b/src/xfns.c index 8304a3df04f..928e6367743 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -425,7 +425,7 @@ x_real_positions (FRAME_PTR f, int *xptr, int *yptr) unsigned char *tmp_data = NULL; Atom target_type = XA_CARDINAL; - BLOCK_INPUT; + block_input (); x_catch_errors (dpy); @@ -543,7 +543,7 @@ x_real_positions (FRAME_PTR f, int *xptr, int *yptr) x_uncatch_errors (); - UNBLOCK_INPUT; + unblock_input (); if (had_errors) return; @@ -575,27 +575,27 @@ gamma_correct (struct frame *f, XColor *color) /* Decide if color named COLOR_NAME is valid for use on frame F. If - so, return the RGB values in COLOR. If ALLOC_P is non-zero, - allocate the color. Value is zero if COLOR_NAME is invalid, or + so, return the RGB values in COLOR. If ALLOC_P, + allocate the color. Value is false if COLOR_NAME is invalid, or no color could be allocated. */ -int +bool x_defined_color (struct frame *f, const char *color_name, - XColor *color, int alloc_p) + XColor *color, bool alloc_p) { - int success_p = 0; + bool success_p = 0; Display *dpy = FRAME_X_DISPLAY (f); Colormap cmap = FRAME_X_COLORMAP (f); - BLOCK_INPUT; + block_input (); #ifdef USE_GTK success_p = xg_check_special_colors (f, color_name, color); #endif if (!success_p) - success_p = XParseColor (dpy, cmap, color_name, color); + success_p = XParseColor (dpy, cmap, color_name, color) != 0; if (success_p && alloc_p) success_p = x_alloc_nearest_color (f, cmap, color); - UNBLOCK_INPUT; + unblock_input (); return success_p; } @@ -656,8 +656,8 @@ x_set_tool_bar_position (struct frame *f, if (EQ (new_value, old_value)) return; #ifdef USE_GTK - if (xg_change_toolbar_position (f, new_value)) - fset_tool_bar_position (f, new_value); + xg_change_toolbar_position (f, new_value); + fset_tool_bar_position (f, new_value); #endif } @@ -679,7 +679,7 @@ xg_set_icon (FRAME_PTR f, Lisp_Object file) GdkPixbuf *pixbuf; GError *err = NULL; char *filename = SSDATA (found); - BLOCK_INPUT; + block_input (); pixbuf = gdk_pixbuf_new_from_file (filename, &err); @@ -694,7 +694,7 @@ xg_set_icon (FRAME_PTR f, Lisp_Object file) else g_error_free (err); - UNBLOCK_INPUT; + unblock_input (); } return result; @@ -737,7 +737,7 @@ x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { Display *dpy = FRAME_X_DISPLAY (f); - BLOCK_INPUT; + block_input (); XSetForeground (dpy, x->normal_gc, fg); XSetBackground (dpy, x->reverse_gc, fg); @@ -748,7 +748,7 @@ x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) XSetBackground (dpy, x->cursor_gc, x->cursor_pixel); } - UNBLOCK_INPUT; + unblock_input (); update_face_from_frame_parameter (f, Qforeground_color, arg); @@ -773,7 +773,7 @@ x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { Display *dpy = FRAME_X_DISPLAY (f); - BLOCK_INPUT; + block_input (); XSetBackground (dpy, x->normal_gc, bg); XSetForeground (dpy, x->reverse_gc, bg); XSetWindowBackground (dpy, FRAME_X_WINDOW (f), bg); @@ -797,7 +797,7 @@ x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) } #endif /* USE_TOOLKIT_SCROLL_BARS */ - UNBLOCK_INPUT; + unblock_input (); update_face_from_frame_parameter (f, Qbackground_color, arg); if (FRAME_VISIBLE_P (f)) @@ -854,7 +854,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) unload_color (f, x->mouse_pixel); x->mouse_pixel = pixel; - BLOCK_INPUT; + block_input (); /* It's not okay to crash if the user selects a screwy cursor. */ x_catch_errors (dpy); @@ -974,7 +974,7 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) x->horizontal_drag_cursor = horizontal_drag_cursor; XFlush (dpy); - UNBLOCK_INPUT; + unblock_input (); update_face_from_frame_parameter (f, Qmouse_color, arg); } @@ -1031,10 +1031,10 @@ x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (FRAME_X_WINDOW (f) != 0) { - BLOCK_INPUT; + block_input (); XSetBackground (FRAME_X_DISPLAY (f), x->cursor_gc, x->cursor_pixel); XSetForeground (FRAME_X_DISPLAY (f), x->cursor_gc, fore_pixel); - UNBLOCK_INPUT; + unblock_input (); if (FRAME_VISIBLE_P (f)) { @@ -1058,9 +1058,9 @@ x_set_border_pixel (struct frame *f, int pix) if (FRAME_X_WINDOW (f) != 0 && f->border_width > 0) { - BLOCK_INPUT; + block_input (); XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), pix); - UNBLOCK_INPUT; + unblock_input (); if (FRAME_VISIBLE_P (f)) redraw_frame (f); @@ -1112,7 +1112,7 @@ x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil)) return; - BLOCK_INPUT; + block_input (); if (NILP (arg)) result = x_text_icon (f, SSDATA ((!NILP (f->icon_name) @@ -1123,12 +1123,12 @@ x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (result) { - UNBLOCK_INPUT; + unblock_input (); error ("No icon window available"); } XFlush (FRAME_X_DISPLAY (f)); - UNBLOCK_INPUT; + unblock_input (); } static void @@ -1149,7 +1149,7 @@ x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (f->output_data.x->icon_bitmap != 0) return; - BLOCK_INPUT; + block_input (); result = x_text_icon (f, SSDATA ((!NILP (f->icon_name) @@ -1160,12 +1160,12 @@ x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (result) { - UNBLOCK_INPUT; + unblock_input (); error ("No icon window available"); } XFlush (FRAME_X_DISPLAY (f)); - UNBLOCK_INPUT; + unblock_input (); } @@ -1228,10 +1228,10 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) { y = FRAME_TOP_MARGIN_HEIGHT (f); - BLOCK_INPUT; + block_input (); x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), 0, y, width, height, False); - UNBLOCK_INPUT; + unblock_input (); } if (nlines > 1 && nlines > olines) @@ -1239,10 +1239,10 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) y = (olines == 0 ? 1 : olines) * FRAME_LINE_HEIGHT (f); height = nlines * FRAME_LINE_HEIGHT (f) - y; - BLOCK_INPUT; + block_input (); x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), 0, y, width, height, False); - UNBLOCK_INPUT; + unblock_input (); } if (nlines == 0 && WINDOWP (f->menu_bar_window)) @@ -1338,10 +1338,10 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) /* height can be zero here. */ if (height > 0 && width > 0) { - BLOCK_INPUT; + block_input (); x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), 0, y, width, height, False); - UNBLOCK_INPUT; + unblock_input (); } if (WINDOWP (f->tool_bar_window)) @@ -1494,7 +1494,7 @@ x_set_name_internal (FRAME_PTR f, Lisp_Object name) { if (FRAME_X_WINDOW (f)) { - BLOCK_INPUT; + block_input (); { XTextProperty text, icon; ptrdiff_t bytes; @@ -1586,7 +1586,7 @@ x_set_name_internal (FRAME_PTR f, Lisp_Object name) if (do_free_text_value) xfree (text.value); } - UNBLOCK_INPUT; + unblock_input (); } } @@ -1779,7 +1779,7 @@ hack_wm_protocols (FRAME_PTR f, Widget widget) int need_focus = 1; int need_save = 1; - BLOCK_INPUT; + block_input (); { Atom type; unsigned char *catoms; @@ -1827,7 +1827,7 @@ hack_wm_protocols (FRAME_PTR f, Widget widget) XA_ATOM, 32, PropModeAppend, (unsigned char *) props, count); } - UNBLOCK_INPUT; + unblock_input (); } #endif @@ -2350,7 +2350,7 @@ x_window (struct frame *f, long window_prompting, int minibuffer_only) Arg al [25]; int ac; - BLOCK_INPUT; + block_input (); /* Use the resource name as the top-level widget name for looking up resources. Make a non-Lisp copy @@ -2572,7 +2572,7 @@ x_window (struct frame *f, long window_prompting, int minibuffer_only) f->output_data.x->current_cursor = f->output_data.x->text_cursor); - UNBLOCK_INPUT; + unblock_input (); /* This is a no-op, except under Motif. Make sure main areas are set to something reasonable, in case we get an error later. */ @@ -2591,7 +2591,7 @@ x_window (FRAME_PTR f) FRAME_XIC (f) = NULL; if (use_xim) { - BLOCK_INPUT; + block_input (); create_frame_xic (f); if (FRAME_XIC (f)) { @@ -2613,7 +2613,7 @@ x_window (FRAME_PTR f) attribute_mask, &attributes); } } - UNBLOCK_INPUT; + unblock_input (); } #endif } @@ -2638,7 +2638,7 @@ x_window (struct frame *f) attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity | CWEventMask | CWColormap); - BLOCK_INPUT; + block_input (); FRAME_X_WINDOW (f) = XCreateWindow (FRAME_X_DISPLAY (f), f->output_data.x->parent_desc, @@ -2715,7 +2715,7 @@ x_window (struct frame *f) f->output_data.x->current_cursor = f->output_data.x->text_cursor); - UNBLOCK_INPUT; + unblock_input (); if (FRAME_X_WINDOW (f) == 0) error ("Unable to create window"); @@ -2768,7 +2768,7 @@ x_icon (struct frame *f, Lisp_Object parms) else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound)) error ("Both left and top icon corners of icon must be specified"); - BLOCK_INPUT; + block_input (); if (! EQ (icon_x, Qunbound)) x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y)); @@ -2787,7 +2787,7 @@ x_icon (struct frame *f, Lisp_Object parms) ? f->icon_name : f->name))); - UNBLOCK_INPUT; + unblock_input (); } /* Make the GCs needed for this window, setting the @@ -2799,7 +2799,7 @@ x_make_gc (struct frame *f) { XGCValues gc_values; - BLOCK_INPUT; + block_input (); /* Create the GCs of this frame. Note that many default values are used. */ @@ -2847,7 +2847,7 @@ x_make_gc (struct frame *f) FRAME_BACKGROUND_PIXEL (f), DefaultDepth (FRAME_X_DISPLAY (f), FRAME_X_SCREEN_NUMBER (f)))); - UNBLOCK_INPUT; + unblock_input (); } @@ -2858,7 +2858,7 @@ x_free_gcs (struct frame *f) { Display *dpy = FRAME_X_DISPLAY (f); - BLOCK_INPUT; + block_input (); if (f->output_data.x->normal_gc) { @@ -2884,7 +2884,7 @@ x_free_gcs (struct frame *f) f->output_data.x->border_tile = 0; } - UNBLOCK_INPUT; + unblock_input (); } @@ -3007,10 +3007,10 @@ If FRAME is nil, use the selected frame. */) if (NILP (frame)) frame = selected_frame; f = XFRAME (frame); - BLOCK_INPUT; + block_input (); if (FRAME_X_P (f)) x_wm_set_size_hint (f, 0, 0); - UNBLOCK_INPUT; + unblock_input (); return Qnil; } @@ -3405,9 +3405,9 @@ This function is an internal primitive--use `make-frame' instead. */) /* Tell the server what size and position, etc, we want, and how badly we want them. This should be done after we have the menu bar so that its size can be taken into account. */ - BLOCK_INPUT; + block_input (); x_wm_set_size_hint (f, window_prompting, 0); - UNBLOCK_INPUT; + unblock_input (); /* Make the window appear on the frame and enable display, unless the caller says not to. However, with explicit parent, Emacs @@ -3431,7 +3431,7 @@ This function is an internal primitive--use `make-frame' instead. */) } } - BLOCK_INPUT; + block_input (); /* Set machine name and pid for the purpose of window managers. */ set_machine_and_pid_properties (f); @@ -3447,7 +3447,7 @@ This function is an internal primitive--use `make-frame' instead. */) (unsigned char *) &dpyinfo->client_leader_window, 1); } - UNBLOCK_INPUT; + unblock_input (); /* Initialize `default-minibuffer-frame' in case this is the first frame on this terminal. */ @@ -3506,7 +3506,7 @@ FRAME nil means use the selected frame. */) struct frame *f = check_x_frame (frame); Display *dpy = FRAME_X_DISPLAY (f); - BLOCK_INPUT; + block_input (); x_catch_errors (dpy); if (FRAME_X_EMBEDDED_P (f)) @@ -3524,7 +3524,7 @@ FRAME nil means use the selected frame. */) } x_uncatch_errors (); - UNBLOCK_INPUT; + unblock_input (); return Qnil; } @@ -4152,9 +4152,9 @@ If TERMINAL is omitted or nil, that stands for the selected frame's display. */ void x_sync (FRAME_PTR f) { - BLOCK_INPUT; + block_input (); XSync (FRAME_X_DISPLAY (f), False); - UNBLOCK_INPUT; + unblock_input (); } @@ -4229,7 +4229,7 @@ FRAME. Default is to change on the edit X window. */) nelements = SBYTES (value); } - BLOCK_INPUT; + block_input (); prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (prop), False); if (! NILP (type)) { @@ -4248,7 +4248,7 @@ FRAME. Default is to change on the edit X window. */) /* Make sure the property is set when we return. */ XFlush (FRAME_X_DISPLAY (f)); - UNBLOCK_INPUT; + unblock_input (); return value; } @@ -4264,13 +4264,13 @@ FRAME nil or omitted means use the selected frame. Value is PROP. */) Atom prop_atom; CHECK_STRING (prop); - BLOCK_INPUT; + block_input (); prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (prop), False); XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), prop_atom); /* Make sure the property is removed when we return. */ XFlush (FRAME_X_DISPLAY (f)); - UNBLOCK_INPUT; + unblock_input (); return prop; } @@ -4318,7 +4318,7 @@ no value of TYPE (always string in the MS Windows case). */) target_window = FRAME_X_DISPLAY_INFO (f)->root_window; } - BLOCK_INPUT; + block_input (); if (STRINGP (type)) { if (strcmp ("AnyPropertyType", SSDATA (type)) == 0) @@ -4384,7 +4384,7 @@ no value of TYPE (always string in the MS Windows case). */) if (tmp_data) XFree (tmp_data); } - UNBLOCK_INPUT; + unblock_input (); UNGCPRO; return prop_value; } @@ -4415,7 +4415,7 @@ show_hourglass (struct atimer *timer) { Lisp_Object rest, frame; - BLOCK_INPUT; + block_input (); FOR_EACH_FRAME (rest, frame) { @@ -4459,7 +4459,7 @@ show_hourglass (struct atimer *timer) } hourglass_shown_p = 1; - UNBLOCK_INPUT; + unblock_input (); } } @@ -4474,7 +4474,7 @@ hide_hourglass (void) { Lisp_Object rest, frame; - BLOCK_INPUT; + block_input (); FOR_EACH_FRAME (rest, frame) { struct frame *f = XFRAME (frame); @@ -4493,7 +4493,7 @@ hide_hourglass (void) } hourglass_shown_p = 0; - UNBLOCK_INPUT; + unblock_input (); } } @@ -4743,7 +4743,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo, unsigned long mask; Atom type = FRAME_X_DISPLAY_INFO (f)->Xatom_net_window_type_tooltip; - BLOCK_INPUT; + block_input (); mask = CWBackPixel | CWOverrideRedirect | CWEventMask; if (DoesSaveUnders (dpyinfo->screen)) mask |= CWSaveUnder; @@ -4770,7 +4770,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo, FRAME_X_DISPLAY_INFO (f)->Xatom_net_window_type, XA_ATOM, 32, PropModeReplace, (unsigned char *)&type, 1); - UNBLOCK_INPUT; + unblock_input (); } x_make_gc (f); @@ -4884,10 +4884,10 @@ compute_tip_xy (struct frame *f, Lisp_Object parms, Lisp_Object dx, Lisp_Object show it. */ if (!INTEGERP (left) || !INTEGERP (top)) { - BLOCK_INPUT; + block_input (); XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window, &root, &child, root_x, root_y, &win_x, &win_y, &pmask); - UNBLOCK_INPUT; + unblock_input (); } if (INTEGERP (top)) @@ -4985,20 +4985,21 @@ Text larger than the specified size is clipped. */) #ifdef USE_GTK if (x_gtk_use_system_tooltips) { - int ok; + bool ok; /* Hide a previous tip, if any. */ Fx_hide_tip (); - BLOCK_INPUT; - if ((ok = xg_prepare_tooltip (f, string, &width, &height)) != 0) + block_input (); + ok = xg_prepare_tooltip (f, string, &width, &height); + if (ok) { compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y); xg_show_tooltip (f, root_x, root_y); /* This is used in Fx_hide_tip. */ XSETFRAME (tip_frame, f); } - UNBLOCK_INPUT; + unblock_input (); if (ok) goto start_timer; } #endif /* USE_GTK */ @@ -5026,12 +5027,12 @@ Text larger than the specified size is clipped. */) call1 (Qcancel_timer, timer); } - BLOCK_INPUT; + block_input (); compute_tip_xy (tip_f, parms, dx, dy, FRAME_PIXEL_WIDTH (tip_f), FRAME_PIXEL_HEIGHT (tip_f), &root_x, &root_y); XMoveWindow (FRAME_X_DISPLAY (tip_f), FRAME_X_WINDOW (tip_f), root_x, root_y); - UNBLOCK_INPUT; + unblock_input (); goto start_timer; } } @@ -5185,11 +5186,11 @@ Text larger than the specified size is clipped. */) show it. */ compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y); - BLOCK_INPUT; + block_input (); XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), root_x, root_y, width, height); XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); - UNBLOCK_INPUT; + unblock_input (); /* Draw into the window. */ w->must_be_updated_p = 1; @@ -5261,9 +5262,9 @@ Value is t if tooltip was open, nil otherwise. */) if (!DoesSaveUnders (FRAME_X_DISPLAY_INFO (f)->screen) && w != NULL) { - BLOCK_INPUT; + block_input (); xlwmenu_redisplay (w); - UNBLOCK_INPUT; + unblock_input (); } } #endif /* USE_LUCID */ @@ -5327,11 +5328,11 @@ clean_up_file_dialog (Lisp_Object arg) Widget dialog = (Widget) p->pointer; /* Clean up. */ - BLOCK_INPUT; + block_input (); XtUnmanageChild (dialog); XtDestroyWidget (dialog); x_menu_set_in_use (0); - UNBLOCK_INPUT; + unblock_input (); return Qnil; } @@ -5372,7 +5373,7 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */) /* Prevent redisplay. */ specbind (Qinhibit_redisplay, Qt); - BLOCK_INPUT; + block_input (); /* Create the dialog with PROMPT as title, using DIR as initial directory and using "*" as pattern. */ @@ -5486,7 +5487,7 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */) else file = Qnil; - UNBLOCK_INPUT; + unblock_input (); UNGCPRO; /* Make "Cancel" equivalent to C-g. */ @@ -5543,7 +5544,7 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */) specbind (Qinhibit_redisplay, Qt); record_unwind_protect (clean_up_dialog, Qnil); - BLOCK_INPUT; + block_input (); if (STRINGP (default_filename)) cdef_file = SSDATA (default_filename); @@ -5560,7 +5561,7 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */) xfree (fn); } - UNBLOCK_INPUT; + unblock_input (); UNGCPRO; /* Make "Cancel" equivalent to C-g. */ @@ -5600,7 +5601,7 @@ nil, it defaults to the selected frame. */) specbind (Qinhibit_redisplay, Qt); record_unwind_protect (clean_up_dialog, Qnil); - BLOCK_INPUT; + block_input (); GCPRO2 (font_param, font); @@ -5618,7 +5619,7 @@ nil, it defaults to the selected frame. */) font = xg_get_font (f, default_name); xfree (default_name); - UNBLOCK_INPUT; + unblock_input (); if (NILP (font)) Fsignal (Qquit, Qnil); @@ -5655,14 +5656,14 @@ present and mapped to the usual X keysyms. */) Lisp_Object have_keys; int major, minor, op, event, error_code; - BLOCK_INPUT; + block_input (); /* Check library version in case we're dynamically linked. */ major = XkbMajorVersion; minor = XkbMinorVersion; if (!XkbLibraryVersion (&major, &minor)) { - UNBLOCK_INPUT; + unblock_input (); return Qlambda; } @@ -5671,7 +5672,7 @@ present and mapped to the usual X keysyms. */) minor = XkbMinorVersion; if (!XkbQueryExtension (dpy, &op, &event, &error_code, &major, &minor)) { - UNBLOCK_INPUT; + unblock_input (); return Qlambda; } @@ -5724,7 +5725,7 @@ present and mapped to the usual X keysyms. */) && XKeysymToKeycode (dpy, XK_BackSpace) == backspace_keycode) have_keys = Qt; } - UNBLOCK_INPUT; + unblock_input (); return have_keys; #else /* not HAVE_XKBGETKEYBOARD */ return Qlambda; diff --git a/src/xfont.c b/src/xfont.c index 1f2fd13f1b7..2d493088b0b 100644 --- a/src/xfont.c +++ b/src/xfont.c @@ -362,7 +362,7 @@ xfont_list_pattern (Display *display, const char *pattern, } } - BLOCK_INPUT; + block_input (); x_catch_errors (display); for (limit = 512; ; limit *= 2) @@ -479,7 +479,7 @@ xfont_list_pattern (Display *display, const char *pattern, } x_uncatch_errors (); - UNBLOCK_INPUT; + unblock_input (); FONT_ADD_LOG ("xfont-list", build_string (pattern), list); return list; @@ -588,7 +588,7 @@ xfont_match (Lisp_Object frame, Lisp_Object spec) if (xfont_encode_coding_xlfd (name) < 0) return Qnil; - BLOCK_INPUT; + block_input (); entity = Qnil; xfont = XLoadQueryFont (display, name); if (xfont) @@ -615,7 +615,7 @@ xfont_match (Lisp_Object frame, Lisp_Object spec) } XFreeFont (display, xfont); } - UNBLOCK_INPUT; + unblock_input (); FONT_ADD_LOG ("xfont-match", spec, entity); return entity; @@ -632,7 +632,7 @@ xfont_list_family (Lisp_Object frame) char *last_family IF_LINT (= 0); int last_len; - BLOCK_INPUT; + block_input (); x_catch_errors (dpyinfo->display); names = XListFonts (dpyinfo->display, "-*-*-*-*-*-*-*-*-*-*-*-*-*-*", 0x8000, &num_fonts); @@ -673,7 +673,7 @@ xfont_list_family (Lisp_Object frame) XFreeFontNames (names); x_uncatch_errors (); - UNBLOCK_INPUT; + unblock_input (); return list; } @@ -717,7 +717,7 @@ xfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size) return Qnil; } - BLOCK_INPUT; + block_input (); x_catch_errors (display); xfont = XLoadQueryFont (display, name); if (x_had_errors_p (display)) @@ -784,7 +784,7 @@ xfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size) XFree (p0); } x_uncatch_errors (); - UNBLOCK_INPUT; + unblock_input (); if (! xfont) { @@ -866,7 +866,7 @@ xfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size) } } - BLOCK_INPUT; + block_input (); font->underline_thickness = (XGetFontProperty (xfont, XA_UNDERLINE_THICKNESS, &value) ? (long) value : 0); @@ -882,7 +882,7 @@ xfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size) font->default_ascent = (XGetFontProperty (xfont, dpyinfo->Xatom_MULE_DEFAULT_ASCENT, &value) ? (long) value : 0); - UNBLOCK_INPUT; + unblock_input (); if (NILP (fullname)) fullname = AREF (font_object, FONT_NAME_INDEX); @@ -897,18 +897,18 @@ xfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size) static void xfont_close (FRAME_PTR f, struct font *font) { - BLOCK_INPUT; + block_input (); XFreeFont (FRAME_X_DISPLAY (f), ((struct xfont_info *) font)->xfont); - UNBLOCK_INPUT; + unblock_input (); } static int xfont_prepare_face (FRAME_PTR f, struct face *face) { - BLOCK_INPUT; + block_input (); XSetFont (FRAME_X_DISPLAY (f), face->gc, ((struct xfont_info *) face->font)->xfont->fid); - UNBLOCK_INPUT; + unblock_input (); return 0; } @@ -1028,9 +1028,9 @@ xfont_draw (struct glyph_string *s, int from, int to, int x, int y, if (s->gc != s->face->gc) { - BLOCK_INPUT; + block_input (); XSetFont (s->display, gc, xfont->fid); - UNBLOCK_INPUT; + unblock_input (); } if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0) @@ -1039,7 +1039,7 @@ xfont_draw (struct glyph_string *s, int from, int to, int x, int y, char *str = SAFE_ALLOCA (len); for (i = 0; i < len ; i++) str[i] = XCHAR2B_BYTE2 (s->char2b + from + i); - BLOCK_INPUT; + block_input (); if (with_background) { if (s->padding_p) @@ -1060,12 +1060,12 @@ xfont_draw (struct glyph_string *s, int from, int to, int x, int y, XDrawString (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f), gc, x, y, str, len); } - UNBLOCK_INPUT; + unblock_input (); SAFE_FREE (); return s->nchars; } - BLOCK_INPUT; + block_input (); if (with_background) { if (s->padding_p) @@ -1086,7 +1086,7 @@ xfont_draw (struct glyph_string *s, int from, int to, int x, int y, XDrawString16 (FRAME_X_DISPLAY (s->f), FRAME_X_WINDOW (s->f), gc, x, y, s->char2b + from, len); } - UNBLOCK_INPUT; + unblock_input (); return len; } diff --git a/src/xftfont.c b/src/xftfont.c index 9f52eb8b233..372ed87705f 100644 --- a/src/xftfont.c +++ b/src/xftfont.c @@ -93,7 +93,7 @@ xftfont_get_colors (FRAME_PTR f, struct face *face, GC gc, struct xftface_info * XGCValues xgcv; bool fg_done = 0, bg_done = 0; - BLOCK_INPUT; + block_input (); XGetGCValues (FRAME_X_DISPLAY (f), gc, GCForeground | GCBackground, &xgcv); if (xftface_info) @@ -131,7 +131,7 @@ xftfont_get_colors (FRAME_PTR f, struct face *face, GC gc, struct xftface_info * bg->color.blue = colors[1].blue; } } - UNBLOCK_INPUT; + unblock_input (); } } @@ -324,7 +324,7 @@ xftfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size) FcPatternAddInteger (pat, FC_INDEX, XINT (idx)); - BLOCK_INPUT; + block_input (); /* Make sure that the Xrender extension is added before the Xft one. Otherwise, the close-display hook set by Xft is called after the one for Xrender, and the former tries to re-add the latter. This @@ -345,12 +345,12 @@ xftfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size) xftfont = XftFontOpenPattern (display, match); if (!xftfont) { - UNBLOCK_INPUT; + unblock_input (); XftPatternDestroy (match); return Qnil; } ft_face = XftLockFace (xftfont); - UNBLOCK_INPUT; + unblock_input (); /* We should not destroy PAT here because it is kept in XFTFONT and destroyed automatically when XFTFONT is closed. */ @@ -399,7 +399,7 @@ xftfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size) for (ch = 0; ch < 95; ch++) ascii_printable[ch] = ' ' + ch; } - BLOCK_INPUT; + block_input (); /* Unfortunately Xft doesn't provide a way to get minimum char width. So, we set min_width to space_width. */ @@ -425,7 +425,7 @@ xftfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size) XftTextExtents8 (display, xftfont, ascii_printable + 1, 94, &extents); font->average_width = (font->space_width + extents.xOff) / 95; } - UNBLOCK_INPUT; + unblock_input (); font->ascent = xftfont->ascent; font->descent = xftfont->descent; @@ -494,10 +494,10 @@ xftfont_close (FRAME_PTR f, struct font *font) if (xftfont_info->otf) OTF_close (xftfont_info->otf); #endif - BLOCK_INPUT; + block_input (); XftUnlockFace (xftfont_info->xftfont); XftFontClose (xftfont_info->display, xftfont_info->xftfont); - UNBLOCK_INPUT; + unblock_input (); } static int @@ -581,10 +581,10 @@ xftfont_text_extents (struct font *font, unsigned int *code, int nglyphs, struct struct xftfont_info *xftfont_info = (struct xftfont_info *) font; XGlyphInfo extents; - BLOCK_INPUT; + block_input (); XftGlyphExtents (xftfont_info->display, xftfont_info->xftfont, code, nglyphs, &extents); - UNBLOCK_INPUT; + unblock_input (); if (metrics) { metrics->lbearing = - extents.x; @@ -603,12 +603,12 @@ xftfont_get_xft_draw (FRAME_PTR f) if (! xft_draw) { - BLOCK_INPUT; + block_input (); xft_draw= XftDrawCreate (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), FRAME_X_VISUAL (f), FRAME_X_COLORMAP (f)); - UNBLOCK_INPUT; + unblock_input (); eassert (xft_draw != NULL); font_put_frame_data (f, &xftfont_driver, xft_draw); } @@ -633,7 +633,7 @@ xftfont_draw (struct glyph_string *s, int from, int to, int x, int y, xftface_info = (struct xftface_info *) face->extra; xftfont_get_colors (f, face, s->gc, xftface_info, &fg, with_background ? &bg : NULL); - BLOCK_INPUT; + block_input (); if (s->num_clips > 0) XftDrawSetClipRectangles (xft_draw, 0, 0, s->clip, s->num_clips); else @@ -654,7 +654,7 @@ xftfont_draw (struct glyph_string *s, int from, int to, int x, int y, else XftDrawGlyphs (xft_draw, &fg, xftfont_info->xftfont, x, y, code, len); - UNBLOCK_INPUT; + unblock_input (); return len; } @@ -690,9 +690,9 @@ xftfont_end_for_frame (FRAME_PTR f) if (xft_draw) { - BLOCK_INPUT; + block_input (); XftDrawDestroy (xft_draw); - UNBLOCK_INPUT; + unblock_input (); font_put_frame_data (f, &xftfont_driver, NULL); } return 0; diff --git a/src/xmenu.c b/src/xmenu.c index d03a4bc974b..96a1ae87fdc 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -165,7 +165,7 @@ mouse_position_for_popup (FRAME_PTR f, int *x, int *y) if (! FRAME_X_P (f)) emacs_abort (); - BLOCK_INPUT; + block_input (); XQueryPointer (FRAME_X_DISPLAY (f), DefaultRootWindow (FRAME_X_DISPLAY (f)), @@ -186,7 +186,7 @@ mouse_position_for_popup (FRAME_PTR f, int *x, int *y) we don't care. */ (unsigned int *) &dummy); - UNBLOCK_INPUT; + unblock_input (); /* xmenu_show expects window coordinates, not root window coordinates. Translate. */ @@ -328,9 +328,9 @@ for instance using the window manager, then this produces a quit and list_of_panes (Fcons (contents, Qnil)); /* Display them in a dialog box. */ - BLOCK_INPUT; + block_input (); selection = xdialog_show (f, 0, title, header, &error_name); - UNBLOCK_INPUT; + unblock_input (); unbind_to (specpdl_count, Qnil); discard_menu_items (); @@ -490,7 +490,7 @@ If FRAME is nil or not given, use the selected frame. */) XEvent ev; FRAME_PTR f = check_x_frame (frame); Widget menubar; - BLOCK_INPUT; + block_input (); if (FRAME_EXTERNAL_MENU_BAR (f)) set_frame_menubar (f, 0, 1); @@ -548,7 +548,7 @@ If FRAME is nil or not given, use the selected frame. */) } } - UNBLOCK_INPUT; + unblock_input (); return Qnil; } @@ -569,9 +569,9 @@ If FRAME is nil or not given, use the selected frame. */) FRAME_PTR f; /* gcc 2.95 doesn't accept the FRAME_PTR declaration after - BLOCK_INPUT. */ + block_input (). */ - BLOCK_INPUT; + block_input (); f = check_x_frame (frame); if (FRAME_EXTERNAL_MENU_BAR (f)) @@ -590,7 +590,7 @@ If FRAME is nil or not given, use the selected frame. */) g_list_free (children); } } - UNBLOCK_INPUT; + unblock_input (); return Qnil; } @@ -642,7 +642,7 @@ x_activate_menubar (FRAME_PTR f) #endif set_frame_menubar (f, 0, 1); - BLOCK_INPUT; + block_input (); popup_activated_flag = 1; #ifdef USE_GTK XPutBackEvent (f->output_data.x->display_info->display, @@ -650,7 +650,7 @@ x_activate_menubar (FRAME_PTR f) #else XtDispatchEvent (f->output_data.x->saved_menu_event); #endif - UNBLOCK_INPUT; + unblock_input (); /* Ignore this if we get it a second time. */ f->output_data.x->saved_menu_event->type = 0; @@ -803,10 +803,10 @@ menubar_selection_callback (GtkWidget *widget, gpointer client_data) sit-for will exit at once if the focus event follows the menu selection event. */ - BLOCK_INPUT; + block_input (); while (gtk_events_pending ()) gtk_main_iteration (); - UNBLOCK_INPUT; + unblock_input (); find_and_call_menu_selection (cb_data->cl_data->f, cb_data->cl_data->menu_bar_items_used, @@ -834,13 +834,13 @@ menubar_selection_callback (Widget widget, LWLIB_ID id, XtPointer client_data) #endif /* not USE_GTK */ /* Recompute all the widgets of frame F, when the menu bar has been - changed. Value is non-zero if widgets were updated. */ + changed. */ -static int +static void update_frame_menubar (FRAME_PTR f) { #ifdef USE_GTK - return xg_update_frame_menubar (f); + xg_update_frame_menubar (f); #else struct x_output *x; int columns, rows; @@ -851,9 +851,9 @@ update_frame_menubar (FRAME_PTR f) x = f->output_data.x; if (!x->menubar_widget || XtIsManaged (x->menubar_widget)) - return 0; + return; - BLOCK_INPUT; + block_input (); /* Save the size of the frame because the pane widget doesn't accept to resize itself. So force it. */ columns = FRAME_COLS (f); @@ -880,9 +880,8 @@ update_frame_menubar (FRAME_PTR f) /* Force the pane widget to resize itself with the right values. */ EmacsFrameSetCharSize (x->edit_widget, columns, rows); - UNBLOCK_INPUT; + unblock_input (); #endif - return 1; } #ifdef USE_LUCID @@ -921,7 +920,7 @@ apply_systemfont_to_menu (struct frame *f, Widget w) it is set the first time this is called, from initialize_frame_menubar. */ void -set_frame_menubar (FRAME_PTR f, int first_time, int deep_p) +set_frame_menubar (FRAME_PTR f, bool first_time, bool deep_p) { xt_or_gtk_widget menubar_widget; #ifdef USE_X_TOOLKIT @@ -1164,7 +1163,7 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p) /* Create or update the menu bar widget. */ - BLOCK_INPUT; + block_input (); #ifdef USE_GTK xg_crazy_callback_abort = 1; @@ -1264,7 +1263,7 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p) xg_crazy_callback_abort = 0; #endif - UNBLOCK_INPUT; + unblock_input (); } /* Called from Fx_create_frame to create the initial menubar of a frame @@ -1313,7 +1312,7 @@ free_frame_menubar (FRAME_PTR f) Position x0, y0, x1, y1; #endif - BLOCK_INPUT; + block_input (); #ifdef USE_MOTIF if (f->output_data.x->widget) @@ -1332,7 +1331,7 @@ free_frame_menubar (FRAME_PTR f) #endif x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f)); } - UNBLOCK_INPUT; + unblock_input (); } } #endif /* not USE_GTK */ @@ -1417,9 +1416,9 @@ pop_down_menu (Lisp_Object arg) struct Lisp_Save_Value *p = XSAVE_VALUE (arg); popup_activated_flag = 0; - BLOCK_INPUT; + block_input (); gtk_widget_destroy (GTK_WIDGET (p->pointer)); - UNBLOCK_INPUT; + unblock_input (); return Qnil; } @@ -1527,9 +1526,9 @@ pop_down_menu (Lisp_Object arg) LWLIB_ID id = (XINT (XCAR (arg)) << 4 * sizeof (LWLIB_ID) | XINT (XCDR (arg))); - BLOCK_INPUT; + block_input (); lw_destroy_all_widgets (id); - UNBLOCK_INPUT; + unblock_input (); popup_activated_flag = 0; return Qnil; @@ -1955,9 +1954,9 @@ dialog_selection_callback (Widget widget, LWLIB_ID id, XtPointer client_data) if ((intptr_t) client_data != -1) menu_item_selection = (Lisp_Object *) client_data; - BLOCK_INPUT; + block_input (); lw_destroy_all_widgets (id); - UNBLOCK_INPUT; + unblock_input (); popup_activated_flag = 0; } @@ -2251,7 +2250,7 @@ pop_down_menu (Lisp_Object arg) FRAME_PTR f = p1->pointer; XMenu *menu = p2->pointer; - BLOCK_INPUT; + block_input (); #ifndef MSDOS XUngrabPointer (FRAME_X_DISPLAY (f), CurrentTime); XUngrabKeyboard (FRAME_X_DISPLAY (f), CurrentTime); @@ -2271,7 +2270,7 @@ pop_down_menu (Lisp_Object arg) #endif /* HAVE_X_WINDOWS */ - UNBLOCK_INPUT; + unblock_input (); return Qnil; } diff --git a/src/xml.c b/src/xml.c index b668525cf26..a22ca208743 100644 --- a/src/xml.c +++ b/src/xml.c @@ -82,7 +82,7 @@ libxml2_loaded_p (void) #endif /* !WINDOWSNT */ static int -init_libxml2_functions (Lisp_Object libraries) +init_libxml2_functions (void) { #ifdef WINDOWSNT if (libxml2_loaded_p ()) @@ -91,7 +91,7 @@ init_libxml2_functions (Lisp_Object libraries) { HMODULE library; - if (!(library = w32_delayed_load (libraries, Qlibxml2_dll))) + if (!(library = w32_delayed_load (Qlibxml2_dll))) { message ("%s", "libxml2 library not found"); return 0; @@ -257,7 +257,7 @@ DEFUN ("libxml-parse-html-region", Flibxml_parse_html_region, If BASE-URL is non-nil, it is used to expand relative URLs. */) (Lisp_Object start, Lisp_Object end, Lisp_Object base_url) { - if (init_libxml2_functions (Vdynamic_library_alist)) + if (init_libxml2_functions ()) return parse_region (start, end, base_url, 1); return Qnil; } @@ -269,7 +269,7 @@ DEFUN ("libxml-parse-xml-region", Flibxml_parse_xml_region, If BASE-URL is non-nil, it is used to expand relative URLs. */) (Lisp_Object start, Lisp_Object end, Lisp_Object base_url) { - if (init_libxml2_functions (Vdynamic_library_alist)) + if (init_libxml2_functions ()) return parse_region (start, end, base_url, 0); return Qnil; } diff --git a/src/xselect.c b/src/xselect.c index ab199e0b9b9..de9386bd7d9 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -247,9 +247,9 @@ symbol_to_x_atom (struct x_display_info *dpyinfo, Lisp_Object sym) if (!SYMBOLP (sym)) emacs_abort (); TRACE1 (" XInternAtom %s", SSDATA (SYMBOL_NAME (sym))); - BLOCK_INPUT; + block_input (); val = XInternAtom (dpyinfo->display, SSDATA (SYMBOL_NAME (sym)), False); - UNBLOCK_INPUT; + unblock_input (); return val; } @@ -307,16 +307,16 @@ x_atom_to_symbol (Display *dpy, Atom atom) if (atom == dpyinfo->Xatom_NULL) return QNULL; - BLOCK_INPUT; + block_input (); str = XGetAtomName (dpy, atom); - UNBLOCK_INPUT; + unblock_input (); TRACE1 ("XGetAtomName --> %s", str); if (! str) return Qnil; val = intern (str); - BLOCK_INPUT; + block_input (); /* This was allocated by Xlib, so use XFree. */ XFree (str); - UNBLOCK_INPUT; + unblock_input (); return val; } @@ -336,12 +336,12 @@ x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value, Time timestamp = last_event_timestamp; Atom selection_atom = symbol_to_x_atom (dpyinfo, selection_name); - BLOCK_INPUT; + block_input (); x_catch_errors (display); XSetSelectionOwner (display, selection_atom, selecting_window, timestamp); x_check_errors (display, "Can't set selection: %s"); x_uncatch_errors (); - UNBLOCK_INPUT; + unblock_input (); /* Now update the local cache */ { @@ -469,12 +469,12 @@ x_decline_selection_request (struct input_event *event) /* The reason for the error may be that the receiver has died in the meantime. Handle that case. */ - BLOCK_INPUT; + block_input (); x_catch_errors (reply->display); XSendEvent (reply->display, reply->requestor, False, 0L, &reply_base); XFlush (reply->display); x_uncatch_errors (); - UNBLOCK_INPUT; + unblock_input (); } /* This is the selection request currently being processed. @@ -536,9 +536,9 @@ x_selection_request_lisp_error (Lisp_Object ignore) static Lisp_Object x_catch_errors_unwind (Lisp_Object dummy) { - BLOCK_INPUT; + block_input (); x_uncatch_errors (); - UNBLOCK_INPUT; + unblock_input (); return Qnil; } @@ -610,7 +610,7 @@ x_reply_selection_request (struct input_event *event, if (reply->property == None) reply->property = reply->target; - BLOCK_INPUT; + block_input (); /* 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. */ @@ -682,7 +682,7 @@ x_reply_selection_request (struct input_event *event, { int format_bytes = cs->format / 8; int had_errors = x_had_errors_p (display); - UNBLOCK_INPUT; + unblock_input (); bytes_remaining = cs->size; bytes_remaining *= format_bytes; @@ -703,7 +703,7 @@ x_reply_selection_request (struct input_event *event, int i = ((bytes_remaining < max_bytes) ? bytes_remaining : max_bytes) / format_bytes; - BLOCK_INPUT; + block_input (); cs->wait_object = expect_property_change (display, window, cs->property, @@ -722,7 +722,7 @@ x_reply_selection_request (struct input_event *event, : format_bytes); XFlush (display); had_errors = x_had_errors_p (display); - UNBLOCK_INPUT; + unblock_input (); if (had_errors) break; @@ -735,7 +735,7 @@ x_reply_selection_request (struct input_event *event, /* Now write a zero-length chunk to the property to tell the requestor that we're done. */ - BLOCK_INPUT; + block_input (); if (! waiting_for_other_props_on_window (display, window)) XSelectInput (display, window, 0L); @@ -757,15 +757,15 @@ x_reply_selection_request (struct input_event *event, /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are delivered before uncatch errors. */ XSync (display, False); - UNBLOCK_INPUT; + unblock_input (); /* GTK queues events in addition to the queue in Xlib. So we UNBLOCK to enter the event loop and get possible errors delivered, and then BLOCK again because x_uncatch_errors requires it. */ - BLOCK_INPUT; + block_input (); /* This calls x_uncatch_errors. */ unbind_to (count, Qnil); - UNBLOCK_INPUT; + unblock_input (); } /* Handle a SelectionRequest event EVENT. @@ -1232,7 +1232,7 @@ x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type, if (! NILP (time_stamp)) CONS_TO_INTEGER (time_stamp, Time, requestor_time); - BLOCK_INPUT; + block_input (); TRACE2 ("Get selection %s, type %s", XGetAtomName (display, type_atom), XGetAtomName (display, target_property)); @@ -1257,7 +1257,7 @@ x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type, record_unwind_protect (queue_selection_requests_unwind, Qnil); #endif - UNBLOCK_INPUT; + unblock_input (); /* This allows quits. Also, don't wait forever. */ timeout = max (0, x_selection_timeout); @@ -1309,7 +1309,7 @@ x_get_window_property (Display *display, Window window, Atom property, ? min (PTRDIFF_MAX, SIZE_MAX) - 1 : LONG_MAX * x_long_size); - BLOCK_INPUT; + block_input (); /* First probe the thing to find out how big it is. */ result = XGetWindowProperty (display, window, property, @@ -1410,19 +1410,19 @@ x_get_window_property (Display *display, Window window, Atom property, data[offset] = '\0'; done: - UNBLOCK_INPUT; + unblock_input (); *data_ret = data; *bytes_ret = offset; return; size_overflow: free (data); - UNBLOCK_INPUT; + unblock_input (); memory_full (SIZE_MAX); memory_exhausted: free (data); - UNBLOCK_INPUT; + unblock_input (); memory_full (total_size + 1); } @@ -1454,7 +1454,7 @@ receive_incremental_selection (Display *display, Window window, Atom property, that property, then reading the property, then deleting it to ack. We are done when the sender places a property of length 0. */ - BLOCK_INPUT; + block_input (); XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask); TRACE1 (" Delete property %s", SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property)))); @@ -1464,7 +1464,7 @@ receive_incremental_selection (Display *display, Window window, Atom property, wait_object = expect_property_change (display, window, property, PropertyNewValue); XFlush (display); - UNBLOCK_INPUT; + unblock_input (); while (1) { @@ -1496,14 +1496,14 @@ receive_incremental_selection (Display *display, Window window, Atom property, break; } - BLOCK_INPUT; + block_input (); TRACE1 (" ACK by deleting property %s", XGetAtomName (display, property)); XDeleteProperty (display, window, property); wait_object = expect_property_change (display, window, property, PropertyNewValue); XFlush (display); - UNBLOCK_INPUT; + unblock_input (); if (*size_bytes_ret - offset < tmp_size_bytes) *data_ret = xpalloc (*data_ret, size_bytes_ret, @@ -1545,10 +1545,10 @@ x_get_window_property_as_lisp_data (Display *display, Window window, if (! data) { int there_is_a_selection_owner; - BLOCK_INPUT; + block_input (); there_is_a_selection_owner = XGetSelectionOwner (display, selection_atom); - UNBLOCK_INPUT; + unblock_input (); if (there_is_a_selection_owner) signal_error ("Selection owner couldn't convert", actual_type @@ -1565,22 +1565,22 @@ x_get_window_property_as_lisp_data (Display *display, Window window, /* That wasn't really the data, just the beginning. */ unsigned int min_size_bytes = * ((unsigned int *) data); - BLOCK_INPUT; + block_input (); /* Use xfree, not XFree, because x_get_window_property calls xmalloc itself. */ xfree (data); - UNBLOCK_INPUT; + unblock_input (); receive_incremental_selection (display, window, property, target_type, min_size_bytes, &data, &bytes, &actual_type, &actual_format, &actual_size); } - BLOCK_INPUT; + block_input (); TRACE1 (" Delete property %s", XGetAtomName (display, property)); XDeleteProperty (display, window, property); XFlush (display); - UNBLOCK_INPUT; + unblock_input (); /* It's been read. Now convert it to a lisp object in some semi-rational manner. */ @@ -2096,13 +2096,13 @@ On MS-DOS, all this does is return non-nil if we own the selection. */) selection_atom = symbol_to_x_atom (dpyinfo, selection); - BLOCK_INPUT; + block_input (); if (NILP (time_object)) timestamp = last_event_timestamp; else CONS_TO_INTEGER (time_object, Time, timestamp); XSetSelectionOwner (dpyinfo->display, selection_atom, None, timestamp); - UNBLOCK_INPUT; + unblock_input (); /* It doesn't seem to be guaranteed that a SelectionClear event will be generated for a window which owns the selection when that window sets @@ -2179,9 +2179,9 @@ On Nextstep, TERMINAL is unused. */) atom = symbol_to_x_atom (dpyinfo, selection); if (atom == 0) return Qnil; - BLOCK_INPUT; + block_input (); owner = XGetSelectionOwner (dpyinfo->display, atom); - UNBLOCK_INPUT; + unblock_input (); return (owner ? Qt : Qnil); } @@ -2353,9 +2353,9 @@ x_fill_property_data (Display *dpy, Lisp_Object data, void *ret, int format) val = cons_to_signed (o, LONG_MIN, LONG_MAX); else if (STRINGP (o)) { - BLOCK_INPUT; + block_input (); val = (long) XInternAtom (dpy, SSDATA (o), False); - UNBLOCK_INPUT; + unblock_input (); } else error ("Wrong type, must be string, number or cons"); @@ -2413,7 +2413,7 @@ mouse_position_for_drop (FRAME_PTR f, int *x, int *y) Window root, dummy_window; int dummy; - BLOCK_INPUT; + block_input (); XQueryPointer (FRAME_X_DISPLAY (f), DefaultRootWindow (FRAME_X_DISPLAY (f)), @@ -2439,7 +2439,7 @@ mouse_position_for_drop (FRAME_PTR f, int *x, int *y) *x -= f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f); *y -= f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f); - UNBLOCK_INPUT; + unblock_input (); } DEFUN ("x-get-atom-name", Fx_get_atom_name, @@ -2462,7 +2462,7 @@ If the value is 0 or the atom is not known, return the empty string. */) CONS_TO_INTEGER (value, Atom, atom); - BLOCK_INPUT; + block_input (); x_catch_errors (dpy); name = atom ? XGetAtomName (dpy, atom) : empty; had_errors = x_had_errors_p (dpy); @@ -2474,7 +2474,7 @@ If the value is 0 or the atom is not known, return the empty string. */) if (atom && name) XFree (name); if (NILP (ret)) ret = empty_unibyte_string; - UNBLOCK_INPUT; + unblock_input (); return ret; } @@ -2496,9 +2496,9 @@ FRAME is on. If FRAME is nil, the selected frame is used. */) x_atom = symbol_to_x_atom (dpyinfo, atom); else if (STRINGP (atom)) { - BLOCK_INPUT; + block_input (); x_atom = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (atom), False); - UNBLOCK_INPUT; + unblock_input (); } else error ("ATOM must be a symbol or a string"); @@ -2657,7 +2657,7 @@ x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from, if (wdest == 0) wdest = dpyinfo->root_window; to_root = wdest == dpyinfo->root_window; - BLOCK_INPUT; + block_input (); event.xclient.message_type = message_type; event.xclient.display = dpyinfo->display; @@ -2683,7 +2683,7 @@ x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from, XFlush (dpyinfo->display); } x_uncatch_errors (); - UNBLOCK_INPUT; + unblock_input (); } diff --git a/src/xsettings.c b/src/xsettings.c index 58c84495489..7c68ff295cf 100644 --- a/src/xsettings.c +++ b/src/xsettings.c @@ -929,7 +929,7 @@ init_xsettings (struct x_display_info *dpyinfo) { Display *dpy = dpyinfo->display; - BLOCK_INPUT; + block_input (); /* Select events so we can detect client messages sent when selection owner changes. */ @@ -939,7 +939,7 @@ init_xsettings (struct x_display_info *dpyinfo) if (dpyinfo->xsettings_window != None) read_and_apply_settings (dpyinfo, False); - UNBLOCK_INPUT; + unblock_input (); } void diff --git a/src/xterm.c b/src/xterm.c index 8c955d0e576..6cd1d583870 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -287,7 +287,7 @@ enum xembed_message /* Used in x_flush. */ -static int x_alloc_nearest_color_1 (Display *, Colormap, XColor *); +static bool x_alloc_nearest_color_1 (Display *, Colormap, XColor *); static void x_set_window_size_1 (struct frame *, int, int, int); static void x_raise_frame (struct frame *); static void x_lower_frame (struct frame *); @@ -353,7 +353,7 @@ x_flush (struct frame *f) if (!NILP (Vinhibit_redisplay)) return; - BLOCK_INPUT; + block_input (); if (f == NULL) { Lisp_Object rest, frame; @@ -363,7 +363,7 @@ x_flush (struct frame *f) } else if (FRAME_X_P (f)) XFlush (FRAME_X_DISPLAY (f)); - UNBLOCK_INPUT; + unblock_input (); } @@ -564,7 +564,7 @@ x_update_window_begin (struct window *w) updated_window = w; set_output_cursor (&w->cursor); - BLOCK_INPUT; + block_input (); if (f == hlinfo->mouse_face_mouse_frame) { @@ -577,7 +577,7 @@ x_update_window_begin (struct window *w) hlinfo->mouse_face_window = Qnil; } - UNBLOCK_INPUT; + unblock_input (); } @@ -618,7 +618,7 @@ x_update_window_end (struct window *w, int cursor_on_p, int mouse_face_overwritt if (!w->pseudo_window_p) { - BLOCK_INPUT; + block_input (); if (cursor_on_p) display_and_set_cursor (w, 1, output_cursor.hpos, @@ -628,7 +628,7 @@ x_update_window_end (struct window *w, int cursor_on_p, int mouse_face_overwritt if (draw_window_fringes (w, 1)) x_draw_vertical_border (w); - UNBLOCK_INPUT; + unblock_input (); } /* If a row with mouse-face was overwritten, arrange for @@ -654,9 +654,9 @@ x_update_end (struct frame *f) MOUSE_HL_INFO (f)->mouse_face_defer = 0; #ifndef XFlush - BLOCK_INPUT; + block_input (); XFlush (FRAME_X_DISPLAY (f)); - UNBLOCK_INPUT; + unblock_input (); #endif } @@ -675,13 +675,13 @@ XTframe_up_to_date (struct frame *f) if (hlinfo->mouse_face_deferred_gc || f == hlinfo->mouse_face_mouse_frame) { - BLOCK_INPUT; + block_input (); if (hlinfo->mouse_face_mouse_frame) note_mouse_highlight (hlinfo->mouse_face_mouse_frame, hlinfo->mouse_face_mouse_x, hlinfo->mouse_face_mouse_y); hlinfo->mouse_face_deferred_gc = 0; - UNBLOCK_INPUT; + unblock_input (); } } } @@ -722,13 +722,13 @@ x_after_update_window_line (struct glyph_row *desired_row) { int y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, desired_row->y)); - BLOCK_INPUT; + block_input (); x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), 0, y, width, height, False); x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), FRAME_PIXEL_WIDTH (f) - width, y, width, height, False); - UNBLOCK_INPUT; + unblock_input (); } } @@ -899,8 +899,8 @@ static void x_compute_glyph_string_overhangs (struct glyph_string *); static void x_set_cursor_gc (struct glyph_string *); static void x_set_mode_line_face_gc (struct glyph_string *); static void x_set_mouse_face_gc (struct glyph_string *); -static int x_alloc_lighter_color (struct frame *, Display *, Colormap, - unsigned long *, double, int); +static bool x_alloc_lighter_color (struct frame *, Display *, Colormap, + unsigned long *, double, int); static void x_setup_relief_color (struct frame *, struct relief *, double, int, unsigned long); static void x_setup_relief_colors (struct glyph_string *); @@ -1469,9 +1469,9 @@ x_frame_of_widget (Widget widget) If this produces the same color as PIXEL, try a color where all RGB values have DELTA added. Return the allocated color in *PIXEL. DISPLAY is the X display, CMAP is the colormap to operate on. - Value is non-zero if successful. */ + Value is true if successful. */ -int +bool x_alloc_lighter_color_for_widget (Widget widget, Display *display, Colormap cmap, unsigned long *pixel, double factor, int delta) { @@ -1696,15 +1696,15 @@ x_query_color (struct frame *f, XColor *color) /* Allocate the color COLOR->pixel on DISPLAY, colormap CMAP. If an exact match can't be allocated, try the nearest color available. - Value is non-zero if successful. Set *COLOR to the color + Value is true if successful. Set *COLOR to the color allocated. */ -static int +static bool x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color) { - int rc; + bool rc; - rc = XAllocColor (dpy, cmap, color); + rc = XAllocColor (dpy, cmap, color) != 0; if (rc == 0) { /* If we got to this point, the colormap is full, so we're going @@ -1735,7 +1735,7 @@ x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color) color->red = cells[nearest].red; color->green = cells[nearest].green; color->blue = cells[nearest].blue; - rc = XAllocColor (dpy, cmap, color); + rc = XAllocColor (dpy, cmap, color) != 0; } else { @@ -1768,10 +1768,10 @@ x_alloc_nearest_color_1 (Display *dpy, Colormap cmap, XColor *color) /* Allocate the color COLOR->pixel on frame F, colormap CMAP. If an exact match can't be allocated, try the nearest color available. - Value is non-zero if successful. Set *COLOR to the color + Value is true if successful. Set *COLOR to the color allocated. */ -int +bool x_alloc_nearest_color (struct frame *f, Colormap cmap, XColor *color) { gamma_correct (f, color); @@ -1789,10 +1789,10 @@ x_copy_color (struct frame *f, long unsigned int pixel) XColor color; color.pixel = pixel; - BLOCK_INPUT; + block_input (); x_query_color (f, &color); XAllocColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), &color); - UNBLOCK_INPUT; + unblock_input (); #ifdef DEBUG_X_COLORS register_color (pixel); #endif @@ -1821,12 +1821,12 @@ x_copy_color (struct frame *f, long unsigned int pixel) DISPLAY is the X display, CMAP is the colormap to operate on. Value is non-zero if successful. */ -static int +static bool x_alloc_lighter_color (struct frame *f, Display *display, Colormap cmap, long unsigned int *pixel, double factor, int delta) { XColor color, new; long bright; - int success_p; + bool success_p; /* Get RGB color values. */ color.pixel = *pixel; @@ -3028,7 +3028,7 @@ x_clear_frame (struct frame *f) /* We don't set the output cursor here because there will always follow an explicit cursor_to. */ - BLOCK_INPUT; + block_input (); XClearWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); @@ -3045,7 +3045,7 @@ x_clear_frame (struct frame *f) XFlush (FRAME_X_DISPLAY (f)); - UNBLOCK_INPUT; + unblock_input (); } @@ -3055,7 +3055,7 @@ x_clear_frame (struct frame *f) static void XTflash (struct frame *f) { - BLOCK_INPUT; + block_input (); { #ifdef USE_GTK @@ -3208,14 +3208,14 @@ XTflash (struct frame *f) } } - UNBLOCK_INPUT; + unblock_input (); } static void XTtoggle_invisible_pointer (FRAME_PTR f, int invisible) { - BLOCK_INPUT; + block_input (); if (invisible) { if (FRAME_X_DISPLAY_INFO (f)->invisible_cursor != 0) @@ -3226,7 +3226,7 @@ XTtoggle_invisible_pointer (FRAME_PTR f, int invisible) XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), f->output_data.x->current_cursor); f->pointer_invisible = invisible; - UNBLOCK_INPUT; + unblock_input (); } @@ -3241,10 +3241,10 @@ XTring_bell (struct frame *f) XTflash (f); else { - BLOCK_INPUT; + block_input (); XBell (FRAME_X_DISPLAY (f), 0); XFlush (FRAME_X_DISPLAY (f)); - UNBLOCK_INPUT; + unblock_input (); } } } @@ -3341,7 +3341,7 @@ x_scroll_run (struct window *w, struct run *run) height = run->height; } - BLOCK_INPUT; + block_input (); /* Cursor off. Will be switched on again in x_update_window_end. */ updated_window = w; @@ -3354,7 +3354,7 @@ x_scroll_run (struct window *w, struct run *run) width, height, x, to_y); - UNBLOCK_INPUT; + unblock_input (); } @@ -3371,7 +3371,7 @@ frame_highlight (struct frame *f) the ICCCM (section 4.1.6) says that the window's border pixmap and border pixel are window attributes which are "private to the client", so we can always change it to whatever we want. */ - BLOCK_INPUT; + block_input (); /* I recently started to get errors in this XSetWindowBorder, depending on the window-manager in use, tho something more is at play since I've been using that same window-manager binary for ever. Let's not crash just @@ -3380,7 +3380,7 @@ frame_highlight (struct frame *f) XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), f->output_data.x->border_pixel); x_uncatch_errors (); - UNBLOCK_INPUT; + unblock_input (); x_update_cursor (f, 1); x_set_frame_alpha (f); } @@ -3392,13 +3392,13 @@ frame_unhighlight (struct frame *f) the ICCCM (section 4.1.6) says that the window's border pixmap and border pixel are window attributes which are "private to the client", so we can always change it to whatever we want. */ - BLOCK_INPUT; + block_input (); /* Same as above for XSetWindowBorder (bug#9310). */ x_catch_errors (FRAME_X_DISPLAY (f)); XSetWindowBorderPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), f->output_data.x->border_tile); x_uncatch_errors (); - UNBLOCK_INPUT; + unblock_input (); x_update_cursor (f, 1); x_set_frame_alpha (f); } @@ -3765,9 +3765,9 @@ x_get_keysym_name (int keysym) { char *value; - BLOCK_INPUT; + block_input (); value = XKeysymToString (keysym); - UNBLOCK_INPUT; + unblock_input (); return value; } @@ -3897,7 +3897,7 @@ XTmouse_position (FRAME_PTR *fp, int insist, Lisp_Object *bar_window, { FRAME_PTR f1; - BLOCK_INPUT; + block_input (); if (! NILP (last_mouse_scroll_bar) && insist == 0) x_scroll_bar_report_motion (fp, bar_window, part, x, y, timestamp); @@ -4078,7 +4078,7 @@ XTmouse_position (FRAME_PTR *fp, int insist, Lisp_Object *bar_window, } } - UNBLOCK_INPUT; + unblock_input (); } @@ -4267,7 +4267,7 @@ x_send_scroll_bar_event (Lisp_Object window, int part, int portion, int whole) struct frame *f = XFRAME (w->frame); ptrdiff_t i; - BLOCK_INPUT; + block_input (); /* Construct a ClientMessage event to send to the frame. */ ev->type = ClientMessage; @@ -4314,7 +4314,7 @@ x_send_scroll_bar_event (Lisp_Object window, int part, int portion, int whole) be sent to the client that created the window, and if that window no longer exists, no event will be sent. */ XSendEvent (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), False, 0, &event); - UNBLOCK_INPUT; + unblock_input (); } @@ -4405,9 +4405,9 @@ xm_scroll_callback (Widget widget, XtPointer client_data, XtPointer call_data) int slider_size; /* Get the slider size. */ - BLOCK_INPUT; + block_input (); XtVaGetValues (widget, XmNsliderSize, &slider_size, NULL); - UNBLOCK_INPUT; + unblock_input (); whole = XM_SB_MAX - slider_size; portion = min (cs->value, whole); @@ -4528,9 +4528,9 @@ xaw_jump_callback (Widget widget, XtPointer client_data, XtPointer call_data) int part; /* Get the size of the thumb, a value between 0 and 1. */ - BLOCK_INPUT; + block_input (); XtVaGetValues (widget, XtNshown, &shown, XtNheight, &height, NULL); - UNBLOCK_INPUT; + unblock_input (); whole = 10000000; portion = shown < 1 ? top * whole : 0; @@ -4570,9 +4570,9 @@ xaw_scroll_callback (Widget widget, XtPointer client_data, XtPointer call_data) int part; /* Get the height of the scroll bar. */ - BLOCK_INPUT; + block_input (); XtVaGetValues (widget, XtNheight, &height, NULL); - UNBLOCK_INPUT; + unblock_input (); if (eabs (position) >= height) part = (position < 0) ? scroll_bar_above_handle : scroll_bar_below_handle; @@ -4603,11 +4603,11 @@ x_create_toolkit_scroll_bar (struct frame *f, struct scroll_bar *bar) { const char *scroll_bar_name = SCROLL_BAR_NAME; - BLOCK_INPUT; + block_input (); xg_create_scroll_bar (f, bar, G_CALLBACK (xg_scroll_callback), G_CALLBACK (xg_end_scroll_callback), scroll_bar_name); - UNBLOCK_INPUT; + unblock_input (); } #else /* not USE_GTK */ @@ -4622,7 +4622,7 @@ x_create_toolkit_scroll_bar (struct frame *f, struct scroll_bar *bar) const char *scroll_bar_name = SCROLL_BAR_NAME; unsigned long pixel; - BLOCK_INPUT; + block_input (); #ifdef USE_MOTIF /* Set resources. Create the widget. */ @@ -4806,7 +4806,7 @@ x_create_toolkit_scroll_bar (struct frame *f, struct scroll_bar *bar) xwindow = XtWindow (widget); bar->x_window = xwindow; - UNBLOCK_INPUT; + unblock_input (); } #endif /* not USE_GTK */ @@ -4830,7 +4830,7 @@ x_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int portion, int positio Widget widget = SCROLL_BAR_X_WIDGET (FRAME_X_DISPLAY (f), bar); float top, shown; - BLOCK_INPUT; + block_input (); #ifdef USE_MOTIF @@ -4921,7 +4921,7 @@ x_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int portion, int positio } #endif /* !USE_MOTIF */ - UNBLOCK_INPUT; + unblock_input (); } #endif /* not USE_GTK */ @@ -4946,7 +4946,7 @@ x_scroll_bar_create (struct window *w, int top, int left, int width, int height) = ALLOCATE_PSEUDOVECTOR (struct scroll_bar, x_window, PVEC_OTHER); Lisp_Object barobj; - BLOCK_INPUT; + block_input (); #ifdef USE_TOOLKIT_SCROLL_BARS x_create_toolkit_scroll_bar (f, bar); @@ -5034,7 +5034,7 @@ x_scroll_bar_create (struct window *w, int top, int left, int width, int height) XMapRaised (FRAME_X_DISPLAY (f), bar->x_window); #endif /* not USE_TOOLKIT_SCROLL_BARS */ - UNBLOCK_INPUT; + unblock_input (); return bar; } @@ -5068,7 +5068,7 @@ x_scroll_bar_set_handle (struct scroll_bar *bar, int start, int end, int rebuild && end == bar->end) return; - BLOCK_INPUT; + block_input (); { int inside_width = VERTICAL_SCROLL_BAR_INSIDE_WIDTH (f, bar->width); @@ -5144,7 +5144,7 @@ x_scroll_bar_set_handle (struct scroll_bar *bar, int start, int end, int rebuild } - UNBLOCK_INPUT; + unblock_input (); } #endif /* !USE_TOOLKIT_SCROLL_BARS */ @@ -5156,7 +5156,7 @@ static void x_scroll_bar_remove (struct scroll_bar *bar) { struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); - BLOCK_INPUT; + block_input (); #ifdef USE_TOOLKIT_SCROLL_BARS #ifdef USE_GTK @@ -5171,7 +5171,7 @@ x_scroll_bar_remove (struct scroll_bar *bar) /* Dissociate this scroll bar from its window. */ wset_vertical_scroll_bar (XWINDOW (bar->window), Qnil); - UNBLOCK_INPUT; + unblock_input (); } @@ -5239,7 +5239,7 @@ XTset_vertical_scroll_bar (struct window *w, int portion, int whole, int positio { if (width > 0 && height > 0) { - BLOCK_INPUT; + block_input (); #ifdef USE_TOOLKIT_SCROLL_BARS if (fringe_extended_p) x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), @@ -5248,7 +5248,7 @@ XTset_vertical_scroll_bar (struct window *w, int portion, int whole, int positio #endif x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), left, top, width, height, False); - UNBLOCK_INPUT; + unblock_input (); } bar = x_scroll_bar_create (w, top, sb_left, sb_width, height); @@ -5260,7 +5260,7 @@ XTset_vertical_scroll_bar (struct window *w, int portion, int whole, int positio bar = XSCROLL_BAR (w->vertical_scroll_bar); - BLOCK_INPUT; + block_input (); if (sb_left != bar->left) mask |= CWX; @@ -5357,7 +5357,7 @@ XTset_vertical_scroll_bar (struct window *w, int portion, int whole, int positio bar->width = sb_width; bar->height = height; - UNBLOCK_INPUT; + unblock_input (); } #ifdef USE_TOOLKIT_SCROLL_BARS @@ -5508,7 +5508,7 @@ x_scroll_bar_expose (struct scroll_bar *bar, XEvent *event) GC gc = f->output_data.x->normal_gc; int width_trim = VERTICAL_SCROLL_BAR_WIDTH_TRIM; - BLOCK_INPUT; + block_input (); x_scroll_bar_set_handle (bar, bar->start, bar->end, 1); @@ -5530,7 +5530,7 @@ x_scroll_bar_expose (struct scroll_bar *bar, XEvent *event) XSetForeground (FRAME_X_DISPLAY (f), gc, FRAME_FOREGROUND_PIXEL (f)); - UNBLOCK_INPUT; + unblock_input (); } #endif /* not USE_TOOLKIT_SCROLL_BARS */ @@ -5643,7 +5643,7 @@ x_scroll_bar_report_motion (FRAME_PTR *fp, Lisp_Object *bar_window, int dummy_coord; unsigned int dummy_mask; - BLOCK_INPUT; + block_input (); /* Get the mouse's position relative to the scroll bar window, and report that. */ @@ -5695,7 +5695,7 @@ x_scroll_bar_report_motion (FRAME_PTR *fp, Lisp_Object *bar_window, *timestamp = last_mouse_movement_time; - UNBLOCK_INPUT; + unblock_input (); } @@ -5816,7 +5816,7 @@ event_handler_gdk (GdkXEvent *gxev, GdkEvent *ev, gpointer data) { XEvent *xev = (XEvent *) gxev; - BLOCK_INPUT; + block_input (); if (current_count >= 0) { struct x_display_info *dpyinfo; @@ -5831,7 +5831,7 @@ event_handler_gdk (GdkXEvent *gxev, GdkEvent *ev, gpointer data) && dpyinfo && x_filter_event (dpyinfo, xev)) { - UNBLOCK_INPUT; + unblock_input (); return GDK_FILTER_REMOVE; } #endif @@ -5846,7 +5846,7 @@ event_handler_gdk (GdkXEvent *gxev, GdkEvent *ev, gpointer data) else current_finish = x_dispatch_event (xev, xev->xany.display); - UNBLOCK_INPUT; + unblock_input (); if (current_finish == X_EVENT_GOTO_OUT || current_finish == X_EVENT_DROP) return GDK_FILTER_REMOVE; @@ -7041,10 +7041,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr, default: OTHER: #ifdef USE_X_TOOLKIT - BLOCK_INPUT; + block_input (); if (*finish != X_EVENT_DROP) XtDispatchEvent (&event); - UNBLOCK_INPUT; + unblock_input (); #endif /* USE_X_TOOLKIT */ break; } @@ -7122,16 +7122,7 @@ XTread_socket (struct terminal *terminal, struct input_event *hold_quit) int count = 0; int event_found = 0; - if (interrupt_input_blocked) - { - interrupt_input_pending = 1; - pending_signals = 1; - return -1; - } - - interrupt_input_pending = 0; - pending_signals = pending_atimers; - BLOCK_INPUT; + block_input (); /* So people can tell when we have read the available input. */ input_signal_count++; @@ -7224,7 +7215,7 @@ XTread_socket (struct terminal *terminal, struct input_event *hold_quit) pending_autoraise_frame = 0; } - UNBLOCK_INPUT; + unblock_input (); return count; } @@ -7660,7 +7651,7 @@ x_uncatch_errors (void) { struct x_error_message_stack *tmp; - BLOCK_INPUT; + block_input (); /* The display may have been closed before this function is called. Check if it is still open before calling XSync. */ @@ -7670,7 +7661,7 @@ x_uncatch_errors (void) tmp = x_error_message; x_error_message = x_error_message->prev; xfree (tmp); - UNBLOCK_INPUT; + unblock_input (); } /* If any X protocol errors have arrived since the last call to @@ -7733,26 +7724,6 @@ x_trace_wire (void) #endif /* ! 0 */ -/* Handle SIGPIPE, which can happen when the connection to a server - simply goes away. SIGPIPE is handled by x_connection_signal. - Don't need to do anything, because the write which caused the - SIGPIPE will fail, causing Xlib to invoke the X IO error handler, - which will do the appropriate cleanup for us. */ - -static void -x_connection_signal (int signalnum) /* If we don't have an argument, */ - /* some compilers complain in signal calls. */ -{ -#ifdef USG - /* USG systems forget handlers when they are used; - must reestablish each time */ - struct sigaction action; - emacs_sigaction_init (&action, x_connection_signal); - sigaction (signalnum, &action, 0); -#endif /* USG */ -} - - /************************************************************************ Handling X errors ************************************************************************/ @@ -7856,17 +7827,7 @@ For details, see etc/PROBLEMS.\n", /* NOTREACHED */ } - /* Ordinary stack unwind doesn't deal with these. */ - { - sigset_t unblocked; - sigemptyset (&unblocked); -#ifdef USABLE_SIGIO - sigaddset (&unblocked, SIGIO); -#endif - sigaddset (&unblocked, SIGALRM); - pthread_sigmask (SIG_UNBLOCK, &unblocked, 0); - } - TOTALLY_UNBLOCK_INPUT; + totally_unblock_input (); unbind_to (idx, Qnil); clear_waiting_for_input (); @@ -8005,9 +7966,9 @@ x_new_font (struct frame *f, Lisp_Object font_object, int fontset) if (FRAME_XIC (f) && (FRAME_XIC_STYLE (f) & (XIMPreeditPosition | XIMStatusArea))) { - BLOCK_INPUT; + block_input (); xic_set_xfontset (f, SSDATA (fontset_ascii (fontset))); - UNBLOCK_INPUT; + unblock_input (); } #endif @@ -8033,7 +7994,7 @@ xim_destroy_callback (XIM xim, XPointer client_data, XPointer call_data) struct x_display_info *dpyinfo = (struct x_display_info *) client_data; Lisp_Object frame, tail; - BLOCK_INPUT; + block_input (); /* No need to call XDestroyIC.. */ FOR_EACH_FRAME (tail, frame) @@ -8049,7 +8010,7 @@ xim_destroy_callback (XIM xim, XPointer client_data, XPointer call_data) /* No need to call XCloseIM. */ dpyinfo->xim = NULL; XFree (dpyinfo->xim_styles); - UNBLOCK_INPUT; + unblock_input (); } #endif /* HAVE_X11R6 */ @@ -8124,7 +8085,7 @@ xim_instantiate_callback (Display *display, XPointer client_data, XPointer call_ { Lisp_Object tail, frame; - BLOCK_INPUT; + block_input (); FOR_EACH_FRAME (tail, frame) { struct frame *f = XFRAME (frame); @@ -8144,7 +8105,7 @@ xim_instantiate_callback (Display *display, XPointer client_data, XPointer call_ } } - UNBLOCK_INPUT; + unblock_input (); } } @@ -8291,7 +8252,7 @@ x_set_offset (struct frame *f, register int xoff, register int yoff, int change_ } x_calc_absolute_position (f); - BLOCK_INPUT; + block_input (); x_wm_set_size_hint (f, (long) 0, 0); modified_left = f->left_pos; @@ -8330,7 +8291,7 @@ x_set_offset (struct frame *f, register int xoff, register int yoff, int change_ && FRAME_X_OUTPUT (f)->move_offset_top == 0)))) x_check_expected_move (f, modified_left, modified_top); - UNBLOCK_INPUT; + unblock_input (); } /* Return non-zero if _NET_SUPPORTING_WM_CHECK window exists and _NET_SUPPORTED @@ -8353,7 +8314,7 @@ wm_supports (struct frame *f, Atom want_atom) unsigned char *tmp_data = NULL; Atom target_type = XA_WINDOW; - BLOCK_INPUT; + block_input (); x_catch_errors (dpy); rc = XGetWindowProperty (dpy, target_window, @@ -8366,7 +8327,7 @@ wm_supports (struct frame *f, Atom want_atom) { if (tmp_data) XFree (tmp_data); x_uncatch_errors (); - UNBLOCK_INPUT; + unblock_input (); return 0; } @@ -8379,7 +8340,7 @@ wm_supports (struct frame *f, Atom want_atom) if (x_had_errors_p (dpy)) { x_uncatch_errors (); - UNBLOCK_INPUT; + unblock_input (); return 0; } @@ -8404,7 +8365,7 @@ wm_supports (struct frame *f, Atom want_atom) { if (tmp_data) XFree (tmp_data); x_uncatch_errors (); - UNBLOCK_INPUT; + unblock_input (); return 0; } @@ -8419,7 +8380,7 @@ wm_supports (struct frame *f, Atom want_atom) rc = dpyinfo->net_supported_atoms[i] == want_atom; x_uncatch_errors (); - UNBLOCK_INPUT; + unblock_input (); return rc; } @@ -8478,7 +8439,7 @@ get_current_wm_state (struct frame *f, *sticky = 0; *size_state = FULLSCREEN_NONE; - BLOCK_INPUT; + block_input (); x_catch_errors (dpy); rc = XGetWindowProperty (dpy, window, dpyinfo->Xatom_net_wm_state, 0, max_len, False, target_type, @@ -8489,7 +8450,7 @@ get_current_wm_state (struct frame *f, { if (tmp_data) XFree (tmp_data); x_uncatch_errors (); - UNBLOCK_INPUT; + unblock_input (); return ! f->iconified; } @@ -8524,7 +8485,7 @@ get_current_wm_state (struct frame *f, } if (tmp_data) XFree (tmp_data); - UNBLOCK_INPUT; + unblock_input (); return ! is_hidden; } @@ -8604,10 +8565,10 @@ XTfullscreen_hook (FRAME_PTR f) { if (f->async_visible) { - BLOCK_INPUT; + block_input (); x_check_fullscreen (f); x_sync (f); - UNBLOCK_INPUT; + unblock_input (); } } @@ -8792,10 +8753,10 @@ x_wait_for_event (struct frame *f, int eventtype) while (pending_event_wait.eventtype) { - interrupt_input_pending = 1; - TOTALLY_UNBLOCK_INPUT; + pending_signals = 1; + totally_unblock_input (); /* XTread_socket is called after unblock. */ - BLOCK_INPUT; + block_input (); interrupt_input_blocked = level; FD_ZERO (&fds); @@ -8886,7 +8847,7 @@ x_set_window_size_1 (struct frame *f, int change_gravity, int cols, int rows) void x_set_window_size (struct frame *f, int change_gravity, int cols, int rows) { - BLOCK_INPUT; + block_input (); if (NILP (tip_frame) || XFRAME (tip_frame) != f) { @@ -8934,7 +8895,7 @@ x_set_window_size (struct frame *f, int change_gravity, int cols, int rows) so don't try--just let the highlighting be done afresh with new size. */ cancel_mouse_face (f); - UNBLOCK_INPUT; + unblock_input (); } /* Mouse warping. */ @@ -8953,11 +8914,11 @@ x_set_mouse_position (struct frame *f, int x, int y) if (pix_y < 0) pix_y = 0; if (pix_y > FRAME_PIXEL_HEIGHT (f)) pix_y = FRAME_PIXEL_HEIGHT (f); - BLOCK_INPUT; + block_input (); XWarpPointer (FRAME_X_DISPLAY (f), None, FRAME_X_WINDOW (f), 0, 0, 0, 0, pix_x, pix_y); - UNBLOCK_INPUT; + unblock_input (); } /* Move the mouse to position pixel PIX_X, PIX_Y relative to frame F. */ @@ -8965,11 +8926,11 @@ x_set_mouse_position (struct frame *f, int x, int y) void x_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y) { - BLOCK_INPUT; + block_input (); XWarpPointer (FRAME_X_DISPLAY (f), None, FRAME_X_WINDOW (f), 0, 0, 0, 0, pix_x, pix_y); - UNBLOCK_INPUT; + unblock_input (); } /* Raise frame F. */ @@ -8977,12 +8938,12 @@ x_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y) void x_raise_frame (struct frame *f) { - BLOCK_INPUT; + block_input (); if (f->async_visible) XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f)); XFlush (FRAME_X_DISPLAY (f)); - UNBLOCK_INPUT; + unblock_input (); } /* Lower frame F. */ @@ -8992,10 +8953,10 @@ x_lower_frame (struct frame *f) { if (f->async_visible) { - BLOCK_INPUT; + block_input (); XLowerWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f)); XFlush (FRAME_X_DISPLAY (f)); - UNBLOCK_INPUT; + unblock_input (); } } @@ -9104,7 +9065,7 @@ x_make_frame_visible (struct frame *f) retry: - BLOCK_INPUT; + block_input (); type = x_icon_type (f); if (!NILP (type)) @@ -9163,7 +9124,7 @@ x_make_frame_visible (struct frame *f) original_top = f->top_pos; /* This must come after we set COUNT. */ - UNBLOCK_INPUT; + unblock_input (); /* We unblock here so that arriving X events are processed. */ @@ -9186,7 +9147,7 @@ x_make_frame_visible (struct frame *f) int x, y; unsigned int width, height, border, depth; - BLOCK_INPUT; + block_input (); /* On some window managers (such as FVWM) moving an existing window, even to the same place, causes the window manager @@ -9202,7 +9163,7 @@ x_make_frame_visible (struct frame *f) XMoveWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), original_left, original_top); - UNBLOCK_INPUT; + unblock_input (); } XSETFRAME (frame, f); @@ -9269,7 +9230,7 @@ x_make_frame_invisible (struct frame *f) if (FRAME_X_DISPLAY_INFO (f)->x_highlight_frame == f) FRAME_X_DISPLAY_INFO (f)->x_highlight_frame = 0; - BLOCK_INPUT; + block_input (); /* Before unmapping the window, update the WM_SIZE_HINTS property to claim that the current position of the window is user-specified, rather than @@ -9292,7 +9253,7 @@ x_make_frame_invisible (struct frame *f) if (! XWithdrawWindow (FRAME_X_DISPLAY (f), window, DefaultScreen (FRAME_X_DISPLAY (f)))) { - UNBLOCK_INPUT_RESIGNAL; + unblock_input (); error ("Can't notify window manager of window withdrawal"); } } @@ -9309,7 +9270,7 @@ x_make_frame_invisible (struct frame *f) x_sync (f); - UNBLOCK_INPUT; + unblock_input (); } /* Change window state from mapped to iconified. */ @@ -9329,7 +9290,7 @@ x_iconify_frame (struct frame *f) if (f->async_iconified) return; - BLOCK_INPUT; + block_input (); FRAME_SAMPLE_VISIBILITY (f); @@ -9348,7 +9309,7 @@ x_iconify_frame (struct frame *f) f->visible = 1; f->async_iconified = 1; f->async_visible = 0; - UNBLOCK_INPUT; + unblock_input (); return; } #endif @@ -9368,14 +9329,14 @@ x_iconify_frame (struct frame *f) f->visible = 1; f->async_iconified = 1; f->async_visible = 0; - UNBLOCK_INPUT; + unblock_input (); return; } result = XIconifyWindow (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget), DefaultScreen (FRAME_X_DISPLAY (f))); - UNBLOCK_INPUT; + unblock_input (); if (!result) error ("Can't notify window manager of iconification"); @@ -9384,9 +9345,9 @@ x_iconify_frame (struct frame *f) f->async_visible = 0; - BLOCK_INPUT; + block_input (); XFlush (FRAME_X_DISPLAY (f)); - UNBLOCK_INPUT; + unblock_input (); #else /* not USE_X_TOOLKIT */ /* Make sure the X server knows where the window should be positioned, @@ -9416,7 +9377,7 @@ x_iconify_frame (struct frame *f) SubstructureRedirectMask | SubstructureNotifyMask, &msg)) { - UNBLOCK_INPUT_RESIGNAL; + unblock_input (); error ("Can't notify window manager of iconification"); } } @@ -9435,7 +9396,7 @@ x_iconify_frame (struct frame *f) f->async_visible = 0; XFlush (FRAME_X_DISPLAY (f)); - UNBLOCK_INPUT; + unblock_input (); #endif /* not USE_X_TOOLKIT */ } @@ -9452,7 +9413,7 @@ x_free_frame_resources (struct frame *f) struct scroll_bar *b; #endif - BLOCK_INPUT; + block_input (); /* If a display connection is dead, don't try sending more commands to the X server. */ @@ -9555,7 +9516,7 @@ x_free_frame_resources (struct frame *f) hlinfo->mouse_face_mouse_frame = 0; } - UNBLOCK_INPUT; + unblock_input (); } @@ -9580,13 +9541,13 @@ x_destroy_window (struct frame *f) /* Set the normal size hints for the window manager, for frame F. FLAGS is the flags word to use--or 0 meaning preserve the flags that the window now has. - If USER_POSITION is nonzero, we set the USPosition + If USER_POSITION, set the USPosition flag (this is useful when FLAGS is 0). - The GTK version is in gtkutils.c */ + The GTK version is in gtkutils.c. */ #ifndef USE_GTK void -x_wm_set_size_hint (struct frame *f, long flags, int user_position) +x_wm_set_size_hint (struct frame *f, long flags, bool user_position) { XSizeHints size_hints; Window window = FRAME_OUTER_WINDOW (f); @@ -9935,7 +9896,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) Mouse_HLInfo *hlinfo; ptrdiff_t lim; - BLOCK_INPUT; + block_input (); if (!x_initialized) { @@ -9996,11 +9957,13 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) Call before gtk_init so Gtk+ event filters comes after our. */ gdk_window_add_filter (NULL, event_handler_gdk, NULL); + /* gtk_init does set_locale. Fix locale before and after. */ + fixup_locale (); gtk_init (&argc, &argv2); + fixup_locale (); + g_log_remove_handler ("GLib", id); - /* gtk_init does set_locale. We must fix locale after calling it. */ - fixup_locale (); xg_initialize (); dpy = DEFAULT_GDK_DISPLAY (); @@ -10067,7 +10030,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) /* Detect failure. */ if (dpy == 0) { - UNBLOCK_INPUT; + unblock_input (); return 0; } @@ -10114,12 +10077,12 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) /* Temporarily hide the partially initialized terminal. */ terminal_list = terminal->next_terminal; - UNBLOCK_INPUT; + unblock_input (); kset_system_key_alist (terminal->kboard, call1 (Qvendor_specific_keysyms, vendor ? build_string (vendor) : empty_unibyte_string)); - BLOCK_INPUT; + block_input (); terminal->next_terminal = terminal_list; terminal_list = terminal; UNGCPRO; @@ -10468,7 +10431,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) x_session_initialize (dpyinfo); #endif - UNBLOCK_INPUT; + unblock_input (); return dpyinfo; } @@ -10548,7 +10511,7 @@ x_delete_display (struct x_display_info *dpyinfo) static void x_process_timeouts (struct atimer *timer) { - BLOCK_INPUT; + block_input (); x_timeout_atimer_activated_flag = 0; if (toolkit_scroll_bar_interaction || popup_activated ()) { @@ -10557,7 +10520,7 @@ x_process_timeouts (struct atimer *timer) /* Reactivate the atimer for next time. */ x_activate_timeout_atimer (); } - UNBLOCK_INPUT; + unblock_input (); } /* Install an asynchronous timer that processes Xt timeout events @@ -10571,14 +10534,14 @@ x_process_timeouts (struct atimer *timer) void x_activate_timeout_atimer (void) { - BLOCK_INPUT; + block_input (); if (!x_timeout_atimer_activated_flag) { EMACS_TIME interval = make_emacs_time (0, 100 * 1000 * 1000); start_atimer (ATIMER_RELATIVE, interval, x_process_timeouts, 0); x_timeout_atimer_activated_flag = 1; } - UNBLOCK_INPUT; + unblock_input (); } #endif /* USE_X_TOOLKIT */ @@ -10631,7 +10594,7 @@ x_delete_terminal (struct terminal *terminal) if (!terminal->name) return; - BLOCK_INPUT; + block_input (); #ifdef HAVE_X_I18N /* We must close our connection to the XIM server before closing the X display. */ @@ -10686,7 +10649,7 @@ x_delete_terminal (struct terminal *terminal) /* Mark as dead. */ dpyinfo->display = NULL; x_delete_display (dpyinfo); - UNBLOCK_INPUT; + unblock_input (); } /* Create a struct terminal, initialize it with the X11 specific @@ -10743,8 +10706,6 @@ x_create_terminal (struct x_display_info *dpyinfo) void x_initialize (void) { - struct sigaction action; - baud_rate = 19200; x_noop_count = 0; @@ -10790,9 +10751,6 @@ x_initialize (void) original error handler. */ XSetErrorHandler (x_error_handler); XSetIOErrorHandler (x_io_error_quitter); - - emacs_sigaction_init (&action, x_connection_signal); - sigaction (SIGPIPE, &action, 0); } diff --git a/src/xterm.h b/src/xterm.h index 2d718f49118..4bc8f9813ed 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -962,11 +962,11 @@ extern XtAppContext Xt_app_con; extern void x_activate_timeout_atimer (void); #endif #ifdef USE_LUCID -extern int x_alloc_lighter_color_for_widget (Widget, Display *, Colormap, - unsigned long *, - double, int); +extern bool x_alloc_lighter_color_for_widget (Widget, Display *, Colormap, + unsigned long *, + double, int); #endif -extern int x_alloc_nearest_color (struct frame *, Colormap, XColor *); +extern bool x_alloc_nearest_color (struct frame *, Colormap, XColor *); extern void x_query_color (struct frame *f, XColor *); extern void x_clear_area (Display *, Window, int, int, int, int, int); #if defined HAVE_MENUS && !defined USE_X_TOOLKIT && !defined USE_GTK @@ -1034,7 +1034,7 @@ extern void xic_set_statusarea (struct frame *); extern void xic_set_xfontset (struct frame *, const char *); extern int x_pixel_width (struct frame *); extern int x_pixel_height (struct frame *); -extern int x_defined_color (struct frame *, const char *, XColor *, int); +extern bool x_defined_color (struct frame *, const char *, XColor *, bool); #ifdef HAVE_X_I18N extern void free_frame_xic (struct frame *); # if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT |