Now on revision 110986. ------------------------------------------------------------ revno: 110986 fixes bug: http://debbugs.gnu.org/12958 committer: Paul Eggert branch nick: trunk timestamp: Thu 2012-11-22 23:48:43 -0800 message: Assume POSIX 1003.1-1988 or later for dirent.h. * admin/CPP-DEFINES (HAVE_CLOSEDIR, HAVE_DIRENT_H): Remove. * admin/notes/copyright: Adjust to src/ndir.h -> nt/inc/dirent.h renaming. * configure.ac: Do not check for dirent.h or closdir. * nt/inc/dirent.h: Rename from ../src/ndir.h, with these changes: (struct dirent): Rename from struct direct. All uses changed. * nt/inc/sys/dir.h: Remove. * src/dired.c: Assume HAVE_DIRENT_H. (NAMLEN): Remove, replacing with ... (dirent_namelen): New function. All uses changed. Use the GNU macro _D_EXACT_NAMELEN if available, as it's faster than strlen. (DIRENTRY): Remove, replacing all uses with 'struct dirent'. (DIRENTRY_NONEMPTY): Remove. All callers now assume it's nonzero. * src/makefile.w32-in (DIR_H): Remove. All uses replaced with $(NT_INC)/dirent.h. ($(BLD)/w32.$(O)): Do not depend on $(SRC)/ndir.h. * src/ndir.h: Rename to ../nt/inc/dirent.h. * src/sysdep.h (closedir) [!HAVE_CLOSEDIR]: Remove. Do not include ; no longer needed. * src/w32.c: Include rather than "ndir.h". diff: === modified file 'ChangeLog' --- ChangeLog 2012-11-21 21:06:52 +0000 +++ ChangeLog 2012-11-23 07:48:43 +0000 @@ -1,3 +1,8 @@ +2012-11-23 Paul Eggert + + Assume POSIX 1003.1-1988 or later for dirent.h (Bug#12958). + * configure.ac: Do not check for dirent.h or closdir. + 2012-11-21 Paul Eggert Assume POSIX 1003.1-1988 or later for unistd.h (Bug#12945). === modified file 'admin/CPP-DEFINES' --- admin/CPP-DEFINES 2012-11-21 21:06:52 +0000 +++ admin/CPP-DEFINES 2012-11-23 07:48:43 +0000 @@ -118,7 +118,6 @@ HAVE_CFSETSPEED HAVE_CLOCK_GETTIME HAVE_CLOCK_SETTIME -HAVE_CLOSEDIR HAVE_COFF_H HAVE_COM_ERR_H HAVE_COPYSIGN @@ -143,7 +142,6 @@ HAVE_DEV_PTMX HAVE_DIALOGS HAVE_DIFFTIME -HAVE_DIRENT_H HAVE_DUP2 HAVE_ENDGRENT HAVE_ENDPWENT === modified file 'admin/ChangeLog' --- admin/ChangeLog 2012-11-21 21:06:52 +0000 +++ admin/ChangeLog 2012-11-23 07:48:43 +0000 @@ -1,3 +1,9 @@ +2012-11-23 Paul Eggert + + Assume POSIX 1003.1-1988 or later for dirent.h (Bug#12958). + * CPP-DEFINES (HAVE_CLOSEDIR, HAVE_DIRENT_H): Remove. + * notes/copyright: Adjust to src/ndir.h -> nt/inc/dirent.h renaming. + 2012-11-21 Paul Eggert Assume POSIX 1003.1-1988 or later for unistd.h (Bug#12945). === modified file 'admin/notes/copyright' --- admin/notes/copyright 2012-01-19 07:21:25 +0000 +++ admin/notes/copyright 2012-11-23 07:48:43 +0000 @@ -380,7 +380,7 @@ src/gmalloc.c - contains numerous copyrights from the GNU C library. Leave them alone. -src/ndir.h +nt/inc/dirent.h - see comments below. This file is OK to be released with Emacs 22, but we may want to revisit it afterwards. @@ -429,7 +429,7 @@ File says it's in the public domain, but that might not make it so. etc/e/eterm-color.ti -src/ndir.h +nt/inc/dirent.h On legal advice from Matt Norwood, the following comment was added to these files in Feb/Mar 2007: === modified file 'configure.ac' --- configure.ac 2012-11-21 21:06:52 +0000 +++ configure.ac 2012-11-23 07:48:43 +0000 @@ -1289,7 +1289,7 @@ linux/version.h sys/systeminfo.h coff.h pty.h sys/vlimit.h sys/resource.h - sys/utsname.h pwd.h utmp.h dirent.h util.h) + sys/utsname.h pwd.h utmp.h util.h) AC_MSG_CHECKING(if personality LINUX32 can be set) AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], [[personality (PER_LINUX32)]])], @@ -2891,7 +2891,7 @@ AC_CHECK_FUNCS(gethostname \ -closedir getrusage get_current_dir_name \ +getrusage get_current_dir_name \ lrand48 \ select getpagesize setlocale \ utimes getrlimit setrlimit shutdown getaddrinfo \ === modified file 'nt/ChangeLog' --- nt/ChangeLog 2012-11-21 21:06:52 +0000 +++ nt/ChangeLog 2012-11-23 07:48:43 +0000 @@ -1,3 +1,10 @@ +2012-11-23 Paul Eggert + + Assume POSIX 1003.1-1988 or later for dirent.h (Bug#12958). + * inc/dirent.h: Rename from ../src/ndir.h, with these changes: + (struct dirent): Rename from struct direct. All uses changed. + * inc/sys/dir.h: Remove. + 2012-11-21 Paul Eggert Assume POSIX 1003.1-1988 or later for unistd.h (Bug#12945). === renamed file 'src/ndir.h' => 'nt/inc/dirent.h' --- src/ndir.h 2011-01-15 23:16:57 +0000 +++ nt/inc/dirent.h 2012-11-23 07:48:43 +0000 @@ -1,7 +1,5 @@ /* - -- definitions for 4.2BSD-compatible directory access - - last edit: 09-Jul-1983 D A Gwyn + -- definitions for POSIX-compatible directory access * The code here is forced by the interface, and is not subject to * copyright, constituting the only possible expression of the @@ -16,7 +14,7 @@ #endif /* not WINDOWSNT */ /* NOTE: MAXNAMLEN must be one less than a multiple of 4 */ -struct direct /* data from readdir() */ +struct dirent /* data from readdir() */ { long d_ino; /* inode number of entry */ unsigned short d_reclen; /* length of this record */ @@ -33,9 +31,8 @@ } DIR; /* stream data from opendir() */ extern DIR *opendir (char *); -extern struct direct *readdir (DIR *); +extern struct dirent *readdir (DIR *); extern void seekdir (DIR *, long); extern void closedir (DIR *); #define rewinddir( dirp ) seekdir( dirp, 0L ) - === removed file 'nt/inc/sys/dir.h' --- nt/inc/sys/dir.h 2011-01-15 23:16:57 +0000 +++ nt/inc/sys/dir.h 1970-01-01 00:00:00 +0000 @@ -1,6 +0,0 @@ -/* - * map sys\dir.h to ..\..\..\src\ndir.h - */ - -#include "..\..\..\src\ndir.h" - === modified file 'src/ChangeLog' --- src/ChangeLog 2012-11-23 06:23:28 +0000 +++ src/ChangeLog 2012-11-23 07:48:43 +0000 @@ -1,3 +1,20 @@ +2012-11-23 Paul Eggert + + Assume POSIX 1003.1-1988 or later for dirent.h (Bug#12958). + * dired.c: Assume HAVE_DIRENT_H. + (NAMLEN): Remove, replacing with ... + (dirent_namelen): New function. All uses changed. Use the GNU macro + _D_EXACT_NAMELEN if available, as it's faster than strlen. + (DIRENTRY): Remove, replacing all uses with 'struct dirent'. + (DIRENTRY_NONEMPTY): Remove. All callers now assume it's nonzero. + * makefile.w32-in (DIR_H): Remove. All uses replaced with + $(NT_INC)/dirent.h. + ($(BLD)/w32.$(O)): Do not depend on $(SRC)/ndir.h. + * ndir.h: Rename to ../nt/inc/dirent.h. + * sysdep.h (closedir) [!HAVE_CLOSEDIR]: Remove. + Do not include ; no longer needed. + * w32.c: Include rather than "ndir.h". + 2012-11-23 Chong Yidong * xftfont.c (xftfont_open): Remove duplicate assignment. === modified file 'src/dired.c' --- src/dired.c 2012-10-01 02:07:14 +0000 +++ src/dired.c 2012-11-23 07:48:43 +0000 @@ -31,44 +31,10 @@ #include #include -/* The d_nameln member of a struct dirent includes the '\0' character - on some systems, but not on others. What's worse, you can't tell - at compile-time which one it will be, since it really depends on - the sort of system providing the filesystem you're reading from, - not the system you are running on. Paul Eggert - says this occurs when Emacs is running on a - SunOS 4.1.2 host, reading a directory that is remote-mounted from a - Solaris 2.1 host and is in a native Solaris 2.1 filesystem. - - Since applying strlen to the name always works, we'll just do that. */ -#define NAMLEN(p) strlen (p->d_name) - -#ifdef HAVE_DIRENT_H - #include -#define DIRENTRY struct dirent - -#else /* not HAVE_DIRENT_H */ - -#include -#include - -#define DIRENTRY struct direct - -extern DIR *opendir (char *); -extern struct direct *readdir (DIR *); - -#endif /* HAVE_DIRENT_H */ - #include #include -#ifdef MSDOS -#define DIRENTRY_NONEMPTY(p) ((p)->d_name[0] != 0) -#else -#define DIRENTRY_NONEMPTY(p) ((p)->d_ino) -#endif - #include "lisp.h" #include "systime.h" #include "character.h" @@ -88,6 +54,17 @@ static ptrdiff_t scmp (const char *, const char *, ptrdiff_t); +/* Return the number of bytes in DP's name. */ +static ptrdiff_t +dirent_namelen (struct dirent *dp) +{ +#ifdef _D_EXACT_NAMLEN + return _D_EXACT_NAMLEN (dp); +#else + return strlen (dp->d_name); +#endif +} + #ifdef WINDOWSNT Lisp_Object directory_files_internal_w32_unwind (Lisp_Object arg) @@ -124,7 +101,7 @@ bool needsep = 0; ptrdiff_t count = SPECPDL_INDEX (); struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; - DIRENTRY *dp; + struct dirent *dp; #ifdef WINDOWSNT Lisp_Object w32_save = Qnil; #endif @@ -209,6 +186,11 @@ /* Loop reading blocks until EOF or error. */ for (;;) { + ptrdiff_t len; + bool wanted = 0; + Lisp_Object name, finalname; + struct gcpro gcpro1, gcpro2; + errno = 0; dp = readdir (d); @@ -225,89 +207,81 @@ if (dp == NULL) break; - if (DIRENTRY_NONEMPTY (dp)) + len = dirent_namelen (dp); + name = finalname = make_unibyte_string (dp->d_name, len); + GCPRO2 (finalname, name); + + /* Note: DECODE_FILE can GC; it should protect its argument, + though. */ + name = DECODE_FILE (name); + len = SBYTES (name); + + /* Now that we have unwind_protect in place, we might as well + allow matching to be interrupted. */ + immediate_quit = 1; + QUIT; + + if (NILP (match) + || (0 <= re_search (bufp, SSDATA (name), len, 0, len, 0))) + wanted = 1; + + immediate_quit = 0; + + if (wanted) { - ptrdiff_t len; - bool wanted = 0; - Lisp_Object name, finalname; - struct gcpro gcpro1, gcpro2; - - len = NAMLEN (dp); - name = finalname = make_unibyte_string (dp->d_name, len); - GCPRO2 (finalname, name); - - /* Note: DECODE_FILE can GC; it should protect its argument, - though. */ - name = DECODE_FILE (name); - len = SBYTES (name); - - /* Now that we have unwind_protect in place, we might as well - allow matching to be interrupted. */ - immediate_quit = 1; - QUIT; - - if (NILP (match) - || (0 <= re_search (bufp, SSDATA (name), len, 0, len, 0))) - wanted = 1; - - immediate_quit = 0; - - if (wanted) - { - if (!NILP (full)) - { - Lisp_Object fullname; - ptrdiff_t nbytes = len + directory_nbytes + needsep; - ptrdiff_t nchars; - - fullname = make_uninit_multibyte_string (nbytes, nbytes); - memcpy (SDATA (fullname), SDATA (directory), - directory_nbytes); - - if (needsep) - SSET (fullname, directory_nbytes, DIRECTORY_SEP); - - memcpy (SDATA (fullname) + directory_nbytes + needsep, - SDATA (name), len); - - nchars = chars_in_text (SDATA (fullname), nbytes); - - /* Some bug somewhere. */ - if (nchars > nbytes) - emacs_abort (); - - STRING_SET_CHARS (fullname, nchars); - if (nchars == nbytes) - STRING_SET_UNIBYTE (fullname); - - finalname = fullname; - } - else - finalname = name; - - if (attrs) - { - /* Construct an expanded filename for the directory entry. - Use the decoded names for input to Ffile_attributes. */ - Lisp_Object decoded_fullname, fileattrs; - struct gcpro gcpro1, gcpro2; - - decoded_fullname = fileattrs = Qnil; - GCPRO2 (decoded_fullname, fileattrs); - - /* Both Fexpand_file_name and Ffile_attributes can GC. */ - decoded_fullname = Fexpand_file_name (name, directory); - fileattrs = Ffile_attributes (decoded_fullname, id_format); - - list = Fcons (Fcons (finalname, fileattrs), list); - UNGCPRO; - } - else - list = Fcons (finalname, list); - } - - UNGCPRO; + if (!NILP (full)) + { + Lisp_Object fullname; + ptrdiff_t nbytes = len + directory_nbytes + needsep; + ptrdiff_t nchars; + + fullname = make_uninit_multibyte_string (nbytes, nbytes); + memcpy (SDATA (fullname), SDATA (directory), + directory_nbytes); + + if (needsep) + SSET (fullname, directory_nbytes, DIRECTORY_SEP); + + memcpy (SDATA (fullname) + directory_nbytes + needsep, + SDATA (name), len); + + nchars = chars_in_text (SDATA (fullname), nbytes); + + /* Some bug somewhere. */ + if (nchars > nbytes) + emacs_abort (); + + STRING_SET_CHARS (fullname, nchars); + if (nchars == nbytes) + STRING_SET_UNIBYTE (fullname); + + finalname = fullname; + } + else + finalname = name; + + if (attrs) + { + /* Construct an expanded filename for the directory entry. + Use the decoded names for input to Ffile_attributes. */ + Lisp_Object decoded_fullname, fileattrs; + struct gcpro gcpro1, gcpro2; + + decoded_fullname = fileattrs = Qnil; + GCPRO2 (decoded_fullname, fileattrs); + + /* Both Fexpand_file_name and Ffile_attributes can GC. */ + decoded_fullname = Fexpand_file_name (name, directory); + fileattrs = Ffile_attributes (decoded_fullname, id_format); + + list = Fcons (Fcons (finalname, fileattrs), list); + UNGCPRO; + } + else + list = Fcons (finalname, list); } + + UNGCPRO; } block_input (); @@ -442,7 +416,8 @@ return file_name_completion (file, directory, 1, Qnil); } -static int file_name_completion_stat (Lisp_Object dirname, DIRENTRY *dp, struct stat *st_addr); +static int file_name_completion_stat (Lisp_Object dirname, struct dirent *dp, + struct stat *st_addr); static Lisp_Object Qdefault_directory; static Lisp_Object @@ -499,7 +474,7 @@ /* (att3b compiler bug requires do a null comparison this way) */ while (1) { - DIRENTRY *dp; + struct dirent *dp; ptrdiff_t len; bool canexclude = 0; @@ -517,11 +492,10 @@ if (!dp) break; - len = NAMLEN (dp); + len = dirent_namelen (dp); QUIT; - if (! DIRENTRY_NONEMPTY (dp) - || len < SCHARS (encoded_file) + if (len < SCHARS (encoded_file) || 0 <= scmp (dp->d_name, SSDATA (encoded_file), SCHARS (encoded_file))) continue; @@ -806,9 +780,10 @@ } static int -file_name_completion_stat (Lisp_Object dirname, DIRENTRY *dp, struct stat *st_addr) +file_name_completion_stat (Lisp_Object dirname, struct dirent *dp, + struct stat *st_addr) { - ptrdiff_t len = NAMLEN (dp); + ptrdiff_t len = dirent_namelen (dp); ptrdiff_t pos = SCHARS (dirname); int value; USE_SAFE_ALLOCA; === modified file 'src/makefile.w32-in' --- src/makefile.w32-in 2012-11-17 23:16:24 +0000 +++ src/makefile.w32-in 2012-11-23 07:48:43 +0000 @@ -413,8 +413,6 @@ $(MS_W32_H) CONFIG_H = $(SRC)/config.h \ $(CONF_POST_H) -DIR_H = $(NT_INC)/sys/dir.h \ - $(SRC)/ndir.h W32GUI_H = $(SRC)/w32gui.h \ $(SYSTIME_H) DISPEXTERN_H = $(SRC)/dispextern.h \ @@ -714,6 +712,7 @@ $(SRC)/blockinput.h \ $(SRC)/commands.h \ $(SRC)/regex.h \ + $(NT_INC)/dirent.h \ $(NT_INC)/pwd.h \ $(NT_INC)/sys/stat.h \ $(NT_INC)/unistd.h \ @@ -722,7 +721,6 @@ $(CHARSET_H) \ $(CODING_H) \ $(CONFIG_H) \ - $(DIR_H) \ $(FILEMODE_H) \ $(GRP_H) \ $(LISP_H) \ @@ -1175,11 +1173,11 @@ $(BLD)/w32.$(O) : \ $(SRC)/w32.c \ - $(SRC)/ndir.h \ $(SRC)/w32.h \ $(SRC)/w32common.h \ $(SRC)/w32heap.h \ $(SRC)/w32select.h \ + $(NT_INC)/dirent.h \ $(NT_INC)/pwd.h \ $(NT_INC)/sys/file.h \ $(NT_INC)/sys/time.h \ === modified file 'src/sysdep.c' --- src/sysdep.c 2012-11-21 21:06:52 +0000 +++ src/sysdep.c 2012-11-23 07:48:43 +0000 @@ -2220,28 +2220,6 @@ &emacs_norealloc_allocator, careadlinkatcwd); } -/* Directory routines for systems that don't have them. */ - -#ifdef HAVE_DIRENT_H - -#include - -#if !defined (HAVE_CLOSEDIR) - -int -closedir (DIR *dirp /* stream from opendir */) -{ - int rtnval; - - rtnval = emacs_close (dirp->dd_fd); - xfree (dirp); - - return rtnval; -} -#endif /* not HAVE_CLOSEDIR */ -#endif /* HAVE_DIRENT_H */ - - /* Return a struct timeval that is roughly equivalent to T. Use the least timeval not less than T. Return an extremal value if the result would overflow. */ === modified file 'src/w32.c' --- src/w32.c 2012-11-22 03:56:38 +0000 +++ src/w32.c 2012-11-23 07:48:43 +0000 @@ -179,7 +179,7 @@ #undef sendto #include "w32.h" -#include "ndir.h" +#include #include "w32common.h" #include "w32heap.h" #include "w32select.h" @@ -2448,7 +2448,7 @@ and readdir. We can't use the procedures supplied in sysdep.c, so we provide them here. */ -struct direct dir_static; /* simulated directory contents */ +struct dirent dir_static; /* simulated directory contents */ static HANDLE dir_find_handle = INVALID_HANDLE_VALUE; static int dir_is_fat; static char dir_pathname[MAXPATHLEN+1]; @@ -2518,7 +2518,7 @@ xfree ((char *) dirp); } -struct direct * +struct dirent * readdir (DIR *dirp) { int downcase = !NILP (Vw32_downcase_file_names); @@ -2572,7 +2572,7 @@ downcase = 1; /* 8+3 aliases are returned in all caps */ } dir_static.d_namlen = strlen (dir_static.d_name); - dir_static.d_reclen = sizeof (struct direct) - MAXNAMLEN + 3 + + dir_static.d_reclen = sizeof (struct dirent) - MAXNAMLEN + 3 + dir_static.d_namlen - dir_static.d_namlen % 4; /* If the file name in cFileName[] includes `?' characters, it means ------------------------------------------------------------ revno: 110985 committer: Paul Eggert branch nick: trunk timestamp: Thu 2012-11-22 23:31:58 -0800 message: Add Bug# to Nov 17 ChangeLog entries. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2012-11-22 08:39:27 +0000 +++ doc/misc/ChangeLog 2012-11-23 07:31:58 +0000 @@ -12,8 +12,8 @@ 2012-11-17 Paul Eggert - Calc now uses the Gregorian calendar for all dates, - and uses January 1, 1 AD as its day number 1. + Calc now uses the Gregorian calendar for all dates (Bug#12633). + It also uses January 1, 1 AD as its day number 1. * calc.texi (Date Forms): Document this. 2012-11-16 Glenn Morris === modified file 'etc/ChangeLog' --- etc/ChangeLog 2012-11-22 08:39:27 +0000 +++ etc/ChangeLog 2012-11-23 07:31:58 +0000 @@ -1,6 +1,6 @@ 2012-11-22 Paul Eggert - * NEWS: Document Calc changes for Gregorian calendar. + * NEWS: Document Calc changes for Gregorian calendar (Bug#12633). 2012-10-26 Nicolas Goaziou === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-23 03:26:09 +0000 +++ lisp/ChangeLog 2012-11-23 07:31:58 +0000 @@ -205,8 +205,10 @@ 2012-11-17 Paul Eggert + Calc by default uses the Gregorian calendar for all dates (Bug#12633). + It also uses January 1, 1 AD as its day number 1. * calc/calc-forms.el (math-julian-date-beginning) - (math-julian-date-beginning-int): Implement [new date numbering]. + (math-julian-date-beginning-int): Implement this. 2012-11-17 Juanma Barranquero ------------------------------------------------------------ revno: 110984 committer: Chong Yidong branch nick: trunk timestamp: Fri 2012-11-23 14:23:28 +0800 message: * xftfont.c (xftfont_open): Remove duplicate assignment. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-11-22 09:32:32 +0000 +++ src/ChangeLog 2012-11-23 06:23:28 +0000 @@ -1,3 +1,7 @@ +2012-11-23 Chong Yidong + + * xftfont.c (xftfont_open): Remove duplicate assignment. + 2012-11-22 Dmitry Antipov * alloc.c (Fgarbage_collect): Unblock input after clearing === modified file 'src/xftfont.c' --- src/xftfont.c 2012-09-23 08:44:20 +0000 +++ src/xftfont.c 2012-11-23 06:23:28 +0000 @@ -369,7 +369,7 @@ ASET (font_object, FONT_FORMAT_INDEX, ftfont_font_format (xftfont->pattern, filename)); font = XFONT_OBJECT (font_object); - font->pixel_size = pixel_size; + font->pixel_size = size; font->driver = &xftfont_driver; font->encoding_charset = font->repertory_charset = -1; @@ -387,8 +387,6 @@ xftfont_info->matrix.xy = 0x10000L * matrix->xy; xftfont_info->matrix.yx = 0x10000L * matrix->yx; } - font->pixel_size = size; - font->driver = &xftfont_driver; if (INTEGERP (AREF (entity, FONT_SPACING_INDEX))) spacing = XINT (AREF (entity, FONT_SPACING_INDEX)); else ------------------------------------------------------------ revno: 110983 committer: Stefan Monnier branch nick: trunk timestamp: Thu 2012-11-22 22:26:09 -0500 message: * emacs-lisp/ert.el, emacs-lisp/ert-x.el: Use cl-lib and lexical-binding. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-22 08:09:03 +0000 +++ lisp/ChangeLog 2012-11-23 03:26:09 +0000 @@ -1,3 +1,7 @@ +2012-11-23 Stefan Monnier + + * emacs-lisp/ert.el, emacs-lisp/ert-x.el: Use cl-lib and lexical-binding. + 2012-11-22 Paul Eggert * calc/calc.el (calc-gregorian-switch): Move to after calc-refresh @@ -5,8 +9,8 @@ (calc-gregorian-switch): In menu, put dates before regions. This is easier to follow, lines up better in the menu, and lets us coalesce regions that switch at the same time. Give country - names, not "Vatican", as that's better for non-expert users. Use - names that are stable between the date of switch and now, e.g., + names, not "Vatican", as that's better for non-expert users. + Use names that are stable between the date of switch and now, e.g., Bohemia and Moravia (which existed then and now) and not Czechoslovakia (which didn't exist then and doesn't exist now). What is now the U.S. mostly did not switch at the same time as === modified file 'lisp/emacs-lisp/ert-x.el' --- lisp/emacs-lisp/ert-x.el 2012-09-24 15:58:20 +0000 +++ lisp/emacs-lisp/ert-x.el 2012-11-23 03:26:09 +0000 @@ -1,4 +1,4 @@ -;;; ert-x.el --- Staging area for experimental extensions to ERT +;;; ert-x.el --- Staging area for experimental extensions to ERT -*- lexical-binding: t -*- ;; Copyright (C) 2008, 2010-2012 Free Software Foundation, Inc. @@ -28,8 +28,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'ert) @@ -90,8 +89,8 @@ (kill-buffer ert--buffer) (remhash ert--buffer ert--test-buffers)))) -(defmacro* ert-with-test-buffer ((&key ((:name name-form))) - &body body) +(cl-defmacro ert-with-test-buffer ((&key ((:name name-form))) + &body body) "Create a test buffer and run BODY in that buffer. To be used in ERT tests. If BODY finishes successfully, the test @@ -116,10 +115,10 @@ "Kill all test buffers that are still live." (interactive) (let ((count 0)) - (maphash (lambda (buffer dummy) + (maphash (lambda (buffer _dummy) (when (or (not (buffer-live-p buffer)) (kill-buffer buffer)) - (incf count))) + (cl-incf count))) ert--test-buffers) (message "%s out of %s test buffers killed" count (hash-table-count ert--test-buffers))) @@ -149,9 +148,9 @@ NOTE: Since the command is not called by `call-interactively' test for `called-interactively' in the command will fail." - (assert (listp command) t) - (assert (commandp (car command)) t) - (assert (not unread-command-events) t) + (cl-assert (listp command) t) + (cl-assert (commandp (car command)) t) + (cl-assert (not unread-command-events) t) (let (return-value) ;; For the order of things here see command_loop_1 in keyboard.c. ;; @@ -175,7 +174,7 @@ (when (boundp 'last-repeatable-command) (setq last-repeatable-command real-last-command)) (when (and deactivate-mark transient-mark-mode) (deactivate-mark)) - (assert (not unread-command-events) t) + (cl-assert (not unread-command-events) t) return-value)) (defun ert-run-idle-timers () @@ -198,7 +197,7 @@ (with-temp-buffer (insert s) (dolist (x regexps) - (destructuring-bind (regexp subexp) (if (listp x) x `(,x nil)) + (cl-destructuring-bind (regexp subexp) (if (listp x) x `(,x nil)) (goto-char (point-min)) (while (re-search-forward regexp nil t) (replace-match "" t t nil subexp)))) @@ -224,15 +223,15 @@ None of the ARGS are modified, but the return value may share structure with the plists in ARGS." (with-temp-buffer - (loop with current-plist = nil - for x in args do - (etypecase x - (string (let ((begin (point))) - (insert x) - (set-text-properties begin (point) current-plist))) - (list (unless (zerop (mod (length x) 2)) - (error "Odd number of args in plist: %S" x)) - (setq current-plist x)))) + (cl-loop with current-plist = nil + for x in args do + (cl-etypecase x + (string (let ((begin (point))) + (insert x) + (set-text-properties begin (point) current-plist))) + (list (unless (zerop (mod (length x) 2)) + (error "Odd number of args in plist: %S" x)) + (setq current-plist x)))) (buffer-string))) @@ -245,8 +244,8 @@ This is useful if THUNK has undesirable side-effects on an Emacs buffer with a fixed name such as *Messages*." - (lexical-let ((new-buffer-name (generate-new-buffer-name - (format "%s orig buffer" buffer-name)))) + (let ((new-buffer-name (generate-new-buffer-name + (format "%s orig buffer" buffer-name)))) (with-current-buffer (get-buffer-create buffer-name) (rename-buffer new-buffer-name)) (unwind-protect @@ -258,7 +257,7 @@ (with-current-buffer new-buffer-name (rename-buffer buffer-name))))) -(defmacro* ert-with-buffer-renamed ((buffer-name-form) &body body) +(cl-defmacro ert-with-buffer-renamed ((buffer-name-form) &body body) "Protect the buffer named BUFFER-NAME from side-effects and run BODY. See `ert-call-with-buffer-renamed' for details." === modified file 'lisp/emacs-lisp/ert.el' --- lisp/emacs-lisp/ert.el 2012-11-19 17:02:20 +0000 +++ lisp/emacs-lisp/ert.el 2012-11-23 03:26:09 +0000 @@ -1,4 +1,4 @@ -;;; ert.el --- Emacs Lisp Regression Testing +;;; ert.el --- Emacs Lisp Regression Testing -*- lexical-binding: t -*- ;; Copyright (C) 2007-2008, 2010-2012 Free Software Foundation, Inc. @@ -54,8 +54,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'button) (require 'debug) (require 'easymenu) @@ -105,33 +104,33 @@ "A reimplementation of `remove-if-not'. ERT-PRED is a predicate, ERT-LIST is the input list." - (loop for ert-x in ert-list - if (funcall ert-pred ert-x) - collect ert-x)) + (cl-loop for ert-x in ert-list + if (funcall ert-pred ert-x) + collect ert-x)) (defun ert--intersection (a b) "A reimplementation of `intersection'. Intersect the sets A and B. Elements are compared using `eql'." - (loop for x in a - if (memql x b) - collect x)) + (cl-loop for x in a + if (memql x b) + collect x)) (defun ert--set-difference (a b) "A reimplementation of `set-difference'. Subtract the set B from the set A. Elements are compared using `eql'." - (loop for x in a - unless (memql x b) - collect x)) + (cl-loop for x in a + unless (memql x b) + collect x)) (defun ert--set-difference-eq (a b) "A reimplementation of `set-difference'. Subtract the set B from the set A. Elements are compared using `eq'." - (loop for x in a - unless (memq x b) - collect x)) + (cl-loop for x in a + unless (memq x b) + collect x)) (defun ert--union (a b) "A reimplementation of `union'. Compute the union of the sets A and B. @@ -149,7 +148,7 @@ (make-symbol (format "%s%s" prefix (prog1 ert--gensym-counter - (incf ert--gensym-counter)))))) + (cl-incf ert--gensym-counter)))))) (defun ert--coerce-to-vector (x) "Coerce X to a vector." @@ -158,19 +157,19 @@ x (vconcat x))) -(defun* ert--remove* (x list &key key test) +(cl-defun ert--remove* (x list &key key test) "Does not support all the keywords of remove*." (unless key (setq key #'identity)) (unless test (setq test #'eql)) - (loop for y in list - unless (funcall test x (funcall key y)) - collect y)) + (cl-loop for y in list + unless (funcall test x (funcall key y)) + collect y)) (defun ert--string-position (c s) "Return the position of the first occurrence of C in S, or nil if none." - (loop for i from 0 - for x across s - when (eql x c) return i)) + (cl-loop for i from 0 + for x across s + when (eql x c) return i)) (defun ert--mismatch (a b) "Return index of first element that differs between A and B. @@ -184,29 +183,30 @@ (t (let ((la (length a)) (lb (length b))) - (assert (arrayp a) t) - (assert (arrayp b) t) - (assert (<= la lb) t) - (loop for i below la - when (not (equal (aref a i) (aref b i))) return i - finally (return (if (/= la lb) - la - (assert (equal a b) t) - nil))))))) + (cl-assert (arrayp a) t) + (cl-assert (arrayp b) t) + (cl-assert (<= la lb) t) + (cl-loop for i below la + when (not (equal (aref a i) (aref b i))) return i + finally (cl-return (if (/= la lb) + la + (cl-assert (equal a b) t) + nil))))))) (defun ert--subseq (seq start &optional end) "Return a subsequence of SEQ from START to END." (when (char-table-p seq) (error "Not supported")) (let ((vector (substring (ert--coerce-to-vector seq) start end))) - (etypecase seq + (cl-etypecase seq (vector vector) (string (concat vector)) (list (append vector nil)) - (bool-vector (loop with result = (make-bool-vector (length vector) nil) - for i below (length vector) do - (setf (aref result i) (aref vector i)) - finally (return result))) - (char-table (assert nil))))) + (bool-vector (cl-loop with result + = (make-bool-vector (length vector) nil) + for i below (length vector) do + (setf (aref result i) (aref vector i)) + finally (cl-return result))) + (char-table (cl-assert nil))))) (defun ert-equal-including-properties (a b) "Return t if A and B have similar structure and contents. @@ -225,10 +225,10 @@ ;;; Defining and locating tests. ;; The data structure that represents a test case. -(defstruct ert-test +(cl-defstruct ert-test (name nil) (documentation nil) - (body (assert nil)) + (body (cl-assert nil)) (most-recent-result nil) (expected-result-type ':passed) (tags '())) @@ -273,7 +273,7 @@ and the body." (let ((extracted-key-accu '()) (remaining keys-and-body)) - (while (and (consp remaining) (keywordp (first remaining))) + (while (keywordp (car-safe remaining)) (let ((keyword (pop remaining))) (unless (consp remaining) (error "Value expected after keyword %S in %S" @@ -283,13 +283,13 @@ keys-and-body)) (push (cons keyword (pop remaining)) extracted-key-accu))) (setq extracted-key-accu (nreverse extracted-key-accu)) - (list (loop for (key . value) in extracted-key-accu - collect key - collect value) + (list (cl-loop for (key . value) in extracted-key-accu + collect key + collect value) remaining))) ;;;###autoload -(defmacro* ert-deftest (name () &body docstring-keys-and-body) +(cl-defmacro ert-deftest (name () &body docstring-keys-and-body) "Define NAME (a symbol) as a test. BODY is evaluated as a `progn' when the test is run. It should @@ -313,12 +313,13 @@ (indent 2)) (let ((documentation nil) (documentation-supplied-p nil)) - (when (stringp (first docstring-keys-and-body)) + (when (stringp (car docstring-keys-and-body)) (setq documentation (pop docstring-keys-and-body) documentation-supplied-p t)) - (destructuring-bind ((&key (expected-result nil expected-result-supplied-p) - (tags nil tags-supplied-p)) - body) + (cl-destructuring-bind + ((&key (expected-result nil expected-result-supplied-p) + (tags nil tags-supplied-p)) + body) (ert--parse-keys-and-body docstring-keys-and-body) `(progn (ert-set-test ',name @@ -405,10 +406,10 @@ (t (let ((fn-name (car form)) (arg-forms (cdr form))) - (assert (or (symbolp fn-name) - (and (consp fn-name) - (eql (car fn-name) 'lambda) - (listp (cdr fn-name))))) + (cl-assert (or (symbolp fn-name) + (and (consp fn-name) + (eql (car fn-name) 'lambda) + (listp (cdr fn-name))))) (let ((fn (ert--gensym "fn-")) (args (ert--gensym "args-")) (value (ert--gensym "value-")) @@ -446,35 +447,34 @@ and error signaling specific to the particular variant of `should'. The code that INNER-EXPANDER returns must not call FORM-DESCRIPTION-FORM before it has called INNER-FORM." - (lexical-let ((inner-expander inner-expander)) - (ert--expand-should-1 - whole form - (lambda (inner-form form-description-form value-var) - (let ((form-description (ert--gensym "form-description-"))) - `(let (,form-description) - ,(funcall inner-expander - `(unwind-protect - ,inner-form - (setq ,form-description ,form-description-form) - (ert--signal-should-execution ,form-description)) - `,form-description - value-var))))))) + (ert--expand-should-1 + whole form + (lambda (inner-form form-description-form value-var) + (let ((form-description (ert--gensym "form-description-"))) + `(let (,form-description) + ,(funcall inner-expander + `(unwind-protect + ,inner-form + (setq ,form-description ,form-description-form) + (ert--signal-should-execution ,form-description)) + `,form-description + value-var)))))) -(defmacro* should (form) +(cl-defmacro should (form) "Evaluate FORM. If it returns nil, abort the current test as failed. Returns the value of FORM." (ert--expand-should `(should ,form) form - (lambda (inner-form form-description-form value-var) + (lambda (inner-form form-description-form _value-var) `(unless ,inner-form (ert-fail ,form-description-form))))) -(defmacro* should-not (form) +(cl-defmacro should-not (form) "Evaluate FORM. If it returns non-nil, abort the current test as failed. Returns nil." (ert--expand-should `(should-not ,form) form - (lambda (inner-form form-description-form value-var) + (lambda (inner-form form-description-form _value-var) `(unless (not ,inner-form) (ert-fail ,form-description-form))))) @@ -485,10 +485,10 @@ Determines whether CONDITION matches TYPE and EXCLUDE-SUBTYPES, and aborts the current test as failed if it doesn't." (let ((signaled-conditions (get (car condition) 'error-conditions)) - (handled-conditions (etypecase type + (handled-conditions (cl-etypecase type (list type) (symbol (list type))))) - (assert signaled-conditions) + (cl-assert signaled-conditions) (unless (ert--intersection signaled-conditions handled-conditions) (ert-fail (append (funcall form-description-fn) @@ -507,7 +507,7 @@ ;; FIXME: The expansion will evaluate the keyword args (if any) in ;; nonstandard order. -(defmacro* should-error (form &rest keys &key type exclude-subtypes) +(cl-defmacro should-error (form &rest keys &key type exclude-subtypes) "Evaluate FORM and check that it signals an error. The error signaled needs to match TYPE. TYPE should be a list @@ -555,19 +555,19 @@ (defun ert--proper-list-p (x) "Return non-nil if X is a proper list, nil otherwise." - (loop + (cl-loop for firstp = t then nil for fast = x then (cddr fast) for slow = x then (cdr slow) do - (when (null fast) (return t)) - (when (not (consp fast)) (return nil)) - (when (null (cdr fast)) (return t)) - (when (not (consp (cdr fast))) (return nil)) - (when (and (not firstp) (eq fast slow)) (return nil)))) + (when (null fast) (cl-return t)) + (when (not (consp fast)) (cl-return nil)) + (when (null (cdr fast)) (cl-return t)) + (when (not (consp (cdr fast))) (cl-return nil)) + (when (and (not firstp) (eq fast slow)) (cl-return nil)))) (defun ert--explain-format-atom (x) "Format the atom X for `ert--explain-equal'." - (typecase x + (cl-typecase x (fixnum (list x (format "#x%x" x) (format "?%c" x))) (t x))) @@ -576,7 +576,7 @@ Returns nil if they are." (if (not (equal (type-of a) (type-of b))) `(different-types ,a ,b) - (etypecase a + (cl-etypecase a (cons (let ((a-proper-p (ert--proper-list-p a)) (b-proper-p (ert--proper-list-p b))) @@ -588,19 +588,19 @@ ,a ,b first-mismatch-at ,(ert--mismatch a b)) - (loop for i from 0 - for ai in a - for bi in b - for xi = (ert--explain-equal-rec ai bi) - do (when xi (return `(list-elt ,i ,xi))) - finally (assert (equal a b) t))) + (cl-loop for i from 0 + for ai in a + for bi in b + for xi = (ert--explain-equal-rec ai bi) + do (when xi (cl-return `(list-elt ,i ,xi))) + finally (cl-assert (equal a b) t))) (let ((car-x (ert--explain-equal-rec (car a) (car b)))) (if car-x `(car ,car-x) (let ((cdr-x (ert--explain-equal-rec (cdr a) (cdr b)))) (if cdr-x `(cdr ,cdr-x) - (assert (equal a b) t) + (cl-assert (equal a b) t) nil)))))))) (array (if (not (equal (length a) (length b))) `(arrays-of-different-length ,(length a) ,(length b) @@ -608,12 +608,12 @@ ,@(unless (char-table-p a) `(first-mismatch-at ,(ert--mismatch a b)))) - (loop for i from 0 - for ai across a - for bi across b - for xi = (ert--explain-equal-rec ai bi) - do (when xi (return `(array-elt ,i ,xi))) - finally (assert (equal a b) t)))) + (cl-loop for i from 0 + for ai across a + for bi across b + for xi = (ert--explain-equal-rec ai bi) + do (when xi (cl-return `(array-elt ,i ,xi))) + finally (cl-assert (equal a b) t)))) (atom (if (not (equal a b)) (if (and (symbolp a) (symbolp b) (string= a b)) `(different-symbols-with-the-same-name ,a ,b) @@ -632,10 +632,10 @@ (defun ert--significant-plist-keys (plist) "Return the keys of PLIST that have non-null values, in order." - (assert (zerop (mod (length plist) 2)) t) - (loop for (key value . rest) on plist by #'cddr - unless (or (null value) (memq key accu)) collect key into accu - finally (return accu))) + (cl-assert (zerop (mod (length plist) 2)) t) + (cl-loop for (key value . rest) on plist by #'cddr + unless (or (null value) (memq key accu)) collect key into accu + finally (cl-return accu))) (defun ert--plist-difference-explanation (a b) "Return a programmer-readable explanation of why A and B are different plists. @@ -643,8 +643,8 @@ Returns nil if they are equivalent, i.e., have the same value for each key, where absent values are treated as nil. The order of key/value pairs in each list does not matter." - (assert (zerop (mod (length a) 2)) t) - (assert (zerop (mod (length b) 2)) t) + (cl-assert (zerop (mod (length a) 2)) t) + (cl-assert (zerop (mod (length b) 2)) t) ;; Normalizing the plists would be another way to do this but it ;; requires a total ordering on all lisp objects (since any object ;; is valid as a text property key). Perhaps defining such an @@ -654,21 +654,21 @@ (keys-b (ert--significant-plist-keys b)) (keys-in-a-not-in-b (ert--set-difference-eq keys-a keys-b)) (keys-in-b-not-in-a (ert--set-difference-eq keys-b keys-a))) - (flet ((explain-with-key (key) - (let ((value-a (plist-get a key)) - (value-b (plist-get b key))) - (assert (not (equal value-a value-b)) t) - `(different-properties-for-key - ,key ,(ert--explain-equal-including-properties value-a - value-b))))) + (cl-flet ((explain-with-key (key) + (let ((value-a (plist-get a key)) + (value-b (plist-get b key))) + (cl-assert (not (equal value-a value-b)) t) + `(different-properties-for-key + ,key ,(ert--explain-equal-including-properties value-a + value-b))))) (cond (keys-in-a-not-in-b - (explain-with-key (first keys-in-a-not-in-b))) + (explain-with-key (car keys-in-a-not-in-b))) (keys-in-b-not-in-a - (explain-with-key (first keys-in-b-not-in-a))) + (explain-with-key (car keys-in-b-not-in-a))) (t - (loop for key in keys-a - when (not (equal (plist-get a key) (plist-get b key))) - return (explain-with-key key))))))) + (cl-loop for key in keys-a + when (not (equal (plist-get a key) (plist-get b key))) + return (explain-with-key key))))))) (defun ert--abbreviate-string (s len suffixp) "Shorten string S to at most LEN chars. @@ -692,29 +692,30 @@ `ert-equal-including-properties', or nil if they are." (if (not (equal a b)) (ert--explain-equal a b) - (assert (stringp a) t) - (assert (stringp b) t) - (assert (eql (length a) (length b)) t) - (loop for i from 0 to (length a) - for props-a = (text-properties-at i a) - for props-b = (text-properties-at i b) - for difference = (ert--plist-difference-explanation props-a props-b) - do (when difference - (return `(char ,i ,(substring-no-properties a i (1+ i)) - ,difference - context-before - ,(ert--abbreviate-string - (substring-no-properties a 0 i) - 10 t) - context-after - ,(ert--abbreviate-string - (substring-no-properties a (1+ i)) - 10 nil)))) - ;; TODO(ohler): Get `equal-including-properties' fixed in - ;; Emacs, delete `ert-equal-including-properties', and - ;; re-enable this assertion. - ;;finally (assert (equal-including-properties a b) t) - ))) + (cl-assert (stringp a) t) + (cl-assert (stringp b) t) + (cl-assert (eql (length a) (length b)) t) + (cl-loop for i from 0 to (length a) + for props-a = (text-properties-at i a) + for props-b = (text-properties-at i b) + for difference = (ert--plist-difference-explanation + props-a props-b) + do (when difference + (cl-return `(char ,i ,(substring-no-properties a i (1+ i)) + ,difference + context-before + ,(ert--abbreviate-string + (substring-no-properties a 0 i) + 10 t) + context-after + ,(ert--abbreviate-string + (substring-no-properties a (1+ i)) + 10 nil)))) + ;; TODO(ohler): Get `equal-including-properties' fixed in + ;; Emacs, delete `ert-equal-including-properties', and + ;; re-enable this assertion. + ;;finally (cl-assert (equal-including-properties a b) t) + ))) (put 'ert-equal-including-properties 'ert-explainer 'ert--explain-equal-including-properties) @@ -729,8 +730,8 @@ Bound dynamically. This is a list of (PREFIX . MESSAGE) pairs.") -(defmacro* ert-info ((message-form &key ((:prefix prefix-form) "Info: ")) - &body body) +(cl-defmacro ert-info ((message-form &key ((:prefix prefix-form) "Info: ")) + &body body) "Evaluate MESSAGE-FORM and BODY, and report the message if BODY fails. To be used within ERT tests. MESSAGE-FORM should evaluate to a @@ -750,18 +751,19 @@ "Non-nil means enter debugger when a test fails or terminates with an error.") ;; The data structures that represent the result of running a test. -(defstruct ert-test-result +(cl-defstruct ert-test-result (messages nil) (should-forms nil) ) -(defstruct (ert-test-passed (:include ert-test-result))) -(defstruct (ert-test-result-with-condition (:include ert-test-result)) - (condition (assert nil)) - (backtrace (assert nil)) - (infos (assert nil))) -(defstruct (ert-test-quit (:include ert-test-result-with-condition))) -(defstruct (ert-test-failed (:include ert-test-result-with-condition))) -(defstruct (ert-test-aborted-with-non-local-exit (:include ert-test-result))) +(cl-defstruct (ert-test-passed (:include ert-test-result))) +(cl-defstruct (ert-test-result-with-condition (:include ert-test-result)) + (condition (cl-assert nil)) + (backtrace (cl-assert nil)) + (infos (cl-assert nil))) +(cl-defstruct (ert-test-quit (:include ert-test-result-with-condition))) +(cl-defstruct (ert-test-failed (:include ert-test-result-with-condition))) +(cl-defstruct (ert-test-aborted-with-non-local-exit + (:include ert-test-result))) (defun ert--record-backtrace () @@ -774,7 +776,7 @@ ;; `ert-results-pop-to-backtrace-for-test-at-point' given that we ;; already have `ert-results-rerun-test-debugging-errors-at-point'. ;; For batch use, however, printing the backtrace may be useful. - (loop + (cl-loop ;; 6 is the number of frames our own debugger adds (when ;; compiled; more when interpreted). FIXME: Need to describe a ;; procedure for determining this constant. @@ -791,33 +793,33 @@ (print-level 8) (print-length 50)) (dolist (frame backtrace) - (ecase (first frame) + (cl-ecase (car frame) ((nil) ;; Special operator. - (destructuring-bind (special-operator &rest arg-forms) + (cl-destructuring-bind (special-operator &rest arg-forms) (cdr frame) (insert - (format " %S\n" (list* special-operator arg-forms))))) + (format " %S\n" (cons special-operator arg-forms))))) ((t) ;; Function call. - (destructuring-bind (fn &rest args) (cdr frame) + (cl-destructuring-bind (fn &rest args) (cdr frame) (insert (format " %S(" fn)) - (loop for firstp = t then nil - for arg in args do - (unless firstp - (insert " ")) - (insert (format "%S" arg))) + (cl-loop for firstp = t then nil + for arg in args do + (unless firstp + (insert " ")) + (insert (format "%S" arg))) (insert ")\n"))))))) ;; A container for the state of the execution of a single test and ;; environment data needed during its execution. -(defstruct ert--test-execution-info - (test (assert nil)) - (result (assert nil)) +(cl-defstruct ert--test-execution-info + (test (cl-assert nil)) + (result (cl-assert nil)) ;; A thunk that may be called when RESULT has been set to its final ;; value and test execution should be terminated. Should not ;; return. - (exit-continuation (assert nil)) + (exit-continuation (cl-assert nil)) ;; The binding of `debugger' outside of the execution of the test. next-debugger ;; The binding of `ert-debug-on-error' that is in effect for the @@ -826,7 +828,7 @@ ;; don't remember whether this feature is important.) ert-debug-on-error) -(defun ert--run-test-debugger (info debugger-args) +(defun ert--run-test-debugger (info args) "During a test run, `debugger' is bound to a closure that calls this function. This function records failures and errors and either terminates @@ -834,21 +836,21 @@ appropriate. INFO is the ert--test-execution-info corresponding to this test -run. DEBUGGER-ARGS are the arguments to `debugger'." - (destructuring-bind (first-debugger-arg &rest more-debugger-args) - debugger-args - (ecase first-debugger-arg +run. ARGS are the arguments to `debugger'." + (cl-destructuring-bind (first-debugger-arg &rest more-debugger-args) + args + (cl-ecase first-debugger-arg ((lambda debug t exit nil) - (apply (ert--test-execution-info-next-debugger info) debugger-args)) + (apply (ert--test-execution-info-next-debugger info) args)) (error - (let* ((condition (first more-debugger-args)) - (type (case (car condition) + (let* ((condition (car more-debugger-args)) + (type (cl-case (car condition) ((quit) 'quit) (otherwise 'failed))) (backtrace (ert--record-backtrace)) (infos (reverse ert--infos))) (setf (ert--test-execution-info-result info) - (ecase type + (cl-ecase type (quit (make-ert-test-quit :condition condition :backtrace backtrace @@ -859,39 +861,42 @@ :infos infos)))) ;; Work around Emacs's heuristic (in eval.c) for detecting ;; errors in the debugger. - (incf num-nonmacro-input-events) + (cl-incf num-nonmacro-input-events) ;; FIXME: We should probably implement more fine-grained ;; control a la non-t `debug-on-error' here. (cond ((ert--test-execution-info-ert-debug-on-error info) - (apply (ert--test-execution-info-next-debugger info) debugger-args)) + (apply (ert--test-execution-info-next-debugger info) args)) (t)) (funcall (ert--test-execution-info-exit-continuation info))))))) -(defun ert--run-test-internal (ert-test-execution-info) - "Low-level function to run a test according to ERT-TEST-EXECUTION-INFO. +(defun ert--run-test-internal (test-execution-info) + "Low-level function to run a test according to TEST-EXECUTION-INFO. This mainly sets up debugger-related bindings." - (lexical-let ((info ert-test-execution-info)) - (setf (ert--test-execution-info-next-debugger info) debugger - (ert--test-execution-info-ert-debug-on-error info) ert-debug-on-error) - (catch 'ert--pass - ;; For now, each test gets its own temp buffer and its own - ;; window excursion, just to be safe. If this turns out to be - ;; too expensive, we can remove it. - (with-temp-buffer - (save-window-excursion - (let ((debugger (lambda (&rest debugger-args) - (ert--run-test-debugger info debugger-args))) - (debug-on-error t) - (debug-on-quit t) - ;; FIXME: Do we need to store the old binding of this - ;; and consider it in `ert--run-test-debugger'? - (debug-ignored-errors nil) - (ert--infos '())) - (funcall (ert-test-body (ert--test-execution-info-test info)))))) - (ert-pass)) - (setf (ert--test-execution-info-result info) (make-ert-test-passed))) + (setf (ert--test-execution-info-next-debugger test-execution-info) debugger + (ert--test-execution-info-ert-debug-on-error test-execution-info) + ert-debug-on-error) + (catch 'ert--pass + ;; For now, each test gets its own temp buffer and its own + ;; window excursion, just to be safe. If this turns out to be + ;; too expensive, we can remove it. + (with-temp-buffer + (save-window-excursion + (let ((debugger (lambda (&rest args) + (ert--run-test-debugger test-execution-info + args))) + (debug-on-error t) + (debug-on-quit t) + ;; FIXME: Do we need to store the old binding of this + ;; and consider it in `ert--run-test-debugger'? + (debug-ignored-errors nil) + (ert--infos '())) + (funcall (ert-test-body (ert--test-execution-info-test + test-execution-info)))))) + (ert-pass)) + (setf (ert--test-execution-info-result test-execution-info) + (make-ert-test-passed)) nil) (defun ert--force-message-log-buffer-truncation () @@ -929,18 +934,18 @@ Returns the result and stores it in ERT-TEST's `most-recent-result' slot." (setf (ert-test-most-recent-result ert-test) nil) - (block error - (lexical-let ((begin-marker - (with-current-buffer (get-buffer-create "*Messages*") - (set-marker (make-marker) (point-max))))) + (cl-block error + (let ((begin-marker + (with-current-buffer (get-buffer-create "*Messages*") + (set-marker (make-marker) (point-max))))) (unwind-protect - (lexical-let ((info (make-ert--test-execution-info - :test ert-test - :result - (make-ert-test-aborted-with-non-local-exit) - :exit-continuation (lambda () - (return-from error nil)))) - (should-form-accu (list))) + (let ((info (make-ert--test-execution-info + :test ert-test + :result + (make-ert-test-aborted-with-non-local-exit) + :exit-continuation (lambda () + (cl-return-from error nil)))) + (should-form-accu (list))) (unwind-protect (let ((ert--should-execution-observer (lambda (form-description) @@ -982,32 +987,32 @@ RESULT." ;; It would be easy to add `member' and `eql' types etc., but I ;; haven't bothered yet. - (etypecase result-type + (cl-etypecase result-type ((member nil) nil) ((member t) t) ((member :failed) (ert-test-failed-p result)) ((member :passed) (ert-test-passed-p result)) (cons - (destructuring-bind (operator &rest operands) result-type - (ecase operator + (cl-destructuring-bind (operator &rest operands) result-type + (cl-ecase operator (and - (case (length operands) + (cl-case (length operands) (0 t) (t - (and (ert-test-result-type-p result (first operands)) - (ert-test-result-type-p result `(and ,@(rest operands))))))) + (and (ert-test-result-type-p result (car operands)) + (ert-test-result-type-p result `(and ,@(cdr operands))))))) (or - (case (length operands) + (cl-case (length operands) (0 nil) (t - (or (ert-test-result-type-p result (first operands)) - (ert-test-result-type-p result `(or ,@(rest operands))))))) + (or (ert-test-result-type-p result (car operands)) + (ert-test-result-type-p result `(or ,@(cdr operands))))))) (not - (assert (eql (length operands) 1)) - (not (ert-test-result-type-p result (first operands)))) + (cl-assert (eql (length operands) 1)) + (not (ert-test-result-type-p result (car operands)))) (satisfies - (assert (eql (length operands) 1)) - (funcall (first operands) result))))))) + (cl-assert (eql (length operands) 1)) + (funcall (car operands) result))))))) (defun ert-test-result-expected-p (test result) "Return non-nil if TEST's expected result type matches RESULT." @@ -1048,9 +1053,9 @@ contained in UNIVERSE." ;; This code needs to match the etypecase in ;; `ert-insert-human-readable-selector'. - (etypecase selector + (cl-etypecase selector ((member nil) nil) - ((member t) (etypecase universe + ((member t) (cl-etypecase universe (list universe) ((member t) (ert-select-tests "" universe)))) ((member :new) (ert-select-tests @@ -1078,7 +1083,7 @@ universe)) ((member :unexpected) (ert-select-tests `(not :expected) universe)) (string - (etypecase universe + (cl-etypecase universe ((member t) (mapcar #'ert-get-test (apropos-internal selector #'ert-test-boundp))) (list (ert--remove-if-not (lambda (test) @@ -1088,51 +1093,51 @@ universe)))) (ert-test (list selector)) (symbol - (assert (ert-test-boundp selector)) + (cl-assert (ert-test-boundp selector)) (list (ert-get-test selector))) (cons - (destructuring-bind (operator &rest operands) selector - (ecase operator + (cl-destructuring-bind (operator &rest operands) selector + (cl-ecase operator (member (mapcar (lambda (purported-test) - (etypecase purported-test - (symbol (assert (ert-test-boundp purported-test)) + (cl-etypecase purported-test + (symbol (cl-assert (ert-test-boundp purported-test)) (ert-get-test purported-test)) (ert-test purported-test))) operands)) (eql - (assert (eql (length operands) 1)) + (cl-assert (eql (length operands) 1)) (ert-select-tests `(member ,@operands) universe)) (and ;; Do these definitions of AND, NOT and OR satisfy de ;; Morgan's laws? Should they? - (case (length operands) + (cl-case (length operands) (0 (ert-select-tests 't universe)) - (t (ert-select-tests `(and ,@(rest operands)) - (ert-select-tests (first operands) + (t (ert-select-tests `(and ,@(cdr operands)) + (ert-select-tests (car operands) universe))))) (not - (assert (eql (length operands) 1)) + (cl-assert (eql (length operands) 1)) (let ((all-tests (ert-select-tests 't universe))) (ert--set-difference all-tests - (ert-select-tests (first operands) + (ert-select-tests (car operands) all-tests)))) (or - (case (length operands) + (cl-case (length operands) (0 (ert-select-tests 'nil universe)) - (t (ert--union (ert-select-tests (first operands) universe) - (ert-select-tests `(or ,@(rest operands)) + (t (ert--union (ert-select-tests (car operands) universe) + (ert-select-tests `(or ,@(cdr operands)) universe))))) (tag - (assert (eql (length operands) 1)) - (let ((tag (first operands))) + (cl-assert (eql (length operands) 1)) + (let ((tag (car operands))) (ert-select-tests `(satisfies ,(lambda (test) (member tag (ert-test-tags test)))) universe))) (satisfies - (assert (eql (length operands) 1)) - (ert--remove-if-not (first operands) + (cl-assert (eql (length operands) 1)) + (ert--remove-if-not (car operands) (ert-select-tests 't universe)))))))) (defun ert--insert-human-readable-selector (selector) @@ -1141,26 +1146,27 @@ ;; `backtrace' slot of the result objects in the ;; `most-recent-result' slots of test case objects in (eql ...) or ;; (member ...) selectors. - (labels ((rec (selector) - ;; This code needs to match the etypecase in `ert-select-tests'. - (etypecase selector - ((or (member nil t - :new :failed :passed - :expected :unexpected) - string - symbol) - selector) - (ert-test - (if (ert-test-name selector) - (make-symbol (format "<%S>" (ert-test-name selector))) - (make-symbol ""))) - (cons - (destructuring-bind (operator &rest operands) selector - (ecase operator - ((member eql and not or) - `(,operator ,@(mapcar #'rec operands))) - ((member tag satisfies) - selector))))))) + (cl-labels ((rec (selector) + ;; This code needs to match the etypecase in + ;; `ert-select-tests'. + (cl-etypecase selector + ((or (member nil t + :new :failed :passed + :expected :unexpected) + string + symbol) + selector) + (ert-test + (if (ert-test-name selector) + (make-symbol (format "<%S>" (ert-test-name selector))) + (make-symbol ""))) + (cons + (cl-destructuring-bind (operator &rest operands) selector + (cl-ecase operator + ((member eql and not or) + `(,operator ,@(mapcar #'rec operands))) + ((member tag satisfies) + selector))))))) (insert (format "%S" (rec selector))))) @@ -1177,21 +1183,21 @@ ;; that corresponds to this run in order to be able to update the ;; statistics correctly when a test is re-run interactively and has a ;; different result than before. -(defstruct ert--stats - (selector (assert nil)) +(cl-defstruct ert--stats + (selector (cl-assert nil)) ;; The tests, in order. - (tests (assert nil) :type vector) + (tests (cl-assert nil) :type vector) ;; A map of test names (or the test objects themselves for unnamed ;; tests) to indices into the `tests' vector. - (test-map (assert nil) :type hash-table) + (test-map (cl-assert nil) :type hash-table) ;; The results of the tests during this run, in order. - (test-results (assert nil) :type vector) + (test-results (cl-assert nil) :type vector) ;; The start times of the tests, in order, as reported by ;; `current-time'. - (test-start-times (assert nil) :type vector) + (test-start-times (cl-assert nil) :type vector) ;; The end times of the tests, in order, as reported by ;; `current-time'. - (test-end-times (assert nil) :type vector) + (test-end-times (cl-assert nil) :type vector) (passed-expected 0) (passed-unexpected 0) (failed-expected 0) @@ -1241,21 +1247,25 @@ (results (ert--stats-test-results stats)) (old-test (aref tests pos)) (map (ert--stats-test-map stats))) - (flet ((update (d) - (if (ert-test-result-expected-p (aref tests pos) - (aref results pos)) - (etypecase (aref results pos) - (ert-test-passed (incf (ert--stats-passed-expected stats) d)) - (ert-test-failed (incf (ert--stats-failed-expected stats) d)) - (null) - (ert-test-aborted-with-non-local-exit) - (ert-test-quit)) - (etypecase (aref results pos) - (ert-test-passed (incf (ert--stats-passed-unexpected stats) d)) - (ert-test-failed (incf (ert--stats-failed-unexpected stats) d)) - (null) - (ert-test-aborted-with-non-local-exit) - (ert-test-quit))))) + (cl-flet ((update (d) + (if (ert-test-result-expected-p (aref tests pos) + (aref results pos)) + (cl-etypecase (aref results pos) + (ert-test-passed + (cl-incf (ert--stats-passed-expected stats) d)) + (ert-test-failed + (cl-incf (ert--stats-failed-expected stats) d)) + (null) + (ert-test-aborted-with-non-local-exit) + (ert-test-quit)) + (cl-etypecase (aref results pos) + (ert-test-passed + (cl-incf (ert--stats-passed-unexpected stats) d)) + (ert-test-failed + (cl-incf (ert--stats-failed-unexpected stats) d)) + (null) + (ert-test-aborted-with-non-local-exit) + (ert-test-quit))))) ;; Adjust counters to remove the result that is currently in stats. (update -1) ;; Put new test and result into stats. @@ -1273,11 +1283,11 @@ SELECTOR is the selector that was used to select TESTS." (setq tests (ert--coerce-to-vector tests)) (let ((map (make-hash-table :size (length tests)))) - (loop for i from 0 - for test across tests - for key = (ert--stats-test-key test) do - (assert (not (gethash key map))) - (setf (gethash key map) i)) + (cl-loop for i from 0 + for test across tests + for key = (ert--stats-test-key test) do + (cl-assert (not (gethash key map))) + (setf (gethash key map) i)) (make-ert--stats :selector selector :tests tests :test-map map @@ -1319,8 +1329,8 @@ (force-mode-line-update) (unwind-protect (progn - (loop for test in tests do - (ert-run-or-rerun-test stats test listener)) + (cl-loop for test in tests do + (ert-run-or-rerun-test stats test listener)) (setq abortedp nil)) (setf (ert--stats-aborted-p stats) abortedp) (setf (ert--stats-end-time stats) (current-time)) @@ -1344,7 +1354,7 @@ "Return a character that represents the test result RESULT. EXPECTEDP specifies whether the result was expected." - (let ((s (etypecase result + (let ((s (cl-etypecase result (ert-test-passed ".P") (ert-test-failed "fF") (null "--") @@ -1356,7 +1366,7 @@ "Return a string that represents the test result RESULT. EXPECTEDP specifies whether the result was expected." - (let ((s (etypecase result + (let ((s (cl-etypecase result (ert-test-passed '("passed" "PASSED")) (ert-test-failed '("failed" "FAILED")) (null '("unknown" "UNKNOWN")) @@ -1378,9 +1388,9 @@ "Insert `ert-info' infos from RESULT into current buffer. RESULT must be an `ert-test-result-with-condition'." - (check-type result ert-test-result-with-condition) + (cl-check-type result ert-test-result-with-condition) (dolist (info (ert-test-result-with-condition-infos result)) - (destructuring-bind (prefix . message) info + (cl-destructuring-bind (prefix . message) info (let ((begin (point)) (indentation (make-string (+ (length prefix) 4) ?\s)) (end nil)) @@ -1416,14 +1426,14 @@ (ert-run-tests selector (lambda (event-type &rest event-args) - (ecase event-type + (cl-ecase event-type (run-started - (destructuring-bind (stats) event-args + (cl-destructuring-bind (stats) event-args (message "Running %s tests (%s)" (length (ert--stats-tests stats)) (ert--format-time-iso8601 (ert--stats-start-time stats))))) (run-ended - (destructuring-bind (stats abortedp) event-args + (cl-destructuring-bind (stats abortedp) event-args (let ((unexpected (ert-stats-completed-unexpected stats)) (expected-failures (ert--stats-failed-expected stats))) (message "\n%sRan %s tests, %s results as expected%s (%s)%s\n" @@ -1441,19 +1451,19 @@ (format "\n%s expected failures" expected-failures))) (unless (zerop unexpected) (message "%s unexpected results:" unexpected) - (loop for test across (ert--stats-tests stats) - for result = (ert-test-most-recent-result test) do - (when (not (ert-test-result-expected-p test result)) - (message "%9s %S" - (ert-string-for-test-result result nil) - (ert-test-name test)))) + (cl-loop for test across (ert--stats-tests stats) + for result = (ert-test-most-recent-result test) do + (when (not (ert-test-result-expected-p test result)) + (message "%9s %S" + (ert-string-for-test-result result nil) + (ert-test-name test)))) (message "%s" ""))))) (test-started ) (test-ended - (destructuring-bind (stats test result) event-args + (cl-destructuring-bind (stats test result) event-args (unless (ert-test-result-expected-p test result) - (etypecase result + (cl-etypecase result (ert-test-passed (message "Test %S passed unexpectedly" (ert-test-name test))) (ert-test-result-with-condition @@ -1479,7 +1489,7 @@ (ert--pp-with-indentation-and-newline (ert-test-result-with-condition-condition result))) (goto-char (1- (point-max))) - (assert (looking-at "\n")) + (cl-assert (looking-at "\n")) (delete-char 1) (message "Test %S condition:" (ert-test-name test)) (message "%s" (buffer-string)))) @@ -1527,7 +1537,7 @@ (1 font-lock-keyword-face nil t) (2 font-lock-function-name-face nil t))))) -(defun* ert--remove-from-list (list-var element &key key test) +(cl-defun ert--remove-from-list (list-var element &key key test) "Remove ELEMENT from the value of LIST-VAR if present. This can be used as an inverse of `add-to-list'." @@ -1552,7 +1562,7 @@ include the default, if any. Signals an error if no test name was read." - (etypecase default + (cl-etypecase default (string (let ((symbol (intern-soft default))) (unless (and symbol (ert-test-boundp symbol)) (setq default nil)))) @@ -1609,11 +1619,11 @@ ;;; Display of test progress and results. ;; An entry in the results buffer ewoc. There is one entry per test. -(defstruct ert--ewoc-entry - (test (assert nil)) +(cl-defstruct ert--ewoc-entry + (test (cl-assert nil)) ;; If the result of this test was expected, its ewoc entry is hidden ;; initially. - (hidden-p (assert nil)) + (hidden-p (cl-assert nil)) ;; An ewoc entry may be collapsed to hide details such as the error ;; condition. ;; @@ -1689,7 +1699,7 @@ ((ert--stats-current-test stats) 'running) ((ert--stats-end-time stats) 'finished) (t 'preparing)))) - (ecase state + (cl-ecase state (preparing (insert "")) (aborted @@ -1700,12 +1710,12 @@ (t (insert "Aborted.")))) (running - (assert (ert--stats-current-test stats)) + (cl-assert (ert--stats-current-test stats)) (insert "Running test: ") (ert-insert-test-name-button (ert-test-name (ert--stats-current-test stats)))) (finished - (assert (not (ert--stats-current-test stats))) + (cl-assert (not (ert--stats-current-test stats))) (insert "Finished."))) (insert "\n") (if (ert--stats-end-time stats) @@ -1808,7 +1818,7 @@ (defun ert-face-for-stats (stats) "Return a face that represents STATS." (cond ((ert--stats-aborted-p stats) 'nil) - ((plusp (ert-stats-completed-unexpected stats)) + ((cl-plusp (ert-stats-completed-unexpected stats)) (ert-face-for-test-result nil)) ((eql (ert-stats-completed-expected stats) (ert-stats-total stats)) (ert-face-for-test-result t)) @@ -1819,7 +1829,7 @@ (let* ((test (ert--ewoc-entry-test entry)) (stats ert--results-stats) (result (let ((pos (ert--stats-test-pos stats test))) - (assert pos) + (cl-assert pos) (aref (ert--stats-test-results stats) pos))) (hiddenp (ert--ewoc-entry-hidden-p entry)) (expandedp (ert--ewoc-entry-expanded-p entry)) @@ -1845,7 +1855,7 @@ (ert--string-first-line (ert-test-documentation test)) 'font-lock-face 'font-lock-doc-face) "\n")) - (etypecase result + (cl-etypecase result (ert-test-passed (if (ert-test-result-expected-p test result) (insert " passed\n") @@ -1903,9 +1913,10 @@ (make-string (ert-stats-total stats) (ert-char-for-test-result nil t))) (set (make-local-variable 'ert--results-listener) listener) - (loop for test across (ert--stats-tests stats) do - (ewoc-enter-last ewoc - (make-ert--ewoc-entry :test test :hidden-p t))) + (cl-loop for test across (ert--stats-tests stats) do + (ewoc-enter-last ewoc + (make-ert--ewoc-entry :test test + :hidden-p t))) (ert--results-update-ewoc-hf ert--results-ewoc ert--results-stats) (goto-char (1- (point-max))) buffer))))) @@ -1940,21 +1951,21 @@ default nil)) nil)) (unless message-fn (setq message-fn 'message)) - (lexical-let ((output-buffer-name output-buffer-name) - buffer - listener - (message-fn message-fn)) + (let ((output-buffer-name output-buffer-name) + buffer + listener + (message-fn message-fn)) (setq listener (lambda (event-type &rest event-args) - (ecase event-type + (cl-ecase event-type (run-started - (destructuring-bind (stats) event-args + (cl-destructuring-bind (stats) event-args (setq buffer (ert--setup-results-buffer stats listener output-buffer-name)) (pop-to-buffer buffer))) (run-ended - (destructuring-bind (stats abortedp) event-args + (cl-destructuring-bind (stats abortedp) event-args (funcall message-fn "%sRan %s tests, %s results were as expected%s" (if (not abortedp) @@ -1971,19 +1982,19 @@ ert--results-ewoc) stats))) (test-started - (destructuring-bind (stats test) event-args + (cl-destructuring-bind (stats test) event-args (with-current-buffer buffer (let* ((ewoc ert--results-ewoc) (pos (ert--stats-test-pos stats test)) (node (ewoc-nth ewoc pos))) - (assert node) + (cl-assert node) (setf (ert--ewoc-entry-test (ewoc-data node)) test) (aset ert--results-progress-bar-string pos (ert-char-for-test-result nil t)) (ert--results-update-stats-display-maybe ewoc stats) (ewoc-invalidate ewoc node))))) (test-ended - (destructuring-bind (stats test result) event-args + (cl-destructuring-bind (stats test result) event-args (with-current-buffer buffer (let* ((ewoc ert--results-ewoc) (pos (ert--stats-test-pos stats test)) @@ -2015,28 +2026,28 @@ (define-derived-mode ert-results-mode special-mode "ERT-Results" "Major mode for viewing results of ERT test runs.") -(loop for (key binding) in - '(;; Stuff that's not in the menu. - ("\t" forward-button) - ([backtab] backward-button) - ("j" ert-results-jump-between-summary-and-result) - ("L" ert-results-toggle-printer-limits-for-test-at-point) - ("n" ert-results-next-test) - ("p" ert-results-previous-test) - ;; Stuff that is in the menu. - ("R" ert-results-rerun-all-tests) - ("r" ert-results-rerun-test-at-point) - ("d" ert-results-rerun-test-at-point-debugging-errors) - ("." ert-results-find-test-at-point-other-window) - ("b" ert-results-pop-to-backtrace-for-test-at-point) - ("m" ert-results-pop-to-messages-for-test-at-point) - ("l" ert-results-pop-to-should-forms-for-test-at-point) - ("h" ert-results-describe-test-at-point) - ("D" ert-delete-test) - ("T" ert-results-pop-to-timings) - ) - do - (define-key ert-results-mode-map key binding)) +(cl-loop for (key binding) in + '( ;; Stuff that's not in the menu. + ("\t" forward-button) + ([backtab] backward-button) + ("j" ert-results-jump-between-summary-and-result) + ("L" ert-results-toggle-printer-limits-for-test-at-point) + ("n" ert-results-next-test) + ("p" ert-results-previous-test) + ;; Stuff that is in the menu. + ("R" ert-results-rerun-all-tests) + ("r" ert-results-rerun-test-at-point) + ("d" ert-results-rerun-test-at-point-debugging-errors) + ("." ert-results-find-test-at-point-other-window) + ("b" ert-results-pop-to-backtrace-for-test-at-point) + ("m" ert-results-pop-to-messages-for-test-at-point) + ("l" ert-results-pop-to-should-forms-for-test-at-point) + ("h" ert-results-describe-test-at-point) + ("D" ert-delete-test) + ("T" ert-results-pop-to-timings) + ) + do + (define-key ert-results-mode-map key binding)) (easy-menu-define ert-results-mode-menu ert-results-mode-map "Menu for `ert-results-mode'." @@ -2116,15 +2127,15 @@ EWOC-FN specifies the direction and should be either `ewoc-prev' or `ewoc-next'. If there are no more nodes in that direction, an error is signaled with the message ERROR-MESSAGE." - (loop + (cl-loop (setq node (funcall ewoc-fn ert--results-ewoc node)) (when (null node) (error "%s" error-message)) (unless (ert--ewoc-entry-hidden-p (ewoc-data node)) (goto-char (ewoc-location node)) - (return)))) + (cl-return)))) -(defun ert--results-expand-collapse-button-action (button) +(defun ert--results-expand-collapse-button-action (_button) "Expand or collapse the test node BUTTON belongs to." (let* ((ewoc ert--results-ewoc) (node (save-excursion @@ -2153,11 +2164,11 @@ (defun ert--ewoc-position (ewoc node) ;; checkdoc-order: nil "Return the position of NODE in EWOC, or nil if NODE is not in EWOC." - (loop for i from 0 - for node-here = (ewoc-nth ewoc 0) then (ewoc-next ewoc node-here) - do (when (eql node node-here) - (return i)) - finally (return nil))) + (cl-loop for i from 0 + for node-here = (ewoc-nth ewoc 0) then (ewoc-next ewoc node-here) + do (when (eql node node-here) + (cl-return i)) + finally (cl-return nil))) (defun ert-results-jump-between-summary-and-result () "Jump back and forth between the test run summary and individual test results. @@ -2205,7 +2216,7 @@ "Return the test at point, or nil. To be used in the ERT results buffer." - (assert (eql major-mode 'ert-results-mode)) + (cl-assert (eql major-mode 'ert-results-mode)) (if (ert--results-test-node-or-null-at-point) (let* ((node (ert--results-test-node-at-point)) (test (ert--ewoc-entry-test (ewoc-data node)))) @@ -2277,9 +2288,9 @@ (point)) ((eventp last-command-event) (posn-point (event-start last-command-event))) - (t (assert nil)))) + (t (cl-assert nil)))) -(defun ert--results-progress-bar-button-action (button) +(defun ert--results-progress-bar-button-action (_button) "Jump to details for the test represented by the character clicked in BUTTON." (goto-char (ert--button-action-position)) (ert-results-jump-between-summary-and-result)) @@ -2289,7 +2300,7 @@ To be used in the ERT results buffer." (interactive) - (assert (eql major-mode 'ert-results-mode)) + (cl-assert (eql major-mode 'ert-results-mode)) (let ((selector (ert--stats-selector ert--results-stats))) (ert-run-tests-interactively selector (buffer-name)))) @@ -2298,13 +2309,13 @@ To be used in the ERT results buffer." (interactive) - (destructuring-bind (test redefinition-state) + (cl-destructuring-bind (test redefinition-state) (ert--results-test-at-point-allow-redefinition) (when (null test) (error "No test at point")) (let* ((stats ert--results-stats) (progress-message (format "Running %stest %S" - (ecase redefinition-state + (cl-ecase redefinition-state ((nil) "") (redefined "new definition of ") (deleted "deleted ")) @@ -2345,7 +2356,7 @@ (stats ert--results-stats) (pos (ert--stats-test-pos stats test)) (result (aref (ert--stats-test-results stats) pos))) - (etypecase result + (cl-etypecase result (ert-test-passed (error "Test passed, no backtrace available")) (ert-test-result-with-condition (let ((backtrace (ert-test-result-with-condition-backtrace result)) @@ -2403,13 +2414,14 @@ (ert-simple-view-mode) (if (null (ert-test-result-should-forms result)) (insert "\n(No should forms during this test.)\n") - (loop for form-description in (ert-test-result-should-forms result) - for i from 1 do - (insert "\n") - (insert (format "%s: " i)) - (let ((begin (point))) - (ert--pp-with-indentation-and-newline form-description) - (ert--make-xrefs-region begin (point))))) + (cl-loop for form-description + in (ert-test-result-should-forms result) + for i from 1 do + (insert "\n") + (insert (format "%s: " i)) + (let ((begin (point))) + (ert--pp-with-indentation-and-newline form-description) + (ert--make-xrefs-region begin (point))))) (goto-char (point-min)) (insert "`should' forms executed during test `") (ert-insert-test-name-button (ert-test-name test)) @@ -2438,17 +2450,16 @@ To be used in the ERT results buffer." (interactive) (let* ((stats ert--results-stats) - (start-times (ert--stats-test-start-times stats)) - (end-times (ert--stats-test-end-times stats)) (buffer (get-buffer-create "*ERT timings*")) - (data (loop for test across (ert--stats-tests stats) - for start-time across (ert--stats-test-start-times stats) - for end-time across (ert--stats-test-end-times stats) - collect (list test - (float-time (subtract-time end-time - start-time)))))) + (data (cl-loop for test across (ert--stats-tests stats) + for start-time across (ert--stats-test-start-times + stats) + for end-time across (ert--stats-test-end-times stats) + collect (list test + (float-time (subtract-time + end-time start-time)))))) (setq data (sort data (lambda (a b) - (> (second a) (second b))))) + (> (cl-second a) (cl-second b))))) (pop-to-buffer buffer) (let ((inhibit-read-only t)) (buffer-disable-undo) @@ -2457,13 +2468,13 @@ (if (null data) (insert "(No data)\n") (insert (format "%-3s %8s %8s\n" "" "time" "cumul")) - (loop for (test time) in data - for cumul-time = time then (+ cumul-time time) - for i from 1 do - (let ((begin (point))) - (insert (format "%3s: %8.3f %8.3f " i time cumul-time)) - (ert-insert-test-name-button (ert-test-name test)) - (insert "\n")))) + (cl-loop for (test time) in data + for cumul-time = time then (+ cumul-time time) + for i from 1 do + (progn + (insert (format "%3s: %8.3f %8.3f " i time cumul-time)) + (ert-insert-test-name-button (ert-test-name test)) + (insert "\n")))) (goto-char (point-min)) (insert "Tests by run time (seconds):\n\n") (forward-line 1)))) @@ -2476,7 +2487,7 @@ (error "Requires Emacs 24")) (let (test-name test-definition) - (etypecase test-or-test-name + (cl-etypecase test-or-test-name (symbol (setq test-name test-or-test-name test-definition (ert-get-test test-or-test-name))) (ert-test (setq test-name (ert-test-name test-or-test-name) ------------------------------------------------------------ revno: 110982 committer: Glenn Morris branch nick: trunk timestamp: Thu 2012-11-22 06:17:34 -0500 message: Auto-commit of generated files. diff: === modified file 'autogen/config.in' --- autogen/config.in 2012-11-18 11:19:05 +0000 +++ autogen/config.in 2012-11-22 11:17:34 +0000 @@ -50,9 +50,6 @@ /* Define to the number of bits in type 'wint_t'. */ #undef BITSIZEOF_WINT_T -/* Define if getwd should not be used. */ -#undef BROKEN_GETWD - /* Define if get_current_dir_name should not be used. */ #undef BROKEN_GET_CURRENT_DIR_NAME @@ -402,9 +399,6 @@ /* Define to 1 if you have the `getaddrinfo' function. */ #undef HAVE_GETADDRINFO -/* Define to 1 if you have the `getcwd' function. */ -#undef HAVE_GETCWD - /* Define to 1 if you have the `getdelim' function. */ #undef HAVE_GETDELIM @@ -453,9 +447,6 @@ /* Define to 1 if you have the `gettimeofday' function. */ #undef HAVE_GETTIMEOFDAY -/* Define to 1 if you have the `getwd' function. */ -#undef HAVE_GETWD - /* Define to 1 if you have the `get_current_dir_name' function. */ #undef HAVE_GET_CURRENT_DIR_NAME === modified file 'autogen/configure' --- autogen/configure 2012-11-21 11:17:40 +0000 +++ autogen/configure 2012-11-22 11:17:34 +0000 @@ -13477,7 +13477,7 @@ closedir getrusage get_current_dir_name \ lrand48 \ select getpagesize setlocale \ -utimes getrlimit setrlimit getcwd shutdown getaddrinfo \ +utimes getrlimit setrlimit shutdown getaddrinfo \ strsignal setitimer \ sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \ gai_strerror mkstemp getline getdelim fsync sync \ @@ -13498,24 +13498,6 @@ done -if test $opsys = unixware; then - -$as_echo "#define BROKEN_GETWD 1" >>confdefs.h - -else - for ac_func in getwd -do : - ac_fn_c_check_func "$LINENO" "getwd" "ac_cv_func_getwd" -if test "x$ac_cv_func_getwd" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_GETWD 1 -_ACEOF - -fi -done - -fi - ## Eric Backus says, HP-UX 9.x on HP 700 machines ## has a broken `rint' in some library versions including math library ## version number A.09.05. ------------------------------------------------------------ revno: 110981 committer: Dmitry Antipov branch nick: trunk timestamp: Thu 2012-11-22 13:32:32 +0400 message: * alloc.c (Fgarbage_collect): Unblock input after clearing gc_in_progress to avoid note_mouse_highlight glitch with GC. * frame.h (FRAME_MOUSE_UPDATE): New macro. * msdos.c (IT_frame_up_to_date): Use it here... * w32term.c (w32_frame_up_to_date): ...here... * xterm.c (XTframe_up_to_date): ...and here... * nsterm.m (ns_frame_up_to_date): ...but not here. * lisp.h (Mouse_HLInfo): Remove mouse_face_deferred_gc member. Adjust users. * xdisp.c (message2_nolog, message3_nolog, note_mouse_highlight): Do not check whether GC is in progress. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-11-22 06:52:30 +0000 +++ src/ChangeLog 2012-11-22 09:32:32 +0000 @@ -1,5 +1,19 @@ 2012-11-22 Dmitry Antipov + * alloc.c (Fgarbage_collect): Unblock input after clearing + gc_in_progress to avoid note_mouse_highlight glitch with GC. + * frame.h (FRAME_MOUSE_UPDATE): New macro. + * msdos.c (IT_frame_up_to_date): Use it here... + * w32term.c (w32_frame_up_to_date): ...here... + * xterm.c (XTframe_up_to_date): ...and here... + * nsterm.m (ns_frame_up_to_date): ...but not here. + * lisp.h (Mouse_HLInfo): Remove mouse_face_deferred_gc member. + Adjust users. + * xdisp.c (message2_nolog, message3_nolog, note_mouse_highlight): + Do not check whether GC is in progress. + +2012-11-22 Dmitry Antipov + * xdisp.c (window_buffer_changed): New function. (update_menu_bar, update_tool_bar): Use it to simplify large 'if' statements. === modified file 'src/alloc.c' --- src/alloc.c 2012-11-21 21:06:52 +0000 +++ src/alloc.c 2012-11-22 09:32:32 +0000 @@ -5331,12 +5331,12 @@ dump_zombies (); #endif + check_cons_list (); + + gc_in_progress = 0; + unblock_input (); - check_cons_list (); - - gc_in_progress = 0; - consing_since_gc = 0; if (gc_cons_threshold < GC_DEFAULT_THRESHOLD / 10) gc_cons_threshold = GC_DEFAULT_THRESHOLD / 10; === modified file 'src/frame.h' --- src/frame.h 2012-11-12 16:02:46 +0000 +++ src/frame.h 2012-11-22 09:32:32 +0000 @@ -933,6 +933,21 @@ && (frame_var = XCAR (list_var), 1)); \ list_var = XCDR (list_var)) +/* Reflect mouse movement when a complete frame update is performed. */ + +#define FRAME_MOUSE_UPDATE(frame) \ + do { \ + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (frame); \ + if (frame == hlinfo->mouse_face_mouse_frame) \ + { \ + block_input (); \ + if (hlinfo->mouse_face_mouse_frame) \ + note_mouse_highlight (hlinfo->mouse_face_mouse_frame, \ + hlinfo->mouse_face_mouse_x, \ + hlinfo->mouse_face_mouse_y); \ + unblock_input (); \ + } \ + } while (0) extern Lisp_Object Qframep, Qframe_live_p; extern Lisp_Object Qtty, Qtty_type; === modified file 'src/lisp.h' --- src/lisp.h 2012-11-20 20:06:17 +0000 +++ src/lisp.h 2012-11-22 09:32:32 +0000 @@ -1649,10 +1649,6 @@ int mouse_face_face_id; Lisp_Object mouse_face_overlay; - /* 1 if a mouse motion event came and we didn't handle it right away because - gc was in progress. */ - int mouse_face_deferred_gc; - /* FRAME and X, Y position of mouse when last checked for highlighting. X and Y can be negative or out of range for the frame. */ struct frame *mouse_face_mouse_frame; === modified file 'src/msdos.c' --- src/msdos.c 2012-11-05 03:18:32 +0000 +++ src/msdos.c 2012-11-22 09:32:32 +0000 @@ -1275,7 +1275,6 @@ hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; hlinfo->mouse_face_window = Qnil; - hlinfo->mouse_face_deferred_gc = 0; hlinfo->mouse_face_mouse_frame = NULL; } @@ -1295,21 +1294,10 @@ static void IT_frame_up_to_date (struct frame *f) { - Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); Lisp_Object new_cursor, frame_desired_cursor; struct window *sw; - if (hlinfo->mouse_face_deferred_gc - || (f && f == hlinfo->mouse_face_mouse_frame)) - { - block_input (); - if (hlinfo->mouse_face_mouse_frame) - note_mouse_highlight (hlinfo->mouse_face_mouse_frame, - hlinfo->mouse_face_mouse_x, - hlinfo->mouse_face_mouse_y); - hlinfo->mouse_face_deferred_gc = 0; - unblock_input (); - } + FRAME_MOUSE_UPDATE (f); /* Set the cursor type to whatever they wanted. In a minibuffer window, we want the cursor to appear only if we are reading input @@ -1849,7 +1837,6 @@ FRAME_BACKGROUND_PIXEL (SELECTED_FRAME ()) = colors[1]; } the_only_display_info.mouse_highlight.mouse_face_mouse_frame = NULL; - the_only_display_info.mouse_highlight.mouse_face_deferred_gc = 0; the_only_display_info.mouse_highlight.mouse_face_beg_row = the_only_display_info.mouse_highlight.mouse_face_beg_col = -1; the_only_display_info.mouse_highlight.mouse_face_end_row = === modified file 'src/nsterm.m' --- src/nsterm.m 2012-11-18 02:29:09 +0000 +++ src/nsterm.m 2012-11-22 09:32:32 +0000 @@ -1186,7 +1186,6 @@ hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; hlinfo->mouse_face_window = Qnil; - hlinfo->mouse_face_deferred_gc = 0; hlinfo->mouse_face_mouse_frame = 0; } @@ -1887,8 +1886,7 @@ ns_frame_up_to_date (struct frame *f) /* -------------------------------------------------------------------------- External (hook): Fix up mouse highlighting right after a full update. - Some highlighting was deferred if GC was happening during - note_mouse_highlight (), while other highlighting was deferred for update. + Can't use FRAME_MOUSE_UPDATE due to ns_frame_begin and ns_frame_end calls. -------------------------------------------------------------------------- */ { NSTRACE (ns_frame_up_to_date); @@ -1896,19 +1894,17 @@ if (FRAME_NS_P (f)) { Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); - if ((hlinfo->mouse_face_deferred_gc || f ==hlinfo->mouse_face_mouse_frame) - /*&& hlinfo->mouse_face_mouse_frame*/) - { - block_input (); + if (f == hlinfo->mouse_face_mouse_frame) + { + block_input (); ns_update_begin(f); - if (hlinfo->mouse_face_mouse_frame) - note_mouse_highlight (hlinfo->mouse_face_mouse_frame, - hlinfo->mouse_face_mouse_x, - hlinfo->mouse_face_mouse_y); - hlinfo->mouse_face_deferred_gc = 0; + if (hlinfo->mouse_face_mouse_frame) + note_mouse_highlight (hlinfo->mouse_face_mouse_frame, + hlinfo->mouse_face_mouse_x, + hlinfo->mouse_face_mouse_y); ns_update_end(f); - unblock_input (); - } + unblock_input (); + } } } @@ -3869,7 +3865,6 @@ dpyinfo->root_window = 42; /* a placeholder.. */ hlinfo->mouse_face_mouse_frame = NULL; - hlinfo->mouse_face_deferred_gc = 0; hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; hlinfo->mouse_face_face_id = DEFAULT_FACE_ID; === modified file 'src/w32term.c' --- src/w32term.c 2012-11-12 04:00:55 +0000 +++ src/w32term.c 2012-11-22 09:32:32 +0000 @@ -723,21 +723,7 @@ w32_frame_up_to_date (struct frame *f) { if (FRAME_W32_P (f)) - { - Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); - - if (hlinfo->mouse_face_deferred_gc - || f == hlinfo->mouse_face_mouse_frame) - { - block_input (); - if (hlinfo->mouse_face_mouse_frame) - note_mouse_highlight (hlinfo->mouse_face_mouse_frame, - hlinfo->mouse_face_mouse_x, - hlinfo->mouse_face_mouse_y); - hlinfo->mouse_face_deferred_gc = 0; - unblock_input (); - } - } + FRAME_MOUSE_UPDATE (f); } @@ -5979,7 +5965,6 @@ hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; hlinfo->mouse_face_window = Qnil; - hlinfo->mouse_face_deferred_gc = 0; hlinfo->mouse_face_mouse_frame = 0; } === modified file 'src/xdisp.c' --- src/xdisp.c 2012-11-22 06:52:30 +0000 +++ src/xdisp.c 2012-11-22 09:32:32 +0000 @@ -9642,7 +9642,7 @@ do_pending_window_change (0); echo_area_display (1); do_pending_window_change (0); - if (FRAME_TERMINAL (f)->frame_up_to_date_hook != 0 && ! gc_in_progress) + if (FRAME_TERMINAL (f)->frame_up_to_date_hook) (*FRAME_TERMINAL (f)->frame_up_to_date_hook) (f); } } @@ -9739,7 +9739,7 @@ do_pending_window_change (0); echo_area_display (1); do_pending_window_change (0); - if (FRAME_TERMINAL (f)->frame_up_to_date_hook != 0 && ! gc_in_progress) + if (FRAME_TERMINAL (f)->frame_up_to_date_hook) (*FRAME_TERMINAL (f)->frame_up_to_date_hook) (f); } } @@ -27685,12 +27685,6 @@ if (hlinfo->mouse_face_defer) return; - if (gc_in_progress) - { - hlinfo->mouse_face_deferred_gc = 1; - return; - } - /* Which window is that in? */ window = window_from_coordinates (f, x, y, &part, 1); === modified file 'src/xterm.c' --- src/xterm.c 2012-11-12 04:00:55 +0000 +++ src/xterm.c 2012-11-22 09:32:32 +0000 @@ -669,21 +669,7 @@ XTframe_up_to_date (struct frame *f) { if (FRAME_X_P (f)) - { - Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); - - if (hlinfo->mouse_face_deferred_gc - || f == hlinfo->mouse_face_mouse_frame) - { - block_input (); - if (hlinfo->mouse_face_mouse_frame) - note_mouse_highlight (hlinfo->mouse_face_mouse_frame, - hlinfo->mouse_face_mouse_x, - hlinfo->mouse_face_mouse_y); - hlinfo->mouse_face_deferred_gc = 0; - unblock_input (); - } - } + FRAME_MOUSE_UPDATE (f); } @@ -9502,7 +9488,6 @@ hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; hlinfo->mouse_face_window = Qnil; - hlinfo->mouse_face_deferred_gc = 0; hlinfo->mouse_face_mouse_frame = 0; } @@ -10153,7 +10138,6 @@ dpyinfo->bitmaps_last = 0; dpyinfo->scratch_cursor_gc = 0; hlinfo->mouse_face_mouse_frame = 0; - hlinfo->mouse_face_deferred_gc = 0; hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; hlinfo->mouse_face_face_id = DEFAULT_FACE_ID; ------------------------------------------------------------ revno: 110980 committer: Paul Eggert branch nick: trunk timestamp: Thu 2012-11-22 00:39:27 -0800 message: Document Calc Gregorian in NEWS; fix manual a bit. diff: === modified file 'doc/misc/ChangeLog' --- doc/misc/ChangeLog 2012-11-22 01:47:04 +0000 +++ doc/misc/ChangeLog 2012-11-22 08:39:27 +0000 @@ -1,3 +1,9 @@ +2012-11-22 Paul Eggert + + * calc.texi: Fix TeX issues with capitals followed by ".", "?", "!". + (Date Forms): Correct off-by-one error in explanation of + Julian day numbers. Give Gregorian equivalent of its origin. + 2012-11-22 Jay Belanger * doc/misc/calc.texi (Date Forms): Mention the customizable === modified file 'doc/misc/calc.texi' --- doc/misc/calc.texi 2012-11-22 01:47:04 +0000 +++ doc/misc/calc.texi 2012-11-22 08:39:27 +0000 @@ -1186,7 +1186,7 @@ fair to give the user direct access to it, which in turn made it practical to support fractions as well as floats. All these features inspired me to look around for other data types that might be worth -having. +having. Around this time, my friend Rick Koshi showed me his nifty new HP-28 calculator. It allowed the user to manipulate formulas as well as @@ -4461,7 +4461,7 @@ Friday the 13th? @xref{Types Answer 5, 5}. (@bullet{}) (@bullet{}) @strong{Exercise 6.} How many leap years will there be -between now and the year 10001 A.D.? @xref{Types Answer 6, 6}. (@bullet{}) +between now and the year 10001 AD@? @xref{Types Answer 6, 6}. (@bullet{}) @cindex Slope and angle of a line @cindex Angle and slope of a line @@ -5693,7 +5693,7 @@ rearranged. (This one is rather tricky; the solution at the end of this chapter uses 6 rewrite rules. Hint: The @samp{constant(x)} condition tests whether @samp{x} is a number.) @xref{Rewrites Answer -6, 6}. (@bullet{}) +6, 6}. (@bullet{}) Just for kicks, try adding the rule @code{2+3 := 6} to @code{EvalRules}. What happens? (Be sure to remove this rule afterward, or you might get @@ -8697,7 +8697,7 @@ @smallexample @group ___ -1: V 2 +1: V 2 . a r a*(b+c) := a*b + a*c @@ -8897,7 +8897,7 @@ apply to any product-of-sum it encounters---this rule may surprise you if you put it into @code{EvalRules}! -In the second rule, the sum of two O's is changed to the smaller O. +In the second rule, the sum of two O's is changed to the smaller O@. The optional constant coefficients are there mostly so that @samp{O(x^2) - O(x^3)} and @samp{O(x^3) - O(x^2)} are handled as well as @samp{O(x^2) + O(x^3)}. @@ -10987,7 +10987,7 @@ notations for dates and times. @xref{Date Formats}. Date forms are stored internally as numbers, specifically the number -of days since midnight on the morning of December 31 of the year 1 BC. +of days since midnight on the morning of December 31 of the year 1 BC@. If the internal number is an integer, the form represents a date only; if the internal number is a fraction or float, the form represents a date and time. For example, @samp{<6:00am Thu Jan 10, 1991>} @@ -11010,13 +11010,13 @@ of a date form. @xref{Packing and Unpacking}. Date forms can go arbitrarily far into the future or past. Negative -year numbers represent years BC. There is no ``year 0''; the day +year numbers represent years BC@. There is no ``year 0''; the day before @samp{} is @samp{}. These are days 1 and 0 respectively in Calc's internal numbering scheme. The Gregorian calendar is used for all dates, including dates before the Gregorian calendar was invented (although that can be configured; see below). Thus Calc's use of the day number @mathit{-10000} to -represent August 15, 28 BC should be taken with a grain of salt. +represent August 15, 28 BC should be taken with a grain of salt. @cindex Julian calendar @cindex Gregorian calendar @@ -11025,7 +11025,7 @@ caused by the irregular Roman calendar that was used before that time. The Julian calendar introduced an extra day in all years divisible by four. After some initial confusion, the calendar was adopted around -the year we call 8 AD. Some centuries later it became +the year we call 8 AD@. Some centuries later it became apparent that the Julian year of 365.25 days was itself not quite right. In 1582 Pope Gregory XIII introduced the Gregorian calendar, which added the new rule that years divisible by 100, but not by 400, @@ -11039,39 +11039,41 @@ Gregorian calendar until 1918, and that year in Russia the day after January 31 was February 14. Calc's reckoning therefore matches English practice starting in 1752 and Russian practice starting in 1918, but -disagrees with earlier dates in both countries. +disagrees with earlier dates in both countries. When the Julian calendar was introduced, it had January 1 as the first day of the year. By the Middle Ages, many European countries had changed the beginning of a new year to a different date, often to a religious festival. Almost all countries reverted to using January 1 as the beginning of the year by the time they adopted the Gregorian -calendar. +calendar. Some calendars attempt to mimic the historical situation by using the Gregorian calendar for recent dates and the Julian calendar for older dates. The @code{cal} program in most Unix implementations does this, for example. While January 1 wasn't always the beginning of a calendar year, these hybrid calendars still use January 1 as the beginning of -the year even for older dates. The customizable variable +the year even for older dates. The customizable variable @code{calc-gregorian-switch} (@pxref{Customizing Calc}) can be set to have Calc's date forms switch from the Julian to Gregorian calendar at -any specified date. +any specified date. Today's timekeepers introduce an occasional ``leap second''. These do not occur regularly and Calc does not take these minor effects into account. (If it did, it would have to report a -non-integer number of days between, say, -@samp{<12:00am Mon Jan 1, 1900>} and +non-integer number of days between, say, +@samp{<12:00am Mon Jan 1, 1900>} and @samp{<12:00am Sat Jan 1, 2000>}.) @cindex Julian day counting Another day counting system in common use is, confusingly, also called -``Julian.'' The Julian day number is the numbers of days since -12:00 noon (GMT) on Jan 1, 4713 BC, which in Calc's scheme (in GMT) -is @mathit{-1721423.5} (recall that Calc starts at midnight instead -of noon). Thus to convert a Calc date code obtained by unpacking a -date form into a Julian day number, simply add 1721423.5 after +``Julian.'' Julian days go from noon to noon. The Julian day number +is the numbers of days since 12:00 noon (GMT) on November 24, 4714 BC +in the Gregorian calendar (i.e., January 1, 4713 BC in the Julian +calendar). In Calc's scheme (in GMT) the Julian day origin is +@mathit{-1721422.5}, because Calc starts at midnight instead of noon. +Thus to convert a Calc date code obtained by unpacking a +date form into a Julian day number, simply add 1721422.5 after compensating for the time zone difference. The built-in @kbd{t J} command performs this conversion for you. @@ -11103,7 +11105,7 @@ up by other astronomers. (At the time, noon was the start of the astronomical day. Herschel originally suggested counting the days since Jan 1, 4713 BC at noon Alexandria time; this was later amended to -noon GMT.) Julian day numbering is largely used in astronomy. +noon GMT@.) Julian day numbering is largely used in astronomy. @cindex Unix time format The Unix operating system measures time as an integer number of @@ -12651,7 +12653,7 @@ A common technique is to set the simplification mode down to the lowest amount of simplification you will allow to be applied automatically, then use manual commands like @kbd{a s} and @kbd{c c} (@code{calc-clean}) to -perform higher types of simplifications on demand. +perform higher types of simplifications on demand. @node Declarations, Display Modes, Simplification Modes, Mode Settings @section Declarations @@ -13002,7 +13004,7 @@ function checks for nonnegative reals, i.e., reals greater than or equal to zero. Note that Calc's algebraic simplifications, which are effectively applied to all conditions in rewrite rules, can simplify -an expression like @expr{x > 0} to 1 or 0 using @code{dpos}. +an expression like @expr{x > 0} to 1 or 0 using @code{dpos}. So the actual functions @code{dpos}, @code{dneg}, and @code{dnonneg} are rarely necessary. @@ -13437,7 +13439,7 @@ match exactly; letter fields must correspond to suitable text in the input. If this doesn't work, Calc checks if the input is a simple number; if so, the number is interpreted as a number of days -since Jan 1, 1 AD. Otherwise, Calc tries a much more relaxed and +since Jan 1, 1 AD@. Otherwise, Calc tries a much more relaxed and flexible algorithm which is described in the next section. Weekday names are ignored during reading. @@ -14666,7 +14668,7 @@ The @kbd{d W} (@code{calc-maple-language}) command selects the conventions of Maple. -Maple's language is much like C. Underscores are allowed in symbol +Maple's language is much like C@. Underscores are allowed in symbol names; square brackets are used for subscripts; explicit @samp{*}s for multiplications are required. Use either @samp{^} or @samp{**} to denote powers. @@ -16727,7 +16729,7 @@ If the simplification mode is set below basic simplification, it is raised for the purposes of this command. Thus, @kbd{c c} applies the basic simplifications even if their automatic application is disabled. -@xref{Simplification Modes}. +@xref{Simplification Modes}. @cindex Roundoff errors, correcting A numeric prefix argument to @kbd{c c} sets the floating-point precision @@ -16804,7 +16806,7 @@ @pindex calc-date @tindex date The @kbd{t D} (@code{calc-date}) [@code{date}] command converts a -date form into a number, measured in days since Jan 1, 1 AD. The +date form into a number, measured in days since Jan 1, 1 AD@. The result will be an integer if @var{date} is a pure date form, or a fraction or float if @var{date} is a date/time form. Or, if its argument is a number, it converts this number into a date form. @@ -16842,7 +16844,7 @@ @cindex Julian day counts, conversions The @kbd{t J} (@code{calc-julian}) [@code{julian}] command converts a date form into a Julian day count, which is the number of days -since noon (GMT) on Jan 1, 4713 BC. A pure date is converted to an +since noon (GMT) on Jan 1, 4713 BC@. A pure date is converted to an integer Julian count representing noon of that day. A date/time form is converted to an exact floating-point Julian count, adjusted to interpret the date form in the current time zone but the Julian @@ -18988,7 +18990,7 @@ ten, however, the numbers should be completely unbiased. The Gaussian random numbers generated by @samp{random(0.0)} use the -``polar'' method described in Knuth section 3.4.1C. This method +``polar'' method described in Knuth section 3.4.1C@. This method generates a pair of Gaussian random numbers at a time, so only every other call to @samp{random(0.0)} will require significant calculations. @@ -22188,7 +22190,7 @@ If you give a numeric prefix argument of 2 to @kbd{a v}, it simplifies using Calc's algebraic simplifications; @pxref{Simplifying Formulas}. If you give a numeric prefix of 3 or more, it uses Extended -Simplification mode (@kbd{a e}). +Simplification mode (@kbd{a e}). If you give a negative prefix argument @mathit{-1}, @mathit{-2}, or @mathit{-3}, it simplifies in the corresponding mode but only works on the top-level @@ -22261,7 +22263,7 @@ are mapped, the direction of the second inequality is reversed to match the first: Using @kbd{a M +} on @samp{a < b} and @samp{a > 2} reverses the latter to get @samp{2 < a}, which then allows the -combination @samp{a + 2 < b + a}, which the algebraic simplifications +combination @samp{a + 2 < b + a}, which the algebraic simplifications can reduce to @samp{2 < b}. Using @kbd{a M *}, @kbd{a M /}, @kbd{a M n}, or @kbd{a M &} to negate @@ -22408,7 +22410,7 @@ @kbd{Q} [@code{sqrt}], the arguments are simply popped from the stack and collected into a suitable function call, which is then simplified (the arguments being simplified first as part of the process, as -described above). +described above). Even the basic set of simplifications are too numerous to describe completely here, but this section will describe the ones that apply to the @@ -22714,7 +22716,7 @@ mode. If you have switched to a different simplification mode, you can switch back with the @kbd{m A} command. Even in other simplification modes, the @kbd{a s} command will use these algebraic simplifications to -simplify the formula. +simplify the formula. There is a variable, @code{AlgSimpRules}, in which you can put rewrites to be applied. Its use is analogous to @code{EvalRules}, @@ -22751,7 +22753,7 @@ simplifications will not change @expr{x y + y x} to @expr{2 x y}, but the algebraic simplifications; it first rewrites the sum to @expr{x y + x y} which can then be recognized as a sum of identical -terms. +terms. The canonical ordering used to sort terms of products has the property that real-valued numbers, interval forms and infinities @@ -22794,10 +22796,10 @@ for example, @expr{(4 x + 6) / 8 x} simplifies to @expr{(2 x + 3) / 4 x}. Non-constant common factors are not found even by algebraic -simplifications. To cancel the factor @expr{a} in +simplifications. To cancel the factor @expr{a} in @expr{(a x + a) / a^2} you could first use @kbd{j M} on the product @expr{a x} to Merge the numerator to @expr{a (1+x)}, which can then be -simplified successfully. +simplified successfully. @tex \bigskip @@ -22950,7 +22952,7 @@ @tindex esimplify Calc is capable of performing some simplifications which may sometimes be desired but which are not ``safe'' in all cases. The @kbd{a e} -(@code{calc-simplify-extended}) [@code{esimplify}] command +(@code{calc-simplify-extended}) [@code{esimplify}] command applies the algebraic simplifications as well as these extended, or ``unsafe'', simplifications. Use this only if you know the values in your formula lie in the restricted ranges for which these @@ -23594,10 +23596,10 @@ @vindex IntegSimpRules Another set of rules, stored in @code{IntegSimpRules}, are applied every time the integrator uses algebraic simplifications to simplify an -intermediate result. For example, putting the rule +intermediate result. For example, putting the rule @samp{twice(x) := 2 x} into @code{IntegSimpRules} would tell Calc to convert the @code{twice} function into a form it knows whenever -integration is attempted. +integration is attempted. One more way to influence the integrator is to define a function with the @kbd{Z F} command (@pxref{Algebraic Definitions}). Calc's @@ -26762,7 +26764,7 @@ been matched to something else the two values must be equal; if the meta-variable is new then it is bound to the result of the expression. This variable can then appear in later conditions, and on the righthand -side of the rule. +side of the rule. In fact, @expr{v} may be any pattern in which case the result of evaluating @expr{x} is matched to that pattern, binding any meta-variables that appear in that pattern. Note that @code{let} @@ -27516,7 +27518,7 @@ formula. The variable @code{AlgSimpRules} holds rules for this purpose. The @kbd{a s} command will apply @code{EvalRules} and @code{AlgSimpRules} to the formula, as well as all of its built-in -simplifications. +simplifications. Most of the special limitations for @code{EvalRules} don't apply to @code{AlgSimpRules}. Calc simply does an @kbd{a r AlgSimpRules} @@ -27524,7 +27526,7 @@ simplifications. It then applies its own built-in simplifications throughout the formula, and then repeats these two steps (along with applying the default simplifications) until no further changes are -possible. +possible. @cindex @code{ExtSimpRules} variable @cindex @code{UnitSimpRules} variable @@ -28959,9 +28961,9 @@ All current modes apply when an @samp{=>} operator is computed, including the current simplification mode. Recall that the formula @samp{arcsin(sin(x))} will not be handled by Calc's algebraic -simplifications, but Calc's unsafe simplifications will reduce it to +simplifications, but Calc's unsafe simplifications will reduce it to @samp{x}. If you enter @samp{arcsin(sin(x)) =>} normally, the result -will be @samp{arcsin(sin(x)) => arcsin(sin(x))}. If you change to +will be @samp{arcsin(sin(x)) => arcsin(sin(x))}. If you change to Extended Simplification mode, the result will be @samp{arcsin(sin(x)) => x}. However, just pressing @kbd{a e} once will have no effect on @samp{arcsin(sin(x)) => arcsin(sin(x))}, @@ -29579,7 +29581,7 @@ @kindex g O @pindex calc-graph-output The @kbd{g O} (@code{calc-graph-output}) command sets the name of the -output file used by GNUPLOT. For some devices, notably @code{x11} and +output file used by GNUPLOT@. For some devices, notably @code{x11} and @code{windows}, there is no output file and this information is not used. Many other ``devices'' are really file formats like @code{postscript}; in these cases the output in the desired format @@ -29651,7 +29653,7 @@ effect if the current device is @code{windows}. The buffer called @samp{*Gnuplot Trail*} holds a transcript of the -session with GNUPLOT. This shows the commands Calc has ``typed'' to +session with GNUPLOT@. This shows the commands Calc has ``typed'' to GNUPLOT and the responses it has received. Calc tries to notice when an error message has appeared here and display the buffer for you when this happens. You can check this buffer yourself if you suspect @@ -33262,7 +33264,7 @@ Date forms are stored as @samp{(date @var{n})}, where @var{n} is a real number that counts days since midnight on the morning of -January 1, 1 AD. If @var{n} is an integer, this is a pure date +January 1, 1 AD@. If @var{n} is an integer, this is a pure date form. If @var{n} is a fraction or float, this is a date/time form. Modulo forms are stored as @samp{(mod @var{n} @var{m})}, where @var{m} is a @@ -33770,7 +33772,7 @@ function is used by the @kbd{V S} vector-sorting command, and also by Calc's algebraic simplifications to put the terms of a product into canonical order: This allows @samp{x y + y x} to be simplified easily to -@samp{2 x y}. +@samp{2 x y}. @end defun @defun equal x y @@ -35605,11 +35607,11 @@ @defvar calc-gregorian-switch See @ref{Date Forms}.@* -The variable @code{calc-gregorian-switch} is either a list of integers +The variable @code{calc-gregorian-switch} is either a list of integers @code{(@var{YEAR} @var{MONTH} @var{DAY})} or @code{nil}. If it is @code{nil}, then Calc's date forms always represent Gregorian dates. Otherwise, @code{calc-gregorian-switch} represents the date that the -calendar switches from Julian dates to Gregorian dates; +calendar switches from Julian dates to Gregorian dates; @code{(@var{YEAR} @var{MONTH} @var{DAY})} will be the first Gregorian date. The customization buffer will offer several standard dates to choose from, or the user can enter their own date. === modified file 'etc/ChangeLog' --- etc/ChangeLog 2012-10-26 14:42:05 +0000 +++ etc/ChangeLog 2012-11-22 08:39:27 +0000 @@ -1,3 +1,7 @@ +2012-11-22 Paul Eggert + + * NEWS: Document Calc changes for Gregorian calendar. + 2012-10-26 Nicolas Goaziou * refcards/orgcard.tex: Fix keybindings about === modified file 'etc/NEWS' --- etc/NEWS 2012-11-21 04:47:55 +0000 +++ etc/NEWS 2012-11-22 08:39:27 +0000 @@ -29,6 +29,20 @@ * Changes in Specialized Modes and Packages in Emacs 24.4 +** Calc + +*** Calc by default now uses the Gregorian calendar for all dates, and +uses January 1, 1 AD as its day number 1. Previously Calc used the +Julian calendar for dates before September 14, 1752, and it used +December 31, 1 BC as its day number 1; the new scheme is more +consistent with Calendar's calendrical system and day numbering. + +*** The new variable `calc-gregorian-switch' lets you configure the +date when Calc switches from the Julian to the Gregorian calendar. +Nil, the default value, means to always use the Gregorian calendar. +The value (YEAR MONTH DAY) means to start using the Gregorian calendar +on the given date. + +++ ** New function `ses-rename-cell' to give SES cells arbitrary names. ------------------------------------------------------------ revno: 110979 committer: Paul Eggert branch nick: trunk timestamp: Thu 2012-11-22 00:09:03 -0800 message: * calc/calc.el (calc-gregorian-switch): In menu, put dates before regions. This is easier to follow, lines up better in the menu, and lets us coalesce regions that switch at the same time. Give country names, not "Vatican", as that's better for non-expert users. Use names that are stable between the date of switch and now, e.g., Bohemia and Moravia (which existed then and now) and not Czechoslovakia (which didn't exist then and doesn't exist now). What is now the U.S. mostly did not switch at the same time as Britain, so omit the U.S. Correct spelling of "Britain". Catholic Switzerland was too much of a mess, so omit it. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-22 07:31:45 +0000 +++ lisp/ChangeLog 2012-11-22 08:09:03 +0000 @@ -2,6 +2,16 @@ * calc/calc.el (calc-gregorian-switch): Move to after calc-refresh definition. This fixes a bootstrap failure. + (calc-gregorian-switch): In menu, put dates before regions. + This is easier to follow, lines up better in the menu, and lets us + coalesce regions that switch at the same time. Give country + names, not "Vatican", as that's better for non-expert users. Use + names that are stable between the date of switch and now, e.g., + Bohemia and Moravia (which existed then and now) and not + Czechoslovakia (which didn't exist then and doesn't exist now). + What is now the U.S. mostly did not switch at the same time as + Britain, so omit the U.S. Correct spelling of "Britain". + Catholic Switzerland was too much of a mess, so omit it. 2012-11-22 Jay Belanger === modified file 'lisp/calc/calc.el' --- lisp/calc/calc.el 2012-11-22 07:31:45 +0000 +++ lisp/calc/calc.el 2012-11-22 08:09:03 +0000 @@ -2040,24 +2040,23 @@ the times of the calendar changes than they are now. The Vatican decided that the Gregorian calendar should take effect on 15 October 1582 (Gregorian), and many Catholic countries made -the change then. Great Britian and its colonies had the Gregorian +the change then. Great Britain and its colonies had the Gregorian calendar take effect on 14 September 1752 (Gregorian); this includes the United States." :group 'calc :version "24.4" :type '(choice (const :tag "Always use the Gregorian calendar" nil) - (const :tag "Great Britian and the US (1752 9 14)" (1752 9 14 639797)) - (const :tag "Vatican (1582 10 15)" (1582 10 15 577736)) - (const :tag "Czechoslovakia (1584 1 17)" (1584 1 17 578195)) - (const :tag "Denmark (1700 3 1)" (1700 3 1 620607)) - (const :tag "France (1582 12 20)" (1582 12 20 577802)) - (const :tag "Hungary (1587 11 1)" (1587 11 1 579579)) - (const :tag "Luxemburg (1582 12 25)" (1582 12 25 577807)) - (const :tag "Romania (1919 4 14)" (1919 4 14 700638)) - (const :tag "Russia (1918 2 14)" (1918 2 14 700214)) - (const :tag "Sweden (1753 3 1)" (1753 3 1 639965)) - (const :tag "Switzerland (Catholic) (1584 1 22)" (1584 1 22 578200)) - (const :tag "Switzerland (Protestant) (1701 1 12)" (1701 1 12 620924)) + (const :tag "1582-10-15 - Italy, Poland, Portugal, Spain" (1582 10 15 577736)) + (const :tag "1582-12-20 - France" (1582 12 20 577802)) + (const :tag "1582-12-25 - Luxemburg" (1582 12 25 577807)) + (const :tag "1584-01-17 - Bohemia and Moravia" (1584 1 17 578195)) + (const :tag "1587-11-01 - Hungary" (1587 11 1 579579)) + (const :tag "1700-03-01 - Denmark" (1700 3 1 620607)) + (const :tag "1701-01-12 - Protestant Switzerland" (1701 1 12 620924)) + (const :tag "1752-09-14 - Great Britain and dominions" (1752 9 14 639797)) + (const :tag "1753-03-01 - Sweden" (1753 3 1 639965)) + (const :tag "1918-02-14 - Russia" (1918 2 14 700214)) + (const :tag "1919-04-14 - Romania" (1919 4 14 700638)) (list :tag "(YEAR MONTH DAY)" (integer :tag "Year") (integer :tag "Month (integer)") ------------------------------------------------------------ revno: 110978 committer: Paul Eggert branch nick: trunk timestamp: Wed 2012-11-21 23:31:45 -0800 message: * calc/calc.el (calc-gregorian-switch): Move to after calc-refresh definition. This fixes a bootstrap failure. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-11-22 01:47:04 +0000 +++ lisp/ChangeLog 2012-11-22 07:31:45 +0000 @@ -1,3 +1,8 @@ +2012-11-22 Paul Eggert + + * calc/calc.el (calc-gregorian-switch): Move to after calc-refresh + definition. This fixes a bootstrap failure. + 2012-11-22 Jay Belanger * calc/calc.el (calc-gregorian-switch): Refresh the Calc buffer === modified file 'lisp/calc/calc.el' --- lisp/calc/calc.el 2012-11-22 01:47:04 +0000 +++ lisp/calc/calc.el 2012-11-22 07:31:45 +0000 @@ -466,51 +466,6 @@ (defvar math-format-date-cache) ; calc-forms.el -;; Dates that are built-in options for `calc-gregorian-switch' should be -;; (YEAR MONTH DAY math-date-from-gregorian-dt(YEAR MONTH DAY)) for speed. -(defcustom calc-gregorian-switch nil - "The first day the Gregorian calendar is used by Calc's date forms. -This is `nil' (the default) if the Gregorian calendar is the only one used. -Otherwise, it should be a list `(YEAR MONTH DAY)' when Calc begins to use -the Gregorian calendar; Calc will use the Julian calendar for earlier dates. -The dates in which different regions of the world began to use the -Gregorian calendar vary quite a bit, even within a single country. -If you want Calc's date forms to switch between the Julian and -Gregorian calendar, you can specify the date or choose from several -common choices. Some of these choices should be taken with a grain -of salt; for example different parts of France changed calendars at -different times, and Sweden's change to the Gregorian calendar was -complicated. Also, the boundaries of the countries were different at -the times of the calendar changes than they are now. -The Vatican decided that the Gregorian calendar should take effect -on 15 October 1582 (Gregorian), and many Catholic countries made -the change then. Great Britian and its colonies had the Gregorian -calendar take effect on 14 September 1752 (Gregorian); this includes -the United States." - :group 'calc - :version "24.4" - :type '(choice (const :tag "Always use the Gregorian calendar" nil) - (const :tag "Great Britian and the US (1752 9 14)" (1752 9 14 639797)) - (const :tag "Vatican (1582 10 15)" (1582 10 15 577736)) - (const :tag "Czechoslovakia (1584 1 17)" (1584 1 17 578195)) - (const :tag "Denmark (1700 3 1)" (1700 3 1 620607)) - (const :tag "France (1582 12 20)" (1582 12 20 577802)) - (const :tag "Hungary (1587 11 1)" (1587 11 1 579579)) - (const :tag "Luxemburg (1582 12 25)" (1582 12 25 577807)) - (const :tag "Romania (1919 4 14)" (1919 4 14 700638)) - (const :tag "Russia (1918 2 14)" (1918 2 14 700214)) - (const :tag "Sweden (1753 3 1)" (1753 3 1 639965)) - (const :tag "Switzerland (Catholic) (1584 1 22)" (1584 1 22 578200)) - (const :tag "Switzerland (Protestant) (1701 1 12)" (1701 1 12 620924)) - (list :tag "(YEAR MONTH DAY)" - (integer :tag "Year") - (integer :tag "Month (integer)") - (integer :tag "Day"))) - :set (lambda (symbol value) - (set-default symbol value) - (setq math-format-date-cache nil) - (calc-refresh))) - (defface calc-nonselected-face '((t :inherit shadow :slant italic)) @@ -2067,6 +2022,51 @@ (calc-refresh align))) (setq calc-refresh-count (1+ calc-refresh-count))) +;; Dates that are built-in options for `calc-gregorian-switch' should be +;; (YEAR MONTH DAY math-date-from-gregorian-dt(YEAR MONTH DAY)) for speed. +(defcustom calc-gregorian-switch nil + "The first day the Gregorian calendar is used by Calc's date forms. +This is `nil' (the default) if the Gregorian calendar is the only one used. +Otherwise, it should be a list `(YEAR MONTH DAY)' when Calc begins to use +the Gregorian calendar; Calc will use the Julian calendar for earlier dates. +The dates in which different regions of the world began to use the +Gregorian calendar vary quite a bit, even within a single country. +If you want Calc's date forms to switch between the Julian and +Gregorian calendar, you can specify the date or choose from several +common choices. Some of these choices should be taken with a grain +of salt; for example different parts of France changed calendars at +different times, and Sweden's change to the Gregorian calendar was +complicated. Also, the boundaries of the countries were different at +the times of the calendar changes than they are now. +The Vatican decided that the Gregorian calendar should take effect +on 15 October 1582 (Gregorian), and many Catholic countries made +the change then. Great Britian and its colonies had the Gregorian +calendar take effect on 14 September 1752 (Gregorian); this includes +the United States." + :group 'calc + :version "24.4" + :type '(choice (const :tag "Always use the Gregorian calendar" nil) + (const :tag "Great Britian and the US (1752 9 14)" (1752 9 14 639797)) + (const :tag "Vatican (1582 10 15)" (1582 10 15 577736)) + (const :tag "Czechoslovakia (1584 1 17)" (1584 1 17 578195)) + (const :tag "Denmark (1700 3 1)" (1700 3 1 620607)) + (const :tag "France (1582 12 20)" (1582 12 20 577802)) + (const :tag "Hungary (1587 11 1)" (1587 11 1 579579)) + (const :tag "Luxemburg (1582 12 25)" (1582 12 25 577807)) + (const :tag "Romania (1919 4 14)" (1919 4 14 700638)) + (const :tag "Russia (1918 2 14)" (1918 2 14 700214)) + (const :tag "Sweden (1753 3 1)" (1753 3 1 639965)) + (const :tag "Switzerland (Catholic) (1584 1 22)" (1584 1 22 578200)) + (const :tag "Switzerland (Protestant) (1701 1 12)" (1701 1 12 620924)) + (list :tag "(YEAR MONTH DAY)" + (integer :tag "Year") + (integer :tag "Month (integer)") + (integer :tag "Day"))) + :set (lambda (symbol value) + (set-default symbol value) + (setq math-format-date-cache nil) + (calc-refresh))) + ;;;; The Calc Trail buffer. (defun calc-check-trail-aligned ()