diff options
| author | Kenichi Handa | 2012-11-23 23:36:24 +0900 |
|---|---|---|
| committer | Kenichi Handa | 2012-11-23 23:36:24 +0900 |
| commit | 2aaec2d9be5cec44ea3b59cba476fd3e091f2fc9 (patch) | |
| tree | 3711b97807201b7eeaa066003b1c3a4ce929e5bb | |
| parent | e1d276cbf9e18f13101328f56bed1a1c0a66e63a (diff) | |
| parent | e7d0e5ee247a155a268ffbf80bedbe25e15b5032 (diff) | |
| download | emacs-2aaec2d9be5cec44ea3b59cba476fd3e091f2fc9.tar.gz emacs-2aaec2d9be5cec44ea3b59cba476fd3e091f2fc9.zip | |
114 files changed, 2592 insertions, 2005 deletions
| @@ -1,3 +1,25 @@ | |||
| 1 | 2012-11-23 Paul Eggert <eggert@cs.ucla.edu> | ||
| 2 | |||
| 3 | Assume POSIX 1003.1-1988 or later for dirent.h (Bug#12958). | ||
| 4 | * configure.ac: Do not check for dirent.h or closdir. | ||
| 5 | |||
| 6 | 2012-11-21 Paul Eggert <eggert@cs.ucla.edu> | ||
| 7 | |||
| 8 | Assume POSIX 1003.1-1988 or later for unistd.h (Bug#12945). | ||
| 9 | * configure.ac: Do not check for getcwd or getwd. | ||
| 10 | |||
| 11 | 2012-11-21 Glenn Morris <rgm@gnu.org> | ||
| 12 | |||
| 13 | * configure.ac (--enable-profiling): Doc fix. | ||
| 14 | |||
| 15 | 2012-11-20 Paul Eggert <eggert@cs.ucla.edu> | ||
| 16 | |||
| 17 | Improve static checking of integer overflow and stack smashing. | ||
| 18 | * configure.ac (WARN_CFLAGS): Add -Wstack-protector | ||
| 19 | if using GCC 4.7.2 or later on a platform with | ||
| 20 | at least 64-bit long int. This improves static checking on these | ||
| 21 | platforms, when configured with --enable-gcc-warnings. | ||
| 22 | |||
| 1 | 2012-11-17 Paul Eggert <eggert@cs.ucla.edu> | 23 | 2012-11-17 Paul Eggert <eggert@cs.ucla.edu> |
| 2 | 24 | ||
| 3 | Assume POSIX 1003.1-1988 or later for fcntl.h (Bug#12881). | 25 | Assume POSIX 1003.1-1988 or later for fcntl.h (Bug#12881). |
diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index ae8673452a3..f4105f00c47 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES | |||
| @@ -86,7 +86,6 @@ anymore, so they can be removed. | |||
| 86 | AMPERSAND_FULL_NAME | 86 | AMPERSAND_FULL_NAME |
| 87 | BROKEN_DATAGRAM_SOCKETS | 87 | BROKEN_DATAGRAM_SOCKETS |
| 88 | BROKEN_FIONREAD | 88 | BROKEN_FIONREAD |
| 89 | BROKEN_GETWD | ||
| 90 | BROKEN_GET_CURRENT_DIR_NAME | 89 | BROKEN_GET_CURRENT_DIR_NAME |
| 91 | BROKEN_NON_BLOCKING_CONNECT | 90 | BROKEN_NON_BLOCKING_CONNECT |
| 92 | BROKEN_PTY_READ_AFTER_EAGAIN | 91 | BROKEN_PTY_READ_AFTER_EAGAIN |
| @@ -119,7 +118,6 @@ HAVE_CFMAKERAW | |||
| 119 | HAVE_CFSETSPEED | 118 | HAVE_CFSETSPEED |
| 120 | HAVE_CLOCK_GETTIME | 119 | HAVE_CLOCK_GETTIME |
| 121 | HAVE_CLOCK_SETTIME | 120 | HAVE_CLOCK_SETTIME |
| 122 | HAVE_CLOSEDIR | ||
| 123 | HAVE_COFF_H | 121 | HAVE_COFF_H |
| 124 | HAVE_COM_ERR_H | 122 | HAVE_COM_ERR_H |
| 125 | HAVE_COPYSIGN | 123 | HAVE_COPYSIGN |
| @@ -144,7 +142,6 @@ HAVE_DES_H | |||
| 144 | HAVE_DEV_PTMX | 142 | HAVE_DEV_PTMX |
| 145 | HAVE_DIALOGS | 143 | HAVE_DIALOGS |
| 146 | HAVE_DIFFTIME | 144 | HAVE_DIFFTIME |
| 147 | HAVE_DIRENT_H | ||
| 148 | HAVE_DUP2 | 145 | HAVE_DUP2 |
| 149 | HAVE_ENDGRENT | 146 | HAVE_ENDGRENT |
| 150 | HAVE_ENDPWENT | 147 | HAVE_ENDPWENT |
| @@ -161,7 +158,6 @@ HAVE_FUTIMESAT | |||
| 161 | HAVE_GAI_STRERROR | 158 | HAVE_GAI_STRERROR |
| 162 | HAVE_GCONF | 159 | HAVE_GCONF |
| 163 | HAVE_GETADDRINFO | 160 | HAVE_GETADDRINFO |
| 164 | HAVE_GETCWD | ||
| 165 | HAVE_GETDELIM | 161 | HAVE_GETDELIM |
| 166 | HAVE_GETGRENT | 162 | HAVE_GETGRENT |
| 167 | HAVE_GETHOSTNAME | 163 | HAVE_GETHOSTNAME |
| @@ -178,7 +174,6 @@ HAVE_GETRLIMIT | |||
| 178 | HAVE_GETRUSAGE | 174 | HAVE_GETRUSAGE |
| 179 | HAVE_GETSOCKNAME | 175 | HAVE_GETSOCKNAME |
| 180 | HAVE_GETTIMEOFDAY | 176 | HAVE_GETTIMEOFDAY |
| 181 | HAVE_GETWD | ||
| 182 | HAVE_GET_CURRENT_DIR_NAME | 177 | HAVE_GET_CURRENT_DIR_NAME |
| 183 | HAVE_GHOSTSCRIPT | 178 | HAVE_GHOSTSCRIPT |
| 184 | HAVE_GIF | 179 | HAVE_GIF |
| @@ -304,7 +299,6 @@ HAVE_SIGNED_SIG_ATOMIC_T | |||
| 304 | HAVE_SIGNED_WCHAR_T | 299 | HAVE_SIGNED_WCHAR_T |
| 305 | HAVE_SIGNED_WINT_T | 300 | HAVE_SIGNED_WINT_T |
| 306 | HAVE_SIGSET_T | 301 | HAVE_SIGSET_T |
| 307 | HAVE_SIZE_T | ||
| 308 | HAVE_SNPRINTF | 302 | HAVE_SNPRINTF |
| 309 | HAVE_SOCKETS | 303 | HAVE_SOCKETS |
| 310 | HAVE_SOUND | 304 | HAVE_SOUND |
| @@ -369,7 +363,6 @@ HAVE_TM_ZONE | |||
| 369 | HAVE_TOUCHLOCK | 363 | HAVE_TOUCHLOCK |
| 370 | HAVE_TZNAME | 364 | HAVE_TZNAME |
| 371 | HAVE_TZSET | 365 | HAVE_TZSET |
| 372 | HAVE_UNISTD_H | ||
| 373 | HAVE_UNSIGNED_LONG_LONG_INT | 366 | HAVE_UNSIGNED_LONG_LONG_INT |
| 374 | HAVE_UTIL_H | 367 | HAVE_UTIL_H |
| 375 | HAVE_UTIMENSAT | 368 | HAVE_UTIMENSAT |
diff --git a/admin/ChangeLog b/admin/ChangeLog index 3d76f9dd2ba..fe75ae57a6d 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog | |||
| @@ -1,3 +1,15 @@ | |||
| 1 | 2012-11-23 Paul Eggert <eggert@cs.ucla.edu> | ||
| 2 | |||
| 3 | Assume POSIX 1003.1-1988 or later for dirent.h (Bug#12958). | ||
| 4 | * CPP-DEFINES (HAVE_CLOSEDIR, HAVE_DIRENT_H): Remove. | ||
| 5 | * notes/copyright: Adjust to src/ndir.h -> nt/inc/dirent.h renaming. | ||
| 6 | |||
| 7 | 2012-11-21 Paul Eggert <eggert@cs.ucla.edu> | ||
| 8 | |||
| 9 | Assume POSIX 1003.1-1988 or later for unistd.h (Bug#12945). | ||
| 10 | * CPP-DEFINES (BROKEN_GETWD, HAVE_GETCWD, HAVE_GETWD, HAVE_SIZE_T) | ||
| 11 | (HAVE_UNISTD_H): Remove. | ||
| 12 | |||
| 1 | 2012-11-17 Paul Eggert <eggert@cs.ucla.edu> | 13 | 2012-11-17 Paul Eggert <eggert@cs.ucla.edu> |
| 2 | 14 | ||
| 3 | Assume POSIX 1003.1-1988 or later for fcntl.h (Bug#12881). | 15 | Assume POSIX 1003.1-1988 or later for fcntl.h (Bug#12881). |
diff --git a/admin/notes/copyright b/admin/notes/copyright index 72b7d7e2d23..173ff83343a 100644 --- a/admin/notes/copyright +++ b/admin/notes/copyright | |||
| @@ -380,7 +380,7 @@ Makefile.in does now. | |||
| 380 | src/gmalloc.c | 380 | src/gmalloc.c |
| 381 | - contains numerous copyrights from the GNU C library. Leave them alone. | 381 | - contains numerous copyrights from the GNU C library. Leave them alone. |
| 382 | 382 | ||
| 383 | src/ndir.h | 383 | nt/inc/dirent.h |
| 384 | - see comments below. This file is OK to be released with Emacs | 384 | - see comments below. This file is OK to be released with Emacs |
| 385 | 22, but we may want to revisit it afterwards. | 385 | 22, but we may want to revisit it afterwards. |
| 386 | 386 | ||
| @@ -429,7 +429,7 @@ admin/check-doc-strings | |||
| 429 | File says it's in the public domain, but that might not make it so. | 429 | File says it's in the public domain, but that might not make it so. |
| 430 | 430 | ||
| 431 | etc/e/eterm-color.ti | 431 | etc/e/eterm-color.ti |
| 432 | src/ndir.h | 432 | nt/inc/dirent.h |
| 433 | On legal advice from Matt Norwood, the following comment was added | 433 | On legal advice from Matt Norwood, the following comment was added |
| 434 | to these files in Feb/Mar 2007: | 434 | to these files in Feb/Mar 2007: |
| 435 | 435 | ||
diff --git a/autogen/config.in b/autogen/config.in index 9f664063761..c0fb1f34bf4 100644 --- a/autogen/config.in +++ b/autogen/config.in | |||
| @@ -50,9 +50,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 50 | /* Define to the number of bits in type 'wint_t'. */ | 50 | /* Define to the number of bits in type 'wint_t'. */ |
| 51 | #undef BITSIZEOF_WINT_T | 51 | #undef BITSIZEOF_WINT_T |
| 52 | 52 | ||
| 53 | /* Define if getwd should not be used. */ | ||
| 54 | #undef BROKEN_GETWD | ||
| 55 | |||
| 56 | /* Define if get_current_dir_name should not be used. */ | 53 | /* Define if get_current_dir_name should not be used. */ |
| 57 | #undef BROKEN_GET_CURRENT_DIR_NAME | 54 | #undef BROKEN_GET_CURRENT_DIR_NAME |
| 58 | 55 | ||
| @@ -256,9 +253,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 256 | /* Define to 1 if you have the `clock_settime' function. */ | 253 | /* Define to 1 if you have the `clock_settime' function. */ |
| 257 | #undef HAVE_CLOCK_SETTIME | 254 | #undef HAVE_CLOCK_SETTIME |
| 258 | 255 | ||
| 259 | /* Define to 1 if you have the `closedir' function. */ | ||
| 260 | #undef HAVE_CLOSEDIR | ||
| 261 | |||
| 262 | /* Define to 1 if you have the <coff.h> header file. */ | 256 | /* Define to 1 if you have the <coff.h> header file. */ |
| 263 | #undef HAVE_COFF_H | 257 | #undef HAVE_COFF_H |
| 264 | 258 | ||
| @@ -342,9 +336,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 342 | /* Define to 1 if you have the `difftime' function. */ | 336 | /* Define to 1 if you have the `difftime' function. */ |
| 343 | #undef HAVE_DIFFTIME | 337 | #undef HAVE_DIFFTIME |
| 344 | 338 | ||
| 345 | /* Define to 1 if you have the <dirent.h> header file. */ | ||
| 346 | #undef HAVE_DIRENT_H | ||
| 347 | |||
| 348 | /* Define to 1 if you have the 'dup2' function. */ | 339 | /* Define to 1 if you have the 'dup2' function. */ |
| 349 | #undef HAVE_DUP2 | 340 | #undef HAVE_DUP2 |
| 350 | 341 | ||
| @@ -402,9 +393,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 402 | /* Define to 1 if you have the `getaddrinfo' function. */ | 393 | /* Define to 1 if you have the `getaddrinfo' function. */ |
| 403 | #undef HAVE_GETADDRINFO | 394 | #undef HAVE_GETADDRINFO |
| 404 | 395 | ||
| 405 | /* Define to 1 if you have the `getcwd' function. */ | ||
| 406 | #undef HAVE_GETCWD | ||
| 407 | |||
| 408 | /* Define to 1 if you have the `getdelim' function. */ | 396 | /* Define to 1 if you have the `getdelim' function. */ |
| 409 | #undef HAVE_GETDELIM | 397 | #undef HAVE_GETDELIM |
| 410 | 398 | ||
| @@ -453,9 +441,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 453 | /* Define to 1 if you have the `gettimeofday' function. */ | 441 | /* Define to 1 if you have the `gettimeofday' function. */ |
| 454 | #undef HAVE_GETTIMEOFDAY | 442 | #undef HAVE_GETTIMEOFDAY |
| 455 | 443 | ||
| 456 | /* Define to 1 if you have the `getwd' function. */ | ||
| 457 | #undef HAVE_GETWD | ||
| 458 | |||
| 459 | /* Define to 1 if you have the `get_current_dir_name' function. */ | 444 | /* Define to 1 if you have the `get_current_dir_name' function. */ |
| 460 | #undef HAVE_GET_CURRENT_DIR_NAME | 445 | #undef HAVE_GET_CURRENT_DIR_NAME |
| 461 | 446 | ||
diff --git a/autogen/configure b/autogen/configure index afcf9a73fa6..fbb2efbc860 100755 --- a/autogen/configure +++ b/autogen/configure | |||
| @@ -2058,8 +2058,9 @@ Optional Features: | |||
| 2058 | enable compile time checks for the Lisp_Object data | 2058 | enable compile time checks for the Lisp_Object data |
| 2059 | type. This is useful for development for catching | 2059 | type. This is useful for development for catching |
| 2060 | certain types of bugs. | 2060 | certain types of bugs. |
| 2061 | --enable-profiling build emacs with profiling support. This might not | 2061 | --enable-profiling build emacs with low-level, gprof profiling support. |
| 2062 | work on all platforms | 2062 | Mainly useful for debugging Emacs itself. May not |
| 2063 | work on all platforms. Stops profiler.el working. | ||
| 2063 | --enable-autodepend automatically generate dependencies to .h-files. | 2064 | --enable-autodepend automatically generate dependencies to .h-files. |
| 2064 | Requires GNU Make and Gcc. Enabled if GNU Make and | 2065 | Requires GNU Make and Gcc. Enabled if GNU Make and |
| 2065 | Gcc is found | 2066 | Gcc is found |
| @@ -3213,7 +3214,6 @@ as_fn_append ac_header_list " sys/resource.h" | |||
| 3213 | as_fn_append ac_header_list " sys/utsname.h" | 3214 | as_fn_append ac_header_list " sys/utsname.h" |
| 3214 | as_fn_append ac_header_list " pwd.h" | 3215 | as_fn_append ac_header_list " pwd.h" |
| 3215 | as_fn_append ac_header_list " utmp.h" | 3216 | as_fn_append ac_header_list " utmp.h" |
| 3216 | as_fn_append ac_header_list " dirent.h" | ||
| 3217 | as_fn_append ac_header_list " util.h" | 3217 | as_fn_append ac_header_list " util.h" |
| 3218 | as_fn_append ac_header_list " sys/socket.h" | 3218 | as_fn_append ac_header_list " sys/socket.h" |
| 3219 | as_fn_append ac_header_list " stdlib.h" | 3219 | as_fn_append ac_header_list " stdlib.h" |
| @@ -7257,6 +7257,8 @@ fi | |||
| 7257 | nw="$nw -Wfloat-equal" # warns about high-quality code | 7257 | nw="$nw -Wfloat-equal" # warns about high-quality code |
| 7258 | nw="$nw -Winline" # OK to ignore 'inline' | 7258 | nw="$nw -Winline" # OK to ignore 'inline' |
| 7259 | nw="$nw -Wjump-misses-init" # We sometimes safely jump over init. | 7259 | nw="$nw -Wjump-misses-init" # We sometimes safely jump over init. |
| 7260 | nw="$nw -Wstrict-overflow" # OK to optimize assuming that | ||
| 7261 | # signed overflow has undefined behavior | ||
| 7260 | nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning | 7262 | nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning |
| 7261 | nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations | 7263 | nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations |
| 7262 | 7264 | ||
| @@ -7264,11 +7266,38 @@ fi | |||
| 7264 | # <http://lists.gnu.org/archive/html/emacs-diffs/2011-11/msg00265.html>. | 7266 | # <http://lists.gnu.org/archive/html/emacs-diffs/2011-11/msg00265.html>. |
| 7265 | nw="$nw -Wshadow" | 7267 | nw="$nw -Wshadow" |
| 7266 | 7268 | ||
| 7267 | # The following lines should be removable at some point. | 7269 | # The following line should be removable at some point. |
| 7268 | nw="$nw -Wstack-protector" | ||
| 7269 | nw="$nw -Wstrict-overflow" | ||
| 7270 | nw="$nw -Wsuggest-attribute=pure" | 7270 | nw="$nw -Wsuggest-attribute=pure" |
| 7271 | 7271 | ||
| 7272 | { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use -Wstack-protector" >&5 | ||
| 7273 | $as_echo_n "checking whether to use -Wstack-protector... " >&6; } | ||
| 7274 | cat confdefs.h - <<_ACEOF >conftest.$ac_ext | ||
| 7275 | /* end confdefs.h. */ | ||
| 7276 | #if (1 <= __LONG_MAX__ >> 31 >> 31 \ | ||
| 7277 | && 4 < __GNUC__ + (7 < __GNUC_MINOR__ + (2 <= __GNUC_PATCHLEVEL__))) | ||
| 7278 | /* OK */ | ||
| 7279 | #else | ||
| 7280 | #error "Not GCC, or GCC before 4.7.2, or 'long int' has < 64 bits." | ||
| 7281 | #endif | ||
| 7282 | |||
| 7283 | int | ||
| 7284 | main () | ||
| 7285 | { | ||
| 7286 | |||
| 7287 | ; | ||
| 7288 | return 0; | ||
| 7289 | } | ||
| 7290 | _ACEOF | ||
| 7291 | if ac_fn_c_try_cpp "$LINENO"; then : | ||
| 7292 | { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 | ||
| 7293 | $as_echo "yes" >&6; } | ||
| 7294 | else | ||
| 7295 | { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 | ||
| 7296 | $as_echo "no" >&6; } | ||
| 7297 | nw="$nw -Wstack-protector" | ||
| 7298 | fi | ||
| 7299 | rm -f conftest.err conftest.$ac_ext | ||
| 7300 | |||
| 7272 | 7301 | ||
| 7273 | 7302 | ||
| 7274 | if test -n "$GCC"; then | 7303 | if test -n "$GCC"; then |
| @@ -8779,8 +8808,6 @@ done | |||
| 8779 | 8808 | ||
| 8780 | 8809 | ||
| 8781 | 8810 | ||
| 8782 | |||
| 8783 | |||
| 8784 | { $as_echo "$as_me:${as_lineno-$LINENO}: checking if personality LINUX32 can be set" >&5 | 8811 | { $as_echo "$as_me:${as_lineno-$LINENO}: checking if personality LINUX32 can be set" >&5 |
| 8785 | $as_echo_n "checking if personality LINUX32 can be set... " >&6; } | 8812 | $as_echo_n "checking if personality LINUX32 can be set... " >&6; } |
| 8786 | cat confdefs.h - <<_ACEOF >conftest.$ac_ext | 8813 | cat confdefs.h - <<_ACEOF >conftest.$ac_ext |
| @@ -13444,10 +13471,10 @@ esac | |||
| 13444 | 13471 | ||
| 13445 | 13472 | ||
| 13446 | for ac_func in gethostname \ | 13473 | for ac_func in gethostname \ |
| 13447 | closedir getrusage get_current_dir_name \ | 13474 | getrusage get_current_dir_name \ |
| 13448 | lrand48 \ | 13475 | lrand48 \ |
| 13449 | select getpagesize setlocale \ | 13476 | select getpagesize setlocale \ |
| 13450 | utimes getrlimit setrlimit getcwd shutdown getaddrinfo \ | 13477 | utimes getrlimit setrlimit shutdown getaddrinfo \ |
| 13451 | strsignal setitimer \ | 13478 | strsignal setitimer \ |
| 13452 | sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \ | 13479 | sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \ |
| 13453 | gai_strerror mkstemp getline getdelim fsync sync \ | 13480 | gai_strerror mkstemp getline getdelim fsync sync \ |
| @@ -13468,24 +13495,6 @@ fi | |||
| 13468 | done | 13495 | done |
| 13469 | 13496 | ||
| 13470 | 13497 | ||
| 13471 | if test $opsys = unixware; then | ||
| 13472 | |||
| 13473 | $as_echo "#define BROKEN_GETWD 1" >>confdefs.h | ||
| 13474 | |||
| 13475 | else | ||
| 13476 | for ac_func in getwd | ||
| 13477 | do : | ||
| 13478 | ac_fn_c_check_func "$LINENO" "getwd" "ac_cv_func_getwd" | ||
| 13479 | if test "x$ac_cv_func_getwd" = x""yes; then : | ||
| 13480 | cat >>confdefs.h <<_ACEOF | ||
| 13481 | #define HAVE_GETWD 1 | ||
| 13482 | _ACEOF | ||
| 13483 | |||
| 13484 | fi | ||
| 13485 | done | ||
| 13486 | |||
| 13487 | fi | ||
| 13488 | |||
| 13489 | ## Eric Backus <ericb@lsid.hp.com> says, HP-UX 9.x on HP 700 machines | 13498 | ## Eric Backus <ericb@lsid.hp.com> says, HP-UX 9.x on HP 700 machines |
| 13490 | ## has a broken `rint' in some library versions including math library | 13499 | ## has a broken `rint' in some library versions including math library |
| 13491 | ## version number A.09.05. | 13500 | ## version number A.09.05. |
diff --git a/configure.ac b/configure.ac index 1884cc7ccf7..7dda0010f28 100644 --- a/configure.ac +++ b/configure.ac | |||
| @@ -329,10 +329,15 @@ if test "${enableval}" != "no"; then | |||
| 329 | fi) | 329 | fi) |
| 330 | 330 | ||
| 331 | 331 | ||
| 332 | dnl The name of this option is unfortunate. It predates, and has no | ||
| 333 | dnl relation to, the "sampling-based elisp profiler" added in 24.3. | ||
| 334 | dnl Actually, it stops it working. | ||
| 335 | dnl http://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00393.html | ||
| 332 | AC_ARG_ENABLE(profiling, | 336 | AC_ARG_ENABLE(profiling, |
| 333 | [AS_HELP_STRING([--enable-profiling], | 337 | [AS_HELP_STRING([--enable-profiling], |
| 334 | [build emacs with profiling support. | 338 | [build emacs with low-level, gprof profiling support. |
| 335 | This might not work on all platforms])], | 339 | Mainly useful for debugging Emacs itself. May not work on |
| 340 | all platforms. Stops profiler.el working.])], | ||
| 336 | [ac_enable_profiling="${enableval}"],[]) | 341 | [ac_enable_profiling="${enableval}"],[]) |
| 337 | if test x$ac_enable_profiling != x ; then | 342 | if test x$ac_enable_profiling != x ; then |
| 338 | PROFILING_CFLAGS="-DPROFILING=1 -pg" | 343 | PROFILING_CFLAGS="-DPROFILING=1 -pg" |
| @@ -710,6 +715,8 @@ else | |||
| 710 | nw="$nw -Wfloat-equal" # warns about high-quality code | 715 | nw="$nw -Wfloat-equal" # warns about high-quality code |
| 711 | nw="$nw -Winline" # OK to ignore 'inline' | 716 | nw="$nw -Winline" # OK to ignore 'inline' |
| 712 | nw="$nw -Wjump-misses-init" # We sometimes safely jump over init. | 717 | nw="$nw -Wjump-misses-init" # We sometimes safely jump over init. |
| 718 | nw="$nw -Wstrict-overflow" # OK to optimize assuming that | ||
| 719 | # signed overflow has undefined behavior | ||
| 713 | nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning | 720 | nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning |
| 714 | nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations | 721 | nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations |
| 715 | 722 | ||
| @@ -717,11 +724,23 @@ else | |||
| 717 | # <http://lists.gnu.org/archive/html/emacs-diffs/2011-11/msg00265.html>. | 724 | # <http://lists.gnu.org/archive/html/emacs-diffs/2011-11/msg00265.html>. |
| 718 | nw="$nw -Wshadow" | 725 | nw="$nw -Wshadow" |
| 719 | 726 | ||
| 720 | # The following lines should be removable at some point. | 727 | # The following line should be removable at some point. |
| 721 | nw="$nw -Wstack-protector" | ||
| 722 | nw="$nw -Wstrict-overflow" | ||
| 723 | nw="$nw -Wsuggest-attribute=pure" | 728 | nw="$nw -Wsuggest-attribute=pure" |
| 724 | 729 | ||
| 730 | AC_MSG_CHECKING([whether to use -Wstack-protector]) | ||
| 731 | AC_PREPROC_IFELSE( | ||
| 732 | [AC_LANG_PROGRAM( | ||
| 733 | [[#if (1 <= __LONG_MAX__ >> 31 >> 31 \ | ||
| 734 | && 4 < __GNUC__ + (7 < __GNUC_MINOR__ + (2 <= __GNUC_PATCHLEVEL__))) | ||
| 735 | /* OK */ | ||
| 736 | #else | ||
| 737 | #error "Not GCC, or GCC before 4.7.2, or 'long int' has < 64 bits." | ||
| 738 | #endif | ||
| 739 | ]])], | ||
| 740 | [AC_MSG_RESULT(yes)], | ||
| 741 | [AC_MSG_RESULT(no) | ||
| 742 | nw="$nw -Wstack-protector"]) | ||
| 743 | |||
| 725 | gl_MANYWARN_ALL_GCC([ws]) | 744 | gl_MANYWARN_ALL_GCC([ws]) |
| 726 | gl_MANYWARN_COMPLEMENT([ws], [$ws], [$nw]) | 745 | gl_MANYWARN_COMPLEMENT([ws], [$ws], [$nw]) |
| 727 | for w in $ws; do | 746 | for w in $ws; do |
| @@ -1270,7 +1289,7 @@ AC_CHECK_HEADERS_ONCE( | |||
| 1270 | linux/version.h sys/systeminfo.h | 1289 | linux/version.h sys/systeminfo.h |
| 1271 | coff.h pty.h | 1290 | coff.h pty.h |
| 1272 | sys/vlimit.h sys/resource.h | 1291 | sys/vlimit.h sys/resource.h |
| 1273 | sys/utsname.h pwd.h utmp.h dirent.h util.h) | 1292 | sys/utsname.h pwd.h utmp.h util.h) |
| 1274 | 1293 | ||
| 1275 | AC_MSG_CHECKING(if personality LINUX32 can be set) | 1294 | AC_MSG_CHECKING(if personality LINUX32 can be set) |
| 1276 | AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/personality.h>]], [[personality (PER_LINUX32)]])], | 1295 | AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/personality.h>]], [[personality (PER_LINUX32)]])], |
| @@ -2872,10 +2891,10 @@ AC_SUBST(BLESSMAIL_TARGET) | |||
| 2872 | 2891 | ||
| 2873 | 2892 | ||
| 2874 | AC_CHECK_FUNCS(gethostname \ | 2893 | AC_CHECK_FUNCS(gethostname \ |
| 2875 | closedir getrusage get_current_dir_name \ | 2894 | getrusage get_current_dir_name \ |
| 2876 | lrand48 \ | 2895 | lrand48 \ |
| 2877 | select getpagesize setlocale \ | 2896 | select getpagesize setlocale \ |
| 2878 | utimes getrlimit setrlimit getcwd shutdown getaddrinfo \ | 2897 | utimes getrlimit setrlimit shutdown getaddrinfo \ |
| 2879 | strsignal setitimer \ | 2898 | strsignal setitimer \ |
| 2880 | sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \ | 2899 | sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \ |
| 2881 | gai_strerror mkstemp getline getdelim fsync sync \ | 2900 | gai_strerror mkstemp getline getdelim fsync sync \ |
| @@ -2884,14 +2903,6 @@ getpwent endpwent getgrent endgrent \ | |||
| 2884 | touchlock \ | 2903 | touchlock \ |
| 2885 | cfmakeraw cfsetspeed copysign __executable_start) | 2904 | cfmakeraw cfsetspeed copysign __executable_start) |
| 2886 | 2905 | ||
| 2887 | dnl getwd appears to be buggy on SVR4.2, so we don't use it. | ||
| 2888 | if test $opsys = unixware; then | ||
| 2889 | dnl In case some other test ends up checking for getwd. | ||
| 2890 | AC_DEFINE(BROKEN_GETWD, 1, [Define if getwd should not be used.]) | ||
| 2891 | else | ||
| 2892 | AC_CHECK_FUNCS(getwd) | ||
| 2893 | fi | ||
| 2894 | |||
| 2895 | ## Eric Backus <ericb@lsid.hp.com> says, HP-UX 9.x on HP 700 machines | 2906 | ## Eric Backus <ericb@lsid.hp.com> says, HP-UX 9.x on HP 700 machines |
| 2896 | ## has a broken `rint' in some library versions including math library | 2907 | ## has a broken `rint' in some library versions including math library |
| 2897 | ## version number A.09.05. | 2908 | ## version number A.09.05. |
diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index dc5fa539cd1..af22f0628d1 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog | |||
| @@ -1,3 +1,9 @@ | |||
| 1 | 2012-11-21 Dani Moncayo <dmoncayo@gmail.com> | ||
| 2 | |||
| 3 | * display.texi (Auto Scrolling): Fix some inaccuracies, plus | ||
| 4 | clarifications (Bug#12865). | ||
| 5 | (Horizontal Scrolling): Clarifications. | ||
| 6 | |||
| 1 | 2012-11-18 Dani Moncayo <dmoncayo@gmail.com> | 7 | 2012-11-18 Dani Moncayo <dmoncayo@gmail.com> |
| 2 | 8 | ||
| 3 | * mark.texi (Disabled Transient Mark): Doc fixes (Bug#12746). | 9 | * mark.texi (Disabled Transient Mark): Doc fixes (Bug#12746). |
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index b6ab4913f9c..876c46bdf1a 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi | |||
| @@ -213,59 +213,62 @@ entire current defun onto the screen if possible. | |||
| 213 | @node Auto Scrolling | 213 | @node Auto Scrolling |
| 214 | @section Automatic Scrolling | 214 | @section Automatic Scrolling |
| 215 | 215 | ||
| 216 | @cindex automatic scrolling | ||
| 216 | Emacs performs @dfn{automatic scrolling} when point moves out of the | 217 | Emacs performs @dfn{automatic scrolling} when point moves out of the |
| 217 | visible portion of the text. | 218 | visible portion of the text. Normally, automatic scrolling centers |
| 219 | point vertically in the window, but there are several ways to alter | ||
| 220 | this behavior. | ||
| 218 | 221 | ||
| 219 | @vindex scroll-conservatively | 222 | @vindex scroll-conservatively |
| 220 | Normally, this centers point vertically within the window. However, | 223 | If you set @code{scroll-conservatively} to a small number @var{n}, |
| 221 | if you set @code{scroll-conservatively} to a small number @var{n}, | 224 | then moving point just a little off the screen (no more than @var{n} |
| 222 | then if you move point just a little off the screen (less than @var{n} | 225 | lines) causes Emacs to scroll just enough to bring point back on |
| 223 | lines), Emacs scrolls the text just far enough to bring point back on | 226 | screen; if doing so fails to make point visible, Emacs scrolls just |
| 224 | screen. If doing so fails to make point visible, Emacs centers point | 227 | far enough to center point in the window. If you set |
| 225 | in the window. By default, @code{scroll-conservatively} is@tie{}0. | 228 | @code{scroll-conservatively} to a large number (larger than 100), |
| 226 | If you set @code{scroll-conservatively} to a large number (larger than | 229 | automatic scrolling never centers point, no matter how far point |
| 227 | 100), Emacs will never center point as result of scrolling, even if | 230 | moves; Emacs always scrolls text just enough to bring point into view, |
| 228 | point moves far away from the text previously displayed in the window. | 231 | either at the top or bottom of the window depending on the scroll |
| 229 | With such a large value, Emacs will always scroll text just enough for | 232 | direction. By default, @code{scroll-conservatively} is@tie{}0, which |
| 230 | bringing point into view, so point will end up at the top or bottom of | 233 | means to always center point in the window. |
| 231 | the window, depending on the scroll direction. | ||
| 232 | 234 | ||
| 233 | @vindex scroll-step | 235 | @vindex scroll-step |
| 234 | An alternative way of controlling how Emacs scrolls text is by | 236 | Another way to control automatic scrolling is to customize the |
| 235 | customizing the variable @code{scroll-step}. Its value determines how | 237 | variable @code{scroll-step}. Its value determines the number of lines |
| 236 | many lines to scroll the window when point moves off the screen. If | 238 | by which to automatically scroll, when point moves off the screen. If |
| 237 | moving by that number of lines fails to bring point back into view, | 239 | scrolling by that number of lines fails to bring point back into view, |
| 238 | point is centered instead. The default value is zero, which causes | 240 | point is centered instead. The default value is zero, which (by |
| 239 | point to always be centered after scrolling. | 241 | default) causes point to always be centered after scrolling. |
| 240 | |||
| 241 | Since both @code{scroll-conservatively} and @code{scroll-step} | ||
| 242 | control automatic scrolling in contradicting ways, you should set only | ||
| 243 | one of them. If you customize both, the value of | ||
| 244 | @code{scroll-conservatively} takes precedence. | ||
| 245 | 242 | ||
| 246 | @cindex aggressive scrolling | 243 | @cindex aggressive scrolling |
| 247 | @vindex scroll-up-aggressively | 244 | @vindex scroll-up-aggressively |
| 248 | @vindex scroll-down-aggressively | 245 | @vindex scroll-down-aggressively |
| 249 | When the window does scroll by a distance longer than | 246 | A third way to control automatic scrolling is to customize the |
| 250 | @code{scroll-step}, you can control how aggressively it scrolls by | 247 | variables @code{scroll-up-aggressively} and |
| 251 | setting the variables @code{scroll-up-aggressively} and | 248 | @code{scroll-down-aggressively}, which directly specify the vertical |
| 252 | @code{scroll-down-aggressively}. The value of | 249 | position of point after scrolling. The value of |
| 253 | @code{scroll-up-aggressively} should be either @code{nil}, or a | 250 | @code{scroll-up-aggressively} should be either @code{nil} (the |
| 254 | fraction @var{f} between 0 and 1. A fraction specifies where on the | 251 | default), or a floating point number @var{f} between 0 and 1. The |
| 255 | screen to put point when scrolling upward, i.e.@: forward. When point | 252 | latter means that when point goes below the bottom window edge (i.e.@: |
| 256 | goes off the window end, the new start position is chosen to put point | 253 | scrolling forward), Emacs scrolls the window so that point is @var{f} |
| 257 | @var{f} parts of the window height from the bottom margin. Thus, | 254 | parts of the window height from the bottom window edge. Thus, larger |
| 258 | larger @var{f} means more aggressive scrolling: more new text is | 255 | @var{f} means more aggressive scrolling: more new text is brought into |
| 259 | brought into view. The default value, @code{nil}, is equivalent to | 256 | view. The default value, @code{nil}, is equivalent to 0.5. |
| 260 | 0.5. | 257 | |
| 261 | 258 | Likewise, @code{scroll-down-aggressively} is used when point goes | |
| 262 | Likewise, @code{scroll-down-aggressively} is used for scrolling | 259 | above the bottom window edge (i.e.@: scrolling backward). The value |
| 263 | down, i.e.@: backward. The value specifies how far point should be | 260 | specifies how far point should be from the top margin of the window |
| 264 | placed from the top margin of the window; thus, as with | 261 | after scrolling. Thus, as with @code{scroll-up-aggressively}, a |
| 265 | @code{scroll-up-aggressively}, a larger value is more aggressive. | 262 | larger value is more aggressive. |
| 266 | 263 | ||
| 267 | These two variables are ignored if either @code{scroll-step} or | 264 | Note that the variables @code{scroll-conservatively}, |
| 268 | @code{scroll-conservatively} are set to a non-zero value. | 265 | @code{scroll-step}, and @code{scroll-up-aggressively} / |
| 266 | @code{scroll-down-aggressively} control automatic scrolling in | ||
| 267 | contradictory ways. Therefore, you should pick no more than one of | ||
| 268 | these methods to customize automatic scrolling. In case you customize | ||
| 269 | multiple variables, the order of priority is: | ||
| 270 | @code{scroll-conservatively}, then @code{scroll-step}, and finally | ||
| 271 | @code{scroll-up-aggressively} / @code{scroll-down-aggressively}. | ||
| 269 | 272 | ||
| 270 | @vindex scroll-margin | 273 | @vindex scroll-margin |
| 271 | The variable @code{scroll-margin} restricts how close point can come | 274 | The variable @code{scroll-margin} restricts how close point can come |
| @@ -295,10 +298,10 @@ the cursor is left at the edge instead.) | |||
| 295 | 298 | ||
| 296 | @vindex hscroll-margin | 299 | @vindex hscroll-margin |
| 297 | The variable @code{hscroll-margin} controls how close point can get | 300 | The variable @code{hscroll-margin} controls how close point can get |
| 298 | to the window's edges before automatic scrolling occurs. It is | 301 | to the window's left and right edges before automatic scrolling |
| 299 | measured in columns. For example, if the value is 5, then moving | 302 | occurs. It is measured in columns. For example, if the value is 5, |
| 300 | point within 5 columns of an edge causes horizontal scrolling away | 303 | then moving point within 5 columns of an edge causes horizontal |
| 301 | from that edge. | 304 | scrolling away from that edge. |
| 302 | 305 | ||
| 303 | @vindex hscroll-step | 306 | @vindex hscroll-step |
| 304 | The variable @code{hscroll-step} determines how many columns to | 307 | The variable @code{hscroll-step} determines how many columns to |
diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index a5295adc368..99e21bac469 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog | |||
| @@ -1,3 +1,25 @@ | |||
| 1 | 2012-11-21 Glenn Morris <rgm@gnu.org> | ||
| 2 | |||
| 3 | * display.texi (Attribute Functions): | ||
| 4 | Update for set-face-* name changes. | ||
| 5 | Add new "inherit" argument for face-bold-p etc. | ||
| 6 | Move description of this argument to a common section, like "frame". | ||
| 7 | |||
| 8 | * debugging.texi (Profiling): New section. | ||
| 9 | (Debugging): Mention profiling in the introduction. | ||
| 10 | * tips.texi (Compilation Tips): Move profiling to separate section. | ||
| 11 | * elisp.texi: Add Profiling to detailed menu. | ||
| 12 | |||
| 13 | 2012-11-21 Martin Rudalics <rudalics@gmx.at> | ||
| 14 | |||
| 15 | * windows.texi (Display Action Functions): Fix recently added | ||
| 16 | example. Suggested by Michael Heerdegen. | ||
| 17 | |||
| 18 | 2012-11-21 Paul Eggert <eggert@cs.ucla.edu> | ||
| 19 | |||
| 20 | Minor cleanup for times as lists of four integers. | ||
| 21 | * os.texi (Time Parsing): Time values can now be four integers. | ||
| 22 | |||
| 1 | 2012-11-18 Glenn Morris <rgm@gnu.org> | 23 | 2012-11-18 Glenn Morris <rgm@gnu.org> |
| 2 | 24 | ||
| 3 | * loading.texi (How Programs Do Loading): Add eager macro expansion. | 25 | * loading.texi (How Programs Do Loading): Add eager macro expansion. |
diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index 11532b19781..3439a8ae152 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi | |||
| @@ -32,6 +32,9 @@ program. | |||
| 32 | @item | 32 | @item |
| 33 | You can use the ERT package to write regression tests for the program. | 33 | You can use the ERT package to write regression tests for the program. |
| 34 | @xref{Top,the ERT manual,, ERT, ERT: Emacs Lisp Regression Testing}. | 34 | @xref{Top,the ERT manual,, ERT, ERT: Emacs Lisp Regression Testing}. |
| 35 | |||
| 36 | @item | ||
| 37 | You can profile the program to get hints about how to make it more efficient. | ||
| 35 | @end itemize | 38 | @end itemize |
| 36 | 39 | ||
| 37 | Other useful tools for debugging input and output problems are the | 40 | Other useful tools for debugging input and output problems are the |
| @@ -43,6 +46,7 @@ function (@pxref{Terminal Output}). | |||
| 43 | * Edebug:: A source-level Emacs Lisp debugger. | 46 | * Edebug:: A source-level Emacs Lisp debugger. |
| 44 | * Syntax Errors:: How to find syntax errors. | 47 | * Syntax Errors:: How to find syntax errors. |
| 45 | * Test Coverage:: Ensuring you have tested all branches in your code. | 48 | * Test Coverage:: Ensuring you have tested all branches in your code. |
| 49 | * Profiling:: Measuring the resources that your code uses. | ||
| 46 | @end menu | 50 | @end menu |
| 47 | 51 | ||
| 48 | @node Debugger | 52 | @node Debugger |
| @@ -809,3 +813,63 @@ never return. If it ever does return, you get a run-time error. | |||
| 809 | Edebug also has a coverage testing feature (@pxref{Coverage | 813 | Edebug also has a coverage testing feature (@pxref{Coverage |
| 810 | Testing}). These features partly duplicate each other, and it would | 814 | Testing}). These features partly duplicate each other, and it would |
| 811 | be cleaner to combine them. | 815 | be cleaner to combine them. |
| 816 | |||
| 817 | |||
| 818 | @node Profiling | ||
| 819 | @section Profiling | ||
| 820 | @cindex profiling | ||
| 821 | @cindex measuring resource usage | ||
| 822 | @cindex memory usage | ||
| 823 | |||
| 824 | If your program is working correctly, but you want to make it run more | ||
| 825 | quickly or efficiently, the first thing to do is @dfn{profile} your | ||
| 826 | code so that you know how it is using resources. If you find that one | ||
| 827 | particular function is responsible for a significant portion of the | ||
| 828 | runtime, you can start looking for ways to optimize that piece. | ||
| 829 | |||
| 830 | Emacs has built-in support for this. To begin profiling, type | ||
| 831 | @kbd{M-x profiler-start}. You can choose to profile by processor | ||
| 832 | usage, memory usage, or both. After doing some work, type | ||
| 833 | @kbd{M-x profiler-report} to display a summary buffer for each | ||
| 834 | resource that you chose to profile. The names of the report buffers | ||
| 835 | include the times at which the reports were generated, so you can | ||
| 836 | generate another report later on without erasing previous results. | ||
| 837 | When you have finished profiling, type @kbd{M-x profiler-stop} (there | ||
| 838 | is a small overhead associated with profiling). | ||
| 839 | |||
| 840 | The profiler report buffer shows, on each line, a function that was | ||
| 841 | called, followed by how much resource (processor or memory) it used in | ||
| 842 | absolute and percentage times since profiling started. If a given | ||
| 843 | line has a @samp{+} symbol at the left-hand side, you can expand that | ||
| 844 | line by typing @key{RET}, in order to see the function(s) called by | ||
| 845 | the higher-level function. Pressing @key{RET} again will collapse | ||
| 846 | back to the original state. | ||
| 847 | |||
| 848 | Press @kbd{j} or @kbd{mouse-2} to jump to the definition of a function. | ||
| 849 | Press @kbd{d} to view a function's documentation. | ||
| 850 | You can save a profile to a file using @kbd{C-x C-w}. | ||
| 851 | You can compare two profiles using @kbd{=}. | ||
| 852 | |||
| 853 | @c FIXME reversed calltree? | ||
| 854 | |||
| 855 | @cindex @file{elp.el} | ||
| 856 | @cindex timing programs | ||
| 857 | The @file{elp} library offers an alternative approach. See the file | ||
| 858 | @file{elp.el} for instructions. | ||
| 859 | |||
| 860 | @cindex @file{benchmark.el} | ||
| 861 | @cindex benchmarking | ||
| 862 | You can check the speed of individual Emacs Lisp forms using the | ||
| 863 | @file{benchmark} library. See the functions @code{benchmark-run} and | ||
| 864 | @code{benchmark-run-compiled} in @file{benchmark.el}. | ||
| 865 | |||
| 866 | @c Not worth putting in the printed manual. | ||
| 867 | @ifnottex | ||
| 868 | @cindex --enable-profiling option of configure | ||
| 869 | For low-level profiling of Emacs itself, you can build it using the | ||
| 870 | @option{--enable-profiling} option of @command{configure}. When Emacs | ||
| 871 | exits, it generates a file @file{gmon.out} that you can examine using | ||
| 872 | the @command{gprof} utility. This feature is mainly useful for | ||
| 873 | debugging Emacs. It actually stops the Lisp-level @kbd{M-x | ||
| 874 | profiler-@dots{}} commands described above from working. | ||
| 875 | @end ifnottex | ||
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 475a9550f99..5148c6ec22e 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi | |||
| @@ -2425,12 +2425,12 @@ This sets the @code{:stipple} attribute of @var{face} to | |||
| 2425 | This sets the @code{:font} attribute of @var{face} to @var{font}. | 2425 | This sets the @code{:font} attribute of @var{face} to @var{font}. |
| 2426 | @end deffn | 2426 | @end deffn |
| 2427 | 2427 | ||
| 2428 | @defun set-face-bold-p face bold-p &optional frame | 2428 | @defun set-face-bold face bold-p &optional frame |
| 2429 | This sets the @code{:weight} attribute of @var{face} to @var{normal} | 2429 | This sets the @code{:weight} attribute of @var{face} to @var{normal} |
| 2430 | if @var{bold-p} is @code{nil}, and to @var{bold} otherwise. | 2430 | if @var{bold-p} is @code{nil}, and to @var{bold} otherwise. |
| 2431 | @end defun | 2431 | @end defun |
| 2432 | 2432 | ||
| 2433 | @defun set-face-italic-p face italic-p &optional frame | 2433 | @defun set-face-italic face italic-p &optional frame |
| 2434 | This sets the @code{:slant} attribute of @var{face} to @var{normal} if | 2434 | This sets the @code{:slant} attribute of @var{face} to @var{normal} if |
| 2435 | @var{italic-p} is @code{nil}, and to @var{italic} otherwise. | 2435 | @var{italic-p} is @code{nil}, and to @var{italic} otherwise. |
| 2436 | @end defun | 2436 | @end defun |
| @@ -2440,7 +2440,7 @@ This sets the @code{:underline} attribute of @var{face} to | |||
| 2440 | @var{underline}. | 2440 | @var{underline}. |
| 2441 | @end defun | 2441 | @end defun |
| 2442 | 2442 | ||
| 2443 | @defun set-face-inverse-video-p face inverse-video-p &optional frame | 2443 | @defun set-face-inverse-video face inverse-video-p &optional frame |
| 2444 | This sets the @code{:inverse-video} attribute of @var{face} to | 2444 | This sets the @code{:inverse-video} attribute of @var{face} to |
| 2445 | @var{inverse-video-p}. | 2445 | @var{inverse-video-p}. |
| 2446 | @end defun | 2446 | @end defun |
| @@ -2453,59 +2453,48 @@ This swaps the foreground and background colors of face @var{face}. | |||
| 2453 | don't specify @var{frame}, they refer to the selected frame; @code{t} | 2453 | don't specify @var{frame}, they refer to the selected frame; @code{t} |
| 2454 | refers to the default data for new frames. They return the symbol | 2454 | refers to the default data for new frames. They return the symbol |
| 2455 | @code{unspecified} if the face doesn't define any value for that | 2455 | @code{unspecified} if the face doesn't define any value for that |
| 2456 | attribute. | 2456 | attribute. If @var{inherit} is @code{nil}, only an attribute directly |
| 2457 | defined by the face is returned. If @var{inherit} is non-@code{nil}, | ||
| 2458 | any faces specified by its @code{:inherit} attribute are considered as | ||
| 2459 | well, and if @var{inherit} is a face or a list of faces, then they are | ||
| 2460 | also considered, until a specified attribute is found. To ensure that | ||
| 2461 | the return value is always specified, use a value of @code{default} for | ||
| 2462 | @var{inherit}. | ||
| 2463 | |||
| 2464 | @defun face-font face &optional frame | ||
| 2465 | This function returns the name of the font of face @var{face}. | ||
| 2466 | @end defun | ||
| 2457 | 2467 | ||
| 2458 | @defun face-foreground face &optional frame inherit | 2468 | @defun face-foreground face &optional frame inherit |
| 2459 | @defunx face-background face &optional frame inherit | 2469 | @defunx face-background face &optional frame inherit |
| 2460 | These functions return the foreground color (or background color, | 2470 | These functions return the foreground color (or background color, |
| 2461 | respectively) of face @var{face}, as a string. | 2471 | respectively) of face @var{face}, as a string. |
| 2462 | |||
| 2463 | If @var{inherit} is @code{nil}, only a color directly defined by the face is | ||
| 2464 | returned. If @var{inherit} is non-@code{nil}, any faces specified by its | ||
| 2465 | @code{:inherit} attribute are considered as well, and if @var{inherit} | ||
| 2466 | is a face or a list of faces, then they are also considered, until a | ||
| 2467 | specified color is found. To ensure that the return value is always | ||
| 2468 | specified, use a value of @code{default} for @var{inherit}. | ||
| 2469 | @end defun | 2472 | @end defun |
| 2470 | 2473 | ||
| 2471 | @defun face-stipple face &optional frame inherit | 2474 | @defun face-stipple face &optional frame inherit |
| 2472 | This function returns the name of the background stipple pattern of face | 2475 | This function returns the name of the background stipple pattern of face |
| 2473 | @var{face}, or @code{nil} if it doesn't have one. | 2476 | @var{face}, or @code{nil} if it doesn't have one. |
| 2474 | |||
| 2475 | If @var{inherit} is @code{nil}, only a stipple directly defined by the | ||
| 2476 | face is returned. If @var{inherit} is non-@code{nil}, any faces | ||
| 2477 | specified by its @code{:inherit} attribute are considered as well, and | ||
| 2478 | if @var{inherit} is a face or a list of faces, then they are also | ||
| 2479 | considered, until a specified stipple is found. To ensure that the | ||
| 2480 | return value is always specified, use a value of @code{default} for | ||
| 2481 | @var{inherit}. | ||
| 2482 | @end defun | ||
| 2483 | |||
| 2484 | @defun face-font face &optional frame | ||
| 2485 | This function returns the name of the font of face @var{face}. | ||
| 2486 | @end defun | 2477 | @end defun |
| 2487 | 2478 | ||
| 2488 | @defun face-bold-p face &optional frame | 2479 | @defun face-bold-p face &optional frame inherit |
| 2489 | This function returns a non-@code{nil} value if the @code{:weight} | 2480 | This function returns a non-@code{nil} value if the @code{:weight} |
| 2490 | attribute of @var{face} is bolder than normal (i.e., one of | 2481 | attribute of @var{face} is bolder than normal (i.e., one of |
| 2491 | @code{semi-bold}, @code{bold}, @code{extra-bold}, or | 2482 | @code{semi-bold}, @code{bold}, @code{extra-bold}, or |
| 2492 | @code{ultra-bold}). Otherwise, it returns @code{nil}. | 2483 | @code{ultra-bold}). Otherwise, it returns @code{nil}. |
| 2493 | @end defun | 2484 | @end defun |
| 2494 | 2485 | ||
| 2495 | @defun face-italic-p face &optional frame | 2486 | @defun face-italic-p face &optional frame inherit |
| 2496 | This function returns a non-@code{nil} value if the @code{:slant} | 2487 | This function returns a non-@code{nil} value if the @code{:slant} |
| 2497 | attribute of @var{face} is @code{italic} or @code{oblique}, and | 2488 | attribute of @var{face} is @code{italic} or @code{oblique}, and |
| 2498 | @code{nil} otherwise. | 2489 | @code{nil} otherwise. |
| 2499 | @end defun | 2490 | @end defun |
| 2500 | 2491 | ||
| 2501 | @c Note the weasel words. A face that inherits from an underlined | 2492 | @defun face-underline-p face &optional frame inherit |
| 2502 | @c face but does not specify :underline will return nil. | ||
| 2503 | @defun face-underline-p face &optional frame | ||
| 2504 | This function returns non-@code{nil} if face @var{face} specifies | 2493 | This function returns non-@code{nil} if face @var{face} specifies |
| 2505 | a non-@code{nil} @code{:underline} attribute. | 2494 | a non-@code{nil} @code{:underline} attribute. |
| 2506 | @end defun | 2495 | @end defun |
| 2507 | 2496 | ||
| 2508 | @defun face-inverse-video-p face &optional frame | 2497 | @defun face-inverse-video-p face &optional frame inherit |
| 2509 | This function returns non-@code{nil} if face @var{face} specifies | 2498 | This function returns non-@code{nil} if face @var{face} specifies |
| 2510 | a non-@code{nil} @code{:inverse-video} attribute. | 2499 | a non-@code{nil} @code{:inverse-video} attribute. |
| 2511 | @end defun | 2500 | @end defun |
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index a70558bf09f..cb00b5e9889 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi | |||
| @@ -617,6 +617,7 @@ Debugging Lisp Programs | |||
| 617 | * Edebug:: A source-level Emacs Lisp debugger. | 617 | * Edebug:: A source-level Emacs Lisp debugger. |
| 618 | * Syntax Errors:: How to find syntax errors. | 618 | * Syntax Errors:: How to find syntax errors. |
| 619 | * Test Coverage:: Ensuring you have tested all branches in your code. | 619 | * Test Coverage:: Ensuring you have tested all branches in your code. |
| 620 | * Profiling:: Measuring the resources that your code uses. | ||
| 620 | 621 | ||
| 621 | The Lisp Debugger | 622 | The Lisp Debugger |
| 622 | 623 | ||
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 2f06e207fc4..7552aaccc53 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi | |||
| @@ -1373,8 +1373,8 @@ on others, years as early as 1901 do work. | |||
| 1373 | @node Time Parsing | 1373 | @node Time Parsing |
| 1374 | @section Parsing and Formatting Times | 1374 | @section Parsing and Formatting Times |
| 1375 | 1375 | ||
| 1376 | These functions convert time values (lists of two or three integers) | 1376 | These functions convert time values to text in a string, and vice versa. |
| 1377 | to text in a string, and vice versa. | 1377 | Time values are lists of two to four integers (@pxref{Time of Day}). |
| 1378 | 1378 | ||
| 1379 | @defun date-to-time string | 1379 | @defun date-to-time string |
| 1380 | This function parses the time-string @var{string} and returns the | 1380 | This function parses the time-string @var{string} and returns the |
diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index 4336baa128f..bba416d5614 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi | |||
| @@ -460,18 +460,8 @@ Lisp programs. | |||
| 460 | 460 | ||
| 461 | @itemize @bullet | 461 | @itemize @bullet |
| 462 | @item | 462 | @item |
| 463 | @cindex profiling | 463 | Profile your program, to find out where the time is being spent. |
| 464 | @cindex timing programs | 464 | @xref{Profiling}. |
| 465 | @cindex @file{elp.el} | ||
| 466 | Profile your program with the @file{elp} library. See the file | ||
| 467 | @file{elp.el} for instructions. | ||
| 468 | |||
| 469 | @item | ||
| 470 | @cindex @file{benchmark.el} | ||
| 471 | @cindex benchmarking | ||
| 472 | Check the speed of individual Emacs Lisp forms using the | ||
| 473 | @file{benchmark} library. See the functions @code{benchmark-run} and | ||
| 474 | @code{benchmark-run-compiled} in @file{benchmark.el}. | ||
| 475 | 465 | ||
| 476 | @item | 466 | @item |
| 477 | Use iteration rather than recursion whenever possible. | 467 | Use iteration rather than recursion whenever possible. |
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index b8581b1cc62..e515b24db93 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi | |||
| @@ -2038,7 +2038,8 @@ Evaluating the form above will cause @code{display-buffer} to proceed as | |||
| 2038 | follows: If `*foo*' already appears on a visible or iconified frame, it | 2038 | follows: If `*foo*' already appears on a visible or iconified frame, it |
| 2039 | will reuse its window. Otherwise, it will try to pop up a new window | 2039 | will reuse its window. Otherwise, it will try to pop up a new window |
| 2040 | or, if that is impossible, a new frame. If all these steps fail, it | 2040 | or, if that is impossible, a new frame. If all these steps fail, it |
| 2041 | will try to use some existing window. | 2041 | will proceed using whatever @code{display-buffer-base-action} and |
| 2042 | @code{display-buffer-fallback-action} prescribe. | ||
| 2042 | 2043 | ||
| 2043 | Furthermore, @code{display-buffer} will try to adjust a reused window | 2044 | Furthermore, @code{display-buffer} will try to adjust a reused window |
| 2044 | (provided `*foo*' was put by @code{display-buffer} there before) or a | 2045 | (provided `*foo*' was put by @code{display-buffer} there before) or a |
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 39931f3a779..6be52213a4a 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog | |||
| @@ -1,7 +1,19 @@ | |||
| 1 | 2012-11-22 Paul Eggert <eggert@cs.ucla.edu> | ||
| 2 | |||
| 3 | * calc.texi: Fix TeX issues with capitals followed by ".", "?", "!". | ||
| 4 | (Date Forms): Correct off-by-one error in explanation of | ||
| 5 | Julian day numbers. Give Gregorian equivalent of its origin. | ||
| 6 | |||
| 7 | 2012-11-22 Jay Belanger <jay.p.belanger@gmail.com> | ||
| 8 | |||
| 9 | * doc/misc/calc.texi (Date Forms): Mention the customizable | ||
| 10 | Gregorian-Julian switch. | ||
| 11 | (Customizing Calc): Mention the variable `calc-gregorian-switch'. | ||
| 12 | |||
| 1 | 2012-11-17 Paul Eggert <eggert@cs.ucla.edu> | 13 | 2012-11-17 Paul Eggert <eggert@cs.ucla.edu> |
| 2 | 14 | ||
| 3 | Calc now uses the Gregorian calendar for all dates, | 15 | Calc now uses the Gregorian calendar for all dates (Bug#12633). |
| 4 | and uses January 1, 1 AD as its day number 1. | 16 | It also uses January 1, 1 AD as its day number 1. |
| 5 | * calc.texi (Date Forms): Document this. | 17 | * calc.texi (Date Forms): Document this. |
| 6 | 18 | ||
| 7 | 2012-11-16 Glenn Morris <rgm@gnu.org> | 19 | 2012-11-16 Glenn Morris <rgm@gnu.org> |
diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index 6daceb4d41a..0ce1efbff58 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi | |||
| @@ -1186,7 +1186,7 @@ since the large integer arithmetic was there anyway it seemed only | |||
| 1186 | fair to give the user direct access to it, which in turn made it | 1186 | fair to give the user direct access to it, which in turn made it |
| 1187 | practical to support fractions as well as floats. All these features | 1187 | practical to support fractions as well as floats. All these features |
| 1188 | inspired me to look around for other data types that might be worth | 1188 | inspired me to look around for other data types that might be worth |
| 1189 | having. | 1189 | having. |
| 1190 | 1190 | ||
| 1191 | Around this time, my friend Rick Koshi showed me his nifty new HP-28 | 1191 | Around this time, my friend Rick Koshi showed me his nifty new HP-28 |
| 1192 | calculator. It allowed the user to manipulate formulas as well as | 1192 | calculator. It allowed the user to manipulate formulas as well as |
| @@ -4461,7 +4461,7 @@ date by one or several months. @xref{Date Arithmetic}, for more. | |||
| 4461 | Friday the 13th? @xref{Types Answer 5, 5}. (@bullet{}) | 4461 | Friday the 13th? @xref{Types Answer 5, 5}. (@bullet{}) |
| 4462 | 4462 | ||
| 4463 | (@bullet{}) @strong{Exercise 6.} How many leap years will there be | 4463 | (@bullet{}) @strong{Exercise 6.} How many leap years will there be |
| 4464 | between now and the year 10001 A.D.? @xref{Types Answer 6, 6}. (@bullet{}) | 4464 | between now and the year 10001 AD@? @xref{Types Answer 6, 6}. (@bullet{}) |
| 4465 | 4465 | ||
| 4466 | @cindex Slope and angle of a line | 4466 | @cindex Slope and angle of a line |
| 4467 | @cindex Angle and slope of a line | 4467 | @cindex Angle and slope of a line |
| @@ -5693,7 +5693,7 @@ on the stack, we want to be able to type @kbd{*} and get the result | |||
| 5693 | rearranged. (This one is rather tricky; the solution at the end of | 5693 | rearranged. (This one is rather tricky; the solution at the end of |
| 5694 | this chapter uses 6 rewrite rules. Hint: The @samp{constant(x)} | 5694 | this chapter uses 6 rewrite rules. Hint: The @samp{constant(x)} |
| 5695 | condition tests whether @samp{x} is a number.) @xref{Rewrites Answer | 5695 | condition tests whether @samp{x} is a number.) @xref{Rewrites Answer |
| 5696 | 6, 6}. (@bullet{}) | 5696 | 6, 6}. (@bullet{}) |
| 5697 | 5697 | ||
| 5698 | Just for kicks, try adding the rule @code{2+3 := 6} to @code{EvalRules}. | 5698 | Just for kicks, try adding the rule @code{2+3 := 6} to @code{EvalRules}. |
| 5699 | What happens? (Be sure to remove this rule afterward, or you might get | 5699 | What happens? (Be sure to remove this rule afterward, or you might get |
| @@ -8697,7 +8697,7 @@ Multiplying by the conjugate helps because @expr{(a+b) (a-b) = a^2 - b^2}. | |||
| 8697 | @smallexample | 8697 | @smallexample |
| 8698 | @group | 8698 | @group |
| 8699 | ___ | 8699 | ___ |
| 8700 | 1: V 2 | 8700 | 1: V 2 |
| 8701 | . | 8701 | . |
| 8702 | 8702 | ||
| 8703 | a r a*(b+c) := a*b + a*c | 8703 | a r a*(b+c) := a*b + a*c |
| @@ -8897,7 +8897,7 @@ Note that this rule does not mention @samp{O} at all, so it will | |||
| 8897 | apply to any product-of-sum it encounters---this rule may surprise | 8897 | apply to any product-of-sum it encounters---this rule may surprise |
| 8898 | you if you put it into @code{EvalRules}! | 8898 | you if you put it into @code{EvalRules}! |
| 8899 | 8899 | ||
| 8900 | In the second rule, the sum of two O's is changed to the smaller O. | 8900 | In the second rule, the sum of two O's is changed to the smaller O@. |
| 8901 | The optional constant coefficients are there mostly so that | 8901 | The optional constant coefficients are there mostly so that |
| 8902 | @samp{O(x^2) - O(x^3)} and @samp{O(x^3) - O(x^2)} are handled | 8902 | @samp{O(x^2) - O(x^3)} and @samp{O(x^3) - O(x^2)} are handled |
| 8903 | as well as @samp{O(x^2) + O(x^3)}. | 8903 | as well as @samp{O(x^2) + O(x^3)}. |
| @@ -10987,10 +10987,10 @@ Input is flexible; date forms can be entered in any of the usual | |||
| 10987 | notations for dates and times. @xref{Date Formats}. | 10987 | notations for dates and times. @xref{Date Formats}. |
| 10988 | 10988 | ||
| 10989 | Date forms are stored internally as numbers, specifically the number | 10989 | Date forms are stored internally as numbers, specifically the number |
| 10990 | of days since midnight on the morning of January 1 of the year 1 AD. | 10990 | of days since midnight on the morning of December 31 of the year 1 BC@. |
| 10991 | If the internal number is an integer, the form represents a date only; | 10991 | If the internal number is an integer, the form represents a date only; |
| 10992 | if the internal number is a fraction or float, the form represents | 10992 | if the internal number is a fraction or float, the form represents |
| 10993 | a date and time. For example, @samp{<6:00am Wed Jan 9, 1991>} | 10993 | a date and time. For example, @samp{<6:00am Thu Jan 10, 1991>} |
| 10994 | is represented by the number 726842.25. The standard precision of | 10994 | is represented by the number 726842.25. The standard precision of |
| 10995 | 12 decimal digits is enough to ensure that a (reasonable) date and | 10995 | 12 decimal digits is enough to ensure that a (reasonable) date and |
| 10996 | time can be stored without roundoff error. | 10996 | time can be stored without roundoff error. |
| @@ -11010,55 +11010,70 @@ You can use the @kbd{v p} (@code{calc-pack}) and @kbd{v u} | |||
| 11010 | of a date form. @xref{Packing and Unpacking}. | 11010 | of a date form. @xref{Packing and Unpacking}. |
| 11011 | 11011 | ||
| 11012 | Date forms can go arbitrarily far into the future or past. Negative | 11012 | Date forms can go arbitrarily far into the future or past. Negative |
| 11013 | year numbers represent years BC. There is no ``year 0''; the day | 11013 | year numbers represent years BC@. There is no ``year 0''; the day |
| 11014 | before @samp{<Mon Jan 1, +1>} is @samp{<Sun Dec 31, -1>}. These are | 11014 | before @samp{<Mon Jan 1, +1>} is @samp{<Sun Dec 31, -1>}. These are |
| 11015 | days 1 and 0 respectively in Calc's internal numbering scheme. The | 11015 | days 1 and 0 respectively in Calc's internal numbering scheme. The |
| 11016 | Gregorian calendar is used for all dates, including dates before the | 11016 | Gregorian calendar is used for all dates, including dates before the |
| 11017 | Gregorian calendar was invented. Thus Calc's use of the day number | 11017 | Gregorian calendar was invented (although that can be configured; see |
| 11018 | @mathit{-10000} to represent August 15, 28 BC should be taken with a | 11018 | below). Thus Calc's use of the day number @mathit{-10000} to |
| 11019 | grain of salt. | 11019 | represent August 15, 28 BC should be taken with a grain of salt. |
| 11020 | 11020 | ||
| 11021 | @cindex Julian calendar | 11021 | @cindex Julian calendar |
| 11022 | @cindex Gregorian calendar | 11022 | @cindex Gregorian calendar |
| 11023 | Some historical background: The Julian calendar was created by | 11023 | Some historical background: The Julian calendar was created by |
| 11024 | Julius Caesar in the year 46 BC as an attempt to fix the confusion | 11024 | Julius Caesar in the year 46 BC as an attempt to fix the confusion |
| 11025 | caused by the irregular Roman calendar that was used before that time. | 11025 | caused by the irregular Roman calendar that was used before that time. |
| 11026 | The Julian calendar introduced an extra day in | 11026 | The Julian calendar introduced an extra day in all years divisible by |
| 11027 | all years divisible by four. After some initial confusion, the | 11027 | four. After some initial confusion, the calendar was adopted around |
| 11028 | calendar was adopted around the year we call 8 AD, although the years were | 11028 | the year we call 8 AD@. Some centuries later it became |
| 11029 | numbered differently and did not necessarily begin on January 1. Some centuries | 11029 | apparent that the Julian year of 365.25 days was itself not quite |
| 11030 | later it became apparent that the Julian year of 365.25 days was | 11030 | right. In 1582 Pope Gregory XIII introduced the Gregorian calendar, |
| 11031 | itself not quite right. In 1582 Pope Gregory XIII introduced the | 11031 | which added the new rule that years divisible by 100, but not by 400, |
| 11032 | Gregorian calendar, which added the new rule that years divisible | 11032 | were not to be considered leap years despite being divisible by four. |
| 11033 | by 100, but not by 400, were not to be considered leap years | 11033 | Many countries delayed adoption of the Gregorian calendar |
| 11034 | despite being divisible by four. Many countries delayed adoption | 11034 | because of religious differences. For example, Great Britain and the |
| 11035 | of the Gregorian calendar because of religious differences, and | 11035 | British colonies switched to the Gregorian calendar in September |
| 11036 | used differing year numbers and start-of-year for other reasons; | 11036 | 1752, when the Julian calendar was eleven days behind the |
| 11037 | for example, in early 1752 England changed the start of its year from | 11037 | Gregorian calendar. That year in Britain, the day after September 2 |
| 11038 | March 25 to January 1, and in September it switched to the Gregorian | 11038 | was September 14. To take another example, Russia did not adopt the |
| 11039 | calendar: in England, the day after December 31, 1750 was January 1, | 11039 | Gregorian calendar until 1918, and that year in Russia the day after |
| 11040 | 1750 and the day after March 24, 1750 was March 25, 1751, but the day | 11040 | January 31 was February 14. Calc's reckoning therefore matches English |
| 11041 | after December 31, 1751 was January 1, 1752 and the day after | 11041 | practice starting in 1752 and Russian practice starting in 1918, but |
| 11042 | September 2, 1752 was September 14, 1752. To take another example, | 11042 | disagrees with earlier dates in both countries. |
| 11043 | Russia switched both year numbering and start-of-year in 1700, but did | 11043 | |
| 11044 | not adopt the Gregorian calendar until 1918. Calc's reckoning | 11044 | When the Julian calendar was introduced, it had January 1 as the first |
| 11045 | therefore matches English practice starting in 1752 and Russian | 11045 | day of the year. By the Middle Ages, many European countries |
| 11046 | practice starting in 1918, but disagrees with earlier dates in both | 11046 | had changed the beginning of a new year to a different date, often to |
| 11047 | countries. | 11047 | a religious festival. Almost all countries reverted to using January 1 |
| 11048 | 11048 | as the beginning of the year by the time they adopted the Gregorian | |
| 11049 | Today's timekeepers introduce an occasional ``leap second'' as | 11049 | calendar. |
| 11050 | well, but Calc does not take these minor effects into account. | 11050 | |
| 11051 | (If it did, it would have to report a non-integer number of days | 11051 | Some calendars attempt to mimic the historical situation by using the |
| 11052 | between, say, @samp{<12:00am Mon Jan 1, 1900>} and | 11052 | Gregorian calendar for recent dates and the Julian calendar for older |
| 11053 | dates. The @code{cal} program in most Unix implementations does this, | ||
| 11054 | for example. While January 1 wasn't always the beginning of a calendar | ||
| 11055 | year, these hybrid calendars still use January 1 as the beginning of | ||
| 11056 | the year even for older dates. The customizable variable | ||
| 11057 | @code{calc-gregorian-switch} (@pxref{Customizing Calc}) can be set to | ||
| 11058 | have Calc's date forms switch from the Julian to Gregorian calendar at | ||
| 11059 | any specified date. | ||
| 11060 | |||
| 11061 | Today's timekeepers introduce an occasional ``leap second''. | ||
| 11062 | These do not occur regularly and Calc does not take these minor | ||
| 11063 | effects into account. (If it did, it would have to report a | ||
| 11064 | non-integer number of days between, say, | ||
| 11065 | @samp{<12:00am Mon Jan 1, 1900>} and | ||
| 11053 | @samp{<12:00am Sat Jan 1, 2000>}.) | 11066 | @samp{<12:00am Sat Jan 1, 2000>}.) |
| 11054 | 11067 | ||
| 11055 | @cindex Julian day counting | 11068 | @cindex Julian day counting |
| 11056 | Another day counting system in common use is, confusingly, also called | 11069 | Another day counting system in common use is, confusingly, also called |
| 11057 | ``Julian.'' The Julian day number is the numbers of days since | 11070 | ``Julian.'' Julian days go from noon to noon. The Julian day number |
| 11058 | 12:00 noon (GMT) on Jan 1, 4713 BC, which in Calc's scheme (in GMT) | 11071 | is the numbers of days since 12:00 noon (GMT) on November 24, 4714 BC |
| 11059 | is @mathit{-1721423.5} (recall that Calc starts at midnight instead | 11072 | in the Gregorian calendar (i.e., January 1, 4713 BC in the Julian |
| 11060 | of noon). Thus to convert a Calc date code obtained by unpacking a | 11073 | calendar). In Calc's scheme (in GMT) the Julian day origin is |
| 11061 | date form into a Julian day number, simply add 1721423.5 after | 11074 | @mathit{-1721422.5}, because Calc starts at midnight instead of noon. |
| 11075 | Thus to convert a Calc date code obtained by unpacking a | ||
| 11076 | date form into a Julian day number, simply add 1721422.5 after | ||
| 11062 | compensating for the time zone difference. The built-in @kbd{t J} | 11077 | compensating for the time zone difference. The built-in @kbd{t J} |
| 11063 | command performs this conversion for you. | 11078 | command performs this conversion for you. |
| 11064 | 11079 | ||
| @@ -11090,7 +11105,7 @@ the Julian cycle as an astronomical dating system; this idea was taken | |||
| 11090 | up by other astronomers. (At the time, noon was the start of the | 11105 | up by other astronomers. (At the time, noon was the start of the |
| 11091 | astronomical day. Herschel originally suggested counting the days | 11106 | astronomical day. Herschel originally suggested counting the days |
| 11092 | since Jan 1, 4713 BC at noon Alexandria time; this was later amended to | 11107 | since Jan 1, 4713 BC at noon Alexandria time; this was later amended to |
| 11093 | noon GMT.) Julian day numbering is largely used in astronomy. | 11108 | noon GMT@.) Julian day numbering is largely used in astronomy. |
| 11094 | 11109 | ||
| 11095 | @cindex Unix time format | 11110 | @cindex Unix time format |
| 11096 | The Unix operating system measures time as an integer number of | 11111 | The Unix operating system measures time as an integer number of |
| @@ -12638,7 +12653,7 @@ are simplified with their unit definitions in mind. | |||
| 12638 | A common technique is to set the simplification mode down to the lowest | 12653 | A common technique is to set the simplification mode down to the lowest |
| 12639 | amount of simplification you will allow to be applied automatically, then | 12654 | amount of simplification you will allow to be applied automatically, then |
| 12640 | use manual commands like @kbd{a s} and @kbd{c c} (@code{calc-clean}) to | 12655 | use manual commands like @kbd{a s} and @kbd{c c} (@code{calc-clean}) to |
| 12641 | perform higher types of simplifications on demand. | 12656 | perform higher types of simplifications on demand. |
| 12642 | @node Declarations, Display Modes, Simplification Modes, Mode Settings | 12657 | @node Declarations, Display Modes, Simplification Modes, Mode Settings |
| 12643 | @section Declarations | 12658 | @section Declarations |
| 12644 | 12659 | ||
| @@ -12989,7 +13004,7 @@ The @code{dneg} function checks for negative reals. The @code{dnonneg} | |||
| 12989 | function checks for nonnegative reals, i.e., reals greater than or | 13004 | function checks for nonnegative reals, i.e., reals greater than or |
| 12990 | equal to zero. Note that Calc's algebraic simplifications, which are | 13005 | equal to zero. Note that Calc's algebraic simplifications, which are |
| 12991 | effectively applied to all conditions in rewrite rules, can simplify | 13006 | effectively applied to all conditions in rewrite rules, can simplify |
| 12992 | an expression like @expr{x > 0} to 1 or 0 using @code{dpos}. | 13007 | an expression like @expr{x > 0} to 1 or 0 using @code{dpos}. |
| 12993 | So the actual functions @code{dpos}, @code{dneg}, and @code{dnonneg} | 13008 | So the actual functions @code{dpos}, @code{dneg}, and @code{dnonneg} |
| 12994 | are rarely necessary. | 13009 | are rarely necessary. |
| 12995 | 13010 | ||
| @@ -13424,7 +13439,7 @@ the time part. The punctuation characters (including spaces) must | |||
| 13424 | match exactly; letter fields must correspond to suitable text in | 13439 | match exactly; letter fields must correspond to suitable text in |
| 13425 | the input. If this doesn't work, Calc checks if the input is a | 13440 | the input. If this doesn't work, Calc checks if the input is a |
| 13426 | simple number; if so, the number is interpreted as a number of days | 13441 | simple number; if so, the number is interpreted as a number of days |
| 13427 | since Jan 1, 1 AD. Otherwise, Calc tries a much more relaxed and | 13442 | since Jan 1, 1 AD@. Otherwise, Calc tries a much more relaxed and |
| 13428 | flexible algorithm which is described in the next section. | 13443 | flexible algorithm which is described in the next section. |
| 13429 | 13444 | ||
| 13430 | Weekday names are ignored during reading. | 13445 | Weekday names are ignored during reading. |
| @@ -14653,7 +14668,7 @@ Subscripts use double square brackets: @samp{a[[i]]}. | |||
| 14653 | The @kbd{d W} (@code{calc-maple-language}) command selects the | 14668 | The @kbd{d W} (@code{calc-maple-language}) command selects the |
| 14654 | conventions of Maple. | 14669 | conventions of Maple. |
| 14655 | 14670 | ||
| 14656 | Maple's language is much like C. Underscores are allowed in symbol | 14671 | Maple's language is much like C@. Underscores are allowed in symbol |
| 14657 | names; square brackets are used for subscripts; explicit @samp{*}s for | 14672 | names; square brackets are used for subscripts; explicit @samp{*}s for |
| 14658 | multiplications are required. Use either @samp{^} or @samp{**} to | 14673 | multiplications are required. Use either @samp{^} or @samp{**} to |
| 14659 | denote powers. | 14674 | denote powers. |
| @@ -16714,7 +16729,7 @@ number (i.e., pervasively). | |||
| 16714 | If the simplification mode is set below basic simplification, it is raised | 16729 | If the simplification mode is set below basic simplification, it is raised |
| 16715 | for the purposes of this command. Thus, @kbd{c c} applies the basic | 16730 | for the purposes of this command. Thus, @kbd{c c} applies the basic |
| 16716 | simplifications even if their automatic application is disabled. | 16731 | simplifications even if their automatic application is disabled. |
| 16717 | @xref{Simplification Modes}. | 16732 | @xref{Simplification Modes}. |
| 16718 | 16733 | ||
| 16719 | @cindex Roundoff errors, correcting | 16734 | @cindex Roundoff errors, correcting |
| 16720 | A numeric prefix argument to @kbd{c c} sets the floating-point precision | 16735 | A numeric prefix argument to @kbd{c c} sets the floating-point precision |
| @@ -16791,7 +16806,7 @@ additional argument from the top of the stack. | |||
| 16791 | @pindex calc-date | 16806 | @pindex calc-date |
| 16792 | @tindex date | 16807 | @tindex date |
| 16793 | The @kbd{t D} (@code{calc-date}) [@code{date}] command converts a | 16808 | The @kbd{t D} (@code{calc-date}) [@code{date}] command converts a |
| 16794 | date form into a number, measured in days since Jan 1, 1 AD. The | 16809 | date form into a number, measured in days since Jan 1, 1 AD@. The |
| 16795 | result will be an integer if @var{date} is a pure date form, or a | 16810 | result will be an integer if @var{date} is a pure date form, or a |
| 16796 | fraction or float if @var{date} is a date/time form. Or, if its | 16811 | fraction or float if @var{date} is a date/time form. Or, if its |
| 16797 | argument is a number, it converts this number into a date form. | 16812 | argument is a number, it converts this number into a date form. |
| @@ -16829,7 +16844,7 @@ The last two arguments default to zero if omitted. | |||
| 16829 | @cindex Julian day counts, conversions | 16844 | @cindex Julian day counts, conversions |
| 16830 | The @kbd{t J} (@code{calc-julian}) [@code{julian}] command converts | 16845 | The @kbd{t J} (@code{calc-julian}) [@code{julian}] command converts |
| 16831 | a date form into a Julian day count, which is the number of days | 16846 | a date form into a Julian day count, which is the number of days |
| 16832 | since noon (GMT) on Jan 1, 4713 BC. A pure date is converted to an | 16847 | since noon (GMT) on Jan 1, 4713 BC@. A pure date is converted to an |
| 16833 | integer Julian count representing noon of that day. A date/time form | 16848 | integer Julian count representing noon of that day. A date/time form |
| 16834 | is converted to an exact floating-point Julian count, adjusted to | 16849 | is converted to an exact floating-point Julian count, adjusted to |
| 16835 | interpret the date form in the current time zone but the Julian | 16850 | interpret the date form in the current time zone but the Julian |
| @@ -18975,7 +18990,7 @@ modulo operation as numbers 39 and below.) If @var{m} is a power of | |||
| 18975 | ten, however, the numbers should be completely unbiased. | 18990 | ten, however, the numbers should be completely unbiased. |
| 18976 | 18991 | ||
| 18977 | The Gaussian random numbers generated by @samp{random(0.0)} use the | 18992 | The Gaussian random numbers generated by @samp{random(0.0)} use the |
| 18978 | ``polar'' method described in Knuth section 3.4.1C. This method | 18993 | ``polar'' method described in Knuth section 3.4.1C@. This method |
| 18979 | generates a pair of Gaussian random numbers at a time, so only every | 18994 | generates a pair of Gaussian random numbers at a time, so only every |
| 18980 | other call to @samp{random(0.0)} will require significant calculations. | 18995 | other call to @samp{random(0.0)} will require significant calculations. |
| 18981 | 18996 | ||
| @@ -22175,7 +22190,7 @@ Use @kbd{a v} if you want the variables to ignore their stored values. | |||
| 22175 | If you give a numeric prefix argument of 2 to @kbd{a v}, it simplifies | 22190 | If you give a numeric prefix argument of 2 to @kbd{a v}, it simplifies |
| 22176 | using Calc's algebraic simplifications; @pxref{Simplifying Formulas}. | 22191 | using Calc's algebraic simplifications; @pxref{Simplifying Formulas}. |
| 22177 | If you give a numeric prefix of 3 or more, it uses Extended | 22192 | If you give a numeric prefix of 3 or more, it uses Extended |
| 22178 | Simplification mode (@kbd{a e}). | 22193 | Simplification mode (@kbd{a e}). |
| 22179 | 22194 | ||
| 22180 | If you give a negative prefix argument @mathit{-1}, @mathit{-2}, or @mathit{-3}, | 22195 | If you give a negative prefix argument @mathit{-1}, @mathit{-2}, or @mathit{-3}, |
| 22181 | it simplifies in the corresponding mode but only works on the top-level | 22196 | it simplifies in the corresponding mode but only works on the top-level |
| @@ -22248,7 +22263,7 @@ If inequalities with opposite direction (e.g., @samp{<} and @samp{>}) | |||
| 22248 | are mapped, the direction of the second inequality is reversed to | 22263 | are mapped, the direction of the second inequality is reversed to |
| 22249 | match the first: Using @kbd{a M +} on @samp{a < b} and @samp{a > 2} | 22264 | match the first: Using @kbd{a M +} on @samp{a < b} and @samp{a > 2} |
| 22250 | reverses the latter to get @samp{2 < a}, which then allows the | 22265 | reverses the latter to get @samp{2 < a}, which then allows the |
| 22251 | combination @samp{a + 2 < b + a}, which the algebraic simplifications | 22266 | combination @samp{a + 2 < b + a}, which the algebraic simplifications |
| 22252 | can reduce to @samp{2 < b}. | 22267 | can reduce to @samp{2 < b}. |
| 22253 | 22268 | ||
| 22254 | Using @kbd{a M *}, @kbd{a M /}, @kbd{a M n}, or @kbd{a M &} to negate | 22269 | Using @kbd{a M *}, @kbd{a M /}, @kbd{a M n}, or @kbd{a M &} to negate |
| @@ -22395,7 +22410,7 @@ common special case of regular arithmetic commands like @kbd{+} and | |||
| 22395 | @kbd{Q} [@code{sqrt}], the arguments are simply popped from the stack | 22410 | @kbd{Q} [@code{sqrt}], the arguments are simply popped from the stack |
| 22396 | and collected into a suitable function call, which is then simplified | 22411 | and collected into a suitable function call, which is then simplified |
| 22397 | (the arguments being simplified first as part of the process, as | 22412 | (the arguments being simplified first as part of the process, as |
| 22398 | described above). | 22413 | described above). |
| 22399 | 22414 | ||
| 22400 | Even the basic set of simplifications are too numerous to describe | 22415 | Even the basic set of simplifications are too numerous to describe |
| 22401 | completely here, but this section will describe the ones that apply to the | 22416 | completely here, but this section will describe the ones that apply to the |
| @@ -22701,7 +22716,7 @@ the algebraic simplification mode, which is the default simplification | |||
| 22701 | mode. If you have switched to a different simplification mode, you can | 22716 | mode. If you have switched to a different simplification mode, you can |
| 22702 | switch back with the @kbd{m A} command. Even in other simplification | 22717 | switch back with the @kbd{m A} command. Even in other simplification |
| 22703 | modes, the @kbd{a s} command will use these algebraic simplifications to | 22718 | modes, the @kbd{a s} command will use these algebraic simplifications to |
| 22704 | simplify the formula. | 22719 | simplify the formula. |
| 22705 | 22720 | ||
| 22706 | There is a variable, @code{AlgSimpRules}, in which you can put rewrites | 22721 | There is a variable, @code{AlgSimpRules}, in which you can put rewrites |
| 22707 | to be applied. Its use is analogous to @code{EvalRules}, | 22722 | to be applied. Its use is analogous to @code{EvalRules}, |
| @@ -22738,7 +22753,7 @@ This allows easier comparison of products; for example, the basic | |||
| 22738 | simplifications will not change @expr{x y + y x} to @expr{2 x y}, | 22753 | simplifications will not change @expr{x y + y x} to @expr{2 x y}, |
| 22739 | but the algebraic simplifications; it first rewrites the sum to | 22754 | but the algebraic simplifications; it first rewrites the sum to |
| 22740 | @expr{x y + x y} which can then be recognized as a sum of identical | 22755 | @expr{x y + x y} which can then be recognized as a sum of identical |
| 22741 | terms. | 22756 | terms. |
| 22742 | 22757 | ||
| 22743 | The canonical ordering used to sort terms of products has the | 22758 | The canonical ordering used to sort terms of products has the |
| 22744 | property that real-valued numbers, interval forms and infinities | 22759 | property that real-valued numbers, interval forms and infinities |
| @@ -22781,10 +22796,10 @@ factor in the numerator and denominator, it is canceled out; | |||
| 22781 | for example, @expr{(4 x + 6) / 8 x} simplifies to @expr{(2 x + 3) / 4 x}. | 22796 | for example, @expr{(4 x + 6) / 8 x} simplifies to @expr{(2 x + 3) / 4 x}. |
| 22782 | 22797 | ||
| 22783 | Non-constant common factors are not found even by algebraic | 22798 | Non-constant common factors are not found even by algebraic |
| 22784 | simplifications. To cancel the factor @expr{a} in | 22799 | simplifications. To cancel the factor @expr{a} in |
| 22785 | @expr{(a x + a) / a^2} you could first use @kbd{j M} on the product | 22800 | @expr{(a x + a) / a^2} you could first use @kbd{j M} on the product |
| 22786 | @expr{a x} to Merge the numerator to @expr{a (1+x)}, which can then be | 22801 | @expr{a x} to Merge the numerator to @expr{a (1+x)}, which can then be |
| 22787 | simplified successfully. | 22802 | simplified successfully. |
| 22788 | 22803 | ||
| 22789 | @tex | 22804 | @tex |
| 22790 | \bigskip | 22805 | \bigskip |
| @@ -22937,7 +22952,7 @@ as is @expr{x^2 >= 0} if @expr{x} is known to be real. | |||
| 22937 | @tindex esimplify | 22952 | @tindex esimplify |
| 22938 | Calc is capable of performing some simplifications which may sometimes | 22953 | Calc is capable of performing some simplifications which may sometimes |
| 22939 | be desired but which are not ``safe'' in all cases. The @kbd{a e} | 22954 | be desired but which are not ``safe'' in all cases. The @kbd{a e} |
| 22940 | (@code{calc-simplify-extended}) [@code{esimplify}] command | 22955 | (@code{calc-simplify-extended}) [@code{esimplify}] command |
| 22941 | applies the algebraic simplifications as well as these extended, or | 22956 | applies the algebraic simplifications as well as these extended, or |
| 22942 | ``unsafe'', simplifications. Use this only if you know the values in | 22957 | ``unsafe'', simplifications. Use this only if you know the values in |
| 22943 | your formula lie in the restricted ranges for which these | 22958 | your formula lie in the restricted ranges for which these |
| @@ -23581,10 +23596,10 @@ forever!) | |||
| 23581 | @vindex IntegSimpRules | 23596 | @vindex IntegSimpRules |
| 23582 | Another set of rules, stored in @code{IntegSimpRules}, are applied | 23597 | Another set of rules, stored in @code{IntegSimpRules}, are applied |
| 23583 | every time the integrator uses algebraic simplifications to simplify an | 23598 | every time the integrator uses algebraic simplifications to simplify an |
| 23584 | intermediate result. For example, putting the rule | 23599 | intermediate result. For example, putting the rule |
| 23585 | @samp{twice(x) := 2 x} into @code{IntegSimpRules} would tell Calc to | 23600 | @samp{twice(x) := 2 x} into @code{IntegSimpRules} would tell Calc to |
| 23586 | convert the @code{twice} function into a form it knows whenever | 23601 | convert the @code{twice} function into a form it knows whenever |
| 23587 | integration is attempted. | 23602 | integration is attempted. |
| 23588 | 23603 | ||
| 23589 | One more way to influence the integrator is to define a function with | 23604 | One more way to influence the integrator is to define a function with |
| 23590 | the @kbd{Z F} command (@pxref{Algebraic Definitions}). Calc's | 23605 | the @kbd{Z F} command (@pxref{Algebraic Definitions}). Calc's |
| @@ -26749,7 +26764,7 @@ meta-variable @expr{v}. As usual, if this meta-variable has already | |||
| 26749 | been matched to something else the two values must be equal; if the | 26764 | been matched to something else the two values must be equal; if the |
| 26750 | meta-variable is new then it is bound to the result of the expression. | 26765 | meta-variable is new then it is bound to the result of the expression. |
| 26751 | This variable can then appear in later conditions, and on the righthand | 26766 | This variable can then appear in later conditions, and on the righthand |
| 26752 | side of the rule. | 26767 | side of the rule. |
| 26753 | In fact, @expr{v} may be any pattern in which case the result of | 26768 | In fact, @expr{v} may be any pattern in which case the result of |
| 26754 | evaluating @expr{x} is matched to that pattern, binding any | 26769 | evaluating @expr{x} is matched to that pattern, binding any |
| 26755 | meta-variables that appear in that pattern. Note that @code{let} | 26770 | meta-variables that appear in that pattern. Note that @code{let} |
| @@ -27503,7 +27518,7 @@ but only when algebraic simplifications are used to simplify the | |||
| 27503 | formula. The variable @code{AlgSimpRules} holds rules for this purpose. | 27518 | formula. The variable @code{AlgSimpRules} holds rules for this purpose. |
| 27504 | The @kbd{a s} command will apply @code{EvalRules} and | 27519 | The @kbd{a s} command will apply @code{EvalRules} and |
| 27505 | @code{AlgSimpRules} to the formula, as well as all of its built-in | 27520 | @code{AlgSimpRules} to the formula, as well as all of its built-in |
| 27506 | simplifications. | 27521 | simplifications. |
| 27507 | 27522 | ||
| 27508 | Most of the special limitations for @code{EvalRules} don't apply to | 27523 | Most of the special limitations for @code{EvalRules} don't apply to |
| 27509 | @code{AlgSimpRules}. Calc simply does an @kbd{a r AlgSimpRules} | 27524 | @code{AlgSimpRules}. Calc simply does an @kbd{a r AlgSimpRules} |
| @@ -27511,7 +27526,7 @@ command with an infinite repeat count as the first step of algebraic | |||
| 27511 | simplifications. It then applies its own built-in simplifications | 27526 | simplifications. It then applies its own built-in simplifications |
| 27512 | throughout the formula, and then repeats these two steps (along with | 27527 | throughout the formula, and then repeats these two steps (along with |
| 27513 | applying the default simplifications) until no further changes are | 27528 | applying the default simplifications) until no further changes are |
| 27514 | possible. | 27529 | possible. |
| 27515 | 27530 | ||
| 27516 | @cindex @code{ExtSimpRules} variable | 27531 | @cindex @code{ExtSimpRules} variable |
| 27517 | @cindex @code{UnitSimpRules} variable | 27532 | @cindex @code{UnitSimpRules} variable |
| @@ -28946,9 +28961,9 @@ to select the lefthand side, execute your commands, then type | |||
| 28946 | All current modes apply when an @samp{=>} operator is computed, | 28961 | All current modes apply when an @samp{=>} operator is computed, |
| 28947 | including the current simplification mode. Recall that the | 28962 | including the current simplification mode. Recall that the |
| 28948 | formula @samp{arcsin(sin(x))} will not be handled by Calc's algebraic | 28963 | formula @samp{arcsin(sin(x))} will not be handled by Calc's algebraic |
| 28949 | simplifications, but Calc's unsafe simplifications will reduce it to | 28964 | simplifications, but Calc's unsafe simplifications will reduce it to |
| 28950 | @samp{x}. If you enter @samp{arcsin(sin(x)) =>} normally, the result | 28965 | @samp{x}. If you enter @samp{arcsin(sin(x)) =>} normally, the result |
| 28951 | will be @samp{arcsin(sin(x)) => arcsin(sin(x))}. If you change to | 28966 | will be @samp{arcsin(sin(x)) => arcsin(sin(x))}. If you change to |
| 28952 | Extended Simplification mode, the result will be | 28967 | Extended Simplification mode, the result will be |
| 28953 | @samp{arcsin(sin(x)) => x}. However, just pressing @kbd{a e} | 28968 | @samp{arcsin(sin(x)) => x}. However, just pressing @kbd{a e} |
| 28954 | once will have no effect on @samp{arcsin(sin(x)) => arcsin(sin(x))}, | 28969 | once will have no effect on @samp{arcsin(sin(x)) => arcsin(sin(x))}, |
| @@ -29566,7 +29581,7 @@ plot on any text-only printer. | |||
| 29566 | @kindex g O | 29581 | @kindex g O |
| 29567 | @pindex calc-graph-output | 29582 | @pindex calc-graph-output |
| 29568 | The @kbd{g O} (@code{calc-graph-output}) command sets the name of the | 29583 | The @kbd{g O} (@code{calc-graph-output}) command sets the name of the |
| 29569 | output file used by GNUPLOT. For some devices, notably @code{x11} and | 29584 | output file used by GNUPLOT@. For some devices, notably @code{x11} and |
| 29570 | @code{windows}, there is no output file and this information is not | 29585 | @code{windows}, there is no output file and this information is not |
| 29571 | used. Many other ``devices'' are really file formats like | 29586 | used. Many other ``devices'' are really file formats like |
| 29572 | @code{postscript}; in these cases the output in the desired format | 29587 | @code{postscript}; in these cases the output in the desired format |
| @@ -29638,7 +29653,7 @@ window in the upper-left corner of the screen. This command has no | |||
| 29638 | effect if the current device is @code{windows}. | 29653 | effect if the current device is @code{windows}. |
| 29639 | 29654 | ||
| 29640 | The buffer called @samp{*Gnuplot Trail*} holds a transcript of the | 29655 | The buffer called @samp{*Gnuplot Trail*} holds a transcript of the |
| 29641 | session with GNUPLOT. This shows the commands Calc has ``typed'' to | 29656 | session with GNUPLOT@. This shows the commands Calc has ``typed'' to |
| 29642 | GNUPLOT and the responses it has received. Calc tries to notice when an | 29657 | GNUPLOT and the responses it has received. Calc tries to notice when an |
| 29643 | error message has appeared here and display the buffer for you when | 29658 | error message has appeared here and display the buffer for you when |
| 29644 | this happens. You can check this buffer yourself if you suspect | 29659 | this happens. You can check this buffer yourself if you suspect |
| @@ -33249,7 +33264,7 @@ in the range @samp{[0 ..@: 60)}. | |||
| 33249 | 33264 | ||
| 33250 | Date forms are stored as @samp{(date @var{n})}, where @var{n} is | 33265 | Date forms are stored as @samp{(date @var{n})}, where @var{n} is |
| 33251 | a real number that counts days since midnight on the morning of | 33266 | a real number that counts days since midnight on the morning of |
| 33252 | January 1, 1 AD. If @var{n} is an integer, this is a pure date | 33267 | January 1, 1 AD@. If @var{n} is an integer, this is a pure date |
| 33253 | form. If @var{n} is a fraction or float, this is a date/time form. | 33268 | form. If @var{n} is a fraction or float, this is a date/time form. |
| 33254 | 33269 | ||
| 33255 | Modulo forms are stored as @samp{(mod @var{n} @var{m})}, where @var{m} is a | 33270 | Modulo forms are stored as @samp{(mod @var{n} @var{m})}, where @var{m} is a |
| @@ -33757,7 +33772,7 @@ objects into a definite, consistent order. The @code{beforep} | |||
| 33757 | function is used by the @kbd{V S} vector-sorting command, and also | 33772 | function is used by the @kbd{V S} vector-sorting command, and also |
| 33758 | by Calc's algebraic simplifications to put the terms of a product into | 33773 | by Calc's algebraic simplifications to put the terms of a product into |
| 33759 | canonical order: This allows @samp{x y + y x} to be simplified easily to | 33774 | canonical order: This allows @samp{x y + y x} to be simplified easily to |
| 33760 | @samp{2 x y}. | 33775 | @samp{2 x y}. |
| 33761 | @end defun | 33776 | @end defun |
| 33762 | 33777 | ||
| 33763 | @defun equal x y | 33778 | @defun equal x y |
| @@ -35590,6 +35605,20 @@ number of undo steps that will be preserved; if | |||
| 35590 | be preserved. The default value of @code{calc-undo-length} is @expr{100}. | 35605 | be preserved. The default value of @code{calc-undo-length} is @expr{100}. |
| 35591 | @end defvar | 35606 | @end defvar |
| 35592 | 35607 | ||
| 35608 | @defvar calc-gregorian-switch | ||
| 35609 | See @ref{Date Forms}.@* | ||
| 35610 | The variable @code{calc-gregorian-switch} is either a list of integers | ||
| 35611 | @code{(@var{YEAR} @var{MONTH} @var{DAY})} or @code{nil}. | ||
| 35612 | If it is @code{nil}, then Calc's date forms always represent Gregorian dates. | ||
| 35613 | Otherwise, @code{calc-gregorian-switch} represents the date that the | ||
| 35614 | calendar switches from Julian dates to Gregorian dates; | ||
| 35615 | @code{(@var{YEAR} @var{MONTH} @var{DAY})} will be the first Gregorian | ||
| 35616 | date. The customization buffer will offer several standard dates to | ||
| 35617 | choose from, or the user can enter their own date. | ||
| 35618 | |||
| 35619 | The default value of @code{calc-gregorian-switch} is @code{nil}. | ||
| 35620 | @end defvar | ||
| 35621 | |||
| 35593 | @node Reporting Bugs, Summary, Customizing Calc, Top | 35622 | @node Reporting Bugs, Summary, Customizing Calc, Top |
| 35594 | @appendix Reporting Bugs | 35623 | @appendix Reporting Bugs |
| 35595 | 35624 | ||
diff --git a/etc/ChangeLog b/etc/ChangeLog index 60d4a7aa271..11dc42b7f45 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog | |||
| @@ -1,3 +1,7 @@ | |||
| 1 | 2012-11-22 Paul Eggert <eggert@cs.ucla.edu> | ||
| 2 | |||
| 3 | * NEWS: Document Calc changes for Gregorian calendar (Bug#12633). | ||
| 4 | |||
| 1 | 2012-10-26 Nicolas Goaziou <n.goaziou@gmail.com> | 5 | 2012-10-26 Nicolas Goaziou <n.goaziou@gmail.com> |
| 2 | 6 | ||
| 3 | * refcards/orgcard.tex: Fix keybindings about | 7 | * refcards/orgcard.tex: Fix keybindings about |
| @@ -29,9 +29,32 @@ so we will look at it and add it to the manual. | |||
| 29 | 29 | ||
| 30 | * Changes in Specialized Modes and Packages in Emacs 24.4 | 30 | * Changes in Specialized Modes and Packages in Emacs 24.4 |
| 31 | 31 | ||
| 32 | ** Calc | ||
| 33 | |||
| 34 | *** Calc by default now uses the Gregorian calendar for all dates, and | ||
| 35 | uses January 1, 1 AD as its day number 1. Previously Calc used the | ||
| 36 | Julian calendar for dates before September 14, 1752, and it used | ||
| 37 | December 31, 1 BC as its day number 1; the new scheme is more | ||
| 38 | consistent with Calendar's calendrical system and day numbering. | ||
| 39 | |||
| 40 | *** The new variable `calc-gregorian-switch' lets you configure the | ||
| 41 | date when Calc switches from the Julian to the Gregorian calendar. | ||
| 42 | Nil, the default value, means to always use the Gregorian calendar. | ||
| 43 | The value (YEAR MONTH DAY) means to start using the Gregorian calendar | ||
| 44 | on the given date. | ||
| 45 | |||
| 32 | +++ | 46 | +++ |
| 33 | ** New function `ses-rename-cell' to give SES cells arbitrary names. | 47 | ** New function `ses-rename-cell' to give SES cells arbitrary names. |
| 34 | 48 | ||
| 49 | ** trace-function was largely rewritten. | ||
| 50 | New features include: | ||
| 51 | - no prompting for the destination buffer, unless a prefix-arg was used. | ||
| 52 | - additionally to prompting for a destination buffer, when a prefix-arg is | ||
| 53 | used, the user can enter a "context", i.e. Lisp expression whose value at the | ||
| 54 | time the function is entered/exited will be printed along with the function | ||
| 55 | name and arguments. Useful to trace the value of (current-buffer) or | ||
| 56 | (point) when the function is invoked. | ||
| 57 | |||
| 35 | 58 | ||
| 36 | * New Modes and Packages in Emacs 24.4 | 59 | * New Modes and Packages in Emacs 24.4 |
| 37 | ** New nadvice.el package offering lighter-weight advice facilities. | 60 | ** New nadvice.el package offering lighter-weight advice facilities. |
| @@ -43,6 +66,10 @@ It is layered as: | |||
| 43 | 66 | ||
| 44 | * Incompatible Lisp Changes in Emacs 24.4 | 67 | * Incompatible Lisp Changes in Emacs 24.4 |
| 45 | 68 | ||
| 69 | ** nil and "unbound" are indistinguishable in symbol-function. | ||
| 70 | `symbol-function' never signals `void-function' any more. | ||
| 71 | `fboundp' returns non-nil if the symbol was `fset' to nil. | ||
| 72 | |||
| 46 | ** `defadvice' does not honor the `freeze' flag and cannot advise | 73 | ** `defadvice' does not honor the `freeze' flag and cannot advise |
| 47 | special-forms any more. | 74 | special-forms any more. |
| 48 | 75 | ||
| @@ -52,6 +79,7 @@ spurious warnings about an unused var. | |||
| 52 | 79 | ||
| 53 | * Lisp changes in Emacs 24.4 | 80 | * Lisp changes in Emacs 24.4 |
| 54 | 81 | ||
| 82 | ** time-to-seconds is not obsolete any more. | ||
| 55 | ** New function special-form-p. | 83 | ** New function special-form-p. |
| 56 | ** Docstrings can be made dynamic by adding a `dynamic-docstring-function' | 84 | ** Docstrings can be made dynamic by adding a `dynamic-docstring-function' |
| 57 | text-property on the first char. | 85 | text-property on the first char. |
| @@ -833,7 +861,7 @@ are deprecated and will be removed eventually. | |||
| 833 | ** New sampling-based Elisp profiler. | 861 | ** New sampling-based Elisp profiler. |
| 834 | Try M-x profiler-start, do some work, and then call M-x profiler-report. | 862 | Try M-x profiler-start, do some work, and then call M-x profiler-report. |
| 835 | When finished, use M-x profiler-stop. The sampling rate can be based on | 863 | When finished, use M-x profiler-stop. The sampling rate can be based on |
| 836 | CPU time (only supported on some systems) or memory allocations. | 864 | CPU time or memory allocations. |
| 837 | 865 | ||
| 838 | +++ | 866 | +++ |
| 839 | ** CL-style generalized variables are now in core Elisp. | 867 | ** CL-style generalized variables are now in core Elisp. |
| @@ -1034,9 +1062,10 @@ takes precedence over most other maps for a short while (normally one key). | |||
| 1034 | Pass --with-w32 to configure. The default remains the X11 interface. | 1062 | Pass --with-w32 to configure. The default remains the X11 interface. |
| 1035 | 1063 | ||
| 1036 | ** Two new functions are available in Cygwin builds: | 1064 | ** Two new functions are available in Cygwin builds: |
| 1037 | `cygwin-convert-path-from-windows' and `cygwin-convert-path-to-windows'. | 1065 | `cygwin-convert-file-name-from-windows' and |
| 1038 | These functions allow Lisp code to access the Cygwin file-name mapping | 1066 | `cygwin-convert-file-name-to-windows'. These functions allow Lisp |
| 1039 | machinery to convert between Cygwin and Windows-native file names. | 1067 | code to access the Cygwin file-name mapping machinery to convert |
| 1068 | between Cygwin and Windows-native file and directory names. | ||
| 1040 | 1069 | ||
| 1041 | ** When invoked with the -nw switch to run on the Windows text-mode terminal, | 1070 | ** When invoked with the -nw switch to run on the Windows text-mode terminal, |
| 1042 | Emacs now supports mouse highlight, help-echo (in the echo area), and | 1071 | Emacs now supports mouse highlight, help-echo (in the echo area), and |
diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index 926297b6dd3..b85ba12a5b2 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog | |||
| @@ -1,3 +1,26 @@ | |||
| 1 | 2012-11-23 Paul Eggert <eggert@cs.ucla.edu> | ||
| 2 | |||
| 3 | movemail: treat EACCES etc. failures as permanent | ||
| 4 | * movemail.c (main): Treat any link failure other than EEXIST as a | ||
| 5 | permanent failure, not just EPERM. EACCES, for example. | ||
| 6 | |||
| 7 | 2012-11-21 Paul Eggert <eggert@cs.ucla.edu> | ||
| 8 | |||
| 9 | Assume POSIX 1003.1-1988 or later for unistd.h (Bug#12945). | ||
| 10 | * emacsclient.c (getcwd): Remove decl. | ||
| 11 | (get_current_dir_name): Assume getcwd exists. | ||
| 12 | * etags.c (HAVE_GETCWD): Remove. | ||
| 13 | (getcwd): Remove decl. | ||
| 14 | (NO_LONG_OPTIONS): Remove this. All uses removed. | ||
| 15 | Emacs always has GNU getopt. | ||
| 16 | (etags_getcwd): Assume getcwd exists. | ||
| 17 | * movemail.c (F_OK, X_OK, W_OK, R_OK): Remove. | ||
| 18 | |||
| 19 | 2012-11-20 Paul Eggert <eggert@cs.ucla.edu> | ||
| 20 | |||
| 21 | * emacsclient.c (handle_sigcont, handle_sigtstp): Use raise (sig) | ||
| 22 | rather than kill (getpid (), sig), as it's simpler and safer. | ||
| 23 | |||
| 1 | 2012-11-17 Juanma Barranquero <lekktu@gmail.com> | 24 | 2012-11-17 Juanma Barranquero <lekktu@gmail.com> |
| 2 | 25 | ||
| 3 | * makefile.w32-in (SYSWAIT_H): New macro. | 26 | * makefile.w32-in (SYSWAIT_H): New macro. |
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 8d60d7961da..021ac6eb247 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c | |||
| @@ -88,10 +88,7 @@ char *w32_getenv (char *); | |||
| 88 | 88 | ||
| 89 | 89 | ||
| 90 | 90 | ||
| 91 | char *getenv (const char *), *getwd (char *); | 91 | char *getenv (const char *); |
| 92 | #ifdef HAVE_GETCWD | ||
| 93 | char *(getcwd) (char *, size_t); | ||
| 94 | #endif | ||
| 95 | 92 | ||
| 96 | #ifndef VERSION | 93 | #ifndef VERSION |
| 97 | #define VERSION "unspecified" | 94 | #define VERSION "unspecified" |
| @@ -223,7 +220,7 @@ get_current_dir_name (void) | |||
| 223 | char *buf; | 220 | char *buf; |
| 224 | const char *pwd; | 221 | const char *pwd; |
| 225 | struct stat dotstat, pwdstat; | 222 | struct stat dotstat, pwdstat; |
| 226 | /* If PWD is accurate, use it instead of calling getwd. PWD is | 223 | /* If PWD is accurate, use it instead of calling getcwd. PWD is |
| 227 | sometimes a nicer name, and using it may avoid a fatal error if a | 224 | sometimes a nicer name, and using it may avoid a fatal error if a |
| 228 | parent directory is searchable but not readable. */ | 225 | parent directory is searchable but not readable. */ |
| 229 | if ((pwd = egetenv ("PWD")) != 0 | 226 | if ((pwd = egetenv ("PWD")) != 0 |
| @@ -240,7 +237,6 @@ get_current_dir_name (void) | |||
| 240 | buf = (char *) xmalloc (strlen (pwd) + 1); | 237 | buf = (char *) xmalloc (strlen (pwd) + 1); |
| 241 | strcpy (buf, pwd); | 238 | strcpy (buf, pwd); |
| 242 | } | 239 | } |
| 243 | #ifdef HAVE_GETCWD | ||
| 244 | else | 240 | else |
| 245 | { | 241 | { |
| 246 | size_t buf_size = 1024; | 242 | size_t buf_size = 1024; |
| @@ -267,20 +263,6 @@ get_current_dir_name (void) | |||
| 267 | } | 263 | } |
| 268 | } | 264 | } |
| 269 | } | 265 | } |
| 270 | #else | ||
| 271 | else | ||
| 272 | { | ||
| 273 | /* We need MAXPATHLEN here. */ | ||
| 274 | buf = (char *) xmalloc (MAXPATHLEN + 1); | ||
| 275 | if (getwd (buf) == NULL) | ||
| 276 | { | ||
| 277 | int tmp_errno = errno; | ||
| 278 | free (buf); | ||
| 279 | errno = tmp_errno; | ||
| 280 | return NULL; | ||
| 281 | } | ||
| 282 | } | ||
| 283 | #endif | ||
| 284 | return buf; | 266 | return buf; |
| 285 | } | 267 | } |
| 286 | #endif | 268 | #endif |
| @@ -1138,7 +1120,7 @@ handle_sigcont (int signalnum) | |||
| 1138 | else | 1120 | else |
| 1139 | { | 1121 | { |
| 1140 | /* We are in the background; cancel the continue. */ | 1122 | /* We are in the background; cancel the continue. */ |
| 1141 | kill (getpid (), SIGSTOP); | 1123 | raise (SIGSTOP); |
| 1142 | } | 1124 | } |
| 1143 | 1125 | ||
| 1144 | signal (signalnum, handle_sigcont); | 1126 | signal (signalnum, handle_sigcont); |
| @@ -1165,7 +1147,7 @@ handle_sigtstp (int signalnum) | |||
| 1165 | sigprocmask (SIG_BLOCK, NULL, &set); | 1147 | sigprocmask (SIG_BLOCK, NULL, &set); |
| 1166 | sigdelset (&set, signalnum); | 1148 | sigdelset (&set, signalnum); |
| 1167 | signal (signalnum, SIG_DFL); | 1149 | signal (signalnum, SIG_DFL); |
| 1168 | kill (getpid (), signalnum); | 1150 | raise (signalnum); |
| 1169 | sigprocmask (SIG_SETMASK, &set, NULL); /* Let's the above signal through. */ | 1151 | sigprocmask (SIG_SETMASK, &set, NULL); /* Let's the above signal through. */ |
| 1170 | signal (signalnum, handle_sigtstp); | 1152 | signal (signalnum, handle_sigtstp); |
| 1171 | 1153 | ||
| @@ -1592,7 +1574,6 @@ main (int argc, char **argv) | |||
| 1592 | cwd = get_current_dir_name (); | 1574 | cwd = get_current_dir_name (); |
| 1593 | if (cwd == 0) | 1575 | if (cwd == 0) |
| 1594 | { | 1576 | { |
| 1595 | /* getwd puts message in STRING if it fails. */ | ||
| 1596 | message (TRUE, "%s: %s\n", progname, | 1577 | message (TRUE, "%s: %s\n", progname, |
| 1597 | "Cannot get current working directory"); | 1578 | "Cannot get current working directory"); |
| 1598 | fail (); | 1579 | fail (); |
diff --git a/lib-src/etags.c b/lib-src/etags.c index ec415e9905f..b6af17b8edf 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c | |||
| @@ -123,19 +123,9 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4"; | |||
| 123 | # undef HAVE_NTGUI | 123 | # undef HAVE_NTGUI |
| 124 | # undef DOS_NT | 124 | # undef DOS_NT |
| 125 | # define DOS_NT | 125 | # define DOS_NT |
| 126 | # ifndef HAVE_GETCWD | 126 | #endif /* WINDOWSNT */ |
| 127 | # define HAVE_GETCWD | ||
| 128 | # endif /* undef HAVE_GETCWD */ | ||
| 129 | #else /* not WINDOWSNT */ | ||
| 130 | #endif /* !WINDOWSNT */ | ||
| 131 | 127 | ||
| 132 | #include <unistd.h> | 128 | #include <unistd.h> |
| 133 | #ifndef HAVE_UNISTD_H | ||
| 134 | # if defined (HAVE_GETCWD) && !defined (WINDOWSNT) | ||
| 135 | extern char *getcwd (char *buf, size_t size); | ||
| 136 | # endif | ||
| 137 | #endif /* HAVE_UNISTD_H */ | ||
| 138 | |||
| 139 | #include <stdarg.h> | 129 | #include <stdarg.h> |
| 140 | #include <stdlib.h> | 130 | #include <stdlib.h> |
| 141 | #include <string.h> | 131 | #include <string.h> |
| @@ -152,16 +142,7 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4"; | |||
| 152 | # define assert(x) ((void) 0) | 142 | # define assert(x) ((void) 0) |
| 153 | #endif | 143 | #endif |
| 154 | 144 | ||
| 155 | #ifdef NO_LONG_OPTIONS /* define this if you don't have GNU getopt */ | 145 | #include <getopt.h> |
| 156 | # define NO_LONG_OPTIONS TRUE | ||
| 157 | # define getopt_long(argc,argv,optstr,lopts,lind) getopt (argc, argv, optstr) | ||
| 158 | extern char *optarg; | ||
| 159 | extern int optind, opterr; | ||
| 160 | #else | ||
| 161 | # define NO_LONG_OPTIONS FALSE | ||
| 162 | # include <getopt.h> | ||
| 163 | #endif /* NO_LONG_OPTIONS */ | ||
| 164 | |||
| 165 | #include <regex.h> | 146 | #include <regex.h> |
| 166 | 147 | ||
| 167 | /* Define CTAGS to make the program "ctags" compatible with the usual one. | 148 | /* Define CTAGS to make the program "ctags" compatible with the usual one. |
| @@ -869,11 +850,7 @@ print_help (argument *argbuffer) | |||
| 869 | printf ("Usage: %s [options] [[regex-option ...] file-name] ...\n\ | 850 | printf ("Usage: %s [options] [[regex-option ...] file-name] ...\n\ |
| 870 | \n\ | 851 | \n\ |
| 871 | These are the options accepted by %s.\n", progname, progname); | 852 | These are the options accepted by %s.\n", progname, progname); |
| 872 | if (NO_LONG_OPTIONS) | 853 | puts ("You may use unambiguous abbreviations for the long option names."); |
| 873 | puts ("WARNING: long option names do not work with this executable,\n\ | ||
| 874 | as it is not linked with GNU getopt."); | ||
| 875 | else | ||
| 876 | puts ("You may use unambiguous abbreviations for the long option names."); | ||
| 877 | puts (" A - as file name means read names from stdin (one per line).\n\ | 854 | puts (" A - as file name means read names from stdin (one per line).\n\ |
| 878 | Absolute names are stored in the output file as they are.\n\ | 855 | Absolute names are stored in the output file as they are.\n\ |
| 879 | Relative ones are stored relative to the output file's directory.\n"); | 856 | Relative ones are stored relative to the output file's directory.\n"); |
| @@ -1065,9 +1042,9 @@ main (int argc, char **argv) | |||
| 1065 | 1042 | ||
| 1066 | /* When the optstring begins with a '-' getopt_long does not rearrange the | 1043 | /* When the optstring begins with a '-' getopt_long does not rearrange the |
| 1067 | non-options arguments to be at the end, but leaves them alone. */ | 1044 | non-options arguments to be at the end, but leaves them alone. */ |
| 1068 | optstring = concat (NO_LONG_OPTIONS ? "" : "-", | 1045 | optstring = concat ("-ac:Cf:Il:o:r:RSVhH", |
| 1069 | "ac:Cf:Il:o:r:RSVhH", | 1046 | (CTAGS) ? "BxdtTuvw" : "Di:", |
| 1070 | (CTAGS) ? "BxdtTuvw" : "Di:"); | 1047 | ""); |
| 1071 | 1048 | ||
| 1072 | while ((opt = getopt_long (argc, argv, optstring, longopts, NULL)) != EOF) | 1049 | while ((opt = getopt_long (argc, argv, optstring, longopts, NULL)) != EOF) |
| 1073 | switch (opt) | 1050 | switch (opt) |
| @@ -6333,8 +6310,8 @@ pfatal (const char *s1) | |||
| 6333 | static void | 6310 | static void |
| 6334 | suggest_asking_for_help (void) | 6311 | suggest_asking_for_help (void) |
| 6335 | { | 6312 | { |
| 6336 | fprintf (stderr, "\tTry `%s %s' for a complete list of options.\n", | 6313 | fprintf (stderr, "\tTry `%s --help' for a complete list of options.\n", |
| 6337 | progname, NO_LONG_OPTIONS ? "-h" : "--help"); | 6314 | progname); |
| 6338 | exit (EXIT_FAILURE); | 6315 | exit (EXIT_FAILURE); |
| 6339 | } | 6316 | } |
| 6340 | 6317 | ||
| @@ -6372,7 +6349,6 @@ concat (const char *s1, const char *s2, const char *s3) | |||
| 6372 | static char * | 6349 | static char * |
| 6373 | etags_getcwd (void) | 6350 | etags_getcwd (void) |
| 6374 | { | 6351 | { |
| 6375 | #ifdef HAVE_GETCWD | ||
| 6376 | int bufsize = 200; | 6352 | int bufsize = 200; |
| 6377 | char *path = xnew (bufsize, char); | 6353 | char *path = xnew (bufsize, char); |
| 6378 | 6354 | ||
| @@ -6387,34 +6363,6 @@ etags_getcwd (void) | |||
| 6387 | 6363 | ||
| 6388 | canonicalize_filename (path); | 6364 | canonicalize_filename (path); |
| 6389 | return path; | 6365 | return path; |
| 6390 | |||
| 6391 | #else /* not HAVE_GETCWD */ | ||
| 6392 | #if MSDOS | ||
| 6393 | |||
| 6394 | char *p, path[MAXPATHLEN + 1]; /* Fixed size is safe on MSDOS. */ | ||
| 6395 | |||
| 6396 | getwd (path); | ||
| 6397 | |||
| 6398 | for (p = path; *p != '\0'; p++) | ||
| 6399 | if (*p == '\\') | ||
| 6400 | *p = '/'; | ||
| 6401 | else | ||
| 6402 | *p = lowcase (*p); | ||
| 6403 | |||
| 6404 | return strdup (path); | ||
| 6405 | #else /* not MSDOS */ | ||
| 6406 | linebuffer path; | ||
| 6407 | FILE *pipe; | ||
| 6408 | |||
| 6409 | linebuffer_init (&path); | ||
| 6410 | pipe = (FILE *) popen ("pwd 2>/dev/null", "r"); | ||
| 6411 | if (pipe == NULL || readline_internal (&path, pipe) == 0) | ||
| 6412 | pfatal ("pwd"); | ||
| 6413 | pclose (pipe); | ||
| 6414 | |||
| 6415 | return path.buffer; | ||
| 6416 | #endif /* not MSDOS */ | ||
| 6417 | #endif /* not HAVE_GETCWD */ | ||
| 6418 | } | 6366 | } |
| 6419 | 6367 | ||
| 6420 | /* Return a newly allocated string containing the file name of FILE | 6368 | /* Return a newly allocated string containing the file name of FILE |
diff --git a/lib-src/movemail.c b/lib-src/movemail.c index cd329a110a8..264b3d292c6 100644 --- a/lib-src/movemail.c +++ b/lib-src/movemail.c | |||
| @@ -96,13 +96,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 96 | #include <fcntl.h> | 96 | #include <fcntl.h> |
| 97 | #endif /* WINDOWSNT */ | 97 | #endif /* WINDOWSNT */ |
| 98 | 98 | ||
| 99 | #ifndef F_OK | ||
| 100 | #define F_OK 0 | ||
| 101 | #define X_OK 1 | ||
| 102 | #define W_OK 2 | ||
| 103 | #define R_OK 4 | ||
| 104 | #endif | ||
| 105 | |||
| 106 | #ifdef WINDOWSNT | 99 | #ifdef WINDOWSNT |
| 107 | #include <sys/locking.h> | 100 | #include <sys/locking.h> |
| 108 | #endif | 101 | #endif |
| @@ -335,11 +328,8 @@ main (int argc, char **argv) | |||
| 335 | 328 | ||
| 336 | tem = link (tempname, lockname); | 329 | tem = link (tempname, lockname); |
| 337 | 330 | ||
| 338 | #ifdef EPERM | 331 | if (tem < 0 && errno != EEXIST) |
| 339 | if (tem < 0 && errno == EPERM) | 332 | pfatal_with_name (lockname); |
| 340 | fatal ("Unable to create hard link between %s and %s", | ||
| 341 | tempname, lockname); | ||
| 342 | #endif | ||
| 343 | 333 | ||
| 344 | unlink (tempname); | 334 | unlink (tempname); |
| 345 | if (tem >= 0) | 335 | if (tem >= 0) |
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ca65e431964..09f42233f96 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,166 @@ | |||
| 1 | 2012-11-23 Chong Yidong <cyd@gnu.org> | ||
| 2 | |||
| 3 | * find-cmd.el (find-constituents): Add executable, ipath, | ||
| 4 | readable, samefile, writable, daystart, regextype (Bug#12856). | ||
| 5 | |||
| 6 | 2012-11-23 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 7 | |||
| 8 | * emacs-lisp/ert.el, emacs-lisp/ert-x.el: Use cl-lib and lexical-binding. | ||
| 9 | |||
| 10 | 2012-11-22 Paul Eggert <eggert@cs.ucla.edu> | ||
| 11 | |||
| 12 | * calc/calc.el (calc-gregorian-switch): Move to after calc-refresh | ||
| 13 | definition. This fixes a bootstrap failure. | ||
| 14 | (calc-gregorian-switch): In menu, put dates before regions. | ||
| 15 | This is easier to follow, lines up better in the menu, and lets us | ||
| 16 | coalesce regions that switch at the same time. Give country | ||
| 17 | names, not "Vatican", as that's better for non-expert users. | ||
| 18 | Use names that are stable between the date of switch and now, e.g., | ||
| 19 | Bohemia and Moravia (which existed then and now) and not | ||
| 20 | Czechoslovakia (which didn't exist then and doesn't exist now). | ||
| 21 | What is now the U.S. mostly did not switch at the same time as | ||
| 22 | Britain, so omit the U.S. Correct spelling of "Britain". | ||
| 23 | Catholic Switzerland was too much of a mess, so omit it. | ||
| 24 | |||
| 25 | 2012-11-22 Jay Belanger <jay.p.belanger@gmail.com> | ||
| 26 | |||
| 27 | * calc/calc.el (calc-gregorian-switch): Refresh the Calc buffer | ||
| 28 | after the variable is changed. | ||
| 29 | |||
| 30 | 2012-11-21 Daniel Colascione <dancol@dancol.org> | ||
| 31 | |||
| 32 | * progmodes/sql.el (sql-mode-font-lock-object-name): Support IF NOT EXISTS | ||
| 33 | in SQL declarations for font-lock. | ||
| 34 | (sql-imenu-generic-expression): Teach imenu about IF NOT EXISTS. | ||
| 35 | |||
| 36 | 2012-11-21 Glenn Morris <rgm@gnu.org> | ||
| 37 | |||
| 38 | * faces.el (face-underline-p, face-inverse-video-p, face-bold-p) | ||
| 39 | (face-italic-p): Add optional argument "inherit". | ||
| 40 | |||
| 41 | * faces.el (set-face-inverse-video, set-face-bold, set-face-italic): | ||
| 42 | Remove -p suffix from names, for consistency with other set-face-*. | ||
| 43 | (set-face-inverse-video): Fix interactive spec. | ||
| 44 | * play/gamegrid.el (gamegrid-make-mono-tty-face): | ||
| 45 | * textmodes/table.el (table--update-cell-face): | ||
| 46 | Use set-face-inverse-video rather than now obsolete alias. | ||
| 47 | |||
| 48 | 2012-11-21 Eli Zaretskii <eliz@gnu.org> | ||
| 49 | |||
| 50 | * simple.el (line-move): Don't call line-move-partial if | ||
| 51 | scroll-conservatively is in effect. (Bug#12927) | ||
| 52 | |||
| 53 | 2012-11-21 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 54 | |||
| 55 | * eshell/em-cmpl.el (eshell-pcomplete): Refine fix for bug#12838: | ||
| 56 | Fallback on completion-at-point rather than | ||
| 57 | pcomplete-expand-and-complete, and only if pcomplete actually failed. | ||
| 58 | (eshell-cmpl-initialize): Setup completion-at-point. | ||
| 59 | |||
| 60 | * pcomplete.el (pcomplete--entries): Obey pcomplete-ignore-case. | ||
| 61 | |||
| 62 | * emacs-lisp/ert.el (ert--expand-should-1): Adapt to cl-lib. | ||
| 63 | |||
| 64 | 2012-11-21 Michael Albinus <michael.albinus@gmx.de> | ||
| 65 | |||
| 66 | * net/tramp-sh.el (tramp-do-copy-or-rename-file): If both files | ||
| 67 | are remote, check out-of-band property for both. | ||
| 68 | |||
| 69 | 2012-11-21 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 70 | |||
| 71 | * window.el (switch-to-buffer): Re-add the warning that was lost in the | ||
| 72 | code rewrite. | ||
| 73 | |||
| 74 | 2012-11-21 Paul Eggert <eggert@cs.ucla.edu> | ||
| 75 | |||
| 76 | More minor time fixes. | ||
| 77 | * calendar/time-date.el: Commentary fix. | ||
| 78 | * net/tramp-sh.el (tramp-do-file-attributes-with-ls): Undo last change; | ||
| 79 | too much other code depends on (0 0) time stamps. | ||
| 80 | * net/tramp.el (tramp-time-less-p, tramp-time-subtract): | ||
| 81 | Add a couple of FIXME comments. | ||
| 82 | |||
| 83 | Minor cleanup for times as lists of four integers. | ||
| 84 | * files.el (dir-locals-directory-cache): | ||
| 85 | * ps-bdf.el (bdf-file-mod-time, bdf-read-font-info): | ||
| 86 | Doc fixes. | ||
| 87 | * net/tramp-sh.el (tramp-do-file-attributes-with-ls): | ||
| 88 | * ps-bdf.el (bdf-file-newer-than-time): | ||
| 89 | Process four-integers time stamps, not two. Doc fixes. | ||
| 90 | |||
| 91 | 2012-11-20 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 92 | |||
| 93 | * uniquify.el (uniquify-managed): Use defvar-local. | ||
| 94 | (rename-buffer, create-file-buffer): Advise with advice-add. | ||
| 95 | (uniquify-unload-function): Unadvise accordingly. | ||
| 96 | |||
| 97 | * emacs-lisp/trace.el: Rewrite, use nadvice and lexical-binding. | ||
| 98 | (trace-buffer): Don't purecopy. | ||
| 99 | (trace-entry-message, trace-exit-message): Add `context' arg. | ||
| 100 | (trace--timer): New var. | ||
| 101 | (trace-make-advice): Adjust for use in nadvice. | ||
| 102 | Add `context' argument. Delay `display-buffer' via a timer. | ||
| 103 | (trace-function-internal): Use advice-add. | ||
| 104 | (trace--read-args): New function. | ||
| 105 | (trace-function-foreground, trace-function-background): Use it. | ||
| 106 | (trace-function): Rename to trace-function-foreground and redefine as | ||
| 107 | an alias to that new name. | ||
| 108 | (untrace-function, untrace-all): Adjust to the use of nadvice. | ||
| 109 | |||
| 110 | * emacs-lisp/bytecomp.el (byte-compile): Fix handling of closures. | ||
| 111 | |||
| 112 | * emacs-lisp/byte-run.el (defun-declarations-alist): Fix last change. | ||
| 113 | |||
| 114 | * subr.el (called-interactively-p-functions): New var. | ||
| 115 | (internal--called-interactively-p--get-frame): New macro. | ||
| 116 | (called-interactively-p, interactive-p): Rewrite in Lisp. | ||
| 117 | * emacs-lisp/nadvice.el (advice--called-interactively-skip): New fun. | ||
| 118 | (called-interactively-p-functions): Use it. | ||
| 119 | * emacs-lisp/edebug.el (edebug--called-interactively-skip): New fun. | ||
| 120 | (called-interactively-p-functions): Use it. | ||
| 121 | * allout.el (allout-called-interactively-p): Don't assume | ||
| 122 | called-interactively-p is a subr. | ||
| 123 | |||
| 124 | 2012-11-20 Glenn Morris <rgm@gnu.org> | ||
| 125 | |||
| 126 | * profiler.el (profiler-report-mode-map): Add a menu. | ||
| 127 | No need to bind `q' because we derive from special-mode. | ||
| 128 | (profiler-report-find-entry): Handle calls from the menu-bar. | ||
| 129 | |||
| 130 | 2012-11-19 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 131 | |||
| 132 | * emacs-lisp/byte-run.el (defun-declarations-alist): | ||
| 133 | Allow a compiler-macro to be a lambda expression. | ||
| 134 | |||
| 135 | * progmodes/python.el: Use cl-lib. Move var declarations outside of | ||
| 136 | eval-when-compile. | ||
| 137 | (python-syntax-context): Add compiler-macro. | ||
| 138 | (python-font-lock-keywords): Simplify with De Morgan. | ||
| 139 | |||
| 140 | * vc/diff-mode.el (diff-hunk): Don't make useless timers. | ||
| 141 | |||
| 142 | * files.el (load-file): Require match in minibuffer selection, as was | ||
| 143 | the case in Emacs-20 before we changed the spec to allow .elc files | ||
| 144 | (bug#12935). | ||
| 145 | |||
| 146 | * json.el: Don't require cl since we don't use it. | ||
| 147 | * color.el: Don't require cl. | ||
| 148 | (color-complement): `caddr' -> `nth 2'. | ||
| 149 | |||
| 150 | * calendar/time-date.el (time-to-seconds): De-obsolete. | ||
| 151 | |||
| 152 | 2012-11-19 Jay Belanger <jay.p.belanger@gmail.com> | ||
| 153 | |||
| 154 | * calc/calc-forms.el (math-leap-year-p): Fix formula for negative | ||
| 155 | year numbers. | ||
| 156 | (math-date-to-julian-dt): Adjust the initial approximation for the | ||
| 157 | year to deal with the new definition of the DATE. | ||
| 158 | |||
| 159 | 2012-11-19 Daniel Colascione <dancol@dancol.org> | ||
| 160 | |||
| 161 | * term/w32-win.el (cygwin-convert-path-from-windows): | ||
| 162 | Accomodate rename of cygwin_convert_path* to cygwin_convert_file_name*. | ||
| 163 | |||
| 1 | 2012-11-18 Chong Yidong <cyd@gnu.org> | 164 | 2012-11-18 Chong Yidong <cyd@gnu.org> |
| 2 | 165 | ||
| 3 | * filecache.el (file-cache--read-list): New function. | 166 | * filecache.el (file-cache--read-list): New function. |
| @@ -47,8 +210,10 @@ | |||
| 47 | 210 | ||
| 48 | 2012-11-17 Paul Eggert <eggert@cs.ucla.edu> | 211 | 2012-11-17 Paul Eggert <eggert@cs.ucla.edu> |
| 49 | 212 | ||
| 213 | Calc by default uses the Gregorian calendar for all dates (Bug#12633). | ||
| 214 | It also uses January 1, 1 AD as its day number 1. | ||
| 50 | * calc/calc-forms.el (math-julian-date-beginning) | 215 | * calc/calc-forms.el (math-julian-date-beginning) |
| 51 | (math-julian-date-beginning-int): Implement [new date numbering]. | 216 | (math-julian-date-beginning-int): Implement this. |
| 52 | 217 | ||
| 53 | 2012-11-17 Juanma Barranquero <lekktu@gmail.com> | 218 | 2012-11-17 Juanma Barranquero <lekktu@gmail.com> |
| 54 | 219 | ||
diff --git a/lisp/allout.el b/lisp/allout.el index 04de853ebe0..e93aefd12cc 100644 --- a/lisp/allout.el +++ b/lisp/allout.el | |||
| @@ -1657,10 +1657,9 @@ and the place for the cursor after the decryption is done." | |||
| 1657 | (defmacro allout-called-interactively-p () | 1657 | (defmacro allout-called-interactively-p () |
| 1658 | "A version of `called-interactively-p' independent of Emacs version." | 1658 | "A version of `called-interactively-p' independent of Emacs version." |
| 1659 | ;; ... to ease maintenance of allout without betraying deprecation. | 1659 | ;; ... to ease maintenance of allout without betraying deprecation. |
| 1660 | (if (equal (subr-arity (symbol-function 'called-interactively-p)) | 1660 | (if (ignore-errors (called-interactively-p 'interactive) t) |
| 1661 | '(0 . 0)) | 1661 | '(called-interactively-p 'interactive) |
| 1662 | '(called-interactively-p) | 1662 | '(called-interactively-p))) |
| 1663 | '(called-interactively-p 'interactive))) | ||
| 1664 | ;;;_ = allout-inhibit-aberrance-doublecheck nil | 1663 | ;;;_ = allout-inhibit-aberrance-doublecheck nil |
| 1665 | ;; In some exceptional moments, disparate topic depths need to be allowed | 1664 | ;; In some exceptional moments, disparate topic depths need to be allowed |
| 1666 | ;; momentarily, eg when one topic is being yanked into another and they're | 1665 | ;; momentarily, eg when one topic is being yanked into another and they're |
diff --git a/lisp/calc/README b/lisp/calc/README index 25d1a5e9b58..638b482a60a 100644 --- a/lisp/calc/README +++ b/lisp/calc/README | |||
| @@ -70,11 +70,18 @@ opinions. | |||
| 70 | Summary of changes to "Calc" | 70 | Summary of changes to "Calc" |
| 71 | ------- -- ------- -- ---- | 71 | ------- -- ------- -- ---- |
| 72 | 72 | ||
| 73 | Emacs 24.4 | ||
| 74 | |||
| 75 | * The date forms use the Gregorian calendar for all dates. | ||
| 76 | (Previously they were a combination of Julian and Gregorian | ||
| 77 | dates.) This can be configured with the customizable variable | ||
| 78 | `calc-gregorian-switch'. | ||
| 79 | |||
| 73 | Emacs 24.3 | 80 | Emacs 24.3 |
| 74 | 81 | ||
| 75 | Algebraic simplification mode is now the default. | 82 | * Algebraic simplification mode is now the default. |
| 76 | To restrict to the limited simplifications given by the former | 83 | To restrict to the limited simplifications given by the former |
| 77 | default simplification mode, use `m I'. | 84 | default simplification mode, use `m I'. |
| 78 | 85 | ||
| 79 | Emacs 24.1 | 86 | Emacs 24.1 |
| 80 | 87 | ||
diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el index 709250f9ba9..98b22550f75 100644 --- a/lisp/calc/calc-forms.el +++ b/lisp/calc/calc-forms.el | |||
| @@ -371,9 +371,10 @@ | |||
| 371 | ;;; These versions are rewritten to use arbitrary-size integers. | 371 | ;;; These versions are rewritten to use arbitrary-size integers. |
| 372 | 372 | ||
| 373 | ;;; A numerical date is the number of days since midnight on | 373 | ;;; A numerical date is the number of days since midnight on |
| 374 | ;;; the morning of December 31, 1 B.C. Emacs's calendar refers to such | 374 | ;;; the morning of December 31, 1 B.C. (Gregorian) or January 2, 1 A.D. (Julian). |
| 375 | ;;; a date as an absolute date, some function names also use that | 375 | ;;; Emacs's calendar refers to such a date as an absolute date, some Calc function |
| 376 | ;;; terminology. If the date is a non-integer, it represents a specific date and time. | 376 | ;;; names also use that terminology. If the date is a non-integer, it represents |
| 377 | ;;; a specific date and time. | ||
| 377 | ;;; A "dt" is a list of the form, (year month day), corresponding to | 378 | ;;; A "dt" is a list of the form, (year month day), corresponding to |
| 378 | ;;; an integer code, or (year month day hour minute second), corresponding | 379 | ;;; an integer code, or (year month day hour minute second), corresponding |
| 379 | ;;; to a non-integer code. | 380 | ;;; to a non-integer code. |
| @@ -408,8 +409,8 @@ DATE is the number of days since December 31, -1 in the Gregorian calendar." | |||
| 408 | (let* ((month 1) | 409 | (let* ((month 1) |
| 409 | day | 410 | day |
| 410 | (year (math-quotient (math-add date (if (Math-lessp date 711859) | 411 | (year (math-quotient (math-add date (if (Math-lessp date 711859) |
| 411 | 365 ; for speed, we take | 412 | 367 ; for speed, we take |
| 412 | -108)) ; >1950 as a special case | 413 | -106)) ; >1950 as a special case |
| 413 | (if (math-negp date) 366 365))) | 414 | (if (math-negp date) 366 365))) |
| 414 | ; this result may be an overestimate | 415 | ; this result may be an overestimate |
| 415 | temp) | 416 | temp) |
| @@ -494,6 +495,8 @@ Gregorian calendar." | |||
| 494 | (if (math-negp year) | 495 | (if (math-negp year) |
| 495 | (= (math-imod (math-neg year) 4) 1) | 496 | (= (math-imod (math-neg year) 4) 1) |
| 496 | (= (math-imod year 4) 0)) | 497 | (= (math-imod year 4) 0)) |
| 498 | (if (math-negp year) | ||
| 499 | (setq year (math-sub -1 year))) | ||
| 497 | (setq year (math-imod year 400)) | 500 | (setq year (math-imod year 400)) |
| 498 | (or (and (= (% year 4) 0) (/= (% year 100) 0)) | 501 | (or (and (= (% year 4) 0) (/= (% year 100) 0)) |
| 499 | (= year 0)))) | 502 | (= year 0)))) |
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index aeca45ebf26..58eabf9bcec 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el | |||
| @@ -466,50 +466,6 @@ to be identified as that note." | |||
| 466 | 466 | ||
| 467 | (defvar math-format-date-cache) ; calc-forms.el | 467 | (defvar math-format-date-cache) ; calc-forms.el |
| 468 | 468 | ||
| 469 | ;; Dates that are built-in options for `calc-gregorian-switch' should be | ||
| 470 | ;; (YEAR MONTH DAY math-date-from-gregorian-dt(YEAR MONTH DAY)) for speed. | ||
| 471 | (defcustom calc-gregorian-switch nil | ||
| 472 | "The first day the Gregorian calendar is used by Calc's date forms. | ||
| 473 | This is `nil' (the default) if the Gregorian calendar is the only one used. | ||
| 474 | Otherwise, it should be a list `(YEAR MONTH DAY)' when Calc begins to use | ||
| 475 | the Gregorian calendar; Calc will use the Julian calendar for earlier dates. | ||
| 476 | The dates in which different regions of the world began to use the | ||
| 477 | Gregorian calendar vary quite a bit, even within a single country. | ||
| 478 | If you want Calc's date forms to switch between the Julian and | ||
| 479 | Gregorian calendar, you can specify the date or choose from several | ||
| 480 | common choices. Some of these choices should be taken with a grain | ||
| 481 | of salt; for example different parts of France changed calendars at | ||
| 482 | different times, and Sweden's change to the Gregorian calendar was | ||
| 483 | complicated. Also, the boundaries of the countries were different at | ||
| 484 | the times of the calendar changes than they are now. | ||
| 485 | The Vatican decided that the Gregorian calendar should take effect | ||
| 486 | on 15 October 1582 (Gregorian), and many Catholic countries made | ||
| 487 | the change then. Great Britian and its colonies had the Gregorian | ||
| 488 | calendar take effect on 14 September 1752 (Gregorian); this includes | ||
| 489 | the United States." | ||
| 490 | :group 'calc | ||
| 491 | :version "24.4" | ||
| 492 | :type '(choice (const :tag "Always use the Gregorian calendar" nil) | ||
| 493 | (const :tag "Great Britian and the US (1752 9 14)" (1752 9 14 639797)) | ||
| 494 | (const :tag "Vatican (1582 10 15)" (1582 10 15 577736)) | ||
| 495 | (const :tag "Czechoslovakia (1584 1 17)" (1584 1 17 578195)) | ||
| 496 | (const :tag "Denmark (1700 3 1)" (1700 3 1 620607)) | ||
| 497 | (const :tag "France (1582 12 20)" (1582 12 20 577802)) | ||
| 498 | (const :tag "Hungary (1587 11 1)" (1587 11 1 579579)) | ||
| 499 | (const :tag "Luxemburg (1582 12 25)" (1582 12 25 577807)) | ||
| 500 | (const :tag "Romania (1919 4 14)" (1919 4 14 700638)) | ||
| 501 | (const :tag "Russia (1918 2 14)" (1918 2 14 700214)) | ||
| 502 | (const :tag "Sweden (1753 3 1)" (1753 3 1 639965)) | ||
| 503 | (const :tag "Switzerland (Catholic) (1584 1 22)" (1584 1 22 578200)) | ||
| 504 | (const :tag "Switzerland (Protestant) (1701 1 12)" (1701 1 12 620924)) | ||
| 505 | (list :tag "(YEAR MONTH DAY)" | ||
| 506 | (integer :tag "Year") | ||
| 507 | (integer :tag "Month (integer)") | ||
| 508 | (integer :tag "Day"))) | ||
| 509 | :set (lambda (symbol value) | ||
| 510 | (set-default symbol value) | ||
| 511 | (setq math-format-date-cache nil))) | ||
| 512 | |||
| 513 | (defface calc-nonselected-face | 469 | (defface calc-nonselected-face |
| 514 | '((t :inherit shadow | 470 | '((t :inherit shadow |
| 515 | :slant italic)) | 471 | :slant italic)) |
| @@ -2066,6 +2022,50 @@ See calc-keypad for details." | |||
| 2066 | (calc-refresh align))) | 2022 | (calc-refresh align))) |
| 2067 | (setq calc-refresh-count (1+ calc-refresh-count))) | 2023 | (setq calc-refresh-count (1+ calc-refresh-count))) |
| 2068 | 2024 | ||
| 2025 | ;; Dates that are built-in options for `calc-gregorian-switch' should be | ||
| 2026 | ;; (YEAR MONTH DAY math-date-from-gregorian-dt(YEAR MONTH DAY)) for speed. | ||
| 2027 | (defcustom calc-gregorian-switch nil | ||
| 2028 | "The first day the Gregorian calendar is used by Calc's date forms. | ||
| 2029 | This is `nil' (the default) if the Gregorian calendar is the only one used. | ||
| 2030 | Otherwise, it should be a list `(YEAR MONTH DAY)' when Calc begins to use | ||
| 2031 | the Gregorian calendar; Calc will use the Julian calendar for earlier dates. | ||
| 2032 | The dates in which different regions of the world began to use the | ||
| 2033 | Gregorian calendar vary quite a bit, even within a single country. | ||
| 2034 | If you want Calc's date forms to switch between the Julian and | ||
| 2035 | Gregorian calendar, you can specify the date or choose from several | ||
| 2036 | common choices. Some of these choices should be taken with a grain | ||
| 2037 | of salt; for example different parts of France changed calendars at | ||
| 2038 | different times, and Sweden's change to the Gregorian calendar was | ||
| 2039 | complicated. Also, the boundaries of the countries were different at | ||
| 2040 | the times of the calendar changes than they are now. | ||
| 2041 | The Vatican decided that the Gregorian calendar should take effect | ||
| 2042 | on 15 October 1582 (Gregorian), and many Catholic countries made | ||
| 2043 | the change then. Great Britain and its colonies had the Gregorian | ||
| 2044 | calendar take effect on 14 September 1752 (Gregorian); this includes | ||
| 2045 | the United States." | ||
| 2046 | :group 'calc | ||
| 2047 | :version "24.4" | ||
| 2048 | :type '(choice (const :tag "Always use the Gregorian calendar" nil) | ||
| 2049 | (const :tag "1582-10-15 - Italy, Poland, Portugal, Spain" (1582 10 15 577736)) | ||
| 2050 | (const :tag "1582-12-20 - France" (1582 12 20 577802)) | ||
| 2051 | (const :tag "1582-12-25 - Luxemburg" (1582 12 25 577807)) | ||
| 2052 | (const :tag "1584-01-17 - Bohemia and Moravia" (1584 1 17 578195)) | ||
| 2053 | (const :tag "1587-11-01 - Hungary" (1587 11 1 579579)) | ||
| 2054 | (const :tag "1700-03-01 - Denmark" (1700 3 1 620607)) | ||
| 2055 | (const :tag "1701-01-12 - Protestant Switzerland" (1701 1 12 620924)) | ||
| 2056 | (const :tag "1752-09-14 - Great Britain and dominions" (1752 9 14 639797)) | ||
| 2057 | (const :tag "1753-03-01 - Sweden" (1753 3 1 639965)) | ||
| 2058 | (const :tag "1918-02-14 - Russia" (1918 2 14 700214)) | ||
| 2059 | (const :tag "1919-04-14 - Romania" (1919 4 14 700638)) | ||
| 2060 | (list :tag "(YEAR MONTH DAY)" | ||
| 2061 | (integer :tag "Year") | ||
| 2062 | (integer :tag "Month (integer)") | ||
| 2063 | (integer :tag "Day"))) | ||
| 2064 | :set (lambda (symbol value) | ||
| 2065 | (set-default symbol value) | ||
| 2066 | (setq math-format-date-cache nil) | ||
| 2067 | (calc-refresh))) | ||
| 2068 | |||
| 2069 | ;;;; The Calc Trail buffer. | 2069 | ;;;; The Calc Trail buffer. |
| 2070 | 2070 | ||
| 2071 | (defun calc-check-trail-aligned () | 2071 | (defun calc-check-trail-aligned () |
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 38b766084c9..9cac659d848 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el | |||
| @@ -30,11 +30,10 @@ | |||
| 30 | ;; value equal to HIGH * 2^16 + LOW + USEC * 10^-6 + PSEC * 10^-12 | 30 | ;; value equal to HIGH * 2^16 + LOW + USEC * 10^-6 + PSEC * 10^-12 |
| 31 | ;; seconds, where missing components are treated as zero. HIGH can be | 31 | ;; seconds, where missing components are treated as zero. HIGH can be |
| 32 | ;; negative, either because the value is a time difference, or because | 32 | ;; negative, either because the value is a time difference, or because |
| 33 | ;; the machine supports negative time stamps that fall before the | 33 | ;; the machine supports negative time stamps that fall before the epoch. |
| 34 | ;; epoch. The macro `with-decoded-time-value' and the | 34 | ;; The macro `with-decoded-time-value' and the function |
| 35 | ;; function `encode-time-value' make it easier to deal with these | 35 | ;; `encode-time-value' make it easier to deal with these formats. |
| 36 | ;; three formats. See `time-subtract' for an example of how to use | 36 | ;; See `time-subtract' for an example of how to use them. |
| 37 | ;; them. | ||
| 38 | 37 | ||
| 39 | ;;; Code: | 38 | ;;; Code: |
| 40 | 39 | ||
| @@ -134,9 +133,7 @@ If DATE lacks timezone information, GMT is assumed." | |||
| 134 | ;;;###autoload(if (or (featurep 'emacs) | 133 | ;;;###autoload(if (or (featurep 'emacs) |
| 135 | ;;;###autoload (and (fboundp 'float-time) | 134 | ;;;###autoload (and (fboundp 'float-time) |
| 136 | ;;;###autoload (subrp (symbol-function 'float-time)))) | 135 | ;;;###autoload (subrp (symbol-function 'float-time)))) |
| 137 | ;;;###autoload (progn | 136 | ;;;###autoload (defalias 'time-to-seconds 'float-time) |
| 138 | ;;;###autoload (defalias 'time-to-seconds 'float-time) | ||
| 139 | ;;;###autoload (make-obsolete 'time-to-seconds 'float-time "21.1")) | ||
| 140 | ;;;###autoload (autoload 'time-to-seconds "time-date")) | 137 | ;;;###autoload (autoload 'time-to-seconds "time-date")) |
| 141 | 138 | ||
| 142 | (eval-when-compile | 139 | (eval-when-compile |
diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index a01ce4c30a3..cdfb357b646 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog | |||
| @@ -1,12 +1,17 @@ | |||
| 1 | 2012-11-19 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * semantic/fw.el (semantic-make-local-hook, semantic-mode-line-update): | ||
| 4 | Simplify via CSE. | ||
| 5 | |||
| 1 | 2012-11-16 David Engster <deng@randomsample.de> | 6 | 2012-11-16 David Engster <deng@randomsample.de> |
| 2 | 7 | ||
| 3 | * semantic/symref/list.el (semantic-symref-symbol): Use | 8 | * semantic/symref/list.el (semantic-symref-symbol): |
| 4 | `semantic-complete-read-tag-project' instead of | 9 | Use `semantic-complete-read-tag-project' instead of |
| 5 | `semantic-complete-read-tag-buffer-deep', since the latter is not | 10 | `semantic-complete-read-tag-buffer-deep', since the latter is not |
| 6 | working correctly. | 11 | working correctly. |
| 7 | 12 | ||
| 8 | * semantic/symref.el (semantic-symref-result-get-tags): Use | 13 | * semantic/symref.el (semantic-symref-result-get-tags): |
| 9 | `find-buffer-visiting' to follow symbolic links. | 14 | Use `find-buffer-visiting' to follow symbolic links. |
| 10 | 15 | ||
| 11 | * semantic/fw.el (semantic-find-file-noselect): Always set | 16 | * semantic/fw.el (semantic-find-file-noselect): Always set |
| 12 | `enable-local-variables' to `:safe' when loading files. | 17 | `enable-local-variables' to `:safe' when loading files. |
diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el index 14ffc808c44..6dd85309967 100644 --- a/lisp/cedet/semantic/fw.el +++ b/lisp/cedet/semantic/fw.el | |||
| @@ -122,15 +122,13 @@ | |||
| 122 | ) | 122 | ) |
| 123 | 123 | ||
| 124 | 124 | ||
| 125 | (if (and (not (featurep 'xemacs)) | 125 | (defalias 'semantic-make-local-hook |
| 126 | (>= emacs-major-version 21)) | 126 | (if (and (not (featurep 'xemacs)) |
| 127 | (defalias 'semantic-make-local-hook 'identity) | 127 | (>= emacs-major-version 21)) |
| 128 | (defalias 'semantic-make-local-hook 'make-local-hook) | 128 | #'identity #'make-local-hook)) |
| 129 | ) | ||
| 130 | 129 | ||
| 131 | (if (featurep 'xemacs) | 130 | (defalias 'semantic-mode-line-update |
| 132 | (defalias 'semantic-mode-line-update 'redraw-modeline) | 131 | (if (featurep 'xemacs) #'redraw-modeline #'force-mode-line-update)) |
| 133 | (defalias 'semantic-mode-line-update 'force-mode-line-update)) | ||
| 134 | 132 | ||
| 135 | ;; Since Emacs 22 major mode functions should use `run-mode-hooks' to | 133 | ;; Since Emacs 22 major mode functions should use `run-mode-hooks' to |
| 136 | ;; run major mode hooks. | 134 | ;; run major mode hooks. |
diff --git a/lisp/color.el b/lisp/color.el index b915beacb0a..e1563ea474c 100644 --- a/lisp/color.el +++ b/lisp/color.el | |||
| @@ -33,9 +33,6 @@ | |||
| 33 | 33 | ||
| 34 | ;;; Code: | 34 | ;;; Code: |
| 35 | 35 | ||
| 36 | (eval-when-compile | ||
| 37 | (require 'cl)) | ||
| 38 | |||
| 39 | ;; Emacs < 23.3 | 36 | ;; Emacs < 23.3 |
| 40 | (eval-and-compile | 37 | (eval-and-compile |
| 41 | (unless (boundp 'float-pi) | 38 | (unless (boundp 'float-pi) |
| @@ -69,9 +66,9 @@ RED, GREEN, and BLUE should be numbers between 0.0 and 1.0, inclusive." | |||
| 69 | COLOR-NAME should be a string naming a color (e.g. \"white\"), or | 66 | COLOR-NAME should be a string naming a color (e.g. \"white\"), or |
| 70 | a string specifying a color's RGB components (e.g. \"#ff12ec\")." | 67 | a string specifying a color's RGB components (e.g. \"#ff12ec\")." |
| 71 | (let ((color (color-name-to-rgb color-name))) | 68 | (let ((color (color-name-to-rgb color-name))) |
| 72 | (list (- 1.0 (car color)) | 69 | (list (- 1.0 (nth 0 color)) |
| 73 | (- 1.0 (cadr color)) | 70 | (- 1.0 (nth 1 color)) |
| 74 | (- 1.0 (caddr color))))) | 71 | (- 1.0 (nth 2 color))))) |
| 75 | 72 | ||
| 76 | (defun color-gradient (start stop step-number) | 73 | (defun color-gradient (start stop step-number) |
| 77 | "Return a list with STEP-NUMBER colors from START to STOP. | 74 | "Return a list with STEP-NUMBER colors from START to STOP. |
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 462b4a25154..b4582a41d6c 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el | |||
| @@ -81,8 +81,14 @@ The return value of this function is not used." | |||
| 81 | #'(lambda (f _args new-name when) | 81 | #'(lambda (f _args new-name when) |
| 82 | `(make-obsolete ',f ',new-name ,when))) | 82 | `(make-obsolete ',f ',new-name ,when))) |
| 83 | (list 'compiler-macro | 83 | (list 'compiler-macro |
| 84 | #'(lambda (f _args compiler-function) | 84 | #'(lambda (f args compiler-function) |
| 85 | `(put ',f 'compiler-macro #',compiler-function))) | 85 | ;; FIXME: Make it possible to just reuse `args'. |
| 86 | `(eval-and-compile | ||
| 87 | (put ',f 'compiler-macro | ||
| 88 | ,(if (eq (car-safe compiler-function) 'lambda) | ||
| 89 | `(lambda ,(append (cadr compiler-function) args) | ||
| 90 | ,@(cddr compiler-function)) | ||
| 91 | `#',compiler-function))))) | ||
| 86 | (list 'doc-string | 92 | (list 'doc-string |
| 87 | #'(lambda (f _args pos) | 93 | #'(lambda (f _args pos) |
| 88 | (list 'put (list 'quote f) ''doc-string-elt (list 'quote pos)))) | 94 | (list 'put (list 'quote f) ''doc-string-elt (list 'quote pos)))) |
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index a325e0f3e44..60036c86dc0 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el | |||
| @@ -2509,8 +2509,8 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 2509 | (when (symbolp form) | 2509 | (when (symbolp form) |
| 2510 | (unless (memq (car-safe fun) '(closure lambda)) | 2510 | (unless (memq (car-safe fun) '(closure lambda)) |
| 2511 | (error "Don't know how to compile %S" fun)) | 2511 | (error "Don't know how to compile %S" fun)) |
| 2512 | (setq fun (byte-compile--reify-function fun)) | 2512 | (setq lexical-binding (eq (car fun) 'closure)) |
| 2513 | (setq lexical-binding (eq (car fun) 'closure))) | 2513 | (setq fun (byte-compile--reify-function fun))) |
| 2514 | (unless (eq (car-safe fun) 'lambda) | 2514 | (unless (eq (car-safe fun) 'lambda) |
| 2515 | (error "Don't know how to compile %S" fun)) | 2515 | (error "Don't know how to compile %S" fun)) |
| 2516 | ;; Expand macros. | 2516 | ;; Expand macros. |
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 483ed64de20..12311711fe0 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el | |||
| @@ -4268,6 +4268,21 @@ With prefix argument, make it a temporary breakpoint." | |||
| 4268 | 4268 | ||
| 4269 | ;;; Finalize Loading | 4269 | ;;; Finalize Loading |
| 4270 | 4270 | ||
| 4271 | ;; When edebugging a function, some of the sub-expressions are | ||
| 4272 | ;; wrapped in (edebug-enter (lambda () ..)), so we need to teach | ||
| 4273 | ;; called-interactively-p that calls within the inner lambda should refer to | ||
| 4274 | ;; the outside function. | ||
| 4275 | (add-hook 'called-interactively-p-functions | ||
| 4276 | #'edebug--called-interactively-skip) | ||
| 4277 | (defun edebug--called-interactively-skip (i frame1 frame2) | ||
| 4278 | (when (and (eq (car-safe (nth 1 frame1)) 'lambda) | ||
| 4279 | (eq (nth 1 (nth 1 frame1)) '()) | ||
| 4280 | (eq (nth 1 frame2) 'edebug-enter)) | ||
| 4281 | ;; `edebug-enter' calls itself on its first invocation. | ||
| 4282 | (if (eq (nth 1 (internal--called-interactively-p--get-frame i)) | ||
| 4283 | 'edebug-enter) | ||
| 4284 | 2 1))) | ||
| 4285 | |||
| 4271 | ;; Finally, hook edebug into the rest of Emacs. | 4286 | ;; Finally, hook edebug into the rest of Emacs. |
| 4272 | ;; There are probably some other things that could go here. | 4287 | ;; There are probably some other things that could go here. |
| 4273 | 4288 | ||
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index c3b8e5e10d4..60d74774e87 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; ert-x.el --- Staging area for experimental extensions to ERT | 1 | ;;; ert-x.el --- Staging area for experimental extensions to ERT -*- lexical-binding: t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2008, 2010-2012 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2008, 2010-2012 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -28,8 +28,7 @@ | |||
| 28 | 28 | ||
| 29 | ;;; Code: | 29 | ;;; Code: |
| 30 | 30 | ||
| 31 | (eval-when-compile | 31 | (eval-when-compile (require 'cl-lib)) |
| 32 | (require 'cl)) | ||
| 33 | (require 'ert) | 32 | (require 'ert) |
| 34 | 33 | ||
| 35 | 34 | ||
| @@ -90,8 +89,8 @@ ERT--THUNK with that buffer as current." | |||
| 90 | (kill-buffer ert--buffer) | 89 | (kill-buffer ert--buffer) |
| 91 | (remhash ert--buffer ert--test-buffers)))) | 90 | (remhash ert--buffer ert--test-buffers)))) |
| 92 | 91 | ||
| 93 | (defmacro* ert-with-test-buffer ((&key ((:name name-form))) | 92 | (cl-defmacro ert-with-test-buffer ((&key ((:name name-form))) |
| 94 | &body body) | 93 | &body body) |
| 95 | "Create a test buffer and run BODY in that buffer. | 94 | "Create a test buffer and run BODY in that buffer. |
| 96 | 95 | ||
| 97 | To be used in ERT tests. If BODY finishes successfully, the test | 96 | To be used in ERT tests. If BODY finishes successfully, the test |
| @@ -116,10 +115,10 @@ the name of the test and the result of NAME-FORM." | |||
| 116 | "Kill all test buffers that are still live." | 115 | "Kill all test buffers that are still live." |
| 117 | (interactive) | 116 | (interactive) |
| 118 | (let ((count 0)) | 117 | (let ((count 0)) |
| 119 | (maphash (lambda (buffer dummy) | 118 | (maphash (lambda (buffer _dummy) |
| 120 | (when (or (not (buffer-live-p buffer)) | 119 | (when (or (not (buffer-live-p buffer)) |
| 121 | (kill-buffer buffer)) | 120 | (kill-buffer buffer)) |
| 122 | (incf count))) | 121 | (cl-incf count))) |
| 123 | ert--test-buffers) | 122 | ert--test-buffers) |
| 124 | (message "%s out of %s test buffers killed" | 123 | (message "%s out of %s test buffers killed" |
| 125 | count (hash-table-count ert--test-buffers))) | 124 | count (hash-table-count ert--test-buffers))) |
| @@ -149,9 +148,9 @@ the rest are arguments to the command. | |||
| 149 | 148 | ||
| 150 | NOTE: Since the command is not called by `call-interactively' | 149 | NOTE: Since the command is not called by `call-interactively' |
| 151 | test for `called-interactively' in the command will fail." | 150 | test for `called-interactively' in the command will fail." |
| 152 | (assert (listp command) t) | 151 | (cl-assert (listp command) t) |
| 153 | (assert (commandp (car command)) t) | 152 | (cl-assert (commandp (car command)) t) |
| 154 | (assert (not unread-command-events) t) | 153 | (cl-assert (not unread-command-events) t) |
| 155 | (let (return-value) | 154 | (let (return-value) |
| 156 | ;; For the order of things here see command_loop_1 in keyboard.c. | 155 | ;; For the order of things here see command_loop_1 in keyboard.c. |
| 157 | ;; | 156 | ;; |
| @@ -175,7 +174,7 @@ test for `called-interactively' in the command will fail." | |||
| 175 | (when (boundp 'last-repeatable-command) | 174 | (when (boundp 'last-repeatable-command) |
| 176 | (setq last-repeatable-command real-last-command)) | 175 | (setq last-repeatable-command real-last-command)) |
| 177 | (when (and deactivate-mark transient-mark-mode) (deactivate-mark)) | 176 | (when (and deactivate-mark transient-mark-mode) (deactivate-mark)) |
| 178 | (assert (not unread-command-events) t) | 177 | (cl-assert (not unread-command-events) t) |
| 179 | return-value)) | 178 | return-value)) |
| 180 | 179 | ||
| 181 | (defun ert-run-idle-timers () | 180 | (defun ert-run-idle-timers () |
| @@ -198,7 +197,7 @@ rather than the entire match." | |||
| 198 | (with-temp-buffer | 197 | (with-temp-buffer |
| 199 | (insert s) | 198 | (insert s) |
| 200 | (dolist (x regexps) | 199 | (dolist (x regexps) |
| 201 | (destructuring-bind (regexp subexp) (if (listp x) x `(,x nil)) | 200 | (cl-destructuring-bind (regexp subexp) (if (listp x) x `(,x nil)) |
| 202 | (goto-char (point-min)) | 201 | (goto-char (point-min)) |
| 203 | (while (re-search-forward regexp nil t) | 202 | (while (re-search-forward regexp nil t) |
| 204 | (replace-match "" t t nil subexp)))) | 203 | (replace-match "" t t nil subexp)))) |
| @@ -224,15 +223,15 @@ would return the string \"foo bar baz quux\" where the substring | |||
| 224 | None of the ARGS are modified, but the return value may share | 223 | None of the ARGS are modified, but the return value may share |
| 225 | structure with the plists in ARGS." | 224 | structure with the plists in ARGS." |
| 226 | (with-temp-buffer | 225 | (with-temp-buffer |
| 227 | (loop with current-plist = nil | 226 | (cl-loop with current-plist = nil |
| 228 | for x in args do | 227 | for x in args do |
| 229 | (etypecase x | 228 | (cl-etypecase x |
| 230 | (string (let ((begin (point))) | 229 | (string (let ((begin (point))) |
| 231 | (insert x) | 230 | (insert x) |
| 232 | (set-text-properties begin (point) current-plist))) | 231 | (set-text-properties begin (point) current-plist))) |
| 233 | (list (unless (zerop (mod (length x) 2)) | 232 | (list (unless (zerop (mod (length x) 2)) |
| 234 | (error "Odd number of args in plist: %S" x)) | 233 | (error "Odd number of args in plist: %S" x)) |
| 235 | (setq current-plist x)))) | 234 | (setq current-plist x)))) |
| 236 | (buffer-string))) | 235 | (buffer-string))) |
| 237 | 236 | ||
| 238 | 237 | ||
| @@ -245,8 +244,8 @@ buffer, and renames the original buffer back to BUFFER-NAME. | |||
| 245 | 244 | ||
| 246 | This is useful if THUNK has undesirable side-effects on an Emacs | 245 | This is useful if THUNK has undesirable side-effects on an Emacs |
| 247 | buffer with a fixed name such as *Messages*." | 246 | buffer with a fixed name such as *Messages*." |
| 248 | (lexical-let ((new-buffer-name (generate-new-buffer-name | 247 | (let ((new-buffer-name (generate-new-buffer-name |
| 249 | (format "%s orig buffer" buffer-name)))) | 248 | (format "%s orig buffer" buffer-name)))) |
| 250 | (with-current-buffer (get-buffer-create buffer-name) | 249 | (with-current-buffer (get-buffer-create buffer-name) |
| 251 | (rename-buffer new-buffer-name)) | 250 | (rename-buffer new-buffer-name)) |
| 252 | (unwind-protect | 251 | (unwind-protect |
| @@ -258,7 +257,7 @@ buffer with a fixed name such as *Messages*." | |||
| 258 | (with-current-buffer new-buffer-name | 257 | (with-current-buffer new-buffer-name |
| 259 | (rename-buffer buffer-name))))) | 258 | (rename-buffer buffer-name))))) |
| 260 | 259 | ||
| 261 | (defmacro* ert-with-buffer-renamed ((buffer-name-form) &body body) | 260 | (cl-defmacro ert-with-buffer-renamed ((buffer-name-form) &body body) |
| 262 | "Protect the buffer named BUFFER-NAME from side-effects and run BODY. | 261 | "Protect the buffer named BUFFER-NAME from side-effects and run BODY. |
| 263 | 262 | ||
| 264 | See `ert-call-with-buffer-renamed' for details." | 263 | See `ert-call-with-buffer-renamed' for details." |
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index ff00be7a237..ab6dcb58143 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; ert.el --- Emacs Lisp Regression Testing | 1 | ;;; ert.el --- Emacs Lisp Regression Testing -*- lexical-binding: t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2007-2008, 2010-2012 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2007-2008, 2010-2012 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -54,8 +54,7 @@ | |||
| 54 | 54 | ||
| 55 | ;;; Code: | 55 | ;;; Code: |
| 56 | 56 | ||
| 57 | (eval-when-compile | 57 | (eval-when-compile (require 'cl-lib)) |
| 58 | (require 'cl)) | ||
| 59 | (require 'button) | 58 | (require 'button) |
| 60 | (require 'debug) | 59 | (require 'debug) |
| 61 | (require 'easymenu) | 60 | (require 'easymenu) |
| @@ -105,33 +104,33 @@ | |||
| 105 | "A reimplementation of `remove-if-not'. | 104 | "A reimplementation of `remove-if-not'. |
| 106 | 105 | ||
| 107 | ERT-PRED is a predicate, ERT-LIST is the input list." | 106 | ERT-PRED is a predicate, ERT-LIST is the input list." |
| 108 | (loop for ert-x in ert-list | 107 | (cl-loop for ert-x in ert-list |
| 109 | if (funcall ert-pred ert-x) | 108 | if (funcall ert-pred ert-x) |
| 110 | collect ert-x)) | 109 | collect ert-x)) |
| 111 | 110 | ||
| 112 | (defun ert--intersection (a b) | 111 | (defun ert--intersection (a b) |
| 113 | "A reimplementation of `intersection'. Intersect the sets A and B. | 112 | "A reimplementation of `intersection'. Intersect the sets A and B. |
| 114 | 113 | ||
| 115 | Elements are compared using `eql'." | 114 | Elements are compared using `eql'." |
| 116 | (loop for x in a | 115 | (cl-loop for x in a |
| 117 | if (memql x b) | 116 | if (memql x b) |
| 118 | collect x)) | 117 | collect x)) |
| 119 | 118 | ||
| 120 | (defun ert--set-difference (a b) | 119 | (defun ert--set-difference (a b) |
| 121 | "A reimplementation of `set-difference'. Subtract the set B from the set A. | 120 | "A reimplementation of `set-difference'. Subtract the set B from the set A. |
| 122 | 121 | ||
| 123 | Elements are compared using `eql'." | 122 | Elements are compared using `eql'." |
| 124 | (loop for x in a | 123 | (cl-loop for x in a |
| 125 | unless (memql x b) | 124 | unless (memql x b) |
| 126 | collect x)) | 125 | collect x)) |
| 127 | 126 | ||
| 128 | (defun ert--set-difference-eq (a b) | 127 | (defun ert--set-difference-eq (a b) |
| 129 | "A reimplementation of `set-difference'. Subtract the set B from the set A. | 128 | "A reimplementation of `set-difference'. Subtract the set B from the set A. |
| 130 | 129 | ||
| 131 | Elements are compared using `eq'." | 130 | Elements are compared using `eq'." |
| 132 | (loop for x in a | 131 | (cl-loop for x in a |
| 133 | unless (memq x b) | 132 | unless (memq x b) |
| 134 | collect x)) | 133 | collect x)) |
| 135 | 134 | ||
| 136 | (defun ert--union (a b) | 135 | (defun ert--union (a b) |
| 137 | "A reimplementation of `union'. Compute the union of the sets A and B. | 136 | "A reimplementation of `union'. Compute the union of the sets A and B. |
| @@ -149,7 +148,7 @@ Elements are compared using `eql'." | |||
| 149 | (make-symbol (format "%s%s" | 148 | (make-symbol (format "%s%s" |
| 150 | prefix | 149 | prefix |
| 151 | (prog1 ert--gensym-counter | 150 | (prog1 ert--gensym-counter |
| 152 | (incf ert--gensym-counter)))))) | 151 | (cl-incf ert--gensym-counter)))))) |
| 153 | 152 | ||
| 154 | (defun ert--coerce-to-vector (x) | 153 | (defun ert--coerce-to-vector (x) |
| 155 | "Coerce X to a vector." | 154 | "Coerce X to a vector." |
| @@ -158,19 +157,19 @@ Elements are compared using `eql'." | |||
| 158 | x | 157 | x |
| 159 | (vconcat x))) | 158 | (vconcat x))) |
| 160 | 159 | ||
| 161 | (defun* ert--remove* (x list &key key test) | 160 | (cl-defun ert--remove* (x list &key key test) |
| 162 | "Does not support all the keywords of remove*." | 161 | "Does not support all the keywords of remove*." |
| 163 | (unless key (setq key #'identity)) | 162 | (unless key (setq key #'identity)) |
| 164 | (unless test (setq test #'eql)) | 163 | (unless test (setq test #'eql)) |
| 165 | (loop for y in list | 164 | (cl-loop for y in list |
| 166 | unless (funcall test x (funcall key y)) | 165 | unless (funcall test x (funcall key y)) |
| 167 | collect y)) | 166 | collect y)) |
| 168 | 167 | ||
| 169 | (defun ert--string-position (c s) | 168 | (defun ert--string-position (c s) |
| 170 | "Return the position of the first occurrence of C in S, or nil if none." | 169 | "Return the position of the first occurrence of C in S, or nil if none." |
| 171 | (loop for i from 0 | 170 | (cl-loop for i from 0 |
| 172 | for x across s | 171 | for x across s |
| 173 | when (eql x c) return i)) | 172 | when (eql x c) return i)) |
| 174 | 173 | ||
| 175 | (defun ert--mismatch (a b) | 174 | (defun ert--mismatch (a b) |
| 176 | "Return index of first element that differs between A and B. | 175 | "Return index of first element that differs between A and B. |
| @@ -184,29 +183,30 @@ Like `mismatch'. Uses `equal' for comparison." | |||
| 184 | (t | 183 | (t |
| 185 | (let ((la (length a)) | 184 | (let ((la (length a)) |
| 186 | (lb (length b))) | 185 | (lb (length b))) |
| 187 | (assert (arrayp a) t) | 186 | (cl-assert (arrayp a) t) |
| 188 | (assert (arrayp b) t) | 187 | (cl-assert (arrayp b) t) |
| 189 | (assert (<= la lb) t) | 188 | (cl-assert (<= la lb) t) |
| 190 | (loop for i below la | 189 | (cl-loop for i below la |
| 191 | when (not (equal (aref a i) (aref b i))) return i | 190 | when (not (equal (aref a i) (aref b i))) return i |
| 192 | finally (return (if (/= la lb) | 191 | finally (cl-return (if (/= la lb) |
| 193 | la | 192 | la |
| 194 | (assert (equal a b) t) | 193 | (cl-assert (equal a b) t) |
| 195 | nil))))))) | 194 | nil))))))) |
| 196 | 195 | ||
| 197 | (defun ert--subseq (seq start &optional end) | 196 | (defun ert--subseq (seq start &optional end) |
| 198 | "Return a subsequence of SEQ from START to END." | 197 | "Return a subsequence of SEQ from START to END." |
| 199 | (when (char-table-p seq) (error "Not supported")) | 198 | (when (char-table-p seq) (error "Not supported")) |
| 200 | (let ((vector (substring (ert--coerce-to-vector seq) start end))) | 199 | (let ((vector (substring (ert--coerce-to-vector seq) start end))) |
| 201 | (etypecase seq | 200 | (cl-etypecase seq |
| 202 | (vector vector) | 201 | (vector vector) |
| 203 | (string (concat vector)) | 202 | (string (concat vector)) |
| 204 | (list (append vector nil)) | 203 | (list (append vector nil)) |
| 205 | (bool-vector (loop with result = (make-bool-vector (length vector) nil) | 204 | (bool-vector (cl-loop with result |
| 206 | for i below (length vector) do | 205 | = (make-bool-vector (length vector) nil) |
| 207 | (setf (aref result i) (aref vector i)) | 206 | for i below (length vector) do |
| 208 | finally (return result))) | 207 | (setf (aref result i) (aref vector i)) |
| 209 | (char-table (assert nil))))) | 208 | finally (cl-return result))) |
| 209 | (char-table (cl-assert nil))))) | ||
| 210 | 210 | ||
| 211 | (defun ert-equal-including-properties (a b) | 211 | (defun ert-equal-including-properties (a b) |
| 212 | "Return t if A and B have similar structure and contents. | 212 | "Return t if A and B have similar structure and contents. |
| @@ -225,10 +225,10 @@ Emacs bug 6581 at URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'." | |||
| 225 | ;;; Defining and locating tests. | 225 | ;;; Defining and locating tests. |
| 226 | 226 | ||
| 227 | ;; The data structure that represents a test case. | 227 | ;; The data structure that represents a test case. |
| 228 | (defstruct ert-test | 228 | (cl-defstruct ert-test |
| 229 | (name nil) | 229 | (name nil) |
| 230 | (documentation nil) | 230 | (documentation nil) |
| 231 | (body (assert nil)) | 231 | (body (cl-assert nil)) |
| 232 | (most-recent-result nil) | 232 | (most-recent-result nil) |
| 233 | (expected-result-type ':passed) | 233 | (expected-result-type ':passed) |
| 234 | (tags '())) | 234 | (tags '())) |
| @@ -273,7 +273,7 @@ Returns a two-element list containing the keys-and-values plist | |||
| 273 | and the body." | 273 | and the body." |
| 274 | (let ((extracted-key-accu '()) | 274 | (let ((extracted-key-accu '()) |
| 275 | (remaining keys-and-body)) | 275 | (remaining keys-and-body)) |
| 276 | (while (and (consp remaining) (keywordp (first remaining))) | 276 | (while (keywordp (car-safe remaining)) |
| 277 | (let ((keyword (pop remaining))) | 277 | (let ((keyword (pop remaining))) |
| 278 | (unless (consp remaining) | 278 | (unless (consp remaining) |
| 279 | (error "Value expected after keyword %S in %S" | 279 | (error "Value expected after keyword %S in %S" |
| @@ -283,13 +283,13 @@ and the body." | |||
| 283 | keys-and-body)) | 283 | keys-and-body)) |
| 284 | (push (cons keyword (pop remaining)) extracted-key-accu))) | 284 | (push (cons keyword (pop remaining)) extracted-key-accu))) |
| 285 | (setq extracted-key-accu (nreverse extracted-key-accu)) | 285 | (setq extracted-key-accu (nreverse extracted-key-accu)) |
| 286 | (list (loop for (key . value) in extracted-key-accu | 286 | (list (cl-loop for (key . value) in extracted-key-accu |
| 287 | collect key | 287 | collect key |
| 288 | collect value) | 288 | collect value) |
| 289 | remaining))) | 289 | remaining))) |
| 290 | 290 | ||
| 291 | ;;;###autoload | 291 | ;;;###autoload |
| 292 | (defmacro* ert-deftest (name () &body docstring-keys-and-body) | 292 | (cl-defmacro ert-deftest (name () &body docstring-keys-and-body) |
| 293 | "Define NAME (a symbol) as a test. | 293 | "Define NAME (a symbol) as a test. |
| 294 | 294 | ||
| 295 | BODY is evaluated as a `progn' when the test is run. It should | 295 | BODY is evaluated as a `progn' when the test is run. It should |
| @@ -313,12 +313,13 @@ description of valid values for RESULT-TYPE. | |||
| 313 | (indent 2)) | 313 | (indent 2)) |
| 314 | (let ((documentation nil) | 314 | (let ((documentation nil) |
| 315 | (documentation-supplied-p nil)) | 315 | (documentation-supplied-p nil)) |
| 316 | (when (stringp (first docstring-keys-and-body)) | 316 | (when (stringp (car docstring-keys-and-body)) |
| 317 | (setq documentation (pop docstring-keys-and-body) | 317 | (setq documentation (pop docstring-keys-and-body) |
| 318 | documentation-supplied-p t)) | 318 | documentation-supplied-p t)) |
| 319 | (destructuring-bind ((&key (expected-result nil expected-result-supplied-p) | 319 | (cl-destructuring-bind |
| 320 | (tags nil tags-supplied-p)) | 320 | ((&key (expected-result nil expected-result-supplied-p) |
| 321 | body) | 321 | (tags nil tags-supplied-p)) |
| 322 | body) | ||
| 322 | (ert--parse-keys-and-body docstring-keys-and-body) | 323 | (ert--parse-keys-and-body docstring-keys-and-body) |
| 323 | `(progn | 324 | `(progn |
| 324 | (ert-set-test ',name | 325 | (ert-set-test ',name |
| @@ -388,16 +389,11 @@ DATA is displayed to the user and should state the reason of the failure." | |||
| 388 | (defun ert--expand-should-1 (whole form inner-expander) | 389 | (defun ert--expand-should-1 (whole form inner-expander) |
| 389 | "Helper function for the `should' macro and its variants." | 390 | "Helper function for the `should' macro and its variants." |
| 390 | (let ((form | 391 | (let ((form |
| 391 | ;; If `cl-macroexpand' isn't bound, the code that we're | 392 | (macroexpand form (cond |
| 392 | ;; compiling doesn't depend on cl and thus doesn't need an | 393 | ((boundp 'macroexpand-all-environment) |
| 393 | ;; environment arg for `macroexpand'. | 394 | macroexpand-all-environment) |
| 394 | (if (fboundp 'cl-macroexpand) | 395 | ((boundp 'cl-macro-environment) |
| 395 | ;; Suppress warning about run-time call to cl function: we | 396 | cl-macro-environment))))) |
| 396 | ;; only call it if it's fboundp. | ||
| 397 | (with-no-warnings | ||
| 398 | (cl-macroexpand form (and (boundp 'cl-macro-environment) | ||
| 399 | cl-macro-environment))) | ||
| 400 | (macroexpand form)))) | ||
| 401 | (cond | 397 | (cond |
| 402 | ((or (atom form) (ert--special-operator-p (car form))) | 398 | ((or (atom form) (ert--special-operator-p (car form))) |
| 403 | (let ((value (ert--gensym "value-"))) | 399 | (let ((value (ert--gensym "value-"))) |
| @@ -410,10 +406,10 @@ DATA is displayed to the user and should state the reason of the failure." | |||
| 410 | (t | 406 | (t |
| 411 | (let ((fn-name (car form)) | 407 | (let ((fn-name (car form)) |
| 412 | (arg-forms (cdr form))) | 408 | (arg-forms (cdr form))) |
| 413 | (assert (or (symbolp fn-name) | 409 | (cl-assert (or (symbolp fn-name) |
| 414 | (and (consp fn-name) | 410 | (and (consp fn-name) |
| 415 | (eql (car fn-name) 'lambda) | 411 | (eql (car fn-name) 'lambda) |
| 416 | (listp (cdr fn-name))))) | 412 | (listp (cdr fn-name))))) |
| 417 | (let ((fn (ert--gensym "fn-")) | 413 | (let ((fn (ert--gensym "fn-")) |
| 418 | (args (ert--gensym "args-")) | 414 | (args (ert--gensym "args-")) |
| 419 | (value (ert--gensym "value-")) | 415 | (value (ert--gensym "value-")) |
| @@ -451,35 +447,34 @@ should return code that calls INNER-FORM and performs the checks | |||
| 451 | and error signaling specific to the particular variant of | 447 | and error signaling specific to the particular variant of |
| 452 | `should'. The code that INNER-EXPANDER returns must not call | 448 | `should'. The code that INNER-EXPANDER returns must not call |
| 453 | FORM-DESCRIPTION-FORM before it has called INNER-FORM." | 449 | FORM-DESCRIPTION-FORM before it has called INNER-FORM." |
| 454 | (lexical-let ((inner-expander inner-expander)) | 450 | (ert--expand-should-1 |
| 455 | (ert--expand-should-1 | 451 | whole form |
| 456 | whole form | 452 | (lambda (inner-form form-description-form value-var) |
| 457 | (lambda (inner-form form-description-form value-var) | 453 | (let ((form-description (ert--gensym "form-description-"))) |
| 458 | (let ((form-description (ert--gensym "form-description-"))) | 454 | `(let (,form-description) |
| 459 | `(let (,form-description) | 455 | ,(funcall inner-expander |
| 460 | ,(funcall inner-expander | 456 | `(unwind-protect |
| 461 | `(unwind-protect | 457 | ,inner-form |
| 462 | ,inner-form | 458 | (setq ,form-description ,form-description-form) |
| 463 | (setq ,form-description ,form-description-form) | 459 | (ert--signal-should-execution ,form-description)) |
| 464 | (ert--signal-should-execution ,form-description)) | 460 | `,form-description |
| 465 | `,form-description | 461 | value-var)))))) |
| 466 | value-var))))))) | 462 | |
| 467 | 463 | (cl-defmacro should (form) | |
| 468 | (defmacro* should (form) | ||
| 469 | "Evaluate FORM. If it returns nil, abort the current test as failed. | 464 | "Evaluate FORM. If it returns nil, abort the current test as failed. |
| 470 | 465 | ||
| 471 | Returns the value of FORM." | 466 | Returns the value of FORM." |
| 472 | (ert--expand-should `(should ,form) form | 467 | (ert--expand-should `(should ,form) form |
| 473 | (lambda (inner-form form-description-form value-var) | 468 | (lambda (inner-form form-description-form _value-var) |
| 474 | `(unless ,inner-form | 469 | `(unless ,inner-form |
| 475 | (ert-fail ,form-description-form))))) | 470 | (ert-fail ,form-description-form))))) |
| 476 | 471 | ||
| 477 | (defmacro* should-not (form) | 472 | (cl-defmacro should-not (form) |
| 478 | "Evaluate FORM. If it returns non-nil, abort the current test as failed. | 473 | "Evaluate FORM. If it returns non-nil, abort the current test as failed. |
| 479 | 474 | ||
| 480 | Returns nil." | 475 | Returns nil." |
| 481 | (ert--expand-should `(should-not ,form) form | 476 | (ert--expand-should `(should-not ,form) form |
| 482 | (lambda (inner-form form-description-form value-var) | 477 | (lambda (inner-form form-description-form _value-var) |
| 483 | `(unless (not ,inner-form) | 478 | `(unless (not ,inner-form) |
| 484 | (ert-fail ,form-description-form))))) | 479 | (ert-fail ,form-description-form))))) |
| 485 | 480 | ||
| @@ -490,10 +485,10 @@ Returns nil." | |||
| 490 | Determines whether CONDITION matches TYPE and EXCLUDE-SUBTYPES, | 485 | Determines whether CONDITION matches TYPE and EXCLUDE-SUBTYPES, |
| 491 | and aborts the current test as failed if it doesn't." | 486 | and aborts the current test as failed if it doesn't." |
| 492 | (let ((signaled-conditions (get (car condition) 'error-conditions)) | 487 | (let ((signaled-conditions (get (car condition) 'error-conditions)) |
| 493 | (handled-conditions (etypecase type | 488 | (handled-conditions (cl-etypecase type |
| 494 | (list type) | 489 | (list type) |
| 495 | (symbol (list type))))) | 490 | (symbol (list type))))) |
| 496 | (assert signaled-conditions) | 491 | (cl-assert signaled-conditions) |
| 497 | (unless (ert--intersection signaled-conditions handled-conditions) | 492 | (unless (ert--intersection signaled-conditions handled-conditions) |
| 498 | (ert-fail (append | 493 | (ert-fail (append |
| 499 | (funcall form-description-fn) | 494 | (funcall form-description-fn) |
| @@ -512,7 +507,7 @@ and aborts the current test as failed if it doesn't." | |||
| 512 | 507 | ||
| 513 | ;; FIXME: The expansion will evaluate the keyword args (if any) in | 508 | ;; FIXME: The expansion will evaluate the keyword args (if any) in |
| 514 | ;; nonstandard order. | 509 | ;; nonstandard order. |
| 515 | (defmacro* should-error (form &rest keys &key type exclude-subtypes) | 510 | (cl-defmacro should-error (form &rest keys &key type exclude-subtypes) |
| 516 | "Evaluate FORM and check that it signals an error. | 511 | "Evaluate FORM and check that it signals an error. |
| 517 | 512 | ||
| 518 | The error signaled needs to match TYPE. TYPE should be a list | 513 | The error signaled needs to match TYPE. TYPE should be a list |
| @@ -560,19 +555,19 @@ failed." | |||
| 560 | 555 | ||
| 561 | (defun ert--proper-list-p (x) | 556 | (defun ert--proper-list-p (x) |
| 562 | "Return non-nil if X is a proper list, nil otherwise." | 557 | "Return non-nil if X is a proper list, nil otherwise." |
| 563 | (loop | 558 | (cl-loop |
| 564 | for firstp = t then nil | 559 | for firstp = t then nil |
| 565 | for fast = x then (cddr fast) | 560 | for fast = x then (cddr fast) |
| 566 | for slow = x then (cdr slow) do | 561 | for slow = x then (cdr slow) do |
| 567 | (when (null fast) (return t)) | 562 | (when (null fast) (cl-return t)) |
| 568 | (when (not (consp fast)) (return nil)) | 563 | (when (not (consp fast)) (cl-return nil)) |
| 569 | (when (null (cdr fast)) (return t)) | 564 | (when (null (cdr fast)) (cl-return t)) |
| 570 | (when (not (consp (cdr fast))) (return nil)) | 565 | (when (not (consp (cdr fast))) (cl-return nil)) |
| 571 | (when (and (not firstp) (eq fast slow)) (return nil)))) | 566 | (when (and (not firstp) (eq fast slow)) (cl-return nil)))) |
| 572 | 567 | ||
| 573 | (defun ert--explain-format-atom (x) | 568 | (defun ert--explain-format-atom (x) |
| 574 | "Format the atom X for `ert--explain-equal'." | 569 | "Format the atom X for `ert--explain-equal'." |
| 575 | (typecase x | 570 | (cl-typecase x |
| 576 | (fixnum (list x (format "#x%x" x) (format "?%c" x))) | 571 | (fixnum (list x (format "#x%x" x) (format "?%c" x))) |
| 577 | (t x))) | 572 | (t x))) |
| 578 | 573 | ||
| @@ -581,7 +576,7 @@ failed." | |||
| 581 | Returns nil if they are." | 576 | Returns nil if they are." |
| 582 | (if (not (equal (type-of a) (type-of b))) | 577 | (if (not (equal (type-of a) (type-of b))) |
| 583 | `(different-types ,a ,b) | 578 | `(different-types ,a ,b) |
| 584 | (etypecase a | 579 | (cl-etypecase a |
| 585 | (cons | 580 | (cons |
| 586 | (let ((a-proper-p (ert--proper-list-p a)) | 581 | (let ((a-proper-p (ert--proper-list-p a)) |
| 587 | (b-proper-p (ert--proper-list-p b))) | 582 | (b-proper-p (ert--proper-list-p b))) |
| @@ -593,19 +588,19 @@ Returns nil if they are." | |||
| 593 | ,a ,b | 588 | ,a ,b |
| 594 | first-mismatch-at | 589 | first-mismatch-at |
| 595 | ,(ert--mismatch a b)) | 590 | ,(ert--mismatch a b)) |
| 596 | (loop for i from 0 | 591 | (cl-loop for i from 0 |
| 597 | for ai in a | 592 | for ai in a |
| 598 | for bi in b | 593 | for bi in b |
| 599 | for xi = (ert--explain-equal-rec ai bi) | 594 | for xi = (ert--explain-equal-rec ai bi) |
| 600 | do (when xi (return `(list-elt ,i ,xi))) | 595 | do (when xi (cl-return `(list-elt ,i ,xi))) |
| 601 | finally (assert (equal a b) t))) | 596 | finally (cl-assert (equal a b) t))) |
| 602 | (let ((car-x (ert--explain-equal-rec (car a) (car b)))) | 597 | (let ((car-x (ert--explain-equal-rec (car a) (car b)))) |
| 603 | (if car-x | 598 | (if car-x |
| 604 | `(car ,car-x) | 599 | `(car ,car-x) |
| 605 | (let ((cdr-x (ert--explain-equal-rec (cdr a) (cdr b)))) | 600 | (let ((cdr-x (ert--explain-equal-rec (cdr a) (cdr b)))) |
| 606 | (if cdr-x | 601 | (if cdr-x |
| 607 | `(cdr ,cdr-x) | 602 | `(cdr ,cdr-x) |
| 608 | (assert (equal a b) t) | 603 | (cl-assert (equal a b) t) |
| 609 | nil)))))))) | 604 | nil)))))))) |
| 610 | (array (if (not (equal (length a) (length b))) | 605 | (array (if (not (equal (length a) (length b))) |
| 611 | `(arrays-of-different-length ,(length a) ,(length b) | 606 | `(arrays-of-different-length ,(length a) ,(length b) |
| @@ -613,12 +608,12 @@ Returns nil if they are." | |||
| 613 | ,@(unless (char-table-p a) | 608 | ,@(unless (char-table-p a) |
| 614 | `(first-mismatch-at | 609 | `(first-mismatch-at |
| 615 | ,(ert--mismatch a b)))) | 610 | ,(ert--mismatch a b)))) |
| 616 | (loop for i from 0 | 611 | (cl-loop for i from 0 |
| 617 | for ai across a | 612 | for ai across a |
| 618 | for bi across b | 613 | for bi across b |
| 619 | for xi = (ert--explain-equal-rec ai bi) | 614 | for xi = (ert--explain-equal-rec ai bi) |
| 620 | do (when xi (return `(array-elt ,i ,xi))) | 615 | do (when xi (cl-return `(array-elt ,i ,xi))) |
| 621 | finally (assert (equal a b) t)))) | 616 | finally (cl-assert (equal a b) t)))) |
| 622 | (atom (if (not (equal a b)) | 617 | (atom (if (not (equal a b)) |
| 623 | (if (and (symbolp a) (symbolp b) (string= a b)) | 618 | (if (and (symbolp a) (symbolp b) (string= a b)) |
| 624 | `(different-symbols-with-the-same-name ,a ,b) | 619 | `(different-symbols-with-the-same-name ,a ,b) |
| @@ -637,10 +632,10 @@ Returns nil if they are." | |||
| 637 | 632 | ||
| 638 | (defun ert--significant-plist-keys (plist) | 633 | (defun ert--significant-plist-keys (plist) |
| 639 | "Return the keys of PLIST that have non-null values, in order." | 634 | "Return the keys of PLIST that have non-null values, in order." |
| 640 | (assert (zerop (mod (length plist) 2)) t) | 635 | (cl-assert (zerop (mod (length plist) 2)) t) |
| 641 | (loop for (key value . rest) on plist by #'cddr | 636 | (cl-loop for (key value . rest) on plist by #'cddr |
| 642 | unless (or (null value) (memq key accu)) collect key into accu | 637 | unless (or (null value) (memq key accu)) collect key into accu |
| 643 | finally (return accu))) | 638 | finally (cl-return accu))) |
| 644 | 639 | ||
| 645 | (defun ert--plist-difference-explanation (a b) | 640 | (defun ert--plist-difference-explanation (a b) |
| 646 | "Return a programmer-readable explanation of why A and B are different plists. | 641 | "Return a programmer-readable explanation of why A and B are different plists. |
| @@ -648,8 +643,8 @@ Returns nil if they are." | |||
| 648 | Returns nil if they are equivalent, i.e., have the same value for | 643 | Returns nil if they are equivalent, i.e., have the same value for |
| 649 | each key, where absent values are treated as nil. The order of | 644 | each key, where absent values are treated as nil. The order of |
| 650 | key/value pairs in each list does not matter." | 645 | key/value pairs in each list does not matter." |
| 651 | (assert (zerop (mod (length a) 2)) t) | 646 | (cl-assert (zerop (mod (length a) 2)) t) |
| 652 | (assert (zerop (mod (length b) 2)) t) | 647 | (cl-assert (zerop (mod (length b) 2)) t) |
| 653 | ;; Normalizing the plists would be another way to do this but it | 648 | ;; Normalizing the plists would be another way to do this but it |
| 654 | ;; requires a total ordering on all lisp objects (since any object | 649 | ;; requires a total ordering on all lisp objects (since any object |
| 655 | ;; is valid as a text property key). Perhaps defining such an | 650 | ;; is valid as a text property key). Perhaps defining such an |
| @@ -659,21 +654,21 @@ key/value pairs in each list does not matter." | |||
| 659 | (keys-b (ert--significant-plist-keys b)) | 654 | (keys-b (ert--significant-plist-keys b)) |
| 660 | (keys-in-a-not-in-b (ert--set-difference-eq keys-a keys-b)) | 655 | (keys-in-a-not-in-b (ert--set-difference-eq keys-a keys-b)) |
| 661 | (keys-in-b-not-in-a (ert--set-difference-eq keys-b keys-a))) | 656 | (keys-in-b-not-in-a (ert--set-difference-eq keys-b keys-a))) |
| 662 | (flet ((explain-with-key (key) | 657 | (cl-flet ((explain-with-key (key) |
| 663 | (let ((value-a (plist-get a key)) | 658 | (let ((value-a (plist-get a key)) |
| 664 | (value-b (plist-get b key))) | 659 | (value-b (plist-get b key))) |
| 665 | (assert (not (equal value-a value-b)) t) | 660 | (cl-assert (not (equal value-a value-b)) t) |
| 666 | `(different-properties-for-key | 661 | `(different-properties-for-key |
| 667 | ,key ,(ert--explain-equal-including-properties value-a | 662 | ,key ,(ert--explain-equal-including-properties value-a |
| 668 | value-b))))) | 663 | value-b))))) |
| 669 | (cond (keys-in-a-not-in-b | 664 | (cond (keys-in-a-not-in-b |
| 670 | (explain-with-key (first keys-in-a-not-in-b))) | 665 | (explain-with-key (car keys-in-a-not-in-b))) |
| 671 | (keys-in-b-not-in-a | 666 | (keys-in-b-not-in-a |
| 672 | (explain-with-key (first keys-in-b-not-in-a))) | 667 | (explain-with-key (car keys-in-b-not-in-a))) |
| 673 | (t | 668 | (t |
| 674 | (loop for key in keys-a | 669 | (cl-loop for key in keys-a |
| 675 | when (not (equal (plist-get a key) (plist-get b key))) | 670 | when (not (equal (plist-get a key) (plist-get b key))) |
| 676 | return (explain-with-key key))))))) | 671 | return (explain-with-key key))))))) |
| 677 | 672 | ||
| 678 | (defun ert--abbreviate-string (s len suffixp) | 673 | (defun ert--abbreviate-string (s len suffixp) |
| 679 | "Shorten string S to at most LEN chars. | 674 | "Shorten string S to at most LEN chars. |
| @@ -697,29 +692,30 @@ Returns a programmer-readable explanation of why A and B are not | |||
| 697 | `ert-equal-including-properties', or nil if they are." | 692 | `ert-equal-including-properties', or nil if they are." |
| 698 | (if (not (equal a b)) | 693 | (if (not (equal a b)) |
| 699 | (ert--explain-equal a b) | 694 | (ert--explain-equal a b) |
| 700 | (assert (stringp a) t) | 695 | (cl-assert (stringp a) t) |
| 701 | (assert (stringp b) t) | 696 | (cl-assert (stringp b) t) |
| 702 | (assert (eql (length a) (length b)) t) | 697 | (cl-assert (eql (length a) (length b)) t) |
| 703 | (loop for i from 0 to (length a) | 698 | (cl-loop for i from 0 to (length a) |
| 704 | for props-a = (text-properties-at i a) | 699 | for props-a = (text-properties-at i a) |
| 705 | for props-b = (text-properties-at i b) | 700 | for props-b = (text-properties-at i b) |
| 706 | for difference = (ert--plist-difference-explanation props-a props-b) | 701 | for difference = (ert--plist-difference-explanation |
| 707 | do (when difference | 702 | props-a props-b) |
| 708 | (return `(char ,i ,(substring-no-properties a i (1+ i)) | 703 | do (when difference |
| 709 | ,difference | 704 | (cl-return `(char ,i ,(substring-no-properties a i (1+ i)) |
| 710 | context-before | 705 | ,difference |
| 711 | ,(ert--abbreviate-string | 706 | context-before |
| 712 | (substring-no-properties a 0 i) | 707 | ,(ert--abbreviate-string |
| 713 | 10 t) | 708 | (substring-no-properties a 0 i) |
| 714 | context-after | 709 | 10 t) |
| 715 | ,(ert--abbreviate-string | 710 | context-after |
| 716 | (substring-no-properties a (1+ i)) | 711 | ,(ert--abbreviate-string |
| 717 | 10 nil)))) | 712 | (substring-no-properties a (1+ i)) |
| 718 | ;; TODO(ohler): Get `equal-including-properties' fixed in | 713 | 10 nil)))) |
| 719 | ;; Emacs, delete `ert-equal-including-properties', and | 714 | ;; TODO(ohler): Get `equal-including-properties' fixed in |
| 720 | ;; re-enable this assertion. | 715 | ;; Emacs, delete `ert-equal-including-properties', and |
| 721 | ;;finally (assert (equal-including-properties a b) t) | 716 | ;; re-enable this assertion. |
| 722 | ))) | 717 | ;;finally (cl-assert (equal-including-properties a b) t) |
| 718 | ))) | ||
| 723 | (put 'ert-equal-including-properties | 719 | (put 'ert-equal-including-properties |
| 724 | 'ert-explainer | 720 | 'ert-explainer |
| 725 | 'ert--explain-equal-including-properties) | 721 | 'ert--explain-equal-including-properties) |
| @@ -734,8 +730,8 @@ Returns a programmer-readable explanation of why A and B are not | |||
| 734 | 730 | ||
| 735 | Bound dynamically. This is a list of (PREFIX . MESSAGE) pairs.") | 731 | Bound dynamically. This is a list of (PREFIX . MESSAGE) pairs.") |
| 736 | 732 | ||
| 737 | (defmacro* ert-info ((message-form &key ((:prefix prefix-form) "Info: ")) | 733 | (cl-defmacro ert-info ((message-form &key ((:prefix prefix-form) "Info: ")) |
| 738 | &body body) | 734 | &body body) |
| 739 | "Evaluate MESSAGE-FORM and BODY, and report the message if BODY fails. | 735 | "Evaluate MESSAGE-FORM and BODY, and report the message if BODY fails. |
| 740 | 736 | ||
| 741 | To be used within ERT tests. MESSAGE-FORM should evaluate to a | 737 | To be used within ERT tests. MESSAGE-FORM should evaluate to a |
| @@ -755,18 +751,19 @@ and is displayed in front of the value of MESSAGE-FORM." | |||
| 755 | "Non-nil means enter debugger when a test fails or terminates with an error.") | 751 | "Non-nil means enter debugger when a test fails or terminates with an error.") |
| 756 | 752 | ||
| 757 | ;; The data structures that represent the result of running a test. | 753 | ;; The data structures that represent the result of running a test. |
| 758 | (defstruct ert-test-result | 754 | (cl-defstruct ert-test-result |
| 759 | (messages nil) | 755 | (messages nil) |
| 760 | (should-forms nil) | 756 | (should-forms nil) |
| 761 | ) | 757 | ) |
| 762 | (defstruct (ert-test-passed (:include ert-test-result))) | 758 | (cl-defstruct (ert-test-passed (:include ert-test-result))) |
| 763 | (defstruct (ert-test-result-with-condition (:include ert-test-result)) | 759 | (cl-defstruct (ert-test-result-with-condition (:include ert-test-result)) |
| 764 | (condition (assert nil)) | 760 | (condition (cl-assert nil)) |
| 765 | (backtrace (assert nil)) | 761 | (backtrace (cl-assert nil)) |
| 766 | (infos (assert nil))) | 762 | (infos (cl-assert nil))) |
| 767 | (defstruct (ert-test-quit (:include ert-test-result-with-condition))) | 763 | (cl-defstruct (ert-test-quit (:include ert-test-result-with-condition))) |
| 768 | (defstruct (ert-test-failed (:include ert-test-result-with-condition))) | 764 | (cl-defstruct (ert-test-failed (:include ert-test-result-with-condition))) |
| 769 | (defstruct (ert-test-aborted-with-non-local-exit (:include ert-test-result))) | 765 | (cl-defstruct (ert-test-aborted-with-non-local-exit |
| 766 | (:include ert-test-result))) | ||
| 770 | 767 | ||
| 771 | 768 | ||
| 772 | (defun ert--record-backtrace () | 769 | (defun ert--record-backtrace () |
| @@ -779,7 +776,7 @@ and is displayed in front of the value of MESSAGE-FORM." | |||
| 779 | ;; `ert-results-pop-to-backtrace-for-test-at-point' given that we | 776 | ;; `ert-results-pop-to-backtrace-for-test-at-point' given that we |
| 780 | ;; already have `ert-results-rerun-test-debugging-errors-at-point'. | 777 | ;; already have `ert-results-rerun-test-debugging-errors-at-point'. |
| 781 | ;; For batch use, however, printing the backtrace may be useful. | 778 | ;; For batch use, however, printing the backtrace may be useful. |
| 782 | (loop | 779 | (cl-loop |
| 783 | ;; 6 is the number of frames our own debugger adds (when | 780 | ;; 6 is the number of frames our own debugger adds (when |
| 784 | ;; compiled; more when interpreted). FIXME: Need to describe a | 781 | ;; compiled; more when interpreted). FIXME: Need to describe a |
| 785 | ;; procedure for determining this constant. | 782 | ;; procedure for determining this constant. |
| @@ -796,33 +793,33 @@ and is displayed in front of the value of MESSAGE-FORM." | |||
| 796 | (print-level 8) | 793 | (print-level 8) |
| 797 | (print-length 50)) | 794 | (print-length 50)) |
| 798 | (dolist (frame backtrace) | 795 | (dolist (frame backtrace) |
| 799 | (ecase (first frame) | 796 | (cl-ecase (car frame) |
| 800 | ((nil) | 797 | ((nil) |
| 801 | ;; Special operator. | 798 | ;; Special operator. |
| 802 | (destructuring-bind (special-operator &rest arg-forms) | 799 | (cl-destructuring-bind (special-operator &rest arg-forms) |
| 803 | (cdr frame) | 800 | (cdr frame) |
| 804 | (insert | 801 | (insert |
| 805 | (format " %S\n" (list* special-operator arg-forms))))) | 802 | (format " %S\n" (cons special-operator arg-forms))))) |
| 806 | ((t) | 803 | ((t) |
| 807 | ;; Function call. | 804 | ;; Function call. |
| 808 | (destructuring-bind (fn &rest args) (cdr frame) | 805 | (cl-destructuring-bind (fn &rest args) (cdr frame) |
| 809 | (insert (format " %S(" fn)) | 806 | (insert (format " %S(" fn)) |
| 810 | (loop for firstp = t then nil | 807 | (cl-loop for firstp = t then nil |
| 811 | for arg in args do | 808 | for arg in args do |
| 812 | (unless firstp | 809 | (unless firstp |
| 813 | (insert " ")) | 810 | (insert " ")) |
| 814 | (insert (format "%S" arg))) | 811 | (insert (format "%S" arg))) |
| 815 | (insert ")\n"))))))) | 812 | (insert ")\n"))))))) |
| 816 | 813 | ||
| 817 | ;; A container for the state of the execution of a single test and | 814 | ;; A container for the state of the execution of a single test and |
| 818 | ;; environment data needed during its execution. | 815 | ;; environment data needed during its execution. |
| 819 | (defstruct ert--test-execution-info | 816 | (cl-defstruct ert--test-execution-info |
| 820 | (test (assert nil)) | 817 | (test (cl-assert nil)) |
| 821 | (result (assert nil)) | 818 | (result (cl-assert nil)) |
| 822 | ;; A thunk that may be called when RESULT has been set to its final | 819 | ;; A thunk that may be called when RESULT has been set to its final |
| 823 | ;; value and test execution should be terminated. Should not | 820 | ;; value and test execution should be terminated. Should not |
| 824 | ;; return. | 821 | ;; return. |
| 825 | (exit-continuation (assert nil)) | 822 | (exit-continuation (cl-assert nil)) |
| 826 | ;; The binding of `debugger' outside of the execution of the test. | 823 | ;; The binding of `debugger' outside of the execution of the test. |
| 827 | next-debugger | 824 | next-debugger |
| 828 | ;; The binding of `ert-debug-on-error' that is in effect for the | 825 | ;; The binding of `ert-debug-on-error' that is in effect for the |
| @@ -831,7 +828,7 @@ and is displayed in front of the value of MESSAGE-FORM." | |||
| 831 | ;; don't remember whether this feature is important.) | 828 | ;; don't remember whether this feature is important.) |
| 832 | ert-debug-on-error) | 829 | ert-debug-on-error) |
| 833 | 830 | ||
| 834 | (defun ert--run-test-debugger (info debugger-args) | 831 | (defun ert--run-test-debugger (info args) |
| 835 | "During a test run, `debugger' is bound to a closure that calls this function. | 832 | "During a test run, `debugger' is bound to a closure that calls this function. |
| 836 | 833 | ||
| 837 | This function records failures and errors and either terminates | 834 | This function records failures and errors and either terminates |
| @@ -839,21 +836,21 @@ the test silently or calls the interactive debugger, as | |||
| 839 | appropriate. | 836 | appropriate. |
| 840 | 837 | ||
| 841 | INFO is the ert--test-execution-info corresponding to this test | 838 | INFO is the ert--test-execution-info corresponding to this test |
| 842 | run. DEBUGGER-ARGS are the arguments to `debugger'." | 839 | run. ARGS are the arguments to `debugger'." |
| 843 | (destructuring-bind (first-debugger-arg &rest more-debugger-args) | 840 | (cl-destructuring-bind (first-debugger-arg &rest more-debugger-args) |
| 844 | debugger-args | 841 | args |
| 845 | (ecase first-debugger-arg | 842 | (cl-ecase first-debugger-arg |
| 846 | ((lambda debug t exit nil) | 843 | ((lambda debug t exit nil) |
| 847 | (apply (ert--test-execution-info-next-debugger info) debugger-args)) | 844 | (apply (ert--test-execution-info-next-debugger info) args)) |
| 848 | (error | 845 | (error |
| 849 | (let* ((condition (first more-debugger-args)) | 846 | (let* ((condition (car more-debugger-args)) |
| 850 | (type (case (car condition) | 847 | (type (cl-case (car condition) |
| 851 | ((quit) 'quit) | 848 | ((quit) 'quit) |
| 852 | (otherwise 'failed))) | 849 | (otherwise 'failed))) |
| 853 | (backtrace (ert--record-backtrace)) | 850 | (backtrace (ert--record-backtrace)) |
| 854 | (infos (reverse ert--infos))) | 851 | (infos (reverse ert--infos))) |
| 855 | (setf (ert--test-execution-info-result info) | 852 | (setf (ert--test-execution-info-result info) |
| 856 | (ecase type | 853 | (cl-ecase type |
| 857 | (quit | 854 | (quit |
| 858 | (make-ert-test-quit :condition condition | 855 | (make-ert-test-quit :condition condition |
| 859 | :backtrace backtrace | 856 | :backtrace backtrace |
| @@ -864,39 +861,42 @@ run. DEBUGGER-ARGS are the arguments to `debugger'." | |||
| 864 | :infos infos)))) | 861 | :infos infos)))) |
| 865 | ;; Work around Emacs's heuristic (in eval.c) for detecting | 862 | ;; Work around Emacs's heuristic (in eval.c) for detecting |
| 866 | ;; errors in the debugger. | 863 | ;; errors in the debugger. |
| 867 | (incf num-nonmacro-input-events) | 864 | (cl-incf num-nonmacro-input-events) |
| 868 | ;; FIXME: We should probably implement more fine-grained | 865 | ;; FIXME: We should probably implement more fine-grained |
| 869 | ;; control a la non-t `debug-on-error' here. | 866 | ;; control a la non-t `debug-on-error' here. |
| 870 | (cond | 867 | (cond |
| 871 | ((ert--test-execution-info-ert-debug-on-error info) | 868 | ((ert--test-execution-info-ert-debug-on-error info) |
| 872 | (apply (ert--test-execution-info-next-debugger info) debugger-args)) | 869 | (apply (ert--test-execution-info-next-debugger info) args)) |
| 873 | (t)) | 870 | (t)) |
| 874 | (funcall (ert--test-execution-info-exit-continuation info))))))) | 871 | (funcall (ert--test-execution-info-exit-continuation info))))))) |
| 875 | 872 | ||
| 876 | (defun ert--run-test-internal (ert-test-execution-info) | 873 | (defun ert--run-test-internal (test-execution-info) |
| 877 | "Low-level function to run a test according to ERT-TEST-EXECUTION-INFO. | 874 | "Low-level function to run a test according to TEST-EXECUTION-INFO. |
| 878 | 875 | ||
| 879 | This mainly sets up debugger-related bindings." | 876 | This mainly sets up debugger-related bindings." |
| 880 | (lexical-let ((info ert-test-execution-info)) | 877 | (setf (ert--test-execution-info-next-debugger test-execution-info) debugger |
| 881 | (setf (ert--test-execution-info-next-debugger info) debugger | 878 | (ert--test-execution-info-ert-debug-on-error test-execution-info) |
| 882 | (ert--test-execution-info-ert-debug-on-error info) ert-debug-on-error) | 879 | ert-debug-on-error) |
| 883 | (catch 'ert--pass | 880 | (catch 'ert--pass |
| 884 | ;; For now, each test gets its own temp buffer and its own | 881 | ;; For now, each test gets its own temp buffer and its own |
| 885 | ;; window excursion, just to be safe. If this turns out to be | 882 | ;; window excursion, just to be safe. If this turns out to be |
| 886 | ;; too expensive, we can remove it. | 883 | ;; too expensive, we can remove it. |
| 887 | (with-temp-buffer | 884 | (with-temp-buffer |
| 888 | (save-window-excursion | 885 | (save-window-excursion |
| 889 | (let ((debugger (lambda (&rest debugger-args) | 886 | (let ((debugger (lambda (&rest args) |
| 890 | (ert--run-test-debugger info debugger-args))) | 887 | (ert--run-test-debugger test-execution-info |
| 891 | (debug-on-error t) | 888 | args))) |
| 892 | (debug-on-quit t) | 889 | (debug-on-error t) |
| 893 | ;; FIXME: Do we need to store the old binding of this | 890 | (debug-on-quit t) |
| 894 | ;; and consider it in `ert--run-test-debugger'? | 891 | ;; FIXME: Do we need to store the old binding of this |
| 895 | (debug-ignored-errors nil) | 892 | ;; and consider it in `ert--run-test-debugger'? |
| 896 | (ert--infos '())) | 893 | (debug-ignored-errors nil) |
| 897 | (funcall (ert-test-body (ert--test-execution-info-test info)))))) | 894 | (ert--infos '())) |
| 898 | (ert-pass)) | 895 | (funcall (ert-test-body (ert--test-execution-info-test |
| 899 | (setf (ert--test-execution-info-result info) (make-ert-test-passed))) | 896 | test-execution-info)))))) |
| 897 | (ert-pass)) | ||
| 898 | (setf (ert--test-execution-info-result test-execution-info) | ||
| 899 | (make-ert-test-passed)) | ||
| 900 | nil) | 900 | nil) |
| 901 | 901 | ||
| 902 | (defun ert--force-message-log-buffer-truncation () | 902 | (defun ert--force-message-log-buffer-truncation () |
| @@ -934,18 +934,18 @@ The elements are of type `ert-test'.") | |||
| 934 | 934 | ||
| 935 | Returns the result and stores it in ERT-TEST's `most-recent-result' slot." | 935 | Returns the result and stores it in ERT-TEST's `most-recent-result' slot." |
| 936 | (setf (ert-test-most-recent-result ert-test) nil) | 936 | (setf (ert-test-most-recent-result ert-test) nil) |
| 937 | (block error | 937 | (cl-block error |
| 938 | (lexical-let ((begin-marker | 938 | (let ((begin-marker |
| 939 | (with-current-buffer (get-buffer-create "*Messages*") | 939 | (with-current-buffer (get-buffer-create "*Messages*") |
| 940 | (set-marker (make-marker) (point-max))))) | 940 | (set-marker (make-marker) (point-max))))) |
| 941 | (unwind-protect | 941 | (unwind-protect |
| 942 | (lexical-let ((info (make-ert--test-execution-info | 942 | (let ((info (make-ert--test-execution-info |
| 943 | :test ert-test | 943 | :test ert-test |
| 944 | :result | 944 | :result |
| 945 | (make-ert-test-aborted-with-non-local-exit) | 945 | (make-ert-test-aborted-with-non-local-exit) |
| 946 | :exit-continuation (lambda () | 946 | :exit-continuation (lambda () |
| 947 | (return-from error nil)))) | 947 | (cl-return-from error nil)))) |
| 948 | (should-form-accu (list))) | 948 | (should-form-accu (list))) |
| 949 | (unwind-protect | 949 | (unwind-protect |
| 950 | (let ((ert--should-execution-observer | 950 | (let ((ert--should-execution-observer |
| 951 | (lambda (form-description) | 951 | (lambda (form-description) |
| @@ -987,32 +987,32 @@ t -- Always matches. | |||
| 987 | RESULT." | 987 | RESULT." |
| 988 | ;; It would be easy to add `member' and `eql' types etc., but I | 988 | ;; It would be easy to add `member' and `eql' types etc., but I |
| 989 | ;; haven't bothered yet. | 989 | ;; haven't bothered yet. |
| 990 | (etypecase result-type | 990 | (cl-etypecase result-type |
| 991 | ((member nil) nil) | 991 | ((member nil) nil) |
| 992 | ((member t) t) | 992 | ((member t) t) |
| 993 | ((member :failed) (ert-test-failed-p result)) | 993 | ((member :failed) (ert-test-failed-p result)) |
| 994 | ((member :passed) (ert-test-passed-p result)) | 994 | ((member :passed) (ert-test-passed-p result)) |
| 995 | (cons | 995 | (cons |
| 996 | (destructuring-bind (operator &rest operands) result-type | 996 | (cl-destructuring-bind (operator &rest operands) result-type |
| 997 | (ecase operator | 997 | (cl-ecase operator |
| 998 | (and | 998 | (and |
| 999 | (case (length operands) | 999 | (cl-case (length operands) |
| 1000 | (0 t) | 1000 | (0 t) |
| 1001 | (t | 1001 | (t |
| 1002 | (and (ert-test-result-type-p result (first operands)) | 1002 | (and (ert-test-result-type-p result (car operands)) |
| 1003 | (ert-test-result-type-p result `(and ,@(rest operands))))))) | 1003 | (ert-test-result-type-p result `(and ,@(cdr operands))))))) |
| 1004 | (or | 1004 | (or |
| 1005 | (case (length operands) | 1005 | (cl-case (length operands) |
| 1006 | (0 nil) | 1006 | (0 nil) |
| 1007 | (t | 1007 | (t |
| 1008 | (or (ert-test-result-type-p result (first operands)) | 1008 | (or (ert-test-result-type-p result (car operands)) |
| 1009 | (ert-test-result-type-p result `(or ,@(rest operands))))))) | 1009 | (ert-test-result-type-p result `(or ,@(cdr operands))))))) |
| 1010 | (not | 1010 | (not |
| 1011 | (assert (eql (length operands) 1)) | 1011 | (cl-assert (eql (length operands) 1)) |
| 1012 | (not (ert-test-result-type-p result (first operands)))) | 1012 | (not (ert-test-result-type-p result (car operands)))) |
| 1013 | (satisfies | 1013 | (satisfies |
| 1014 | (assert (eql (length operands) 1)) | 1014 | (cl-assert (eql (length operands) 1)) |
| 1015 | (funcall (first operands) result))))))) | 1015 | (funcall (car operands) result))))))) |
| 1016 | 1016 | ||
| 1017 | (defun ert-test-result-expected-p (test result) | 1017 | (defun ert-test-result-expected-p (test result) |
| 1018 | "Return non-nil if TEST's expected result type matches RESULT." | 1018 | "Return non-nil if TEST's expected result type matches RESULT." |
| @@ -1053,9 +1053,9 @@ set implied by them without checking whether it is really | |||
| 1053 | contained in UNIVERSE." | 1053 | contained in UNIVERSE." |
| 1054 | ;; This code needs to match the etypecase in | 1054 | ;; This code needs to match the etypecase in |
| 1055 | ;; `ert-insert-human-readable-selector'. | 1055 | ;; `ert-insert-human-readable-selector'. |
| 1056 | (etypecase selector | 1056 | (cl-etypecase selector |
| 1057 | ((member nil) nil) | 1057 | ((member nil) nil) |
| 1058 | ((member t) (etypecase universe | 1058 | ((member t) (cl-etypecase universe |
| 1059 | (list universe) | 1059 | (list universe) |
| 1060 | ((member t) (ert-select-tests "" universe)))) | 1060 | ((member t) (ert-select-tests "" universe)))) |
| 1061 | ((member :new) (ert-select-tests | 1061 | ((member :new) (ert-select-tests |
| @@ -1083,7 +1083,7 @@ contained in UNIVERSE." | |||
| 1083 | universe)) | 1083 | universe)) |
| 1084 | ((member :unexpected) (ert-select-tests `(not :expected) universe)) | 1084 | ((member :unexpected) (ert-select-tests `(not :expected) universe)) |
| 1085 | (string | 1085 | (string |
| 1086 | (etypecase universe | 1086 | (cl-etypecase universe |
| 1087 | ((member t) (mapcar #'ert-get-test | 1087 | ((member t) (mapcar #'ert-get-test |
| 1088 | (apropos-internal selector #'ert-test-boundp))) | 1088 | (apropos-internal selector #'ert-test-boundp))) |
| 1089 | (list (ert--remove-if-not (lambda (test) | 1089 | (list (ert--remove-if-not (lambda (test) |
| @@ -1093,51 +1093,51 @@ contained in UNIVERSE." | |||
| 1093 | universe)))) | 1093 | universe)))) |
| 1094 | (ert-test (list selector)) | 1094 | (ert-test (list selector)) |
| 1095 | (symbol | 1095 | (symbol |
| 1096 | (assert (ert-test-boundp selector)) | 1096 | (cl-assert (ert-test-boundp selector)) |
| 1097 | (list (ert-get-test selector))) | 1097 | (list (ert-get-test selector))) |
| 1098 | (cons | 1098 | (cons |
| 1099 | (destructuring-bind (operator &rest operands) selector | 1099 | (cl-destructuring-bind (operator &rest operands) selector |
| 1100 | (ecase operator | 1100 | (cl-ecase operator |
| 1101 | (member | 1101 | (member |
| 1102 | (mapcar (lambda (purported-test) | 1102 | (mapcar (lambda (purported-test) |
| 1103 | (etypecase purported-test | 1103 | (cl-etypecase purported-test |
| 1104 | (symbol (assert (ert-test-boundp purported-test)) | 1104 | (symbol (cl-assert (ert-test-boundp purported-test)) |
| 1105 | (ert-get-test purported-test)) | 1105 | (ert-get-test purported-test)) |
| 1106 | (ert-test purported-test))) | 1106 | (ert-test purported-test))) |
| 1107 | operands)) | 1107 | operands)) |
| 1108 | (eql | 1108 | (eql |
| 1109 | (assert (eql (length operands) 1)) | 1109 | (cl-assert (eql (length operands) 1)) |
| 1110 | (ert-select-tests `(member ,@operands) universe)) | 1110 | (ert-select-tests `(member ,@operands) universe)) |
| 1111 | (and | 1111 | (and |
| 1112 | ;; Do these definitions of AND, NOT and OR satisfy de | 1112 | ;; Do these definitions of AND, NOT and OR satisfy de |
| 1113 | ;; Morgan's laws? Should they? | 1113 | ;; Morgan's laws? Should they? |
| 1114 | (case (length operands) | 1114 | (cl-case (length operands) |
| 1115 | (0 (ert-select-tests 't universe)) | 1115 | (0 (ert-select-tests 't universe)) |
| 1116 | (t (ert-select-tests `(and ,@(rest operands)) | 1116 | (t (ert-select-tests `(and ,@(cdr operands)) |
| 1117 | (ert-select-tests (first operands) | 1117 | (ert-select-tests (car operands) |
| 1118 | universe))))) | 1118 | universe))))) |
| 1119 | (not | 1119 | (not |
| 1120 | (assert (eql (length operands) 1)) | 1120 | (cl-assert (eql (length operands) 1)) |
| 1121 | (let ((all-tests (ert-select-tests 't universe))) | 1121 | (let ((all-tests (ert-select-tests 't universe))) |
| 1122 | (ert--set-difference all-tests | 1122 | (ert--set-difference all-tests |
| 1123 | (ert-select-tests (first operands) | 1123 | (ert-select-tests (car operands) |
| 1124 | all-tests)))) | 1124 | all-tests)))) |
| 1125 | (or | 1125 | (or |
| 1126 | (case (length operands) | 1126 | (cl-case (length operands) |
| 1127 | (0 (ert-select-tests 'nil universe)) | 1127 | (0 (ert-select-tests 'nil universe)) |
| 1128 | (t (ert--union (ert-select-tests (first operands) universe) | 1128 | (t (ert--union (ert-select-tests (car operands) universe) |
| 1129 | (ert-select-tests `(or ,@(rest operands)) | 1129 | (ert-select-tests `(or ,@(cdr operands)) |
| 1130 | universe))))) | 1130 | universe))))) |
| 1131 | (tag | 1131 | (tag |
| 1132 | (assert (eql (length operands) 1)) | 1132 | (cl-assert (eql (length operands) 1)) |
| 1133 | (let ((tag (first operands))) | 1133 | (let ((tag (car operands))) |
| 1134 | (ert-select-tests `(satisfies | 1134 | (ert-select-tests `(satisfies |
| 1135 | ,(lambda (test) | 1135 | ,(lambda (test) |
| 1136 | (member tag (ert-test-tags test)))) | 1136 | (member tag (ert-test-tags test)))) |
| 1137 | universe))) | 1137 | universe))) |
| 1138 | (satisfies | 1138 | (satisfies |
| 1139 | (assert (eql (length operands) 1)) | 1139 | (cl-assert (eql (length operands) 1)) |
| 1140 | (ert--remove-if-not (first operands) | 1140 | (ert--remove-if-not (car operands) |
| 1141 | (ert-select-tests 't universe)))))))) | 1141 | (ert-select-tests 't universe)))))))) |
| 1142 | 1142 | ||
| 1143 | (defun ert--insert-human-readable-selector (selector) | 1143 | (defun ert--insert-human-readable-selector (selector) |
| @@ -1146,26 +1146,27 @@ contained in UNIVERSE." | |||
| 1146 | ;; `backtrace' slot of the result objects in the | 1146 | ;; `backtrace' slot of the result objects in the |
| 1147 | ;; `most-recent-result' slots of test case objects in (eql ...) or | 1147 | ;; `most-recent-result' slots of test case objects in (eql ...) or |
| 1148 | ;; (member ...) selectors. | 1148 | ;; (member ...) selectors. |
| 1149 | (labels ((rec (selector) | 1149 | (cl-labels ((rec (selector) |
| 1150 | ;; This code needs to match the etypecase in `ert-select-tests'. | 1150 | ;; This code needs to match the etypecase in |
| 1151 | (etypecase selector | 1151 | ;; `ert-select-tests'. |
| 1152 | ((or (member nil t | 1152 | (cl-etypecase selector |
| 1153 | :new :failed :passed | 1153 | ((or (member nil t |
| 1154 | :expected :unexpected) | 1154 | :new :failed :passed |
| 1155 | string | 1155 | :expected :unexpected) |
| 1156 | symbol) | 1156 | string |
| 1157 | selector) | 1157 | symbol) |
| 1158 | (ert-test | 1158 | selector) |
| 1159 | (if (ert-test-name selector) | 1159 | (ert-test |
| 1160 | (make-symbol (format "<%S>" (ert-test-name selector))) | 1160 | (if (ert-test-name selector) |
| 1161 | (make-symbol "<unnamed test>"))) | 1161 | (make-symbol (format "<%S>" (ert-test-name selector))) |
| 1162 | (cons | 1162 | (make-symbol "<unnamed test>"))) |
| 1163 | (destructuring-bind (operator &rest operands) selector | 1163 | (cons |
| 1164 | (ecase operator | 1164 | (cl-destructuring-bind (operator &rest operands) selector |
| 1165 | ((member eql and not or) | 1165 | (cl-ecase operator |
| 1166 | `(,operator ,@(mapcar #'rec operands))) | 1166 | ((member eql and not or) |
| 1167 | ((member tag satisfies) | 1167 | `(,operator ,@(mapcar #'rec operands))) |
| 1168 | selector))))))) | 1168 | ((member tag satisfies) |
| 1169 | selector))))))) | ||
| 1169 | (insert (format "%S" (rec selector))))) | 1170 | (insert (format "%S" (rec selector))))) |
| 1170 | 1171 | ||
| 1171 | 1172 | ||
| @@ -1182,21 +1183,21 @@ contained in UNIVERSE." | |||
| 1182 | ;; that corresponds to this run in order to be able to update the | 1183 | ;; that corresponds to this run in order to be able to update the |
| 1183 | ;; statistics correctly when a test is re-run interactively and has a | 1184 | ;; statistics correctly when a test is re-run interactively and has a |
| 1184 | ;; different result than before. | 1185 | ;; different result than before. |
| 1185 | (defstruct ert--stats | 1186 | (cl-defstruct ert--stats |
| 1186 | (selector (assert nil)) | 1187 | (selector (cl-assert nil)) |
| 1187 | ;; The tests, in order. | 1188 | ;; The tests, in order. |
| 1188 | (tests (assert nil) :type vector) | 1189 | (tests (cl-assert nil) :type vector) |
| 1189 | ;; A map of test names (or the test objects themselves for unnamed | 1190 | ;; A map of test names (or the test objects themselves for unnamed |
| 1190 | ;; tests) to indices into the `tests' vector. | 1191 | ;; tests) to indices into the `tests' vector. |
| 1191 | (test-map (assert nil) :type hash-table) | 1192 | (test-map (cl-assert nil) :type hash-table) |
| 1192 | ;; The results of the tests during this run, in order. | 1193 | ;; The results of the tests during this run, in order. |
| 1193 | (test-results (assert nil) :type vector) | 1194 | (test-results (cl-assert nil) :type vector) |
| 1194 | ;; The start times of the tests, in order, as reported by | 1195 | ;; The start times of the tests, in order, as reported by |
| 1195 | ;; `current-time'. | 1196 | ;; `current-time'. |
| 1196 | (test-start-times (assert nil) :type vector) | 1197 | (test-start-times (cl-assert nil) :type vector) |
| 1197 | ;; The end times of the tests, in order, as reported by | 1198 | ;; The end times of the tests, in order, as reported by |
| 1198 | ;; `current-time'. | 1199 | ;; `current-time'. |
| 1199 | (test-end-times (assert nil) :type vector) | 1200 | (test-end-times (cl-assert nil) :type vector) |
| 1200 | (passed-expected 0) | 1201 | (passed-expected 0) |
| 1201 | (passed-unexpected 0) | 1202 | (passed-unexpected 0) |
| 1202 | (failed-expected 0) | 1203 | (failed-expected 0) |
| @@ -1246,21 +1247,25 @@ Also changes the counters in STATS to match." | |||
| 1246 | (results (ert--stats-test-results stats)) | 1247 | (results (ert--stats-test-results stats)) |
| 1247 | (old-test (aref tests pos)) | 1248 | (old-test (aref tests pos)) |
| 1248 | (map (ert--stats-test-map stats))) | 1249 | (map (ert--stats-test-map stats))) |
| 1249 | (flet ((update (d) | 1250 | (cl-flet ((update (d) |
| 1250 | (if (ert-test-result-expected-p (aref tests pos) | 1251 | (if (ert-test-result-expected-p (aref tests pos) |
| 1251 | (aref results pos)) | 1252 | (aref results pos)) |
| 1252 | (etypecase (aref results pos) | 1253 | (cl-etypecase (aref results pos) |
| 1253 | (ert-test-passed (incf (ert--stats-passed-expected stats) d)) | 1254 | (ert-test-passed |
| 1254 | (ert-test-failed (incf (ert--stats-failed-expected stats) d)) | 1255 | (cl-incf (ert--stats-passed-expected stats) d)) |
| 1255 | (null) | 1256 | (ert-test-failed |
| 1256 | (ert-test-aborted-with-non-local-exit) | 1257 | (cl-incf (ert--stats-failed-expected stats) d)) |
| 1257 | (ert-test-quit)) | 1258 | (null) |
| 1258 | (etypecase (aref results pos) | 1259 | (ert-test-aborted-with-non-local-exit) |
| 1259 | (ert-test-passed (incf (ert--stats-passed-unexpected stats) d)) | 1260 | (ert-test-quit)) |
| 1260 | (ert-test-failed (incf (ert--stats-failed-unexpected stats) d)) | 1261 | (cl-etypecase (aref results pos) |
| 1261 | (null) | 1262 | (ert-test-passed |
| 1262 | (ert-test-aborted-with-non-local-exit) | 1263 | (cl-incf (ert--stats-passed-unexpected stats) d)) |
| 1263 | (ert-test-quit))))) | 1264 | (ert-test-failed |
| 1265 | (cl-incf (ert--stats-failed-unexpected stats) d)) | ||
| 1266 | (null) | ||
| 1267 | (ert-test-aborted-with-non-local-exit) | ||
| 1268 | (ert-test-quit))))) | ||
| 1264 | ;; Adjust counters to remove the result that is currently in stats. | 1269 | ;; Adjust counters to remove the result that is currently in stats. |
| 1265 | (update -1) | 1270 | (update -1) |
| 1266 | ;; Put new test and result into stats. | 1271 | ;; Put new test and result into stats. |
| @@ -1278,11 +1283,11 @@ Also changes the counters in STATS to match." | |||
| 1278 | SELECTOR is the selector that was used to select TESTS." | 1283 | SELECTOR is the selector that was used to select TESTS." |
| 1279 | (setq tests (ert--coerce-to-vector tests)) | 1284 | (setq tests (ert--coerce-to-vector tests)) |
| 1280 | (let ((map (make-hash-table :size (length tests)))) | 1285 | (let ((map (make-hash-table :size (length tests)))) |
| 1281 | (loop for i from 0 | 1286 | (cl-loop for i from 0 |
| 1282 | for test across tests | 1287 | for test across tests |
| 1283 | for key = (ert--stats-test-key test) do | 1288 | for key = (ert--stats-test-key test) do |
| 1284 | (assert (not (gethash key map))) | 1289 | (cl-assert (not (gethash key map))) |
| 1285 | (setf (gethash key map) i)) | 1290 | (setf (gethash key map) i)) |
| 1286 | (make-ert--stats :selector selector | 1291 | (make-ert--stats :selector selector |
| 1287 | :tests tests | 1292 | :tests tests |
| 1288 | :test-map map | 1293 | :test-map map |
| @@ -1324,8 +1329,8 @@ SELECTOR is the selector that was used to select TESTS." | |||
| 1324 | (force-mode-line-update) | 1329 | (force-mode-line-update) |
| 1325 | (unwind-protect | 1330 | (unwind-protect |
| 1326 | (progn | 1331 | (progn |
| 1327 | (loop for test in tests do | 1332 | (cl-loop for test in tests do |
| 1328 | (ert-run-or-rerun-test stats test listener)) | 1333 | (ert-run-or-rerun-test stats test listener)) |
| 1329 | (setq abortedp nil)) | 1334 | (setq abortedp nil)) |
| 1330 | (setf (ert--stats-aborted-p stats) abortedp) | 1335 | (setf (ert--stats-aborted-p stats) abortedp) |
| 1331 | (setf (ert--stats-end-time stats) (current-time)) | 1336 | (setf (ert--stats-end-time stats) (current-time)) |
| @@ -1349,7 +1354,7 @@ SELECTOR is the selector that was used to select TESTS." | |||
| 1349 | "Return a character that represents the test result RESULT. | 1354 | "Return a character that represents the test result RESULT. |
| 1350 | 1355 | ||
| 1351 | EXPECTEDP specifies whether the result was expected." | 1356 | EXPECTEDP specifies whether the result was expected." |
| 1352 | (let ((s (etypecase result | 1357 | (let ((s (cl-etypecase result |
| 1353 | (ert-test-passed ".P") | 1358 | (ert-test-passed ".P") |
| 1354 | (ert-test-failed "fF") | 1359 | (ert-test-failed "fF") |
| 1355 | (null "--") | 1360 | (null "--") |
| @@ -1361,7 +1366,7 @@ EXPECTEDP specifies whether the result was expected." | |||
| 1361 | "Return a string that represents the test result RESULT. | 1366 | "Return a string that represents the test result RESULT. |
| 1362 | 1367 | ||
| 1363 | EXPECTEDP specifies whether the result was expected." | 1368 | EXPECTEDP specifies whether the result was expected." |
| 1364 | (let ((s (etypecase result | 1369 | (let ((s (cl-etypecase result |
| 1365 | (ert-test-passed '("passed" "PASSED")) | 1370 | (ert-test-passed '("passed" "PASSED")) |
| 1366 | (ert-test-failed '("failed" "FAILED")) | 1371 | (ert-test-failed '("failed" "FAILED")) |
| 1367 | (null '("unknown" "UNKNOWN")) | 1372 | (null '("unknown" "UNKNOWN")) |
| @@ -1383,9 +1388,9 @@ Ensures a final newline is inserted." | |||
| 1383 | "Insert `ert-info' infos from RESULT into current buffer. | 1388 | "Insert `ert-info' infos from RESULT into current buffer. |
| 1384 | 1389 | ||
| 1385 | RESULT must be an `ert-test-result-with-condition'." | 1390 | RESULT must be an `ert-test-result-with-condition'." |
| 1386 | (check-type result ert-test-result-with-condition) | 1391 | (cl-check-type result ert-test-result-with-condition) |
| 1387 | (dolist (info (ert-test-result-with-condition-infos result)) | 1392 | (dolist (info (ert-test-result-with-condition-infos result)) |
| 1388 | (destructuring-bind (prefix . message) info | 1393 | (cl-destructuring-bind (prefix . message) info |
| 1389 | (let ((begin (point)) | 1394 | (let ((begin (point)) |
| 1390 | (indentation (make-string (+ (length prefix) 4) ?\s)) | 1395 | (indentation (make-string (+ (length prefix) 4) ?\s)) |
| 1391 | (end nil)) | 1396 | (end nil)) |
| @@ -1421,14 +1426,14 @@ Returns the stats object." | |||
| 1421 | (ert-run-tests | 1426 | (ert-run-tests |
| 1422 | selector | 1427 | selector |
| 1423 | (lambda (event-type &rest event-args) | 1428 | (lambda (event-type &rest event-args) |
| 1424 | (ecase event-type | 1429 | (cl-ecase event-type |
| 1425 | (run-started | 1430 | (run-started |
| 1426 | (destructuring-bind (stats) event-args | 1431 | (cl-destructuring-bind (stats) event-args |
| 1427 | (message "Running %s tests (%s)" | 1432 | (message "Running %s tests (%s)" |
| 1428 | (length (ert--stats-tests stats)) | 1433 | (length (ert--stats-tests stats)) |
| 1429 | (ert--format-time-iso8601 (ert--stats-start-time stats))))) | 1434 | (ert--format-time-iso8601 (ert--stats-start-time stats))))) |
| 1430 | (run-ended | 1435 | (run-ended |
| 1431 | (destructuring-bind (stats abortedp) event-args | 1436 | (cl-destructuring-bind (stats abortedp) event-args |
| 1432 | (let ((unexpected (ert-stats-completed-unexpected stats)) | 1437 | (let ((unexpected (ert-stats-completed-unexpected stats)) |
| 1433 | (expected-failures (ert--stats-failed-expected stats))) | 1438 | (expected-failures (ert--stats-failed-expected stats))) |
| 1434 | (message "\n%sRan %s tests, %s results as expected%s (%s)%s\n" | 1439 | (message "\n%sRan %s tests, %s results as expected%s (%s)%s\n" |
| @@ -1446,19 +1451,19 @@ Returns the stats object." | |||
| 1446 | (format "\n%s expected failures" expected-failures))) | 1451 | (format "\n%s expected failures" expected-failures))) |
| 1447 | (unless (zerop unexpected) | 1452 | (unless (zerop unexpected) |
| 1448 | (message "%s unexpected results:" unexpected) | 1453 | (message "%s unexpected results:" unexpected) |
| 1449 | (loop for test across (ert--stats-tests stats) | 1454 | (cl-loop for test across (ert--stats-tests stats) |
| 1450 | for result = (ert-test-most-recent-result test) do | 1455 | for result = (ert-test-most-recent-result test) do |
| 1451 | (when (not (ert-test-result-expected-p test result)) | 1456 | (when (not (ert-test-result-expected-p test result)) |
| 1452 | (message "%9s %S" | 1457 | (message "%9s %S" |
| 1453 | (ert-string-for-test-result result nil) | 1458 | (ert-string-for-test-result result nil) |
| 1454 | (ert-test-name test)))) | 1459 | (ert-test-name test)))) |
| 1455 | (message "%s" ""))))) | 1460 | (message "%s" ""))))) |
| 1456 | (test-started | 1461 | (test-started |
| 1457 | ) | 1462 | ) |
| 1458 | (test-ended | 1463 | (test-ended |
| 1459 | (destructuring-bind (stats test result) event-args | 1464 | (cl-destructuring-bind (stats test result) event-args |
| 1460 | (unless (ert-test-result-expected-p test result) | 1465 | (unless (ert-test-result-expected-p test result) |
| 1461 | (etypecase result | 1466 | (cl-etypecase result |
| 1462 | (ert-test-passed | 1467 | (ert-test-passed |
| 1463 | (message "Test %S passed unexpectedly" (ert-test-name test))) | 1468 | (message "Test %S passed unexpectedly" (ert-test-name test))) |
| 1464 | (ert-test-result-with-condition | 1469 | (ert-test-result-with-condition |
| @@ -1484,7 +1489,7 @@ Returns the stats object." | |||
| 1484 | (ert--pp-with-indentation-and-newline | 1489 | (ert--pp-with-indentation-and-newline |
| 1485 | (ert-test-result-with-condition-condition result))) | 1490 | (ert-test-result-with-condition-condition result))) |
| 1486 | (goto-char (1- (point-max))) | 1491 | (goto-char (1- (point-max))) |
| 1487 | (assert (looking-at "\n")) | 1492 | (cl-assert (looking-at "\n")) |
| 1488 | (delete-char 1) | 1493 | (delete-char 1) |
| 1489 | (message "Test %S condition:" (ert-test-name test)) | 1494 | (message "Test %S condition:" (ert-test-name test)) |
| 1490 | (message "%s" (buffer-string)))) | 1495 | (message "%s" (buffer-string)))) |
| @@ -1532,7 +1537,7 @@ the tests)." | |||
| 1532 | (1 font-lock-keyword-face nil t) | 1537 | (1 font-lock-keyword-face nil t) |
| 1533 | (2 font-lock-function-name-face nil t))))) | 1538 | (2 font-lock-function-name-face nil t))))) |
| 1534 | 1539 | ||
| 1535 | (defun* ert--remove-from-list (list-var element &key key test) | 1540 | (cl-defun ert--remove-from-list (list-var element &key key test) |
| 1536 | "Remove ELEMENT from the value of LIST-VAR if present. | 1541 | "Remove ELEMENT from the value of LIST-VAR if present. |
| 1537 | 1542 | ||
| 1538 | This can be used as an inverse of `add-to-list'." | 1543 | This can be used as an inverse of `add-to-list'." |
| @@ -1557,7 +1562,7 @@ If ADD-DEFAULT-TO-PROMPT is non-nil, PROMPT will be modified to | |||
| 1557 | include the default, if any. | 1562 | include the default, if any. |
| 1558 | 1563 | ||
| 1559 | Signals an error if no test name was read." | 1564 | Signals an error if no test name was read." |
| 1560 | (etypecase default | 1565 | (cl-etypecase default |
| 1561 | (string (let ((symbol (intern-soft default))) | 1566 | (string (let ((symbol (intern-soft default))) |
| 1562 | (unless (and symbol (ert-test-boundp symbol)) | 1567 | (unless (and symbol (ert-test-boundp symbol)) |
| 1563 | (setq default nil)))) | 1568 | (setq default nil)))) |
| @@ -1614,11 +1619,11 @@ Nothing more than an interactive interface to `ert-make-test-unbound'." | |||
| 1614 | ;;; Display of test progress and results. | 1619 | ;;; Display of test progress and results. |
| 1615 | 1620 | ||
| 1616 | ;; An entry in the results buffer ewoc. There is one entry per test. | 1621 | ;; An entry in the results buffer ewoc. There is one entry per test. |
| 1617 | (defstruct ert--ewoc-entry | 1622 | (cl-defstruct ert--ewoc-entry |
| 1618 | (test (assert nil)) | 1623 | (test (cl-assert nil)) |
| 1619 | ;; If the result of this test was expected, its ewoc entry is hidden | 1624 | ;; If the result of this test was expected, its ewoc entry is hidden |
| 1620 | ;; initially. | 1625 | ;; initially. |
| 1621 | (hidden-p (assert nil)) | 1626 | (hidden-p (cl-assert nil)) |
| 1622 | ;; An ewoc entry may be collapsed to hide details such as the error | 1627 | ;; An ewoc entry may be collapsed to hide details such as the error |
| 1623 | ;; condition. | 1628 | ;; condition. |
| 1624 | ;; | 1629 | ;; |
| @@ -1694,7 +1699,7 @@ Also sets `ert--results-progress-bar-button-begin'." | |||
| 1694 | ((ert--stats-current-test stats) 'running) | 1699 | ((ert--stats-current-test stats) 'running) |
| 1695 | ((ert--stats-end-time stats) 'finished) | 1700 | ((ert--stats-end-time stats) 'finished) |
| 1696 | (t 'preparing)))) | 1701 | (t 'preparing)))) |
| 1697 | (ecase state | 1702 | (cl-ecase state |
| 1698 | (preparing | 1703 | (preparing |
| 1699 | (insert "")) | 1704 | (insert "")) |
| 1700 | (aborted | 1705 | (aborted |
| @@ -1705,12 +1710,12 @@ Also sets `ert--results-progress-bar-button-begin'." | |||
| 1705 | (t | 1710 | (t |
| 1706 | (insert "Aborted.")))) | 1711 | (insert "Aborted.")))) |
| 1707 | (running | 1712 | (running |
| 1708 | (assert (ert--stats-current-test stats)) | 1713 | (cl-assert (ert--stats-current-test stats)) |
| 1709 | (insert "Running test: ") | 1714 | (insert "Running test: ") |
| 1710 | (ert-insert-test-name-button (ert-test-name | 1715 | (ert-insert-test-name-button (ert-test-name |
| 1711 | (ert--stats-current-test stats)))) | 1716 | (ert--stats-current-test stats)))) |
| 1712 | (finished | 1717 | (finished |
| 1713 | (assert (not (ert--stats-current-test stats))) | 1718 | (cl-assert (not (ert--stats-current-test stats))) |
| 1714 | (insert "Finished."))) | 1719 | (insert "Finished."))) |
| 1715 | (insert "\n") | 1720 | (insert "\n") |
| 1716 | (if (ert--stats-end-time stats) | 1721 | (if (ert--stats-end-time stats) |
| @@ -1813,7 +1818,7 @@ non-nil, returns the face for expected results.." | |||
| 1813 | (defun ert-face-for-stats (stats) | 1818 | (defun ert-face-for-stats (stats) |
| 1814 | "Return a face that represents STATS." | 1819 | "Return a face that represents STATS." |
| 1815 | (cond ((ert--stats-aborted-p stats) 'nil) | 1820 | (cond ((ert--stats-aborted-p stats) 'nil) |
| 1816 | ((plusp (ert-stats-completed-unexpected stats)) | 1821 | ((cl-plusp (ert-stats-completed-unexpected stats)) |
| 1817 | (ert-face-for-test-result nil)) | 1822 | (ert-face-for-test-result nil)) |
| 1818 | ((eql (ert-stats-completed-expected stats) (ert-stats-total stats)) | 1823 | ((eql (ert-stats-completed-expected stats) (ert-stats-total stats)) |
| 1819 | (ert-face-for-test-result t)) | 1824 | (ert-face-for-test-result t)) |
| @@ -1824,7 +1829,7 @@ non-nil, returns the face for expected results.." | |||
| 1824 | (let* ((test (ert--ewoc-entry-test entry)) | 1829 | (let* ((test (ert--ewoc-entry-test entry)) |
| 1825 | (stats ert--results-stats) | 1830 | (stats ert--results-stats) |
| 1826 | (result (let ((pos (ert--stats-test-pos stats test))) | 1831 | (result (let ((pos (ert--stats-test-pos stats test))) |
| 1827 | (assert pos) | 1832 | (cl-assert pos) |
| 1828 | (aref (ert--stats-test-results stats) pos))) | 1833 | (aref (ert--stats-test-results stats) pos))) |
| 1829 | (hiddenp (ert--ewoc-entry-hidden-p entry)) | 1834 | (hiddenp (ert--ewoc-entry-hidden-p entry)) |
| 1830 | (expandedp (ert--ewoc-entry-expanded-p entry)) | 1835 | (expandedp (ert--ewoc-entry-expanded-p entry)) |
| @@ -1850,7 +1855,7 @@ non-nil, returns the face for expected results.." | |||
| 1850 | (ert--string-first-line (ert-test-documentation test)) | 1855 | (ert--string-first-line (ert-test-documentation test)) |
| 1851 | 'font-lock-face 'font-lock-doc-face) | 1856 | 'font-lock-face 'font-lock-doc-face) |
| 1852 | "\n")) | 1857 | "\n")) |
| 1853 | (etypecase result | 1858 | (cl-etypecase result |
| 1854 | (ert-test-passed | 1859 | (ert-test-passed |
| 1855 | (if (ert-test-result-expected-p test result) | 1860 | (if (ert-test-result-expected-p test result) |
| 1856 | (insert " passed\n") | 1861 | (insert " passed\n") |
| @@ -1908,9 +1913,10 @@ BUFFER-NAME, if non-nil, is the buffer name to use." | |||
| 1908 | (make-string (ert-stats-total stats) | 1913 | (make-string (ert-stats-total stats) |
| 1909 | (ert-char-for-test-result nil t))) | 1914 | (ert-char-for-test-result nil t))) |
| 1910 | (set (make-local-variable 'ert--results-listener) listener) | 1915 | (set (make-local-variable 'ert--results-listener) listener) |
| 1911 | (loop for test across (ert--stats-tests stats) do | 1916 | (cl-loop for test across (ert--stats-tests stats) do |
| 1912 | (ewoc-enter-last ewoc | 1917 | (ewoc-enter-last ewoc |
| 1913 | (make-ert--ewoc-entry :test test :hidden-p t))) | 1918 | (make-ert--ewoc-entry :test test |
| 1919 | :hidden-p t))) | ||
| 1914 | (ert--results-update-ewoc-hf ert--results-ewoc ert--results-stats) | 1920 | (ert--results-update-ewoc-hf ert--results-ewoc ert--results-stats) |
| 1915 | (goto-char (1- (point-max))) | 1921 | (goto-char (1- (point-max))) |
| 1916 | buffer))))) | 1922 | buffer))))) |
| @@ -1945,21 +1951,21 @@ and how to display message." | |||
| 1945 | default nil)) | 1951 | default nil)) |
| 1946 | nil)) | 1952 | nil)) |
| 1947 | (unless message-fn (setq message-fn 'message)) | 1953 | (unless message-fn (setq message-fn 'message)) |
| 1948 | (lexical-let ((output-buffer-name output-buffer-name) | 1954 | (let ((output-buffer-name output-buffer-name) |
| 1949 | buffer | 1955 | buffer |
| 1950 | listener | 1956 | listener |
| 1951 | (message-fn message-fn)) | 1957 | (message-fn message-fn)) |
| 1952 | (setq listener | 1958 | (setq listener |
| 1953 | (lambda (event-type &rest event-args) | 1959 | (lambda (event-type &rest event-args) |
| 1954 | (ecase event-type | 1960 | (cl-ecase event-type |
| 1955 | (run-started | 1961 | (run-started |
| 1956 | (destructuring-bind (stats) event-args | 1962 | (cl-destructuring-bind (stats) event-args |
| 1957 | (setq buffer (ert--setup-results-buffer stats | 1963 | (setq buffer (ert--setup-results-buffer stats |
| 1958 | listener | 1964 | listener |
| 1959 | output-buffer-name)) | 1965 | output-buffer-name)) |
| 1960 | (pop-to-buffer buffer))) | 1966 | (pop-to-buffer buffer))) |
| 1961 | (run-ended | 1967 | (run-ended |
| 1962 | (destructuring-bind (stats abortedp) event-args | 1968 | (cl-destructuring-bind (stats abortedp) event-args |
| 1963 | (funcall message-fn | 1969 | (funcall message-fn |
| 1964 | "%sRan %s tests, %s results were as expected%s" | 1970 | "%sRan %s tests, %s results were as expected%s" |
| 1965 | (if (not abortedp) | 1971 | (if (not abortedp) |
| @@ -1976,19 +1982,19 @@ and how to display message." | |||
| 1976 | ert--results-ewoc) | 1982 | ert--results-ewoc) |
| 1977 | stats))) | 1983 | stats))) |
| 1978 | (test-started | 1984 | (test-started |
| 1979 | (destructuring-bind (stats test) event-args | 1985 | (cl-destructuring-bind (stats test) event-args |
| 1980 | (with-current-buffer buffer | 1986 | (with-current-buffer buffer |
| 1981 | (let* ((ewoc ert--results-ewoc) | 1987 | (let* ((ewoc ert--results-ewoc) |
| 1982 | (pos (ert--stats-test-pos stats test)) | 1988 | (pos (ert--stats-test-pos stats test)) |
| 1983 | (node (ewoc-nth ewoc pos))) | 1989 | (node (ewoc-nth ewoc pos))) |
| 1984 | (assert node) | 1990 | (cl-assert node) |
| 1985 | (setf (ert--ewoc-entry-test (ewoc-data node)) test) | 1991 | (setf (ert--ewoc-entry-test (ewoc-data node)) test) |
| 1986 | (aset ert--results-progress-bar-string pos | 1992 | (aset ert--results-progress-bar-string pos |
| 1987 | (ert-char-for-test-result nil t)) | 1993 | (ert-char-for-test-result nil t)) |
| 1988 | (ert--results-update-stats-display-maybe ewoc stats) | 1994 | (ert--results-update-stats-display-maybe ewoc stats) |
| 1989 | (ewoc-invalidate ewoc node))))) | 1995 | (ewoc-invalidate ewoc node))))) |
| 1990 | (test-ended | 1996 | (test-ended |
| 1991 | (destructuring-bind (stats test result) event-args | 1997 | (cl-destructuring-bind (stats test result) event-args |
| 1992 | (with-current-buffer buffer | 1998 | (with-current-buffer buffer |
| 1993 | (let* ((ewoc ert--results-ewoc) | 1999 | (let* ((ewoc ert--results-ewoc) |
| 1994 | (pos (ert--stats-test-pos stats test)) | 2000 | (pos (ert--stats-test-pos stats test)) |
| @@ -2020,28 +2026,28 @@ and how to display message." | |||
| 2020 | (define-derived-mode ert-results-mode special-mode "ERT-Results" | 2026 | (define-derived-mode ert-results-mode special-mode "ERT-Results" |
| 2021 | "Major mode for viewing results of ERT test runs.") | 2027 | "Major mode for viewing results of ERT test runs.") |
| 2022 | 2028 | ||
| 2023 | (loop for (key binding) in | 2029 | (cl-loop for (key binding) in |
| 2024 | '(;; Stuff that's not in the menu. | 2030 | '( ;; Stuff that's not in the menu. |
| 2025 | ("\t" forward-button) | 2031 | ("\t" forward-button) |
| 2026 | ([backtab] backward-button) | 2032 | ([backtab] backward-button) |
| 2027 | ("j" ert-results-jump-between-summary-and-result) | 2033 | ("j" ert-results-jump-between-summary-and-result) |
| 2028 | ("L" ert-results-toggle-printer-limits-for-test-at-point) | 2034 | ("L" ert-results-toggle-printer-limits-for-test-at-point) |
| 2029 | ("n" ert-results-next-test) | 2035 | ("n" ert-results-next-test) |
| 2030 | ("p" ert-results-previous-test) | 2036 | ("p" ert-results-previous-test) |
| 2031 | ;; Stuff that is in the menu. | 2037 | ;; Stuff that is in the menu. |
| 2032 | ("R" ert-results-rerun-all-tests) | 2038 | ("R" ert-results-rerun-all-tests) |
| 2033 | ("r" ert-results-rerun-test-at-point) | 2039 | ("r" ert-results-rerun-test-at-point) |
| 2034 | ("d" ert-results-rerun-test-at-point-debugging-errors) | 2040 | ("d" ert-results-rerun-test-at-point-debugging-errors) |
| 2035 | ("." ert-results-find-test-at-point-other-window) | 2041 | ("." ert-results-find-test-at-point-other-window) |
| 2036 | ("b" ert-results-pop-to-backtrace-for-test-at-point) | 2042 | ("b" ert-results-pop-to-backtrace-for-test-at-point) |
| 2037 | ("m" ert-results-pop-to-messages-for-test-at-point) | 2043 | ("m" ert-results-pop-to-messages-for-test-at-point) |
| 2038 | ("l" ert-results-pop-to-should-forms-for-test-at-point) | 2044 | ("l" ert-results-pop-to-should-forms-for-test-at-point) |
| 2039 | ("h" ert-results-describe-test-at-point) | 2045 | ("h" ert-results-describe-test-at-point) |
| 2040 | ("D" ert-delete-test) | 2046 | ("D" ert-delete-test) |
| 2041 | ("T" ert-results-pop-to-timings) | 2047 | ("T" ert-results-pop-to-timings) |
| 2042 | ) | 2048 | ) |
| 2043 | do | 2049 | do |
| 2044 | (define-key ert-results-mode-map key binding)) | 2050 | (define-key ert-results-mode-map key binding)) |
| 2045 | 2051 | ||
| 2046 | (easy-menu-define ert-results-mode-menu ert-results-mode-map | 2052 | (easy-menu-define ert-results-mode-menu ert-results-mode-map |
| 2047 | "Menu for `ert-results-mode'." | 2053 | "Menu for `ert-results-mode'." |
| @@ -2121,15 +2127,15 @@ To be used in the ERT results buffer." | |||
| 2121 | EWOC-FN specifies the direction and should be either `ewoc-prev' | 2127 | EWOC-FN specifies the direction and should be either `ewoc-prev' |
| 2122 | or `ewoc-next'. If there are no more nodes in that direction, an | 2128 | or `ewoc-next'. If there are no more nodes in that direction, an |
| 2123 | error is signaled with the message ERROR-MESSAGE." | 2129 | error is signaled with the message ERROR-MESSAGE." |
| 2124 | (loop | 2130 | (cl-loop |
| 2125 | (setq node (funcall ewoc-fn ert--results-ewoc node)) | 2131 | (setq node (funcall ewoc-fn ert--results-ewoc node)) |
| 2126 | (when (null node) | 2132 | (when (null node) |
| 2127 | (error "%s" error-message)) | 2133 | (error "%s" error-message)) |
| 2128 | (unless (ert--ewoc-entry-hidden-p (ewoc-data node)) | 2134 | (unless (ert--ewoc-entry-hidden-p (ewoc-data node)) |
| 2129 | (goto-char (ewoc-location node)) | 2135 | (goto-char (ewoc-location node)) |
| 2130 | (return)))) | 2136 | (cl-return)))) |
| 2131 | 2137 | ||
| 2132 | (defun ert--results-expand-collapse-button-action (button) | 2138 | (defun ert--results-expand-collapse-button-action (_button) |
| 2133 | "Expand or collapse the test node BUTTON belongs to." | 2139 | "Expand or collapse the test node BUTTON belongs to." |
| 2134 | (let* ((ewoc ert--results-ewoc) | 2140 | (let* ((ewoc ert--results-ewoc) |
| 2135 | (node (save-excursion | 2141 | (node (save-excursion |
| @@ -2158,11 +2164,11 @@ To be used in the ERT results buffer." | |||
| 2158 | (defun ert--ewoc-position (ewoc node) | 2164 | (defun ert--ewoc-position (ewoc node) |
| 2159 | ;; checkdoc-order: nil | 2165 | ;; checkdoc-order: nil |
| 2160 | "Return the position of NODE in EWOC, or nil if NODE is not in EWOC." | 2166 | "Return the position of NODE in EWOC, or nil if NODE is not in EWOC." |
| 2161 | (loop for i from 0 | 2167 | (cl-loop for i from 0 |
| 2162 | for node-here = (ewoc-nth ewoc 0) then (ewoc-next ewoc node-here) | 2168 | for node-here = (ewoc-nth ewoc 0) then (ewoc-next ewoc node-here) |
| 2163 | do (when (eql node node-here) | 2169 | do (when (eql node node-here) |
| 2164 | (return i)) | 2170 | (cl-return i)) |
| 2165 | finally (return nil))) | 2171 | finally (cl-return nil))) |
| 2166 | 2172 | ||
| 2167 | (defun ert-results-jump-between-summary-and-result () | 2173 | (defun ert-results-jump-between-summary-and-result () |
| 2168 | "Jump back and forth between the test run summary and individual test results. | 2174 | "Jump back and forth between the test run summary and individual test results. |
| @@ -2210,7 +2216,7 @@ To be used in the ERT results buffer." | |||
| 2210 | "Return the test at point, or nil. | 2216 | "Return the test at point, or nil. |
| 2211 | 2217 | ||
| 2212 | To be used in the ERT results buffer." | 2218 | To be used in the ERT results buffer." |
| 2213 | (assert (eql major-mode 'ert-results-mode)) | 2219 | (cl-assert (eql major-mode 'ert-results-mode)) |
| 2214 | (if (ert--results-test-node-or-null-at-point) | 2220 | (if (ert--results-test-node-or-null-at-point) |
| 2215 | (let* ((node (ert--results-test-node-at-point)) | 2221 | (let* ((node (ert--results-test-node-at-point)) |
| 2216 | (test (ert--ewoc-entry-test (ewoc-data node)))) | 2222 | (test (ert--ewoc-entry-test (ewoc-data node)))) |
| @@ -2282,9 +2288,9 @@ definition." | |||
| 2282 | (point)) | 2288 | (point)) |
| 2283 | ((eventp last-command-event) | 2289 | ((eventp last-command-event) |
| 2284 | (posn-point (event-start last-command-event))) | 2290 | (posn-point (event-start last-command-event))) |
| 2285 | (t (assert nil)))) | 2291 | (t (cl-assert nil)))) |
| 2286 | 2292 | ||
| 2287 | (defun ert--results-progress-bar-button-action (button) | 2293 | (defun ert--results-progress-bar-button-action (_button) |
| 2288 | "Jump to details for the test represented by the character clicked in BUTTON." | 2294 | "Jump to details for the test represented by the character clicked in BUTTON." |
| 2289 | (goto-char (ert--button-action-position)) | 2295 | (goto-char (ert--button-action-position)) |
| 2290 | (ert-results-jump-between-summary-and-result)) | 2296 | (ert-results-jump-between-summary-and-result)) |
| @@ -2294,7 +2300,7 @@ definition." | |||
| 2294 | 2300 | ||
| 2295 | To be used in the ERT results buffer." | 2301 | To be used in the ERT results buffer." |
| 2296 | (interactive) | 2302 | (interactive) |
| 2297 | (assert (eql major-mode 'ert-results-mode)) | 2303 | (cl-assert (eql major-mode 'ert-results-mode)) |
| 2298 | (let ((selector (ert--stats-selector ert--results-stats))) | 2304 | (let ((selector (ert--stats-selector ert--results-stats))) |
| 2299 | (ert-run-tests-interactively selector (buffer-name)))) | 2305 | (ert-run-tests-interactively selector (buffer-name)))) |
| 2300 | 2306 | ||
| @@ -2303,13 +2309,13 @@ To be used in the ERT results buffer." | |||
| 2303 | 2309 | ||
| 2304 | To be used in the ERT results buffer." | 2310 | To be used in the ERT results buffer." |
| 2305 | (interactive) | 2311 | (interactive) |
| 2306 | (destructuring-bind (test redefinition-state) | 2312 | (cl-destructuring-bind (test redefinition-state) |
| 2307 | (ert--results-test-at-point-allow-redefinition) | 2313 | (ert--results-test-at-point-allow-redefinition) |
| 2308 | (when (null test) | 2314 | (when (null test) |
| 2309 | (error "No test at point")) | 2315 | (error "No test at point")) |
| 2310 | (let* ((stats ert--results-stats) | 2316 | (let* ((stats ert--results-stats) |
| 2311 | (progress-message (format "Running %stest %S" | 2317 | (progress-message (format "Running %stest %S" |
| 2312 | (ecase redefinition-state | 2318 | (cl-ecase redefinition-state |
| 2313 | ((nil) "") | 2319 | ((nil) "") |
| 2314 | (redefined "new definition of ") | 2320 | (redefined "new definition of ") |
| 2315 | (deleted "deleted ")) | 2321 | (deleted "deleted ")) |
| @@ -2350,7 +2356,7 @@ To be used in the ERT results buffer." | |||
| 2350 | (stats ert--results-stats) | 2356 | (stats ert--results-stats) |
| 2351 | (pos (ert--stats-test-pos stats test)) | 2357 | (pos (ert--stats-test-pos stats test)) |
| 2352 | (result (aref (ert--stats-test-results stats) pos))) | 2358 | (result (aref (ert--stats-test-results stats) pos))) |
| 2353 | (etypecase result | 2359 | (cl-etypecase result |
| 2354 | (ert-test-passed (error "Test passed, no backtrace available")) | 2360 | (ert-test-passed (error "Test passed, no backtrace available")) |
| 2355 | (ert-test-result-with-condition | 2361 | (ert-test-result-with-condition |
| 2356 | (let ((backtrace (ert-test-result-with-condition-backtrace result)) | 2362 | (let ((backtrace (ert-test-result-with-condition-backtrace result)) |
| @@ -2408,13 +2414,14 @@ To be used in the ERT results buffer." | |||
| 2408 | (ert-simple-view-mode) | 2414 | (ert-simple-view-mode) |
| 2409 | (if (null (ert-test-result-should-forms result)) | 2415 | (if (null (ert-test-result-should-forms result)) |
| 2410 | (insert "\n(No should forms during this test.)\n") | 2416 | (insert "\n(No should forms during this test.)\n") |
| 2411 | (loop for form-description in (ert-test-result-should-forms result) | 2417 | (cl-loop for form-description |
| 2412 | for i from 1 do | 2418 | in (ert-test-result-should-forms result) |
| 2413 | (insert "\n") | 2419 | for i from 1 do |
| 2414 | (insert (format "%s: " i)) | 2420 | (insert "\n") |
| 2415 | (let ((begin (point))) | 2421 | (insert (format "%s: " i)) |
| 2416 | (ert--pp-with-indentation-and-newline form-description) | 2422 | (let ((begin (point))) |
| 2417 | (ert--make-xrefs-region begin (point))))) | 2423 | (ert--pp-with-indentation-and-newline form-description) |
| 2424 | (ert--make-xrefs-region begin (point))))) | ||
| 2418 | (goto-char (point-min)) | 2425 | (goto-char (point-min)) |
| 2419 | (insert "`should' forms executed during test `") | 2426 | (insert "`should' forms executed during test `") |
| 2420 | (ert-insert-test-name-button (ert-test-name test)) | 2427 | (ert-insert-test-name-button (ert-test-name test)) |
| @@ -2443,17 +2450,16 @@ To be used in the ERT results buffer." | |||
| 2443 | To be used in the ERT results buffer." | 2450 | To be used in the ERT results buffer." |
| 2444 | (interactive) | 2451 | (interactive) |
| 2445 | (let* ((stats ert--results-stats) | 2452 | (let* ((stats ert--results-stats) |
| 2446 | (start-times (ert--stats-test-start-times stats)) | ||
| 2447 | (end-times (ert--stats-test-end-times stats)) | ||
| 2448 | (buffer (get-buffer-create "*ERT timings*")) | 2453 | (buffer (get-buffer-create "*ERT timings*")) |
| 2449 | (data (loop for test across (ert--stats-tests stats) | 2454 | (data (cl-loop for test across (ert--stats-tests stats) |
| 2450 | for start-time across (ert--stats-test-start-times stats) | 2455 | for start-time across (ert--stats-test-start-times |
| 2451 | for end-time across (ert--stats-test-end-times stats) | 2456 | stats) |
| 2452 | collect (list test | 2457 | for end-time across (ert--stats-test-end-times stats) |
| 2453 | (float-time (subtract-time end-time | 2458 | collect (list test |
| 2454 | start-time)))))) | 2459 | (float-time (subtract-time |
| 2460 | end-time start-time)))))) | ||
| 2455 | (setq data (sort data (lambda (a b) | 2461 | (setq data (sort data (lambda (a b) |
| 2456 | (> (second a) (second b))))) | 2462 | (> (cl-second a) (cl-second b))))) |
| 2457 | (pop-to-buffer buffer) | 2463 | (pop-to-buffer buffer) |
| 2458 | (let ((inhibit-read-only t)) | 2464 | (let ((inhibit-read-only t)) |
| 2459 | (buffer-disable-undo) | 2465 | (buffer-disable-undo) |
| @@ -2462,13 +2468,13 @@ To be used in the ERT results buffer." | |||
| 2462 | (if (null data) | 2468 | (if (null data) |
| 2463 | (insert "(No data)\n") | 2469 | (insert "(No data)\n") |
| 2464 | (insert (format "%-3s %8s %8s\n" "" "time" "cumul")) | 2470 | (insert (format "%-3s %8s %8s\n" "" "time" "cumul")) |
| 2465 | (loop for (test time) in data | 2471 | (cl-loop for (test time) in data |
| 2466 | for cumul-time = time then (+ cumul-time time) | 2472 | for cumul-time = time then (+ cumul-time time) |
| 2467 | for i from 1 do | 2473 | for i from 1 do |
| 2468 | (let ((begin (point))) | 2474 | (progn |
| 2469 | (insert (format "%3s: %8.3f %8.3f " i time cumul-time)) | 2475 | (insert (format "%3s: %8.3f %8.3f " i time cumul-time)) |
| 2470 | (ert-insert-test-name-button (ert-test-name test)) | 2476 | (ert-insert-test-name-button (ert-test-name test)) |
| 2471 | (insert "\n")))) | 2477 | (insert "\n")))) |
| 2472 | (goto-char (point-min)) | 2478 | (goto-char (point-min)) |
| 2473 | (insert "Tests by run time (seconds):\n\n") | 2479 | (insert "Tests by run time (seconds):\n\n") |
| 2474 | (forward-line 1)))) | 2480 | (forward-line 1)))) |
| @@ -2481,7 +2487,7 @@ To be used in the ERT results buffer." | |||
| 2481 | (error "Requires Emacs 24")) | 2487 | (error "Requires Emacs 24")) |
| 2482 | (let (test-name | 2488 | (let (test-name |
| 2483 | test-definition) | 2489 | test-definition) |
| 2484 | (etypecase test-or-test-name | 2490 | (cl-etypecase test-or-test-name |
| 2485 | (symbol (setq test-name test-or-test-name | 2491 | (symbol (setq test-name test-or-test-name |
| 2486 | test-definition (ert-get-test test-or-test-name))) | 2492 | test-definition (ert-get-test test-or-test-name))) |
| 2487 | (ert-test (setq test-name (ert-test-name test-or-test-name) | 2493 | (ert-test (setq test-name (ert-test-name test-or-test-name) |
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 540e0166ec2..d9c5316b1b8 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el | |||
| @@ -402,6 +402,56 @@ of the piece of advice." | |||
| 402 | (if (fboundp function-name) | 402 | (if (fboundp function-name) |
| 403 | (symbol-function function-name)))))) | 403 | (symbol-function function-name)))))) |
| 404 | 404 | ||
| 405 | ;; When code is advised, called-interactively-p needs to be taught to skip | ||
| 406 | ;; the advising frames. | ||
| 407 | ;; FIXME: This Major Ugly Hack won't handle calls to called-interactively-p | ||
| 408 | ;; done from the advised function if the deepest advice is an around advice! | ||
| 409 | ;; In other cases (calls from an advice or calls from the advised function when | ||
| 410 | ;; the deepest advice is not an around advice), it should hopefully get | ||
| 411 | ;; it right. | ||
| 412 | (add-hook 'called-interactively-p-functions | ||
| 413 | #'advice--called-interactively-skip) | ||
| 414 | (defun advice--called-interactively-skip (origi frame1 frame2) | ||
| 415 | (let* ((i origi) | ||
| 416 | (get-next-frame | ||
| 417 | (lambda () | ||
| 418 | (setq frame1 frame2) | ||
| 419 | (setq frame2 (internal--called-interactively-p--get-frame i)) | ||
| 420 | ;; (message "Advice Frame %d = %S" i frame2) | ||
| 421 | (setq i (1+ i))))) | ||
| 422 | (when (and (eq (nth 1 frame2) 'apply) | ||
| 423 | (progn | ||
| 424 | (funcall get-next-frame) | ||
| 425 | (advice--p (indirect-function (nth 1 frame2))))) | ||
| 426 | (funcall get-next-frame) | ||
| 427 | ;; If we now have the symbol, this was the head advice and | ||
| 428 | ;; we're done. | ||
| 429 | (while (advice--p (nth 1 frame1)) | ||
| 430 | ;; This was an inner advice called from some earlier advice. | ||
| 431 | ;; The stack frames look different depending on the particular | ||
| 432 | ;; kind of the earlier advice. | ||
| 433 | (let ((inneradvice (nth 1 frame1))) | ||
| 434 | (if (and (eq (nth 1 frame2) 'apply) | ||
| 435 | (progn | ||
| 436 | (funcall get-next-frame) | ||
| 437 | (advice--p (indirect-function | ||
| 438 | (nth 1 frame2))))) | ||
| 439 | ;; The earlier advice was something like a before/after | ||
| 440 | ;; advice where the "next" code is called directly by the | ||
| 441 | ;; advice--p object. | ||
| 442 | (funcall get-next-frame) | ||
| 443 | ;; It's apparently an around advice, where the "next" is | ||
| 444 | ;; called by the body of the advice in any way it sees fit, | ||
| 445 | ;; so we need to skip the frames of that body. | ||
| 446 | (while | ||
| 447 | (progn | ||
| 448 | (funcall get-next-frame) | ||
| 449 | (not (and (eq (nth 1 frame2) 'apply) | ||
| 450 | (eq (nth 3 frame2) inneradvice))))) | ||
| 451 | (funcall get-next-frame) | ||
| 452 | (funcall get-next-frame)))) | ||
| 453 | (- i origi 1)))) | ||
| 454 | |||
| 405 | 455 | ||
| 406 | (provide 'nadvice) | 456 | (provide 'nadvice) |
| 407 | ;;; nadvice.el ends here | 457 | ;;; nadvice.el ends here |
diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el index c6fff7aa443..722e6270e95 100644 --- a/lisp/emacs-lisp/trace.el +++ b/lisp/emacs-lisp/trace.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; trace.el --- tracing facility for Emacs Lisp functions | 1 | ;;; trace.el --- tracing facility for Emacs Lisp functions -*- lexical-binding: t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1993, 1998, 2000-2012 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1993, 1998, 2000-2012 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -151,18 +151,15 @@ | |||
| 151 | 151 | ||
| 152 | ;;; Code: | 152 | ;;; Code: |
| 153 | 153 | ||
| 154 | (require 'advice) | ||
| 155 | |||
| 156 | (defgroup trace nil | 154 | (defgroup trace nil |
| 157 | "Tracing facility for Emacs Lisp functions." | 155 | "Tracing facility for Emacs Lisp functions." |
| 158 | :prefix "trace-" | 156 | :prefix "trace-" |
| 159 | :group 'lisp) | 157 | :group 'lisp) |
| 160 | 158 | ||
| 161 | ;;;###autoload | 159 | ;;;###autoload |
| 162 | (defcustom trace-buffer (purecopy "*trace-output*") | 160 | (defcustom trace-buffer "*trace-output*" |
| 163 | "Trace output will by default go to that buffer." | 161 | "Trace output will by default go to that buffer." |
| 164 | :type 'string | 162 | :type 'string) |
| 165 | :group 'trace) | ||
| 166 | 163 | ||
| 167 | ;; Current level of traced function invocation: | 164 | ;; Current level of traced function invocation: |
| 168 | (defvar trace-level 0) | 165 | (defvar trace-level 0) |
| @@ -176,78 +173,109 @@ | |||
| 176 | (defvar inhibit-trace nil | 173 | (defvar inhibit-trace nil |
| 177 | "If non-nil, all tracing is temporarily inhibited.") | 174 | "If non-nil, all tracing is temporarily inhibited.") |
| 178 | 175 | ||
| 179 | (defun trace-entry-message (function level argument-bindings) | 176 | (defun trace-entry-message (function level args context) |
| 180 | ;; Generates a string that describes that FUNCTION has been entered at | 177 | "Generate a string that describes that FUNCTION has been entered. |
| 181 | ;; trace LEVEL with ARGUMENT-BINDINGS. | 178 | LEVEL is the trace level, ARGS is the list of arguments passed to FUNCTION, |
| 182 | (format "%s%s%d -> %s: %s\n" | 179 | and CONTEXT is a string describing the dynamic context (e.g. values of |
| 183 | (mapconcat 'char-to-string (make-string (1- level) ?|) " ") | 180 | some global variables)." |
| 184 | (if (> level 1) " " "") | 181 | (let ((print-circle t)) |
| 185 | level | 182 | (format "%s%s%d -> %S%s\n" |
| 186 | function | 183 | (mapconcat 'char-to-string (make-string (1- level) ?|) " ") |
| 187 | (let ((print-circle t)) | 184 | (if (> level 1) " " "") |
| 188 | (mapconcat (lambda (binding) | 185 | level |
| 189 | (concat | 186 | (cons function args) |
| 190 | (symbol-name (ad-arg-binding-field binding 'name)) | 187 | context))) |
| 191 | "=" | 188 | |
| 192 | ;; do this so we'll see strings: | 189 | (defun trace-exit-message (function level value context) |
| 193 | (prin1-to-string | 190 | "Generate a string that describes that FUNCTION has exited. |
| 194 | (ad-arg-binding-field binding 'value)))) | 191 | LEVEL is the trace level, VALUE value returned by FUNCTION, |
| 195 | argument-bindings | 192 | and CONTEXT is a string describing the dynamic context (e.g. values of |
| 196 | " ")))) | 193 | some global variables)." |
| 197 | 194 | (let ((print-circle t)) | |
| 198 | (defun trace-exit-message (function level value) | 195 | (format "%s%s%d <- %s: %S%s\n" |
| 199 | ;; Generates a string that describes that FUNCTION has been exited at | 196 | (mapconcat 'char-to-string (make-string (1- level) ?|) " ") |
| 200 | ;; trace LEVEL and that it returned VALUE. | 197 | (if (> level 1) " " "") |
| 201 | (format "%s%s%d <- %s: %s\n" | 198 | level |
| 202 | (mapconcat 'char-to-string (make-string (1- level) ?|) " ") | 199 | function |
| 203 | (if (> level 1) " " "") | 200 | ;; Do this so we'll see strings: |
| 204 | level | 201 | value |
| 205 | function | 202 | context))) |
| 206 | ;; do this so we'll see strings: | 203 | |
| 207 | (let ((print-circle t)) (prin1-to-string value)))) | 204 | (defvar trace--timer nil) |
| 208 | 205 | ||
| 209 | (defun trace-make-advice (function buffer background) | 206 | (defun trace-make-advice (function buffer background context) |
| 210 | ;; Builds the piece of advice to be added to FUNCTION's advice info | 207 | "Build the piece of advice to be added to trace FUNCTION. |
| 211 | ;; so that it will generate the proper trace output in BUFFER | 208 | FUNCTION is the name of the traced function. |
| 212 | ;; (quietly if BACKGROUND is t). | 209 | BUFFER is the buffer where the trace should be printed. |
| 213 | (ad-make-advice | 210 | BACKGROUND if nil means to display BUFFER. |
| 214 | trace-advice-name nil t | 211 | CONTEXT if non-nil should be a function that returns extra info that should |
| 215 | `(advice | 212 | be printed along with the arguments in the trace." |
| 216 | lambda () | 213 | (lambda (body &rest args) |
| 217 | (let ((trace-level (1+ trace-level)) | 214 | (let ((trace-level (1+ trace-level)) |
| 218 | (trace-buffer (get-buffer-create ,buffer))) | 215 | (trace-buffer (get-buffer-create buffer)) |
| 219 | (unless inhibit-trace | 216 | (ctx (funcall context))) |
| 220 | (with-current-buffer trace-buffer | 217 | (unless inhibit-trace |
| 221 | (set (make-local-variable 'window-point-insertion-type) t) | 218 | (with-current-buffer trace-buffer |
| 222 | ,(unless background '(display-buffer trace-buffer)) | 219 | (set (make-local-variable 'window-point-insertion-type) t) |
| 223 | (goto-char (point-max)) | 220 | (unless (or background trace--timer |
| 224 | ;; Insert a separator from previous trace output: | 221 | (get-buffer-window trace-buffer 'visible)) |
| 225 | (if (= trace-level 1) (insert trace-separator)) | 222 | (setq trace--timer |
| 226 | (insert | 223 | ;; Postpone the display to some later time, in case we |
| 227 | (trace-entry-message | 224 | ;; can't actually do it now. |
| 228 | ',function trace-level ad-arg-bindings)))) | 225 | (run-with-timer 0 nil |
| 229 | ad-do-it | 226 | (lambda () |
| 230 | (unless inhibit-trace | 227 | (setq trace--timer nil) |
| 231 | (with-current-buffer trace-buffer | 228 | (display-buffer trace-buffer))))) |
| 232 | ,(unless background '(display-buffer trace-buffer)) | 229 | (goto-char (point-max)) |
| 233 | (goto-char (point-max)) | 230 | ;; Insert a separator from previous trace output: |
| 234 | (insert | 231 | (if (= trace-level 1) (insert trace-separator)) |
| 235 | (trace-exit-message | 232 | (insert |
| 236 | ',function trace-level ad-return-value)))))))) | 233 | (trace-entry-message |
| 237 | 234 | function trace-level args ctx)))) | |
| 238 | (defun trace-function-internal (function buffer background) | 235 | (let ((result)) |
| 239 | ;; Adds trace advice for FUNCTION and activates it. | 236 | (unwind-protect |
| 240 | (ad-add-advice | 237 | (setq result (list (apply body args))) |
| 241 | function | 238 | (unless inhibit-trace |
| 242 | (trace-make-advice function (or buffer trace-buffer) background) | 239 | (let ((ctx (funcall context))) |
| 243 | 'around 'last) | 240 | (with-current-buffer trace-buffer |
| 244 | (ad-activate function nil)) | 241 | (unless background (display-buffer trace-buffer)) |
| 242 | (goto-char (point-max)) | ||
| 243 | (insert | ||
| 244 | (trace-exit-message | ||
| 245 | function | ||
| 246 | trace-level | ||
| 247 | (if result (car result) '\!non-local\ exit\!) | ||
| 248 | ctx)))))) | ||
| 249 | (car result))))) | ||
| 250 | |||
| 251 | (defun trace-function-internal (function buffer background context) | ||
| 252 | "Add trace advice for FUNCTION." | ||
| 253 | (advice-add | ||
| 254 | function :around | ||
| 255 | (trace-make-advice function (or buffer trace-buffer) background | ||
| 256 | (or context (lambda () ""))) | ||
| 257 | `((name . ,trace-advice-name)))) | ||
| 245 | 258 | ||
| 246 | (defun trace-is-traced (function) | 259 | (defun trace-is-traced (function) |
| 247 | (ad-find-advice function 'around trace-advice-name)) | 260 | (advice-member-p trace-advice-name function)) |
| 261 | |||
| 262 | (defun trace--read-args (prompt) | ||
| 263 | (cons | ||
| 264 | (intern (completing-read prompt obarray 'fboundp t)) | ||
| 265 | (when current-prefix-arg | ||
| 266 | (list | ||
| 267 | (read-buffer "Output to buffer: " trace-buffer) | ||
| 268 | (let ((exp | ||
| 269 | (let ((minibuffer-completing-symbol t)) | ||
| 270 | (read-from-minibuffer "Context expression: " | ||
| 271 | nil read-expression-map t | ||
| 272 | 'read-expression-history)))) | ||
| 273 | `(lambda () | ||
| 274 | (let ((print-circle t)) | ||
| 275 | (concat " [" (prin1-to-string ,exp) "]")))))))) | ||
| 248 | 276 | ||
| 249 | ;;;###autoload | 277 | ;;;###autoload |
| 250 | (defun trace-function (function &optional buffer) | 278 | (defun trace-function-foreground (function &optional buffer context) |
| 251 | "Traces FUNCTION with trace output going to BUFFER. | 279 | "Traces FUNCTION with trace output going to BUFFER. |
| 252 | For every call of FUNCTION Lisp-style trace messages that display argument | 280 | For every call of FUNCTION Lisp-style trace messages that display argument |
| 253 | and return values will be inserted into BUFFER. This function generates the | 281 | and return values will be inserted into BUFFER. This function generates the |
| @@ -255,14 +283,11 @@ trace advice for FUNCTION and activates it together with any other advice | |||
| 255 | there might be!! The trace BUFFER will popup whenever FUNCTION is called. | 283 | there might be!! The trace BUFFER will popup whenever FUNCTION is called. |
| 256 | Do not use this to trace functions that switch buffers or do any other | 284 | Do not use this to trace functions that switch buffers or do any other |
| 257 | display oriented stuff, use `trace-function-background' instead." | 285 | display oriented stuff, use `trace-function-background' instead." |
| 258 | (interactive | 286 | (interactive (trace--read-args "Trace function: ")) |
| 259 | (list | 287 | (trace-function-internal function buffer nil context)) |
| 260 | (intern (completing-read "Trace function: " obarray 'fboundp t)) | ||
| 261 | (read-buffer "Output to buffer: " trace-buffer))) | ||
| 262 | (trace-function-internal function buffer nil)) | ||
| 263 | 288 | ||
| 264 | ;;;###autoload | 289 | ;;;###autoload |
| 265 | (defun trace-function-background (function &optional buffer) | 290 | (defun trace-function-background (function &optional buffer context) |
| 266 | "Traces FUNCTION with trace output going quietly to BUFFER. | 291 | "Traces FUNCTION with trace output going quietly to BUFFER. |
| 267 | When this tracing is enabled, every call to FUNCTION writes | 292 | When this tracing is enabled, every call to FUNCTION writes |
| 268 | a Lisp-style trace message (showing the arguments and return value) | 293 | a Lisp-style trace message (showing the arguments and return value) |
| @@ -272,12 +297,11 @@ The trace output goes to BUFFER quietly, without changing | |||
| 272 | the window or buffer configuration. | 297 | the window or buffer configuration. |
| 273 | 298 | ||
| 274 | BUFFER defaults to `trace-buffer'." | 299 | BUFFER defaults to `trace-buffer'." |
| 275 | (interactive | 300 | (interactive (trace--read-args "Trace function in background: ")) |
| 276 | (list | 301 | (trace-function-internal function buffer t context)) |
| 277 | (intern | 302 | |
| 278 | (completing-read "Trace function in background: " obarray 'fboundp t)) | 303 | ;;;###autoload |
| 279 | (read-buffer "Output to buffer: " trace-buffer))) | 304 | (defalias 'trace-function 'trace-function-foreground) |
| 280 | (trace-function-internal function buffer t)) | ||
| 281 | 305 | ||
| 282 | (defun untrace-function (function) | 306 | (defun untrace-function (function) |
| 283 | "Untraces FUNCTION and possibly activates all remaining advice. | 307 | "Untraces FUNCTION and possibly activates all remaining advice. |
| @@ -285,16 +309,14 @@ Activation is performed with `ad-update', hence remaining advice will get | |||
| 285 | activated only if the advice of FUNCTION is currently active. If FUNCTION | 309 | activated only if the advice of FUNCTION is currently active. If FUNCTION |
| 286 | was not traced this is a noop." | 310 | was not traced this is a noop." |
| 287 | (interactive | 311 | (interactive |
| 288 | (list (ad-read-advised-function "Untrace function" 'trace-is-traced))) | 312 | (list (intern (completing-read "Untrace function: " |
| 289 | (when (trace-is-traced function) | 313 | obarray #'trace-is-traced t)))) |
| 290 | (ad-remove-advice function 'around trace-advice-name) | 314 | (advice-remove function trace-advice-name)) |
| 291 | (ad-update function))) | ||
| 292 | 315 | ||
| 293 | (defun untrace-all () | 316 | (defun untrace-all () |
| 294 | "Untraces all currently traced functions." | 317 | "Untraces all currently traced functions." |
| 295 | (interactive) | 318 | (interactive) |
| 296 | (ad-do-advised-functions (function) | 319 | (mapatoms #'untrace-function)) |
| 297 | (untrace-function function))) | ||
| 298 | 320 | ||
| 299 | (provide 'trace) | 321 | (provide 'trace) |
| 300 | 322 | ||
diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index e0a88461dc9..ca7edd1aa88 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog | |||
| @@ -1,3 +1,16 @@ | |||
| 1 | 2012-11-19 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | Use cl-lib instead of cl, and interactive-p => called-interactively-p. | ||
| 4 | * erc-track.el, erc-networks.el, erc-netsplit.el, erc-dcc.el: | ||
| 5 | * erc-backend.el: Use cl-lib, nth, pcase, and called-interactively-p | ||
| 6 | instead of cl. | ||
| 7 | * erc-speedbar.el, erc-services.el, erc-pcomplete.el, erc-notify.el: | ||
| 8 | * erc-match.el, erc-log.el, erc-join.el, erc-ezbounce.el: | ||
| 9 | * erc-capab.el: Don't require cl since we don't use it. | ||
| 10 | * erc.el: Use cl-lib, nth, pcase, and called-interactively-p i.s.o cl. | ||
| 11 | (erc-lurker-ignore-chars, erc-common-server-suffixes): | ||
| 12 | Move before first use. | ||
| 13 | |||
| 1 | 2012-11-16 Glenn Morris <rgm@gnu.org> | 14 | 2012-11-16 Glenn Morris <rgm@gnu.org> |
| 2 | 15 | ||
| 3 | * erc.el (erc-modules): Add "notifications". Tweak "hecomplete" doc. | 16 | * erc.el (erc-modules): Add "notifications". Tweak "hecomplete" doc. |
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 90b96d7c763..a3d0ebe121f 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el | |||
| @@ -98,7 +98,7 @@ | |||
| 98 | ;;; Code: | 98 | ;;; Code: |
| 99 | 99 | ||
| 100 | (require 'erc-compat) | 100 | (require 'erc-compat) |
| 101 | (eval-when-compile (require 'cl)) | 101 | (eval-when-compile (require 'cl-lib)) |
| 102 | ;; There's a fairly strong mutual dependency between erc.el and erc-backend.el. | 102 | ;; There's a fairly strong mutual dependency between erc.el and erc-backend.el. |
| 103 | ;; Luckily, erc.el does not need erc-backend.el for macroexpansion whereas the | 103 | ;; Luckily, erc.el does not need erc-backend.el for macroexpansion whereas the |
| 104 | ;; reverse is true: | 104 | ;; reverse is true: |
| @@ -109,7 +109,7 @@ | |||
| 109 | (defvar erc-server-responses (make-hash-table :test #'equal) | 109 | (defvar erc-server-responses (make-hash-table :test #'equal) |
| 110 | "Hashtable mapping server responses to their handler hooks.") | 110 | "Hashtable mapping server responses to their handler hooks.") |
| 111 | 111 | ||
| 112 | (defstruct (erc-response (:conc-name erc-response.)) | 112 | (cl-defstruct (erc-response (:conc-name erc-response.)) |
| 113 | (unparsed "" :type string) | 113 | (unparsed "" :type string) |
| 114 | (sender "" :type string) | 114 | (sender "" :type string) |
| 115 | (command "" :type string) | 115 | (command "" :type string) |
| @@ -950,7 +950,7 @@ PROCs `process-buffer' is `current-buffer' when this function is called." | |||
| 950 | (push str (erc-response.command-args msg)))) | 950 | (push str (erc-response.command-args msg)))) |
| 951 | 951 | ||
| 952 | (setf (erc-response.contents msg) | 952 | (setf (erc-response.contents msg) |
| 953 | (first (erc-response.command-args msg))) | 953 | (car (erc-response.command-args msg))) |
| 954 | 954 | ||
| 955 | (setf (erc-response.command-args msg) | 955 | (setf (erc-response.command-args msg) |
| 956 | (nreverse (erc-response.command-args msg))) | 956 | (nreverse (erc-response.command-args msg))) |
| @@ -1045,7 +1045,7 @@ Finds hooks by looking in the `erc-server-responses' hashtable." | |||
| 1045 | (name &rest name) | 1045 | (name &rest name) |
| 1046 | &optional sexp sexp def-body)) | 1046 | &optional sexp sexp def-body)) |
| 1047 | 1047 | ||
| 1048 | (defmacro* define-erc-response-handler ((name &rest aliases) | 1048 | (cl-defmacro define-erc-response-handler ((name &rest aliases) |
| 1049 | &optional extra-fn-doc extra-var-doc | 1049 | &optional extra-fn-doc extra-var-doc |
| 1050 | &rest fn-body) | 1050 | &rest fn-body) |
| 1051 | "Define an ERC handler hook/function pair. | 1051 | "Define an ERC handler hook/function pair. |
| @@ -1154,11 +1154,11 @@ add things to `%s' instead." | |||
| 1154 | "") | 1154 | "") |
| 1155 | name hook-name)) | 1155 | name hook-name)) |
| 1156 | (fn-alternates | 1156 | (fn-alternates |
| 1157 | (loop for alias in aliases | 1157 | (cl-loop for alias in aliases |
| 1158 | collect (intern (format "erc-server-%s" alias)))) | 1158 | collect (intern (format "erc-server-%s" alias)))) |
| 1159 | (var-alternates | 1159 | (var-alternates |
| 1160 | (loop for alias in aliases | 1160 | (cl-loop for alias in aliases |
| 1161 | collect (intern (format "erc-server-%s-functions" alias))))) | 1161 | collect (intern (format "erc-server-%s-functions" alias))))) |
| 1162 | `(prog2 | 1162 | `(prog2 |
| 1163 | ;; Normal hook variable. | 1163 | ;; Normal hook variable. |
| 1164 | (defvar ,hook-name ',fn-name ,(format hook-doc name)) | 1164 | (defvar ,hook-name ',fn-name ,(format hook-doc name)) |
| @@ -1172,19 +1172,19 @@ add things to `%s' instead." | |||
| 1172 | (put ',hook-name 'definition-name ',name) | 1172 | (put ',hook-name 'definition-name ',name) |
| 1173 | 1173 | ||
| 1174 | ;; Hashtable map of responses to hook variables | 1174 | ;; Hashtable map of responses to hook variables |
| 1175 | ,@(loop for response in (cons name aliases) | 1175 | ,@(cl-loop for response in (cons name aliases) |
| 1176 | for var in (cons hook-name var-alternates) | 1176 | for var in (cons hook-name var-alternates) |
| 1177 | collect `(puthash ,(format "%s" response) ',var | 1177 | collect `(puthash ,(format "%s" response) ',var |
| 1178 | erc-server-responses)) | 1178 | erc-server-responses)) |
| 1179 | ;; Alternates. | 1179 | ;; Alternates. |
| 1180 | ;; Functions are defaliased, hook variables are defvared so we | 1180 | ;; Functions are defaliased, hook variables are defvared so we |
| 1181 | ;; can add hooks to one alias, but not another. | 1181 | ;; can add hooks to one alias, but not another. |
| 1182 | ,@(loop for fn in fn-alternates | 1182 | ,@(cl-loop for fn in fn-alternates |
| 1183 | for var in var-alternates | 1183 | for var in var-alternates |
| 1184 | for a in aliases | 1184 | for a in aliases |
| 1185 | nconc (list `(defalias ',fn ',fn-name) | 1185 | nconc (list `(defalias ',fn ',fn-name) |
| 1186 | `(defvar ,var ',fn-name ,(format hook-doc a)) | 1186 | `(defvar ,var ',fn-name ,(format hook-doc a)) |
| 1187 | `(put ',var 'definition-name ',hook-name)))))) | 1187 | `(put ',var 'definition-name ',hook-name)))))) |
| 1188 | 1188 | ||
| 1189 | (define-erc-response-handler (ERROR) | 1189 | (define-erc-response-handler (ERROR) |
| 1190 | "Handle an ERROR command from the server." nil | 1190 | "Handle an ERROR command from the server." nil |
| @@ -1196,10 +1196,10 @@ add things to `%s' instead." | |||
| 1196 | (define-erc-response-handler (INVITE) | 1196 | (define-erc-response-handler (INVITE) |
| 1197 | "Handle invitation messages." | 1197 | "Handle invitation messages." |
| 1198 | nil | 1198 | nil |
| 1199 | (let ((target (first (erc-response.command-args parsed))) | 1199 | (let ((target (car (erc-response.command-args parsed))) |
| 1200 | (chnl (erc-response.contents parsed))) | 1200 | (chnl (erc-response.contents parsed))) |
| 1201 | (multiple-value-bind (nick login host) | 1201 | (pcase-let ((`(,nick ,login ,host) |
| 1202 | (values-list (erc-parse-user (erc-response.sender parsed))) | 1202 | (erc-parse-user (erc-response.sender parsed)))) |
| 1203 | (setq erc-invitation chnl) | 1203 | (setq erc-invitation chnl) |
| 1204 | (when (string= target (erc-current-nick)) | 1204 | (when (string= target (erc-current-nick)) |
| 1205 | (erc-display-message | 1205 | (erc-display-message |
| @@ -1212,8 +1212,8 @@ add things to `%s' instead." | |||
| 1212 | nil | 1212 | nil |
| 1213 | (let ((chnl (erc-response.contents parsed)) | 1213 | (let ((chnl (erc-response.contents parsed)) |
| 1214 | (buffer nil)) | 1214 | (buffer nil)) |
| 1215 | (multiple-value-bind (nick login host) | 1215 | (pcase-let ((`(,nick ,login ,host) |
| 1216 | (values-list (erc-parse-user (erc-response.sender parsed))) | 1216 | (erc-parse-user (erc-response.sender parsed)))) |
| 1217 | ;; strip the stupid combined JOIN facility (IRC 2.9) | 1217 | ;; strip the stupid combined JOIN facility (IRC 2.9) |
| 1218 | (if (string-match "^\\(.*\\)?\^g.*$" chnl) | 1218 | (if (string-match "^\\(.*\\)?\^g.*$" chnl) |
| 1219 | (setq chnl (match-string 1 chnl))) | 1219 | (setq chnl (match-string 1 chnl))) |
| @@ -1249,12 +1249,12 @@ add things to `%s' instead." | |||
| 1249 | 1249 | ||
| 1250 | (define-erc-response-handler (KICK) | 1250 | (define-erc-response-handler (KICK) |
| 1251 | "Handle kick messages received from the server." nil | 1251 | "Handle kick messages received from the server." nil |
| 1252 | (let* ((ch (first (erc-response.command-args parsed))) | 1252 | (let* ((ch (nth 0 (erc-response.command-args parsed))) |
| 1253 | (tgt (second (erc-response.command-args parsed))) | 1253 | (tgt (nth 1 (erc-response.command-args parsed))) |
| 1254 | (reason (erc-trim-string (erc-response.contents parsed))) | 1254 | (reason (erc-trim-string (erc-response.contents parsed))) |
| 1255 | (buffer (erc-get-buffer ch proc))) | 1255 | (buffer (erc-get-buffer ch proc))) |
| 1256 | (multiple-value-bind (nick login host) | 1256 | (pcase-let ((`(,nick ,login ,host) |
| 1257 | (values-list (erc-parse-user (erc-response.sender parsed))) | 1257 | (erc-parse-user (erc-response.sender parsed)))) |
| 1258 | (erc-remove-channel-member buffer tgt) | 1258 | (erc-remove-channel-member buffer tgt) |
| 1259 | (cond | 1259 | (cond |
| 1260 | ((string= tgt (erc-current-nick)) | 1260 | ((string= tgt (erc-current-nick)) |
| @@ -1277,11 +1277,11 @@ add things to `%s' instead." | |||
| 1277 | 1277 | ||
| 1278 | (define-erc-response-handler (MODE) | 1278 | (define-erc-response-handler (MODE) |
| 1279 | "Handle server mode changes." nil | 1279 | "Handle server mode changes." nil |
| 1280 | (let ((tgt (first (erc-response.command-args parsed))) | 1280 | (let ((tgt (car (erc-response.command-args parsed))) |
| 1281 | (mode (mapconcat 'identity (cdr (erc-response.command-args parsed)) | 1281 | (mode (mapconcat 'identity (cdr (erc-response.command-args parsed)) |
| 1282 | " "))) | 1282 | " "))) |
| 1283 | (multiple-value-bind (nick login host) | 1283 | (pcase-let ((`(,nick ,login ,host) |
| 1284 | (values-list (erc-parse-user (erc-response.sender parsed))) | 1284 | (erc-parse-user (erc-response.sender parsed)))) |
| 1285 | (erc-log (format "MODE: %s -> %s: %s" nick tgt mode)) | 1285 | (erc-log (format "MODE: %s -> %s: %s" nick tgt mode)) |
| 1286 | ;; dirty hack | 1286 | ;; dirty hack |
| 1287 | (let ((buf (cond ((erc-channel-p tgt) | 1287 | (let ((buf (cond ((erc-channel-p tgt) |
| @@ -1305,8 +1305,8 @@ add things to `%s' instead." | |||
| 1305 | "Handle nick change messages." nil | 1305 | "Handle nick change messages." nil |
| 1306 | (let ((nn (erc-response.contents parsed)) | 1306 | (let ((nn (erc-response.contents parsed)) |
| 1307 | bufs) | 1307 | bufs) |
| 1308 | (multiple-value-bind (nick login host) | 1308 | (pcase-let ((`(,nick ,login ,host) |
| 1309 | (values-list (erc-parse-user (erc-response.sender parsed))) | 1309 | (erc-parse-user (erc-response.sender parsed)))) |
| 1310 | (setq bufs (erc-buffer-list-with-nick nick proc)) | 1310 | (setq bufs (erc-buffer-list-with-nick nick proc)) |
| 1311 | (erc-log (format "NICK: %s -> %s" nick nn)) | 1311 | (erc-log (format "NICK: %s -> %s" nick nn)) |
| 1312 | ;; if we had a query with this user, make sure future messages will be | 1312 | ;; if we had a query with this user, make sure future messages will be |
| @@ -1340,11 +1340,11 @@ add things to `%s' instead." | |||
| 1340 | 1340 | ||
| 1341 | (define-erc-response-handler (PART) | 1341 | (define-erc-response-handler (PART) |
| 1342 | "Handle part messages." nil | 1342 | "Handle part messages." nil |
| 1343 | (let* ((chnl (first (erc-response.command-args parsed))) | 1343 | (let* ((chnl (car (erc-response.command-args parsed))) |
| 1344 | (reason (erc-trim-string (erc-response.contents parsed))) | 1344 | (reason (erc-trim-string (erc-response.contents parsed))) |
| 1345 | (buffer (erc-get-buffer chnl proc))) | 1345 | (buffer (erc-get-buffer chnl proc))) |
| 1346 | (multiple-value-bind (nick login host) | 1346 | (pcase-let ((`(,nick ,login ,host) |
| 1347 | (values-list (erc-parse-user (erc-response.sender parsed))) | 1347 | (erc-parse-user (erc-response.sender parsed)))) |
| 1348 | (erc-remove-channel-member buffer nick) | 1348 | (erc-remove-channel-member buffer nick) |
| 1349 | (erc-display-message parsed 'notice buffer | 1349 | (erc-display-message parsed 'notice buffer |
| 1350 | 'PART ?n nick ?u login | 1350 | 'PART ?n nick ?u login |
| @@ -1361,7 +1361,7 @@ add things to `%s' instead." | |||
| 1361 | 1361 | ||
| 1362 | (define-erc-response-handler (PING) | 1362 | (define-erc-response-handler (PING) |
| 1363 | "Handle ping messages." nil | 1363 | "Handle ping messages." nil |
| 1364 | (let ((pinger (first (erc-response.command-args parsed)))) | 1364 | (let ((pinger (car (erc-response.command-args parsed)))) |
| 1365 | (erc-log (format "PING: %s" pinger)) | 1365 | (erc-log (format "PING: %s" pinger)) |
| 1366 | ;; ping response to the server MUST be forced, or you can lose big | 1366 | ;; ping response to the server MUST be forced, or you can lose big |
| 1367 | (erc-server-send (format "PONG :%s" pinger) t) | 1367 | (erc-server-send (format "PONG :%s" pinger) t) |
| @@ -1379,7 +1379,7 @@ add things to `%s' instead." | |||
| 1379 | (when erc-verbose-server-ping | 1379 | (when erc-verbose-server-ping |
| 1380 | (erc-display-message | 1380 | (erc-display-message |
| 1381 | parsed 'notice proc 'PONG | 1381 | parsed 'notice proc 'PONG |
| 1382 | ?h (first (erc-response.command-args parsed)) ?i erc-server-lag | 1382 | ?h (car (erc-response.command-args parsed)) ?i erc-server-lag |
| 1383 | ?s (if (/= erc-server-lag 1) "s" ""))) | 1383 | ?s (if (/= erc-server-lag 1) "s" ""))) |
| 1384 | (erc-update-mode-line)))) | 1384 | (erc-update-mode-line)))) |
| 1385 | 1385 | ||
| @@ -1451,8 +1451,8 @@ add things to `%s' instead." | |||
| 1451 | "Another user has quit IRC." nil | 1451 | "Another user has quit IRC." nil |
| 1452 | (let ((reason (erc-response.contents parsed)) | 1452 | (let ((reason (erc-response.contents parsed)) |
| 1453 | bufs) | 1453 | bufs) |
| 1454 | (multiple-value-bind (nick login host) | 1454 | (pcase-let ((`(,nick ,login ,host) |
| 1455 | (values-list (erc-parse-user (erc-response.sender parsed))) | 1455 | (erc-parse-user (erc-response.sender parsed)))) |
| 1456 | (setq bufs (erc-buffer-list-with-nick nick proc)) | 1456 | (setq bufs (erc-buffer-list-with-nick nick proc)) |
| 1457 | (erc-remove-user nick) | 1457 | (erc-remove-user nick) |
| 1458 | (setq reason (erc-wash-quit-reason reason nick login host)) | 1458 | (setq reason (erc-wash-quit-reason reason nick login host)) |
| @@ -1462,12 +1462,12 @@ add things to `%s' instead." | |||
| 1462 | 1462 | ||
| 1463 | (define-erc-response-handler (TOPIC) | 1463 | (define-erc-response-handler (TOPIC) |
| 1464 | "The channel topic has changed." nil | 1464 | "The channel topic has changed." nil |
| 1465 | (let* ((ch (first (erc-response.command-args parsed))) | 1465 | (let* ((ch (car (erc-response.command-args parsed))) |
| 1466 | (topic (erc-trim-string (erc-response.contents parsed))) | 1466 | (topic (erc-trim-string (erc-response.contents parsed))) |
| 1467 | (time (format-time-string erc-server-timestamp-format | 1467 | (time (format-time-string erc-server-timestamp-format |
| 1468 | (current-time)))) | 1468 | (current-time)))) |
| 1469 | (multiple-value-bind (nick login host) | 1469 | (pcase-let ((`(,nick ,login ,host) |
| 1470 | (values-list (erc-parse-user (erc-response.sender parsed))) | 1470 | (erc-parse-user (erc-response.sender parsed)))) |
| 1471 | (erc-update-channel-member ch nick nick nil nil nil host login) | 1471 | (erc-update-channel-member ch nick nick nil nil nil host login) |
| 1472 | (erc-update-channel-topic ch (format "%s\C-o (%s, %s)" topic nick time)) | 1472 | (erc-update-channel-topic ch (format "%s\C-o (%s, %s)" topic nick time)) |
| 1473 | (erc-display-message parsed 'notice (erc-get-buffer ch proc) | 1473 | (erc-display-message parsed 'notice (erc-get-buffer ch proc) |
| @@ -1477,8 +1477,8 @@ add things to `%s' instead." | |||
| 1477 | (define-erc-response-handler (WALLOPS) | 1477 | (define-erc-response-handler (WALLOPS) |
| 1478 | "Display a WALLOPS message." nil | 1478 | "Display a WALLOPS message." nil |
| 1479 | (let ((message (erc-response.contents parsed))) | 1479 | (let ((message (erc-response.contents parsed))) |
| 1480 | (multiple-value-bind (nick login host) | 1480 | (pcase-let ((`(,nick ,login ,host) |
| 1481 | (values-list (erc-parse-user (erc-response.sender parsed))) | 1481 | (erc-parse-user (erc-response.sender parsed)))) |
| 1482 | (erc-display-message | 1482 | (erc-display-message |
| 1483 | parsed 'notice nil | 1483 | parsed 'notice nil |
| 1484 | 'WALLOPS ?n nick ?m message)))) | 1484 | 'WALLOPS ?n nick ?m message)))) |
| @@ -1486,7 +1486,7 @@ add things to `%s' instead." | |||
| 1486 | (define-erc-response-handler (001) | 1486 | (define-erc-response-handler (001) |
| 1487 | "Set `erc-server-current-nick' to reflect server settings and display the welcome message." | 1487 | "Set `erc-server-current-nick' to reflect server settings and display the welcome message." |
| 1488 | nil | 1488 | nil |
| 1489 | (erc-set-current-nick (first (erc-response.command-args parsed))) | 1489 | (erc-set-current-nick (car (erc-response.command-args parsed))) |
| 1490 | (erc-update-mode-line) ; needed here? | 1490 | (erc-update-mode-line) ; needed here? |
| 1491 | (setq erc-nick-change-attempt-count 0) | 1491 | (setq erc-nick-change-attempt-count 0) |
| 1492 | (setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick))) | 1492 | (setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick))) |
| @@ -1507,16 +1507,16 @@ add things to `%s' instead." | |||
| 1507 | 1507 | ||
| 1508 | (define-erc-response-handler (004) | 1508 | (define-erc-response-handler (004) |
| 1509 | "Display the server's identification." nil | 1509 | "Display the server's identification." nil |
| 1510 | (multiple-value-bind (server-name server-version) | 1510 | (pcase-let ((`(,server-name ,server-version) |
| 1511 | (values-list (cdr (erc-response.command-args parsed))) | 1511 | (cdr (erc-response.command-args parsed)))) |
| 1512 | (setq erc-server-version server-version) | 1512 | (setq erc-server-version server-version) |
| 1513 | (setq erc-server-announced-name server-name) | 1513 | (setq erc-server-announced-name server-name) |
| 1514 | (erc-update-mode-line-buffer (process-buffer proc)) | 1514 | (erc-update-mode-line-buffer (process-buffer proc)) |
| 1515 | (erc-display-message | 1515 | (erc-display-message |
| 1516 | parsed 'notice proc | 1516 | parsed 'notice proc |
| 1517 | 's004 ?s server-name ?v server-version | 1517 | 's004 ?s server-name ?v server-version |
| 1518 | ?U (fourth (erc-response.command-args parsed)) | 1518 | ?U (nth 3 (erc-response.command-args parsed)) |
| 1519 | ?C (fifth (erc-response.command-args parsed))))) | 1519 | ?C (nth 4 (erc-response.command-args parsed))))) |
| 1520 | 1520 | ||
| 1521 | (define-erc-response-handler (005) | 1521 | (define-erc-response-handler (005) |
| 1522 | "Set the variable `erc-server-parameters' and display the received message. | 1522 | "Set the variable `erc-server-parameters' and display the received message. |
| @@ -1547,7 +1547,7 @@ A server may send more than one 005 message." | |||
| 1547 | 1547 | ||
| 1548 | (define-erc-response-handler (221) | 1548 | (define-erc-response-handler (221) |
| 1549 | "Display the current user modes." nil | 1549 | "Display the current user modes." nil |
| 1550 | (let* ((nick (first (erc-response.command-args parsed))) | 1550 | (let* ((nick (car (erc-response.command-args parsed))) |
| 1551 | (modes (mapconcat 'identity | 1551 | (modes (mapconcat 'identity |
| 1552 | (cdr (erc-response.command-args parsed)) " "))) | 1552 | (cdr (erc-response.command-args parsed)) " "))) |
| 1553 | (erc-set-modes nick modes) | 1553 | (erc-set-modes nick modes) |
| @@ -1576,8 +1576,8 @@ See `erc-display-server-message'." nil | |||
| 1576 | 1576 | ||
| 1577 | (define-erc-response-handler (275) | 1577 | (define-erc-response-handler (275) |
| 1578 | "Display secure connection message." nil | 1578 | "Display secure connection message." nil |
| 1579 | (multiple-value-bind (nick user message) | 1579 | (pcase-let ((`(,nick ,user ,message) |
| 1580 | (values-list (cdr (erc-response.command-args parsed))) | 1580 | (cdr (erc-response.command-args parsed)))) |
| 1581 | (erc-display-message | 1581 | (erc-display-message |
| 1582 | parsed 'notice 'active 's275 | 1582 | parsed 'notice 'active 's275 |
| 1583 | ?n nick | 1583 | ?n nick |
| @@ -1612,8 +1612,8 @@ See `erc-display-server-message'." nil | |||
| 1612 | 1612 | ||
| 1613 | (define-erc-response-handler (307) | 1613 | (define-erc-response-handler (307) |
| 1614 | "Display nick-identified message." nil | 1614 | "Display nick-identified message." nil |
| 1615 | (multiple-value-bind (nick user message) | 1615 | (pcase-let ((`(,nick ,user ,message) |
| 1616 | (values-list (cdr (erc-response.command-args parsed))) | 1616 | (cdr (erc-response.command-args parsed)))) |
| 1617 | (erc-display-message | 1617 | (erc-display-message |
| 1618 | parsed 'notice 'active 's307 | 1618 | parsed 'notice 'active 's307 |
| 1619 | ?n nick | 1619 | ?n nick |
| @@ -1624,8 +1624,8 @@ See `erc-display-server-message'." nil | |||
| 1624 | "WHOIS/WHOWAS notices." nil | 1624 | "WHOIS/WHOWAS notices." nil |
| 1625 | (let ((fname (erc-response.contents parsed)) | 1625 | (let ((fname (erc-response.contents parsed)) |
| 1626 | (catalog-entry (intern (format "s%s" (erc-response.command parsed))))) | 1626 | (catalog-entry (intern (format "s%s" (erc-response.command parsed))))) |
| 1627 | (multiple-value-bind (nick user host) | 1627 | (pcase-let ((`(,nick ,user ,host) |
| 1628 | (values-list (cdr (erc-response.command-args parsed))) | 1628 | (cdr (erc-response.command-args parsed)))) |
| 1629 | (erc-update-user-nick nick nick host nil fname user) | 1629 | (erc-update-user-nick nick nick host nil fname user) |
| 1630 | (erc-display-message | 1630 | (erc-display-message |
| 1631 | parsed 'notice 'active catalog-entry | 1631 | parsed 'notice 'active catalog-entry |
| @@ -1633,8 +1633,8 @@ See `erc-display-server-message'." nil | |||
| 1633 | 1633 | ||
| 1634 | (define-erc-response-handler (312) | 1634 | (define-erc-response-handler (312) |
| 1635 | "Server name response in WHOIS." nil | 1635 | "Server name response in WHOIS." nil |
| 1636 | (multiple-value-bind (nick server-host) | 1636 | (pcase-let ((`(,nick ,server-host)) |
| 1637 | (values-list (cdr (erc-response.command-args parsed))) | 1637 | (cdr (erc-response.command-args parsed))) |
| 1638 | (erc-display-message | 1638 | (erc-display-message |
| 1639 | parsed 'notice 'active 's312 | 1639 | parsed 'notice 'active 's312 |
| 1640 | ?n nick ?s server-host ?c (erc-response.contents parsed)))) | 1640 | ?n nick ?s server-host ?c (erc-response.contents parsed)))) |
| @@ -1655,8 +1655,8 @@ See `erc-display-server-message'." nil | |||
| 1655 | 1655 | ||
| 1656 | (define-erc-response-handler (317) | 1656 | (define-erc-response-handler (317) |
| 1657 | "IDLE notice." nil | 1657 | "IDLE notice." nil |
| 1658 | (multiple-value-bind (nick seconds-idle on-since time) | 1658 | (pcase-let ((`(,nick ,seconds-idle ,on-since ,time) |
| 1659 | (values-list (cdr (erc-response.command-args parsed))) | 1659 | (cdr (erc-response.command-args parsed)))) |
| 1660 | (setq time (when on-since | 1660 | (setq time (when on-since |
| 1661 | (format-time-string erc-server-timestamp-format | 1661 | (format-time-string erc-server-timestamp-format |
| 1662 | (erc-string-to-emacs-time on-since)))) | 1662 | (erc-string-to-emacs-time on-since)))) |
| @@ -1696,16 +1696,16 @@ See `erc-display-server-message'." nil | |||
| 1696 | (define-erc-response-handler (322) | 1696 | (define-erc-response-handler (322) |
| 1697 | "LIST notice." nil | 1697 | "LIST notice." nil |
| 1698 | (let ((topic (erc-response.contents parsed))) | 1698 | (let ((topic (erc-response.contents parsed))) |
| 1699 | (multiple-value-bind (channel num-users) | 1699 | (pcase-let ((`(,channel ,num-users) |
| 1700 | (values-list (cdr (erc-response.command-args parsed))) | 1700 | (cdr (erc-response.command-args parsed)))) |
| 1701 | (add-to-list 'erc-channel-list (list channel)) | 1701 | (add-to-list 'erc-channel-list (list channel)) |
| 1702 | (erc-update-channel-topic channel topic)))) | 1702 | (erc-update-channel-topic channel topic)))) |
| 1703 | 1703 | ||
| 1704 | (defun erc-server-322-message (proc parsed) | 1704 | (defun erc-server-322-message (proc parsed) |
| 1705 | "Display a message for the 322 event." | 1705 | "Display a message for the 322 event." |
| 1706 | (let ((topic (erc-response.contents parsed))) | 1706 | (let ((topic (erc-response.contents parsed))) |
| 1707 | (multiple-value-bind (channel num-users) | 1707 | (pcase-let ((`(,channel ,num-users) |
| 1708 | (values-list (cdr (erc-response.command-args parsed))) | 1708 | (cdr (erc-response.command-args parsed)))) |
| 1709 | (erc-display-message | 1709 | (erc-display-message |
| 1710 | parsed 'notice proc 's322 | 1710 | parsed 'notice proc 's322 |
| 1711 | ?c channel ?u num-users ?t (or topic ""))))) | 1711 | ?c channel ?u num-users ?t (or topic ""))))) |
| @@ -1732,7 +1732,7 @@ See `erc-display-server-message'." nil | |||
| 1732 | "Channel creation date." nil | 1732 | "Channel creation date." nil |
| 1733 | (let ((channel (second (erc-response.command-args parsed))) | 1733 | (let ((channel (second (erc-response.command-args parsed))) |
| 1734 | (time (erc-string-to-emacs-time | 1734 | (time (erc-string-to-emacs-time |
| 1735 | (third (erc-response.command-args parsed))))) | 1735 | (nth 2 (erc-response.command-args parsed))))) |
| 1736 | (erc-display-message | 1736 | (erc-display-message |
| 1737 | parsed 'notice (erc-get-buffer channel proc) | 1737 | parsed 'notice (erc-get-buffer channel proc) |
| 1738 | 's329 ?c channel ?t (format-time-string erc-server-timestamp-format | 1738 | 's329 ?c channel ?t (format-time-string erc-server-timestamp-format |
| @@ -1749,7 +1749,7 @@ See `erc-display-server-message'." nil | |||
| 1749 | ;; authmsg == (aref parsed 5) | 1749 | ;; authmsg == (aref parsed 5) |
| 1750 | ;; The guesses below are, well, just that. -- Lawrence 2004/05/10 | 1750 | ;; The guesses below are, well, just that. -- Lawrence 2004/05/10 |
| 1751 | (let ((nick (second (erc-response.command-args parsed))) | 1751 | (let ((nick (second (erc-response.command-args parsed))) |
| 1752 | (authaccount (third (erc-response.command-args parsed))) | 1752 | (authaccount (nth 2 (erc-response.command-args parsed))) |
| 1753 | (authmsg (erc-response.contents parsed))) | 1753 | (authmsg (erc-response.contents parsed))) |
| 1754 | (erc-display-message parsed 'notice 'active 's330 | 1754 | (erc-display-message parsed 'notice 'active 's330 |
| 1755 | ?n nick ?a authmsg ?i authaccount))) | 1755 | ?n nick ?a authmsg ?i authaccount))) |
| @@ -1771,8 +1771,8 @@ See `erc-display-server-message'." nil | |||
| 1771 | 1771 | ||
| 1772 | (define-erc-response-handler (333) | 1772 | (define-erc-response-handler (333) |
| 1773 | "Who set the topic, and when." nil | 1773 | "Who set the topic, and when." nil |
| 1774 | (multiple-value-bind (channel nick time) | 1774 | (pcase-let ((`(,channel ,nick ,time) |
| 1775 | (values-list (cdr (erc-response.command-args parsed))) | 1775 | (cdr (erc-response.command-args parsed)))) |
| 1776 | (setq time (format-time-string erc-server-timestamp-format | 1776 | (setq time (format-time-string erc-server-timestamp-format |
| 1777 | (erc-string-to-emacs-time time))) | 1777 | (erc-string-to-emacs-time time))) |
| 1778 | (erc-update-channel-topic channel | 1778 | (erc-update-channel-topic channel |
| @@ -1784,15 +1784,15 @@ See `erc-display-server-message'." nil | |||
| 1784 | (define-erc-response-handler (341) | 1784 | (define-erc-response-handler (341) |
| 1785 | "Let user know when an INVITE attempt has been sent successfully." | 1785 | "Let user know when an INVITE attempt has been sent successfully." |
| 1786 | nil | 1786 | nil |
| 1787 | (multiple-value-bind (nick channel) | 1787 | (pcase-let ((`(,nick ,channel) |
| 1788 | (values-list (cdr (erc-response.command-args parsed))) | 1788 | (cdr (erc-response.command-args parsed)))) |
| 1789 | (erc-display-message parsed 'notice (erc-get-buffer channel proc) | 1789 | (erc-display-message parsed 'notice (erc-get-buffer channel proc) |
| 1790 | 's341 ?n nick ?c channel))) | 1790 | 's341 ?n nick ?c channel))) |
| 1791 | 1791 | ||
| 1792 | (define-erc-response-handler (352) | 1792 | (define-erc-response-handler (352) |
| 1793 | "WHO notice." nil | 1793 | "WHO notice." nil |
| 1794 | (multiple-value-bind (channel user host server nick away-flag) | 1794 | (pcase-let ((`(,channel ,user ,host ,server ,nick ,away-flag) |
| 1795 | (values-list (cdr (erc-response.command-args parsed))) | 1795 | (cdr (erc-response.command-args parsed)))) |
| 1796 | (let ((full-name (erc-response.contents parsed)) | 1796 | (let ((full-name (erc-response.contents parsed)) |
| 1797 | hopcount) | 1797 | hopcount) |
| 1798 | (when (string-match "\\(^[0-9]+ \\)\\(.*\\)$" full-name) | 1798 | (when (string-match "\\(^[0-9]+ \\)\\(.*\\)$" full-name) |
| @@ -1806,7 +1806,7 @@ See `erc-display-server-message'." nil | |||
| 1806 | 1806 | ||
| 1807 | (define-erc-response-handler (353) | 1807 | (define-erc-response-handler (353) |
| 1808 | "NAMES notice." nil | 1808 | "NAMES notice." nil |
| 1809 | (let ((channel (third (erc-response.command-args parsed))) | 1809 | (let ((channel (nth 2 (erc-response.command-args parsed))) |
| 1810 | (users (erc-response.contents parsed))) | 1810 | (users (erc-response.contents parsed))) |
| 1811 | (erc-display-message parsed 'notice (or (erc-get-buffer channel proc) | 1811 | (erc-display-message parsed 'notice (or (erc-get-buffer channel proc) |
| 1812 | 'active) | 1812 | 'active) |
| @@ -1821,8 +1821,8 @@ See `erc-display-server-message'." nil | |||
| 1821 | 1821 | ||
| 1822 | (define-erc-response-handler (367) | 1822 | (define-erc-response-handler (367) |
| 1823 | "Channel ban list entries." nil | 1823 | "Channel ban list entries." nil |
| 1824 | (multiple-value-bind (channel banmask setter time) | 1824 | (pcase-let ((`(,channel ,banmask ,setter ,time) |
| 1825 | (values-list (cdr (erc-response.command-args parsed))) | 1825 | (cdr (erc-response.command-args parsed)))) |
| 1826 | ;; setter and time are not standard | 1826 | ;; setter and time are not standard |
| 1827 | (if setter | 1827 | (if setter |
| 1828 | (erc-display-message parsed 'notice 'active 's367-set-by | 1828 | (erc-display-message parsed 'notice 'active 's367-set-by |
| @@ -1845,8 +1845,8 @@ See `erc-display-server-message'." nil | |||
| 1845 | ;; FIXME: Yet more magic numbers in original code, I'm guessing this | 1845 | ;; FIXME: Yet more magic numbers in original code, I'm guessing this |
| 1846 | ;; command takes two arguments, and doesn't have any "contents". -- | 1846 | ;; command takes two arguments, and doesn't have any "contents". -- |
| 1847 | ;; Lawrence 2004/05/10 | 1847 | ;; Lawrence 2004/05/10 |
| 1848 | (multiple-value-bind (from to) | 1848 | (pcase-let ((`(,from ,to) |
| 1849 | (values-list (cdr (erc-response.command-args parsed))) | 1849 | (cdr (erc-response.command-args parsed)))) |
| 1850 | (erc-display-message parsed 'notice 'active | 1850 | (erc-display-message parsed 'notice 'active |
| 1851 | 's379 ?c from ?f to))) | 1851 | 's379 ?c from ?f to))) |
| 1852 | 1852 | ||
| @@ -1855,7 +1855,7 @@ See `erc-display-server-message'." nil | |||
| 1855 | (erc-display-message | 1855 | (erc-display-message |
| 1856 | parsed 'notice 'active | 1856 | parsed 'notice 'active |
| 1857 | 's391 ?s (second (erc-response.command-args parsed)) | 1857 | 's391 ?s (second (erc-response.command-args parsed)) |
| 1858 | ?t (third (erc-response.command-args parsed)))) | 1858 | ?t (nth 2 (erc-response.command-args parsed)))) |
| 1859 | 1859 | ||
| 1860 | (define-erc-response-handler (401) | 1860 | (define-erc-response-handler (401) |
| 1861 | "No such nick/channel." nil | 1861 | "No such nick/channel." nil |
diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el index 08b9c67f6c0..e8201f2ea43 100644 --- a/lisp/erc/erc-capab.el +++ b/lisp/erc/erc-capab.el | |||
| @@ -68,7 +68,6 @@ | |||
| 68 | ;;; Code: | 68 | ;;; Code: |
| 69 | 69 | ||
| 70 | (require 'erc) | 70 | (require 'erc) |
| 71 | (eval-when-compile (require 'cl)) | ||
| 72 | 71 | ||
| 73 | ;;; Customization: | 72 | ;;; Customization: |
| 74 | 73 | ||
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index ed8440315eb..e31416f0e1a 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el | |||
| @@ -54,9 +54,7 @@ | |||
| 54 | ;;; Code: | 54 | ;;; Code: |
| 55 | 55 | ||
| 56 | (require 'erc) | 56 | (require 'erc) |
| 57 | (eval-when-compile | 57 | (eval-when-compile (require 'pcomplete)) |
| 58 | (require 'cl) | ||
| 59 | (require 'pcomplete)) | ||
| 60 | 58 | ||
| 61 | ;;;###autoload (autoload 'erc-dcc-mode "erc-dcc") | 59 | ;;;###autoload (autoload 'erc-dcc-mode "erc-dcc") |
| 62 | (define-erc-module dcc nil | 60 | (define-erc-module dcc nil |
| @@ -277,7 +275,7 @@ Argument IP is the address as a string. The result is also a string." | |||
| 277 | (* (nth 1 ips) 65536.0) | 275 | (* (nth 1 ips) 65536.0) |
| 278 | (* (nth 2 ips) 256.0) | 276 | (* (nth 2 ips) 256.0) |
| 279 | (nth 3 ips)))) | 277 | (nth 3 ips)))) |
| 280 | (if (interactive-p) | 278 | (if (called-interactively-p 'interactive) |
| 281 | (message "%s is %.0f" ip res) | 279 | (message "%s is %.0f" ip res) |
| 282 | (format "%.0f" res))))) | 280 | (format "%.0f" res))))) |
| 283 | 281 | ||
| @@ -380,8 +378,8 @@ created subprocess, or nil." | |||
| 380 | (with-no-warnings ; obsolete since 23.1 | 378 | (with-no-warnings ; obsolete since 23.1 |
| 381 | (set-process-filter-multibyte process nil))))) | 379 | (set-process-filter-multibyte process nil))))) |
| 382 | (file-error | 380 | (file-error |
| 383 | (unless (and (string= "Cannot bind server socket" (cadr err)) | 381 | (unless (and (string= "Cannot bind server socket" (nth 1 err)) |
| 384 | (string= "address already in use" (caddr err))) | 382 | (string= "address already in use" (nth 2 err))) |
| 385 | (signal (car err) (cdr err))) | 383 | (signal (car err) (cdr err))) |
| 386 | (setq port (1+ port)) | 384 | (setq port (1+ port)) |
| 387 | (unless (< port upper) | 385 | (unless (< port upper) |
| @@ -434,38 +432,38 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc." | |||
| 434 | (pcomplete-here (append '("chat" "close" "get" "list") | 432 | (pcomplete-here (append '("chat" "close" "get" "list") |
| 435 | (when (fboundp 'make-network-process) '("send")))) | 433 | (when (fboundp 'make-network-process) '("send")))) |
| 436 | (pcomplete-here | 434 | (pcomplete-here |
| 437 | (case (intern (downcase (pcomplete-arg 1))) | 435 | (pcase (intern (downcase (pcomplete-arg 1))) |
| 438 | (chat (mapcar (lambda (elt) (plist-get elt :nick)) | 436 | (`chat (mapcar (lambda (elt) (plist-get elt :nick)) |
| 437 | (erc-remove-if-not | ||
| 438 | #'(lambda (elt) | ||
| 439 | (eq (plist-get elt :type) 'CHAT)) | ||
| 440 | erc-dcc-list))) | ||
| 441 | (`close (erc-delete-dups | ||
| 442 | (mapcar (lambda (elt) (symbol-name (plist-get elt :type))) | ||
| 443 | erc-dcc-list))) | ||
| 444 | (`get (mapcar #'erc-dcc-nick | ||
| 439 | (erc-remove-if-not | 445 | (erc-remove-if-not |
| 440 | #'(lambda (elt) | 446 | #'(lambda (elt) |
| 441 | (eq (plist-get elt :type) 'CHAT)) | 447 | (eq (plist-get elt :type) 'GET)) |
| 442 | erc-dcc-list))) | 448 | erc-dcc-list))) |
| 443 | (close (erc-delete-dups | 449 | (`send (pcomplete-erc-all-nicks)))) |
| 444 | (mapcar (lambda (elt) (symbol-name (plist-get elt :type))) | ||
| 445 | erc-dcc-list))) | ||
| 446 | (get (mapcar #'erc-dcc-nick | ||
| 447 | (erc-remove-if-not | ||
| 448 | #'(lambda (elt) | ||
| 449 | (eq (plist-get elt :type) 'GET)) | ||
| 450 | erc-dcc-list))) | ||
| 451 | (send (pcomplete-erc-all-nicks)))) | ||
| 452 | (pcomplete-here | 450 | (pcomplete-here |
| 453 | (case (intern (downcase (pcomplete-arg 2))) | 451 | (pcase (intern (downcase (pcomplete-arg 2))) |
| 454 | (get (mapcar (lambda (elt) (plist-get elt :file)) | 452 | (`get (mapcar (lambda (elt) (plist-get elt :file)) |
| 455 | (erc-remove-if-not | 453 | (erc-remove-if-not |
| 456 | #'(lambda (elt) | 454 | #'(lambda (elt) |
| 457 | (and (eq (plist-get elt :type) 'GET) | 455 | (and (eq (plist-get elt :type) 'GET) |
| 458 | (erc-nick-equal-p (erc-extract-nick | 456 | (erc-nick-equal-p (erc-extract-nick |
| 459 | (plist-get elt :nick)) | 457 | (plist-get elt :nick)) |
| 460 | (pcomplete-arg 1)))) | 458 | (pcomplete-arg 1)))) |
| 461 | erc-dcc-list))) | 459 | erc-dcc-list))) |
| 462 | (close (mapcar #'erc-dcc-nick | 460 | (`close (mapcar #'erc-dcc-nick |
| 463 | (erc-remove-if-not | 461 | (erc-remove-if-not |
| 464 | #'(lambda (elt) | 462 | #'(lambda (elt) |
| 465 | (eq (plist-get elt :type) | 463 | (eq (plist-get elt :type) |
| 466 | (intern (upcase (pcomplete-arg 1))))) | 464 | (intern (upcase (pcomplete-arg 1))))) |
| 467 | erc-dcc-list))) | 465 | erc-dcc-list))) |
| 468 | (send (pcomplete-entries))))) | 466 | (`send (pcomplete-entries))))) |
| 469 | 467 | ||
| 470 | (defun erc-dcc-do-CHAT-command (proc &optional nick) | 468 | (defun erc-dcc-do-CHAT-command (proc &optional nick) |
| 471 | (when nick | 469 | (when nick |
| @@ -1248,7 +1246,7 @@ other client." | |||
| 1248 | 1246 | ||
| 1249 | (defun erc-dcc-no-such-nick (proc parsed) | 1247 | (defun erc-dcc-no-such-nick (proc parsed) |
| 1250 | "Detect and handle no-such-nick replies from the IRC server." | 1248 | "Detect and handle no-such-nick replies from the IRC server." |
| 1251 | (let* ((elt (erc-dcc-member :nick (second (erc-response.command-args parsed)) | 1249 | (let* ((elt (erc-dcc-member :nick (nth 1 (erc-response.command-args parsed)) |
| 1252 | :parent proc)) | 1250 | :parent proc)) |
| 1253 | (peer (plist-get elt :peer))) | 1251 | (peer (plist-get elt :peer))) |
| 1254 | (when (or (and (processp peer) (not (eq (process-status peer) 'open))) | 1252 | (when (or (and (processp peer) (not (eq (process-status peer) 'open))) |
diff --git a/lisp/erc/erc-ezbounce.el b/lisp/erc/erc-ezbounce.el index 5e5d6c2c188..6bcc17e4bc0 100644 --- a/lisp/erc/erc-ezbounce.el +++ b/lisp/erc/erc-ezbounce.el | |||
| @@ -26,7 +26,6 @@ | |||
| 26 | ;;; Code: | 26 | ;;; Code: |
| 27 | 27 | ||
| 28 | (require 'erc) | 28 | (require 'erc) |
| 29 | (eval-when-compile (require 'cl)) | ||
| 30 | 29 | ||
| 31 | (defgroup erc-ezbounce nil | 30 | (defgroup erc-ezbounce nil |
| 32 | "Interface to the EZBounce IRC bouncer (a virtual IRC server)" | 31 | "Interface to the EZBounce IRC bouncer (a virtual IRC server)" |
diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el index ac6b311a0c4..e285cfb4ec5 100644 --- a/lisp/erc/erc-join.el +++ b/lisp/erc/erc-join.el | |||
| @@ -34,7 +34,6 @@ | |||
| 34 | 34 | ||
| 35 | (require 'erc) | 35 | (require 'erc) |
| 36 | (require 'auth-source) | 36 | (require 'auth-source) |
| 37 | (eval-when-compile (require 'cl)) | ||
| 38 | 37 | ||
| 39 | (defgroup erc-autojoin nil | 38 | (defgroup erc-autojoin nil |
| 40 | "Enable autojoining." | 39 | "Enable autojoining." |
diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el index b3f3f5865a1..1ff2951e09e 100644 --- a/lisp/erc/erc-log.el +++ b/lisp/erc/erc-log.el | |||
| @@ -93,9 +93,7 @@ | |||
| 93 | ;;; Code: | 93 | ;;; Code: |
| 94 | 94 | ||
| 95 | (require 'erc) | 95 | (require 'erc) |
| 96 | (eval-when-compile | 96 | (eval-when-compile (require 'erc-networks)) |
| 97 | (require 'erc-networks) | ||
| 98 | (require 'cl)) | ||
| 99 | 97 | ||
| 100 | (defgroup erc-log nil | 98 | (defgroup erc-log nil |
| 101 | "Logging facilities for ERC." | 99 | "Logging facilities for ERC." |
| @@ -429,7 +427,8 @@ You can save every individual message by putting this function on | |||
| 429 | file t 'nomessage)))) | 427 | file t 'nomessage)))) |
| 430 | (let ((coding-system-for-write coding-system)) | 428 | (let ((coding-system-for-write coding-system)) |
| 431 | (write-region start end file t 'nomessage)))) | 429 | (write-region start end file t 'nomessage)))) |
| 432 | (if (and erc-truncate-buffer-on-save (interactive-p)) | 430 | (if (and erc-truncate-buffer-on-save |
| 431 | (called-interactively-p 'interactive)) | ||
| 433 | (progn | 432 | (progn |
| 434 | (let ((inhibit-read-only t)) (erase-buffer)) | 433 | (let ((inhibit-read-only t)) (erase-buffer)) |
| 435 | (move-marker erc-last-saved-position (point-max)) | 434 | (move-marker erc-last-saved-position (point-max)) |
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 8dcdcb9e2e6..f1219427360 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el | |||
| @@ -35,7 +35,6 @@ | |||
| 35 | ;;; Code: | 35 | ;;; Code: |
| 36 | 36 | ||
| 37 | (require 'erc) | 37 | (require 'erc) |
| 38 | (eval-when-compile (require 'cl)) | ||
| 39 | 38 | ||
| 40 | ;; Customization: | 39 | ;; Customization: |
| 41 | 40 | ||
diff --git a/lisp/erc/erc-netsplit.el b/lisp/erc/erc-netsplit.el index fc4aeb10c84..cbaf62b1a61 100644 --- a/lisp/erc/erc-netsplit.el +++ b/lisp/erc/erc-netsplit.el | |||
| @@ -31,7 +31,6 @@ | |||
| 31 | ;;; Code: | 31 | ;;; Code: |
| 32 | 32 | ||
| 33 | (require 'erc) | 33 | (require 'erc) |
| 34 | (eval-when-compile (require 'cl)) | ||
| 35 | 34 | ||
| 36 | (defgroup erc-netsplit nil | 35 | (defgroup erc-netsplit nil |
| 37 | "Netsplit detection tries to automatically figure when a | 36 | "Netsplit detection tries to automatically figure when a |
| @@ -107,7 +106,7 @@ join from that split has been detected or not.") | |||
| 107 | (dolist (elt erc-netsplit-list) | 106 | (dolist (elt erc-netsplit-list) |
| 108 | (if (member nick (nthcdr 3 elt)) | 107 | (if (member nick (nthcdr 3 elt)) |
| 109 | (progn | 108 | (progn |
| 110 | (if (not (caddr elt)) | 109 | (if (not (nth 2 elt)) |
| 111 | (progn | 110 | (progn |
| 112 | (erc-display-message | 111 | (erc-display-message |
| 113 | parsed 'notice (process-buffer proc) | 112 | parsed 'notice (process-buffer proc) |
| @@ -149,7 +148,7 @@ join from that split has been detected or not.") | |||
| 149 | ;; element for this netsplit exists already | 148 | ;; element for this netsplit exists already |
| 150 | (progn | 149 | (progn |
| 151 | (setcdr (nthcdr 2 ass) (cons nick (nthcdr 3 ass))) | 150 | (setcdr (nthcdr 2 ass) (cons nick (nthcdr 3 ass))) |
| 152 | (when (caddr ass) | 151 | (when (nth 2 ass) |
| 153 | ;; There was already a netjoin for this netsplit, it | 152 | ;; There was already a netjoin for this netsplit, it |
| 154 | ;; seems like the old one didn't get finished... | 153 | ;; seems like the old one didn't get finished... |
| 155 | (erc-display-message | 154 | (erc-display-message |
| @@ -194,7 +193,7 @@ join from that split has been detected or not.") | |||
| 194 | nil 'notice 'active | 193 | nil 'notice 'active |
| 195 | 'netsplit-wholeft ?s (car elt) | 194 | 'netsplit-wholeft ?s (car elt) |
| 196 | ?n (mapconcat 'erc-extract-nick (nthcdr 3 elt) " ") | 195 | ?n (mapconcat 'erc-extract-nick (nthcdr 3 elt) " ") |
| 197 | ?t (if (caddr elt) | 196 | ?t (if (nth 2 elt) |
| 198 | "(joining)" | 197 | "(joining)" |
| 199 | ""))))) | 198 | ""))))) |
| 200 | t) | 199 | t) |
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 89372555ccc..5089ff6b4ba 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el | |||
| @@ -40,7 +40,7 @@ | |||
| 40 | ;;; Code: | 40 | ;;; Code: |
| 41 | 41 | ||
| 42 | (require 'erc) | 42 | (require 'erc) |
| 43 | (eval-when-compile (require 'cl)) | 43 | (eval-when-compile (require 'cl-lib)) |
| 44 | 44 | ||
| 45 | ;; Variables | 45 | ;; Variables |
| 46 | 46 | ||
| @@ -729,10 +729,10 @@ search for a match in `erc-networks-alist'." | |||
| 729 | (or | 729 | (or |
| 730 | ;; Loop through `erc-networks-alist' looking for a match. | 730 | ;; Loop through `erc-networks-alist' looking for a match. |
| 731 | (let ((server (or erc-server-announced-name erc-session-server))) | 731 | (let ((server (or erc-server-announced-name erc-session-server))) |
| 732 | (loop for (name matcher) in erc-networks-alist | 732 | (cl-loop for (name matcher) in erc-networks-alist |
| 733 | when (and matcher | 733 | when (and matcher |
| 734 | (string-match (concat matcher "\\'") server)) | 734 | (string-match (concat matcher "\\'") server)) |
| 735 | do (return name))) | 735 | do (cl-return name))) |
| 736 | 'Unknown))) | 736 | 'Unknown))) |
| 737 | 737 | ||
| 738 | (defun erc-network () | 738 | (defun erc-network () |
| @@ -789,8 +789,8 @@ As an example: | |||
| 789 | (cond ((numberp p) | 789 | (cond ((numberp p) |
| 790 | (push p result)) | 790 | (push p result)) |
| 791 | ((listp p) | 791 | ((listp p) |
| 792 | (setq result (nconc (loop for i from (cadr p) downto (car p) | 792 | (setq result (nconc (cl-loop for i from (cadr p) downto (car p) |
| 793 | collect i) | 793 | collect i) |
| 794 | result))))) | 794 | result))))) |
| 795 | (nreverse result))) | 795 | (nreverse result))) |
| 796 | 796 | ||
diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el index 0b5e99180d6..b9d7ff78cd8 100644 --- a/lisp/erc/erc-notify.el +++ b/lisp/erc/erc-notify.el | |||
| @@ -30,9 +30,7 @@ | |||
| 30 | 30 | ||
| 31 | (require 'erc) | 31 | (require 'erc) |
| 32 | (require 'erc-networks) | 32 | (require 'erc-networks) |
| 33 | (eval-when-compile | 33 | (eval-when-compile (require 'pcomplete)) |
| 34 | (require 'cl) | ||
| 35 | (require 'pcomplete)) | ||
| 36 | 34 | ||
| 37 | ;;;; Customizable variables | 35 | ;;;; Customizable variables |
| 38 | 36 | ||
diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el index bb30fd90066..d6bb8019b15 100644 --- a/lisp/erc/erc-pcomplete.el +++ b/lisp/erc/erc-pcomplete.el | |||
| @@ -43,7 +43,6 @@ | |||
| 43 | (require 'erc) | 43 | (require 'erc) |
| 44 | (require 'erc-compat) | 44 | (require 'erc-compat) |
| 45 | (require 'time-date) | 45 | (require 'time-date) |
| 46 | (eval-when-compile (require 'cl)) | ||
| 47 | 46 | ||
| 48 | (defgroup erc-pcomplete nil | 47 | (defgroup erc-pcomplete nil |
| 49 | "Programmable completion for ERC" | 48 | "Programmable completion for ERC" |
diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el index b3b80a5f851..b75ad8e9517 100644 --- a/lisp/erc/erc-services.el +++ b/lisp/erc/erc-services.el | |||
| @@ -62,7 +62,7 @@ | |||
| 62 | 62 | ||
| 63 | (require 'erc) | 63 | (require 'erc) |
| 64 | (require 'erc-networks) | 64 | (require 'erc-networks) |
| 65 | (eval-when-compile (require 'cl)) | 65 | (eval-when-compile (require 'cl-lib)) |
| 66 | 66 | ||
| 67 | ;; Customization: | 67 | ;; Customization: |
| 68 | 68 | ||
diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index 4b98cf173be..22053945159 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el | |||
| @@ -38,7 +38,6 @@ | |||
| 38 | (require 'erc) | 38 | (require 'erc) |
| 39 | (require 'speedbar) | 39 | (require 'speedbar) |
| 40 | (condition-case nil (require 'dframe) (error nil)) | 40 | (condition-case nil (require 'dframe) (error nil)) |
| 41 | (eval-when-compile (require 'cl)) | ||
| 42 | 41 | ||
| 43 | ;;; Customization: | 42 | ;;; Customization: |
| 44 | 43 | ||
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index a204584b400..976d2a21030 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el | |||
| @@ -34,7 +34,7 @@ | |||
| 34 | ;; * Add extensibility so that custom functions can track | 34 | ;; * Add extensibility so that custom functions can track |
| 35 | ;; custom modification types. | 35 | ;; custom modification types. |
| 36 | 36 | ||
| 37 | (eval-when-compile (require 'cl)) | 37 | (eval-when-compile (require 'cl-lib)) |
| 38 | (require 'erc) | 38 | (require 'erc) |
| 39 | (require 'erc-compat) | 39 | (require 'erc-compat) |
| 40 | (require 'erc-match) | 40 | (require 'erc-match) |
| @@ -484,7 +484,7 @@ START is the minimum length of the name used." | |||
| 484 | 484 | ||
| 485 | ;;; Test: | 485 | ;;; Test: |
| 486 | 486 | ||
| 487 | (assert | 487 | (cl-assert |
| 488 | (and | 488 | (and |
| 489 | ;; verify examples from the doc strings | 489 | ;; verify examples from the doc strings |
| 490 | (equal (let ((erc-track-shorten-aggressively nil)) | 490 | (equal (let ((erc-track-shorten-aggressively nil)) |
| @@ -869,7 +869,7 @@ Use `erc-make-mode-line-buffer-name' to create buttons." | |||
| 869 | (setq erc-modified-channels-alist | 869 | (setq erc-modified-channels-alist |
| 870 | (delete (assq buffer erc-modified-channels-alist) | 870 | (delete (assq buffer erc-modified-channels-alist) |
| 871 | erc-modified-channels-alist)) | 871 | erc-modified-channels-alist)) |
| 872 | (when (interactive-p) | 872 | (when (called-interactively-p 'interactive) |
| 873 | (erc-modified-channels-display))) | 873 | (erc-modified-channels-display))) |
| 874 | 874 | ||
| 875 | (defun erc-track-find-face (faces) | 875 | (defun erc-track-find-face (faces) |
| @@ -980,7 +980,7 @@ is in `erc-mode'." | |||
| 980 | (add-to-list 'faces cur))) | 980 | (add-to-list 'faces cur))) |
| 981 | faces)) | 981 | faces)) |
| 982 | 982 | ||
| 983 | (assert | 983 | (cl-assert |
| 984 | (let ((str "is bold")) | 984 | (let ((str "is bold")) |
| 985 | (put-text-property 3 (length str) | 985 | (put-text-property 3 (length str) |
| 986 | 'face '(bold erc-current-nick-face) | 986 | 'face '(bold erc-current-nick-face) |
| @@ -1030,17 +1030,17 @@ relative to `erc-track-switch-direction'" | |||
| 1030 | (let ((dir erc-track-switch-direction) | 1030 | (let ((dir erc-track-switch-direction) |
| 1031 | offset) | 1031 | offset) |
| 1032 | (when (< arg 0) | 1032 | (when (< arg 0) |
| 1033 | (setq dir (case dir | 1033 | (setq dir (pcase dir |
| 1034 | (oldest 'newest) | 1034 | (`oldest 'newest) |
| 1035 | (newest 'oldest) | 1035 | (`newest 'oldest) |
| 1036 | (mostactive 'leastactive) | 1036 | (`mostactive 'leastactive) |
| 1037 | (leastactive 'mostactive) | 1037 | (`leastactive 'mostactive) |
| 1038 | (importance 'oldest))) | 1038 | (`importance 'oldest))) |
| 1039 | (setq arg (- arg))) | 1039 | (setq arg (- arg))) |
| 1040 | (setq offset (case dir | 1040 | (setq offset (pcase dir |
| 1041 | ((oldest leastactive) | 1041 | ((or `oldest `leastactive) |
| 1042 | (- (length erc-modified-channels-alist) arg)) | 1042 | (- (length erc-modified-channels-alist) arg)) |
| 1043 | (t (1- arg)))) | 1043 | (_ (1- arg)))) |
| 1044 | ;; normalize out of range user input | 1044 | ;; normalize out of range user input |
| 1045 | (cond ((>= offset (length erc-modified-channels-alist)) | 1045 | (cond ((>= offset (length erc-modified-channels-alist)) |
| 1046 | (setq offset (1- (length erc-modified-channels-alist)))) | 1046 | (setq offset (1- (length erc-modified-channels-alist)))) |
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 7cb6fbb595b..cec9718e751 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el | |||
| @@ -67,7 +67,7 @@ | |||
| 67 | (defconst erc-version-string "Version 5.3" | 67 | (defconst erc-version-string "Version 5.3" |
| 68 | "ERC version. This is used by function `erc-version'.") | 68 | "ERC version. This is used by function `erc-version'.") |
| 69 | 69 | ||
| 70 | (eval-when-compile (require 'cl)) | 70 | (eval-when-compile (require 'cl-lib)) |
| 71 | (require 'font-lock) | 71 | (require 'font-lock) |
| 72 | (require 'pp) | 72 | (require 'pp) |
| 73 | (require 'thingatpt) | 73 | (require 'thingatpt) |
| @@ -369,7 +369,7 @@ If no server buffer exists, return nil." | |||
| 369 | (with-current-buffer ,buffer | 369 | (with-current-buffer ,buffer |
| 370 | ,@body))))) | 370 | ,@body))))) |
| 371 | 371 | ||
| 372 | (defstruct (erc-server-user (:type vector) :named) | 372 | (cl-defstruct (erc-server-user (:type vector) :named) |
| 373 | ;; User data | 373 | ;; User data |
| 374 | nickname host login full-name info | 374 | nickname host login full-name info |
| 375 | ;; Buffers | 375 | ;; Buffers |
| @@ -379,7 +379,7 @@ If no server buffer exists, return nil." | |||
| 379 | (buffers nil) | 379 | (buffers nil) |
| 380 | ) | 380 | ) |
| 381 | 381 | ||
| 382 | (defstruct (erc-channel-user (:type vector) :named) | 382 | (cl-defstruct (erc-channel-user (:type vector) :named) |
| 383 | op voice | 383 | op voice |
| 384 | ;; Last message time (in the form of the return value of | 384 | ;; Last message time (in the form of the return value of |
| 385 | ;; (current-time) | 385 | ;; (current-time) |
| @@ -1386,7 +1386,7 @@ If BUFFER is nil, the current buffer is used." | |||
| 1386 | t)) | 1386 | t)) |
| 1387 | (erc-server-send (format "ISON %s" nick)) | 1387 | (erc-server-send (format "ISON %s" nick)) |
| 1388 | (while (eq erc-online-p 'unknown) (accept-process-output)) | 1388 | (while (eq erc-online-p 'unknown) (accept-process-output)) |
| 1389 | (if (interactive-p) | 1389 | (if (called-interactively-p 'interactive) |
| 1390 | (message "%s is %sonline" | 1390 | (message "%s is %sonline" |
| 1391 | (or erc-online-p nick) | 1391 | (or erc-online-p nick) |
| 1392 | (if erc-online-p "" "not ")) | 1392 | (if erc-online-p "" "not ")) |
| @@ -2157,11 +2157,11 @@ functions in here get called with the parameters SERVER and NICK." | |||
| 2157 | (list :server server :port port :nick nick :password passwd))) | 2157 | (list :server server :port port :nick nick :password passwd))) |
| 2158 | 2158 | ||
| 2159 | ;;;###autoload | 2159 | ;;;###autoload |
| 2160 | (defun* erc (&key (server (erc-compute-server)) | 2160 | (cl-defun erc (&key (server (erc-compute-server)) |
| 2161 | (port (erc-compute-port)) | 2161 | (port (erc-compute-port)) |
| 2162 | (nick (erc-compute-nick)) | 2162 | (nick (erc-compute-nick)) |
| 2163 | password | 2163 | password |
| 2164 | (full-name (erc-compute-full-name))) | 2164 | (full-name (erc-compute-full-name))) |
| 2165 | "ERC is a powerful, modular, and extensible IRC client. | 2165 | "ERC is a powerful, modular, and extensible IRC client. |
| 2166 | This function is the main entry point for ERC. | 2166 | This function is the main entry point for ERC. |
| 2167 | 2167 | ||
| @@ -2383,24 +2383,24 @@ If STRING is nil, the function does nothing." | |||
| 2383 | (while list | 2383 | (while list |
| 2384 | (setq elt (car list)) | 2384 | (setq elt (car list)) |
| 2385 | (cond ((integerp elt) ; POSITION | 2385 | (cond ((integerp elt) ; POSITION |
| 2386 | (incf (car list) shift)) | 2386 | (cl-incf (car list) shift)) |
| 2387 | ((or (atom elt) ; nil, EXTENT | 2387 | ((or (atom elt) ; nil, EXTENT |
| 2388 | ;; (eq t (car elt)) ; (t . TIME) | 2388 | ;; (eq t (car elt)) ; (t . TIME) |
| 2389 | (markerp (car elt))) ; (MARKER . DISTANCE) | 2389 | (markerp (car elt))) ; (MARKER . DISTANCE) |
| 2390 | nil) | 2390 | nil) |
| 2391 | ((integerp (car elt)) ; (BEGIN . END) | 2391 | ((integerp (car elt)) ; (BEGIN . END) |
| 2392 | (incf (car elt) shift) | 2392 | (cl-incf (car elt) shift) |
| 2393 | (incf (cdr elt) shift)) | 2393 | (cl-incf (cdr elt) shift)) |
| 2394 | ((stringp (car elt)) ; (TEXT . POSITION) | 2394 | ((stringp (car elt)) ; (TEXT . POSITION) |
| 2395 | (incf (cdr elt) (* (if (natnump (cdr elt)) 1 -1) shift))) | 2395 | (cl-incf (cdr elt) (* (if (natnump (cdr elt)) 1 -1) shift))) |
| 2396 | ((null (car elt)) ; (nil PROPERTY VALUE BEG . END) | 2396 | ((null (car elt)) ; (nil PROPERTY VALUE BEG . END) |
| 2397 | (let ((cons (nthcdr 3 elt))) | 2397 | (let ((cons (nthcdr 3 elt))) |
| 2398 | (incf (car cons) shift) | 2398 | (cl-incf (car cons) shift) |
| 2399 | (incf (cdr cons) shift))) | 2399 | (cl-incf (cdr cons) shift))) |
| 2400 | ((and (featurep 'xemacs) | 2400 | ((and (featurep 'xemacs) |
| 2401 | (extentp (car elt))) ; (EXTENT START END) | 2401 | (extentp (car elt))) ; (EXTENT START END) |
| 2402 | (incf (nth 1 elt) shift) | 2402 | (cl-incf (nth 1 elt) shift) |
| 2403 | (incf (nth 2 elt) shift))) | 2403 | (cl-incf (nth 2 elt) shift))) |
| 2404 | (setq list (cdr list)))))) | 2404 | (setq list (cdr list)))))) |
| 2405 | 2405 | ||
| 2406 | (defvar erc-valid-nick-regexp "[]a-zA-Z^[;\\`_{}|][]^[;\\`_{}|a-zA-Z0-9-]*" | 2406 | (defvar erc-valid-nick-regexp "[]a-zA-Z^[;\\`_{}|][]^[;\\`_{}|a-zA-Z0-9-]*" |
| @@ -2477,6 +2477,13 @@ purposes." | |||
| 2477 | :group 'erc-lurker | 2477 | :group 'erc-lurker |
| 2478 | :type 'boolean) | 2478 | :type 'boolean) |
| 2479 | 2479 | ||
| 2480 | (defcustom erc-lurker-ignore-chars "`_" | ||
| 2481 | "Characters at the end of a nick to strip for activity tracking purposes. | ||
| 2482 | |||
| 2483 | See also `erc-lurker-trim-nicks'." | ||
| 2484 | :group 'erc-lurker | ||
| 2485 | :type 'string) | ||
| 2486 | |||
| 2480 | (defun erc-lurker-maybe-trim (nick) | 2487 | (defun erc-lurker-maybe-trim (nick) |
| 2481 | "Maybe trim trailing `erc-lurker-ignore-chars' from NICK. | 2488 | "Maybe trim trailing `erc-lurker-ignore-chars' from NICK. |
| 2482 | 2489 | ||
| @@ -2491,13 +2498,6 @@ non-nil." | |||
| 2491 | "" nick) | 2498 | "" nick) |
| 2492 | nick)) | 2499 | nick)) |
| 2493 | 2500 | ||
| 2494 | (defcustom erc-lurker-ignore-chars "`_" | ||
| 2495 | "Characters at the end of a nick to strip for activity tracking purposes. | ||
| 2496 | |||
| 2497 | See also `erc-lurker-trim-nicks'." | ||
| 2498 | :group 'erc-lurker | ||
| 2499 | :type 'string) | ||
| 2500 | |||
| 2501 | (defcustom erc-lurker-hide-list nil | 2501 | (defcustom erc-lurker-hide-list nil |
| 2502 | "List of IRC type messages to hide when sent by lurkers. | 2502 | "List of IRC type messages to hide when sent by lurkers. |
| 2503 | 2503 | ||
| @@ -2580,7 +2580,8 @@ updates of `erc-lurker-state'." | |||
| 2580 | (server | 2580 | (server |
| 2581 | (erc-canonicalize-server-name erc-server-announced-name))) | 2581 | (erc-canonicalize-server-name erc-server-announced-name))) |
| 2582 | (when (equal command "PRIVMSG") | 2582 | (when (equal command "PRIVMSG") |
| 2583 | (when (>= (incf erc-lurker-cleanup-count) erc-lurker-cleanup-interval) | 2583 | (when (>= (cl-incf erc-lurker-cleanup-count) |
| 2584 | erc-lurker-cleanup-interval) | ||
| 2584 | (setq erc-lurker-cleanup-count 0) | 2585 | (setq erc-lurker-cleanup-count 0) |
| 2585 | (erc-lurker-cleanup)) | 2586 | (erc-lurker-cleanup)) |
| 2586 | (unless (gethash server erc-lurker-state) | 2587 | (unless (gethash server erc-lurker-state) |
| @@ -2605,6 +2606,17 @@ server within `erc-lurker-threshold-time'. See also | |||
| 2605 | (time-subtract (current-time) last-PRIVMSG-time)) | 2606 | (time-subtract (current-time) last-PRIVMSG-time)) |
| 2606 | erc-lurker-threshold-time)))) | 2607 | erc-lurker-threshold-time)))) |
| 2607 | 2608 | ||
| 2609 | (defcustom erc-common-server-suffixes | ||
| 2610 | '(("openprojects.net$" . "OPN") | ||
| 2611 | ("freenode.net$" . "freenode") | ||
| 2612 | ("oftc.net$" . "OFTC")) | ||
| 2613 | "Alist of common server name suffixes. | ||
| 2614 | This variable is used in mode-line display to save screen | ||
| 2615 | real estate. Set it to nil if you want to avoid changing | ||
| 2616 | displayed hostnames." | ||
| 2617 | :group 'erc-mode-line-and-header | ||
| 2618 | :type 'alist) | ||
| 2619 | |||
| 2608 | (defun erc-canonicalize-server-name (server) | 2620 | (defun erc-canonicalize-server-name (server) |
| 2609 | "Returns the canonical network name for SERVER if any, | 2621 | "Returns the canonical network name for SERVER if any, |
| 2610 | otherwise `erc-server-announced-name'. SERVER is matched against | 2622 | otherwise `erc-server-announced-name'. SERVER is matched against |
| @@ -3115,37 +3127,37 @@ If SERVER is non-nil, use that, rather than the current server." | |||
| 3115 | (add-to-list 'symlist | 3127 | (add-to-list 'symlist |
| 3116 | (cons (erc-once-with-server-event | 3128 | (cons (erc-once-with-server-event |
| 3117 | 311 `(string= ,nick | 3129 | 311 `(string= ,nick |
| 3118 | (second | 3130 | (nth 1 |
| 3119 | (erc-response.command-args parsed)))) | 3131 | (erc-response.command-args parsed)))) |
| 3120 | 'erc-server-311-functions)) | 3132 | 'erc-server-311-functions)) |
| 3121 | (add-to-list 'symlist | 3133 | (add-to-list 'symlist |
| 3122 | (cons (erc-once-with-server-event | 3134 | (cons (erc-once-with-server-event |
| 3123 | 312 `(string= ,nick | 3135 | 312 `(string= ,nick |
| 3124 | (second | 3136 | (nth 1 |
| 3125 | (erc-response.command-args parsed)))) | 3137 | (erc-response.command-args parsed)))) |
| 3126 | 'erc-server-312-functions)) | 3138 | 'erc-server-312-functions)) |
| 3127 | (add-to-list 'symlist | 3139 | (add-to-list 'symlist |
| 3128 | (cons (erc-once-with-server-event | 3140 | (cons (erc-once-with-server-event |
| 3129 | 318 `(string= ,nick | 3141 | 318 `(string= ,nick |
| 3130 | (second | 3142 | (nth 1 |
| 3131 | (erc-response.command-args parsed)))) | 3143 | (erc-response.command-args parsed)))) |
| 3132 | 'erc-server-318-functions)) | 3144 | 'erc-server-318-functions)) |
| 3133 | (add-to-list 'symlist | 3145 | (add-to-list 'symlist |
| 3134 | (cons (erc-once-with-server-event | 3146 | (cons (erc-once-with-server-event |
| 3135 | 319 `(string= ,nick | 3147 | 319 `(string= ,nick |
| 3136 | (second | 3148 | (nth 1 |
| 3137 | (erc-response.command-args parsed)))) | 3149 | (erc-response.command-args parsed)))) |
| 3138 | 'erc-server-319-functions)) | 3150 | 'erc-server-319-functions)) |
| 3139 | (add-to-list 'symlist | 3151 | (add-to-list 'symlist |
| 3140 | (cons (erc-once-with-server-event | 3152 | (cons (erc-once-with-server-event |
| 3141 | 320 `(string= ,nick | 3153 | 320 `(string= ,nick |
| 3142 | (second | 3154 | (nth 1 |
| 3143 | (erc-response.command-args parsed)))) | 3155 | (erc-response.command-args parsed)))) |
| 3144 | 'erc-server-320-functions)) | 3156 | 'erc-server-320-functions)) |
| 3145 | (add-to-list 'symlist | 3157 | (add-to-list 'symlist |
| 3146 | (cons (erc-once-with-server-event | 3158 | (cons (erc-once-with-server-event |
| 3147 | 330 `(string= ,nick | 3159 | 330 `(string= ,nick |
| 3148 | (second | 3160 | (nth 1 |
| 3149 | (erc-response.command-args parsed)))) | 3161 | (erc-response.command-args parsed)))) |
| 3150 | 'erc-server-330-functions)) | 3162 | 'erc-server-330-functions)) |
| 3151 | (add-to-list 'symlist | 3163 | (add-to-list 'symlist |
| @@ -4328,8 +4340,8 @@ See also: `erc-echo-notice-in-user-buffers', | |||
| 4328 | 4340 | ||
| 4329 | (defun erc-banlist-store (proc parsed) | 4341 | (defun erc-banlist-store (proc parsed) |
| 4330 | "Record ban entries for a channel." | 4342 | "Record ban entries for a channel." |
| 4331 | (multiple-value-bind (channel mask whoset) | 4343 | (pcase-let ((`(,channel ,mask ,whoset) |
| 4332 | (values-list (cdr (erc-response.command-args parsed))) | 4344 | (cdr (erc-response.command-args parsed)))) |
| 4333 | ;; Determine to which buffer the message corresponds | 4345 | ;; Determine to which buffer the message corresponds |
| 4334 | (let ((buffer (erc-get-buffer channel proc))) | 4346 | (let ((buffer (erc-get-buffer channel proc))) |
| 4335 | (with-current-buffer buffer | 4347 | (with-current-buffer buffer |
| @@ -4340,7 +4352,7 @@ See also: `erc-echo-notice-in-user-buffers', | |||
| 4340 | 4352 | ||
| 4341 | (defun erc-banlist-finished (proc parsed) | 4353 | (defun erc-banlist-finished (proc parsed) |
| 4342 | "Record that we have received the banlist." | 4354 | "Record that we have received the banlist." |
| 4343 | (let* ((channel (second (erc-response.command-args parsed))) | 4355 | (let* ((channel (nth 1 (erc-response.command-args parsed))) |
| 4344 | (buffer (erc-get-buffer channel proc))) | 4356 | (buffer (erc-get-buffer channel proc))) |
| 4345 | (with-current-buffer buffer | 4357 | (with-current-buffer buffer |
| 4346 | (put 'erc-channel-banlist 'received-from-server t))) | 4358 | (put 'erc-channel-banlist 'received-from-server t))) |
| @@ -4349,7 +4361,7 @@ See also: `erc-echo-notice-in-user-buffers', | |||
| 4349 | (defun erc-banlist-update (proc parsed) | 4361 | (defun erc-banlist-update (proc parsed) |
| 4350 | "Check MODE commands for bans and update the banlist appropriately." | 4362 | "Check MODE commands for bans and update the banlist appropriately." |
| 4351 | ;; FIXME: Possibly incorrect. -- Lawrence 2004-05-11 | 4363 | ;; FIXME: Possibly incorrect. -- Lawrence 2004-05-11 |
| 4352 | (let* ((tgt (first (erc-response.command-args parsed))) | 4364 | (let* ((tgt (car (erc-response.command-args parsed))) |
| 4353 | (mode (erc-response.contents parsed)) | 4365 | (mode (erc-response.contents parsed)) |
| 4354 | (whoset (erc-response.sender parsed)) | 4366 | (whoset (erc-response.sender parsed)) |
| 4355 | (buffer (erc-get-buffer tgt proc))) | 4367 | (buffer (erc-get-buffer tgt proc))) |
| @@ -6000,7 +6012,7 @@ entry of `channel-members'." | |||
| 6000 | (if cuser | 6012 | (if cuser |
| 6001 | (setq op (erc-channel-user-op cuser) | 6013 | (setq op (erc-channel-user-op cuser) |
| 6002 | voice (erc-channel-user-voice cuser))) | 6014 | voice (erc-channel-user-voice cuser))) |
| 6003 | (if (interactive-p) | 6015 | (if (called-interactively-p 'interactive) |
| 6004 | (message "%s is %s@%s%s%s" | 6016 | (message "%s is %s@%s%s%s" |
| 6005 | nick login host | 6017 | nick login host |
| 6006 | (if full-name (format " (%s)" full-name) "") | 6018 | (if full-name (format " (%s)" full-name) "") |
| @@ -6088,17 +6100,6 @@ Otherwise, use the `erc-header-line' face." | |||
| 6088 | :group 'erc-paranoia | 6100 | :group 'erc-paranoia |
| 6089 | :type 'boolean) | 6101 | :type 'boolean) |
| 6090 | 6102 | ||
| 6091 | (defcustom erc-common-server-suffixes | ||
| 6092 | '(("openprojects.net$" . "OPN") | ||
| 6093 | ("freenode.net$" . "freenode") | ||
| 6094 | ("oftc.net$" . "OFTC")) | ||
| 6095 | "Alist of common server name suffixes. | ||
| 6096 | This variable is used in mode-line display to save screen | ||
| 6097 | real estate. Set it to nil if you want to avoid changing | ||
| 6098 | displayed hostnames." | ||
| 6099 | :group 'erc-mode-line-and-header | ||
| 6100 | :type 'alist) | ||
| 6101 | |||
| 6102 | (defcustom erc-mode-line-away-status-format | 6103 | (defcustom erc-mode-line-away-status-format |
| 6103 | "(AWAY since %a %b %d %H:%M) " | 6104 | "(AWAY since %a %b %d %H:%M) " |
| 6104 | "When you're away on a server, this is shown in the mode line. | 6105 | "When you're away on a server, this is shown in the mode line. |
| @@ -6302,7 +6303,7 @@ If optional argument HERE is non-nil, insert version number at point." | |||
| 6302 | (format "ERC %s (GNU Emacs %s)" erc-version-string emacs-version))) | 6303 | (format "ERC %s (GNU Emacs %s)" erc-version-string emacs-version))) |
| 6303 | (if here | 6304 | (if here |
| 6304 | (insert version-string) | 6305 | (insert version-string) |
| 6305 | (if (interactive-p) | 6306 | (if (called-interactively-p 'interactive) |
| 6306 | (message "%s" version-string) | 6307 | (message "%s" version-string) |
| 6307 | version-string)))) | 6308 | version-string)))) |
| 6308 | 6309 | ||
| @@ -6322,7 +6323,7 @@ If optional argument HERE is non-nil, insert version number at point." | |||
| 6322 | ", "))) | 6323 | ", "))) |
| 6323 | (if here | 6324 | (if here |
| 6324 | (insert string) | 6325 | (insert string) |
| 6325 | (if (interactive-p) | 6326 | (if (called-interactively-p 'interactive) |
| 6326 | (message "%s" string) | 6327 | (message "%s" string) |
| 6327 | string)))) | 6328 | string)))) |
| 6328 | 6329 | ||
diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index aa8aae2d245..b4c86e39e86 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el | |||
| @@ -297,6 +297,8 @@ to writing a completion function." | |||
| 297 | (define-key eshell-command-map [? ] 'pcomplete-expand) | 297 | (define-key eshell-command-map [? ] 'pcomplete-expand) |
| 298 | (define-key eshell-mode-map [tab] 'eshell-pcomplete) | 298 | (define-key eshell-mode-map [tab] 'eshell-pcomplete) |
| 299 | (define-key eshell-mode-map [(control ?i)] 'eshell-pcomplete) | 299 | (define-key eshell-mode-map [(control ?i)] 'eshell-pcomplete) |
| 300 | (add-hook 'completion-at-point-functions | ||
| 301 | #'pcomplete-completions-at-point nil t) | ||
| 300 | ;; jww (1999-10-19): Will this work on anything but X? | 302 | ;; jww (1999-10-19): Will this work on anything but X? |
| 301 | (if (featurep 'xemacs) | 303 | (if (featurep 'xemacs) |
| 302 | (define-key eshell-mode-map [iso-left-tab] 'pcomplete-reverse) | 304 | (define-key eshell-mode-map [iso-left-tab] 'pcomplete-reverse) |
| @@ -452,9 +454,9 @@ to writing a completion function." | |||
| 452 | (defun eshell-pcomplete () | 454 | (defun eshell-pcomplete () |
| 453 | "Eshell wrapper for `pcomplete'." | 455 | "Eshell wrapper for `pcomplete'." |
| 454 | (interactive) | 456 | (interactive) |
| 455 | (if eshell-cmpl-ignore-case | 457 | (condition-case nil |
| 456 | (pcomplete-expand-and-complete) ; hack workaround for bug#12838 | 458 | (pcomplete) |
| 457 | (pcomplete))) | 459 | (text-read-only (completion-at-point)))) ; Workaround for bug#12838. |
| 458 | 460 | ||
| 459 | (provide 'em-cmpl) | 461 | (provide 'em-cmpl) |
| 460 | 462 | ||
diff --git a/lisp/faces.el b/lisp/faces.el index 9e0ca962499..f8dc4783cbb 100644 --- a/lisp/faces.el +++ b/lisp/faces.el | |||
| @@ -487,44 +487,44 @@ with the `default' face (which is always completely specified)." | |||
| 487 | (defalias 'face-background-pixmap 'face-stipple) | 487 | (defalias 'face-background-pixmap 'face-stipple) |
| 488 | 488 | ||
| 489 | 489 | ||
| 490 | ;; FIXME all of these -p functions ignore inheritance (cf face-stipple). | 490 | (defun face-underline-p (face &optional frame inherit) |
| 491 | ;; Ie, a face that inherits from an underlined face but does not | ||
| 492 | ;; specify :underline will return nil. | ||
| 493 | ;; So these functions don't actually tell you anything about how the | ||
| 494 | ;; face will _appear_. So not very useful IMO. | ||
| 495 | (defun face-underline-p (face &optional frame) | ||
| 496 | "Return non-nil if FACE specifies a non-nil underlining. | 491 | "Return non-nil if FACE specifies a non-nil underlining. |
| 497 | If the optional argument FRAME is given, report on face FACE in that frame. | 492 | If the optional argument FRAME is given, report on face FACE in that frame. |
| 498 | If FRAME is t, report on the defaults for face FACE (for new frames). | 493 | If FRAME is t, report on the defaults for face FACE (for new frames). |
| 499 | If FRAME is omitted or nil, use the selected frame." | 494 | If FRAME is omitted or nil, use the selected frame. |
| 500 | (face-attribute-specified-or (face-attribute face :underline frame) nil)) | 495 | Optional argument INHERIT is passed to `face-attribute'." |
| 496 | (face-attribute-specified-or | ||
| 497 | (face-attribute face :underline frame inherit) nil)) | ||
| 501 | 498 | ||
| 502 | 499 | ||
| 503 | (defun face-inverse-video-p (face &optional frame) | 500 | (defun face-inverse-video-p (face &optional frame inherit) |
| 504 | "Return non-nil if FACE specifies a non-nil inverse-video. | 501 | "Return non-nil if FACE specifies a non-nil inverse-video. |
| 505 | If the optional argument FRAME is given, report on face FACE in that frame. | 502 | If the optional argument FRAME is given, report on face FACE in that frame. |
| 506 | If FRAME is t, report on the defaults for face FACE (for new frames). | 503 | If FRAME is t, report on the defaults for face FACE (for new frames). |
| 507 | If FRAME is omitted or nil, use the selected frame." | 504 | If FRAME is omitted or nil, use the selected frame. |
| 508 | (eq (face-attribute face :inverse-video frame) t)) | 505 | Optional argument INHERIT is passed to `face-attribute'." |
| 506 | (eq (face-attribute face :inverse-video frame inherit) t)) | ||
| 509 | 507 | ||
| 510 | 508 | ||
| 511 | (defun face-bold-p (face &optional frame) | 509 | (defun face-bold-p (face &optional frame inherit) |
| 512 | "Return non-nil if the font of FACE is bold on FRAME. | 510 | "Return non-nil if the font of FACE is bold on FRAME. |
| 513 | If the optional argument FRAME is given, report on face FACE in that frame. | 511 | If the optional argument FRAME is given, report on face FACE in that frame. |
| 514 | If FRAME is t, report on the defaults for face FACE (for new frames). | 512 | If FRAME is t, report on the defaults for face FACE (for new frames). |
| 515 | If FRAME is omitted or nil, use the selected frame. | 513 | If FRAME is omitted or nil, use the selected frame. |
| 514 | Optional argument INHERIT is passed to `face-attribute'. | ||
| 516 | Use `face-attribute' for finer control." | 515 | Use `face-attribute' for finer control." |
| 517 | (let ((bold (face-attribute face :weight frame))) | 516 | (let ((bold (face-attribute face :weight frame inherit))) |
| 518 | (memq bold '(semi-bold bold extra-bold ultra-bold)))) | 517 | (memq bold '(semi-bold bold extra-bold ultra-bold)))) |
| 519 | 518 | ||
| 520 | 519 | ||
| 521 | (defun face-italic-p (face &optional frame) | 520 | (defun face-italic-p (face &optional frame inherit) |
| 522 | "Return non-nil if the font of FACE is italic on FRAME. | 521 | "Return non-nil if the font of FACE is italic on FRAME. |
| 523 | If the optional argument FRAME is given, report on face FACE in that frame. | 522 | If the optional argument FRAME is given, report on face FACE in that frame. |
| 524 | If FRAME is t, report on the defaults for face FACE (for new frames). | 523 | If FRAME is t, report on the defaults for face FACE (for new frames). |
| 525 | If FRAME is omitted or nil, use the selected frame. | 524 | If FRAME is omitted or nil, use the selected frame. |
| 525 | Optional argument INHERIT is passed to `face-attribute'. | ||
| 526 | Use `face-attribute' for finer control." | 526 | Use `face-attribute' for finer control." |
| 527 | (let ((italic (face-attribute face :slant frame))) | 527 | (let ((italic (face-attribute face :slant frame inherit))) |
| 528 | (memq italic '(italic oblique)))) | 528 | (memq italic '(italic oblique)))) |
| 529 | 529 | ||
| 530 | 530 | ||
| @@ -862,7 +862,7 @@ Use `set-face-attribute' to ``unspecify'' underlining." | |||
| 862 | 'set-face-underline "24.3") | 862 | 'set-face-underline "24.3") |
| 863 | 863 | ||
| 864 | 864 | ||
| 865 | (defun set-face-inverse-video-p (face inverse-video-p &optional frame) | 865 | (defun set-face-inverse-video (face inverse-video-p &optional frame) |
| 866 | "Specify whether face FACE is in inverse video. | 866 | "Specify whether face FACE is in inverse video. |
| 867 | INVERSE-VIDEO-P non-nil means FACE displays explicitly in inverse video. | 867 | INVERSE-VIDEO-P non-nil means FACE displays explicitly in inverse video. |
| 868 | INVERSE-VIDEO-P nil means FACE explicitly is not in inverse video. | 868 | INVERSE-VIDEO-P nil means FACE explicitly is not in inverse video. |
| @@ -870,14 +870,13 @@ FRAME nil or not specified means change face on all frames. | |||
| 870 | Use `set-face-attribute' to ``unspecify'' the inverse video attribute." | 870 | Use `set-face-attribute' to ``unspecify'' the inverse video attribute." |
| 871 | (interactive | 871 | (interactive |
| 872 | (let ((list (read-face-and-attribute :inverse-video))) | 872 | (let ((list (read-face-and-attribute :inverse-video))) |
| 873 | (list (car list) (eq (car (cdr list)) t)))) | 873 | (list (car list) (if (cadr list) t)))) |
| 874 | (set-face-attribute face frame :inverse-video inverse-video-p)) | 874 | (set-face-attribute face frame :inverse-video inverse-video-p)) |
| 875 | 875 | ||
| 876 | (define-obsolete-function-alias 'set-face-inverse-video-p | ||
| 877 | 'set-face-inverse-video "24.4") | ||
| 876 | 878 | ||
| 877 | ;; The -p suffix is a hostage to fortune. What if we want to extend | 879 | (defun set-face-bold (face bold-p &optional frame) |
| 878 | ;; this to allow more than boolean options? Exactly this happened | ||
| 879 | ;; to set-face-underline-p. | ||
| 880 | (defun set-face-bold-p (face bold-p &optional frame) | ||
| 881 | "Specify whether face FACE is bold. | 880 | "Specify whether face FACE is bold. |
| 882 | BOLD-P non-nil means FACE should explicitly display bold. | 881 | BOLD-P non-nil means FACE should explicitly display bold. |
| 883 | BOLD-P nil means FACE should explicitly display non-bold. | 882 | BOLD-P nil means FACE should explicitly display non-bold. |
| @@ -887,8 +886,10 @@ Use `set-face-attribute' or `modify-face' for finer control." | |||
| 887 | (make-face-unbold face frame) | 886 | (make-face-unbold face frame) |
| 888 | (make-face-bold face frame))) | 887 | (make-face-bold face frame))) |
| 889 | 888 | ||
| 889 | (define-obsolete-function-alias 'set-face-bold-p 'set-face-bold "24.4") | ||
| 890 | |||
| 890 | 891 | ||
| 891 | (defun set-face-italic-p (face italic-p &optional frame) | 892 | (defun set-face-italic (face italic-p &optional frame) |
| 892 | "Specify whether face FACE is italic. | 893 | "Specify whether face FACE is italic. |
| 893 | ITALIC-P non-nil means FACE should explicitly display italic. | 894 | ITALIC-P non-nil means FACE should explicitly display italic. |
| 894 | ITALIC-P nil means FACE should explicitly display non-italic. | 895 | ITALIC-P nil means FACE should explicitly display non-italic. |
| @@ -898,6 +899,8 @@ Use `set-face-attribute' or `modify-face' for finer control." | |||
| 898 | (make-face-unitalic face frame) | 899 | (make-face-unitalic face frame) |
| 899 | (make-face-italic face frame))) | 900 | (make-face-italic face frame))) |
| 900 | 901 | ||
| 902 | (define-obsolete-function-alias 'set-face-italic-p 'set-face-italic "24.4") | ||
| 903 | |||
| 901 | 904 | ||
| 902 | (defalias 'set-face-background-pixmap 'set-face-stipple) | 905 | (defalias 'set-face-background-pixmap 'set-face-stipple) |
| 903 | 906 | ||
diff --git a/lisp/files.el b/lisp/files.el index 8e8a178caab..496f9bf8fa4 100644 --- a/lisp/files.el +++ b/lisp/files.el | |||
| @@ -730,7 +730,7 @@ The path separator is colon in GNU and GNU-like systems." | |||
| 730 | ;; This is a case where .elc makes a lot of sense. | 730 | ;; This is a case where .elc makes a lot of sense. |
| 731 | (interactive (list (let ((completion-ignored-extensions | 731 | (interactive (list (let ((completion-ignored-extensions |
| 732 | (remove ".elc" completion-ignored-extensions))) | 732 | (remove ".elc" completion-ignored-extensions))) |
| 733 | (read-file-name "Load file: ")))) | 733 | (read-file-name "Load file: " nil nil 'lambda)))) |
| 734 | (load (expand-file-name file) nil nil t)) | 734 | (load (expand-file-name file) nil nil t)) |
| 735 | 735 | ||
| 736 | (defun locate-file (filename path &optional suffixes predicate) | 736 | (defun locate-file (filename path &optional suffixes predicate) |
| @@ -3433,7 +3433,7 @@ DIR is the name of the directory. | |||
| 3433 | CLASS is the name of a variable class (a symbol). | 3433 | CLASS is the name of a variable class (a symbol). |
| 3434 | MTIME is the recorded modification time of the directory-local | 3434 | MTIME is the recorded modification time of the directory-local |
| 3435 | variables file associated with this entry. This time is a list | 3435 | variables file associated with this entry. This time is a list |
| 3436 | of two integers (the same format as `file-attributes'), and is | 3436 | of integers (the same format as `file-attributes'), and is |
| 3437 | used to test whether the cache entry is still valid. | 3437 | used to test whether the cache entry is still valid. |
| 3438 | Alternatively, MTIME can be nil, which means the entry is always | 3438 | Alternatively, MTIME can be nil, which means the entry is always |
| 3439 | considered valid.") | 3439 | considered valid.") |
diff --git a/lisp/find-cmd.el b/lisp/find-cmd.el index 6589bac0c6a..4cf5b85c81a 100644 --- a/lisp/find-cmd.el +++ b/lisp/find-cmd.el | |||
| @@ -63,6 +63,7 @@ | |||
| 63 | (cnewer . (1)) | 63 | (cnewer . (1)) |
| 64 | (ctime . (1)) | 64 | (ctime . (1)) |
| 65 | (empty . (0)) | 65 | (empty . (0)) |
| 66 | (executable . (0)) | ||
| 66 | (false . (0)) | 67 | (false . (0)) |
| 67 | (fstype . (1)) | 68 | (fstype . (1)) |
| 68 | (gid . (1)) | 69 | (gid . (1)) |
| @@ -70,37 +71,43 @@ | |||
| 70 | (ilname . (1)) | 71 | (ilname . (1)) |
| 71 | (iname . (1)) | 72 | (iname . (1)) |
| 72 | (inum . (1)) | 73 | (inum . (1)) |
| 73 | (iwholename . (1)) | 74 | (ipath . (1)) |
| 74 | (iregex . (1)) | 75 | (iregex . (1)) |
| 76 | (iwholename . (1)) | ||
| 75 | (links . (1)) | 77 | (links . (1)) |
| 76 | (lname . (1)) | 78 | (lname . (1)) |
| 77 | (mmin . (1)) | 79 | (mmin . (1)) |
| 78 | (mtime . (1)) | 80 | (mtime . (1)) |
| 79 | (name . (1)) | 81 | (name . (1)) |
| 80 | (newer . (1)) | 82 | (newer . (1)) |
| 81 | (nouser . (0)) | ||
| 82 | (nogroup . (0)) | 83 | (nogroup . (0)) |
| 84 | (nouser . (0)) | ||
| 83 | (path . (1)) | 85 | (path . (1)) |
| 84 | (perm . (0)) | 86 | (perm . (0)) |
| 87 | (readable . (0)) | ||
| 85 | (regex . (1)) | 88 | (regex . (1)) |
| 86 | (wholename . (1)) | 89 | (samefile . (1)) |
| 87 | (size . (1)) | 90 | (size . (1)) |
| 88 | (true . (0)) | 91 | (true . (0)) |
| 89 | (type . (1)) | 92 | (type . (1)) |
| 90 | (uid . (1)) | 93 | (uid . (1)) |
| 91 | (used . (1)) | 94 | (used . (1)) |
| 92 | (user . (1)) | 95 | (user . (1)) |
| 96 | (wholename . (1)) | ||
| 97 | (writable . (0)) | ||
| 93 | (xtype . (nil)) | 98 | (xtype . (nil)) |
| 94 | 99 | ||
| 95 | ;; normal options (always true) | 100 | ;; normal options (always true) |
| 101 | (daystart . (0)) | ||
| 96 | (depth . (0)) | 102 | (depth . (0)) |
| 97 | (maxdepth . (1)) | 103 | (maxdepth . (1)) |
| 98 | (mindepth . (1)) | 104 | (mindepth . (1)) |
| 99 | (mount . (0)) | 105 | (mount . (0)) |
| 100 | (noleaf . (0)) | 106 | (noleaf . (0)) |
| 101 | (xdev . (0)) | ||
| 102 | (ignore_readdir_race . (0)) | 107 | (ignore_readdir_race . (0)) |
| 103 | (noignore_readdir_race . (0)) | 108 | (noignore_readdir_race . (0)) |
| 109 | (regextype . (1)) | ||
| 110 | (xdev . (0)) | ||
| 104 | 111 | ||
| 105 | ;; actions | 112 | ;; actions |
| 106 | (delete . (0)) | 113 | (delete . (0)) |
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index dd493d383a3..d0dfd100f44 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,3 +1,8 @@ | |||
| 1 | 2012-11-19 Katsumi Yamaoka <yamaoka@jpl.org> | ||
| 2 | |||
| 3 | * message.el (message-get-reply-headers): | ||
| 4 | Make sure the reply goes to the author if it is a wide reply. | ||
| 5 | |||
| 1 | 2012-11-16 Jan Tatarik <jan.tatarik@gmail.com> | 6 | 2012-11-16 Jan Tatarik <jan.tatarik@gmail.com> |
| 2 | 7 | ||
| 3 | * gnus-score.el (gnus-score-body): | 8 | * gnus-score.el (gnus-score-body): |
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 8905acb9d1f..5a2b4334582 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el | |||
| @@ -6730,11 +6730,16 @@ The function is called with one parameter, a cons cell ..." | |||
| 6730 | ", ")) | 6730 | ", ")) |
| 6731 | mct (message-fetch-field "mail-copies-to") | 6731 | mct (message-fetch-field "mail-copies-to") |
| 6732 | author (or (message-fetch-field "mail-reply-to") | 6732 | author (or (message-fetch-field "mail-reply-to") |
| 6733 | (message-fetch-field "reply-to") | 6733 | (message-fetch-field "reply-to")) |
| 6734 | (message-fetch-field "from") | ||
| 6735 | "") | ||
| 6736 | mft (and message-use-mail-followup-to | 6734 | mft (and message-use-mail-followup-to |
| 6737 | (message-fetch-field "mail-followup-to")))) | 6735 | (message-fetch-field "mail-followup-to"))) |
| 6736 | ;; Make sure this message goes to the author if this is a wide | ||
| 6737 | ;; reply, since Reply-To address may be a list address a mailing | ||
| 6738 | ;; list server added. | ||
| 6739 | (when (and wide author) | ||
| 6740 | (setq cc (concat author ", " cc))) | ||
| 6741 | (when (or wide (not author)) | ||
| 6742 | (setq author (or (message-fetch-field "from") "")))) | ||
| 6738 | 6743 | ||
| 6739 | ;; Handle special values of Mail-Copies-To. | 6744 | ;; Handle special values of Mail-Copies-To. |
| 6740 | (when mct | 6745 | (when mct |
diff --git a/lisp/json.el b/lisp/json.el index 8167bfe93f2..b1ea03120dc 100644 --- a/lisp/json.el +++ b/lisp/json.el | |||
| @@ -51,7 +51,6 @@ | |||
| 51 | 51 | ||
| 52 | ;;; Code: | 52 | ;;; Code: |
| 53 | 53 | ||
| 54 | (eval-when-compile (require 'cl)) | ||
| 55 | 54 | ||
| 56 | ;; Compatibility code | 55 | ;; Compatibility code |
| 57 | 56 | ||
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index ec321d00506..07da0b3dc16 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el | |||
| @@ -1270,9 +1270,10 @@ target of the symlink differ." | |||
| 1270 | res-uid | 1270 | res-uid |
| 1271 | ;; 3. File gid. | 1271 | ;; 3. File gid. |
| 1272 | res-gid | 1272 | res-gid |
| 1273 | ;; 4. Last access time, as a list of two integers. First | 1273 | ;; 4. Last access time, as a list of integers. Normally this |
| 1274 | ;; integer has high-order 16 bits of time, second has low 16 | 1274 | ;; would be in the same format as `current-time', but the |
| 1275 | ;; bits. | 1275 | ;; subseconds part is not currently implemented, and (0 0) |
| 1276 | ;; denotes an unknown time. | ||
| 1276 | ;; 5. Last modification time, likewise. | 1277 | ;; 5. Last modification time, likewise. |
| 1277 | ;; 6. Last status change time, likewise. | 1278 | ;; 6. Last status change time, likewise. |
| 1278 | '(0 0) '(0 0) '(0 0) ;CCC how to find out? | 1279 | '(0 0) '(0 0) '(0 0) ;CCC how to find out? |
| @@ -1980,6 +1981,7 @@ file names." | |||
| 1980 | (error "Unknown operation `%s', must be `copy' or `rename'" op)) | 1981 | (error "Unknown operation `%s', must be `copy' or `rename'" op)) |
| 1981 | (let ((t1 (tramp-tramp-file-p filename)) | 1982 | (let ((t1 (tramp-tramp-file-p filename)) |
| 1982 | (t2 (tramp-tramp-file-p newname)) | 1983 | (t2 (tramp-tramp-file-p newname)) |
| 1984 | (length (nth 7 (file-attributes (file-truename filename)))) | ||
| 1983 | (context (and preserve-selinux-context | 1985 | (context (and preserve-selinux-context |
| 1984 | (apply 'file-selinux-context (list filename)))) | 1986 | (apply 'file-selinux-context (list filename)))) |
| 1985 | pr tm) | 1987 | pr tm) |
| @@ -2009,8 +2011,9 @@ file names." | |||
| 2009 | ok-if-already-exists keep-date preserve-uid-gid)) | 2011 | ok-if-already-exists keep-date preserve-uid-gid)) |
| 2010 | 2012 | ||
| 2011 | ;; Try out-of-band operation. | 2013 | ;; Try out-of-band operation. |
| 2012 | ((tramp-method-out-of-band-p | 2014 | ((and |
| 2013 | v1 (nth 7 (file-attributes (file-truename filename)))) | 2015 | (tramp-method-out-of-band-p v1 length) |
| 2016 | (tramp-method-out-of-band-p v2 length)) | ||
| 2014 | (tramp-do-copy-or-rename-file-out-of-band | 2017 | (tramp-do-copy-or-rename-file-out-of-band |
| 2015 | op filename newname keep-date)) | 2018 | op filename newname keep-date)) |
| 2016 | 2019 | ||
| @@ -2038,8 +2041,7 @@ file names." | |||
| 2038 | 2041 | ||
| 2039 | ;; If the Tramp file has an out-of-band method, the | 2042 | ;; If the Tramp file has an out-of-band method, the |
| 2040 | ;; corresponding copy-program can be invoked. | 2043 | ;; corresponding copy-program can be invoked. |
| 2041 | ((tramp-method-out-of-band-p | 2044 | ((tramp-method-out-of-band-p v length) |
| 2042 | v (nth 7 (file-attributes (file-truename filename)))) | ||
| 2043 | (tramp-do-copy-or-rename-file-out-of-band | 2045 | (tramp-do-copy-or-rename-file-out-of-band |
| 2044 | op filename newname keep-date)) | 2046 | op filename newname keep-date)) |
| 2045 | 2047 | ||
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index caaae5d553e..d6f2177b03b 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el | |||
| @@ -3767,6 +3767,7 @@ Invokes `password-read' if available, `read-passwd' else." | |||
| 3767 | ("oct" . 10) ("nov" . 11) ("dec" . 12)) | 3767 | ("oct" . 10) ("nov" . 11) ("dec" . 12)) |
| 3768 | "Alist mapping month names to integers.") | 3768 | "Alist mapping month names to integers.") |
| 3769 | 3769 | ||
| 3770 | ;; FIXME: Shouldn't this also look at any subseconds parts of T1 and T2? | ||
| 3770 | ;;;###tramp-autoload | 3771 | ;;;###tramp-autoload |
| 3771 | (defun tramp-time-less-p (t1 t2) | 3772 | (defun tramp-time-less-p (t1 t2) |
| 3772 | "Say whether time value T1 is less than time value T2." | 3773 | "Say whether time value T1 is less than time value T2." |
| @@ -3776,6 +3777,7 @@ Invokes `password-read' if available, `read-passwd' else." | |||
| 3776 | (and (= (car t1) (car t2)) | 3777 | (and (= (car t1) (car t2)) |
| 3777 | (< (nth 1 t1) (nth 1 t2))))) | 3778 | (< (nth 1 t1) (nth 1 t2))))) |
| 3778 | 3779 | ||
| 3780 | ;; FIXME: Shouldn't this also look at any subseconds parts of T1 and T2? | ||
| 3779 | (defun tramp-time-subtract (t1 t2) | 3781 | (defun tramp-time-subtract (t1 t2) |
| 3780 | "Subtract two time values. | 3782 | "Subtract two time values. |
| 3781 | Return the difference in the format of a time value." | 3783 | Return the difference in the format of a time value." |
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 9e55976a8bd..13cf7356e7f 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el | |||
| @@ -833,7 +833,8 @@ this is `comint-dynamic-complete-functions'." | |||
| 833 | . ,(lambda (comps) | 833 | . ,(lambda (comps) |
| 834 | (sort comps pcomplete-compare-entry-function))) | 834 | (sort comps pcomplete-compare-entry-function))) |
| 835 | ,@(cdr (completion-file-name-table s p a))) | 835 | ,@(cdr (completion-file-name-table s p a))) |
| 836 | (let ((completion-ignored-extensions nil)) | 836 | (let ((completion-ignored-extensions nil) |
| 837 | (completion-ignore-case pcomplete-ignore-case)) | ||
| 837 | (completion-table-with-predicate | 838 | (completion-table-with-predicate |
| 838 | #'comint-completion-file-name-table pred 'strict s p a)))))) | 839 | #'comint-completion-file-name-table pred 'strict s p a)))))) |
| 839 | 840 | ||
diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index a3ea4af4651..8af877c7843 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el | |||
| @@ -175,7 +175,7 @@ static unsigned char gamegrid_bits[] = { | |||
| 175 | 175 | ||
| 176 | (defun gamegrid-make-mono-tty-face () | 176 | (defun gamegrid-make-mono-tty-face () |
| 177 | (let ((face (make-face 'gamegrid-mono-tty-face))) | 177 | (let ((face (make-face 'gamegrid-mono-tty-face))) |
| 178 | (set-face-inverse-video-p face t) | 178 | (set-face-inverse-video face t) |
| 179 | face)) | 179 | face)) |
| 180 | 180 | ||
| 181 | (defun gamegrid-make-color-tty-face (color) | 181 | (defun gamegrid-make-color-tty-face (color) |
diff --git a/lisp/profiler.el b/lisp/profiler.el index 38c0c0b83a7..00b51ffe099 100644 --- a/lisp/profiler.el +++ b/lisp/profiler.el | |||
| @@ -404,7 +404,6 @@ RET: expand or collapse")) | |||
| 404 | 404 | ||
| 405 | (defvar profiler-report-mode-map | 405 | (defvar profiler-report-mode-map |
| 406 | (let ((map (make-sparse-keymap))) | 406 | (let ((map (make-sparse-keymap))) |
| 407 | ;; FIXME: Add menu. | ||
| 408 | (define-key map "n" 'profiler-report-next-entry) | 407 | (define-key map "n" 'profiler-report-next-entry) |
| 409 | (define-key map "p" 'profiler-report-previous-entry) | 408 | (define-key map "p" 'profiler-report-previous-entry) |
| 410 | ;; I find it annoying more than helpful to not be able to navigate | 409 | ;; I find it annoying more than helpful to not be able to navigate |
| @@ -424,8 +423,43 @@ RET: expand or collapse")) | |||
| 424 | (define-key map "D" 'profiler-report-descending-sort) | 423 | (define-key map "D" 'profiler-report-descending-sort) |
| 425 | (define-key map "=" 'profiler-report-compare-profile) | 424 | (define-key map "=" 'profiler-report-compare-profile) |
| 426 | (define-key map (kbd "C-x C-w") 'profiler-report-write-profile) | 425 | (define-key map (kbd "C-x C-w") 'profiler-report-write-profile) |
| 427 | (define-key map "q" 'quit-window) | 426 | (easy-menu-define profiler-report-menu map "Menu for Profiler Report mode." |
| 428 | map)) | 427 | '("Profiler" |
| 428 | ["Next Entry" profiler-report-next-entry :active t | ||
| 429 | :help "Move to next entry"] | ||
| 430 | ["Previous Entry" profiler-report-previous-entry :active t | ||
| 431 | :help "Move to previous entry"] | ||
| 432 | "--" | ||
| 433 | ["Toggle Entry" profiler-report-toggle-entry | ||
| 434 | :active (profiler-report-calltree-at-point) | ||
| 435 | :help "Expand or collapse the current entry"] | ||
| 436 | ["Find Entry" profiler-report-find-entry | ||
| 437 | ;; FIXME should deactivate if not on a known function. | ||
| 438 | :active (profiler-report-calltree-at-point) | ||
| 439 | :help "Find the definition of the current entry"] | ||
| 440 | ["Describe Entry" profiler-report-describe-entry | ||
| 441 | :active (profiler-report-calltree-at-point) | ||
| 442 | :help "Show the documentation of the current entry"] | ||
| 443 | "--" | ||
| 444 | ["Show Calltree" profiler-report-render-calltree | ||
| 445 | :active profiler-report-reversed | ||
| 446 | :help "Show calltree view"] | ||
| 447 | ["Show Reversed Calltree" profiler-report-render-reversed-calltree | ||
| 448 | :active (not profiler-report-reversed) | ||
| 449 | :help "Show reversed calltree view"] | ||
| 450 | ["Sort Ascending" profiler-report-ascending-sort | ||
| 451 | :active (not (eq profiler-report-order 'ascending)) | ||
| 452 | :help "Sort calltree view in ascending order"] | ||
| 453 | ["Sort Descending" profiler-report-descending-sort | ||
| 454 | :active (not (eq profiler-report-order 'descending)) | ||
| 455 | :help "Sort calltree view in descending order"] | ||
| 456 | "--" | ||
| 457 | ["Compare Profile..." profiler-report-compare-profile :active t | ||
| 458 | :help "Compare current profile with another"] | ||
| 459 | ["Write Profile..." profiler-report-write-profile :active t | ||
| 460 | :help "Write current profile to a file"])) | ||
| 461 | map) | ||
| 462 | "Keymap for `profiler-report-mode'.") | ||
| 429 | 463 | ||
| 430 | (defun profiler-report-make-buffer-name (profile) | 464 | (defun profiler-report-make-buffer-name (profile) |
| 431 | (format "*%s-Profiler-Report %s*" | 465 | (format "*%s-Profiler-Report %s*" |
| @@ -529,11 +563,15 @@ otherwise collapse." | |||
| 529 | (defun profiler-report-find-entry (&optional event) | 563 | (defun profiler-report-find-entry (&optional event) |
| 530 | "Find entry at point." | 564 | "Find entry at point." |
| 531 | (interactive (list last-nonmenu-event)) | 565 | (interactive (list last-nonmenu-event)) |
| 532 | (if event (posn-set-point (event-end event))) | 566 | (with-current-buffer |
| 533 | (let ((tree (profiler-report-calltree-at-point))) | 567 | (if event (window-buffer (posn-window (event-start event))) |
| 534 | (when tree | 568 | (current-buffer)) |
| 535 | (let ((entry (profiler-calltree-entry tree))) | 569 | (and event (setq event (event-end event)) |
| 536 | (find-function entry))))) | 570 | (posn-set-point event)) |
| 571 | (let ((tree (profiler-report-calltree-at-point))) | ||
| 572 | (when tree | ||
| 573 | (let ((entry (profiler-calltree-entry tree))) | ||
| 574 | (find-function entry)))))) | ||
| 537 | 575 | ||
| 538 | (defun profiler-report-describe-entry () | 576 | (defun profiler-report-describe-entry () |
| 539 | "Describe entry at point." | 577 | "Describe entry at point." |
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 949b0252bf1..550c5f5a129 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el | |||
| @@ -202,13 +202,12 @@ | |||
| 202 | 202 | ||
| 203 | (require 'ansi-color) | 203 | (require 'ansi-color) |
| 204 | (require 'comint) | 204 | (require 'comint) |
| 205 | (eval-when-compile (require 'cl-lib)) | ||
| 205 | 206 | ||
| 206 | (eval-when-compile | 207 | ;; Avoid compiler warnings |
| 207 | (require 'cl) | 208 | (defvar view-return-to-alist) |
| 208 | ;; Avoid compiler warnings | 209 | (defvar compilation-error-regexp-alist) |
| 209 | (defvar view-return-to-alist) | 210 | (defvar outline-heading-end-regexp) |
| 210 | (defvar compilation-error-regexp-alist) | ||
| 211 | (defvar outline-heading-end-regexp)) | ||
| 212 | 211 | ||
| 213 | (autoload 'comint-mode "comint") | 212 | (autoload 'comint-mode "comint") |
| 214 | 213 | ||
| @@ -364,12 +363,24 @@ This variant of `rx' supports common python named REGEXPS." | |||
| 364 | "Return non-nil if point is on TYPE using SYNTAX-PPSS. | 363 | "Return non-nil if point is on TYPE using SYNTAX-PPSS. |
| 365 | TYPE can be `comment', `string' or `paren'. It returns the start | 364 | TYPE can be `comment', `string' or `paren'. It returns the start |
| 366 | character address of the specified TYPE." | 365 | character address of the specified TYPE." |
| 366 | (declare (compiler-macro | ||
| 367 | (lambda (form) | ||
| 368 | (pcase type | ||
| 369 | (`'comment | ||
| 370 | `(let ((ppss (or ,syntax-ppss (syntax-ppss)))) | ||
| 371 | (and (nth 4 ppss) (nth 8 ppss)))) | ||
| 372 | (`'string | ||
| 373 | `(let ((ppss (or ,syntax-ppss (syntax-ppss)))) | ||
| 374 | (and (nth 3 ppss) (nth 8 ppss)))) | ||
| 375 | (`'paren | ||
| 376 | `(nth 1 (or ,syntax-ppss (syntax-ppss)))) | ||
| 377 | (_ form))))) | ||
| 367 | (let ((ppss (or syntax-ppss (syntax-ppss)))) | 378 | (let ((ppss (or syntax-ppss (syntax-ppss)))) |
| 368 | (case type | 379 | (pcase type |
| 369 | (comment (and (nth 4 ppss) (nth 8 ppss))) | 380 | (`comment (and (nth 4 ppss) (nth 8 ppss))) |
| 370 | (string (and (not (nth 4 ppss)) (nth 8 ppss))) | 381 | (`string (and (nth 3 ppss) (nth 8 ppss))) |
| 371 | (paren (nth 1 ppss)) | 382 | (`paren (nth 1 ppss)) |
| 372 | (t nil)))) | 383 | (_ nil)))) |
| 373 | 384 | ||
| 374 | (defun python-syntax-context-type (&optional syntax-ppss) | 385 | (defun python-syntax-context-type (&optional syntax-ppss) |
| 375 | "Return the context type using SYNTAX-PPSS. | 386 | "Return the context type using SYNTAX-PPSS. |
| @@ -481,8 +492,8 @@ The type returned can be `comment', `string' or `paren'." | |||
| 481 | (when (re-search-forward re limit t) | 492 | (when (re-search-forward re limit t) |
| 482 | (while (and (python-syntax-context 'paren) | 493 | (while (and (python-syntax-context 'paren) |
| 483 | (re-search-forward re limit t))) | 494 | (re-search-forward re limit t))) |
| 484 | (if (and (not (python-syntax-context 'paren)) | 495 | (if (not (or (python-syntax-context 'paren) |
| 485 | (not (equal (char-after (point-marker)) ?=))) | 496 | (equal (char-after (point-marker)) ?=))) |
| 486 | t | 497 | t |
| 487 | (set-match-data nil))))) | 498 | (set-match-data nil))))) |
| 488 | (1 font-lock-variable-name-face nil nil)) | 499 | (1 font-lock-variable-name-face nil nil)) |
| @@ -516,7 +527,7 @@ is used to limit the scan." | |||
| 516 | (while (and (< i 3) | 527 | (while (and (< i 3) |
| 517 | (or (not limit) (< (+ point i) limit)) | 528 | (or (not limit) (< (+ point i) limit)) |
| 518 | (eq (char-after (+ point i)) quote-char)) | 529 | (eq (char-after (+ point i)) quote-char)) |
| 519 | (incf i)) | 530 | (cl-incf i)) |
| 520 | i)) | 531 | i)) |
| 521 | 532 | ||
| 522 | (defun python-syntax-stringify () | 533 | (defun python-syntax-stringify () |
| @@ -723,17 +734,17 @@ START is the buffer position where the sexp starts." | |||
| 723 | (save-restriction | 734 | (save-restriction |
| 724 | (widen) | 735 | (widen) |
| 725 | (save-excursion | 736 | (save-excursion |
| 726 | (case context-status | 737 | (pcase context-status |
| 727 | ('no-indent 0) | 738 | (`no-indent 0) |
| 728 | ;; When point is after beginning of block just add one level | 739 | ;; When point is after beginning of block just add one level |
| 729 | ;; of indentation relative to the context-start | 740 | ;; of indentation relative to the context-start |
| 730 | ('after-beginning-of-block | 741 | (`after-beginning-of-block |
| 731 | (goto-char context-start) | 742 | (goto-char context-start) |
| 732 | (+ (current-indentation) python-indent-offset)) | 743 | (+ (current-indentation) python-indent-offset)) |
| 733 | ;; When after a simple line just use previous line | 744 | ;; When after a simple line just use previous line |
| 734 | ;; indentation, in the case current line starts with a | 745 | ;; indentation, in the case current line starts with a |
| 735 | ;; `python-indent-dedenters' de-indent one level. | 746 | ;; `python-indent-dedenters' de-indent one level. |
| 736 | ('after-line | 747 | (`after-line |
| 737 | (- | 748 | (- |
| 738 | (save-excursion | 749 | (save-excursion |
| 739 | (goto-char context-start) | 750 | (goto-char context-start) |
| @@ -746,11 +757,11 @@ START is the buffer position where the sexp starts." | |||
| 746 | ;; When inside of a string, do nothing. just use the current | 757 | ;; When inside of a string, do nothing. just use the current |
| 747 | ;; indentation. XXX: perhaps it would be a good idea to | 758 | ;; indentation. XXX: perhaps it would be a good idea to |
| 748 | ;; invoke standard text indentation here | 759 | ;; invoke standard text indentation here |
| 749 | ('inside-string | 760 | (`inside-string |
| 750 | (goto-char context-start) | 761 | (goto-char context-start) |
| 751 | (current-indentation)) | 762 | (current-indentation)) |
| 752 | ;; After backslash we have several possibilities. | 763 | ;; After backslash we have several possibilities. |
| 753 | ('after-backslash | 764 | (`after-backslash |
| 754 | (cond | 765 | (cond |
| 755 | ;; Check if current line is a dot continuation. For this | 766 | ;; Check if current line is a dot continuation. For this |
| 756 | ;; the current line must start with a dot and previous | 767 | ;; the current line must start with a dot and previous |
| @@ -816,7 +827,7 @@ START is the buffer position where the sexp starts." | |||
| 816 | (+ (current-indentation) python-indent-offset))))) | 827 | (+ (current-indentation) python-indent-offset))))) |
| 817 | ;; When inside a paren there's a need to handle nesting | 828 | ;; When inside a paren there's a need to handle nesting |
| 818 | ;; correctly | 829 | ;; correctly |
| 819 | ('inside-paren | 830 | (`inside-paren |
| 820 | (cond | 831 | (cond |
| 821 | ;; If current line closes the outermost open paren use the | 832 | ;; If current line closes the outermost open paren use the |
| 822 | ;; current indentation of the context-start line. | 833 | ;; current indentation of the context-start line. |
| @@ -2164,11 +2175,11 @@ INPUT." | |||
| 2164 | 'default) | 2175 | 'default) |
| 2165 | (t nil))) | 2176 | (t nil))) |
| 2166 | (completion-code | 2177 | (completion-code |
| 2167 | (case completion-context | 2178 | (pcase completion-context |
| 2168 | (pdb python-shell-completion-pdb-string-code) | 2179 | (`pdb python-shell-completion-pdb-string-code) |
| 2169 | (import python-shell-completion-module-string-code) | 2180 | (`import python-shell-completion-module-string-code) |
| 2170 | (default python-shell-completion-string-code) | 2181 | (`default python-shell-completion-string-code) |
| 2171 | (t nil))) | 2182 | (_ nil))) |
| 2172 | (input | 2183 | (input |
| 2173 | (if (eq completion-context 'import) | 2184 | (if (eq completion-context 'import) |
| 2174 | (replace-regexp-in-string "^[ \t]+" "" line) | 2185 | (replace-regexp-in-string "^[ \t]+" "" line) |
| @@ -2492,17 +2503,17 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." | |||
| 2492 | ;; Docstring styles may vary for oneliners and multi-liners. | 2503 | ;; Docstring styles may vary for oneliners and multi-liners. |
| 2493 | (> (count-matches "\n" str-start-pos str-end-pos) 0)) | 2504 | (> (count-matches "\n" str-start-pos str-end-pos) 0)) |
| 2494 | (delimiters-style | 2505 | (delimiters-style |
| 2495 | (case python-fill-docstring-style | 2506 | (pcase python-fill-docstring-style |
| 2496 | ;; delimiters-style is a cons cell with the form | 2507 | ;; delimiters-style is a cons cell with the form |
| 2497 | ;; (START-NEWLINES . END-NEWLINES). When any of the sexps | 2508 | ;; (START-NEWLINES . END-NEWLINES). When any of the sexps |
| 2498 | ;; is NIL means to not add any newlines for start or end | 2509 | ;; is NIL means to not add any newlines for start or end |
| 2499 | ;; of docstring. See `python-fill-docstring-style' for a | 2510 | ;; of docstring. See `python-fill-docstring-style' for a |
| 2500 | ;; graphic idea of each style. | 2511 | ;; graphic idea of each style. |
| 2501 | (django (cons 1 1)) | 2512 | (`django (cons 1 1)) |
| 2502 | (onetwo (and multi-line-p (cons 1 2))) | 2513 | (`onetwo (and multi-line-p (cons 1 2))) |
| 2503 | (pep-257 (and multi-line-p (cons nil 2))) | 2514 | (`pep-257 (and multi-line-p (cons nil 2))) |
| 2504 | (pep-257-nn (and multi-line-p (cons nil 1))) | 2515 | (`pep-257-nn (and multi-line-p (cons nil 1))) |
| 2505 | (symmetric (and multi-line-p (cons 1 1))))) | 2516 | (`symmetric (and multi-line-p (cons 1 1))))) |
| 2506 | (docstring-p (save-excursion | 2517 | (docstring-p (save-excursion |
| 2507 | ;; Consider docstrings those strings which | 2518 | ;; Consider docstrings those strings which |
| 2508 | ;; start on a line by themselves. | 2519 | ;; start on a line by themselves. |
| @@ -2703,7 +2714,7 @@ The skeleton will be bound to python-skeleton-NAME." | |||
| 2703 | (easy-menu-add-item | 2714 | (easy-menu-add-item |
| 2704 | nil '("Python" "Skeletons") | 2715 | nil '("Python" "Skeletons") |
| 2705 | `[,(format | 2716 | `[,(format |
| 2706 | "Insert %s" (caddr (split-string (symbol-name skeleton) "-"))) | 2717 | "Insert %s" (nth 2 (split-string (symbol-name skeleton) "-"))) |
| 2707 | ,skeleton t])))) | 2718 | ,skeleton t])))) |
| 2708 | 2719 | ||
| 2709 | ;;; FFAP | 2720 | ;;; FFAP |
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 64b87d9e436..d84d57cad22 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el | |||
| @@ -736,15 +736,15 @@ this variable is nil, that buffer is shown using | |||
| 736 | 736 | ||
| 737 | (defvar sql-imenu-generic-expression | 737 | (defvar sql-imenu-generic-expression |
| 738 | ;; Items are in reverse order because they are rendered in reverse. | 738 | ;; Items are in reverse order because they are rendered in reverse. |
| 739 | '(("Rules/Defaults" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*\\(rule\\|default\\)\\s-+\\(\\w+\\)" 3) | 739 | '(("Rules/Defaults" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*\\(?:rule\\|default\\)\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\s-+\\(\\w+\\)" 1) |
| 740 | ("Sequences" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*sequence\\s-+\\(\\w+\\)" 2) | 740 | ("Sequences" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*sequence\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\w+\\)" 1) |
| 741 | ("Triggers" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*trigger\\s-+\\(\\w+\\)" 2) | 741 | ("Triggers" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*trigger\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\w+\\)" 1) |
| 742 | ("Functions" "^\\s-*\\(create\\s-+\\(\\w+\\s-+\\)*\\)?function\\s-+\\(\\w+\\)" 3) | 742 | ("Functions" "^\\s-*\\(?:create\\s-+\\(?:\\w+\\s-+\\)*\\)?function\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\w+\\)" 1) |
| 743 | ("Procedures" "^\\s-*\\(create\\s-+\\(\\w+\\s-+\\)*\\)?proc\\(edure\\)?\\s-+\\(\\w+\\)" 4) | 743 | ("Procedures" "^\\s-*\\(?:create\\s-+\\(?:\\w+\\s-+\\)*\\)?proc\\(?:edure\\)?\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\w+\\)" 1) |
| 744 | ("Packages" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*package\\s-+\\(body\\s-+\\)?\\(\\w+\\)" 3) | 744 | ("Packages" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*package\\s-+\\(?:body\\s-+\\)?\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\w+\\)" 1) |
| 745 | ("Types" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*type\\s-+\\(body\\s-+\\)?\\(\\w+\\)" 3) | 745 | ("Types" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*type\\s-+\\(?:body\\s-+\\)?\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\w+\\)" 1) |
| 746 | ("Indexes" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*index\\s-+\\(\\w+\\)" 2) | 746 | ("Indexes" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*index\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\w+\\)" 1) |
| 747 | ("Tables/Views" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*\\(table\\|view\\)\\s-+\\(\\w+\\)" 3)) | 747 | ("Tables/Views" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*\\(?:table\\|view\\)\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\w+\\)" 1)) |
| 748 | "Define interesting points in the SQL buffer for `imenu'. | 748 | "Define interesting points in the SQL buffer for `imenu'. |
| 749 | 749 | ||
| 750 | This is used to set `imenu-generic-expression' when SQL mode is | 750 | This is used to set `imenu-generic-expression' when SQL mode is |
| @@ -1339,6 +1339,7 @@ Based on `comint-mode-map'.") | |||
| 1339 | "\\(?:\\w+\\s-+\\)*" ;; optional intervening keywords | 1339 | "\\(?:\\w+\\s-+\\)*" ;; optional intervening keywords |
| 1340 | "\\(?:table\\|view\\|\\(?:package\\|type\\)\\(?:\\s-+body\\)?\\|proc\\(?:edure\\)?" | 1340 | "\\(?:table\\|view\\|\\(?:package\\|type\\)\\(?:\\s-+body\\)?\\|proc\\(?:edure\\)?" |
| 1341 | "\\|function\\|trigger\\|sequence\\|rule\\|default\\)\\s-+" | 1341 | "\\|function\\|trigger\\|sequence\\|rule\\|default\\)\\s-+" |
| 1342 | "\\(?:if\\s-+not\\s-+exists\\s-+\\)?" ;; IF NOT EXISTS | ||
| 1342 | "\\(\\w+\\)") | 1343 | "\\(\\w+\\)") |
| 1343 | 1 'font-lock-function-name-face)) | 1344 | 1 'font-lock-function-name-face)) |
| 1344 | 1345 | ||
diff --git a/lisp/ps-bdf.el b/lisp/ps-bdf.el index a82e03ceda7..477aee1b2da 100644 --- a/lisp/ps-bdf.el +++ b/lisp/ps-bdf.el | |||
| @@ -70,20 +70,15 @@ for BDFNAME." | |||
| 70 | 70 | ||
| 71 | (defsubst bdf-file-mod-time (filename) | 71 | (defsubst bdf-file-mod-time (filename) |
| 72 | "Return modification time of FILENAME. | 72 | "Return modification time of FILENAME. |
| 73 | The value is a list of two integers, the first integer has high-order | 73 | The value is a list of integers in the same format as `current-time'." |
| 74 | 16 bits, the second has low 16 bits." | ||
| 75 | (nth 5 (file-attributes filename))) | 74 | (nth 5 (file-attributes filename))) |
| 76 | 75 | ||
| 77 | (defun bdf-file-newer-than-time (filename mod-time) | 76 | (defun bdf-file-newer-than-time (filename mod-time) |
| 78 | "Return non-nil if and only if FILENAME is newer than MOD-TIME. | 77 | "Return non-nil if and only if FILENAME is newer than MOD-TIME. |
| 79 | MOD-TIME is a modification time as a list of two integers, the first | 78 | MOD-TIME is a modification time as a list of integers in the same |
| 80 | integer has high-order 16 bits, the second has low 16 bits." | 79 | format as `current-time'." |
| 81 | (let* ((new-mod-time (bdf-file-mod-time filename)) | 80 | (let ((new-mod-time (bdf-file-mod-time filename))) |
| 82 | (new-time (car new-mod-time)) | 81 | (time-less-p mod-time new-mod-time))) |
| 83 | (time (car mod-time))) | ||
| 84 | (or (> new-time time) | ||
| 85 | (and (= new-time time) | ||
| 86 | (> (nth 1 new-mod-time) (nth 1 mod-time)))))) | ||
| 87 | 82 | ||
| 88 | (defun bdf-find-file (bdfname) | 83 | (defun bdf-find-file (bdfname) |
| 89 | "Return a buffer visiting a bdf file BDFNAME. | 84 | "Return a buffer visiting a bdf file BDFNAME. |
| @@ -178,8 +173,8 @@ FONT-INFO is a list of the following format: | |||
| 178 | (BDFFILE MOD-TIME FONT-BOUNDING-BOX | 173 | (BDFFILE MOD-TIME FONT-BOUNDING-BOX |
| 179 | RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR) | 174 | RELATIVE-COMPOSE BASELINE-OFFSET CODE-RANGE MAXLEN OFFSET-VECTOR) |
| 180 | 175 | ||
| 181 | MOD-TIME is last modification time as a list of two integers, the | 176 | MOD-TIME is last modification time as a list of integers in the |
| 182 | first integer has high-order 16 bits, the second has low 16 bits. | 177 | same format as `current-time'. |
| 183 | 178 | ||
| 184 | SIZE is a size of the font on 72 dpi device. This value is got | 179 | SIZE is a size of the font on 72 dpi device. This value is got |
| 185 | from SIZE record of the font. | 180 | from SIZE record of the font. |
diff --git a/lisp/simple.el b/lisp/simple.el index aed945d6e13..5867561da26 100644 --- a/lisp/simple.el +++ b/lisp/simple.el | |||
| @@ -4583,6 +4583,9 @@ lines." | |||
| 4583 | (unless (and auto-window-vscroll try-vscroll | 4583 | (unless (and auto-window-vscroll try-vscroll |
| 4584 | ;; Only vscroll for single line moves | 4584 | ;; Only vscroll for single line moves |
| 4585 | (= (abs arg) 1) | 4585 | (= (abs arg) 1) |
| 4586 | ;; Under scroll-conservatively, the display engine | ||
| 4587 | ;; does this better. | ||
| 4588 | (zerop scroll-conservatively) | ||
| 4586 | ;; But don't vscroll in a keyboard macro. | 4589 | ;; But don't vscroll in a keyboard macro. |
| 4587 | (not defining-kbd-macro) | 4590 | (not defining-kbd-macro) |
| 4588 | (not executing-kbd-macro) | 4591 | (not executing-kbd-macro) |
diff --git a/lisp/subr.el b/lisp/subr.el index 8410897fd6f..c0479d35987 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -1191,8 +1191,6 @@ is converted into a string by expressing it in decimal." | |||
| 1191 | (make-obsolete 'unfocus-frame "it does nothing." "22.1") | 1191 | (make-obsolete 'unfocus-frame "it does nothing." "22.1") |
| 1192 | (make-obsolete 'make-variable-frame-local | 1192 | (make-obsolete 'make-variable-frame-local |
| 1193 | "explicitly check for a frame-parameter instead." "22.2") | 1193 | "explicitly check for a frame-parameter instead." "22.2") |
| 1194 | (make-obsolete 'interactive-p 'called-interactively-p "23.2") | ||
| 1195 | (set-advertised-calling-convention 'called-interactively-p '(kind) "23.1") | ||
| 1196 | (set-advertised-calling-convention | 1194 | (set-advertised-calling-convention |
| 1197 | 'all-completions '(string collection &optional predicate) "23.1") | 1195 | 'all-completions '(string collection &optional predicate) "23.1") |
| 1198 | (set-advertised-calling-convention 'unintern '(name obarray) "23.3") | 1196 | (set-advertised-calling-convention 'unintern '(name obarray) "23.3") |
| @@ -3963,6 +3961,152 @@ The properties used on SYMBOL are `composefunc', `sendfunc', | |||
| 3963 | (put symbol 'abortfunc (or abortfunc 'kill-buffer)) | 3961 | (put symbol 'abortfunc (or abortfunc 'kill-buffer)) |
| 3964 | (put symbol 'hookvar (or hookvar 'mail-send-hook))) | 3962 | (put symbol 'hookvar (or hookvar 'mail-send-hook))) |
| 3965 | 3963 | ||
| 3964 | (defvar called-interactively-p-functions nil | ||
| 3965 | "Special hook called to skip special frames in `called-interactively-p'. | ||
| 3966 | The functions are called with 3 arguments: (I FRAME1 FRAME2), | ||
| 3967 | where FRAME1 is a \"current frame\", FRAME2 is the next frame, | ||
| 3968 | I is the index of the frame after FRAME2. It should return nil | ||
| 3969 | if those frames don't seem special and otherwise, it should return | ||
| 3970 | the number of frames to skip (minus 1).") | ||
| 3971 | |||
| 3972 | (defmacro internal--called-interactively-p--get-frame (n) | ||
| 3973 | ;; `sym' will hold a global variable, which will be used kind of like C's | ||
| 3974 | ;; "static" variables. | ||
| 3975 | (let ((sym (make-symbol "base-index"))) | ||
| 3976 | `(progn | ||
| 3977 | (defvar ,sym | ||
| 3978 | (let ((i 1)) | ||
| 3979 | (while (not (eq (nth 1 (backtrace-frame i)) | ||
| 3980 | 'called-interactively-p)) | ||
| 3981 | (setq i (1+ i))) | ||
| 3982 | i)) | ||
| 3983 | ;; (unless (eq (nth 1 (backtrace-frame ,sym)) 'called-interactively-p) | ||
| 3984 | ;; (error "called-interactively-p: %s is out-of-sync!" ,sym)) | ||
| 3985 | (backtrace-frame (+ ,sym ,n))))) | ||
| 3986 | |||
| 3987 | (defun called-interactively-p (&optional kind) | ||
| 3988 | "Return t if the containing function was called by `call-interactively'. | ||
| 3989 | If KIND is `interactive', then only return t if the call was made | ||
| 3990 | interactively by the user, i.e. not in `noninteractive' mode nor | ||
| 3991 | when `executing-kbd-macro'. | ||
| 3992 | If KIND is `any', on the other hand, it will return t for any kind of | ||
| 3993 | interactive call, including being called as the binding of a key or | ||
| 3994 | from a keyboard macro, even in `noninteractive' mode. | ||
| 3995 | |||
| 3996 | This function is very brittle, it may fail to return the intended result when | ||
| 3997 | the code is debugged, advised, or instrumented in some form. Some macros and | ||
| 3998 | special forms (such as `condition-case') may also sometimes wrap their bodies | ||
| 3999 | in a `lambda', so any call to `called-interactively-p' from those bodies will | ||
| 4000 | indicate whether that lambda (rather than the surrounding function) was called | ||
| 4001 | interactively. | ||
| 4002 | |||
| 4003 | Instead of using this function, it is cleaner and more reliable to give your | ||
| 4004 | function an extra optional argument whose `interactive' spec specifies | ||
| 4005 | non-nil unconditionally (\"p\" is a good way to do this), or via | ||
| 4006 | \(not (or executing-kbd-macro noninteractive)). | ||
| 4007 | |||
| 4008 | The only known proper use of `interactive' for KIND is in deciding | ||
| 4009 | whether to display a helpful message, or how to display it. If you're | ||
| 4010 | thinking of using it for any other purpose, it is quite likely that | ||
| 4011 | you're making a mistake. Think: what do you want to do when the | ||
| 4012 | command is called from a keyboard macro?" | ||
| 4013 | (declare (advertised-calling-convention (kind) "23.1")) | ||
| 4014 | (when (not (and (eq kind 'interactive) | ||
| 4015 | (or executing-kbd-macro noninteractive))) | ||
| 4016 | (let* ((i 1) ;; 0 is the called-interactively-p frame. | ||
| 4017 | frame nextframe | ||
| 4018 | (get-next-frame | ||
| 4019 | (lambda () | ||
| 4020 | (setq frame nextframe) | ||
| 4021 | (setq nextframe (internal--called-interactively-p--get-frame i)) | ||
| 4022 | ;; (message "Frame %d = %S" i nextframe) | ||
| 4023 | (setq i (1+ i))))) | ||
| 4024 | (funcall get-next-frame) ;; Get the first frame. | ||
| 4025 | (while | ||
| 4026 | ;; FIXME: The edebug and advice handling should be made modular and | ||
| 4027 | ;; provided directly by edebug.el and nadvice.el. | ||
| 4028 | (progn | ||
| 4029 | ;; frame =(backtrace-frame i-2) | ||
| 4030 | ;; nextframe=(backtrace-frame i-1) | ||
| 4031 | (funcall get-next-frame) | ||
| 4032 | ;; `pcase' would be a fairly good fit here, but it sometimes moves | ||
| 4033 | ;; branches within local functions, which then messes up the | ||
| 4034 | ;; `backtrace-frame' data we get, | ||
| 4035 | (or | ||
| 4036 | ;; Skip special forms (from non-compiled code). | ||
| 4037 | (and frame (null (car frame))) | ||
| 4038 | ;; Skip also `interactive-p' (because we don't want to know if | ||
| 4039 | ;; interactive-p was called interactively but if it's caller was) | ||
| 4040 | ;; and `byte-code' (idem; this appears in subexpressions of things | ||
| 4041 | ;; like condition-case, which are wrapped in a separate bytecode | ||
| 4042 | ;; chunk). | ||
| 4043 | ;; FIXME: For lexical-binding code, this is much worse, | ||
| 4044 | ;; because the frames look like "byte-code -> funcall -> #[...]", | ||
| 4045 | ;; which is not a reliable signature. | ||
| 4046 | (memq (nth 1 frame) '(interactive-p 'byte-code)) | ||
| 4047 | ;; Skip package-specific stack-frames. | ||
| 4048 | (let ((skip (run-hook-with-args-until-success | ||
| 4049 | 'called-interactively-p-functions | ||
| 4050 | i frame nextframe))) | ||
| 4051 | (pcase skip | ||
| 4052 | (`nil nil) | ||
| 4053 | (`0 t) | ||
| 4054 | (_ (setq i (+ i skip -1)) (funcall get-next-frame))))))) | ||
| 4055 | ;; Now `frame' should be "the function from which we were called". | ||
| 4056 | (pcase (cons frame nextframe) | ||
| 4057 | ;; No subr calls `interactive-p', so we can rule that out. | ||
| 4058 | (`((,_ ,(pred (lambda (f) (subrp (indirect-function f)))) . ,_) . ,_) nil) | ||
| 4059 | ;; Somehow, I sometimes got `command-execute' rather than | ||
| 4060 | ;; `call-interactively' on my stacktrace !? | ||
| 4061 | ;;(`(,_ . (t command-execute . ,_)) t) | ||
| 4062 | (`(,_ . (t call-interactively . ,_)) t))))) | ||
| 4063 | |||
| 4064 | (defun interactive-p () | ||
| 4065 | "Return t if the containing function was run directly by user input. | ||
| 4066 | This means that the function was called with `call-interactively' | ||
| 4067 | \(which includes being called as the binding of a key) | ||
| 4068 | and input is currently coming from the keyboard (not a keyboard macro), | ||
| 4069 | and Emacs is not running in batch mode (`noninteractive' is nil). | ||
| 4070 | |||
| 4071 | The only known proper use of `interactive-p' is in deciding whether to | ||
| 4072 | display a helpful message, or how to display it. If you're thinking | ||
| 4073 | of using it for any other purpose, it is quite likely that you're | ||
| 4074 | making a mistake. Think: what do you want to do when the command is | ||
| 4075 | called from a keyboard macro or in batch mode? | ||
| 4076 | |||
| 4077 | To test whether your function was called with `call-interactively', | ||
| 4078 | either (i) add an extra optional argument and give it an `interactive' | ||
| 4079 | spec that specifies non-nil unconditionally (such as \"p\"); or (ii) | ||
| 4080 | use `called-interactively-p'." | ||
| 4081 | (declare (obsolete called-interactively-p "23.2")) | ||
| 4082 | (called-interactively-p 'interactive)) | ||
| 4083 | |||
| 4084 | (defun function-arity (f &optional num) | ||
| 4085 | "Return the (MIN . MAX) arity of F. | ||
| 4086 | If the maximum arity is infinite, MAX is `many'. | ||
| 4087 | F can be a function or a macro. | ||
| 4088 | If NUM is non-nil, return non-nil iff F can be called with NUM args." | ||
| 4089 | (if (symbolp f) (setq f (indirect-function f))) | ||
| 4090 | (if (eq (car-safe f) 'macro) (setq f (cdr f))) | ||
| 4091 | (let ((res | ||
| 4092 | (if (subrp f) | ||
| 4093 | (let ((x (subr-arity f))) | ||
| 4094 | (if (eq (cdr x) 'unevalled) (cons (car x) 'many))) | ||
| 4095 | (let* ((args (if (consp f) (cadr f) (aref f 0))) | ||
| 4096 | (max (length args)) | ||
| 4097 | (opt (memq '&optional args)) | ||
| 4098 | (rest (memq '&rest args)) | ||
| 4099 | (min (- max (length opt)))) | ||
| 4100 | (if opt | ||
| 4101 | (cons min (if rest 'many (1- max))) | ||
| 4102 | (if rest | ||
| 4103 | (cons (- max (length rest)) 'many) | ||
| 4104 | (cons min max))))))) | ||
| 4105 | (if (not num) | ||
| 4106 | res | ||
| 4107 | (and (>= num (car res)) | ||
| 4108 | (or (eq 'many (cdr res)) (<= num (cdr res))))))) | ||
| 4109 | |||
| 3966 | (defun set-temporary-overlay-map (map &optional keep-pred) | 4110 | (defun set-temporary-overlay-map (map &optional keep-pred) |
| 3967 | "Set MAP as a temporary keymap taking precedence over most other keymaps. | 4111 | "Set MAP as a temporary keymap taking precedence over most other keymaps. |
| 3968 | Note that this does NOT take precedence over the \"overriding\" maps | 4112 | Note that this does NOT take precedence over the \"overriding\" maps |
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 42e09b65750..95dab10101b 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el | |||
| @@ -91,7 +91,7 @@ | |||
| 91 | (declare-function w32-send-sys-command "w32fns.c") | 91 | (declare-function w32-send-sys-command "w32fns.c") |
| 92 | (declare-function set-message-beep "w32fns.c") | 92 | (declare-function set-message-beep "w32fns.c") |
| 93 | 93 | ||
| 94 | (declare-function cygwin-convert-path-from-windows "cygw32.c" | 94 | (declare-function cygwin-convert-file-name-from-windows "cygw32.c" |
| 95 | (path &optional absolute_p)) | 95 | (path &optional absolute_p)) |
| 96 | 96 | ||
| 97 | ;; Conditional on new-fontset so bootstrapping works on non-GUI compiles | 97 | ;; Conditional on new-fontset so bootstrapping works on non-GUI compiles |
| @@ -108,7 +108,7 @@ | |||
| 108 | 108 | ||
| 109 | (defun w32-handle-dropped-file (window file-name) | 109 | (defun w32-handle-dropped-file (window file-name) |
| 110 | (let ((f (if (eq system-type 'cygwin) | 110 | (let ((f (if (eq system-type 'cygwin) |
| 111 | (cygwin-convert-path-from-windows file-name t) | 111 | (cygwin-convert-file-name-from-windows file-name t) |
| 112 | (subst-char-in-string ?\\ ?/ file-name))) | 112 | (subst-char-in-string ?\\ ?/ file-name))) |
| 113 | (coding (or file-name-coding-system | 113 | (coding (or file-name-coding-system |
| 114 | default-file-name-coding-system))) | 114 | default-file-name-coding-system))) |
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index 3d9f88a43c9..6db15b7ec2a 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el | |||
| @@ -5210,7 +5210,7 @@ instead of the current buffer and returns the OBJECT." | |||
| 5210 | "Update cell face according to the current mode." | 5210 | "Update cell face according to the current mode." |
| 5211 | (if (featurep 'xemacs) | 5211 | (if (featurep 'xemacs) |
| 5212 | (set-face-property 'table-cell 'underline table-fixed-width-mode) | 5212 | (set-face-property 'table-cell 'underline table-fixed-width-mode) |
| 5213 | (set-face-inverse-video-p 'table-cell table-fixed-width-mode))) | 5213 | (set-face-inverse-video 'table-cell table-fixed-width-mode))) |
| 5214 | 5214 | ||
| 5215 | (table--update-cell-face) | 5215 | (table--update-cell-face) |
| 5216 | 5216 | ||
diff --git a/lisp/uniquify.el b/lisp/uniquify.el index 3619d499419..2b4794c9cc2 100644 --- a/lisp/uniquify.el +++ b/lisp/uniquify.el | |||
| @@ -183,10 +183,9 @@ contains the name of the directory which the buffer is visiting.") | |||
| 183 | ;; Internal variables used free | 183 | ;; Internal variables used free |
| 184 | (defvar uniquify-possibly-resolvable nil) | 184 | (defvar uniquify-possibly-resolvable nil) |
| 185 | 185 | ||
| 186 | (defvar uniquify-managed nil | 186 | (defvar-local uniquify-managed nil |
| 187 | "Non-nil if the name of this buffer is managed by uniquify. | 187 | "Non-nil if the name of this buffer is managed by uniquify. |
| 188 | It actually holds the list of `uniquify-item's corresponding to the conflict.") | 188 | It actually holds the list of `uniquify-item's corresponding to the conflict.") |
| 189 | (make-variable-buffer-local 'uniquify-managed) | ||
| 190 | (put 'uniquify-managed 'permanent-local t) | 189 | (put 'uniquify-managed 'permanent-local t) |
| 191 | 190 | ||
| 192 | ;; Used in desktop.el to save the non-uniquified buffer name | 191 | ;; Used in desktop.el to save the non-uniquified buffer name |
| @@ -464,27 +463,34 @@ For use on `kill-buffer-hook'." | |||
| 464 | ;; rename-buffer and create-file-buffer. (Setting find-file-hook isn't | 463 | ;; rename-buffer and create-file-buffer. (Setting find-file-hook isn't |
| 465 | ;; sufficient.) | 464 | ;; sufficient.) |
| 466 | 465 | ||
| 467 | (defadvice rename-buffer (after rename-buffer-uniquify activate) | 466 | (advice-add 'rename-buffer :around #'uniquify--rename-buffer-advice) |
| 467 | (defun uniquify--rename-buffer-advice (rb-fun newname &optional unique &rest args) | ||
| 468 | "Uniquify buffer names with parts of directory name." | 468 | "Uniquify buffer names with parts of directory name." |
| 469 | (let ((retval (apply rb-fun newname unique args))) | ||
| 469 | (uniquify-maybe-rerationalize-w/o-cb) | 470 | (uniquify-maybe-rerationalize-w/o-cb) |
| 470 | (if (null (ad-get-arg 1)) ; no UNIQUE argument. | 471 | (if (null unique) |
| 471 | ;; Mark this buffer so it won't be renamed by uniquify. | 472 | ;; Mark this buffer so it won't be renamed by uniquify. |
| 472 | (setq uniquify-managed nil) | 473 | (setq uniquify-managed nil) |
| 473 | (when uniquify-buffer-name-style | 474 | (when uniquify-buffer-name-style |
| 474 | ;; Rerationalize w.r.t the new name. | 475 | ;; Rerationalize w.r.t the new name. |
| 475 | (uniquify-rationalize-file-buffer-names | 476 | (uniquify-rationalize-file-buffer-names |
| 476 | (ad-get-arg 0) | 477 | newname |
| 477 | (uniquify-buffer-file-name (current-buffer)) | 478 | (uniquify-buffer-file-name (current-buffer)) |
| 478 | (current-buffer)) | 479 | (current-buffer)) |
| 479 | (setq ad-return-value (buffer-name (current-buffer)))))) | 480 | (setq retval (buffer-name (current-buffer))))) |
| 481 | retval)) | ||
| 480 | 482 | ||
| 481 | (defadvice create-file-buffer (after create-file-buffer-uniquify activate) | 483 | |
| 484 | (advice-add 'create-file-buffer :around #'uniquify--create-file-buffer-advice) | ||
| 485 | (defun uniquify--create-file-buffer-advice (cfb-fun filename &rest args) | ||
| 482 | "Uniquify buffer names with parts of directory name." | 486 | "Uniquify buffer names with parts of directory name." |
| 487 | (let ((retval (apply cfb-fun filename args))) | ||
| 483 | (if uniquify-buffer-name-style | 488 | (if uniquify-buffer-name-style |
| 484 | (let ((filename (expand-file-name (directory-file-name (ad-get-arg 0))))) | 489 | (let ((filename (expand-file-name (directory-file-name filename)))) |
| 485 | (uniquify-rationalize-file-buffer-names | 490 | (uniquify-rationalize-file-buffer-names |
| 486 | (file-name-nondirectory filename) | 491 | (file-name-nondirectory filename) |
| 487 | (file-name-directory filename) ad-return-value)))) | 492 | (file-name-directory filename) retval))) |
| 493 | retval)) | ||
| 488 | 494 | ||
| 489 | ;;; The End | 495 | ;;; The End |
| 490 | 496 | ||
| @@ -496,9 +502,8 @@ For use on `kill-buffer-hook'." | |||
| 496 | (set-buffer buf) | 502 | (set-buffer buf) |
| 497 | (when uniquify-managed | 503 | (when uniquify-managed |
| 498 | (push (cons buf (uniquify-item-base (car uniquify-managed))) buffers))) | 504 | (push (cons buf (uniquify-item-base (car uniquify-managed))) buffers))) |
| 499 | (dolist (fun '(rename-buffer create-file-buffer)) | 505 | (advice-remove 'rename-buffer #'uniquify--rename-buffer-advice) |
| 500 | (ad-remove-advice fun 'after (intern (concat (symbol-name fun) "-uniquify"))) | 506 | (advice-remove 'create-file-buffer #'uniquify--create-file-buffer-advice) |
| 501 | (ad-update fun)) | ||
| 502 | (dolist (buf buffers) | 507 | (dolist (buf buffers) |
| 503 | (set-buffer (car buf)) | 508 | (set-buffer (car buf)) |
| 504 | (rename-buffer (cdr buf) t)))) | 509 | (rename-buffer (cdr buf) t)))) |
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 26c64ce2ad3..0c023b0f7f4 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el | |||
| @@ -575,19 +575,21 @@ next hunk if TRY-HARDER is non-nil; otherwise signal an error." | |||
| 575 | (easy-mmode-define-navigation | 575 | (easy-mmode-define-navigation |
| 576 | diff-hunk diff-hunk-header-re "hunk" diff-end-of-hunk diff-restrict-view | 576 | diff-hunk diff-hunk-header-re "hunk" diff-end-of-hunk diff-restrict-view |
| 577 | (when diff-auto-refine-mode | 577 | (when diff-auto-refine-mode |
| 578 | (setq diff--auto-refine-data (cons (current-buffer) (point-marker))) | 578 | (unless (prog1 diff--auto-refine-data |
| 579 | (run-at-time 0.0 nil | 579 | (setq diff--auto-refine-data |
| 580 | (lambda () | 580 | (cons (current-buffer) (point-marker)))) |
| 581 | (when diff--auto-refine-data | 581 | (run-at-time 0.0 nil |
| 582 | (let ((buffer (car diff--auto-refine-data)) | 582 | (lambda () |
| 583 | (point (cdr diff--auto-refine-data))) | 583 | (when diff--auto-refine-data |
| 584 | (setq diff--auto-refine-data nil) | 584 | (let ((buffer (car diff--auto-refine-data)) |
| 585 | (with-local-quit | 585 | (point (cdr diff--auto-refine-data))) |
| 586 | (when (buffer-live-p buffer) | 586 | (setq diff--auto-refine-data nil) |
| 587 | (with-current-buffer buffer | 587 | (with-local-quit |
| 588 | (save-excursion | 588 | (when (buffer-live-p buffer) |
| 589 | (goto-char point) | 589 | (with-current-buffer buffer |
| 590 | (diff-refine-hunk))))))))))) | 590 | (save-excursion |
| 591 | (goto-char point) | ||
| 592 | (diff-refine-hunk)))))))))))) | ||
| 591 | 593 | ||
| 592 | (easy-mmode-define-navigation | 594 | (easy-mmode-define-navigation |
| 593 | diff-file diff-file-header-re "file" diff-end-of-file) | 595 | diff-file diff-file-header-re "file" diff-end-of-file) |
diff --git a/lisp/window.el b/lisp/window.el index d378ea5ff14..52909fa9e5f 100644 --- a/lisp/window.el +++ b/lisp/window.el | |||
| @@ -5870,7 +5870,12 @@ the selected window or never appeared in it before, or if | |||
| 5870 | :version "24.3") | 5870 | :version "24.3") |
| 5871 | 5871 | ||
| 5872 | (defun switch-to-buffer (buffer-or-name &optional norecord force-same-window) | 5872 | (defun switch-to-buffer (buffer-or-name &optional norecord force-same-window) |
| 5873 | "Switch to buffer BUFFER-OR-NAME in the selected window. | 5873 | "Display buffer BUFFER-OR-NAME in the selected window. |
| 5874 | |||
| 5875 | WARNING: This is NOT the way to work on another buffer temporarily | ||
| 5876 | within a Lisp program! Use `set-buffer' instead. That avoids | ||
| 5877 | messing with the window-buffer correspondences. | ||
| 5878 | |||
| 5874 | If the selected window cannot display the specified | 5879 | If the selected window cannot display the specified |
| 5875 | buffer (e.g. if it is a minibuffer window or strongly dedicated | 5880 | buffer (e.g. if it is a minibuffer window or strongly dedicated |
| 5876 | to another buffer), call `pop-to-buffer' to select the buffer in | 5881 | to another buffer), call `pop-to-buffer' to select the buffer in |
diff --git a/nt/ChangeLog b/nt/ChangeLog index 95203b9d2fa..ae6cb231614 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog | |||
| @@ -1,3 +1,34 @@ | |||
| 1 | 2012-11-23 Eli Zaretskii <eliz@gnu.org> | ||
| 2 | |||
| 3 | * gmake.defs (SWITCHCHAR): Define to // under MSYS, / otherwise. | ||
| 4 | (Bug#12955) | ||
| 5 | |||
| 6 | * nmake.defs (SWITCHCHAR): Define to /. | ||
| 7 | |||
| 8 | 2012-11-23 Paul Eggert <eggert@cs.ucla.edu> | ||
| 9 | |||
| 10 | Assume POSIX 1003.1-1988 or later for dirent.h (Bug#12958). | ||
| 11 | * inc/dirent.h: Rename from ../src/ndir.h, with these changes: | ||
| 12 | (struct dirent): Rename from struct direct. All uses changed. | ||
| 13 | * inc/sys/dir.h: Remove. | ||
| 14 | |||
| 15 | 2012-11-21 Paul Eggert <eggert@cs.ucla.edu> | ||
| 16 | |||
| 17 | Assume POSIX 1003.1-1988 or later for unistd.h (Bug#12945). | ||
| 18 | * config.nt (HAVE_GETCWD): Remove. | ||
| 19 | |||
| 20 | 2012-11-21 Eli Zaretskii <eliz@gnu.org> | ||
| 21 | |||
| 22 | * nmake.defs: Use !if, not !ifdef. For the details, see | ||
| 23 | http://lists.gnu.org/archive/html/help-emacs-windows/2012-11/msg00027.html | ||
| 24 | |||
| 25 | * inc/stdint.h (INTPTR_MIN): | ||
| 26 | (PTRDIFF_MIN) [!__GNUC__]: Define for MSVC. | ||
| 27 | |||
| 28 | 2012-11-18 Eli Zaretskii <eliz@gnu.org> | ||
| 29 | |||
| 30 | * inc/unistd.h: Don't include fcntl.h and don't define O_RDWR. | ||
| 31 | |||
| 1 | 2012-11-17 Juanma Barranquero <lekktu@gmail.com> | 32 | 2012-11-17 Juanma Barranquero <lekktu@gmail.com> |
| 2 | 33 | ||
| 3 | * config.nt: Sync with autogen/config.in. | 34 | * config.nt: Sync with autogen/config.in. |
diff --git a/nt/config.nt b/nt/config.nt index 57c18ad2789..1adcbca89be 100644 --- a/nt/config.nt +++ b/nt/config.nt | |||
| @@ -411,12 +411,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 411 | /* Define to 1 if you have the `getaddrinfo' function. */ | 411 | /* Define to 1 if you have the `getaddrinfo' function. */ |
| 412 | #undef HAVE_GETADDRINFO | 412 | #undef HAVE_GETADDRINFO |
| 413 | 413 | ||
| 414 | /* Define to 1 if you have the `getcwd' function. | ||
| 415 | If you think about defining HAVE_GETCWD, don't: the alternative | ||
| 416 | getwd is redefined on w32.c, and does not really return the current | ||
| 417 | directory, to get the desired results elsewhere in Emacs. */ | ||
| 418 | #undef HAVE_GETCWD | ||
| 419 | |||
| 420 | /* Define to 1 if you have the `getdelim' function. */ | 414 | /* Define to 1 if you have the `getdelim' function. */ |
| 421 | #undef HAVE_GETDELIM | 415 | #undef HAVE_GETDELIM |
| 422 | 416 | ||
diff --git a/nt/gmake.defs b/nt/gmake.defs index 358c262db28..3d545fab975 100644 --- a/nt/gmake.defs +++ b/nt/gmake.defs | |||
| @@ -69,10 +69,18 @@ sh_output := $(shell echo) | |||
| 69 | ifeq "$(findstring ECHO, $(sh_output))" "ECHO" | 69 | ifeq "$(findstring ECHO, $(sh_output))" "ECHO" |
| 70 | THE_SHELL = $(COMSPEC)$(ComSpec) | 70 | THE_SHELL = $(COMSPEC)$(ComSpec) |
| 71 | SHELLTYPE=CMD | 71 | SHELLTYPE=CMD |
| 72 | SWITCHCHAR=/ | ||
| 72 | else | 73 | else |
| 73 | USING_SH = 1 | 74 | USING_SH = 1 |
| 74 | THE_SHELL = $(SHELL) | 75 | THE_SHELL = $(SHELL) |
| 75 | SHELLTYPE=SH | 76 | SHELLTYPE=SH |
| 77 | # MSYS needs to double the slash in cmd-style switches to avoid | ||
| 78 | # interpreting /x as a Posix style file name reference | ||
| 79 | ifneq ($(MSYSTEM),) | ||
| 80 | SWITCHCHAR=// | ||
| 81 | else | ||
| 82 | SWITCHCHAR=/ | ||
| 83 | endif | ||
| 76 | endif | 84 | endif |
| 77 | 85 | ||
| 78 | MAKETYPE=gmake | 86 | MAKETYPE=gmake |
diff --git a/src/ndir.h b/nt/inc/dirent.h index cd7cdbe55f5..618f3beddf0 100644 --- a/src/ndir.h +++ b/nt/inc/dirent.h | |||
| @@ -1,7 +1,5 @@ | |||
| 1 | /* | 1 | /* |
| 2 | <dir.h> -- definitions for 4.2BSD-compatible directory access | 2 | <dirent.h> -- definitions for POSIX-compatible directory access |
| 3 | |||
| 4 | last edit: 09-Jul-1983 D A Gwyn | ||
| 5 | 3 | ||
| 6 | * The code here is forced by the interface, and is not subject to | 4 | * The code here is forced by the interface, and is not subject to |
| 7 | * copyright, constituting the only possible expression of the | 5 | * copyright, constituting the only possible expression of the |
| @@ -16,7 +14,7 @@ | |||
| 16 | #endif /* not WINDOWSNT */ | 14 | #endif /* not WINDOWSNT */ |
| 17 | /* NOTE: MAXNAMLEN must be one less than a multiple of 4 */ | 15 | /* NOTE: MAXNAMLEN must be one less than a multiple of 4 */ |
| 18 | 16 | ||
| 19 | struct direct /* data from readdir() */ | 17 | struct dirent /* data from readdir() */ |
| 20 | { | 18 | { |
| 21 | long d_ino; /* inode number of entry */ | 19 | long d_ino; /* inode number of entry */ |
| 22 | unsigned short d_reclen; /* length of this record */ | 20 | unsigned short d_reclen; /* length of this record */ |
| @@ -33,9 +31,8 @@ typedef struct | |||
| 33 | } DIR; /* stream data from opendir() */ | 31 | } DIR; /* stream data from opendir() */ |
| 34 | 32 | ||
| 35 | extern DIR *opendir (char *); | 33 | extern DIR *opendir (char *); |
| 36 | extern struct direct *readdir (DIR *); | 34 | extern struct dirent *readdir (DIR *); |
| 37 | extern void seekdir (DIR *, long); | 35 | extern void seekdir (DIR *, long); |
| 38 | extern void closedir (DIR *); | 36 | extern void closedir (DIR *); |
| 39 | 37 | ||
| 40 | #define rewinddir( dirp ) seekdir( dirp, 0L ) | 38 | #define rewinddir( dirp ) seekdir( dirp, 0L ) |
| 41 | |||
diff --git a/nt/inc/stdint.h b/nt/inc/stdint.h index 5c53fa18b55..97c9bbdaee9 100644 --- a/nt/inc/stdint.h +++ b/nt/inc/stdint.h | |||
| @@ -37,6 +37,7 @@ typedef unsigned __int64 uint64_t; | |||
| 37 | #define INT64_MAX 9223372036854775807i64 | 37 | #define INT64_MAX 9223372036854775807i64 |
| 38 | #define INT64_MIN (~INT64_MAX) | 38 | #define INT64_MIN (~INT64_MAX) |
| 39 | #define INTPTR_MAX INT64_MAX | 39 | #define INTPTR_MAX INT64_MAX |
| 40 | #define INTPTR_MIN INT64_MIN | ||
| 40 | #define UINTMAX_MAX UINT64_MAX | 41 | #define UINTMAX_MAX UINT64_MAX |
| 41 | #define UINTMAX_MIN UINT64_MIN | 42 | #define UINTMAX_MIN UINT64_MIN |
| 42 | #define INTMAX_MAX INT64_MAX | 43 | #define INTMAX_MAX INT64_MAX |
| @@ -51,6 +52,7 @@ typedef unsigned int uint32_t; | |||
| 51 | #define INT32_MAX 2147483647 | 52 | #define INT32_MAX 2147483647 |
| 52 | #define INT32_MIN (~INT32_MAX) | 53 | #define INT32_MIN (~INT32_MAX) |
| 53 | #define INTPTR_MAX INT32_MAX | 54 | #define INTPTR_MAX INT32_MAX |
| 55 | #define INTPTR_MIN INT32_MIN | ||
| 54 | #define UINTMAX_MAX UINT32_MAX | 56 | #define UINTMAX_MAX UINT32_MAX |
| 55 | #define UINTMAX_MIN UINT32_MIN | 57 | #define UINTMAX_MIN UINT32_MIN |
| 56 | #define INTMAX_MAX INT32_MAX | 58 | #define INTMAX_MAX INT32_MAX |
| @@ -60,6 +62,7 @@ typedef unsigned int uint32_t; | |||
| 60 | #endif | 62 | #endif |
| 61 | 63 | ||
| 62 | #define PTRDIFF_MAX INTPTR_MAX | 64 | #define PTRDIFF_MAX INTPTR_MAX |
| 65 | #define PTRDIFF_MIN INTPTR_MIN | ||
| 63 | 66 | ||
| 64 | #endif /* !__GNUC__ */ | 67 | #endif /* !__GNUC__ */ |
| 65 | 68 | ||
diff --git a/nt/inc/sys/dir.h b/nt/inc/sys/dir.h deleted file mode 100644 index dc075cd7587..00000000000 --- a/nt/inc/sys/dir.h +++ /dev/null | |||
| @@ -1,6 +0,0 @@ | |||
| 1 | /* | ||
| 2 | * map sys\dir.h to ..\..\..\src\ndir.h | ||
| 3 | */ | ||
| 4 | |||
| 5 | #include "..\..\..\src\ndir.h" | ||
| 6 | |||
diff --git a/nt/inc/unistd.h b/nt/inc/unistd.h index 0173fdbb943..e751ed124d3 100644 --- a/nt/inc/unistd.h +++ b/nt/inc/unistd.h | |||
| @@ -26,17 +26,6 @@ extern int faccessat (int, char const *, int, int); | |||
| 26 | #define AT_EACCESS 4 | 26 | #define AT_EACCESS 4 |
| 27 | #define AT_SYMLINK_NOFOLLOW 4096 | 27 | #define AT_SYMLINK_NOFOLLOW 4096 |
| 28 | 28 | ||
| 29 | /* Here are some more fcntl.h macros that default to gnulib-compatible | ||
| 30 | values. Include <fcntl.h> first, to make sure we don't override | ||
| 31 | its values if any. FIXME: If we know <fcntl.h> does not define | ||
| 32 | O_NOCTTY and O_RDWR, this can be replaced with a simple "#define | ||
| 33 | O_NOCTTY 0" and "#define O_RDWR 2". */ | ||
| 34 | #include <fcntl.h> | ||
| 35 | #ifndef O_NOCTTY | ||
| 36 | #define O_NOCTTY 0 | 29 | #define O_NOCTTY 0 |
| 37 | #endif | ||
| 38 | #ifndef O_RDWR | ||
| 39 | #define O_RDWR 2 | ||
| 40 | #endif | ||
| 41 | 30 | ||
| 42 | #endif /* _UNISTD_H */ | 31 | #endif /* _UNISTD_H */ |
diff --git a/nt/nmake.defs b/nt/nmake.defs index 48809afc771..2c6bc66b673 100644 --- a/nt/nmake.defs +++ b/nt/nmake.defs | |||
| @@ -22,6 +22,7 @@ all: | |||
| 22 | 22 | ||
| 23 | THE_SHELL = $(COMSPEC) | 23 | THE_SHELL = $(COMSPEC) |
| 24 | SHELLTYPE=CMD | 24 | SHELLTYPE=CMD |
| 25 | SWITCHCHAR=/ | ||
| 25 | 26 | ||
| 26 | MAKETYPE=nmake | 27 | MAKETYPE=nmake |
| 27 | 28 | ||
| @@ -116,7 +117,7 @@ RC_INCLUDE = -i | |||
| 116 | 117 | ||
| 117 | USE_CRT_DLL = 1 | 118 | USE_CRT_DLL = 1 |
| 118 | 119 | ||
| 119 | !ifdef USE_CRT_DLL | 120 | !if USE_CRT_DLL |
| 120 | libc = msvcrt$(D).lib | 121 | libc = msvcrt$(D).lib |
| 121 | EMACS_EXTRA_C_FLAGS= -D_DLL -D_MT -DUSE_CRT_DLL=1 | 122 | EMACS_EXTRA_C_FLAGS= -D_DLL -D_MT -DUSE_CRT_DLL=1 |
| 122 | !else | 123 | !else |
diff --git a/src/ChangeLog b/src/ChangeLog index 6dcddea2e63..c230b4bef24 100644 --- a/src/ChangeLog +++ b/src/ChangeLog | |||
| @@ -8,6 +8,140 @@ | |||
| 8 | * font.c (font_unparse_xlfd): Exclude special characters from the | 8 | * font.c (font_unparse_xlfd): Exclude special characters from the |
| 9 | generating XLFD name. | 9 | generating XLFD name. |
| 10 | 10 | ||
| 11 | 2012-11-23 Eli Zaretskii <eliz@gnu.org> | ||
| 12 | |||
| 13 | * makefile.w32-in (globals.h, gl-stamp): Use $(SWITCHCHAR) instead | ||
| 14 | of a literal "/". (Bug#12955) | ||
| 15 | (gl-stamp): Invoke fc.exe directly, not through cmd. | ||
| 16 | |||
| 17 | 2012-11-23 Paul Eggert <eggert@cs.ucla.edu> | ||
| 18 | |||
| 19 | Assume POSIX 1003.1-1988 or later for dirent.h (Bug#12958). | ||
| 20 | * dired.c: Assume HAVE_DIRENT_H. | ||
| 21 | (NAMLEN): Remove, replacing with ... | ||
| 22 | (dirent_namelen): New function. All uses changed. Use the GNU macro | ||
| 23 | _D_EXACT_NAMELEN if available, as it's faster than strlen. | ||
| 24 | (DIRENTRY): Remove, replacing all uses with 'struct dirent'. | ||
| 25 | (DIRENTRY_NONEMPTY): Remove. All callers now assume it's nonzero. | ||
| 26 | * makefile.w32-in (DIR_H): Remove. All uses replaced with | ||
| 27 | $(NT_INC)/dirent.h. | ||
| 28 | ($(BLD)/w32.$(O)): Do not depend on $(SRC)/ndir.h. | ||
| 29 | * ndir.h: Rename to ../nt/inc/dirent.h. | ||
| 30 | * sysdep.h (closedir) [!HAVE_CLOSEDIR]: Remove. | ||
| 31 | Do not include <dirent.h>; no longer needed. | ||
| 32 | * w32.c: Include <dirent.h> rather than "ndir.h". | ||
| 33 | |||
| 34 | 2012-11-23 Chong Yidong <cyd@gnu.org> | ||
| 35 | |||
| 36 | * xftfont.c (xftfont_open): Remove duplicate assignment. | ||
| 37 | |||
| 38 | 2012-11-22 Dmitry Antipov <dmantipov@yandex.ru> | ||
| 39 | |||
| 40 | * alloc.c (Fgarbage_collect): Unblock input after clearing | ||
| 41 | gc_in_progress to avoid note_mouse_highlight glitch with GC. | ||
| 42 | * frame.h (FRAME_MOUSE_UPDATE): New macro. | ||
| 43 | * msdos.c (IT_frame_up_to_date): Use it here... | ||
| 44 | * w32term.c (w32_frame_up_to_date): ...here... | ||
| 45 | * xterm.c (XTframe_up_to_date): ...and here... | ||
| 46 | * nsterm.m (ns_frame_up_to_date): ...but not here. | ||
| 47 | * lisp.h (Mouse_HLInfo): Remove mouse_face_deferred_gc member. | ||
| 48 | Adjust users. | ||
| 49 | * xdisp.c (message2_nolog, message3_nolog, note_mouse_highlight): | ||
| 50 | Do not check whether GC is in progress. | ||
| 51 | |||
| 52 | 2012-11-22 Dmitry Antipov <dmantipov@yandex.ru> | ||
| 53 | |||
| 54 | * xdisp.c (window_buffer_changed): New function. | ||
| 55 | (update_menu_bar, update_tool_bar): Use it to | ||
| 56 | simplify large 'if' statements. | ||
| 57 | (redisplay_internal): Generalize commonly used | ||
| 58 | 'tail' and 'frame' local variables. | ||
| 59 | |||
| 60 | 2012-11-22 Eli Zaretskii <eliz@gnu.org> | ||
| 61 | |||
| 62 | * w32.c (getcwd): Fix the 2nd argument type, to prevent conflicts | ||
| 63 | with Windows system header. | ||
| 64 | |||
| 65 | 2012-11-21 Paul Eggert <eggert@cs.ucla.edu> | ||
| 66 | |||
| 67 | Assume POSIX 1003.1-1988 or later for unistd.h (Bug#12945). | ||
| 68 | * alloc.c: Assume unistd.h exists. | ||
| 69 | * fileio.c (Fexpand_file_name) [DOS_NT]: Use getcwd, not getwd. | ||
| 70 | * sysdep.c (get_current_dir_name): Assume getcwd exists. | ||
| 71 | (getwd) [USG]: Remove; no longer needed. | ||
| 72 | (sys_subshell) [DOS_NT]: Use getcwd, not getwd. | ||
| 73 | * w32.c (getcwd): Rename from getwd, and switch to getcwd's API. | ||
| 74 | * w32.h (getcwd): Remove decl. | ||
| 75 | |||
| 76 | 2012-11-21 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 77 | |||
| 78 | * xdisp.c (fast_set_selected_frame): Rename from update_tool_bar_unwind. | ||
| 79 | Make it set selected_window as well. | ||
| 80 | (update_tool_bar): Use it. | ||
| 81 | |||
| 82 | 2012-11-21 Ken Brown <kbrown@cornell.edu> | ||
| 83 | |||
| 84 | * emacs.c (main): Set the G_SLICE environment variable for all | ||
| 85 | Cygwin builds, not just GTK builds. See | ||
| 86 | https://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00368.html. | ||
| 87 | |||
| 88 | 2012-11-21 Eli Zaretskii <eliz@gnu.org> | ||
| 89 | |||
| 90 | * w32.c (FILE_DEVICE_FILE_SYSTEM, METHOD_BUFFERED) | ||
| 91 | (FILE_ANY_ACCESS, CTL_CODE, FSCTL_GET_REPARSE_POINT) [_MSC_VER]: | ||
| 92 | Define for the MSVC compiler. | ||
| 93 | |||
| 94 | * w32term.h (EnumSystemLocalesW) [_MSC_VER]: Add a missing semi-colon. | ||
| 95 | |||
| 96 | * fileio.c (Fsubstitute_in_file_name, Ffile_name_directory) | ||
| 97 | (Fexpand_file_name) [DOS_NT]: Pass encoded file name to | ||
| 98 | dostounix_filename. Prevents crashes down the road, because | ||
| 99 | dostounix_filename assumes it gets a unibyte string. Reported by | ||
| 100 | Michel de Ruiter <michel@sentient.nl>, see | ||
| 101 | http://lists.gnu.org/archive/html/help-emacs-windows/2012-11/msg00017.html | ||
| 102 | |||
| 103 | 2012-11-20 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 104 | |||
| 105 | Conflate Qnil and Qunbound for `symbol-function'. | ||
| 106 | * alloc.c (Fmake_symbol): Initialize `function' to Qnil. | ||
| 107 | * lread.c (init_obarray): Set `function' fields to Qnil. | ||
| 108 | * eval.c (Fcommandp): Ignore Qunbound. | ||
| 109 | (Fautoload, eval_sub, Fapply, Ffuncall, Fmacroexpand): | ||
| 110 | * data.c (Ffset, Ffboundp, indirect_function, Findirect_function): | ||
| 111 | Test NILP rather than Qunbound. | ||
| 112 | (Ffmakunbound): Set to Qnil. | ||
| 113 | (Fsymbol_function): Never signal an error. | ||
| 114 | (Finteractive_form): Ignore Qunbound. | ||
| 115 | |||
| 116 | 2012-11-20 Paul Eggert <eggert@cs.ucla.edu> | ||
| 117 | |||
| 118 | * eval.c (interactive_p): Remove no-longer-used decl. | ||
| 119 | |||
| 120 | 2012-11-20 Dmitry Antipov <dmantipov@yandex.ru> | ||
| 121 | |||
| 122 | * xdisp.c (buffer_shared): Adjust comment. | ||
| 123 | (buffer_shared_and_changed): New function. | ||
| 124 | (prepare_menu_bars, redisplay_internal): Use it to | ||
| 125 | decide whether all windows or frames should be updated. | ||
| 126 | (window_outdated): New function. | ||
| 127 | (text_outside_line_unchanged_p, redisplay_window): Use it. | ||
| 128 | (redisplay_internal): Likewise. Fix indentation. | ||
| 129 | |||
| 130 | 2012-11-20 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 131 | |||
| 132 | * eval.c (Finteractive_p, Fcalled_interactively_p, interactive_p): Remove. | ||
| 133 | (syms_of_eval): Remove corresponding defsubr. | ||
| 134 | * bytecode.c (exec_byte_code): `interactive-p' is now a Lisp function. | ||
| 135 | |||
| 136 | 2012-11-19 Daniel Colascione <dancol@dancol.org> | ||
| 137 | |||
| 138 | * w32fns.c (Fx_file_dialog): | ||
| 139 | (Fx_file_dialog): Accomodate rename of cygwin_convert_path* to | ||
| 140 | cygwin_convert_file_name*. | ||
| 141 | |||
| 142 | * cygw32.c (Fcygwin_convert_path_to_windows, syms_of_cygw32): | ||
| 143 | Rename cygwin_convert_path* to cygwin_convert_file_name*. | ||
| 144 | |||
| 11 | 2012-11-18 Paul Eggert <eggert@cs.ucla.edu> | 145 | 2012-11-18 Paul Eggert <eggert@cs.ucla.edu> |
| 12 | 146 | ||
| 13 | * nsterm.m (ns_select): Send SIGIO only to self, not to process group. | 147 | * nsterm.m (ns_select): Send SIGIO only to self, not to process group. |
| @@ -18,10 +152,10 @@ | |||
| 18 | windows.h gets included before w32term.h uses some of its | 152 | windows.h gets included before w32term.h uses some of its |
| 19 | features, see below. | 153 | features, see below. |
| 20 | 154 | ||
| 21 | * w32term.h (LOCALE_ENUMPROCA, LOCALE_ENUMPROCW) [_MSC_VER]: New | 155 | * w32term.h (LOCALE_ENUMPROCA, LOCALE_ENUMPROCW) [_MSC_VER]: |
| 22 | typedefs. | 156 | New typedefs. |
| 23 | (EnumSystemLocalesA, EnumSystemLocalesW) [_MSC_VER]: New | 157 | (EnumSystemLocalesA, EnumSystemLocalesW) [_MSC_VER]: |
| 24 | prototypes. | 158 | New prototypes. |
| 25 | (EnumSystemLocales) [_MSC_VER]: Define if undefined. (Bug#12878) | 159 | (EnumSystemLocales) [_MSC_VER]: Define if undefined. (Bug#12878) |
| 26 | 160 | ||
| 27 | 2012-11-18 Jan Djärv <jan.h.d@swipnet.se> | 161 | 2012-11-18 Jan Djärv <jan.h.d@swipnet.se> |
| @@ -313,8 +447,8 @@ | |||
| 313 | * xdisp.c (try_scrolling): Fix correction of aggressive-scroll | 447 | * xdisp.c (try_scrolling): Fix correction of aggressive-scroll |
| 314 | amount when the scroll margins are too large. When scrolling | 448 | amount when the scroll margins are too large. When scrolling |
| 315 | backwards in the buffer, give up if cannot reach point or the | 449 | backwards in the buffer, give up if cannot reach point or the |
| 316 | scroll margin within a reasonable number of screen lines. Fixes | 450 | scroll margin within a reasonable number of screen lines. |
| 317 | point position in window under scroll-up/down-aggressively when | 451 | Fixes point position in window under scroll-up/down-aggressively when |
| 318 | point is positioned many lines beyond the window top/bottom. | 452 | point is positioned many lines beyond the window top/bottom. |
| 319 | (Bug#12811) | 453 | (Bug#12811) |
| 320 | 454 | ||
diff --git a/src/alloc.c b/src/alloc.c index a66a752f5dc..28c9b51dab4 100644 --- a/src/alloc.c +++ b/src/alloc.c | |||
| @@ -63,10 +63,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 63 | #endif | 63 | #endif |
| 64 | 64 | ||
| 65 | #include <unistd.h> | 65 | #include <unistd.h> |
| 66 | #ifndef HAVE_UNISTD_H | ||
| 67 | extern void *sbrk (); | ||
| 68 | #endif | ||
| 69 | |||
| 70 | #include <fcntl.h> | 66 | #include <fcntl.h> |
| 71 | 67 | ||
| 72 | #ifdef USE_GTK | 68 | #ifdef USE_GTK |
| @@ -3212,7 +3208,7 @@ static struct Lisp_Symbol *symbol_free_list; | |||
| 3212 | 3208 | ||
| 3213 | DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, | 3209 | DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, |
| 3214 | doc: /* Return a newly allocated uninterned symbol whose name is NAME. | 3210 | doc: /* Return a newly allocated uninterned symbol whose name is NAME. |
| 3215 | Its value and function definition are void, and its property list is nil. */) | 3211 | Its value is void, and its function definition and property list are nil. */) |
| 3216 | (Lisp_Object name) | 3212 | (Lisp_Object name) |
| 3217 | { | 3213 | { |
| 3218 | register Lisp_Object val; | 3214 | register Lisp_Object val; |
| @@ -3249,7 +3245,7 @@ Its value and function definition are void, and its property list is nil. */) | |||
| 3249 | set_symbol_plist (val, Qnil); | 3245 | set_symbol_plist (val, Qnil); |
| 3250 | p->redirect = SYMBOL_PLAINVAL; | 3246 | p->redirect = SYMBOL_PLAINVAL; |
| 3251 | SET_SYMBOL_VAL (p, Qunbound); | 3247 | SET_SYMBOL_VAL (p, Qunbound); |
| 3252 | set_symbol_function (val, Qunbound); | 3248 | set_symbol_function (val, Qnil); |
| 3253 | set_symbol_next (val, NULL); | 3249 | set_symbol_next (val, NULL); |
| 3254 | p->gcmarkbit = 0; | 3250 | p->gcmarkbit = 0; |
| 3255 | p->interned = SYMBOL_UNINTERNED; | 3251 | p->interned = SYMBOL_UNINTERNED; |
| @@ -5335,12 +5331,12 @@ See Info node `(elisp)Garbage Collection'. */) | |||
| 5335 | dump_zombies (); | 5331 | dump_zombies (); |
| 5336 | #endif | 5332 | #endif |
| 5337 | 5333 | ||
| 5338 | unblock_input (); | ||
| 5339 | |||
| 5340 | check_cons_list (); | 5334 | check_cons_list (); |
| 5341 | 5335 | ||
| 5342 | gc_in_progress = 0; | 5336 | gc_in_progress = 0; |
| 5343 | 5337 | ||
| 5338 | unblock_input (); | ||
| 5339 | |||
| 5344 | consing_since_gc = 0; | 5340 | consing_since_gc = 0; |
| 5345 | if (gc_cons_threshold < GC_DEFAULT_THRESHOLD / 10) | 5341 | if (gc_cons_threshold < GC_DEFAULT_THRESHOLD / 10) |
| 5346 | gc_cons_threshold = GC_DEFAULT_THRESHOLD / 10; | 5342 | gc_cons_threshold = GC_DEFAULT_THRESHOLD / 10; |
diff --git a/src/bytecode.c b/src/bytecode.c index 648813aed86..3267c7c8c76 100644 --- a/src/bytecode.c +++ b/src/bytecode.c | |||
| @@ -1579,7 +1579,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 1579 | NEXT; | 1579 | NEXT; |
| 1580 | 1580 | ||
| 1581 | CASE (Binteractive_p): /* Obsolete since 24.1. */ | 1581 | CASE (Binteractive_p): /* Obsolete since 24.1. */ |
| 1582 | PUSH (Finteractive_p ()); | 1582 | BEFORE_POTENTIAL_GC (); |
| 1583 | PUSH (call0 (intern ("interactive-p"))); | ||
| 1584 | AFTER_POTENTIAL_GC (); | ||
| 1583 | NEXT; | 1585 | NEXT; |
| 1584 | 1586 | ||
| 1585 | CASE (Bforward_char): | 1587 | CASE (Bforward_char): |
diff --git a/src/cygw32.c b/src/cygw32.c index 54f2076a891..d9777d5e22e 100644 --- a/src/cygw32.c +++ b/src/cygw32.c | |||
| @@ -106,22 +106,24 @@ conv_filename_from_w32_unicode (const wchar_t* in, int absolute_p) | |||
| 106 | return unbind_to (count, DECODE_FILE (converted)); | 106 | return unbind_to (count, DECODE_FILE (converted)); |
| 107 | } | 107 | } |
| 108 | 108 | ||
| 109 | DEFUN ("cygwin-convert-path-to-windows", | 109 | DEFUN ("cygwin-convert-file-name-to-windows", |
| 110 | Fcygwin_convert_path_to_windows, Scygwin_convert_path_to_windows, | 110 | Fcygwin_convert_file_name_to_windows, |
| 111 | Scygwin_convert_file_name_to_windows, | ||
| 111 | 1, 2, 0, | 112 | 1, 2, 0, |
| 112 | doc: /* Convert PATH to a Windows path. If ABSOLUTE-P if | 113 | doc: /* Convert PATH to a Windows path. If ABSOLUTE-P is |
| 113 | non-nil, return an absolute path.*/) | 114 | non-nil, return an absolute path.*/) |
| 114 | (Lisp_Object path, Lisp_Object absolute_p) | 115 | (Lisp_Object path, Lisp_Object absolute_p) |
| 115 | { | 116 | { |
| 116 | return from_unicode ( | 117 | return from_unicode ( |
| 117 | conv_filename_to_w32_unicode (path, EQ (absolute_p, Qnil) ? 0 : 1)); | 118 | conv_filename_to_w32_unicode (path, EQ (absolute_p, Qnil) ? 0 : 1)); |
| 118 | } | 119 | } |
| 119 | 120 | ||
| 120 | DEFUN ("cygwin-convert-path-from-windows", | 121 | DEFUN ("cygwin-convert-file-name-from-windows", |
| 121 | Fcygwin_convert_path_from_windows, Scygwin_convert_path_from_windows, | 122 | Fcygwin_convert_file_name_from_windows, |
| 123 | Scygwin_convert_file_name_from_windows, | ||
| 122 | 1, 2, 0, | 124 | 1, 2, 0, |
| 123 | doc: /* Convert a Windows path to a Cygwin path. If ABSOLUTE-P | 125 | doc: /* Convert a Windows path to a Cygwin path. If ABSOLUTE-P |
| 124 | if non-nil, return an absolute path.*/) | 126 | is non-nil, return an absolute path.*/) |
| 125 | (Lisp_Object path, Lisp_Object absolute_p) | 127 | (Lisp_Object path, Lisp_Object absolute_p) |
| 126 | { | 128 | { |
| 127 | return conv_filename_from_w32_unicode (to_unicode (path, &path), | 129 | return conv_filename_from_w32_unicode (to_unicode (path, &path), |
| @@ -131,6 +133,6 @@ DEFUN ("cygwin-convert-path-from-windows", | |||
| 131 | void | 133 | void |
| 132 | syms_of_cygw32 (void) | 134 | syms_of_cygw32 (void) |
| 133 | { | 135 | { |
| 134 | defsubr (&Scygwin_convert_path_from_windows); | 136 | defsubr (&Scygwin_convert_file_name_from_windows); |
| 135 | defsubr (&Scygwin_convert_path_to_windows); | 137 | defsubr (&Scygwin_convert_file_name_to_windows); |
| 136 | } | 138 | } |
diff --git a/src/data.c b/src/data.c index 09899400b68..5fc6afaaa03 100644 --- a/src/data.c +++ b/src/data.c | |||
| @@ -543,12 +543,13 @@ DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0, | |||
| 543 | return (EQ (valcontents, Qunbound) ? Qnil : Qt); | 543 | return (EQ (valcontents, Qunbound) ? Qnil : Qt); |
| 544 | } | 544 | } |
| 545 | 545 | ||
| 546 | /* FIXME: Make it an alias for function-symbol! */ | ||
| 546 | DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0, | 547 | DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0, |
| 547 | doc: /* Return t if SYMBOL's function definition is not void. */) | 548 | doc: /* Return t if SYMBOL's function definition is not void. */) |
| 548 | (register Lisp_Object symbol) | 549 | (register Lisp_Object symbol) |
| 549 | { | 550 | { |
| 550 | CHECK_SYMBOL (symbol); | 551 | CHECK_SYMBOL (symbol); |
| 551 | return EQ (XSYMBOL (symbol)->function, Qunbound) ? Qnil : Qt; | 552 | return NILP (XSYMBOL (symbol)->function) ? Qnil : Qt; |
| 552 | } | 553 | } |
| 553 | 554 | ||
| 554 | DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, | 555 | DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, |
| @@ -564,14 +565,14 @@ Return SYMBOL. */) | |||
| 564 | } | 565 | } |
| 565 | 566 | ||
| 566 | DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0, | 567 | DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0, |
| 567 | doc: /* Make SYMBOL's function definition be void. | 568 | doc: /* Make SYMBOL's function definition be nil. |
| 568 | Return SYMBOL. */) | 569 | Return SYMBOL. */) |
| 569 | (register Lisp_Object symbol) | 570 | (register Lisp_Object symbol) |
| 570 | { | 571 | { |
| 571 | CHECK_SYMBOL (symbol); | 572 | CHECK_SYMBOL (symbol); |
| 572 | if (NILP (symbol) || EQ (symbol, Qt)) | 573 | if (NILP (symbol) || EQ (symbol, Qt)) |
| 573 | xsignal1 (Qsetting_constant, symbol); | 574 | xsignal1 (Qsetting_constant, symbol); |
| 574 | set_symbol_function (symbol, Qunbound); | 575 | set_symbol_function (symbol, Qnil); |
| 575 | return symbol; | 576 | return symbol; |
| 576 | } | 577 | } |
| 577 | 578 | ||
| @@ -580,9 +581,7 @@ DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0, | |||
| 580 | (register Lisp_Object symbol) | 581 | (register Lisp_Object symbol) |
| 581 | { | 582 | { |
| 582 | CHECK_SYMBOL (symbol); | 583 | CHECK_SYMBOL (symbol); |
| 583 | if (!EQ (XSYMBOL (symbol)->function, Qunbound)) | ||
| 584 | return XSYMBOL (symbol)->function; | 584 | return XSYMBOL (symbol)->function; |
| 585 | xsignal1 (Qvoid_function, symbol); | ||
| 586 | } | 585 | } |
| 587 | 586 | ||
| 588 | DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0, | 587 | DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0, |
| @@ -613,7 +612,7 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0, | |||
| 613 | 612 | ||
| 614 | function = XSYMBOL (symbol)->function; | 613 | function = XSYMBOL (symbol)->function; |
| 615 | 614 | ||
| 616 | if (!NILP (Vautoload_queue) && !EQ (function, Qunbound)) | 615 | if (!NILP (Vautoload_queue) && !NILP (function)) |
| 617 | Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue); | 616 | Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue); |
| 618 | 617 | ||
| 619 | if (AUTOLOADP (function)) | 618 | if (AUTOLOADP (function)) |
| @@ -714,7 +713,7 @@ Value, if non-nil, is a list \(interactive SPEC). */) | |||
| 714 | { | 713 | { |
| 715 | Lisp_Object fun = indirect_function (cmd); /* Check cycles. */ | 714 | Lisp_Object fun = indirect_function (cmd); /* Check cycles. */ |
| 716 | 715 | ||
| 717 | if (NILP (fun) || EQ (fun, Qunbound)) | 716 | if (NILP (fun)) |
| 718 | return Qnil; | 717 | return Qnil; |
| 719 | 718 | ||
| 720 | /* Use an `interactive-form' property if present, analogous to the | 719 | /* Use an `interactive-form' property if present, analogous to the |
| @@ -2008,10 +2007,10 @@ indirect_function (register Lisp_Object object) | |||
| 2008 | 2007 | ||
| 2009 | for (;;) | 2008 | for (;;) |
| 2010 | { | 2009 | { |
| 2011 | if (!SYMBOLP (hare) || EQ (hare, Qunbound)) | 2010 | if (!SYMBOLP (hare) || NILP (hare)) |
| 2012 | break; | 2011 | break; |
| 2013 | hare = XSYMBOL (hare)->function; | 2012 | hare = XSYMBOL (hare)->function; |
| 2014 | if (!SYMBOLP (hare) || EQ (hare, Qunbound)) | 2013 | if (!SYMBOLP (hare) || NILP (hare)) |
| 2015 | break; | 2014 | break; |
| 2016 | hare = XSYMBOL (hare)->function; | 2015 | hare = XSYMBOL (hare)->function; |
| 2017 | 2016 | ||
| @@ -2038,10 +2037,10 @@ function chain of symbols. */) | |||
| 2038 | 2037 | ||
| 2039 | /* Optimize for no indirection. */ | 2038 | /* Optimize for no indirection. */ |
| 2040 | result = object; | 2039 | result = object; |
| 2041 | if (SYMBOLP (result) && !EQ (result, Qunbound) | 2040 | if (SYMBOLP (result) && !NILP (result) |
| 2042 | && (result = XSYMBOL (result)->function, SYMBOLP (result))) | 2041 | && (result = XSYMBOL (result)->function, SYMBOLP (result))) |
| 2043 | result = indirect_function (result); | 2042 | result = indirect_function (result); |
| 2044 | if (!EQ (result, Qunbound)) | 2043 | if (!NILP (result)) |
| 2045 | return result; | 2044 | return result; |
| 2046 | 2045 | ||
| 2047 | if (NILP (noerror)) | 2046 | if (NILP (noerror)) |
diff --git a/src/dired.c b/src/dired.c index 4986f845101..3530b74ecb4 100644 --- a/src/dired.c +++ b/src/dired.c | |||
| @@ -31,44 +31,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 31 | #include <errno.h> | 31 | #include <errno.h> |
| 32 | #include <unistd.h> | 32 | #include <unistd.h> |
| 33 | 33 | ||
| 34 | /* The d_nameln member of a struct dirent includes the '\0' character | ||
| 35 | on some systems, but not on others. What's worse, you can't tell | ||
| 36 | at compile-time which one it will be, since it really depends on | ||
| 37 | the sort of system providing the filesystem you're reading from, | ||
| 38 | not the system you are running on. Paul Eggert | ||
| 39 | <eggert@bi.twinsun.com> says this occurs when Emacs is running on a | ||
| 40 | SunOS 4.1.2 host, reading a directory that is remote-mounted from a | ||
| 41 | Solaris 2.1 host and is in a native Solaris 2.1 filesystem. | ||
| 42 | |||
| 43 | Since applying strlen to the name always works, we'll just do that. */ | ||
| 44 | #define NAMLEN(p) strlen (p->d_name) | ||
| 45 | |||
| 46 | #ifdef HAVE_DIRENT_H | ||
| 47 | |||
| 48 | #include <dirent.h> | 34 | #include <dirent.h> |
| 49 | #define DIRENTRY struct dirent | ||
| 50 | |||
| 51 | #else /* not HAVE_DIRENT_H */ | ||
| 52 | |||
| 53 | #include <sys/dir.h> | ||
| 54 | #include <sys/stat.h> | ||
| 55 | |||
| 56 | #define DIRENTRY struct direct | ||
| 57 | |||
| 58 | extern DIR *opendir (char *); | ||
| 59 | extern struct direct *readdir (DIR *); | ||
| 60 | |||
| 61 | #endif /* HAVE_DIRENT_H */ | ||
| 62 | |||
| 63 | #include <filemode.h> | 35 | #include <filemode.h> |
| 64 | #include <stat-time.h> | 36 | #include <stat-time.h> |
| 65 | 37 | ||
| 66 | #ifdef MSDOS | ||
| 67 | #define DIRENTRY_NONEMPTY(p) ((p)->d_name[0] != 0) | ||
| 68 | #else | ||
| 69 | #define DIRENTRY_NONEMPTY(p) ((p)->d_ino) | ||
| 70 | #endif | ||
| 71 | |||
| 72 | #include "lisp.h" | 38 | #include "lisp.h" |
| 73 | #include "systime.h" | 39 | #include "systime.h" |
| 74 | #include "character.h" | 40 | #include "character.h" |
| @@ -88,6 +54,17 @@ static Lisp_Object Qfile_attributes_lessp; | |||
| 88 | 54 | ||
| 89 | static ptrdiff_t scmp (const char *, const char *, ptrdiff_t); | 55 | static ptrdiff_t scmp (const char *, const char *, ptrdiff_t); |
| 90 | 56 | ||
| 57 | /* Return the number of bytes in DP's name. */ | ||
| 58 | static ptrdiff_t | ||
| 59 | dirent_namelen (struct dirent *dp) | ||
| 60 | { | ||
| 61 | #ifdef _D_EXACT_NAMLEN | ||
| 62 | return _D_EXACT_NAMLEN (dp); | ||
| 63 | #else | ||
| 64 | return strlen (dp->d_name); | ||
| 65 | #endif | ||
| 66 | } | ||
| 67 | |||
| 91 | #ifdef WINDOWSNT | 68 | #ifdef WINDOWSNT |
| 92 | Lisp_Object | 69 | Lisp_Object |
| 93 | directory_files_internal_w32_unwind (Lisp_Object arg) | 70 | directory_files_internal_w32_unwind (Lisp_Object arg) |
| @@ -124,7 +101,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, | |||
| 124 | bool needsep = 0; | 101 | bool needsep = 0; |
| 125 | ptrdiff_t count = SPECPDL_INDEX (); | 102 | ptrdiff_t count = SPECPDL_INDEX (); |
| 126 | struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; | 103 | struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; |
| 127 | DIRENTRY *dp; | 104 | struct dirent *dp; |
| 128 | #ifdef WINDOWSNT | 105 | #ifdef WINDOWSNT |
| 129 | Lisp_Object w32_save = Qnil; | 106 | Lisp_Object w32_save = Qnil; |
| 130 | #endif | 107 | #endif |
| @@ -209,6 +186,11 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, | |||
| 209 | /* Loop reading blocks until EOF or error. */ | 186 | /* Loop reading blocks until EOF or error. */ |
| 210 | for (;;) | 187 | for (;;) |
| 211 | { | 188 | { |
| 189 | ptrdiff_t len; | ||
| 190 | bool wanted = 0; | ||
| 191 | Lisp_Object name, finalname; | ||
| 192 | struct gcpro gcpro1, gcpro2; | ||
| 193 | |||
| 212 | errno = 0; | 194 | errno = 0; |
| 213 | dp = readdir (d); | 195 | dp = readdir (d); |
| 214 | 196 | ||
| @@ -225,89 +207,81 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, | |||
| 225 | if (dp == NULL) | 207 | if (dp == NULL) |
| 226 | break; | 208 | break; |
| 227 | 209 | ||
| 228 | if (DIRENTRY_NONEMPTY (dp)) | 210 | len = dirent_namelen (dp); |
| 211 | name = finalname = make_unibyte_string (dp->d_name, len); | ||
| 212 | GCPRO2 (finalname, name); | ||
| 213 | |||
| 214 | /* Note: DECODE_FILE can GC; it should protect its argument, | ||
| 215 | though. */ | ||
| 216 | name = DECODE_FILE (name); | ||
| 217 | len = SBYTES (name); | ||
| 218 | |||
| 219 | /* Now that we have unwind_protect in place, we might as well | ||
| 220 | allow matching to be interrupted. */ | ||
| 221 | immediate_quit = 1; | ||
| 222 | QUIT; | ||
| 223 | |||
| 224 | if (NILP (match) | ||
| 225 | || (0 <= re_search (bufp, SSDATA (name), len, 0, len, 0))) | ||
| 226 | wanted = 1; | ||
| 227 | |||
| 228 | immediate_quit = 0; | ||
| 229 | |||
| 230 | if (wanted) | ||
| 229 | { | 231 | { |
| 230 | ptrdiff_t len; | 232 | if (!NILP (full)) |
| 231 | bool wanted = 0; | 233 | { |
| 232 | Lisp_Object name, finalname; | 234 | Lisp_Object fullname; |
| 233 | struct gcpro gcpro1, gcpro2; | 235 | ptrdiff_t nbytes = len + directory_nbytes + needsep; |
| 236 | ptrdiff_t nchars; | ||
| 234 | 237 | ||
| 235 | len = NAMLEN (dp); | 238 | fullname = make_uninit_multibyte_string (nbytes, nbytes); |
| 236 | name = finalname = make_unibyte_string (dp->d_name, len); | 239 | memcpy (SDATA (fullname), SDATA (directory), |
| 237 | GCPRO2 (finalname, name); | 240 | directory_nbytes); |
| 238 | 241 | ||
| 239 | /* Note: DECODE_FILE can GC; it should protect its argument, | 242 | if (needsep) |
| 240 | though. */ | 243 | SSET (fullname, directory_nbytes, DIRECTORY_SEP); |
| 241 | name = DECODE_FILE (name); | ||
| 242 | len = SBYTES (name); | ||
| 243 | 244 | ||
| 244 | /* Now that we have unwind_protect in place, we might as well | 245 | memcpy (SDATA (fullname) + directory_nbytes + needsep, |
| 245 | allow matching to be interrupted. */ | 246 | SDATA (name), len); |
| 246 | immediate_quit = 1; | ||
| 247 | QUIT; | ||
| 248 | 247 | ||
| 249 | if (NILP (match) | 248 | nchars = chars_in_text (SDATA (fullname), nbytes); |
| 250 | || (0 <= re_search (bufp, SSDATA (name), len, 0, len, 0))) | ||
| 251 | wanted = 1; | ||
| 252 | 249 | ||
| 253 | immediate_quit = 0; | 250 | /* Some bug somewhere. */ |
| 251 | if (nchars > nbytes) | ||
| 252 | emacs_abort (); | ||
| 254 | 253 | ||
| 255 | if (wanted) | 254 | STRING_SET_CHARS (fullname, nchars); |
| 256 | { | 255 | if (nchars == nbytes) |
| 257 | if (!NILP (full)) | 256 | STRING_SET_UNIBYTE (fullname); |
| 258 | { | 257 | |
| 259 | Lisp_Object fullname; | 258 | finalname = fullname; |
| 260 | ptrdiff_t nbytes = len + directory_nbytes + needsep; | ||
| 261 | ptrdiff_t nchars; | ||
| 262 | |||
| 263 | fullname = make_uninit_multibyte_string (nbytes, nbytes); | ||
| 264 | memcpy (SDATA (fullname), SDATA (directory), | ||
| 265 | directory_nbytes); | ||
| 266 | |||
| 267 | if (needsep) | ||
| 268 | SSET (fullname, directory_nbytes, DIRECTORY_SEP); | ||
| 269 | |||
| 270 | memcpy (SDATA (fullname) + directory_nbytes + needsep, | ||
| 271 | SDATA (name), len); | ||
| 272 | |||
| 273 | nchars = chars_in_text (SDATA (fullname), nbytes); | ||
| 274 | |||
| 275 | /* Some bug somewhere. */ | ||
| 276 | if (nchars > nbytes) | ||
| 277 | emacs_abort (); | ||
| 278 | |||
| 279 | STRING_SET_CHARS (fullname, nchars); | ||
| 280 | if (nchars == nbytes) | ||
| 281 | STRING_SET_UNIBYTE (fullname); | ||
| 282 | |||
| 283 | finalname = fullname; | ||
| 284 | } | ||
| 285 | else | ||
| 286 | finalname = name; | ||
| 287 | |||
| 288 | if (attrs) | ||
| 289 | { | ||
| 290 | /* Construct an expanded filename for the directory entry. | ||
| 291 | Use the decoded names for input to Ffile_attributes. */ | ||
| 292 | Lisp_Object decoded_fullname, fileattrs; | ||
| 293 | struct gcpro gcpro1, gcpro2; | ||
| 294 | |||
| 295 | decoded_fullname = fileattrs = Qnil; | ||
| 296 | GCPRO2 (decoded_fullname, fileattrs); | ||
| 297 | |||
| 298 | /* Both Fexpand_file_name and Ffile_attributes can GC. */ | ||
| 299 | decoded_fullname = Fexpand_file_name (name, directory); | ||
| 300 | fileattrs = Ffile_attributes (decoded_fullname, id_format); | ||
| 301 | |||
| 302 | list = Fcons (Fcons (finalname, fileattrs), list); | ||
| 303 | UNGCPRO; | ||
| 304 | } | ||
| 305 | else | ||
| 306 | list = Fcons (finalname, list); | ||
| 307 | } | 259 | } |
| 260 | else | ||
| 261 | finalname = name; | ||
| 308 | 262 | ||
| 309 | UNGCPRO; | 263 | if (attrs) |
| 264 | { | ||
| 265 | /* Construct an expanded filename for the directory entry. | ||
| 266 | Use the decoded names for input to Ffile_attributes. */ | ||
| 267 | Lisp_Object decoded_fullname, fileattrs; | ||
| 268 | struct gcpro gcpro1, gcpro2; | ||
| 269 | |||
| 270 | decoded_fullname = fileattrs = Qnil; | ||
| 271 | GCPRO2 (decoded_fullname, fileattrs); | ||
| 272 | |||
| 273 | /* Both Fexpand_file_name and Ffile_attributes can GC. */ | ||
| 274 | decoded_fullname = Fexpand_file_name (name, directory); | ||
| 275 | fileattrs = Ffile_attributes (decoded_fullname, id_format); | ||
| 276 | |||
| 277 | list = Fcons (Fcons (finalname, fileattrs), list); | ||
| 278 | UNGCPRO; | ||
| 279 | } | ||
| 280 | else | ||
| 281 | list = Fcons (finalname, list); | ||
| 310 | } | 282 | } |
| 283 | |||
| 284 | UNGCPRO; | ||
| 311 | } | 285 | } |
| 312 | 286 | ||
| 313 | block_input (); | 287 | block_input (); |
| @@ -442,7 +416,8 @@ These are all file names in directory DIRECTORY which begin with FILE. */) | |||
| 442 | return file_name_completion (file, directory, 1, Qnil); | 416 | return file_name_completion (file, directory, 1, Qnil); |
| 443 | } | 417 | } |
| 444 | 418 | ||
| 445 | static int file_name_completion_stat (Lisp_Object dirname, DIRENTRY *dp, struct stat *st_addr); | 419 | static int file_name_completion_stat (Lisp_Object dirname, struct dirent *dp, |
| 420 | struct stat *st_addr); | ||
| 446 | static Lisp_Object Qdefault_directory; | 421 | static Lisp_Object Qdefault_directory; |
| 447 | 422 | ||
| 448 | static Lisp_Object | 423 | static Lisp_Object |
| @@ -499,7 +474,7 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, | |||
| 499 | /* (att3b compiler bug requires do a null comparison this way) */ | 474 | /* (att3b compiler bug requires do a null comparison this way) */ |
| 500 | while (1) | 475 | while (1) |
| 501 | { | 476 | { |
| 502 | DIRENTRY *dp; | 477 | struct dirent *dp; |
| 503 | ptrdiff_t len; | 478 | ptrdiff_t len; |
| 504 | bool canexclude = 0; | 479 | bool canexclude = 0; |
| 505 | 480 | ||
| @@ -517,11 +492,10 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, | |||
| 517 | 492 | ||
| 518 | if (!dp) break; | 493 | if (!dp) break; |
| 519 | 494 | ||
| 520 | len = NAMLEN (dp); | 495 | len = dirent_namelen (dp); |
| 521 | 496 | ||
| 522 | QUIT; | 497 | QUIT; |
| 523 | if (! DIRENTRY_NONEMPTY (dp) | 498 | if (len < SCHARS (encoded_file) |
| 524 | || len < SCHARS (encoded_file) | ||
| 525 | || 0 <= scmp (dp->d_name, SSDATA (encoded_file), | 499 | || 0 <= scmp (dp->d_name, SSDATA (encoded_file), |
| 526 | SCHARS (encoded_file))) | 500 | SCHARS (encoded_file))) |
| 527 | continue; | 501 | continue; |
| @@ -806,9 +780,10 @@ scmp (const char *s1, const char *s2, ptrdiff_t len) | |||
| 806 | } | 780 | } |
| 807 | 781 | ||
| 808 | static int | 782 | static int |
| 809 | file_name_completion_stat (Lisp_Object dirname, DIRENTRY *dp, struct stat *st_addr) | 783 | file_name_completion_stat (Lisp_Object dirname, struct dirent *dp, |
| 784 | struct stat *st_addr) | ||
| 810 | { | 785 | { |
| 811 | ptrdiff_t len = NAMLEN (dp); | 786 | ptrdiff_t len = dirent_namelen (dp); |
| 812 | ptrdiff_t pos = SCHARS (dirname); | 787 | ptrdiff_t pos = SCHARS (dirname); |
| 813 | int value; | 788 | int value; |
| 814 | USE_SAFE_ALLOCA; | 789 | USE_SAFE_ALLOCA; |
diff --git a/src/emacs.c b/src/emacs.c index d69dbfda7bf..b2b193e3a4f 100644 --- a/src/emacs.c +++ b/src/emacs.c | |||
| @@ -715,7 +715,7 @@ main (int argc, char **argv) | |||
| 715 | stack_base = &dummy; | 715 | stack_base = &dummy; |
| 716 | #endif | 716 | #endif |
| 717 | 717 | ||
| 718 | #if defined (USE_GTK) && defined (G_SLICE_ALWAYS_MALLOC) | 718 | #ifdef G_SLICE_ALWAYS_MALLOC |
| 719 | /* This is used by the Cygwin build. */ | 719 | /* This is used by the Cygwin build. */ |
| 720 | setenv ("G_SLICE", "always-malloc", 1); | 720 | setenv ("G_SLICE", "always-malloc", 1); |
| 721 | #endif | 721 | #endif |
diff --git a/src/eval.c b/src/eval.c index f8a76646352..34b20f6fc8e 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -114,7 +114,6 @@ Lisp_Object Vsignaling_function; | |||
| 114 | Lisp_Object inhibit_lisp_code; | 114 | Lisp_Object inhibit_lisp_code; |
| 115 | 115 | ||
| 116 | static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *); | 116 | static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *); |
| 117 | static bool interactive_p (void); | ||
| 118 | static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); | 117 | static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); |
| 119 | 118 | ||
| 120 | /* Functions to set Lisp_Object slots of struct specbinding. */ | 119 | /* Functions to set Lisp_Object slots of struct specbinding. */ |
| @@ -489,102 +488,6 @@ usage: (function ARG) */) | |||
| 489 | } | 488 | } |
| 490 | 489 | ||
| 491 | 490 | ||
| 492 | DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0, | ||
| 493 | doc: /* Return t if the containing function was run directly by user input. | ||
| 494 | This means that the function was called with `call-interactively' | ||
| 495 | \(which includes being called as the binding of a key) | ||
| 496 | and input is currently coming from the keyboard (not a keyboard macro), | ||
| 497 | and Emacs is not running in batch mode (`noninteractive' is nil). | ||
| 498 | |||
| 499 | The only known proper use of `interactive-p' is in deciding whether to | ||
| 500 | display a helpful message, or how to display it. If you're thinking | ||
| 501 | of using it for any other purpose, it is quite likely that you're | ||
| 502 | making a mistake. Think: what do you want to do when the command is | ||
| 503 | called from a keyboard macro? | ||
| 504 | |||
| 505 | To test whether your function was called with `call-interactively', | ||
| 506 | either (i) add an extra optional argument and give it an `interactive' | ||
| 507 | spec that specifies non-nil unconditionally (such as \"p\"); or (ii) | ||
| 508 | use `called-interactively-p'. */) | ||
| 509 | (void) | ||
| 510 | { | ||
| 511 | return (INTERACTIVE && interactive_p ()) ? Qt : Qnil; | ||
| 512 | } | ||
| 513 | |||
| 514 | |||
| 515 | DEFUN ("called-interactively-p", Fcalled_interactively_p, Scalled_interactively_p, 0, 1, 0, | ||
| 516 | doc: /* Return t if the containing function was called by `call-interactively'. | ||
| 517 | If KIND is `interactive', then only return t if the call was made | ||
| 518 | interactively by the user, i.e. not in `noninteractive' mode nor | ||
| 519 | when `executing-kbd-macro'. | ||
| 520 | If KIND is `any', on the other hand, it will return t for any kind of | ||
| 521 | interactive call, including being called as the binding of a key, or | ||
| 522 | from a keyboard macro, or in `noninteractive' mode. | ||
| 523 | |||
| 524 | The only known proper use of `interactive' for KIND is in deciding | ||
| 525 | whether to display a helpful message, or how to display it. If you're | ||
| 526 | thinking of using it for any other purpose, it is quite likely that | ||
| 527 | you're making a mistake. Think: what do you want to do when the | ||
| 528 | command is called from a keyboard macro? | ||
| 529 | |||
| 530 | Instead of using this function, it is sometimes cleaner to give your | ||
| 531 | function an extra optional argument whose `interactive' spec specifies | ||
| 532 | non-nil unconditionally (\"p\" is a good way to do this), or via | ||
| 533 | \(not (or executing-kbd-macro noninteractive)). */) | ||
| 534 | (Lisp_Object kind) | ||
| 535 | { | ||
| 536 | return (((INTERACTIVE || !EQ (kind, intern ("interactive"))) | ||
| 537 | && interactive_p ()) | ||
| 538 | ? Qt : Qnil); | ||
| 539 | } | ||
| 540 | |||
| 541 | |||
| 542 | /* Return true if function in which this appears was called using | ||
| 543 | call-interactively and is not a built-in. */ | ||
| 544 | |||
| 545 | static bool | ||
| 546 | interactive_p (void) | ||
| 547 | { | ||
| 548 | struct backtrace *btp; | ||
| 549 | Lisp_Object fun; | ||
| 550 | |||
| 551 | btp = backtrace_list; | ||
| 552 | |||
| 553 | /* If this isn't a byte-compiled function, there may be a frame at | ||
| 554 | the top for Finteractive_p. If so, skip it. */ | ||
| 555 | fun = Findirect_function (btp->function, Qnil); | ||
| 556 | if (SUBRP (fun) && (XSUBR (fun) == &Sinteractive_p | ||
| 557 | || XSUBR (fun) == &Scalled_interactively_p)) | ||
| 558 | btp = btp->next; | ||
| 559 | |||
| 560 | /* If we're running an Emacs 18-style byte-compiled function, there | ||
| 561 | may be a frame for Fbytecode at the top level. In any version of | ||
| 562 | Emacs there can be Fbytecode frames for subexpressions evaluated | ||
| 563 | inside catch and condition-case. Skip past them. | ||
| 564 | |||
| 565 | If this isn't a byte-compiled function, then we may now be | ||
| 566 | looking at several frames for special forms. Skip past them. */ | ||
| 567 | while (btp | ||
| 568 | && (EQ (btp->function, Qbytecode) | ||
| 569 | || btp->nargs == UNEVALLED)) | ||
| 570 | btp = btp->next; | ||
| 571 | |||
| 572 | /* `btp' now points at the frame of the innermost function that isn't | ||
| 573 | a special form, ignoring frames for Finteractive_p and/or | ||
| 574 | Fbytecode at the top. If this frame is for a built-in function | ||
| 575 | (such as load or eval-region) return false. */ | ||
| 576 | fun = Findirect_function (btp->function, Qnil); | ||
| 577 | if (SUBRP (fun)) | ||
| 578 | return 0; | ||
| 579 | |||
| 580 | /* `btp' points to the frame of a Lisp function that called interactive-p. | ||
| 581 | Return t if that function was called interactively. */ | ||
| 582 | if (btp && btp->next && EQ (btp->next->function, Qcall_interactively)) | ||
| 583 | return 1; | ||
| 584 | return 0; | ||
| 585 | } | ||
| 586 | |||
| 587 | |||
| 588 | DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0, | 491 | DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0, |
| 589 | doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE. | 492 | doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE. |
| 590 | Aliased variables always have the same value; setting one sets the other. | 493 | Aliased variables always have the same value; setting one sets the other. |
| @@ -696,8 +599,9 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) | |||
| 696 | if (EQ ((--pdl)->symbol, sym) && !pdl->func | 599 | if (EQ ((--pdl)->symbol, sym) && !pdl->func |
| 697 | && EQ (pdl->old_value, Qunbound)) | 600 | && EQ (pdl->old_value, Qunbound)) |
| 698 | { | 601 | { |
| 699 | message_with_string ("Warning: defvar ignored because %s is let-bound", | 602 | message_with_string |
| 700 | SYMBOL_NAME (sym), 1); | 603 | ("Warning: defvar ignored because %s is let-bound", |
| 604 | SYMBOL_NAME (sym), 1); | ||
| 701 | break; | 605 | break; |
| 702 | } | 606 | } |
| 703 | } | 607 | } |
| @@ -717,8 +621,8 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) | |||
| 717 | /* A simple (defvar foo) with lexical scoping does "nothing" except | 621 | /* A simple (defvar foo) with lexical scoping does "nothing" except |
| 718 | declare that var to be dynamically scoped *locally* (i.e. within | 622 | declare that var to be dynamically scoped *locally* (i.e. within |
| 719 | the current file or let-block). */ | 623 | the current file or let-block). */ |
| 720 | Vinternal_interpreter_environment = | 624 | Vinternal_interpreter_environment |
| 721 | Fcons (sym, Vinternal_interpreter_environment); | 625 | = Fcons (sym, Vinternal_interpreter_environment); |
| 722 | else | 626 | else |
| 723 | { | 627 | { |
| 724 | /* Simple (defvar <var>) should not count as a definition at all. | 628 | /* Simple (defvar <var>) should not count as a definition at all. |
| @@ -971,7 +875,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */) | |||
| 971 | if (NILP (tem)) | 875 | if (NILP (tem)) |
| 972 | { | 876 | { |
| 973 | def = XSYMBOL (sym)->function; | 877 | def = XSYMBOL (sym)->function; |
| 974 | if (!EQ (def, Qunbound)) | 878 | if (!NILP (def)) |
| 975 | continue; | 879 | continue; |
| 976 | } | 880 | } |
| 977 | break; | 881 | break; |
| @@ -986,7 +890,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */) | |||
| 986 | GCPRO1 (form); | 890 | GCPRO1 (form); |
| 987 | def = Fautoload_do_load (def, sym, Qmacro); | 891 | def = Fautoload_do_load (def, sym, Qmacro); |
| 988 | UNGCPRO; | 892 | UNGCPRO; |
| 989 | if (EQ (def, Qunbound) || !CONSP (def)) | 893 | if (!CONSP (def)) |
| 990 | /* Not defined or definition not suitable. */ | 894 | /* Not defined or definition not suitable. */ |
| 991 | break; | 895 | break; |
| 992 | if (!EQ (XCAR (def), Qmacro)) | 896 | if (!EQ (XCAR (def), Qmacro)) |
| @@ -1811,12 +1715,12 @@ then strings and vectors are not accepted. */) | |||
| 1811 | 1715 | ||
| 1812 | fun = function; | 1716 | fun = function; |
| 1813 | 1717 | ||
| 1814 | fun = indirect_function (fun); /* Check cycles. */ | 1718 | fun = indirect_function (fun); /* Check cycles. */ |
| 1815 | if (NILP (fun) || EQ (fun, Qunbound)) | 1719 | if (NILP (fun)) |
| 1816 | return Qnil; | 1720 | return Qnil; |
| 1817 | 1721 | ||
| 1818 | /* Check an `interactive-form' property if present, analogous to the | 1722 | /* Check an `interactive-form' property if present, analogous to the |
| 1819 | function-documentation property. */ | 1723 | function-documentation property. */ |
| 1820 | fun = function; | 1724 | fun = function; |
| 1821 | while (SYMBOLP (fun)) | 1725 | while (SYMBOLP (fun)) |
| 1822 | { | 1726 | { |
| @@ -1876,7 +1780,7 @@ this does nothing and returns nil. */) | |||
| 1876 | CHECK_STRING (file); | 1780 | CHECK_STRING (file); |
| 1877 | 1781 | ||
| 1878 | /* If function is defined and not as an autoload, don't override. */ | 1782 | /* If function is defined and not as an autoload, don't override. */ |
| 1879 | if (!EQ (XSYMBOL (function)->function, Qunbound) | 1783 | if (!NILP (XSYMBOL (function)->function) |
| 1880 | && !AUTOLOADP (XSYMBOL (function)->function)) | 1784 | && !AUTOLOADP (XSYMBOL (function)->function)) |
| 1881 | return Qnil; | 1785 | return Qnil; |
| 1882 | 1786 | ||
| @@ -2055,7 +1959,7 @@ eval_sub (Lisp_Object form) | |||
| 2055 | 1959 | ||
| 2056 | /* Optimize for no indirection. */ | 1960 | /* Optimize for no indirection. */ |
| 2057 | fun = original_fun; | 1961 | fun = original_fun; |
| 2058 | if (SYMBOLP (fun) && !EQ (fun, Qunbound) | 1962 | if (SYMBOLP (fun) && !NILP (fun) |
| 2059 | && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) | 1963 | && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) |
| 2060 | fun = indirect_function (fun); | 1964 | fun = indirect_function (fun); |
| 2061 | 1965 | ||
| @@ -2177,7 +2081,7 @@ eval_sub (Lisp_Object form) | |||
| 2177 | val = apply_lambda (fun, original_args); | 2081 | val = apply_lambda (fun, original_args); |
| 2178 | else | 2082 | else |
| 2179 | { | 2083 | { |
| 2180 | if (EQ (fun, Qunbound)) | 2084 | if (NILP (fun)) |
| 2181 | xsignal1 (Qvoid_function, original_fun); | 2085 | xsignal1 (Qvoid_function, original_fun); |
| 2182 | if (!CONSP (fun)) | 2086 | if (!CONSP (fun)) |
| 2183 | xsignal1 (Qinvalid_function, original_fun); | 2087 | xsignal1 (Qinvalid_function, original_fun); |
| @@ -2251,10 +2155,10 @@ usage: (apply FUNCTION &rest ARGUMENTS) */) | |||
| 2251 | numargs += nargs - 2; | 2155 | numargs += nargs - 2; |
| 2252 | 2156 | ||
| 2253 | /* Optimize for no indirection. */ | 2157 | /* Optimize for no indirection. */ |
| 2254 | if (SYMBOLP (fun) && !EQ (fun, Qunbound) | 2158 | if (SYMBOLP (fun) && !NILP (fun) |
| 2255 | && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) | 2159 | && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) |
| 2256 | fun = indirect_function (fun); | 2160 | fun = indirect_function (fun); |
| 2257 | if (EQ (fun, Qunbound)) | 2161 | if (NILP (fun)) |
| 2258 | { | 2162 | { |
| 2259 | /* Let funcall get the error. */ | 2163 | /* Let funcall get the error. */ |
| 2260 | fun = args[0]; | 2164 | fun = args[0]; |
| @@ -2728,7 +2632,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) | |||
| 2728 | 2632 | ||
| 2729 | /* Optimize for no indirection. */ | 2633 | /* Optimize for no indirection. */ |
| 2730 | fun = original_fun; | 2634 | fun = original_fun; |
| 2731 | if (SYMBOLP (fun) && !EQ (fun, Qunbound) | 2635 | if (SYMBOLP (fun) && !NILP (fun) |
| 2732 | && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) | 2636 | && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) |
| 2733 | fun = indirect_function (fun); | 2637 | fun = indirect_function (fun); |
| 2734 | 2638 | ||
| @@ -2816,7 +2720,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) | |||
| 2816 | val = funcall_lambda (fun, numargs, args + 1); | 2720 | val = funcall_lambda (fun, numargs, args + 1); |
| 2817 | else | 2721 | else |
| 2818 | { | 2722 | { |
| 2819 | if (EQ (fun, Qunbound)) | 2723 | if (NILP (fun)) |
| 2820 | xsignal1 (Qvoid_function, original_fun); | 2724 | xsignal1 (Qvoid_function, original_fun); |
| 2821 | if (!CONSP (fun)) | 2725 | if (!CONSP (fun)) |
| 2822 | xsignal1 (Qinvalid_function, original_fun); | 2726 | xsignal1 (Qinvalid_function, original_fun); |
| @@ -3551,8 +3455,6 @@ alist of active lexical bindings. */); | |||
| 3551 | defsubr (&Sunwind_protect); | 3455 | defsubr (&Sunwind_protect); |
| 3552 | defsubr (&Scondition_case); | 3456 | defsubr (&Scondition_case); |
| 3553 | defsubr (&Ssignal); | 3457 | defsubr (&Ssignal); |
| 3554 | defsubr (&Sinteractive_p); | ||
| 3555 | defsubr (&Scalled_interactively_p); | ||
| 3556 | defsubr (&Scommandp); | 3458 | defsubr (&Scommandp); |
| 3557 | defsubr (&Sautoload); | 3459 | defsubr (&Sautoload); |
| 3558 | defsubr (&Sautoload_do_load); | 3460 | defsubr (&Sautoload_do_load); |
diff --git a/src/fileio.c b/src/fileio.c index 572f6d8ef83..442c66550d3 100644 --- a/src/fileio.c +++ b/src/fileio.c | |||
| @@ -315,6 +315,7 @@ Given a Unix syntax file name, returns a string ending in slash. */) | |||
| 315 | register const char *beg; | 315 | register const char *beg; |
| 316 | #else | 316 | #else |
| 317 | register char *beg; | 317 | register char *beg; |
| 318 | Lisp_Object tem_fn; | ||
| 318 | #endif | 319 | #endif |
| 319 | register const char *p; | 320 | register const char *p; |
| 320 | Lisp_Object handler; | 321 | Lisp_Object handler; |
| @@ -374,10 +375,13 @@ Given a Unix syntax file name, returns a string ending in slash. */) | |||
| 374 | p = beg + strlen (beg); | 375 | p = beg + strlen (beg); |
| 375 | } | 376 | } |
| 376 | } | 377 | } |
| 377 | dostounix_filename (beg); | 378 | tem_fn = ENCODE_FILE (make_specified_string (beg, -1, p - beg, |
| 378 | #endif /* DOS_NT */ | 379 | STRING_MULTIBYTE (filename))); |
| 379 | 380 | dostounix_filename (SSDATA (tem_fn)); | |
| 381 | return DECODE_FILE (tem_fn); | ||
| 382 | #else /* DOS_NT */ | ||
| 380 | return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename)); | 383 | return make_specified_string (beg, -1, p - beg, STRING_MULTIBYTE (filename)); |
| 384 | #endif /* DOS_NT */ | ||
| 381 | } | 385 | } |
| 382 | 386 | ||
| 383 | DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, | 387 | DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, |
| @@ -951,7 +955,18 @@ filesystem tree, not (expand-file-name ".." dirname). */) | |||
| 951 | #ifdef DOS_NT | 955 | #ifdef DOS_NT |
| 952 | /* Make sure directories are all separated with /, but | 956 | /* Make sure directories are all separated with /, but |
| 953 | avoid allocation of a new string when not required. */ | 957 | avoid allocation of a new string when not required. */ |
| 954 | dostounix_filename (nm); | 958 | if (multibyte) |
| 959 | { | ||
| 960 | Lisp_Object tem_name = make_specified_string (nm, -1, strlen (nm), | ||
| 961 | multibyte); | ||
| 962 | |||
| 963 | tem_name = ENCODE_FILE (tem_name); | ||
| 964 | dostounix_filename (SSDATA (tem_name)); | ||
| 965 | tem_name = DECODE_FILE (tem_name); | ||
| 966 | memcpy (nm, SSDATA (tem_name), SBYTES (tem_name) + 1); | ||
| 967 | } | ||
| 968 | else | ||
| 969 | dostounix_filename (nm); | ||
| 955 | #ifdef WINDOWSNT | 970 | #ifdef WINDOWSNT |
| 956 | if (IS_DIRECTORY_SEP (nm[1])) | 971 | if (IS_DIRECTORY_SEP (nm[1])) |
| 957 | { | 972 | { |
| @@ -1133,7 +1148,7 @@ filesystem tree, not (expand-file-name ".." dirname). */) | |||
| 1133 | newdir = "/"; | 1148 | newdir = "/"; |
| 1134 | } | 1149 | } |
| 1135 | else | 1150 | else |
| 1136 | getwd (adir); | 1151 | getcwd (adir, MAXPATHLEN + 1); |
| 1137 | newdir = adir; | 1152 | newdir = adir; |
| 1138 | } | 1153 | } |
| 1139 | 1154 | ||
| @@ -1305,10 +1320,13 @@ filesystem tree, not (expand-file-name ".." dirname). */) | |||
| 1305 | target[0] = '/'; | 1320 | target[0] = '/'; |
| 1306 | target[1] = ':'; | 1321 | target[1] = ':'; |
| 1307 | } | 1322 | } |
| 1308 | dostounix_filename (target); | ||
| 1309 | #endif /* DOS_NT */ | ||
| 1310 | |||
| 1311 | result = make_specified_string (target, -1, o - target, multibyte); | 1323 | result = make_specified_string (target, -1, o - target, multibyte); |
| 1324 | result = ENCODE_FILE (result); | ||
| 1325 | dostounix_filename (SSDATA (result)); | ||
| 1326 | result = DECODE_FILE (result); | ||
| 1327 | #else /* !DOS_NT */ | ||
| 1328 | result = make_specified_string (target, -1, o - target, multibyte); | ||
| 1329 | #endif /* !DOS_NT */ | ||
| 1312 | } | 1330 | } |
| 1313 | 1331 | ||
| 1314 | /* Again look to see if the file name has special constructs in it | 1332 | /* Again look to see if the file name has special constructs in it |
| @@ -1587,8 +1605,18 @@ those `/' is discarded. */) | |||
| 1587 | memcpy (nm, SDATA (filename), SBYTES (filename) + 1); | 1605 | memcpy (nm, SDATA (filename), SBYTES (filename) + 1); |
| 1588 | 1606 | ||
| 1589 | #ifdef DOS_NT | 1607 | #ifdef DOS_NT |
| 1590 | dostounix_filename (nm); | 1608 | { |
| 1591 | substituted = (strcmp (nm, SDATA (filename)) != 0); | 1609 | Lisp_Object encoded_filename = ENCODE_FILE (filename); |
| 1610 | Lisp_Object tem_fn; | ||
| 1611 | |||
| 1612 | dostounix_filename (SDATA (encoded_filename)); | ||
| 1613 | tem_fn = DECODE_FILE (encoded_filename); | ||
| 1614 | nm = alloca (SBYTES (tem_fn) + 1); | ||
| 1615 | memcpy (nm, SDATA (tem_fn), SBYTES (tem_fn) + 1); | ||
| 1616 | substituted = (memcmp (nm, SDATA (filename), SBYTES (filename)) != 0); | ||
| 1617 | if (substituted) | ||
| 1618 | filename = tem_fn; | ||
| 1619 | } | ||
| 1592 | #endif | 1620 | #endif |
| 1593 | endp = nm + SBYTES (filename); | 1621 | endp = nm + SBYTES (filename); |
| 1594 | 1622 | ||
diff --git a/src/frame.h b/src/frame.h index 35cbc44becc..87c4fcb0555 100644 --- a/src/frame.h +++ b/src/frame.h | |||
| @@ -933,6 +933,21 @@ typedef struct frame *FRAME_PTR; | |||
| 933 | && (frame_var = XCAR (list_var), 1)); \ | 933 | && (frame_var = XCAR (list_var), 1)); \ |
| 934 | list_var = XCDR (list_var)) | 934 | list_var = XCDR (list_var)) |
| 935 | 935 | ||
| 936 | /* Reflect mouse movement when a complete frame update is performed. */ | ||
| 937 | |||
| 938 | #define FRAME_MOUSE_UPDATE(frame) \ | ||
| 939 | do { \ | ||
| 940 | Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (frame); \ | ||
| 941 | if (frame == hlinfo->mouse_face_mouse_frame) \ | ||
| 942 | { \ | ||
| 943 | block_input (); \ | ||
| 944 | if (hlinfo->mouse_face_mouse_frame) \ | ||
| 945 | note_mouse_highlight (hlinfo->mouse_face_mouse_frame, \ | ||
| 946 | hlinfo->mouse_face_mouse_x, \ | ||
| 947 | hlinfo->mouse_face_mouse_y); \ | ||
| 948 | unblock_input (); \ | ||
| 949 | } \ | ||
| 950 | } while (0) | ||
| 936 | 951 | ||
| 937 | extern Lisp_Object Qframep, Qframe_live_p; | 952 | extern Lisp_Object Qframep, Qframe_live_p; |
| 938 | extern Lisp_Object Qtty, Qtty_type; | 953 | extern Lisp_Object Qtty, Qtty_type; |
diff --git a/src/lisp.h b/src/lisp.h index 67ae28a488f..419176d06c8 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -1104,7 +1104,7 @@ struct Lisp_Symbol | |||
| 1104 | union Lisp_Fwd *fwd; | 1104 | union Lisp_Fwd *fwd; |
| 1105 | } val; | 1105 | } val; |
| 1106 | 1106 | ||
| 1107 | /* Function value of the symbol or Qunbound if not fboundp. */ | 1107 | /* Function value of the symbol or Qnil if not fboundp. */ |
| 1108 | Lisp_Object function; | 1108 | Lisp_Object function; |
| 1109 | 1109 | ||
| 1110 | /* The symbol's property list. */ | 1110 | /* The symbol's property list. */ |
| @@ -1649,10 +1649,6 @@ typedef struct { | |||
| 1649 | int mouse_face_face_id; | 1649 | int mouse_face_face_id; |
| 1650 | Lisp_Object mouse_face_overlay; | 1650 | Lisp_Object mouse_face_overlay; |
| 1651 | 1651 | ||
| 1652 | /* 1 if a mouse motion event came and we didn't handle it right away because | ||
| 1653 | gc was in progress. */ | ||
| 1654 | int mouse_face_deferred_gc; | ||
| 1655 | |||
| 1656 | /* FRAME and X, Y position of mouse when last checked for | 1652 | /* FRAME and X, Y position of mouse when last checked for |
| 1657 | highlighting. X and Y can be negative or out of range for the frame. */ | 1653 | highlighting. X and Y can be negative or out of range for the frame. */ |
| 1658 | struct frame *mouse_face_mouse_frame; | 1654 | struct frame *mouse_face_mouse_frame; |
diff --git a/src/lread.c b/src/lread.c index 5859a2f85a9..6d0ff9f780e 100644 --- a/src/lread.c +++ b/src/lread.c | |||
| @@ -3957,12 +3957,13 @@ init_obarray (void) | |||
| 3957 | /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil, | 3957 | /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil, |
| 3958 | so those two need to be fixed manually. */ | 3958 | so those two need to be fixed manually. */ |
| 3959 | SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound); | 3959 | SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound); |
| 3960 | set_symbol_function (Qunbound, Qunbound); | 3960 | set_symbol_function (Qunbound, Qnil); |
| 3961 | set_symbol_plist (Qunbound, Qnil); | 3961 | set_symbol_plist (Qunbound, Qnil); |
| 3962 | SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil); | 3962 | SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil); |
| 3963 | XSYMBOL (Qnil)->constant = 1; | 3963 | XSYMBOL (Qnil)->constant = 1; |
| 3964 | XSYMBOL (Qnil)->declared_special = 1; | 3964 | XSYMBOL (Qnil)->declared_special = 1; |
| 3965 | set_symbol_plist (Qnil, Qnil); | 3965 | set_symbol_plist (Qnil, Qnil); |
| 3966 | set_symbol_function (Qnil, Qnil); | ||
| 3966 | 3967 | ||
| 3967 | Qt = intern_c_string ("t"); | 3968 | Qt = intern_c_string ("t"); |
| 3968 | SET_SYMBOL_VAL (XSYMBOL (Qt), Qt); | 3969 | SET_SYMBOL_VAL (XSYMBOL (Qt), Qt); |
diff --git a/src/makefile.w32-in b/src/makefile.w32-in index 9778e955677..a296f6eb393 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in | |||
| @@ -229,12 +229,12 @@ SOME_MACHINE_OBJECTS = dosfns.o msdos.o \ | |||
| 229 | obj = $(GLOBAL_SOURCES:.c=.o) | 229 | obj = $(GLOBAL_SOURCES:.c=.o) |
| 230 | 230 | ||
| 231 | globals.h: gl-stamp | 231 | globals.h: gl-stamp |
| 232 | @cmd /c rem true | 232 | @cmd $(SWITCHCHAR)c rem true |
| 233 | 233 | ||
| 234 | gl-stamp: ../lib-src/$(BLD)/make-docfile.exe $(GLOBAL_SOURCES) | 234 | gl-stamp: ../lib-src/$(BLD)/make-docfile.exe $(GLOBAL_SOURCES) |
| 235 | - $(DEL) gl-tmp | 235 | - $(DEL) gl-tmp |
| 236 | "$(THISDIR)/../lib-src/$(BLD)/make-docfile" -d . -g $(SOME_MACHINE_OBJECTS) $(obj) > gl-tmp | 236 | "$(THISDIR)/../lib-src/$(BLD)/make-docfile" -d . -g $(SOME_MACHINE_OBJECTS) $(obj) > gl-tmp |
| 237 | cmd /c "fc /b gl-tmp globals.h >nul 2>&1 || $(CP) gl-tmp globals.h" | 237 | fc.exe $(SWITCHCHAR)b gl-tmp globals.h >nul 2>&1 || $(CP) gl-tmp globals.h |
| 238 | - $(DEL) gl-tmp | 238 | - $(DEL) gl-tmp |
| 239 | echo timestamp > $@ | 239 | echo timestamp > $@ |
| 240 | 240 | ||
| @@ -413,8 +413,6 @@ CONF_POST_H = $(SRC)/conf_post.h \ | |||
| 413 | $(MS_W32_H) | 413 | $(MS_W32_H) |
| 414 | CONFIG_H = $(SRC)/config.h \ | 414 | CONFIG_H = $(SRC)/config.h \ |
| 415 | $(CONF_POST_H) | 415 | $(CONF_POST_H) |
| 416 | DIR_H = $(NT_INC)/sys/dir.h \ | ||
| 417 | $(SRC)/ndir.h | ||
| 418 | W32GUI_H = $(SRC)/w32gui.h \ | 416 | W32GUI_H = $(SRC)/w32gui.h \ |
| 419 | $(SYSTIME_H) | 417 | $(SYSTIME_H) |
| 420 | DISPEXTERN_H = $(SRC)/dispextern.h \ | 418 | DISPEXTERN_H = $(SRC)/dispextern.h \ |
| @@ -714,6 +712,7 @@ $(BLD)/dired.$(O) : \ | |||
| 714 | $(SRC)/blockinput.h \ | 712 | $(SRC)/blockinput.h \ |
| 715 | $(SRC)/commands.h \ | 713 | $(SRC)/commands.h \ |
| 716 | $(SRC)/regex.h \ | 714 | $(SRC)/regex.h \ |
| 715 | $(NT_INC)/dirent.h \ | ||
| 717 | $(NT_INC)/pwd.h \ | 716 | $(NT_INC)/pwd.h \ |
| 718 | $(NT_INC)/sys/stat.h \ | 717 | $(NT_INC)/sys/stat.h \ |
| 719 | $(NT_INC)/unistd.h \ | 718 | $(NT_INC)/unistd.h \ |
| @@ -722,7 +721,6 @@ $(BLD)/dired.$(O) : \ | |||
| 722 | $(CHARSET_H) \ | 721 | $(CHARSET_H) \ |
| 723 | $(CODING_H) \ | 722 | $(CODING_H) \ |
| 724 | $(CONFIG_H) \ | 723 | $(CONFIG_H) \ |
| 725 | $(DIR_H) \ | ||
| 726 | $(FILEMODE_H) \ | 724 | $(FILEMODE_H) \ |
| 727 | $(GRP_H) \ | 725 | $(GRP_H) \ |
| 728 | $(LISP_H) \ | 726 | $(LISP_H) \ |
| @@ -1175,11 +1173,11 @@ $(BLD)/minibuf.$(O) : \ | |||
| 1175 | 1173 | ||
| 1176 | $(BLD)/w32.$(O) : \ | 1174 | $(BLD)/w32.$(O) : \ |
| 1177 | $(SRC)/w32.c \ | 1175 | $(SRC)/w32.c \ |
| 1178 | $(SRC)/ndir.h \ | ||
| 1179 | $(SRC)/w32.h \ | 1176 | $(SRC)/w32.h \ |
| 1180 | $(SRC)/w32common.h \ | 1177 | $(SRC)/w32common.h \ |
| 1181 | $(SRC)/w32heap.h \ | 1178 | $(SRC)/w32heap.h \ |
| 1182 | $(SRC)/w32select.h \ | 1179 | $(SRC)/w32select.h \ |
| 1180 | $(NT_INC)/dirent.h \ | ||
| 1183 | $(NT_INC)/pwd.h \ | 1181 | $(NT_INC)/pwd.h \ |
| 1184 | $(NT_INC)/sys/file.h \ | 1182 | $(NT_INC)/sys/file.h \ |
| 1185 | $(NT_INC)/sys/time.h \ | 1183 | $(NT_INC)/sys/time.h \ |
diff --git a/src/msdos.c b/src/msdos.c index dd05a8b2c5d..433bf1074d8 100644 --- a/src/msdos.c +++ b/src/msdos.c | |||
| @@ -1275,7 +1275,6 @@ IT_update_begin (struct frame *f) | |||
| 1275 | hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; | 1275 | hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; |
| 1276 | hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; | 1276 | hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; |
| 1277 | hlinfo->mouse_face_window = Qnil; | 1277 | hlinfo->mouse_face_window = Qnil; |
| 1278 | hlinfo->mouse_face_deferred_gc = 0; | ||
| 1279 | hlinfo->mouse_face_mouse_frame = NULL; | 1278 | hlinfo->mouse_face_mouse_frame = NULL; |
| 1280 | } | 1279 | } |
| 1281 | 1280 | ||
| @@ -1295,21 +1294,10 @@ IT_update_end (struct frame *f) | |||
| 1295 | static void | 1294 | static void |
| 1296 | IT_frame_up_to_date (struct frame *f) | 1295 | IT_frame_up_to_date (struct frame *f) |
| 1297 | { | 1296 | { |
| 1298 | Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); | ||
| 1299 | Lisp_Object new_cursor, frame_desired_cursor; | 1297 | Lisp_Object new_cursor, frame_desired_cursor; |
| 1300 | struct window *sw; | 1298 | struct window *sw; |
| 1301 | 1299 | ||
| 1302 | if (hlinfo->mouse_face_deferred_gc | 1300 | FRAME_MOUSE_UPDATE (f); |
| 1303 | || (f && f == hlinfo->mouse_face_mouse_frame)) | ||
| 1304 | { | ||
| 1305 | block_input (); | ||
| 1306 | if (hlinfo->mouse_face_mouse_frame) | ||
| 1307 | note_mouse_highlight (hlinfo->mouse_face_mouse_frame, | ||
| 1308 | hlinfo->mouse_face_mouse_x, | ||
| 1309 | hlinfo->mouse_face_mouse_y); | ||
| 1310 | hlinfo->mouse_face_deferred_gc = 0; | ||
| 1311 | unblock_input (); | ||
| 1312 | } | ||
| 1313 | 1301 | ||
| 1314 | /* Set the cursor type to whatever they wanted. In a minibuffer | 1302 | /* Set the cursor type to whatever they wanted. In a minibuffer |
| 1315 | window, we want the cursor to appear only if we are reading input | 1303 | window, we want the cursor to appear only if we are reading input |
| @@ -1849,7 +1837,6 @@ internal_terminal_init (void) | |||
| 1849 | FRAME_BACKGROUND_PIXEL (SELECTED_FRAME ()) = colors[1]; | 1837 | FRAME_BACKGROUND_PIXEL (SELECTED_FRAME ()) = colors[1]; |
| 1850 | } | 1838 | } |
| 1851 | the_only_display_info.mouse_highlight.mouse_face_mouse_frame = NULL; | 1839 | the_only_display_info.mouse_highlight.mouse_face_mouse_frame = NULL; |
| 1852 | the_only_display_info.mouse_highlight.mouse_face_deferred_gc = 0; | ||
| 1853 | the_only_display_info.mouse_highlight.mouse_face_beg_row = | 1840 | the_only_display_info.mouse_highlight.mouse_face_beg_row = |
| 1854 | the_only_display_info.mouse_highlight.mouse_face_beg_col = -1; | 1841 | the_only_display_info.mouse_highlight.mouse_face_beg_col = -1; |
| 1855 | the_only_display_info.mouse_highlight.mouse_face_end_row = | 1842 | the_only_display_info.mouse_highlight.mouse_face_end_row = |
diff --git a/src/nsterm.m b/src/nsterm.m index 57d32ee0528..25eb7ebc495 100644 --- a/src/nsterm.m +++ b/src/nsterm.m | |||
| @@ -1186,7 +1186,6 @@ x_free_frame_resources (struct frame *f) | |||
| 1186 | hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; | 1186 | hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; |
| 1187 | hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; | 1187 | hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; |
| 1188 | hlinfo->mouse_face_window = Qnil; | 1188 | hlinfo->mouse_face_window = Qnil; |
| 1189 | hlinfo->mouse_face_deferred_gc = 0; | ||
| 1190 | hlinfo->mouse_face_mouse_frame = 0; | 1189 | hlinfo->mouse_face_mouse_frame = 0; |
| 1191 | } | 1190 | } |
| 1192 | 1191 | ||
| @@ -1887,8 +1886,7 @@ static void | |||
| 1887 | ns_frame_up_to_date (struct frame *f) | 1886 | ns_frame_up_to_date (struct frame *f) |
| 1888 | /* -------------------------------------------------------------------------- | 1887 | /* -------------------------------------------------------------------------- |
| 1889 | External (hook): Fix up mouse highlighting right after a full update. | 1888 | External (hook): Fix up mouse highlighting right after a full update. |
| 1890 | Some highlighting was deferred if GC was happening during | 1889 | Can't use FRAME_MOUSE_UPDATE due to ns_frame_begin and ns_frame_end calls. |
| 1891 | note_mouse_highlight (), while other highlighting was deferred for update. | ||
| 1892 | -------------------------------------------------------------------------- */ | 1890 | -------------------------------------------------------------------------- */ |
| 1893 | { | 1891 | { |
| 1894 | NSTRACE (ns_frame_up_to_date); | 1892 | NSTRACE (ns_frame_up_to_date); |
| @@ -1896,19 +1894,17 @@ ns_frame_up_to_date (struct frame *f) | |||
| 1896 | if (FRAME_NS_P (f)) | 1894 | if (FRAME_NS_P (f)) |
| 1897 | { | 1895 | { |
| 1898 | Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); | 1896 | Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); |
| 1899 | if ((hlinfo->mouse_face_deferred_gc || f ==hlinfo->mouse_face_mouse_frame) | 1897 | if (f == hlinfo->mouse_face_mouse_frame) |
| 1900 | /*&& hlinfo->mouse_face_mouse_frame*/) | 1898 | { |
| 1901 | { | 1899 | block_input (); |
| 1902 | block_input (); | ||
| 1903 | ns_update_begin(f); | 1900 | ns_update_begin(f); |
| 1904 | if (hlinfo->mouse_face_mouse_frame) | 1901 | if (hlinfo->mouse_face_mouse_frame) |
| 1905 | note_mouse_highlight (hlinfo->mouse_face_mouse_frame, | 1902 | note_mouse_highlight (hlinfo->mouse_face_mouse_frame, |
| 1906 | hlinfo->mouse_face_mouse_x, | 1903 | hlinfo->mouse_face_mouse_x, |
| 1907 | hlinfo->mouse_face_mouse_y); | 1904 | hlinfo->mouse_face_mouse_y); |
| 1908 | hlinfo->mouse_face_deferred_gc = 0; | ||
| 1909 | ns_update_end(f); | 1905 | ns_update_end(f); |
| 1910 | unblock_input (); | 1906 | unblock_input (); |
| 1911 | } | 1907 | } |
| 1912 | } | 1908 | } |
| 1913 | } | 1909 | } |
| 1914 | 1910 | ||
| @@ -3869,7 +3865,6 @@ ns_initialize_display_info (struct ns_display_info *dpyinfo) | |||
| 3869 | dpyinfo->root_window = 42; /* a placeholder.. */ | 3865 | dpyinfo->root_window = 42; /* a placeholder.. */ |
| 3870 | 3866 | ||
| 3871 | hlinfo->mouse_face_mouse_frame = NULL; | 3867 | hlinfo->mouse_face_mouse_frame = NULL; |
| 3872 | hlinfo->mouse_face_deferred_gc = 0; | ||
| 3873 | hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; | 3868 | hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; |
| 3874 | hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; | 3869 | hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; |
| 3875 | hlinfo->mouse_face_face_id = DEFAULT_FACE_ID; | 3870 | hlinfo->mouse_face_face_id = DEFAULT_FACE_ID; |
diff --git a/src/sysdep.c b/src/sysdep.c index 7c5c144fa8c..bc4dc91509f 100644 --- a/src/sysdep.c +++ b/src/sysdep.c | |||
| @@ -101,7 +101,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | |||
| 101 | #define _P_WAIT 0 | 101 | #define _P_WAIT 0 |
| 102 | int _cdecl _spawnlp (int, const char *, const char *, ...); | 102 | int _cdecl _spawnlp (int, const char *, const char *, ...); |
| 103 | int _cdecl _getpid (void); | 103 | int _cdecl _getpid (void); |
| 104 | extern char *getwd (char *); | ||
| 105 | #endif | 104 | #endif |
| 106 | 105 | ||
| 107 | #include "syssignal.h" | 106 | #include "syssignal.h" |
| @@ -134,12 +133,12 @@ char* | |||
| 134 | get_current_dir_name (void) | 133 | get_current_dir_name (void) |
| 135 | { | 134 | { |
| 136 | char *buf; | 135 | char *buf; |
| 137 | char *pwd; | 136 | char *pwd = getenv ("PWD"); |
| 138 | struct stat dotstat, pwdstat; | 137 | struct stat dotstat, pwdstat; |
| 139 | /* If PWD is accurate, use it instead of calling getwd. PWD is | 138 | /* If PWD is accurate, use it instead of calling getcwd. PWD is |
| 140 | sometimes a nicer name, and using it may avoid a fatal error if a | 139 | sometimes a nicer name, and using it may avoid a fatal error if a |
| 141 | parent directory is searchable but not readable. */ | 140 | parent directory is searchable but not readable. */ |
| 142 | if ((pwd = getenv ("PWD")) != 0 | 141 | if (pwd |
| 143 | && (IS_DIRECTORY_SEP (*pwd) || (*pwd && IS_DEVICE_SEP (pwd[1]))) | 142 | && (IS_DIRECTORY_SEP (*pwd) || (*pwd && IS_DEVICE_SEP (pwd[1]))) |
| 144 | && stat (pwd, &pwdstat) == 0 | 143 | && stat (pwd, &pwdstat) == 0 |
| 145 | && stat (".", &dotstat) == 0 | 144 | && stat (".", &dotstat) == 0 |
| @@ -155,7 +154,6 @@ get_current_dir_name (void) | |||
| 155 | return NULL; | 154 | return NULL; |
| 156 | strcpy (buf, pwd); | 155 | strcpy (buf, pwd); |
| 157 | } | 156 | } |
| 158 | #ifdef HAVE_GETCWD | ||
| 159 | else | 157 | else |
| 160 | { | 158 | { |
| 161 | size_t buf_size = 1024; | 159 | size_t buf_size = 1024; |
| @@ -179,22 +177,6 @@ get_current_dir_name (void) | |||
| 179 | return NULL; | 177 | return NULL; |
| 180 | } | 178 | } |
| 181 | } | 179 | } |
| 182 | #else | ||
| 183 | else | ||
| 184 | { | ||
| 185 | /* We need MAXPATHLEN here. */ | ||
| 186 | buf = malloc (MAXPATHLEN + 1); | ||
| 187 | if (!buf) | ||
| 188 | return NULL; | ||
| 189 | if (getwd (buf) == NULL) | ||
| 190 | { | ||
| 191 | int tmp_errno = errno; | ||
| 192 | free (buf); | ||
| 193 | errno = tmp_errno; | ||
| 194 | return NULL; | ||
| 195 | } | ||
| 196 | } | ||
| 197 | #endif | ||
| 198 | return buf; | 180 | return buf; |
| 199 | } | 181 | } |
| 200 | #endif | 182 | #endif |
| @@ -521,7 +503,7 @@ sys_subshell (void) | |||
| 521 | const char *sh = 0; | 503 | const char *sh = 0; |
| 522 | 504 | ||
| 523 | #ifdef DOS_NT /* MW, Aug 1993 */ | 505 | #ifdef DOS_NT /* MW, Aug 1993 */ |
| 524 | getwd (oldwd); | 506 | getcwd (oldwd, sizeof oldwd); |
| 525 | if (sh == 0) | 507 | if (sh == 0) |
| 526 | sh = (char *) egetenv ("SUSPEND"); /* KFS, 1994-12-14 */ | 508 | sh = (char *) egetenv ("SUSPEND"); /* KFS, 1994-12-14 */ |
| 527 | #endif | 509 | #endif |
| @@ -2238,82 +2220,6 @@ emacs_readlink (char const *filename, char initial_buf[READLINK_BUFSIZE]) | |||
| 2238 | &emacs_norealloc_allocator, careadlinkatcwd); | 2220 | &emacs_norealloc_allocator, careadlinkatcwd); |
| 2239 | } | 2221 | } |
| 2240 | 2222 | ||
| 2241 | #ifdef USG | ||
| 2242 | /* | ||
| 2243 | * All of the following are for USG. | ||
| 2244 | * | ||
| 2245 | * On USG systems the system calls are INTERRUPTIBLE by signals | ||
| 2246 | * that the user program has elected to catch. Thus the system call | ||
| 2247 | * must be retried in these cases. To handle this without massive | ||
| 2248 | * changes in the source code, we remap the standard system call names | ||
| 2249 | * to names for our own functions in sysdep.c that do the system call | ||
| 2250 | * with retries. Actually, for portability reasons, it is good | ||
| 2251 | * programming practice, as this example shows, to limit all actual | ||
| 2252 | * system calls to a single occurrence in the source. Sure, this | ||
| 2253 | * adds an extra level of function call overhead but it is almost | ||
| 2254 | * always negligible. Fred Fish, Unisoft Systems Inc. | ||
| 2255 | */ | ||
| 2256 | |||
| 2257 | /* | ||
| 2258 | * Warning, this function may not duplicate 4.2 action properly | ||
| 2259 | * under error conditions. | ||
| 2260 | */ | ||
| 2261 | |||
| 2262 | #if !defined (HAVE_GETWD) || defined (BROKEN_GETWD) | ||
| 2263 | |||
| 2264 | #ifndef MAXPATHLEN | ||
| 2265 | /* In 4.1, param.h fails to define this. */ | ||
| 2266 | #define MAXPATHLEN 1024 | ||
| 2267 | #endif | ||
| 2268 | |||
| 2269 | char * | ||
| 2270 | getwd (char *pathname) | ||
| 2271 | { | ||
| 2272 | char *npath, *spath; | ||
| 2273 | extern char *getcwd (char *, size_t); | ||
| 2274 | |||
| 2275 | block_input (); /* getcwd uses malloc */ | ||
| 2276 | spath = npath = getcwd ((char *) 0, MAXPATHLEN); | ||
| 2277 | if (spath == 0) | ||
| 2278 | { | ||
| 2279 | unblock_input (); | ||
| 2280 | return spath; | ||
| 2281 | } | ||
| 2282 | /* On Altos 3068, getcwd can return @hostname/dir, so discard | ||
| 2283 | up to first slash. Should be harmless on other systems. */ | ||
| 2284 | while (*npath && *npath != '/') | ||
| 2285 | npath++; | ||
| 2286 | strcpy (pathname, npath); | ||
| 2287 | free (spath); /* getcwd uses malloc */ | ||
| 2288 | unblock_input (); | ||
| 2289 | return pathname; | ||
| 2290 | } | ||
| 2291 | |||
| 2292 | #endif /* !defined (HAVE_GETWD) || defined (BROKEN_GETWD) */ | ||
| 2293 | #endif /* USG */ | ||
| 2294 | |||
| 2295 | /* Directory routines for systems that don't have them. */ | ||
| 2296 | |||
| 2297 | #ifdef HAVE_DIRENT_H | ||
| 2298 | |||
| 2299 | #include <dirent.h> | ||
| 2300 | |||
| 2301 | #if !defined (HAVE_CLOSEDIR) | ||
| 2302 | |||
| 2303 | int | ||
| 2304 | closedir (DIR *dirp /* stream from opendir */) | ||
| 2305 | { | ||
| 2306 | int rtnval; | ||
| 2307 | |||
| 2308 | rtnval = emacs_close (dirp->dd_fd); | ||
| 2309 | xfree (dirp); | ||
| 2310 | |||
| 2311 | return rtnval; | ||
| 2312 | } | ||
| 2313 | #endif /* not HAVE_CLOSEDIR */ | ||
| 2314 | #endif /* HAVE_DIRENT_H */ | ||
| 2315 | |||
| 2316 | |||
| 2317 | /* Return a struct timeval that is roughly equivalent to T. | 2223 | /* Return a struct timeval that is roughly equivalent to T. |
| 2318 | Use the least timeval not less than T. | 2224 | Use the least timeval not less than T. |
| 2319 | Return an extremal value if the result would overflow. */ | 2225 | Return an extremal value if the result would overflow. */ |
| @@ -119,9 +119,10 @@ typedef struct _PROCESS_MEMORY_COUNTERS_EX { | |||
| 119 | #include <aclapi.h> | 119 | #include <aclapi.h> |
| 120 | 120 | ||
| 121 | #ifdef _MSC_VER | 121 | #ifdef _MSC_VER |
| 122 | /* MSVC doesn't provide the definition of REPARSE_DATA_BUFFER, except | 122 | /* MSVC doesn't provide the definition of REPARSE_DATA_BUFFER and the |
| 123 | on ntifs.h, which cannot be included because it triggers conflicts | 123 | associated macros, except on ntifs.h, which cannot be included |
| 124 | with other Windows API headers. So we define it here by hand. */ | 124 | because it triggers conflicts with other Windows API headers. So |
| 125 | we define it here by hand. */ | ||
| 125 | 126 | ||
| 126 | typedef struct _REPARSE_DATA_BUFFER { | 127 | typedef struct _REPARSE_DATA_BUFFER { |
| 127 | ULONG ReparseTag; | 128 | ULONG ReparseTag; |
| @@ -149,6 +150,12 @@ typedef struct _REPARSE_DATA_BUFFER { | |||
| 149 | } DUMMYUNIONNAME; | 150 | } DUMMYUNIONNAME; |
| 150 | } REPARSE_DATA_BUFFER, *PREPARSE_DATA_BUFFER; | 151 | } REPARSE_DATA_BUFFER, *PREPARSE_DATA_BUFFER; |
| 151 | 152 | ||
| 153 | #define FILE_DEVICE_FILE_SYSTEM 9 | ||
| 154 | #define METHOD_BUFFERED 0 | ||
| 155 | #define FILE_ANY_ACCESS 0x00000000 | ||
| 156 | #define CTL_CODE(t,f,m,a) (((t)<<16)|((a)<<14)|((f)<<2)|(m)) | ||
| 157 | #define FSCTL_GET_REPARSE_POINT \ | ||
| 158 | CTL_CODE(FILE_DEVICE_FILE_SYSTEM, 42, METHOD_BUFFERED, FILE_ANY_ACCESS) | ||
| 152 | #endif | 159 | #endif |
| 153 | 160 | ||
| 154 | /* TCP connection support. */ | 161 | /* TCP connection support. */ |
| @@ -172,7 +179,7 @@ typedef struct _REPARSE_DATA_BUFFER { | |||
| 172 | #undef sendto | 179 | #undef sendto |
| 173 | 180 | ||
| 174 | #include "w32.h" | 181 | #include "w32.h" |
| 175 | #include "ndir.h" | 182 | #include <dirent.h> |
| 176 | #include "w32common.h" | 183 | #include "w32common.h" |
| 177 | #include "w32heap.h" | 184 | #include "w32heap.h" |
| 178 | #include "w32select.h" | 185 | #include "w32select.h" |
| @@ -901,8 +908,18 @@ static char startup_dir[MAXPATHLEN]; | |||
| 901 | 908 | ||
| 902 | /* Get the current working directory. */ | 909 | /* Get the current working directory. */ |
| 903 | char * | 910 | char * |
| 904 | getwd (char *dir) | 911 | getcwd (char *dir, int dirsize) |
| 905 | { | 912 | { |
| 913 | if (!dirsize) | ||
| 914 | { | ||
| 915 | errno = EINVAL; | ||
| 916 | return NULL; | ||
| 917 | } | ||
| 918 | if (dirsize <= strlen (startup_dir)) | ||
| 919 | { | ||
| 920 | errno = ERANGE; | ||
| 921 | return NULL; | ||
| 922 | } | ||
| 906 | #if 0 | 923 | #if 0 |
| 907 | if (GetCurrentDirectory (MAXPATHLEN, dir) > 0) | 924 | if (GetCurrentDirectory (MAXPATHLEN, dir) > 0) |
| 908 | return dir; | 925 | return dir; |
| @@ -1818,7 +1835,7 @@ init_environment (char ** argv) | |||
| 1818 | memcpy (*envp, "COMSPEC=", 8); | 1835 | memcpy (*envp, "COMSPEC=", 8); |
| 1819 | } | 1836 | } |
| 1820 | 1837 | ||
| 1821 | /* Remember the initial working directory for getwd. */ | 1838 | /* Remember the initial working directory for getcwd. */ |
| 1822 | /* FIXME: Do we need to resolve possible symlinks in startup_dir? | 1839 | /* FIXME: Do we need to resolve possible symlinks in startup_dir? |
| 1823 | Does it matter anywhere in Emacs? */ | 1840 | Does it matter anywhere in Emacs? */ |
| 1824 | if (!GetCurrentDirectory (MAXPATHLEN, startup_dir)) | 1841 | if (!GetCurrentDirectory (MAXPATHLEN, startup_dir)) |
| @@ -2431,7 +2448,7 @@ is_exec (const char * name) | |||
| 2431 | and readdir. We can't use the procedures supplied in sysdep.c, | 2448 | and readdir. We can't use the procedures supplied in sysdep.c, |
| 2432 | so we provide them here. */ | 2449 | so we provide them here. */ |
| 2433 | 2450 | ||
| 2434 | struct direct dir_static; /* simulated directory contents */ | 2451 | struct dirent dir_static; /* simulated directory contents */ |
| 2435 | static HANDLE dir_find_handle = INVALID_HANDLE_VALUE; | 2452 | static HANDLE dir_find_handle = INVALID_HANDLE_VALUE; |
| 2436 | static int dir_is_fat; | 2453 | static int dir_is_fat; |
| 2437 | static char dir_pathname[MAXPATHLEN+1]; | 2454 | static char dir_pathname[MAXPATHLEN+1]; |
| @@ -2501,7 +2518,7 @@ closedir (DIR *dirp) | |||
| 2501 | xfree ((char *) dirp); | 2518 | xfree ((char *) dirp); |
| 2502 | } | 2519 | } |
| 2503 | 2520 | ||
| 2504 | struct direct * | 2521 | struct dirent * |
| 2505 | readdir (DIR *dirp) | 2522 | readdir (DIR *dirp) |
| 2506 | { | 2523 | { |
| 2507 | int downcase = !NILP (Vw32_downcase_file_names); | 2524 | int downcase = !NILP (Vw32_downcase_file_names); |
| @@ -2555,7 +2572,7 @@ readdir (DIR *dirp) | |||
| 2555 | downcase = 1; /* 8+3 aliases are returned in all caps */ | 2572 | downcase = 1; /* 8+3 aliases are returned in all caps */ |
| 2556 | } | 2573 | } |
| 2557 | dir_static.d_namlen = strlen (dir_static.d_name); | 2574 | dir_static.d_namlen = strlen (dir_static.d_name); |
| 2558 | dir_static.d_reclen = sizeof (struct direct) - MAXNAMLEN + 3 + | 2575 | dir_static.d_reclen = sizeof (struct dirent) - MAXNAMLEN + 3 + |
| 2559 | dir_static.d_namlen - dir_static.d_namlen % 4; | 2576 | dir_static.d_namlen - dir_static.d_namlen % 4; |
| 2560 | 2577 | ||
| 2561 | /* If the file name in cFileName[] includes `?' characters, it means | 2578 | /* If the file name in cFileName[] includes `?' characters, it means |
| @@ -163,7 +163,6 @@ extern int sys_spawnve (int, char *, char **, char **); | |||
| 163 | extern void register_child (int, int); | 163 | extern void register_child (int, int); |
| 164 | 164 | ||
| 165 | extern void sys_sleep (int); | 165 | extern void sys_sleep (int); |
| 166 | extern char *getwd (char *); | ||
| 167 | extern int sys_link (const char *, const char *); | 166 | extern int sys_link (const char *, const char *); |
| 168 | 167 | ||
| 169 | 168 | ||
| @@ -181,4 +180,3 @@ extern ssize_t emacs_gnutls_push (gnutls_transport_ptr_t p, | |||
| 181 | #endif /* HAVE_GNUTLS */ | 180 | #endif /* HAVE_GNUTLS */ |
| 182 | 181 | ||
| 183 | #endif /* EMACS_W32_H */ | 182 | #endif /* EMACS_W32_H */ |
| 184 | |||
diff --git a/src/w32fns.c b/src/w32fns.c index ed5625e802c..90f5b1695ea 100644 --- a/src/w32fns.c +++ b/src/w32fns.c | |||
| @@ -6167,9 +6167,9 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */) | |||
| 6167 | filename = empty_unibyte_string; | 6167 | filename = empty_unibyte_string; |
| 6168 | 6168 | ||
| 6169 | #ifdef CYGWIN | 6169 | #ifdef CYGWIN |
| 6170 | dir = Fcygwin_convert_path_to_windows (dir, Qt); | 6170 | dir = Fcygwin_convert_file_name_to_windows (dir, Qt); |
| 6171 | if (SCHARS (filename) > 0) | 6171 | if (SCHARS (filename) > 0) |
| 6172 | filename = Fcygwin_convert_path_to_windows (filename, Qnil); | 6172 | filename = Fcygwin_convert_file_name_to_windows (filename, Qnil); |
| 6173 | #endif | 6173 | #endif |
| 6174 | 6174 | ||
| 6175 | CHECK_STRING (dir); | 6175 | CHECK_STRING (dir); |
| @@ -6270,7 +6270,7 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */) | |||
| 6270 | #endif /* NTGUI_UNICODE */ | 6270 | #endif /* NTGUI_UNICODE */ |
| 6271 | 6271 | ||
| 6272 | #ifdef CYGWIN | 6272 | #ifdef CYGWIN |
| 6273 | filename = Fcygwin_convert_path_from_windows (filename, Qt); | 6273 | filename = Fcygwin_convert_file_name_from_windows (filename, Qt); |
| 6274 | #endif /* CYGWIN */ | 6274 | #endif /* CYGWIN */ |
| 6275 | 6275 | ||
| 6276 | /* Strip the dummy filename off the end of the string if we | 6276 | /* Strip the dummy filename off the end of the string if we |
diff --git a/src/w32term.c b/src/w32term.c index 032912c27f4..ab6afd32c75 100644 --- a/src/w32term.c +++ b/src/w32term.c | |||
| @@ -723,21 +723,7 @@ static void | |||
| 723 | w32_frame_up_to_date (struct frame *f) | 723 | w32_frame_up_to_date (struct frame *f) |
| 724 | { | 724 | { |
| 725 | if (FRAME_W32_P (f)) | 725 | if (FRAME_W32_P (f)) |
| 726 | { | 726 | FRAME_MOUSE_UPDATE (f); |
| 727 | Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); | ||
| 728 | |||
| 729 | if (hlinfo->mouse_face_deferred_gc | ||
| 730 | || f == hlinfo->mouse_face_mouse_frame) | ||
| 731 | { | ||
| 732 | block_input (); | ||
| 733 | if (hlinfo->mouse_face_mouse_frame) | ||
| 734 | note_mouse_highlight (hlinfo->mouse_face_mouse_frame, | ||
| 735 | hlinfo->mouse_face_mouse_x, | ||
| 736 | hlinfo->mouse_face_mouse_y); | ||
| 737 | hlinfo->mouse_face_deferred_gc = 0; | ||
| 738 | unblock_input (); | ||
| 739 | } | ||
| 740 | } | ||
| 741 | } | 727 | } |
| 742 | 728 | ||
| 743 | 729 | ||
| @@ -5979,7 +5965,6 @@ x_free_frame_resources (struct frame *f) | |||
| 5979 | hlinfo->mouse_face_end_row | 5965 | hlinfo->mouse_face_end_row |
| 5980 | = hlinfo->mouse_face_end_col = -1; | 5966 | = hlinfo->mouse_face_end_col = -1; |
| 5981 | hlinfo->mouse_face_window = Qnil; | 5967 | hlinfo->mouse_face_window = Qnil; |
| 5982 | hlinfo->mouse_face_deferred_gc = 0; | ||
| 5983 | hlinfo->mouse_face_mouse_frame = 0; | 5968 | hlinfo->mouse_face_mouse_frame = 0; |
| 5984 | } | 5969 | } |
| 5985 | 5970 | ||
diff --git a/src/w32term.h b/src/w32term.h index 83535b8faa3..ce709c1231d 100644 --- a/src/w32term.h +++ b/src/w32term.h | |||
| @@ -751,7 +751,7 @@ extern int w32_system_caret_y; | |||
| 751 | typedef BOOL (CALLBACK *LOCALE_ENUMPROCA)(LPSTR); | 751 | typedef BOOL (CALLBACK *LOCALE_ENUMPROCA)(LPSTR); |
| 752 | typedef BOOL (CALLBACK *LOCALE_ENUMPROCW)(LPWSTR); | 752 | typedef BOOL (CALLBACK *LOCALE_ENUMPROCW)(LPWSTR); |
| 753 | BOOL WINAPI EnumSystemLocalesA(LOCALE_ENUMPROCA,DWORD); | 753 | BOOL WINAPI EnumSystemLocalesA(LOCALE_ENUMPROCA,DWORD); |
| 754 | BOOL WINAPI EnumSystemLocalesW(LOCALE_ENUMPROCW,DWORD) | 754 | BOOL WINAPI EnumSystemLocalesW(LOCALE_ENUMPROCW,DWORD); |
| 755 | #ifdef UNICODE | 755 | #ifdef UNICODE |
| 756 | #define EnumSystemLocales EnumSystemLocalesW | 756 | #define EnumSystemLocales EnumSystemLocalesW |
| 757 | #else | 757 | #else |
diff --git a/src/xdisp.c b/src/xdisp.c index 27d9fff0b7d..5d260d851ef 100644 --- a/src/xdisp.c +++ b/src/xdisp.c | |||
| @@ -515,9 +515,8 @@ Lisp_Object Qmenu_bar_update_hook; | |||
| 515 | 515 | ||
| 516 | static int overlay_arrow_seen; | 516 | static int overlay_arrow_seen; |
| 517 | 517 | ||
| 518 | /* Number of windows showing the buffer of the selected window (or | 518 | /* Number of windows showing the buffer of the selected |
| 519 | another buffer with the same base buffer). keyboard.c refers to | 519 | window (or another buffer with the same base buffer). */ |
| 520 | this. */ | ||
| 521 | 520 | ||
| 522 | int buffer_shared; | 521 | int buffer_shared; |
| 523 | 522 | ||
| @@ -9643,7 +9642,7 @@ message2_nolog (const char *m, ptrdiff_t nbytes, int multibyte) | |||
| 9643 | do_pending_window_change (0); | 9642 | do_pending_window_change (0); |
| 9644 | echo_area_display (1); | 9643 | echo_area_display (1); |
| 9645 | do_pending_window_change (0); | 9644 | do_pending_window_change (0); |
| 9646 | if (FRAME_TERMINAL (f)->frame_up_to_date_hook != 0 && ! gc_in_progress) | 9645 | if (FRAME_TERMINAL (f)->frame_up_to_date_hook) |
| 9647 | (*FRAME_TERMINAL (f)->frame_up_to_date_hook) (f); | 9646 | (*FRAME_TERMINAL (f)->frame_up_to_date_hook) (f); |
| 9648 | } | 9647 | } |
| 9649 | } | 9648 | } |
| @@ -9740,7 +9739,7 @@ message3_nolog (Lisp_Object m, ptrdiff_t nbytes, int multibyte) | |||
| 9740 | do_pending_window_change (0); | 9739 | do_pending_window_change (0); |
| 9741 | echo_area_display (1); | 9740 | echo_area_display (1); |
| 9742 | do_pending_window_change (0); | 9741 | do_pending_window_change (0); |
| 9743 | if (FRAME_TERMINAL (f)->frame_up_to_date_hook != 0 && ! gc_in_progress) | 9742 | if (FRAME_TERMINAL (f)->frame_up_to_date_hook) |
| 9744 | (*FRAME_TERMINAL (f)->frame_up_to_date_hook) (f); | 9743 | (*FRAME_TERMINAL (f)->frame_up_to_date_hook) (f); |
| 9745 | } | 9744 | } |
| 9746 | } | 9745 | } |
| @@ -10889,8 +10888,41 @@ echo_area_display (int update_frame_p) | |||
| 10889 | return window_height_changed_p; | 10888 | return window_height_changed_p; |
| 10890 | } | 10889 | } |
| 10891 | 10890 | ||
| 10891 | /* Nonzero if the current buffer is shown in more than | ||
| 10892 | one window and was modified since last display. */ | ||
| 10893 | |||
| 10894 | static int | ||
| 10895 | buffer_shared_and_changed (void) | ||
| 10896 | { | ||
| 10897 | return (buffer_shared > 1 && UNCHANGED_MODIFIED < MODIFF); | ||
| 10898 | } | ||
| 10899 | |||
| 10900 | /* Nonzero if W doesn't reflect the actual state of | ||
| 10901 | current buffer due to its text or overlays change. */ | ||
| 10902 | |||
| 10903 | static int | ||
| 10904 | window_outdated (struct window *w) | ||
| 10905 | { | ||
| 10906 | eassert (XBUFFER (w->buffer) == current_buffer); | ||
| 10907 | return (w->last_modified < MODIFF | ||
| 10908 | || w->last_overlay_modified < OVERLAY_MODIFF); | ||
| 10909 | } | ||
| 10910 | |||
| 10911 | /* Nonzero if W's buffer was changed but not saved or Transient Mark mode | ||
| 10912 | is enabled and mark of W's buffer was changed since last W's update. */ | ||
| 10913 | |||
| 10914 | static int | ||
| 10915 | window_buffer_changed (struct window *w) | ||
| 10916 | { | ||
| 10917 | struct buffer *b = XBUFFER (w->buffer); | ||
| 10918 | |||
| 10919 | eassert (BUFFER_LIVE_P (b)); | ||
| 10920 | |||
| 10921 | return (((BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)) != w->last_had_star) | ||
| 10922 | || ((!NILP (Vtransient_mark_mode) && !NILP (BVAR (b, mark_active))) | ||
| 10923 | != !NILP (w->region_showing))); | ||
| 10924 | } | ||
| 10892 | 10925 | ||
| 10893 | |||
| 10894 | /*********************************************************************** | 10926 | /*********************************************************************** |
| 10895 | Mode Lines and Frame Titles | 10927 | Mode Lines and Frame Titles |
| 10896 | ***********************************************************************/ | 10928 | ***********************************************************************/ |
| @@ -11196,7 +11228,7 @@ prepare_menu_bars (void) | |||
| 11196 | /* Update the menu bar item lists, if appropriate. This has to be | 11228 | /* Update the menu bar item lists, if appropriate. This has to be |
| 11197 | done before any actual redisplay or generation of display lines. */ | 11229 | done before any actual redisplay or generation of display lines. */ |
| 11198 | all_windows = (update_mode_lines | 11230 | all_windows = (update_mode_lines |
| 11199 | || buffer_shared > 1 | 11231 | || buffer_shared_and_changed () |
| 11200 | || windows_or_buffers_changed); | 11232 | || windows_or_buffers_changed); |
| 11201 | if (all_windows) | 11233 | if (all_windows) |
| 11202 | { | 11234 | { |
| @@ -11310,12 +11342,7 @@ update_menu_bar (struct frame *f, int save_match_data, int hooks_run) | |||
| 11310 | /* This used to test w->update_mode_line, but we believe | 11342 | /* This used to test w->update_mode_line, but we believe |
| 11311 | there is no need to recompute the menu in that case. */ | 11343 | there is no need to recompute the menu in that case. */ |
| 11312 | || update_mode_lines | 11344 | || update_mode_lines |
| 11313 | || ((BUF_SAVE_MODIFF (XBUFFER (w->buffer)) | 11345 | || window_buffer_changed (w)) |
| 11314 | < BUF_MODIFF (XBUFFER (w->buffer))) | ||
| 11315 | != w->last_had_star) | ||
| 11316 | || ((!NILP (Vtransient_mark_mode) | ||
| 11317 | && !NILP (BVAR (XBUFFER (w->buffer), mark_active))) | ||
| 11318 | != !NILP (w->region_showing))) | ||
| 11319 | { | 11346 | { |
| 11320 | struct buffer *prev = current_buffer; | 11347 | struct buffer *prev = current_buffer; |
| 11321 | ptrdiff_t count = SPECPDL_INDEX (); | 11348 | ptrdiff_t count = SPECPDL_INDEX (); |
| @@ -11467,11 +11494,18 @@ FRAME_PTR last_mouse_frame; | |||
| 11467 | 11494 | ||
| 11468 | int last_tool_bar_item; | 11495 | int last_tool_bar_item; |
| 11469 | 11496 | ||
| 11470 | 11497 | /* Select `frame' temporarily without running all the code in | |
| 11498 | do_switch_frame. | ||
| 11499 | FIXME: Maybe do_switch_frame should be trimmed down similarly | ||
| 11500 | when `norecord' is set. */ | ||
| 11471 | static Lisp_Object | 11501 | static Lisp_Object |
| 11472 | update_tool_bar_unwind (Lisp_Object frame) | 11502 | fast_set_selected_frame (Lisp_Object frame) |
| 11473 | { | 11503 | { |
| 11474 | selected_frame = frame; | 11504 | if (!EQ (selected_frame, frame)) |
| 11505 | { | ||
| 11506 | selected_frame = frame; | ||
| 11507 | selected_window = XFRAME (frame)->selected_window; | ||
| 11508 | } | ||
| 11475 | return Qnil; | 11509 | return Qnil; |
| 11476 | } | 11510 | } |
| 11477 | 11511 | ||
| @@ -11508,12 +11542,7 @@ update_tool_bar (struct frame *f, int save_match_data) | |||
| 11508 | if (windows_or_buffers_changed | 11542 | if (windows_or_buffers_changed |
| 11509 | || w->update_mode_line | 11543 | || w->update_mode_line |
| 11510 | || update_mode_lines | 11544 | || update_mode_lines |
| 11511 | || ((BUF_SAVE_MODIFF (XBUFFER (w->buffer)) | 11545 | || window_buffer_changed (w)) |
| 11512 | < BUF_MODIFF (XBUFFER (w->buffer))) | ||
| 11513 | != w->last_had_star) | ||
| 11514 | || ((!NILP (Vtransient_mark_mode) | ||
| 11515 | && !NILP (BVAR (XBUFFER (w->buffer), mark_active))) | ||
| 11516 | != !NILP (w->region_showing))) | ||
| 11517 | { | 11546 | { |
| 11518 | struct buffer *prev = current_buffer; | 11547 | struct buffer *prev = current_buffer; |
| 11519 | ptrdiff_t count = SPECPDL_INDEX (); | 11548 | ptrdiff_t count = SPECPDL_INDEX (); |
| @@ -11543,9 +11572,13 @@ update_tool_bar (struct frame *f, int save_match_data) | |||
| 11543 | before calling tool_bar_items, because the calculation of | 11572 | before calling tool_bar_items, because the calculation of |
| 11544 | the tool-bar keymap uses the selected frame (see | 11573 | the tool-bar keymap uses the selected frame (see |
| 11545 | `tool-bar-make-keymap' in tool-bar.el). */ | 11574 | `tool-bar-make-keymap' in tool-bar.el). */ |
| 11546 | record_unwind_protect (update_tool_bar_unwind, selected_frame); | 11575 | eassert (EQ (selected_window, |
| 11576 | /* Since we only explicitly preserve selected_frame, | ||
| 11577 | check that selected_window would be redundant. */ | ||
| 11578 | XFRAME (selected_frame)->selected_window)); | ||
| 11579 | record_unwind_protect (fast_set_selected_frame, selected_frame); | ||
| 11547 | XSETFRAME (frame, f); | 11580 | XSETFRAME (frame, f); |
| 11548 | selected_frame = frame; | 11581 | fast_set_selected_frame (frame); |
| 11549 | 11582 | ||
| 11550 | /* Build desired tool-bar items from keymaps. */ | 11583 | /* Build desired tool-bar items from keymaps. */ |
| 11551 | new_tool_bar | 11584 | new_tool_bar |
| @@ -12616,8 +12649,7 @@ text_outside_line_unchanged_p (struct window *w, | |||
| 12616 | int unchanged_p = 1; | 12649 | int unchanged_p = 1; |
| 12617 | 12650 | ||
| 12618 | /* If text or overlays have changed, see where. */ | 12651 | /* If text or overlays have changed, see where. */ |
| 12619 | if (w->last_modified < MODIFF | 12652 | if (window_outdated (w)) |
| 12620 | || w->last_overlay_modified < OVERLAY_MODIFF) | ||
| 12621 | { | 12653 | { |
| 12622 | /* Gap in the line? */ | 12654 | /* Gap in the line? */ |
| 12623 | if (GPT < start || Z - GPT < end) | 12655 | if (GPT < start || Z - GPT < end) |
| @@ -12961,7 +12993,7 @@ redisplay_internal (void) | |||
| 12961 | ptrdiff_t count, count1; | 12993 | ptrdiff_t count, count1; |
| 12962 | struct frame *sf; | 12994 | struct frame *sf; |
| 12963 | int polling_stopped_here = 0; | 12995 | int polling_stopped_here = 0; |
| 12964 | Lisp_Object old_frame = selected_frame; | 12996 | Lisp_Object tail, frame, old_frame = selected_frame; |
| 12965 | struct backtrace backtrace; | 12997 | struct backtrace backtrace; |
| 12966 | 12998 | ||
| 12967 | /* Non-zero means redisplay has to consider all windows on all | 12999 | /* Non-zero means redisplay has to consider all windows on all |
| @@ -13013,15 +13045,8 @@ redisplay_internal (void) | |||
| 13013 | backtrace.debug_on_exit = 0; | 13045 | backtrace.debug_on_exit = 0; |
| 13014 | backtrace_list = &backtrace; | 13046 | backtrace_list = &backtrace; |
| 13015 | 13047 | ||
| 13016 | { | 13048 | FOR_EACH_FRAME (tail, frame) |
| 13017 | Lisp_Object tail, frame; | 13049 | XFRAME (frame)->already_hscrolled_p = 0; |
| 13018 | |||
| 13019 | FOR_EACH_FRAME (tail, frame) | ||
| 13020 | { | ||
| 13021 | struct frame *f = XFRAME (frame); | ||
| 13022 | f->already_hscrolled_p = 0; | ||
| 13023 | } | ||
| 13024 | } | ||
| 13025 | 13050 | ||
| 13026 | retry: | 13051 | retry: |
| 13027 | /* Remember the currently selected window. */ | 13052 | /* Remember the currently selected window. */ |
| @@ -13071,25 +13096,20 @@ redisplay_internal (void) | |||
| 13071 | FRAME_TTY (sf)->previous_frame = sf; | 13096 | FRAME_TTY (sf)->previous_frame = sf; |
| 13072 | } | 13097 | } |
| 13073 | 13098 | ||
| 13074 | /* Set the visible flags for all frames. Do this before checking | 13099 | /* Set the visible flags for all frames. Do this before checking for |
| 13075 | for resized or garbaged frames; they want to know if their frames | 13100 | resized or garbaged frames; they want to know if their frames are |
| 13076 | are visible. See the comment in frame.h for | 13101 | visible. See the comment in frame.h for FRAME_SAMPLE_VISIBILITY. */ |
| 13077 | FRAME_SAMPLE_VISIBILITY. */ | 13102 | number_of_visible_frames = 0; |
| 13078 | { | ||
| 13079 | Lisp_Object tail, frame; | ||
| 13080 | 13103 | ||
| 13081 | number_of_visible_frames = 0; | 13104 | FOR_EACH_FRAME (tail, frame) |
| 13082 | 13105 | { | |
| 13083 | FOR_EACH_FRAME (tail, frame) | 13106 | struct frame *f = XFRAME (frame); |
| 13084 | { | ||
| 13085 | struct frame *f = XFRAME (frame); | ||
| 13086 | 13107 | ||
| 13087 | FRAME_SAMPLE_VISIBILITY (f); | 13108 | FRAME_SAMPLE_VISIBILITY (f); |
| 13088 | if (FRAME_VISIBLE_P (f)) | 13109 | if (FRAME_VISIBLE_P (f)) |
| 13089 | ++number_of_visible_frames; | 13110 | ++number_of_visible_frames; |
| 13090 | clear_desired_matrices (f); | 13111 | clear_desired_matrices (f); |
| 13091 | } | 13112 | } |
| 13092 | } | ||
| 13093 | 13113 | ||
| 13094 | /* Notice any pending interrupt request to change frame size. */ | 13114 | /* Notice any pending interrupt request to change frame size. */ |
| 13095 | do_pending_window_change (1); | 13115 | do_pending_window_change (1); |
| @@ -13116,7 +13136,7 @@ redisplay_internal (void) | |||
| 13116 | if ((SAVE_MODIFF < MODIFF) != w->last_had_star) | 13136 | if ((SAVE_MODIFF < MODIFF) != w->last_had_star) |
| 13117 | { | 13137 | { |
| 13118 | w->update_mode_line = 1; | 13138 | w->update_mode_line = 1; |
| 13119 | if (buffer_shared > 1) | 13139 | if (buffer_shared_and_changed ()) |
| 13120 | update_mode_lines++; | 13140 | update_mode_lines++; |
| 13121 | } | 13141 | } |
| 13122 | 13142 | ||
| @@ -13128,9 +13148,7 @@ redisplay_internal (void) | |||
| 13128 | if (!NILP (w->column_number_displayed) | 13148 | if (!NILP (w->column_number_displayed) |
| 13129 | /* This alternative quickly identifies a common case | 13149 | /* This alternative quickly identifies a common case |
| 13130 | where no change is needed. */ | 13150 | where no change is needed. */ |
| 13131 | && !(PT == w->last_point | 13151 | && !(PT == w->last_point && !window_outdated (w)) |
| 13132 | && w->last_modified >= MODIFF | ||
| 13133 | && w->last_overlay_modified >= OVERLAY_MODIFF) | ||
| 13134 | && (XFASTINT (w->column_number_displayed) != current_column ())) | 13152 | && (XFASTINT (w->column_number_displayed) != current_column ())) |
| 13135 | w->update_mode_line = 1; | 13153 | w->update_mode_line = 1; |
| 13136 | 13154 | ||
| @@ -13141,7 +13159,8 @@ redisplay_internal (void) | |||
| 13141 | /* The variable buffer_shared is set in redisplay_window and | 13159 | /* The variable buffer_shared is set in redisplay_window and |
| 13142 | indicates that we redisplay a buffer in different windows. See | 13160 | indicates that we redisplay a buffer in different windows. See |
| 13143 | there. */ | 13161 | there. */ |
| 13144 | consider_all_windows_p = (update_mode_lines || buffer_shared > 1 | 13162 | consider_all_windows_p = (update_mode_lines |
| 13163 | || buffer_shared_and_changed () | ||
| 13145 | || cursor_type_changed); | 13164 | || cursor_type_changed); |
| 13146 | 13165 | ||
| 13147 | /* If specs for an arrow have changed, do thorough redisplay | 13166 | /* If specs for an arrow have changed, do thorough redisplay |
| @@ -13191,18 +13210,16 @@ redisplay_internal (void) | |||
| 13191 | } | 13210 | } |
| 13192 | } | 13211 | } |
| 13193 | else if (EQ (selected_window, minibuf_window) | 13212 | else if (EQ (selected_window, minibuf_window) |
| 13194 | && (current_buffer->clip_changed | 13213 | && (current_buffer->clip_changed || window_outdated (w)) |
| 13195 | || w->last_modified < MODIFF | ||
| 13196 | || w->last_overlay_modified < OVERLAY_MODIFF) | ||
| 13197 | && resize_mini_window (w, 0)) | 13214 | && resize_mini_window (w, 0)) |
| 13198 | { | 13215 | { |
| 13199 | /* Resized active mini-window to fit the size of what it is | 13216 | /* Resized active mini-window to fit the size of what it is |
| 13200 | showing if its contents might have changed. */ | 13217 | showing if its contents might have changed. */ |
| 13201 | must_finish = 1; | 13218 | must_finish = 1; |
| 13202 | /* FIXME: this causes all frames to be updated, which seems unnecessary | 13219 | /* FIXME: this causes all frames to be updated, which seems unnecessary |
| 13203 | since only the current frame needs to be considered. This function needs | 13220 | since only the current frame needs to be considered. This function |
| 13204 | to be rewritten with two variables, consider_all_windows and | 13221 | needs to be rewritten with two variables, consider_all_windows and |
| 13205 | consider_all_frames. */ | 13222 | consider_all_frames. */ |
| 13206 | consider_all_windows_p = 1; | 13223 | consider_all_windows_p = 1; |
| 13207 | ++windows_or_buffers_changed; | 13224 | ++windows_or_buffers_changed; |
| 13208 | ++update_mode_lines; | 13225 | ++update_mode_lines; |
| @@ -13257,9 +13274,7 @@ redisplay_internal (void) | |||
| 13257 | || FETCH_BYTE (BYTEPOS (tlbufpos)) == '\n')) | 13274 | || FETCH_BYTE (BYTEPOS (tlbufpos)) == '\n')) |
| 13258 | /* Former continuation line has disappeared by becoming empty. */ | 13275 | /* Former continuation line has disappeared by becoming empty. */ |
| 13259 | goto cancel; | 13276 | goto cancel; |
| 13260 | else if (w->last_modified < MODIFF | 13277 | else if (window_outdated (w) || MINI_WINDOW_P (w)) |
| 13261 | || w->last_overlay_modified < OVERLAY_MODIFF | ||
| 13262 | || MINI_WINDOW_P (w)) | ||
| 13263 | { | 13278 | { |
| 13264 | /* We have to handle the case of continuation around a | 13279 | /* We have to handle the case of continuation around a |
| 13265 | wide-column character (see the comment in indent.c around | 13280 | wide-column character (see the comment in indent.c around |
| @@ -13433,7 +13448,7 @@ redisplay_internal (void) | |||
| 13433 | } | 13448 | } |
| 13434 | 13449 | ||
| 13435 | CHARPOS (this_line_start_pos) = 0; | 13450 | CHARPOS (this_line_start_pos) = 0; |
| 13436 | consider_all_windows_p |= buffer_shared > 1; | 13451 | consider_all_windows_p |= buffer_shared_and_changed (); |
| 13437 | ++clear_face_cache_count; | 13452 | ++clear_face_cache_count; |
| 13438 | #ifdef HAVE_WINDOW_SYSTEM | 13453 | #ifdef HAVE_WINDOW_SYSTEM |
| 13439 | ++clear_image_cache_count; | 13454 | ++clear_image_cache_count; |
| @@ -13445,8 +13460,6 @@ redisplay_internal (void) | |||
| 13445 | 13460 | ||
| 13446 | if (consider_all_windows_p) | 13461 | if (consider_all_windows_p) |
| 13447 | { | 13462 | { |
| 13448 | Lisp_Object tail, frame; | ||
| 13449 | |||
| 13450 | FOR_EACH_FRAME (tail, frame) | 13463 | FOR_EACH_FRAME (tail, frame) |
| 13451 | XFRAME (frame)->updated_p = 0; | 13464 | XFRAME (frame)->updated_p = 0; |
| 13452 | 13465 | ||
| @@ -13656,7 +13669,6 @@ redisplay_internal (void) | |||
| 13656 | frames here explicitly. */ | 13669 | frames here explicitly. */ |
| 13657 | if (!pending) | 13670 | if (!pending) |
| 13658 | { | 13671 | { |
| 13659 | Lisp_Object tail, frame; | ||
| 13660 | int new_count = 0; | 13672 | int new_count = 0; |
| 13661 | 13673 | ||
| 13662 | FOR_EACH_FRAME (tail, frame) | 13674 | FOR_EACH_FRAME (tail, frame) |
| @@ -15510,8 +15522,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) | |||
| 15510 | = (!NILP (w->window_end_valid) | 15522 | = (!NILP (w->window_end_valid) |
| 15511 | && !current_buffer->clip_changed | 15523 | && !current_buffer->clip_changed |
| 15512 | && !current_buffer->prevent_redisplay_optimizations_p | 15524 | && !current_buffer->prevent_redisplay_optimizations_p |
| 15513 | && w->last_modified >= MODIFF | 15525 | && !window_outdated (w)); |
| 15514 | && w->last_overlay_modified >= OVERLAY_MODIFF); | ||
| 15515 | 15526 | ||
| 15516 | /* Run the window-bottom-change-functions | 15527 | /* Run the window-bottom-change-functions |
| 15517 | if it is possible that the text on the screen has changed | 15528 | if it is possible that the text on the screen has changed |
| @@ -15533,8 +15544,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) | |||
| 15533 | buffer_unchanged_p | 15544 | buffer_unchanged_p |
| 15534 | = (!NILP (w->window_end_valid) | 15545 | = (!NILP (w->window_end_valid) |
| 15535 | && !current_buffer->clip_changed | 15546 | && !current_buffer->clip_changed |
| 15536 | && w->last_modified >= MODIFF | 15547 | && !window_outdated (w)); |
| 15537 | && w->last_overlay_modified >= OVERLAY_MODIFF); | ||
| 15538 | 15548 | ||
| 15539 | /* When windows_or_buffers_changed is non-zero, we can't rely on | 15549 | /* When windows_or_buffers_changed is non-zero, we can't rely on |
| 15540 | the window end being valid, so set it to nil there. */ | 15550 | the window end being valid, so set it to nil there. */ |
| @@ -15559,9 +15569,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) | |||
| 15559 | if (!NILP (w->column_number_displayed) | 15569 | if (!NILP (w->column_number_displayed) |
| 15560 | /* This alternative quickly identifies a common case | 15570 | /* This alternative quickly identifies a common case |
| 15561 | where no change is needed. */ | 15571 | where no change is needed. */ |
| 15562 | && !(PT == w->last_point | 15572 | && !(PT == w->last_point && !window_outdated (w)) |
| 15563 | && w->last_modified >= MODIFF | ||
| 15564 | && w->last_overlay_modified >= OVERLAY_MODIFF) | ||
| 15565 | && (XFASTINT (w->column_number_displayed) != current_column ())) | 15573 | && (XFASTINT (w->column_number_displayed) != current_column ())) |
| 15566 | update_mode_line = 1; | 15574 | update_mode_line = 1; |
| 15567 | 15575 | ||
| @@ -15803,8 +15811,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) | |||
| 15803 | && (CHARPOS (startp) < ZV | 15811 | && (CHARPOS (startp) < ZV |
| 15804 | /* Avoid starting at end of buffer. */ | 15812 | /* Avoid starting at end of buffer. */ |
| 15805 | || CHARPOS (startp) == BEGV | 15813 | || CHARPOS (startp) == BEGV |
| 15806 | || (w->last_modified >= MODIFF | 15814 | || !window_outdated (w))) |
| 15807 | && w->last_overlay_modified >= OVERLAY_MODIFF))) | ||
| 15808 | { | 15815 | { |
| 15809 | int d1, d2, d3, d4, d5, d6; | 15816 | int d1, d2, d3, d4, d5, d6; |
| 15810 | 15817 | ||
| @@ -27678,12 +27685,6 @@ note_mouse_highlight (struct frame *f, int x, int y) | |||
| 27678 | if (hlinfo->mouse_face_defer) | 27685 | if (hlinfo->mouse_face_defer) |
| 27679 | return; | 27686 | return; |
| 27680 | 27687 | ||
| 27681 | if (gc_in_progress) | ||
| 27682 | { | ||
| 27683 | hlinfo->mouse_face_deferred_gc = 1; | ||
| 27684 | return; | ||
| 27685 | } | ||
| 27686 | |||
| 27687 | /* Which window is that in? */ | 27688 | /* Which window is that in? */ |
| 27688 | window = window_from_coordinates (f, x, y, &part, 1); | 27689 | window = window_from_coordinates (f, x, y, &part, 1); |
| 27689 | 27690 | ||
diff --git a/src/xftfont.c b/src/xftfont.c index 372ed87705f..181a1da9b38 100644 --- a/src/xftfont.c +++ b/src/xftfont.c | |||
| @@ -369,7 +369,7 @@ xftfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size) | |||
| 369 | ASET (font_object, FONT_FORMAT_INDEX, | 369 | ASET (font_object, FONT_FORMAT_INDEX, |
| 370 | ftfont_font_format (xftfont->pattern, filename)); | 370 | ftfont_font_format (xftfont->pattern, filename)); |
| 371 | font = XFONT_OBJECT (font_object); | 371 | font = XFONT_OBJECT (font_object); |
| 372 | font->pixel_size = pixel_size; | 372 | font->pixel_size = size; |
| 373 | font->driver = &xftfont_driver; | 373 | font->driver = &xftfont_driver; |
| 374 | font->encoding_charset = font->repertory_charset = -1; | 374 | font->encoding_charset = font->repertory_charset = -1; |
| 375 | 375 | ||
| @@ -387,8 +387,6 @@ xftfont_open (FRAME_PTR f, Lisp_Object entity, int pixel_size) | |||
| 387 | xftfont_info->matrix.xy = 0x10000L * matrix->xy; | 387 | xftfont_info->matrix.xy = 0x10000L * matrix->xy; |
| 388 | xftfont_info->matrix.yx = 0x10000L * matrix->yx; | 388 | xftfont_info->matrix.yx = 0x10000L * matrix->yx; |
| 389 | } | 389 | } |
| 390 | font->pixel_size = size; | ||
| 391 | font->driver = &xftfont_driver; | ||
| 392 | if (INTEGERP (AREF (entity, FONT_SPACING_INDEX))) | 390 | if (INTEGERP (AREF (entity, FONT_SPACING_INDEX))) |
| 393 | spacing = XINT (AREF (entity, FONT_SPACING_INDEX)); | 391 | spacing = XINT (AREF (entity, FONT_SPACING_INDEX)); |
| 394 | else | 392 | else |
diff --git a/src/xterm.c b/src/xterm.c index 463d82b4ee2..61e942e10d2 100644 --- a/src/xterm.c +++ b/src/xterm.c | |||
| @@ -669,21 +669,7 @@ static void | |||
| 669 | XTframe_up_to_date (struct frame *f) | 669 | XTframe_up_to_date (struct frame *f) |
| 670 | { | 670 | { |
| 671 | if (FRAME_X_P (f)) | 671 | if (FRAME_X_P (f)) |
| 672 | { | 672 | FRAME_MOUSE_UPDATE (f); |
| 673 | Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); | ||
| 674 | |||
| 675 | if (hlinfo->mouse_face_deferred_gc | ||
| 676 | || f == hlinfo->mouse_face_mouse_frame) | ||
| 677 | { | ||
| 678 | block_input (); | ||
| 679 | if (hlinfo->mouse_face_mouse_frame) | ||
| 680 | note_mouse_highlight (hlinfo->mouse_face_mouse_frame, | ||
| 681 | hlinfo->mouse_face_mouse_x, | ||
| 682 | hlinfo->mouse_face_mouse_y); | ||
| 683 | hlinfo->mouse_face_deferred_gc = 0; | ||
| 684 | unblock_input (); | ||
| 685 | } | ||
| 686 | } | ||
| 687 | } | 673 | } |
| 688 | 674 | ||
| 689 | 675 | ||
| @@ -9502,7 +9488,6 @@ x_free_frame_resources (struct frame *f) | |||
| 9502 | hlinfo->mouse_face_end_row | 9488 | hlinfo->mouse_face_end_row |
| 9503 | = hlinfo->mouse_face_end_col = -1; | 9489 | = hlinfo->mouse_face_end_col = -1; |
| 9504 | hlinfo->mouse_face_window = Qnil; | 9490 | hlinfo->mouse_face_window = Qnil; |
| 9505 | hlinfo->mouse_face_deferred_gc = 0; | ||
| 9506 | hlinfo->mouse_face_mouse_frame = 0; | 9491 | hlinfo->mouse_face_mouse_frame = 0; |
| 9507 | } | 9492 | } |
| 9508 | 9493 | ||
| @@ -10153,7 +10138,6 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) | |||
| 10153 | dpyinfo->bitmaps_last = 0; | 10138 | dpyinfo->bitmaps_last = 0; |
| 10154 | dpyinfo->scratch_cursor_gc = 0; | 10139 | dpyinfo->scratch_cursor_gc = 0; |
| 10155 | hlinfo->mouse_face_mouse_frame = 0; | 10140 | hlinfo->mouse_face_mouse_frame = 0; |
| 10156 | hlinfo->mouse_face_deferred_gc = 0; | ||
| 10157 | hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; | 10141 | hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; |
| 10158 | hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; | 10142 | hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; |
| 10159 | hlinfo->mouse_face_face_id = DEFAULT_FACE_ID; | 10143 | hlinfo->mouse_face_face_id = DEFAULT_FACE_ID; |
diff --git a/test/ChangeLog b/test/ChangeLog index f11325d0318..b66c2925287 100644 --- a/test/ChangeLog +++ b/test/ChangeLog | |||
| @@ -1,3 +1,14 @@ | |||
| 1 | 2012-11-20 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * automated/advice-tests.el (advice-tests--data): Remove. | ||
| 4 | (advice-tests): Move the tests directly here instead. | ||
| 5 | Add called-interactively-p tests. | ||
| 6 | |||
| 7 | 2012-11-19 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 8 | |||
| 9 | * automated/ert-x-tests.el: Use cl-lib. | ||
| 10 | * automated/ert-tests.el: Use lexical-binding and cl-lib. | ||
| 11 | |||
| 1 | 2012-11-14 Dmitry Gutov <dgutov@yandex.ru> | 12 | 2012-11-14 Dmitry Gutov <dgutov@yandex.ru> |
| 2 | 13 | ||
| 3 | * automated/ruby-mode-tests.el (ruby-indent-singleton-class): Pass. | 14 | * automated/ruby-mode-tests.el (ruby-indent-singleton-class): Pass. |
| @@ -5,8 +16,8 @@ | |||
| 5 | (ruby-indent-inside-heredoc-after-space): New tests. | 16 | (ruby-indent-inside-heredoc-after-space): New tests. |
| 6 | Change direct font-lock face references to var references. | 17 | Change direct font-lock face references to var references. |
| 7 | (ruby-interpolation-suppresses-syntax-inside): New test. | 18 | (ruby-interpolation-suppresses-syntax-inside): New test. |
| 8 | (ruby-interpolation-inside-percent-literal-with-paren): New | 19 | (ruby-interpolation-inside-percent-literal-with-paren): |
| 9 | failing test. | 20 | New failing test. |
| 10 | 21 | ||
| 11 | 2012-11-13 Dmitry Gutov <dgutov@yandex.ru> | 22 | 2012-11-13 Dmitry Gutov <dgutov@yandex.ru> |
| 12 | 23 | ||
diff --git a/test/automated/advice-tests.el b/test/automated/advice-tests.el index 80321f8f3f9..94f69e77e43 100644 --- a/test/automated/advice-tests.el +++ b/test/automated/advice-tests.el | |||
| @@ -21,81 +21,94 @@ | |||
| 21 | 21 | ||
| 22 | ;;; Code: | 22 | ;;; Code: |
| 23 | 23 | ||
| 24 | (defvar advice-tests--data | 24 | (ert-deftest advice-tests () |
| 25 | '(((defun sm-test1 (x) (+ x 4)) | 25 | "Test advice code." |
| 26 | (sm-test1 6) 10) | 26 | (with-temp-buffer |
| 27 | ((advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5))) | 27 | (defun sm-test1 (x) (+ x 4)) |
| 28 | (sm-test1 6) 50) | 28 | (should (equal (sm-test1 6) 10)) |
| 29 | ((defun sm-test1 (x) (+ x 14)) | 29 | (advice-add 'sm-test1 :around (lambda (f y) (* (funcall f y) 5))) |
| 30 | (sm-test1 6) 100) | 30 | (should (equal (sm-test1 6) 50)) |
| 31 | ((null (get 'sm-test1 'defalias-fset-function)) nil) | 31 | (defun sm-test1 (x) (+ x 14)) |
| 32 | ((advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5))) | 32 | (should (equal (sm-test1 6) 100)) |
| 33 | (sm-test1 6) 20) | 33 | (should (equal (null (get 'sm-test1 'defalias-fset-function)) nil)) |
| 34 | ((null (get 'sm-test1 'defalias-fset-function)) t) | 34 | (advice-remove 'sm-test1 (lambda (f y) (* (funcall f y) 5))) |
| 35 | 35 | (should (equal (sm-test1 6) 20)) | |
| 36 | ((defun sm-test2 (x) (+ x 4)) | 36 | (should (equal (null (get 'sm-test1 'defalias-fset-function)) t)) |
| 37 | (sm-test2 6) 10) | 37 | |
| 38 | ((defadvice sm-test2 (around sm-test activate) | 38 | (defun sm-test2 (x) (+ x 4)) |
| 39 | (should (equal (sm-test2 6) 10)) | ||
| 40 | (defadvice sm-test2 (around sm-test activate) | ||
| 39 | ad-do-it (setq ad-return-value (* ad-return-value 5))) | 41 | ad-do-it (setq ad-return-value (* ad-return-value 5))) |
| 40 | (sm-test2 6) 50) | 42 | (should (equal (sm-test2 6) 50)) |
| 41 | ((ad-deactivate 'sm-test2) | 43 | (ad-deactivate 'sm-test2) |
| 42 | (sm-test2 6) 10) | 44 | (should (equal (sm-test2 6) 10)) |
| 43 | ((ad-activate 'sm-test2) | 45 | (ad-activate 'sm-test2) |
| 44 | (sm-test2 6) 50) | 46 | (should (equal (sm-test2 6) 50)) |
| 45 | ((defun sm-test2 (x) (+ x 14)) | 47 | (defun sm-test2 (x) (+ x 14)) |
| 46 | (sm-test2 6) 100) | 48 | (should (equal (sm-test2 6) 100)) |
| 47 | ((null (get 'sm-test2 'defalias-fset-function)) nil) | 49 | (should (equal (null (get 'sm-test2 'defalias-fset-function)) nil)) |
| 48 | ((ad-remove-advice 'sm-test2 'around 'sm-test) | 50 | (ad-remove-advice 'sm-test2 'around 'sm-test) |
| 49 | (sm-test2 6) 100) | 51 | (should (equal (sm-test2 6) 100)) |
| 50 | ((ad-activate 'sm-test2) | 52 | (ad-activate 'sm-test2) |
| 51 | (sm-test2 6) 20) | 53 | (should (equal (sm-test2 6) 20)) |
| 52 | ((null (get 'sm-test2 'defalias-fset-function)) t) | 54 | (should (equal (null (get 'sm-test2 'defalias-fset-function)) t)) |
| 53 | 55 | ||
| 54 | ((advice-add 'sm-test3 :around | 56 | (advice-add 'sm-test3 :around |
| 55 | (lambda (f &rest args) `(toto ,(apply f args))) | 57 | (lambda (f &rest args) `(toto ,(apply f args))) |
| 56 | '((name . wrap-with-toto))) | 58 | '((name . wrap-with-toto))) |
| 57 | (defmacro sm-test3 (x) `(call-test3 ,x)) | 59 | (defmacro sm-test3 (x) `(call-test3 ,x)) |
| 58 | (macroexpand '(sm-test3 56)) (toto (call-test3 56))) | 60 | (should (equal (macroexpand '(sm-test3 56)) '(toto (call-test3 56)))) |
| 59 | 61 | ||
| 60 | ((defadvice sm-test4 (around wrap-with-toto activate) | 62 | (defadvice sm-test4 (around wrap-with-toto activate) |
| 61 | ad-do-it (setq ad-return-value `(toto ,ad-return-value))) | 63 | ad-do-it (setq ad-return-value `(toto ,ad-return-value))) |
| 62 | (defmacro sm-test4 (x) `(call-test4 ,x)) | 64 | (defmacro sm-test4 (x) `(call-test4 ,x)) |
| 63 | (macroexpand '(sm-test4 56)) (toto (call-test4 56))) | 65 | (should (equal (macroexpand '(sm-test4 56)) '(toto (call-test4 56)))) |
| 64 | ((defmacro sm-test4 (x) `(call-testq ,x)) | 66 | (defmacro sm-test4 (x) `(call-testq ,x)) |
| 65 | (macroexpand '(sm-test4 56)) (toto (call-testq 56))) | 67 | (should (equal (macroexpand '(sm-test4 56)) '(toto (call-testq 56)))) |
| 66 | 68 | ||
| 67 | ;; Combining old style and new style advices. | 69 | ;; Combining old style and new style advices. |
| 68 | ((defun sm-test5 (x) (+ x 4)) | 70 | (defun sm-test5 (x) (+ x 4)) |
| 69 | (sm-test5 6) 10) | 71 | (should (equal (sm-test5 6) 10)) |
| 70 | ((advice-add 'sm-test5 :around (lambda (f y) (* (funcall f y) 5))) | 72 | (advice-add 'sm-test5 :around (lambda (f y) (* (funcall f y) 5))) |
| 71 | (sm-test5 6) 50) | 73 | (should (equal (sm-test5 6) 50)) |
| 72 | ((defadvice sm-test5 (around test activate) | 74 | (defadvice sm-test5 (around test activate) |
| 73 | ad-do-it (setq ad-return-value (+ ad-return-value 0.1))) | 75 | ad-do-it (setq ad-return-value (+ ad-return-value 0.1))) |
| 74 | (sm-test5 5) 45.1) | 76 | (should (equal (sm-test5 5) 45.1)) |
| 75 | ((ad-deactivate 'sm-test5) | 77 | (ad-deactivate 'sm-test5) |
| 76 | (sm-test5 6) 50) | 78 | (should (equal (sm-test5 6) 50)) |
| 77 | ((ad-activate 'sm-test5) | 79 | (ad-activate 'sm-test5) |
| 78 | (sm-test5 6) 50.1) | 80 | (should (equal (sm-test5 6) 50.1)) |
| 79 | ((defun sm-test5 (x) (+ x 14)) | 81 | (defun sm-test5 (x) (+ x 14)) |
| 80 | (sm-test5 6) 100.1) | 82 | (should (equal (sm-test5 6) 100.1)) |
| 81 | ((advice-remove 'sm-test5 (lambda (f y) (* (funcall f y) 5))) | 83 | (advice-remove 'sm-test5 (lambda (f y) (* (funcall f y) 5))) |
| 82 | (sm-test5 6) 20.1) | 84 | (should (equal (sm-test5 6) 20.1)) |
| 83 | 85 | ||
| 84 | ;; This used to signal an error (bug#12858). | 86 | ;; This used to signal an error (bug#12858). |
| 85 | ((autoload 'sm-test6 "foo") | 87 | (autoload 'sm-test6 "foo") |
| 86 | (defadvice sm-test6 (around test activate) | 88 | (defadvice sm-test6 (around test activate) |
| 87 | ad-do-it) | 89 | ad-do-it) |
| 88 | t t) | ||
| 89 | 90 | ||
| 91 | ;; Check interaction between advice and called-interactively-p. | ||
| 92 | (defun sm-test7 (&optional x) (interactive) (+ (or x 7) 4)) | ||
| 93 | (advice-add 'sm-test7 :around | ||
| 94 | (lambda (f &rest args) | ||
| 95 | (list (cons 1 (called-interactively-p)) (apply f args)))) | ||
| 96 | (should (equal (sm-test7) '((1 . nil) 11))) | ||
| 97 | (should (equal (call-interactively 'sm-test7) '((1 . t) 11))) | ||
| 98 | (let ((smi 7)) | ||
| 99 | (advice-add 'sm-test7 :before | ||
| 100 | (lambda (&rest args) | ||
| 101 | (setq smi (called-interactively-p)))) | ||
| 102 | (should (equal (list (sm-test7) smi) | ||
| 103 | '(((1 . nil) 11) nil))) | ||
| 104 | (should (equal (list (call-interactively 'sm-test7) smi) | ||
| 105 | '(((1 . t) 11) t)))) | ||
| 106 | (advice-add 'sm-test7 :around | ||
| 107 | (lambda (f &rest args) | ||
| 108 | (cons (cons 2 (called-interactively-p)) (apply f args)))) | ||
| 109 | (should (equal (call-interactively 'sm-test7) '((2 . t) (1 . t) 11))) | ||
| 90 | )) | 110 | )) |
| 91 | 111 | ||
| 92 | (ert-deftest advice-tests () | ||
| 93 | "Test advice code." | ||
| 94 | (with-temp-buffer | ||
| 95 | (dolist (test advice-tests--data) | ||
| 96 | (let ((res (eval `(progn ,@(butlast test))))) | ||
| 97 | (should (equal (car (last test)) res)))))) | ||
| 98 | |||
| 99 | ;; Local Variables: | 112 | ;; Local Variables: |
| 100 | ;; no-byte-compile: t | 113 | ;; no-byte-compile: t |
| 101 | ;; End: | 114 | ;; End: |
diff --git a/test/automated/ert-tests.el b/test/automated/ert-tests.el index 1778afea802..1aef1921871 100644 --- a/test/automated/ert-tests.el +++ b/test/automated/ert-tests.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; ert-tests.el --- ERT's self-tests | 1 | ;;; ert-tests.el --- ERT's self-tests -*- lexical-binding: t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2007-2008, 2010-2012 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2007-2008, 2010-2012 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -27,7 +27,7 @@ | |||
| 27 | ;;; Code: | 27 | ;;; Code: |
| 28 | 28 | ||
| 29 | (eval-when-compile | 29 | (eval-when-compile |
| 30 | (require 'cl)) | 30 | (require 'cl-lib)) |
| 31 | (require 'ert) | 31 | (require 'ert) |
| 32 | 32 | ||
| 33 | 33 | ||
| @@ -45,7 +45,7 @@ | |||
| 45 | ;; The buffer name chosen here should not compete with the default | 45 | ;; The buffer name chosen here should not compete with the default |
| 46 | ;; results buffer name for completion in `switch-to-buffer'. | 46 | ;; results buffer name for completion in `switch-to-buffer'. |
| 47 | (let ((stats (ert-run-tests-interactively "^ert-" " *ert self-tests*"))) | 47 | (let ((stats (ert-run-tests-interactively "^ert-" " *ert self-tests*"))) |
| 48 | (assert ert--test-body-was-run) | 48 | (cl-assert ert--test-body-was-run) |
| 49 | (if (zerop (ert-stats-completed-unexpected stats)) | 49 | (if (zerop (ert-stats-completed-unexpected stats)) |
| 50 | ;; Hide results window only when everything went well. | 50 | ;; Hide results window only when everything went well. |
| 51 | (set-window-configuration window-configuration) | 51 | (set-window-configuration window-configuration) |
| @@ -71,26 +71,26 @@ failed or if there was a problem." | |||
| 71 | 71 | ||
| 72 | (ert-deftest ert-test-nested-test-body-runs () | 72 | (ert-deftest ert-test-nested-test-body-runs () |
| 73 | "Test that nested test bodies run." | 73 | "Test that nested test bodies run." |
| 74 | (lexical-let ((was-run nil)) | 74 | (let ((was-run nil)) |
| 75 | (let ((test (make-ert-test :body (lambda () | 75 | (let ((test (make-ert-test :body (lambda () |
| 76 | (setq was-run t))))) | 76 | (setq was-run t))))) |
| 77 | (assert (not was-run)) | 77 | (cl-assert (not was-run)) |
| 78 | (ert-run-test test) | 78 | (ert-run-test test) |
| 79 | (assert was-run)))) | 79 | (cl-assert was-run)))) |
| 80 | 80 | ||
| 81 | 81 | ||
| 82 | ;;; Test that pass/fail works. | 82 | ;;; Test that pass/fail works. |
| 83 | (ert-deftest ert-test-pass () | 83 | (ert-deftest ert-test-pass () |
| 84 | (let ((test (make-ert-test :body (lambda ())))) | 84 | (let ((test (make-ert-test :body (lambda ())))) |
| 85 | (let ((result (ert-run-test test))) | 85 | (let ((result (ert-run-test test))) |
| 86 | (assert (ert-test-passed-p result))))) | 86 | (cl-assert (ert-test-passed-p result))))) |
| 87 | 87 | ||
| 88 | (ert-deftest ert-test-fail () | 88 | (ert-deftest ert-test-fail () |
| 89 | (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) | 89 | (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) |
| 90 | (let ((result (let ((ert-debug-on-error nil)) | 90 | (let ((result (let ((ert-debug-on-error nil)) |
| 91 | (ert-run-test test)))) | 91 | (ert-run-test test)))) |
| 92 | (assert (ert-test-failed-p result) t) | 92 | (cl-assert (ert-test-failed-p result) t) |
| 93 | (assert (equal (ert-test-result-with-condition-condition result) | 93 | (cl-assert (equal (ert-test-result-with-condition-condition result) |
| 94 | '(ert-test-failed "failure message")) | 94 | '(ert-test-failed "failure message")) |
| 95 | t)))) | 95 | t)))) |
| 96 | 96 | ||
| @@ -100,50 +100,50 @@ failed or if there was a problem." | |||
| 100 | (progn | 100 | (progn |
| 101 | (let ((ert-debug-on-error t)) | 101 | (let ((ert-debug-on-error t)) |
| 102 | (ert-run-test test)) | 102 | (ert-run-test test)) |
| 103 | (assert nil)) | 103 | (cl-assert nil)) |
| 104 | ((error) | 104 | ((error) |
| 105 | (assert (equal condition '(ert-test-failed "failure message")) t))))) | 105 | (cl-assert (equal condition '(ert-test-failed "failure message")) t))))) |
| 106 | 106 | ||
| 107 | (ert-deftest ert-test-fail-debug-with-debugger-1 () | 107 | (ert-deftest ert-test-fail-debug-with-debugger-1 () |
| 108 | (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) | 108 | (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) |
| 109 | (let ((debugger (lambda (&rest debugger-args) | 109 | (let ((debugger (lambda (&rest _args) |
| 110 | (assert nil)))) | 110 | (cl-assert nil)))) |
| 111 | (let ((ert-debug-on-error nil)) | 111 | (let ((ert-debug-on-error nil)) |
| 112 | (ert-run-test test))))) | 112 | (ert-run-test test))))) |
| 113 | 113 | ||
| 114 | (ert-deftest ert-test-fail-debug-with-debugger-2 () | 114 | (ert-deftest ert-test-fail-debug-with-debugger-2 () |
| 115 | (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) | 115 | (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) |
| 116 | (block nil | 116 | (cl-block nil |
| 117 | (let ((debugger (lambda (&rest debugger-args) | 117 | (let ((debugger (lambda (&rest _args) |
| 118 | (return-from nil nil)))) | 118 | (cl-return-from nil nil)))) |
| 119 | (let ((ert-debug-on-error t)) | 119 | (let ((ert-debug-on-error t)) |
| 120 | (ert-run-test test)) | 120 | (ert-run-test test)) |
| 121 | (assert nil))))) | 121 | (cl-assert nil))))) |
| 122 | 122 | ||
| 123 | (ert-deftest ert-test-fail-debug-nested-with-debugger () | 123 | (ert-deftest ert-test-fail-debug-nested-with-debugger () |
| 124 | (let ((test (make-ert-test :body (lambda () | 124 | (let ((test (make-ert-test :body (lambda () |
| 125 | (let ((ert-debug-on-error t)) | 125 | (let ((ert-debug-on-error t)) |
| 126 | (ert-fail "failure message")))))) | 126 | (ert-fail "failure message")))))) |
| 127 | (let ((debugger (lambda (&rest debugger-args) | 127 | (let ((debugger (lambda (&rest _args) |
| 128 | (assert nil nil "Assertion a")))) | 128 | (cl-assert nil nil "Assertion a")))) |
| 129 | (let ((ert-debug-on-error nil)) | 129 | (let ((ert-debug-on-error nil)) |
| 130 | (ert-run-test test)))) | 130 | (ert-run-test test)))) |
| 131 | (let ((test (make-ert-test :body (lambda () | 131 | (let ((test (make-ert-test :body (lambda () |
| 132 | (let ((ert-debug-on-error nil)) | 132 | (let ((ert-debug-on-error nil)) |
| 133 | (ert-fail "failure message")))))) | 133 | (ert-fail "failure message")))))) |
| 134 | (block nil | 134 | (cl-block nil |
| 135 | (let ((debugger (lambda (&rest debugger-args) | 135 | (let ((debugger (lambda (&rest _args) |
| 136 | (return-from nil nil)))) | 136 | (cl-return-from nil nil)))) |
| 137 | (let ((ert-debug-on-error t)) | 137 | (let ((ert-debug-on-error t)) |
| 138 | (ert-run-test test)) | 138 | (ert-run-test test)) |
| 139 | (assert nil nil "Assertion b"))))) | 139 | (cl-assert nil nil "Assertion b"))))) |
| 140 | 140 | ||
| 141 | (ert-deftest ert-test-error () | 141 | (ert-deftest ert-test-error () |
| 142 | (let ((test (make-ert-test :body (lambda () (error "Error message"))))) | 142 | (let ((test (make-ert-test :body (lambda () (error "Error message"))))) |
| 143 | (let ((result (let ((ert-debug-on-error nil)) | 143 | (let ((result (let ((ert-debug-on-error nil)) |
| 144 | (ert-run-test test)))) | 144 | (ert-run-test test)))) |
| 145 | (assert (ert-test-failed-p result) t) | 145 | (cl-assert (ert-test-failed-p result) t) |
| 146 | (assert (equal (ert-test-result-with-condition-condition result) | 146 | (cl-assert (equal (ert-test-result-with-condition-condition result) |
| 147 | '(error "Error message")) | 147 | '(error "Error message")) |
| 148 | t)))) | 148 | t)))) |
| 149 | 149 | ||
| @@ -153,9 +153,9 @@ failed or if there was a problem." | |||
| 153 | (progn | 153 | (progn |
| 154 | (let ((ert-debug-on-error t)) | 154 | (let ((ert-debug-on-error t)) |
| 155 | (ert-run-test test)) | 155 | (ert-run-test test)) |
| 156 | (assert nil)) | 156 | (cl-assert nil)) |
| 157 | ((error) | 157 | ((error) |
| 158 | (assert (equal condition '(error "Error message")) t))))) | 158 | (cl-assert (equal condition '(error "Error message")) t))))) |
| 159 | 159 | ||
| 160 | 160 | ||
| 161 | ;;; Test that `should' works. | 161 | ;;; Test that `should' works. |
| @@ -163,13 +163,13 @@ failed or if there was a problem." | |||
| 163 | (let ((test (make-ert-test :body (lambda () (should nil))))) | 163 | (let ((test (make-ert-test :body (lambda () (should nil))))) |
| 164 | (let ((result (let ((ert-debug-on-error nil)) | 164 | (let ((result (let ((ert-debug-on-error nil)) |
| 165 | (ert-run-test test)))) | 165 | (ert-run-test test)))) |
| 166 | (assert (ert-test-failed-p result) t) | 166 | (cl-assert (ert-test-failed-p result) t) |
| 167 | (assert (equal (ert-test-result-with-condition-condition result) | 167 | (cl-assert (equal (ert-test-result-with-condition-condition result) |
| 168 | '(ert-test-failed ((should nil) :form nil :value nil))) | 168 | '(ert-test-failed ((should nil) :form nil :value nil))) |
| 169 | t))) | 169 | t))) |
| 170 | (let ((test (make-ert-test :body (lambda () (should t))))) | 170 | (let ((test (make-ert-test :body (lambda () (should t))))) |
| 171 | (let ((result (ert-run-test test))) | 171 | (let ((result (ert-run-test test))) |
| 172 | (assert (ert-test-passed-p result) t)))) | 172 | (cl-assert (ert-test-passed-p result) t)))) |
| 173 | 173 | ||
| 174 | (ert-deftest ert-test-should-value () | 174 | (ert-deftest ert-test-should-value () |
| 175 | (should (eql (should 'foo) 'foo)) | 175 | (should (eql (should 'foo) 'foo)) |
| @@ -179,17 +179,18 @@ failed or if there was a problem." | |||
| 179 | (let ((test (make-ert-test :body (lambda () (should-not t))))) | 179 | (let ((test (make-ert-test :body (lambda () (should-not t))))) |
| 180 | (let ((result (let ((ert-debug-on-error nil)) | 180 | (let ((result (let ((ert-debug-on-error nil)) |
| 181 | (ert-run-test test)))) | 181 | (ert-run-test test)))) |
| 182 | (assert (ert-test-failed-p result) t) | 182 | (cl-assert (ert-test-failed-p result) t) |
| 183 | (assert (equal (ert-test-result-with-condition-condition result) | 183 | (cl-assert (equal (ert-test-result-with-condition-condition result) |
| 184 | '(ert-test-failed ((should-not t) :form t :value t))) | 184 | '(ert-test-failed ((should-not t) :form t :value t))) |
| 185 | t))) | 185 | t))) |
| 186 | (let ((test (make-ert-test :body (lambda () (should-not nil))))) | 186 | (let ((test (make-ert-test :body (lambda () (should-not nil))))) |
| 187 | (let ((result (ert-run-test test))) | 187 | (let ((result (ert-run-test test))) |
| 188 | (assert (ert-test-passed-p result))))) | 188 | (cl-assert (ert-test-passed-p result))))) |
| 189 | |||
| 189 | 190 | ||
| 190 | (ert-deftest ert-test-should-with-macrolet () | 191 | (ert-deftest ert-test-should-with-macrolet () |
| 191 | (let ((test (make-ert-test :body (lambda () | 192 | (let ((test (make-ert-test :body (lambda () |
| 192 | (macrolet ((foo () `(progn t nil))) | 193 | (cl-macrolet ((foo () `(progn t nil))) |
| 193 | (should (foo))))))) | 194 | (should (foo))))))) |
| 194 | (let ((result (let ((ert-debug-on-error nil)) | 195 | (let ((result (let ((ert-debug-on-error nil)) |
| 195 | (ert-run-test test)))) | 196 | (ert-run-test test)))) |
| @@ -303,32 +304,33 @@ This macro is used to test if macroexpansion in `should' works." | |||
| 303 | 304 | ||
| 304 | (ert-deftest ert-test-should-failure-debugging () | 305 | (ert-deftest ert-test-should-failure-debugging () |
| 305 | "Test that `should' errors contain the information we expect them to." | 306 | "Test that `should' errors contain the information we expect them to." |
| 306 | (loop for (body expected-condition) in | 307 | (cl-loop |
| 307 | `((,(lambda () (let ((x nil)) (should x))) | 308 | for (body expected-condition) in |
| 308 | (ert-test-failed ((should x) :form x :value nil))) | 309 | `((,(lambda () (let ((x nil)) (should x))) |
| 309 | (,(lambda () (let ((x t)) (should-not x))) | 310 | (ert-test-failed ((should x) :form x :value nil))) |
| 310 | (ert-test-failed ((should-not x) :form x :value t))) | 311 | (,(lambda () (let ((x t)) (should-not x))) |
| 311 | (,(lambda () (let ((x t)) (should (not x)))) | 312 | (ert-test-failed ((should-not x) :form x :value t))) |
| 312 | (ert-test-failed ((should (not x)) :form (not t) :value nil))) | 313 | (,(lambda () (let ((x t)) (should (not x)))) |
| 313 | (,(lambda () (let ((x nil)) (should-not (not x)))) | 314 | (ert-test-failed ((should (not x)) :form (not t) :value nil))) |
| 314 | (ert-test-failed ((should-not (not x)) :form (not nil) :value t))) | 315 | (,(lambda () (let ((x nil)) (should-not (not x)))) |
| 315 | (,(lambda () (let ((x t) (y nil)) (should-not | 316 | (ert-test-failed ((should-not (not x)) :form (not nil) :value t))) |
| 316 | (ert--test-my-list x y)))) | 317 | (,(lambda () (let ((x t) (y nil)) (should-not |
| 317 | (ert-test-failed | 318 | (ert--test-my-list x y)))) |
| 318 | ((should-not (ert--test-my-list x y)) | 319 | (ert-test-failed |
| 319 | :form (list t nil) | 320 | ((should-not (ert--test-my-list x y)) |
| 320 | :value (t nil)))) | 321 | :form (list t nil) |
| 321 | (,(lambda () (let ((x t)) (should (error "Foo")))) | 322 | :value (t nil)))) |
| 322 | (error "Foo"))) | 323 | (,(lambda () (let ((_x t)) (should (error "Foo")))) |
| 323 | do | 324 | (error "Foo"))) |
| 324 | (let ((test (make-ert-test :body body))) | 325 | do |
| 325 | (condition-case actual-condition | 326 | (let ((test (make-ert-test :body body))) |
| 326 | (progn | 327 | (condition-case actual-condition |
| 327 | (let ((ert-debug-on-error t)) | 328 | (progn |
| 328 | (ert-run-test test)) | 329 | (let ((ert-debug-on-error t)) |
| 329 | (assert nil)) | 330 | (ert-run-test test)) |
| 330 | ((error) | 331 | (cl-assert nil)) |
| 331 | (should (equal actual-condition expected-condition))))))) | 332 | ((error) |
| 333 | (should (equal actual-condition expected-condition))))))) | ||
| 332 | 334 | ||
| 333 | (ert-deftest ert-test-deftest () | 335 | (ert-deftest ert-test-deftest () |
| 334 | (should (equal (macroexpand '(ert-deftest abc () "foo" :tags '(bar))) | 336 | (should (equal (macroexpand '(ert-deftest abc () "foo" :tags '(bar))) |
| @@ -520,7 +522,7 @@ This macro is used to test if macroexpansion in `should' works." | |||
| 520 | (setf (cdr (last a)) (cddr a)) | 522 | (setf (cdr (last a)) (cddr a)) |
| 521 | (should (not (ert--proper-list-p a)))) | 523 | (should (not (ert--proper-list-p a)))) |
| 522 | (let ((a (list 1 2 3 4))) | 524 | (let ((a (list 1 2 3 4))) |
| 523 | (setf (cdr (last a)) (cdddr a)) | 525 | (setf (cdr (last a)) (cl-cdddr a)) |
| 524 | (should (not (ert--proper-list-p a))))) | 526 | (should (not (ert--proper-list-p a))))) |
| 525 | 527 | ||
| 526 | (ert-deftest ert-test-parse-keys-and-body () | 528 | (ert-deftest ert-test-parse-keys-and-body () |
| @@ -657,14 +659,14 @@ This macro is used to test if macroexpansion in `should' works." | |||
| 657 | (i 0)) | 659 | (i 0)) |
| 658 | (let ((result (ert--remove-if-not (lambda (x) | 660 | (let ((result (ert--remove-if-not (lambda (x) |
| 659 | (should (eql x (nth i list))) | 661 | (should (eql x (nth i list))) |
| 660 | (incf i) | 662 | (cl-incf i) |
| 661 | (member i '(2 3))) | 663 | (member i '(2 3))) |
| 662 | list))) | 664 | list))) |
| 663 | (should (equal i 4)) | 665 | (should (equal i 4)) |
| 664 | (should (equal result '(b c))) | 666 | (should (equal result '(b c))) |
| 665 | (should (equal list '(a b c d))))) | 667 | (should (equal list '(a b c d))))) |
| 666 | (should (equal '() | 668 | (should (equal '() |
| 667 | (ert--remove-if-not (lambda (x) (should nil)) '())))) | 669 | (ert--remove-if-not (lambda (_x) (should nil)) '())))) |
| 668 | 670 | ||
| 669 | (ert-deftest ert-test-remove* () | 671 | (ert-deftest ert-test-remove* () |
| 670 | (let ((list (list 'a 'b 'c 'd)) | 672 | (let ((list (list 'a 'b 'c 'd)) |
| @@ -676,13 +678,13 @@ This macro is used to test if macroexpansion in `should' works." | |||
| 676 | (should (eql x (nth key-index list))) | 678 | (should (eql x (nth key-index list))) |
| 677 | (prog1 | 679 | (prog1 |
| 678 | (list key-index x) | 680 | (list key-index x) |
| 679 | (incf key-index))) | 681 | (cl-incf key-index))) |
| 680 | :test | 682 | :test |
| 681 | (lambda (a b) | 683 | (lambda (a b) |
| 682 | (should (eql a 'foo)) | 684 | (should (eql a 'foo)) |
| 683 | (should (equal b (list test-index | 685 | (should (equal b (list test-index |
| 684 | (nth test-index list)))) | 686 | (nth test-index list)))) |
| 685 | (incf test-index) | 687 | (cl-incf test-index) |
| 686 | (member test-index '(2 3)))))) | 688 | (member test-index '(2 3)))))) |
| 687 | (should (equal key-index 4)) | 689 | (should (equal key-index 4)) |
| 688 | (should (equal test-index 4)) | 690 | (should (equal test-index 4)) |
diff --git a/test/automated/ert-x-tests.el b/test/automated/ert-x-tests.el index 520502bb307..e03c8475442 100644 --- a/test/automated/ert-x-tests.el +++ b/test/automated/ert-x-tests.el | |||
| @@ -28,7 +28,7 @@ | |||
| 28 | ;;; Code: | 28 | ;;; Code: |
| 29 | 29 | ||
| 30 | (eval-when-compile | 30 | (eval-when-compile |
| 31 | (require 'cl)) | 31 | (require 'cl-lib)) |
| 32 | (require 'ert) | 32 | (require 'ert) |
| 33 | (require 'ert-x) | 33 | (require 'ert-x) |
| 34 | 34 | ||
| @@ -233,8 +233,8 @@ desired effect." | |||
| 233 | (should (equal (buffer-string) "")) | 233 | (should (equal (buffer-string) "")) |
| 234 | (let ((message-log-max 2)) | 234 | (let ((message-log-max 2)) |
| 235 | (let ((message-log-max t)) | 235 | (let ((message-log-max t)) |
| 236 | (loop for i below 4 do | 236 | (cl-loop for i below 4 do |
| 237 | (message "%s" i)) | 237 | (message "%s" i)) |
| 238 | (should (equal (buffer-string) "0\n1\n2\n3\n"))) | 238 | (should (equal (buffer-string) "0\n1\n2\n3\n"))) |
| 239 | (should (equal (buffer-string) "0\n1\n2\n3\n")) | 239 | (should (equal (buffer-string) "0\n1\n2\n3\n")) |
| 240 | (message "") | 240 | (message "") |
| @@ -244,28 +244,28 @@ desired effect." | |||
| 244 | 244 | ||
| 245 | (ert-deftest ert-test-force-message-log-buffer-truncation () | 245 | (ert-deftest ert-test-force-message-log-buffer-truncation () |
| 246 | :tags '(:causes-redisplay) | 246 | :tags '(:causes-redisplay) |
| 247 | (labels ((body () | 247 | (cl-labels ((body () |
| 248 | (loop for i below 3 do | 248 | (cl-loop for i below 3 do |
| 249 | (message "%s" i))) | 249 | (message "%s" i))) |
| 250 | ;; Uses the implicit messages buffer truncation implemented | 250 | ;; Uses the implicit messages buffer truncation implemented |
| 251 | ;; in Emacs' C core. | 251 | ;; in Emacs' C core. |
| 252 | (c (x) | 252 | (c (x) |
| 253 | (ert-with-buffer-renamed ("*Messages*") | 253 | (ert-with-buffer-renamed ("*Messages*") |
| 254 | (let ((message-log-max x)) | 254 | (let ((message-log-max x)) |
| 255 | (body)) | 255 | (body)) |
| 256 | (with-current-buffer "*Messages*" | 256 | (with-current-buffer "*Messages*" |
| 257 | (buffer-string)))) | 257 | (buffer-string)))) |
| 258 | ;; Uses our lisp reimplementation. | 258 | ;; Uses our lisp reimplementation. |
| 259 | (lisp (x) | 259 | (lisp (x) |
| 260 | (ert-with-buffer-renamed ("*Messages*") | 260 | (ert-with-buffer-renamed ("*Messages*") |
| 261 | (let ((message-log-max t)) | 261 | (let ((message-log-max t)) |
| 262 | (body)) | 262 | (body)) |
| 263 | (let ((message-log-max x)) | 263 | (let ((message-log-max x)) |
| 264 | (ert--force-message-log-buffer-truncation)) | 264 | (ert--force-message-log-buffer-truncation)) |
| 265 | (with-current-buffer "*Messages*" | 265 | (with-current-buffer "*Messages*" |
| 266 | (buffer-string))))) | 266 | (buffer-string))))) |
| 267 | (loop for x in '(0 1 2 3 4 t) do | 267 | (cl-loop for x in '(0 1 2 3 4 t) do |
| 268 | (should (equal (c x) (lisp x)))))) | 268 | (should (equal (c x) (lisp x)))))) |
| 269 | 269 | ||
| 270 | 270 | ||
| 271 | (provide 'ert-x-tests) | 271 | (provide 'ert-x-tests) |