Now on revision 109018. ------------------------------------------------------------ revno: 109018 committer: Glenn Morris branch nick: trunk timestamp: Tue 2012-07-10 23:55:30 -0700 message: Remove src/s/gnu.h * configure.ac (opsysfile): Use bsd-common on gnu systems. * src/s/gnu.h: Remove file, which is now empty. diff: === modified file 'ChangeLog' --- ChangeLog 2012-07-11 06:52:48 +0000 +++ ChangeLog 2012-07-11 06:55:30 +0000 @@ -1,5 +1,7 @@ 2012-07-11 Glenn Morris + * configure.ac (opsysfile): Use bsd-common on gnu systems. + * configure.ac (GNU_LIBRARY_PENDING_OUTPUT_COUNT): Move here from src/s. === modified file 'configure.ac' --- configure.ac 2012-07-11 06:52:48 +0000 +++ configure.ac 2012-07-11 06:55:30 +0000 @@ -3254,6 +3254,8 @@ esac case $opsys in + gnu) opsysfile="s/bsd-common.h" ;; + gnu-kfreebsd) opsysfile="s/gnu-linux.h" ;; hpux11) === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-11 06:52:48 +0000 +++ src/ChangeLog 2012-07-11 06:55:30 +0000 @@ -1,5 +1,7 @@ 2012-07-11 Glenn Morris + * s/gnu.h: Remove file, which is now empty. + * s/gnu.h, s/gnu-linux.h: Move GNU_LIBRARY_PENDING_OUTPUT_COUNT to configure. === removed file 'src/s/gnu.h' --- src/s/gnu.h 2012-07-11 06:52:48 +0000 +++ src/s/gnu.h 1970-01-01 00:00:00 +0000 @@ -1,22 +0,0 @@ -/* Definitions file for GNU Emacs running on the GNU Hurd. - -Copyright (C) 1994-1996, 2001-2012 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or -(at your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - - -/* Get most of the stuff from bsd-common */ -#include "bsd-common.h" ------------------------------------------------------------ revno: 109017 committer: Glenn Morris branch nick: trunk timestamp: Tue 2012-07-10 23:52:48 -0700 message: Move GNU_LIBRARY_PENDING_OUTPUT_COUNT from src/s to configure * configure.ac (GNU_LIBRARY_PENDING_OUTPUT_COUNT): Move here from src/s. * src/s/gnu.h, src/s/gnu-linux.h: Move GNU_LIBRARY_PENDING_OUTPUT_COUNT to configure. diff: === modified file 'ChangeLog' --- ChangeLog 2012-07-11 06:09:09 +0000 +++ ChangeLog 2012-07-11 06:52:48 +0000 @@ -1,3 +1,8 @@ +2012-07-11 Glenn Morris + + * configure.ac (GNU_LIBRARY_PENDING_OUTPUT_COUNT): + Move here from src/s. + 2012-07-11 Paul Eggert Assume rename, strerror. === modified file 'configure.ac' --- configure.ac 2012-07-11 06:09:09 +0000 +++ configure.ac 2012-07-11 06:52:48 +0000 @@ -3163,6 +3163,70 @@ AC_DEFINE_UNQUOTED(DEFAULT_SOUND_DEVICE, "$sound_device", [Name of the default sound device.]) +dnl Used in dispnew.c +AH_TEMPLATE(PENDING_OUTPUT_COUNT, [Number of chars of output in the +buffer of a stdio stream.]) + +dnl FIXME just PENDING_OUTPUT_COUNT should suffice. +AH_TEMPLATE(GNU_LIBRARY_PENDING_OUTPUT_COUNT, [Value of +PENDING_OUTPUT_COUNT if using the GNU C library.]) + +case $opsys in + cygwin | darwin | freebsd | netbsd | openbsd ) + AC_DEFINE(PENDING_OUTPUT_COUNT(FILE), [((FILE)->_p - (FILE)->_bf._base)]) + ;; + + unixware) + AC_DEFINE(PENDING_OUTPUT_COUNT(FILE), [((FILE)->__ptr - (FILE)->__base)]) + ;; + + gnu | gnu-linux | gnu-kfreebsd ) + AC_MSG_CHECKING([for style of pending output formalism]) + dnl In autoconf 2.67 (?) and later, we could use a single test + dnl since the preprocessed output is accessible in "conftest.i". + AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[ +#include +#if !defined (_IO_STDIO_H) && !defined (_STDIO_USES_IOSTREAM) +# error "stdio definitions not found" +#endif + ]], [[]])], emacs_pending_output=new, emacs_pending_output=unknown) + + if test $emacs_pending_output = unknown; then + case $opsys in + gnu-linux | gnu-kfreebsd) + AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[ +#include +#ifndef __UCLIBC__ +# error "not using uclibc" +#endif + ]], [[]])], emacs_pending_output=uclibc, emacs_pending_output=old) + ;; + esac + fi + + AC_MSG_RESULT([$emacs_pending_output]) + + case $emacs_pending_output in + new) + dnl New C libio names. + AC_DEFINE(GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE), + [((FILE)->_IO_write_ptr - (FILE)->_IO_write_base)]) + ;; + uclibc) + dnl Using the uClibc library. + AC_DEFINE(GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE), + [((FILE)->__bufpos - (FILE)->__bufstart)]) + ;; + old) + dnl Old C++ iostream names. + AC_DEFINE(GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE), + [((FILE)->_pptr - (FILE)->_pbase)]) + ;; + esac + ;; +esac + + dnl Used in vm-limit.c AH_TEMPLATE(DATA_START, [Address of the start of the data segment.]) dnl Used in lisp.h, emacs.c, mem-limits.h @@ -3172,19 +3236,7 @@ stored in a Lisp_Object.]) dnl if Emacs uses fewer than 32 bits for the value field of a LISP_OBJECT. -dnl Used in dispnew.c -AH_TEMPLATE(PENDING_OUTPUT_COUNT, [Number of chars of output in the -buffer of a stdio stream.]) - case $opsys in - cygwin | darwin | freebsd | netbsd | openbsd ) - AC_DEFINE(PENDING_OUTPUT_COUNT(FILE), [((FILE)->_p - (FILE)->_bf._base)]) - ;; - - unixware) - AC_DEFINE(PENDING_OUTPUT_COUNT(FILE), [((FILE)->__ptr - (FILE)->__base)]) - ;; - gnu) dnl libc defines data_start. AC_DEFINE(DATA_START, [({ extern int data_start; (char *) &data_start; })]) === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-11 06:14:27 +0000 +++ src/ChangeLog 2012-07-11 06:52:48 +0000 @@ -1,3 +1,8 @@ +2012-07-11 Glenn Morris + + * s/gnu.h, s/gnu-linux.h: + Move GNU_LIBRARY_PENDING_OUTPUT_COUNT to configure. + 2012-07-11 John Wiegley * alloc.c (mark_memory): Guard the "no_address_safety_analysis" === modified file 'src/s/gnu-linux.h' --- src/s/gnu-linux.h 2012-07-10 21:48:34 +0000 +++ src/s/gnu-linux.h 2012-07-11 06:52:48 +0000 @@ -92,25 +92,9 @@ your system and must be used only through an encapsulation (Which you should place, by convention, in sysdep.c). */ -/* This is needed for dispnew.c:update_frame. */ #ifdef emacs -#include /* Get the definition of _IO_STDIO_H. */ -#if defined (_IO_STDIO_H) || defined (_STDIO_USES_IOSTREAM) -/* New C libio names. */ -#define GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE) \ - ((FILE)->_IO_write_ptr - (FILE)->_IO_write_base) -#elif defined (__UCLIBC__) -/* Using the uClibc library. */ -#define GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE) \ - ((FILE)->__bufpos - (FILE)->__bufstart) -#else /* !_IO_STDIO_H && ! __UCLIBC__ */ -/* Old C++ iostream names. */ -#define GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE) \ - ((FILE)->_pptr - (FILE)->_pbase) -#endif /* !_IO_STDIO_H && ! __UCLIBC__ */ - #define INTERRUPT_INPUT -#endif /* emacs */ +#endif #define POSIX /* affects getpagesize.h and systty.h */ === modified file 'src/s/gnu.h' --- src/s/gnu.h 2012-07-10 07:15:05 +0000 +++ src/s/gnu.h 2012-07-11 06:52:48 +0000 @@ -20,13 +20,3 @@ /* Get most of the stuff from bsd-common */ #include "bsd-common.h" - -/* It would be harmless to drop the ifdef emacs test. */ -#ifdef emacs -#include /* Get the definition of _IO_STDIO_H. */ -#if defined (_IO_STDIO_H) || defined (_STDIO_USES_IOSTREAM) -/* new C libio names */ -#define GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE) \ - ((FILE)->_IO_write_ptr - (FILE)->_IO_write_base) -#endif /* !_IO_STDIO_H */ -#endif /* emacs */ ------------------------------------------------------------ revno: 109016 committer: John Wiegley branch nick: trunk timestamp: Wed 2012-07-11 01:14:27 -0500 message: alloc.c (mark_memory): Guard the "no_address_safety_analysis" function attribute, so we only use it if it exists in the compiler. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-11 06:14:19 +0000 +++ src/ChangeLog 2012-07-11 06:14:27 +0000 @@ -1,3 +1,9 @@ +2012-07-11 John Wiegley + + * alloc.c (mark_memory): Guard the "no_address_safety_analysis" + function attribute, so we only use it if it exists in the + compiler. + 2012-07-11 Dmitry Antipov Avoid call to strlen in fast_c_string_match_ignore_case. === modified file 'src/alloc.c' --- src/alloc.c 2012-07-10 23:24:36 +0000 +++ src/alloc.c 2012-07-11 06:14:27 +0000 @@ -4641,12 +4641,14 @@ static void mark_memory (void *start, void *end) -#ifdef __clang__ +#if defined (__clang__) && defined (__has_feature) +#if __has_feature(address_sanitizer) /* Do not allow -faddress-sanitizer to check this function, since it crosses the function stack boundary, and thus would yield many false positives. */ __attribute__((no_address_safety_analysis)) #endif +#endif { void **pp; int i; ------------------------------------------------------------ revno: 109015 committer: Dmitry Antipov branch nick: trunk timestamp: Wed 2012-07-11 10:14:19 +0400 message: Avoid call to strlen in fast_c_string_match_ignore_case. * search.c (fast_c_string_match_ignore_case): Change to use length argument. Adjust users accordingly. * lisp.h (fast_c_string_match_ignore_case): Adjust prototype. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-11 06:09:09 +0000 +++ src/ChangeLog 2012-07-11 06:14:19 +0000 @@ -1,3 +1,10 @@ +2012-07-11 Dmitry Antipov + + Avoid call to strlen in fast_c_string_match_ignore_case. + * search.c (fast_c_string_match_ignore_case): Change to use + length argument. Adjust users accordingly. + * lisp.h (fast_c_string_match_ignore_case): Adjust prototype. + 2012-07-11 Paul Eggert Assume rename. @@ -15,10 +22,12 @@ Avoid calls to strlen in font processing functions. * font.c (font_parse_name, font_parse_xlfd, font_parse_fcname) - (font_open_by_name): Changed to use length argument. Adjust + (font_open_by_name): Change to use length argument. Adjust users accordingly. - * font.h (font_open_by_name, font_parse_xlfd): Adjust prototypes. - * xfont.c (xfont_decode_coding_xlfd): Changed to return ptrdiff_t. + * font.h (font_open_by_name, font_parse_xlfd, font_unparse_xlfd): + Adjust prototypes. + * xfont.c (xfont_decode_coding_xlfd, font_unparse_xlfd): + Change to return ptrdiff_t. (xfont_list_pattern, xfont_match): Use length returned by xfont_decode_coding_xlfd. * xfns.c (x_default_font_parameter): Omit useless xstrdup. @@ -107,7 +116,7 @@ Use XCAR and XCDR instead of Fcar and Fcdr where possible. * callint.c, coding.c, doc.c, editfns.c, eval.c, font.c, fontset.c, * frame.c, gnutls.c, minibuf.c, msdos.c, textprop.c, w32fns.c, - * w32menu.c, window.c, xmenu.c: Changed to use XCAR and XCDR + * w32menu.c, window.c, xmenu.c: Change to use XCAR and XCDR where argument type is known to be a Lisp_Cons. 2012-07-10 Tom Tromey === modified file 'src/font.c' --- src/font.c 2012-07-11 04:31:53 +0000 +++ src/font.c 2012-07-11 06:14:19 +0000 @@ -1199,7 +1199,7 @@ length), and return the name length. If FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */ -int +ptrdiff_t font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes) { char *p; @@ -2642,15 +2642,18 @@ if (! NILP (Vface_ignored_fonts)) { char name[256]; + ptrdiff_t namelen; Lisp_Object tail, regexp; - if (font_unparse_xlfd (entity, 0, name, 256) >= 0) + namelen = font_unparse_xlfd (entity, 0, name, 256); + if (namelen >= 0) { for (tail = Vface_ignored_fonts; CONSP (tail); tail = XCDR (tail)) { regexp = XCAR (tail); if (STRINGP (regexp) - && fast_c_string_match_ignore_case (regexp, name) >= 0) + && fast_c_string_match_ignore_case (regexp, name, + namelen) >= 0) break; } if (CONSP (tail)) === modified file 'src/font.h' --- src/font.h 2012-07-11 04:31:53 +0000 +++ src/font.h 2012-07-11 06:14:19 +0000 @@ -782,8 +782,8 @@ Lisp_Object spec); extern int font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font); -extern int font_unparse_xlfd (Lisp_Object font, int pixel_size, - char *name, int bytes); +extern ptrdiff_t font_unparse_xlfd (Lisp_Object font, int pixel_size, + char *name, int bytes); extern int font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int bytes); extern void register_font_driver (struct font_driver *driver, FRAME_PTR f); === modified file 'src/ftfont.c' --- src/ftfont.c 2012-07-05 18:35:48 +0000 +++ src/ftfont.c 2012-07-11 06:14:19 +0000 @@ -598,7 +598,9 @@ re[j] = '\0'; regexp = make_unibyte_string (re, j); for (i = 0; fc_charset_table[i].name; i++) - if (fast_c_string_match_ignore_case (regexp, fc_charset_table[i].name) >= 0) + if (fast_c_string_match_ignore_case + (regexp, fc_charset_table[i].name, + strlen (fc_charset_table[i].name)) >= 0) break; if (! fc_charset_table[i].name) return -1; === modified file 'src/lisp.h' --- src/lisp.h 2012-07-10 08:43:46 +0000 +++ src/lisp.h 2012-07-11 06:14:19 +0000 @@ -2896,7 +2896,8 @@ struct re_registers *, Lisp_Object, int, int); extern ptrdiff_t fast_string_match (Lisp_Object, Lisp_Object); -extern ptrdiff_t fast_c_string_match_ignore_case (Lisp_Object, const char *); +extern ptrdiff_t fast_c_string_match_ignore_case (Lisp_Object, const char *, + ptrdiff_t); extern ptrdiff_t fast_string_match_ignore_case (Lisp_Object, Lisp_Object); extern ptrdiff_t fast_looking_at (Lisp_Object, ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t, Lisp_Object); === modified file 'src/lread.c' --- src/lread.c 2012-07-10 23:24:36 +0000 +++ src/lread.c 2012-07-11 06:14:19 +0000 @@ -906,7 +906,7 @@ if (i >= nbytes || fast_c_string_match_ignore_case (Vbytecomp_version_regexp, - buf + i) < 0) + buf + i, nbytes - i) < 0) safe_p = 0; } if (safe_p) === modified file 'src/search.c' --- src/search.c 2012-07-10 08:43:46 +0000 +++ src/search.c 2012-07-11 06:14:19 +0000 @@ -490,11 +490,11 @@ We assume that STRING contains single-byte characters. */ ptrdiff_t -fast_c_string_match_ignore_case (Lisp_Object regexp, const char *string) +fast_c_string_match_ignore_case (Lisp_Object regexp, + const char *string, ptrdiff_t len) { ptrdiff_t val; struct re_pattern_buffer *bufp; - size_t len = strlen (string); regexp = string_make_unibyte (regexp); re_match_object = Qt; === modified file 'src/xfont.c' --- src/xfont.c 2012-07-11 04:31:53 +0000 +++ src/xfont.c 2012-07-11 06:14:19 +0000 @@ -434,7 +434,8 @@ { elt = XCAR (tail); if (STRINGP (elt) - && fast_c_string_match_ignore_case (elt, indices[i]) >= 0) + && fast_c_string_match_ignore_case (elt, indices[i], + len) >= 0) break; } if (! CONSP (tail)) ------------------------------------------------------------ revno: 109014 committer: Paul Eggert branch nick: trunk timestamp: Tue 2012-07-10 23:09:09 -0700 message: Assume rename. diff: === modified file 'ChangeLog' --- ChangeLog 2012-07-11 05:44:06 +0000 +++ ChangeLog 2012-07-11 06:09:09 +0000 @@ -1,7 +1,7 @@ 2012-07-11 Paul Eggert - Assume strerror. - * configure.ac (strerror): Remove check. + Assume rename, strerror. + * configure.ac (rename, strerror): Remove check. 2012-07-11 Glenn Morris === modified file 'admin/CPP-DEFINES' --- admin/CPP-DEFINES 2012-07-11 05:57:03 +0000 +++ admin/CPP-DEFINES 2012-07-11 06:09:09 +0000 @@ -137,7 +137,6 @@ HAVE_PSTAT_GETDYNAMIC HAVE_PWD_H HAVE_RANDOM -HAVE_RENAME HAVE_RES_INIT HAVE_RINT HAVE_RMDIR === modified file 'admin/ChangeLog' --- admin/ChangeLog 2012-07-11 05:57:03 +0000 +++ admin/ChangeLog 2012-07-11 06:09:09 +0000 @@ -1,7 +1,8 @@ 2012-07-11 Paul Eggert - Assume perror, strerror. - * CPP-DEFINES (HAVE_PERROR, HAVE_STRERROR, strerror): Remove. + Assume perror, rename, strerror. + * CPP-DEFINES (HAVE_PERROR, HAVE_RENAME, HAVE_STRERROR, strerror): + Remove. 2012-07-10 Dmitry Antipov === modified file 'configure.ac' --- configure.ac 2012-07-11 05:44:06 +0000 +++ configure.ac 2012-07-11 06:09:09 +0000 @@ -2708,7 +2708,7 @@ AC_CHECK_FUNCS(gethostname \ -rename closedir mkdir rmdir getrusage get_current_dir_name \ +closedir mkdir rmdir getrusage get_current_dir_name \ lrand48 logb frexp fmod cbrt setsid \ fpathconf select euidaccess getpagesize setlocale \ utimes getrlimit setrlimit setpgid getcwd shutdown getaddrinfo \ === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-11 05:57:03 +0000 +++ src/ChangeLog 2012-07-11 06:09:09 +0000 @@ -1,5 +1,8 @@ 2012-07-11 Paul Eggert + Assume rename. + * sysdep.c (rename) [!HAVE_RENAME]: Remove. + Assume perror. * s/hpux10-20.h (HAVE_PERROR): Remove. * sysdep.c (perror) [HPUX && !HAVE_PERROR]: === modified file 'src/sysdep.c' --- src/sysdep.c 2012-07-11 05:57:03 +0000 +++ src/sysdep.c 2012-07-11 06:09:09 +0000 @@ -2001,29 +2001,6 @@ #endif /* HAVE_GETWD */ /* - * Emulate rename using unlink/link. Note that this is - * only partially correct. Also, doesn't enforce restriction - * that files be of same type (regular->regular, dir->dir, etc). - */ - -#ifndef HAVE_RENAME - -int -rename (const char *from, const char *to) -{ - if (access (from, 0) == 0) - { - unlink (to); - if (link (from, to) == 0) - if (unlink (from) == 0) - return (0); - } - return (-1); -} - -#endif - -/* * This function will go away as soon as all the stubs fixed. (fnf) */ ------------------------------------------------------------ revno: 109013 committer: Paul Eggert branch nick: trunk timestamp: Tue 2012-07-10 22:57:03 -0700 message: Assume perror. diff: === modified file 'admin/CPP-DEFINES' --- admin/CPP-DEFINES 2012-07-11 05:44:06 +0000 +++ admin/CPP-DEFINES 2012-07-11 05:57:03 +0000 @@ -134,7 +134,6 @@ HAVE_MKDIR HAVE_MKTIME HAVE_MOUSE -HAVE_PERROR HAVE_PSTAT_GETDYNAMIC HAVE_PWD_H HAVE_RANDOM === modified file 'admin/ChangeLog' --- admin/ChangeLog 2012-07-11 05:44:06 +0000 +++ admin/ChangeLog 2012-07-11 05:57:03 +0000 @@ -1,7 +1,7 @@ 2012-07-11 Paul Eggert - Assume strerror. - * CPP-DEFINES (HAVE_STRERROR, strerror): Remove. + Assume perror, strerror. + * CPP-DEFINES (HAVE_PERROR, HAVE_STRERROR, strerror): Remove. 2012-07-10 Dmitry Antipov === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-11 05:44:06 +0000 +++ src/ChangeLog 2012-07-11 05:57:03 +0000 @@ -1,5 +1,10 @@ 2012-07-11 Paul Eggert + Assume perror. + * s/hpux10-20.h (HAVE_PERROR): Remove. + * sysdep.c (perror) [HPUX && !HAVE_PERROR]: + Remove dummy definition, as this problem was obsolete long ago. + Assume strerror. * sysdep.c (strerror) [!HAVE_STRERROR && !WINDOWSNT]: Remove. === modified file 'src/s/hpux10-20.h' --- src/s/hpux10-20.h 2012-07-10 07:15:05 +0000 +++ src/s/hpux10-20.h 2012-07-11 05:57:03 +0000 @@ -43,9 +43,6 @@ /* Special hacks needed to make Emacs run on this system. */ -/* Some additional system facilities exist. */ -#define HAVE_PERROR /* Delete this line for version 6. */ - /* This is how to get the device name of the tty end of a pty. */ #define PTY_TTY_NAME_SPRINTF \ sprintf (pty_name, "/dev/pty/tty%c%x", c, i); === modified file 'src/sysdep.c' --- src/sysdep.c 2012-07-11 05:44:06 +0000 +++ src/sysdep.c 2012-07-11 05:57:03 +0000 @@ -2023,18 +2023,6 @@ #endif - -#if defined (HPUX) && !defined (HAVE_PERROR) - -/* HPUX curses library references perror, but as far as we know - it won't be called. Anyway this definition will do for now. */ - -void -perror (void) -{ -} -#endif /* HPUX and not HAVE_PERROR */ - /* * This function will go away as soon as all the stubs fixed. (fnf) */ ------------------------------------------------------------ revno: 109012 committer: Paul Eggert branch nick: trunk timestamp: Tue 2012-07-10 22:44:06 -0700 message: Assume strerror. diff: === modified file 'ChangeLog' --- ChangeLog 2012-07-11 02:29:13 +0000 +++ ChangeLog 2012-07-11 05:44:06 +0000 @@ -1,3 +1,8 @@ +2012-07-11 Paul Eggert + + Assume strerror. + * configure.ac (strerror): Remove check. + 2012-07-11 Glenn Morris * configure.ac (DONT_REOPEN_PTY): Move here from src/s. === modified file 'admin/CPP-DEFINES' --- admin/CPP-DEFINES 2012-07-04 16:46:42 +0000 +++ admin/CPP-DEFINES 2012-07-11 05:44:06 +0000 @@ -151,7 +151,6 @@ HAVE_SOCKETS HAVE_SOUND HAVE_STDLIB_H -HAVE_STRERROR HAVE_STRFTIME HAVE_STRING_H HAVE_STRUCT_UTIMBUF @@ -311,7 +310,6 @@ spawnve srandom strdup -strerror stricmp strnicmp strupr === modified file 'admin/ChangeLog' --- admin/ChangeLog 2012-07-10 16:53:26 +0000 +++ admin/ChangeLog 2012-07-11 05:44:06 +0000 @@ -1,3 +1,8 @@ +2012-07-11 Paul Eggert + + Assume strerror. + * CPP-DEFINES (HAVE_STRERROR, strerror): Remove. + 2012-07-10 Dmitry Antipov * coccinelle/list_loop.cocci: Semantic patch to convert from Fcdr === modified file 'configure.ac' --- configure.ac 2012-07-11 02:29:13 +0000 +++ configure.ac 2012-07-11 05:44:06 +0000 @@ -2710,7 +2710,7 @@ AC_CHECK_FUNCS(gethostname \ rename closedir mkdir rmdir getrusage get_current_dir_name \ lrand48 logb frexp fmod cbrt setsid \ -strerror fpathconf select euidaccess getpagesize setlocale \ +fpathconf select euidaccess getpagesize setlocale \ utimes getrlimit setrlimit setpgid getcwd shutdown getaddrinfo \ __fpending strsignal setitimer \ sendto recvfrom getsockname getpeername getifaddrs freeifaddrs \ === modified file 'lib-src/ChangeLog' --- lib-src/ChangeLog 2012-07-10 23:24:36 +0000 +++ lib-src/ChangeLog 2012-07-11 05:44:06 +0000 @@ -1,3 +1,9 @@ +2012-07-11 Paul Eggert + + Assume strerror. + * emacsclient.c, movemail.c, update-game-score.c (strerror) + [!HAVE_STRERROR]: Remove. + 2012-07-10 Paul Eggert EMACS_TIME simplification (Bug#11875). === modified file 'lib-src/emacsclient.c' --- lib-src/emacsclient.c 2012-07-09 14:01:41 +0000 +++ lib-src/emacsclient.c 2012-07-11 05:44:06 +0000 @@ -749,8 +749,6 @@ #define AUTH_KEY_LENGTH 64 #define SEND_BUFFER_SIZE 4096 -extern char *strerror (int); - /* Buffer to accumulate data to send in TCP connections. */ char send_buffer[SEND_BUFFER_SIZE + 1]; int sblen = 0; /* Fill pointer for the send buffer. */ @@ -1850,22 +1848,3 @@ } #endif /* HAVE_SOCKETS && HAVE_INET_SOCKETS */ - - -#ifndef HAVE_STRERROR -char * -strerror (errnum) - int errnum; -{ - extern char *sys_errlist[]; - extern int sys_nerr; - - if (errnum >= 0 && errnum < sys_nerr) - return sys_errlist[errnum]; - return (char *) "Unknown error"; -} - -#endif /* ! HAVE_STRERROR */ - - -/* emacsclient.c ends here */ === modified file 'lib-src/movemail.c' --- lib-src/movemail.c 2012-07-10 21:48:34 +0000 +++ lib-src/movemail.c 2012-07-11 05:44:06 +0000 @@ -133,10 +133,6 @@ #endif #endif -#ifndef HAVE_STRERROR -char *strerror (int); -#endif - static _Noreturn void fatal (const char *s1, const char *s2, const char *s3); static void error (const char *s1, const char *s2, const char *s3); static _Noreturn void pfatal_with_name (char *name); @@ -920,21 +916,3 @@ } #endif /* MAIL_USE_POP */ - -#ifndef HAVE_STRERROR -char * -strerror (errnum) - int errnum; -{ - extern char *sys_errlist[]; - extern int sys_nerr; - - if (errnum >= 0 && errnum < sys_nerr) - return sys_errlist[errnum]; - return (char *) "Unknown error"; -} - -#endif /* ! HAVE_STRERROR */ - - -/* movemail.c ends here */ === modified file 'lib-src/update-game-score.c' --- lib-src/update-game-score.c 2012-06-24 17:39:14 +0000 +++ lib-src/update-game-score.c 2012-07-11 05:44:06 +0000 @@ -94,22 +94,6 @@ exit (EXIT_FAILURE); } -/* Taken from sysdep.c. */ -#ifndef HAVE_STRERROR -#ifndef WINDOWSNT -char * -strerror (int errnum) -{ - extern char *sys_errlist[]; - extern int sys_nerr; - - if (errnum >= 0 && errnum < sys_nerr) - return sys_errlist[errnum]; - return (char *) "Unknown error"; -} -#endif /* not WINDOWSNT */ -#endif /* ! HAVE_STRERROR */ - static _Noreturn void lose_syserr (const char *msg) { === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-11 04:31:53 +0000 +++ src/ChangeLog 2012-07-11 05:44:06 +0000 @@ -1,3 +1,8 @@ +2012-07-11 Paul Eggert + + Assume strerror. + * sysdep.c (strerror) [!HAVE_STRERROR && !WINDOWSNT]: Remove. + 2012-07-11 Dmitry Antipov Avoid calls to strlen in font processing functions. === modified file 'src/sysdep.c' --- src/sysdep.c 2012-07-10 23:24:36 +0000 +++ src/sysdep.c 2012-07-11 05:44:06 +0000 @@ -1792,21 +1792,6 @@ return val & INTMASK; } -#ifndef HAVE_STRERROR -#ifndef WINDOWSNT -char * -strerror (int errnum) -{ - extern char *sys_errlist[]; - extern int sys_nerr; - - if (errnum >= 0 && errnum < sys_nerr) - return sys_errlist[errnum]; - return (char *) "Unknown error"; -} -#endif /* not WINDOWSNT */ -#endif /* ! HAVE_STRERROR */ - #ifndef HAVE_SNPRINTF /* Approximate snprintf as best we can on ancient hosts that lack it. */ int ------------------------------------------------------------ revno: 109011 committer: Chong Yidong branch nick: trunk timestamp: Wed 2012-07-11 12:35:13 +0800 message: Allow use of vc-root-* commands in *vc-log* buffers. * lisp/vc/log-edit.el (log-edit-vc-backend): New variable. (log-edit): Doc fix. * lisp/vc/log-view.el (log-view-vc-fileset, log-view-vc-backend): Doc fix. * lisp/vc/vc-dispatcher.el (vc-log-edit): New args. Use PARAMS argument of log-edit to set up all local variables. (vc-start-logentry): New optional arg specifying VC backend. * lisp/vc/vc.el (vc-checkin): Use it. (vc-deduce-fileset): Handle Log Edit buffers. (vc-diff): Make first argument optional too. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-07-10 12:16:40 +0000 +++ lisp/ChangeLog 2012-07-11 04:35:13 +0000 @@ -1,3 +1,18 @@ +2012-07-11 Chong Yidong + + * vc/log-edit.el (log-edit-vc-backend): New variable. + (log-edit): Doc fix. + + * vc/vc-dispatcher.el (vc-log-edit): New args. Use PARAMS + argument of log-edit to set up all local variables. + (vc-start-logentry): New optional arg specifying VC backend. + + * vc/vc.el (vc-checkin): Use it. + (vc-deduce-fileset): Handle Log Edit buffers. + (vc-diff): Make first argument optional too. + + * vc/log-view.el (log-view-vc-fileset, log-view-vc-backend): Doc fix. + 2012-07-10 Michael Albinus * eshell/esh-ext.el (eshell-remote-command): Remove remote part of === modified file 'lisp/vc/log-edit.el' --- lisp/vc/log-edit.el 2012-07-10 11:51:54 +0000 +++ lisp/vc/log-edit.el 2012-07-11 04:35:13 +0000 @@ -190,6 +190,9 @@ (defvar log-edit-parent-buffer nil) +(defvar log-edit-vc-backend nil + "VC fileset corresponding to the current log.") + ;;; Originally taken from VC-Log mode (defconst log-edit-maximum-comment-ring-size 32 @@ -405,23 +408,27 @@ ;;;###autoload (defun log-edit (callback &optional setup params buffer mode &rest _ignore) "Setup a buffer to enter a log message. -\\The buffer will be put in mode MODE or `log-edit-mode' -if MODE is nil. -If SETUP is non-nil, the buffer is then erased and `log-edit-hook' is run. -Mark and point will be set around the entire contents of the buffer so -that it is easy to kill the contents of the buffer with \\[kill-region]. -Once you're done editing the message, pressing \\[log-edit-done] will call -`log-edit-done' which will end up calling CALLBACK to do the actual commit. +The buffer is put in mode MODE or `log-edit-mode' if MODE is nil. +\\ +If SETUP is non-nil, erase the buffer and run `log-edit-hook'. +Set mark and point around the entire contents of the buffer, so +that it is easy to kill the contents of the buffer with +\\[kill-region]. Once the user is done editing the message, +invoking the command \\[log-edit-done] (`log-edit-done') will +call CALLBACK to do the actual commit. -PARAMS if non-nil is an alist. Possible keys and associated values: +PARAMS if non-nil is an alist of variables and buffer-local +values to give them in the Log Edit buffer. Possible keys and +associated values: `log-edit-listfun' -- function taking no arguments that returns the list of files that are concerned by the current operation (using relative names); `log-edit-diff-function' -- function taking no arguments that displays a diff of the files concerned by the current operation. + `vc-log-fileset' -- the VC fileset to be committed (if any). -If BUFFER is non-nil `log-edit' will jump to that buffer, use it to edit the -log message and go back to the current buffer when done. Otherwise, it -uses the current buffer." +If BUFFER is non-nil `log-edit' will jump to that buffer, use it +to edit the log message and go back to the current buffer when +done. Otherwise, it uses the current buffer." (let ((parent (current-buffer))) (if buffer (pop-to-buffer buffer)) (when (and log-edit-setup-invert (not (eq setup 'force))) === modified file 'lisp/vc/log-view.el' --- lisp/vc/log-view.el 2012-07-10 11:51:54 +0000 +++ lisp/vc/log-view.el 2012-07-11 04:35:13 +0000 @@ -245,10 +245,10 @@ '(log-view-font-lock-keywords t nil nil nil)) (defvar log-view-vc-fileset nil - "Set this to the fileset corresponding to the current log.") + "The VC fileset corresponding to the current log.") (defvar log-view-vc-backend nil - "Set this to the VC backend that created the current log.") + "The VC backend that created the current log.") ;;;; ;;;; Actual code === modified file 'lisp/vc/vc-dispatcher.el' --- lisp/vc/vc-dispatcher.el 2012-04-16 23:57:09 +0000 +++ lisp/vc/vc-dispatcher.el 2012-07-11 04:35:13 +0000 @@ -575,10 +575,10 @@ ;; Set up key bindings for use while editing log messages -(defun vc-log-edit (fileset mode) +(defun vc-log-edit (fileset mode backend) "Set up `log-edit' for use on FILE." (setq default-directory - (with-current-buffer vc-parent-buffer default-directory)) + (buffer-local-value 'default-directory vc-parent-buffer)) (log-edit 'vc-finish-logentry nil `((log-edit-listfun . (lambda () @@ -586,14 +586,15 @@ ;; for directories. (mapcar 'file-relative-name ',fileset))) - (log-edit-diff-function . (lambda () (vc-diff nil)))) + (log-edit-diff-function . vc-diff) + (log-edit-vc-backend . ,backend) + (vc-log-fileset . ,fileset)) nil mode) - (set (make-local-variable 'vc-log-fileset) fileset) (set-buffer-modified-p nil) (setq buffer-file-name nil)) -(defun vc-start-logentry (files comment initial-contents msg logbuf mode action &optional after-hook) +(defun vc-start-logentry (files comment initial-contents msg logbuf mode action &optional after-hook backend) "Accept a comment for an operation on FILES. If COMMENT is nil, pop up a LOGBUF buffer, emit MSG, and set the action on close to ACTION. If COMMENT is a string and @@ -604,7 +605,8 @@ empty comment. Remember the file's buffer in `vc-parent-buffer' \(current one if no file). Puts the log-entry buffer in major-mode MODE, defaulting to `log-edit-mode' if MODE is nil. -AFTER-HOOK specifies the local value for `vc-log-after-operation-hook'." +AFTER-HOOK specifies the local value for `vc-log-after-operation-hook'. +BACKEND, if non-nil, specifies a VC backend for the Log Edit buffer." (let ((parent (if (vc-dispatcher-browsing) ;; If we are called from a directory browser, the parent buffer is @@ -619,7 +621,7 @@ (set (make-local-variable 'vc-parent-buffer) parent) (set (make-local-variable 'vc-parent-buffer-name) (concat " from " (buffer-name vc-parent-buffer))) - (vc-log-edit files mode) + (vc-log-edit files mode backend) (make-local-variable 'vc-log-after-operation-hook) (when after-hook (setq vc-log-after-operation-hook after-hook)) === modified file 'lisp/vc/vc.el' --- lisp/vc/vc.el 2012-05-29 11:41:45 +0000 +++ lisp/vc/vc.el 2012-07-11 04:35:13 +0000 @@ -936,11 +936,13 @@ (defvar vc-dir-backend) (defvar log-view-vc-backend) +(defvar log-edit-vc-backend) (defvar diff-vc-backend) (defun vc-deduce-backend () (cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend) ((derived-mode-p 'log-view-mode) log-view-vc-backend) + ((derived-mode-p 'log-edit-mode) log-edit-vc-backend) ((derived-mode-p 'diff-mode) diff-vc-backend) ;; Maybe we could even use comint-mode rather than shell-mode? ((derived-mode-p 'dired-mode 'shell-mode 'compilation-mode) @@ -1434,7 +1436,8 @@ (vc-checkout-time . ,(nth 5 (file-attributes file))) (vc-working-revision . nil))) (message "Checking in %s...done" (vc-delistify files))) - 'vc-checkin-hook)) + 'vc-checkin-hook + backend)) ;;; Additional entry points for examining version histories @@ -1680,7 +1683,7 @@ (called-interactively-p 'interactive))) ;;;###autoload -(defun vc-diff (historic &optional not-urgent) +(defun vc-diff (&optional historic not-urgent) "Display diffs between file revisions. Normally this compares the currently selected fileset with their working revisions. With a prefix argument HISTORIC, it reads two revision ------------------------------------------------------------ revno: 109010 committer: Dmitry Antipov branch nick: trunk timestamp: Wed 2012-07-11 08:31:53 +0400 message: Avoid calls to strlen in font processing functions. * font.c (font_parse_name, font_parse_xlfd, font_parse_fcname) (font_open_by_name): Changed to use length argument. Adjust users accordingly. * font.h (font_open_by_name, font_parse_xlfd): Adjust prototypes. * xfont.c (xfont_decode_coding_xlfd): Changed to return ptrdiff_t. (xfont_list_pattern, xfont_match): Use length returned by xfont_decode_coding_xlfd. * xfns.c (x_default_font_parameter): Omit useless xstrdup. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-11 02:29:13 +0000 +++ src/ChangeLog 2012-07-11 04:31:53 +0000 @@ -1,3 +1,15 @@ +2012-07-11 Dmitry Antipov + + Avoid calls to strlen in font processing functions. + * font.c (font_parse_name, font_parse_xlfd, font_parse_fcname) + (font_open_by_name): Changed to use length argument. Adjust + users accordingly. + * font.h (font_open_by_name, font_parse_xlfd): Adjust prototypes. + * xfont.c (xfont_decode_coding_xlfd): Changed to return ptrdiff_t. + (xfont_list_pattern, xfont_match): Use length returned by + xfont_decode_coding_xlfd. + * xfns.c (x_default_font_parameter): Omit useless xstrdup. + 2012-07-11 Glenn Morris * s/darwin.h, s/freebsd.h, s/netbsd.h: === modified file 'src/font.c' --- src/font.c 2012-07-10 16:53:26 +0000 +++ src/font.c 2012-07-11 04:31:53 +0000 @@ -739,7 +739,7 @@ static int parse_matrix (const char *); static int font_expand_wildcards (Lisp_Object *, int); -static int font_parse_name (char *, Lisp_Object); +static int font_parse_name (char *, ptrdiff_t, Lisp_Object); /* An enumerator for each field of an XLFD font name. */ enum xlfd_field_index @@ -1019,9 +1019,8 @@ a fully specified XLFD. */ int -font_parse_xlfd (char *name, Lisp_Object font) +font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font) { - ptrdiff_t len = strlen (name); int i, j, n; char *f[XLFD_LAST_INDEX + 1]; Lisp_Object val; @@ -1336,12 +1335,11 @@ This function tries to guess which format it is. */ static int -font_parse_fcname (char *name, Lisp_Object font) +font_parse_fcname (char *name, ptrdiff_t len, Lisp_Object font) { char *p, *q; char *size_beg = NULL, *size_end = NULL; char *props_beg = NULL, *family_end = NULL; - ptrdiff_t len = strlen (name); if (len == 0) return -1; @@ -1694,11 +1692,11 @@ 0. Otherwise return -1. */ static int -font_parse_name (char *name, Lisp_Object font) +font_parse_name (char *name, ptrdiff_t namelen, Lisp_Object font) { if (name[0] == '-' || strchr (name, '*') || strchr (name, '?')) - return font_parse_xlfd (name, font); - return font_parse_fcname (name, font); + return font_parse_xlfd (name, namelen, font); + return font_parse_fcname (name, namelen, font); } @@ -2987,7 +2985,7 @@ Lisp_Object spec = Ffont_spec (0, NULL); CHECK_STRING (font_name); - if (font_parse_name (SSDATA (font_name), spec) == -1) + if (font_parse_name (SSDATA (font_name), SBYTES (font_name), spec) == -1) return Qnil; font_put_extra (spec, QCname, font_name); font_put_extra (spec, QCuser_spec, font_name); @@ -3359,13 +3357,13 @@ found, return Qnil. */ Lisp_Object -font_open_by_name (FRAME_PTR f, const char *name) +font_open_by_name (FRAME_PTR f, const char *name, ptrdiff_t len) { Lisp_Object args[2]; Lisp_Object spec, ret; args[0] = QCname; - args[1] = make_unibyte_string (name, strlen (name)); + args[1] = make_unibyte_string (name, len); spec = Ffont_spec (2, args); ret = font_open_by_spec (f, spec); /* Do not lose name originally put in. */ @@ -3872,7 +3870,7 @@ if (EQ (key, QCname)) { CHECK_STRING (val); - font_parse_name (SSDATA (val), spec); + font_parse_name (SSDATA (val), SBYTES (val), spec); font_put_extra (spec, key, val); } else @@ -4887,7 +4885,7 @@ if (fontset >= 0) name = fontset_ascii (fontset); - font_object = font_open_by_name (f, SSDATA (name)); + font_object = font_open_by_name (f, SSDATA (name), SBYTES (name)); } else if (FONT_OBJECT_P (name)) font_object = name; === modified file 'src/font.h' --- src/font.h 2012-07-03 18:24:42 +0000 +++ src/font.h 2012-07-11 04:31:53 +0000 @@ -771,7 +771,7 @@ extern void font_done_for_face (FRAME_PTR f, struct face *face); extern Lisp_Object font_open_by_spec (FRAME_PTR f, Lisp_Object spec); -extern Lisp_Object font_open_by_name (FRAME_PTR f, const char *name); +extern Lisp_Object font_open_by_name (FRAME_PTR f, const char *name, ptrdiff_t len); extern Lisp_Object font_intern_prop (const char *str, ptrdiff_t len, int force_symbol); @@ -781,7 +781,7 @@ Lisp_Object registry, Lisp_Object spec); -extern int font_parse_xlfd (char *name, Lisp_Object font); +extern int font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font); extern int font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int bytes); extern int font_unparse_fcname (Lisp_Object font, int pixel_size, === modified file 'src/fontset.c' --- src/fontset.c 2012-07-10 16:53:26 +0000 +++ src/fontset.c 2012-07-11 04:31:53 +0000 @@ -1646,7 +1646,7 @@ char xlfd[256]; int len; - if (font_parse_xlfd (SSDATA (name), font_spec) < 0) + if (font_parse_xlfd (SSDATA (name), SBYTES (name), font_spec) < 0) error ("Fontset name must be in XLFD format"); short_name = AREF (font_spec, FONT_REGISTRY_INDEX); if (strncmp (SSDATA (SYMBOL_NAME (short_name)), "fontset-", 8) === modified file 'src/frame.c' --- src/frame.c 2012-07-10 21:48:34 +0000 +++ src/frame.c 2012-07-11 04:31:53 +0000 @@ -3167,7 +3167,7 @@ fontset = fs_query_fontset (arg, 0); if (fontset < 0) { - font_object = font_open_by_name (f, SSDATA (arg)); + font_object = font_open_by_name (f, SSDATA (arg), SBYTES (arg)); if (NILP (font_object)) error ("Font `%s' is not defined", SSDATA (arg)); arg = AREF (font_object, FONT_NAME_INDEX); @@ -3176,7 +3176,7 @@ { Lisp_Object ascii_font = fontset_ascii (fontset); - font_object = font_open_by_name (f, SSDATA (ascii_font)); + font_object = font_open_by_name (f, SSDATA (ascii_font), SBYTES (ascii_font)); if (NILP (font_object)) error ("Font `%s' is not defined", SDATA (arg)); arg = AREF (font_object, FONT_NAME_INDEX); === modified file 'src/w32fns.c' --- src/w32fns.c 2012-07-10 16:53:26 +0000 +++ src/w32fns.c 2012-07-11 04:31:53 +0000 @@ -4036,7 +4036,7 @@ for (i = 0; names[i]; i++) { - font = font_open_by_name (f, names[i]); + font = font_open_by_name (f, names[i], strlen (names[i])); if (! NILP (font)) break; } === modified file 'src/xfns.c' --- src/xfns.c 2012-07-10 08:43:46 +0000 +++ src/xfns.c 2012-07-11 04:31:53 +0000 @@ -2956,11 +2956,7 @@ read yet. */ const char *system_font = xsettings_get_system_font (); if (system_font) - { - char *name = xstrdup (system_font); - font = font_open_by_name (f, name); - xfree (name); - } + font = font_open_by_name (f, system_font, strlen (system_font)); } if (NILP (font)) @@ -2990,7 +2986,7 @@ for (i = 0; names[i]; i++) { - font = font_open_by_name (f, names[i]); + font = font_open_by_name (f, names[i], strlen (names[i])); if (! NILP (font)) break; } === modified file 'src/xfont.c' --- src/xfont.c 2012-07-06 20:49:23 +0000 +++ src/xfont.c 2012-07-11 04:31:53 +0000 @@ -174,7 +174,7 @@ XLFD is NULL terminated. The caller must assure that OUTPUT is at least twice (plus 1) as large as XLFD. */ -static int +static ptrdiff_t xfont_decode_coding_xlfd (char *xlfd, int len, char *output) { char *p0 = xlfd, *p1 = output; @@ -397,13 +397,14 @@ for (i = 0; i < num_fonts; i++) { + ptrdiff_t len; Lisp_Object entity; if (i > 0 && xstrcasecmp (indices[i - 1], indices[i]) == 0) continue; entity = font_make_entity (); - xfont_decode_coding_xlfd (indices[i], -1, buf); - if (font_parse_xlfd (buf, entity) < 0) + len = xfont_decode_coding_xlfd (indices[i], -1, buf); + if (font_parse_xlfd (buf, len, entity) < 0) continue; ASET (entity, FONT_TYPE_INDEX, Qx); /* Avoid auto-scaled fonts. */ @@ -604,10 +605,11 @@ string. We must avoid such a name. */ if (*s) { + ptrdiff_t len; entity = font_make_entity (); ASET (entity, FONT_TYPE_INDEX, Qx); - xfont_decode_coding_xlfd (s, -1, name); - if (font_parse_xlfd (name, entity) < 0) + len = xfont_decode_coding_xlfd (s, -1, name); + if (font_parse_xlfd (name, len, entity) < 0) entity = Qnil; } XFree (s); @@ -796,7 +798,7 @@ ASET (font_object, FONT_TYPE_INDEX, Qx); if (STRINGP (fullname)) { - font_parse_xlfd (SSDATA (fullname), font_object); + font_parse_xlfd (SSDATA (fullname), SBYTES (fullname), font_object); ASET (font_object, FONT_NAME_INDEX, fullname); } else ------------------------------------------------------------ revno: 109009 committer: Glenn Morris branch nick: trunk timestamp: Tue 2012-07-10 22:29:13 -0400 message: Move DONT_REOPEN_PTY from src/s to configure * configure.ac (DONT_REOPEN_PTY): Move here from src/s. * src/s/darwin.h, src/s/freebsd.h, src/s/netbsd.h: Move DONT_REOPEN_PTY to configure. diff: === modified file 'ChangeLog' --- ChangeLog 2012-07-11 02:16:25 +0000 +++ ChangeLog 2012-07-11 02:29:13 +0000 @@ -1,5 +1,7 @@ 2012-07-11 Glenn Morris + * configure.ac (DONT_REOPEN_PTY): Move here from src/s. + * configure.ac (DEFAULT_SOUND_DEVICE): New definition. 2012-07-10 Paul Eggert === modified file 'configure.ac' --- configure.ac 2012-07-11 02:16:25 +0000 +++ configure.ac 2012-07-11 02:29:13 +0000 @@ -3145,6 +3145,14 @@ ;; esac +case $opsys in + darwin | freebsd | netbsd | openbsd ) + AC_DEFINE(DONT_REOPEN_PTY, 1, [Define if process.c does not need to + close a pty to make it a controlling terminal (it is already a + controlling terminal of the subprocess, because we did ioctl TIOCSCTTY).]) + ;; +esac + dnl FIXME Surely we can test for this rather than hard-code it. case $opsys in netbsd | openbsd) sound_device="/dev/audio" ;; === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-11 02:16:25 +0000 +++ src/ChangeLog 2012-07-11 02:29:13 +0000 @@ -1,5 +1,8 @@ 2012-07-11 Glenn Morris + * s/darwin.h, s/freebsd.h, s/netbsd.h: + Move DONT_REOPEN_PTY to configure. + * sound.c (DEFAULT_SOUND_DEVICE) [!WINDOWSNT]: * s/netbsd.h (DEFAULT_SOUND_DEVICE): Let configure set it. === modified file 'src/s/darwin.h' --- src/s/darwin.h 2012-07-10 07:37:17 +0000 +++ src/s/darwin.h 2012-07-11 02:29:13 +0000 @@ -126,8 +126,3 @@ context as of Darwin 9/Mac OS X 10.5. */ #undef HAVE_WORKING_VFORK #define vfork fork - -/* Don't close pty in process.c to make it as controlling terminal. - It is already a controlling terminal of subprocess, because we did - ioctl TIOCSCTTY. */ -#define DONT_REOPEN_PTY === modified file 'src/s/freebsd.h' --- src/s/freebsd.h 2012-07-10 07:37:17 +0000 +++ src/s/freebsd.h 2012-07-11 02:29:13 +0000 @@ -33,11 +33,6 @@ #define BSD_SYSTEM 199506 #endif -/* Don't close pty in process.c to make it as controlling terminal. - It is already a controlling terminal of subprocess, because we did - ioctl TIOCSCTTY. */ -#define DONT_REOPEN_PTY - /* Circumvent a bug in FreeBSD. In the following sequence of writes/reads on a PTY, read(2) returns bogus data: === modified file 'src/s/netbsd.h' --- src/s/netbsd.h 2012-07-11 02:16:25 +0000 +++ src/s/netbsd.h 2012-07-11 02:29:13 +0000 @@ -26,11 +26,6 @@ that are handled with CPP __RENAME() macro in signal.h. */ #include -/* Don't close pty in process.c to make it as controlling terminal. - It is already a controlling terminal of subprocess, because we did - ioctl TIOCSCTTY. */ -#define DONT_REOPEN_PTY - /* Tell that garbage collector that setjmp is known to save all registers relevant for conservative garbage collection in the jmp_buf. */ #define GC_SETJMP_WORKS 1 ------------------------------------------------------------ revno: 109008 committer: Glenn Morris branch nick: trunk timestamp: Tue 2012-07-10 22:16:25 -0400 message: Let configure set DEFAULT_SOUND_DEVICE * configure.ac (DEFAULT_SOUND_DEVICE): New definition. * src/sound.c (DEFAULT_SOUND_DEVICE) [!WINDOWSNT]: * src/s/netbsd.h (DEFAULT_SOUND_DEVICE): Let configure set it. diff: === modified file 'ChangeLog' --- ChangeLog 2012-07-11 00:01:21 +0000 +++ ChangeLog 2012-07-11 02:16:25 +0000 @@ -1,3 +1,7 @@ +2012-07-11 Glenn Morris + + * configure.ac (DEFAULT_SOUND_DEVICE): New definition. + 2012-07-10 Paul Eggert Remove "#define unix" that is no longer needed (Bug#11905). === modified file 'configure.ac' --- configure.ac 2012-07-10 07:37:17 +0000 +++ configure.ac 2012-07-11 02:16:25 +0000 @@ -3145,6 +3145,16 @@ ;; esac +dnl FIXME Surely we can test for this rather than hard-code it. +case $opsys in + netbsd | openbsd) sound_device="/dev/audio" ;; + *) sound_device="/dev/dsp" ;; +esac + +dnl Used in sound.c +AC_DEFINE_UNQUOTED(DEFAULT_SOUND_DEVICE, "$sound_device", + [Name of the default sound device.]) + dnl Used in vm-limit.c AH_TEMPLATE(DATA_START, [Address of the start of the data segment.]) dnl Used in lisp.h, emacs.c, mem-limits.h === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-11 00:01:21 +0000 +++ src/ChangeLog 2012-07-11 02:16:25 +0000 @@ -1,3 +1,8 @@ +2012-07-11 Glenn Morris + + * sound.c (DEFAULT_SOUND_DEVICE) [!WINDOWSNT]: + * s/netbsd.h (DEFAULT_SOUND_DEVICE): Let configure set it. + 2012-07-10 Paul Eggert Remove "#define unix" that is no longer needed (Bug#11905). === modified file 'src/s/netbsd.h' --- src/s/netbsd.h 2012-07-10 07:37:17 +0000 +++ src/s/netbsd.h 2012-07-11 02:16:25 +0000 @@ -21,8 +21,6 @@ /* Get most of the stuff from bsd-common. */ #include "bsd-common.h" -#define DEFAULT_SOUND_DEVICE "/dev/audio" - /* Greg A. Woods says we must include signal.h before syssignal.h is included, to work around interface conflicts that are handled with CPP __RENAME() macro in signal.h. */ === modified file 'src/sound.c' --- src/sound.c 2012-07-05 18:35:48 +0000 +++ src/sound.c 2012-07-11 02:16:25 +0000 @@ -1,5 +1,6 @@ /* sound.c -- sound support. - Copyright (C) 1998-1999, 2001-2012 Free Software Foundation, Inc. + +Copyright (C) 1998-1999, 2001-2012 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -114,11 +115,6 @@ /* BEGIN: Non Windows Definitions */ #ifndef WINDOWSNT -#ifndef DEFAULT_SOUND_DEVICE -#define DEFAULT_SOUND_DEVICE "/dev/dsp" -#endif - - /* Structure forward declarations. */ struct sound; @@ -714,7 +710,7 @@ { const char *file; - /* Open the sound device. Default is /dev/dsp. */ + /* Open the sound device (eg /dev/dsp). */ if (sd->file) file = sd->file; else @@ -860,7 +856,7 @@ const char *file; int fd; - /* Open the sound device. Default is /dev/dsp. */ + /* Open the sound device (eg /dev/dsp). */ if (sd->file) file = sd->file; else ------------------------------------------------------------ revno: 109007 fixes bug(s): http://debbugs.gnu.org/11905 committer: Paul Eggert branch nick: trunk timestamp: Tue 2012-07-10 17:01:21 -0700 message: Remove "#define unix" that is no longer needed (Bug#11905). Merge from gnulib to make "#define unix" unnecessary, incorporating: 2012-07-10 getloadavg: clean out old Emacs and Autoconf cruft 2012-07-09 getopt: Simplify after Emacs changed. * src/s/aix4-2.h (unix): Remove; no longer needed. diff: === modified file 'ChangeLog' --- ChangeLog 2012-07-10 07:37:17 +0000 +++ ChangeLog 2012-07-11 00:01:21 +0000 @@ -1,3 +1,10 @@ +2012-07-10 Paul Eggert + + Remove "#define unix" that is no longer needed (Bug#11905). + Merge from gnulib to make "#define unix" unnecessary, incorporating: + 2012-07-10 getloadavg: clean out old Emacs and Autoconf cruft + 2012-07-09 getopt: Simplify after Emacs changed. + 2012-07-10 Glenn Morris * configure.ac (DATA_START, DATA_SEG_BITS, PENDING_OUTPUT_COUNT): === modified file 'lib/getloadavg.c' --- lib/getloadavg.c 2012-07-09 08:34:39 +0000 +++ lib/getloadavg.c 2012-07-11 00:01:21 +0000 @@ -80,45 +80,23 @@ We also #define LDAV_PRIVILEGED if a program will require special installation to be able to call getloadavg. */ -/* "configure" defines CONFIGURING_GETLOADAVG to sidestep problems - with partially-configured source directories. */ - -#ifndef CONFIGURING_GETLOADAVG -# include -# include -#endif +#include /* Specification. */ #include #include +#include #include # include -/* Both the Emacs and non-Emacs sections want this. Some - configuration files' definitions for the LOAD_AVE_CVT macro (like - sparc.h's) use macros like FSCALE, defined here. */ -# if defined (unix) || defined (__unix) +# if HAVE_SYS_PARAM_H # include # endif # include "intprops.h" -/* The existing Emacs configuration files define a macro called - LOAD_AVE_CVT, which accepts a value of type LOAD_AVE_TYPE, and - returns the load average multiplied by 100. What we actually want - is a macro called LDAV_CVT, which returns the load average as an - unmultiplied double. - - For backwards compatibility, we'll define LDAV_CVT in terms of - LOAD_AVE_CVT, but future machine config files should just define - LDAV_CVT directly. */ - -# if !defined (LDAV_CVT) && defined (LOAD_AVE_CVT) -# define LDAV_CVT(n) (LOAD_AVE_CVT (n) / 100.0) -# endif - # if !defined (BSD) && defined (ultrix) /* Ultrix behaves like BSD on Vaxen. */ # define BSD === modified file 'm4/getloadavg.m4' --- m4/getloadavg.m4 2012-06-22 17:20:00 +0000 +++ m4/getloadavg.m4 2012-07-11 00:01:21 +0000 @@ -105,6 +105,8 @@ [ # Figure out what our getloadavg.c needs. +AC_CHECK_HEADERS_ONCE([sys/param.h]) + # On HPUX9, an unprivileged user can get load averages this way. if test $gl_func_getloadavg_done = no; then AC_CHECK_FUNCS([pstat_getdynamic], [gl_func_getloadavg_done=yes]) === modified file 'm4/getopt.m4' --- m4/getopt.m4 2012-07-09 08:34:39 +0000 +++ m4/getopt.m4 2012-07-11 00:01:21 +0000 @@ -1,4 +1,4 @@ -# getopt.m4 serial 43 +# getopt.m4 serial 44 dnl Copyright (C) 2002-2006, 2008-2012 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -9,18 +9,17 @@ [ m4_divert_text([DEFAULTS], [gl_getopt_required=POSIX]) AC_REQUIRE([gl_UNISTD_H_DEFAULTS]) + AC_REQUIRE([gl_GETOPT_CHECK_HEADERS]) dnl Other modules can request the gnulib implementation of the getopt dnl functions unconditionally, by defining gl_REPLACE_GETOPT_ALWAYS. dnl argp.m4 does this. m4_ifdef([gl_REPLACE_GETOPT_ALWAYS], [ - gl_GETOPT_IFELSE([], []) REPLACE_GETOPT=1 ], [ REPLACE_GETOPT=0 - gl_GETOPT_IFELSE([ + if test -n "$gl_replace_getopt"; then REPLACE_GETOPT=1 - ], - []) + fi ]) if test $REPLACE_GETOPT = 1; then dnl Arrange for getopt.h to be created. @@ -38,12 +37,6 @@ AC_REQUIRE([gl_FUNC_GETOPT_POSIX]) ]) -AC_DEFUN([gl_GETOPT_IFELSE], -[ - AC_REQUIRE([gl_GETOPT_CHECK_HEADERS]) - AS_IF([test -n "$gl_replace_getopt"], [$1], [$2]) -]) - # Determine whether to replace the entire getopt facility. AC_DEFUN([gl_GETOPT_CHECK_HEADERS], [ === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-10 23:24:36 +0000 +++ src/ChangeLog 2012-07-11 00:01:21 +0000 @@ -1,5 +1,8 @@ 2012-07-10 Paul Eggert + Remove "#define unix" that is no longer needed (Bug#11905). + * s/aix4-2.h (unix): Remove; no longer needed. + EMACS_TIME simplification (Bug#11875). This replaces macros (which typically do not work in GDB) with functions, typedefs and enums, making the code easier to debug. === modified file 'src/s/aix4-2.h' --- src/s/aix4-2.h 2012-06-11 23:17:11 +0000 +++ src/s/aix4-2.h 2012-07-11 00:01:21 +0000 @@ -40,9 +40,6 @@ /* Special items needed to make Emacs run on this system. */ -/* AIX doesn't define this. */ -#define unix 1 - /* Perry Smith says these are correct. */ #define SIGNALS_VIA_CHARACTERS #define CLASH_DETECTION ------------------------------------------------------------ revno: 109006 fixes bug(s): http://debbugs.gnu.org/11875 committer: Paul Eggert branch nick: trunk timestamp: Tue 2012-07-10 16:24:36 -0700 message: EMACS_TIME simplification (Bug#11875). This replaces macros (which typically do not work in GDB) with functions, typedefs and enums, making the code easier to debug. The functional style also makes code easier to read and maintain. * lib-src/profile.c (TV2): Remove no-longer-needed static var. * src/systime.h: Include on all hosts, not just if WINDOWSNT, since 'struct timeval' is needed in general. (EMACS_TIME): Now a typedef, not a macro. (EMACS_TIME_RESOLUTION, LOG10_EMACS_TIME_RESOLUTION): Now constants, not macros. (EMACS_SECS, EMACS_NSECS, EMACS_TIME_SIGN, EMACS_TIME_VALID_P) (EMACS_TIME_FROM_DOUBLE, EMACS_TIME_TO_DOUBLE, EMACS_TIME_EQ) (EMACS_TIME_NE, EMACS_TIME_GT, EMACS_TIME_GE, EMACS_TIME_LT) (EMACS_TIME_LE): Now functions, not macros. (EMACS_SET_SECS, EMACS_SET_NSECS, EMACS_SET_SECS_NSECS) (EMACS_SET_USECS, EMACS_SET_SECS_USECS): Remove these macros, which are not functions. All uses rewritten to use: (make_emacs_time): New function. (EMACS_SECS_ADDR, EMACS_SET_INVALID_TIME, EMACS_GET_TIME) (EMACS_ADD_TIME, EMACS_SUB_TIME): Remove these macros, which are not functions. All uses rewritten to use the following, respectively: (emacs_secs_addr, invalid_emacs_time, get_emacs_time) (add_emacs_time, sub_emacs_time): New functions. * src/atimer.c: Don't include , as "systime.h" does this. * src/fileio.c (Fcopy_file): * src/xterm.c (XTflash): Get the current time closer to when it's used. * src/makefile.w32-in ($(BLD)/atimer.$(O)): Update dependencies. diff: === modified file 'lib-src/ChangeLog' --- lib-src/ChangeLog 2012-07-10 21:48:34 +0000 +++ lib-src/ChangeLog 2012-07-10 23:24:36 +0000 @@ -1,5 +1,8 @@ 2012-07-10 Paul Eggert + EMACS_TIME simplification (Bug#11875). + * profile.c (TV2): Remove no-longer-needed static var. + Simplify by avoiding confusing use of strncpy etc. * etags.c (write_classname, C_entries): Use sprintf rather than strncpy or strncat. === modified file 'lib-src/profile.c' --- lib-src/profile.c 2012-06-30 15:32:51 +0000 +++ lib-src/profile.c 2012-07-10 23:24:36 +0000 @@ -36,7 +36,7 @@ #include #include -static EMACS_TIME TV1, TV2; +static EMACS_TIME TV1; static int watch_not_started = 1; /* flag */ static char time_string[INT_STRLEN_BOUND (uintmax_t) + sizeof "." + LOG10_EMACS_TIME_RESOLUTION]; @@ -46,7 +46,7 @@ static void reset_watch (void) { - EMACS_GET_TIME (TV1); + TV1 = current_emacs_time (); watch_not_started = 0; } @@ -57,14 +57,11 @@ static char * get_time (void) { - uintmax_t s; - int ns; + EMACS_TIME TV2 = sub_emacs_time (current_emacs_time (), TV1); + uintmax_t s = EMACS_SECS (TV2); + int ns = EMACS_NSECS (TV2); if (watch_not_started) exit (EXIT_FAILURE); /* call reset_watch first ! */ - EMACS_GET_TIME (TV2); - EMACS_SUB_TIME (TV2, TV2, TV1); - s = EMACS_SECS (TV2); - ns = EMACS_NSECS (TV2); sprintf (time_string, "%"PRIuMAX".%0*d", s, LOG10_EMACS_TIME_RESOLUTION, ns); return time_string; } === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-10 22:40:34 +0000 +++ src/ChangeLog 2012-07-10 23:24:36 +0000 @@ -1,5 +1,32 @@ 2012-07-10 Paul Eggert + EMACS_TIME simplification (Bug#11875). + This replaces macros (which typically do not work in GDB) + with functions, typedefs and enums, making the code easier to debug. + The functional style also makes code easier to read and maintain. + * systime.h: Include on all hosts, not just if + WINDOWSNT, since 'struct timeval' is needed in general. + (EMACS_TIME): Now a typedef, not a macro. + (EMACS_TIME_RESOLUTION, LOG10_EMACS_TIME_RESOLUTION): Now constants, + not macros. + (EMACS_SECS, EMACS_NSECS, EMACS_TIME_SIGN, EMACS_TIME_VALID_P) + (EMACS_TIME_FROM_DOUBLE, EMACS_TIME_TO_DOUBLE, EMACS_TIME_EQ) + (EMACS_TIME_NE, EMACS_TIME_GT, EMACS_TIME_GE, EMACS_TIME_LT) + (EMACS_TIME_LE): Now functions, not macros. + (EMACS_SET_SECS, EMACS_SET_NSECS, EMACS_SET_SECS_NSECS) + (EMACS_SET_USECS, EMACS_SET_SECS_USECS): Remove these macros, + which are not functions. All uses rewritten to use: + (make_emacs_time): New function. + (EMACS_SECS_ADDR, EMACS_SET_INVALID_TIME, EMACS_GET_TIME) + (EMACS_ADD_TIME, EMACS_SUB_TIME): Remove these macros, which are + not functions. All uses rewritten to use the following, respectively: + (emacs_secs_addr, invalid_emacs_time, get_emacs_time) + (add_emacs_time, sub_emacs_time): New functions. + * atimer.c: Don't include , as "systime.h" does this. + * fileio.c (Fcopy_file): + * xterm.c (XTflash): Get the current time closer to when it's used. + * makefile.w32-in ($(BLD)/atimer.$(O)): Update dependencies. + * bytecode.c (targets): Suppress -Woverride-init warnings. Simplify by avoiding confusing use of strncpy etc. === modified file 'src/alloc.c' --- src/alloc.c 2012-07-10 08:43:46 +0000 +++ src/alloc.c 2012-07-10 23:24:36 +0000 @@ -5393,7 +5393,7 @@ int message_p; Lisp_Object total[8]; ptrdiff_t count = SPECPDL_INDEX (); - EMACS_TIME t1, t2, t3; + EMACS_TIME t1; if (abort_on_gc) abort (); @@ -5442,7 +5442,7 @@ } } - EMACS_GET_TIME (t1); + t1 = current_emacs_time (); /* In case user calls debug_print during GC, don't let that cause a recursive GC. */ @@ -5696,8 +5696,8 @@ /* Accumulate statistics. */ if (FLOATP (Vgc_elapsed)) { - EMACS_GET_TIME (t2); - EMACS_SUB_TIME (t3, t2, t1); + EMACS_TIME t2 = current_emacs_time (); + EMACS_TIME t3 = sub_emacs_time (t2, t1); Vgc_elapsed = make_float (XFLOAT_DATA (Vgc_elapsed) + EMACS_TIME_TO_DOUBLE (t3)); } === modified file 'src/atimer.c' --- src/atimer.c 2012-07-05 06:32:41 +0000 +++ src/atimer.c 2012-07-10 23:24:36 +0000 @@ -26,7 +26,6 @@ #include "blockinput.h" #include "atimer.h" #include -#include /* Free-list of atimer structures. */ @@ -93,10 +92,7 @@ #ifndef HAVE_SETITIMER if (EMACS_NSECS (timestamp) != 0 && EMACS_SECS (timestamp) < TYPE_MAXIMUM (time_t)) - { - EMACS_SET_USECS (timestamp, 0); - EMACS_SET_SECS (timestamp, EMACS_SECS (timestamp) + 1); - } + timestamp = make_emacs_time (EMACS_SECS (timestamp) + 1, 0); #endif /* not HAVE_SETITIMER */ /* Get an atimer structure from the free-list, or allocate @@ -125,13 +121,11 @@ break; case ATIMER_RELATIVE: - EMACS_GET_TIME (t->expiration); - EMACS_ADD_TIME (t->expiration, t->expiration, timestamp); + t->expiration = add_emacs_time (current_emacs_time (), timestamp); break; case ATIMER_CONTINUOUS: - EMACS_GET_TIME (t->expiration); - EMACS_ADD_TIME (t->expiration, t->expiration, timestamp); + t->expiration = add_emacs_time (current_emacs_time (), timestamp); t->interval = timestamp; break; } @@ -285,31 +279,25 @@ { if (atimers) { - EMACS_TIME now, timestamp; #ifdef HAVE_SETITIMER struct itimerval it; #endif /* Determine s/us till the next timer is ripe. */ - EMACS_GET_TIME (now); + EMACS_TIME now = current_emacs_time (); /* Don't set the interval to 0; this disables the timer. */ - if (EMACS_TIME_LE (atimers->expiration, now)) - { - EMACS_SET_SECS (timestamp, 0); - EMACS_SET_USECS (timestamp, 1000); - } - else - EMACS_SUB_TIME (timestamp, atimers->expiration, now); - + EMACS_TIME interval = (EMACS_TIME_LE (atimers->expiration, now) + ? make_emacs_time (0, 1000 * 1000) + : sub_emacs_time (atimers->expiration, now)); #ifdef HAVE_SETITIMER memset (&it, 0, sizeof it); - it.it_value = make_timeval (timestamp); + it.it_value = make_timeval (interval); setitimer (ITIMER_REAL, &it, 0); #else /* not HAVE_SETITIMER */ - alarm (max (EMACS_SECS (timestamp), 1)); + alarm (max (EMACS_SECS (interval), 1)); #endif /* not HAVE_SETITIMER */ } } @@ -344,7 +332,7 @@ while (atimers && (pending_atimers = interrupt_input_blocked) == 0 - && (EMACS_GET_TIME (now), + && (now = current_emacs_time (), EMACS_TIME_LE (atimers->expiration, now))) { struct atimer *t; @@ -355,7 +343,7 @@ if (t->type == ATIMER_CONTINUOUS) { - EMACS_ADD_TIME (t->expiration, now, t->interval); + t->expiration = add_emacs_time (now, t->interval); schedule_atimer (t); } else === modified file 'src/buffer.c' --- src/buffer.c 2012-07-10 08:43:46 +0000 +++ src/buffer.c 2012-07-10 23:24:36 +0000 @@ -705,7 +705,7 @@ BVAR (b, filename) = Qnil; BVAR (b, file_truename) = Qnil; BVAR (b, directory) = (current_buffer) ? BVAR (current_buffer, directory) : Qnil; - EMACS_SET_SECS_NSECS (b->modtime, 0, UNKNOWN_MODTIME_NSECS); + b->modtime = make_emacs_time (0, UNKNOWN_MODTIME_NSECS); b->modtime_size = -1; XSETFASTINT (BVAR (b, save_length), 0); b->last_window_start = 1; === modified file 'src/dispnew.c' --- src/dispnew.c 2012-07-10 19:04:14 +0000 +++ src/dispnew.c 2012-07-10 23:24:36 +0000 @@ -3191,7 +3191,6 @@ force_p = 1; else if (!force_p && NUMBERP (Vredisplay_preemption_period)) { - EMACS_TIME tm; double p = XFLOATINT (Vredisplay_preemption_period); if (detect_input_pending_ignore_squeezables ()) @@ -3200,9 +3199,9 @@ goto do_pause; } - EMACS_GET_TIME (tm); preemption_period = EMACS_TIME_FROM_DOUBLE (p); - EMACS_ADD_TIME (preemption_next_check, tm, preemption_period); + preemption_next_check = add_emacs_time (current_emacs_time (), + preemption_period); } if (FRAME_WINDOW_P (f)) @@ -3344,12 +3343,10 @@ force_p = 1; else if (!force_p && NUMBERP (Vredisplay_preemption_period)) { - EMACS_TIME tm; double p = XFLOATINT (Vredisplay_preemption_period); - - EMACS_GET_TIME (tm); preemption_period = EMACS_TIME_FROM_DOUBLE (p); - EMACS_ADD_TIME (preemption_next_check, tm, preemption_period); + preemption_next_check = add_emacs_time (current_emacs_time (), + preemption_period); } /* Update W. */ @@ -3596,11 +3593,11 @@ #if PERIODIC_PREEMPTION_CHECKING if (!force_p) { - EMACS_TIME tm; - EMACS_GET_TIME (tm); + EMACS_TIME tm = current_emacs_time (); if (EMACS_TIME_LT (preemption_next_check, tm)) { - EMACS_ADD_TIME (preemption_next_check, tm, preemption_period); + preemption_next_check = add_emacs_time (tm, + preemption_period); if (detect_input_pending_ignore_squeezables ()) break; } @@ -4701,11 +4698,10 @@ #if PERIODIC_PREEMPTION_CHECKING if (!force_p) { - EMACS_TIME tm; - EMACS_GET_TIME (tm); + EMACS_TIME tm = current_emacs_time (); if (EMACS_TIME_LT (preemption_next_check, tm)) { - EMACS_ADD_TIME (preemption_next_check, tm, preemption_period); + preemption_next_check = add_emacs_time (tm, preemption_period); if (detect_input_pending_ignore_squeezables ()) break; } === modified file 'src/editfns.c' --- src/editfns.c 2012-07-10 16:53:26 +0000 +++ src/editfns.c 2012-07-10 23:24:36 +0000 @@ -1408,10 +1408,7 @@ picosecond counts. */) (void) { - EMACS_TIME t; - - EMACS_GET_TIME (t); - return make_lisp_time (t); + return make_lisp_time (current_emacs_time ()); } DEFUN ("get-internal-run-time", Fget_internal_run_time, Sget_internal_run_time, @@ -1428,7 +1425,6 @@ struct rusage usage; time_t secs; int usecs; - EMACS_TIME t; if (getrusage (RUSAGE_SELF, &usage) < 0) /* This shouldn't happen. What action is appropriate? */ @@ -1442,8 +1438,7 @@ usecs -= 1000000; secs++; } - EMACS_SET_SECS_USECS (t, secs, usecs); - return make_lisp_time (t); + return make_lisp_time (make_emacs_time (secs, usecs * 1000)); #else /* ! HAVE_GETRUSAGE */ #ifdef WINDOWSNT return w32_get_internal_run_time (); @@ -1560,8 +1555,7 @@ /* Return the greatest representable time that is not greater than the requested time. */ time_t sec = hi; - EMACS_SET_SECS_NSECS (*result, (sec << 16) + lo, - us * 1000 + ps / 1000); + *result = make_emacs_time ((sec << 16) + lo, us * 1000 + ps / 1000); } else { @@ -1587,7 +1581,7 @@ { EMACS_TIME t; if (NILP (specified_time)) - EMACS_GET_TIME (t); + t = current_emacs_time (); else { Lisp_Object high, low, usec, psec; @@ -1635,8 +1629,7 @@ double t; if (NILP (specified_time)) { - EMACS_TIME now; - EMACS_GET_TIME (now); + EMACS_TIME now = current_emacs_time (); t = EMACS_SECS (now) + EMACS_NSECS (now) / 1e9; } else @@ -1780,11 +1773,12 @@ while (1) { + time_t *taddr = emacs_secs_addr (&t); BLOCK_INPUT; synchronize_system_time_locale (); - tm = ut ? gmtime (EMACS_SECS_ADDR (t)) : localtime (EMACS_SECS_ADDR (t)); + tm = ut ? gmtime (taddr) : localtime (taddr); if (! tm) { UNBLOCK_INPUT; @@ -2065,10 +2059,10 @@ Lisp_Object zone_offset, zone_name; zone_offset = Qnil; - EMACS_SET_SECS_NSECS (value, lisp_seconds_argument (specified_time), 0); + value = make_emacs_time (lisp_seconds_argument (specified_time), 0); zone_name = format_time_string ("%Z", sizeof "%Z" - 1, value, 0, &localtm); BLOCK_INPUT; - t = gmtime (EMACS_SECS_ADDR (value)); + t = gmtime (emacs_secs_addr (&value)); if (t) offset = tm_diff (&localtm, t); UNBLOCK_INPUT; === modified file 'src/fileio.c' --- src/fileio.c 2012-07-10 21:48:34 +0000 +++ src/fileio.c 2012-07-10 23:24:36 +0000 @@ -1927,12 +1927,12 @@ DWORD attributes; char * filename; - EMACS_GET_TIME (now); filename = SDATA (encoded_newname); /* Ensure file is writable while its modified time is set. */ attributes = GetFileAttributes (filename); SetFileAttributes (filename, attributes & ~FILE_ATTRIBUTE_READONLY); + now = current_emacs_time (); if (set_file_times (-1, filename, now, now)) { /* Restore original attributes. */ @@ -3219,12 +3219,10 @@ static EMACS_TIME time_error_value (int errnum) { - EMACS_TIME t; int ns = (errnum == ENOENT || errnum == EACCES || errnum == ENOTDIR ? NONEXISTENT_MODTIME_NSECS : UNKNOWN_MODTIME_NSECS); - EMACS_SET_SECS_NSECS (t, 0, ns); - return t; + return make_emacs_time (0, ns); } DEFUN ("insert-file-contents", Finsert_file_contents, Sinsert_file_contents, @@ -5084,7 +5082,7 @@ struct stat st; Lisp_Object handler; Lisp_Object filename; - EMACS_TIME mtime, diff, one_second; + EMACS_TIME mtime, diff; if (NILP (buf)) b = current_buffer; @@ -5112,11 +5110,10 @@ if ((EMACS_TIME_EQ (mtime, b->modtime) /* If both exist, accept them if they are off by one second. */ || (EMACS_TIME_VALID_P (mtime) && EMACS_TIME_VALID_P (b->modtime) - && ((EMACS_TIME_LT (mtime, b->modtime) - ? EMACS_SUB_TIME (diff, b->modtime, mtime) - : EMACS_SUB_TIME (diff, mtime, b->modtime)), - EMACS_SET_SECS_NSECS (one_second, 1, 0), - EMACS_TIME_LE (diff, one_second)))) + && ((diff = (EMACS_TIME_LT (mtime, b->modtime) + ? sub_emacs_time (b->modtime, mtime) + : sub_emacs_time (mtime, b->modtime))), + EMACS_TIME_LE (diff, make_emacs_time (1, 0))))) && (st.st_size == b->modtime_size || b->modtime_size < 0)) return Qt; @@ -5129,7 +5126,7 @@ Next attempt to save will certainly not complain of a discrepancy. */) (void) { - EMACS_SET_SECS_NSECS (current_buffer->modtime, 0, UNKNOWN_MODTIME_NSECS); + current_buffer->modtime = make_emacs_time (0, UNKNOWN_MODTIME_NSECS); current_buffer->modtime_size = -1; return Qnil; } @@ -5428,9 +5425,8 @@ || NILP (Ffind_file_name_handler (BVAR (b, auto_save_file_name), Qwrite_region)))) { - EMACS_TIME before_time, after_time; - - EMACS_GET_TIME (before_time); + EMACS_TIME before_time = current_emacs_time (); + EMACS_TIME after_time; /* If we had a failure, don't try again for 20 minutes. */ if (b->auto_save_failure_time > 0 @@ -5467,7 +5463,7 @@ XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG); set_buffer_internal (old); - EMACS_GET_TIME (after_time); + after_time = current_emacs_time (); /* If auto-save took more than 60 seconds, assume it was an NFS failure that got a timeout. */ === modified file 'src/fns.c' --- src/fns.c 2012-07-05 18:35:48 +0000 +++ src/fns.c 2012-07-10 23:24:36 +0000 @@ -78,8 +78,7 @@ if (EQ (limit, Qt)) { - EMACS_TIME t; - EMACS_GET_TIME (t); + EMACS_TIME t = current_emacs_time (); seed_random (getpid () ^ EMACS_SECS (t) ^ EMACS_NSECS (t)); } === modified file 'src/image.c' --- src/image.c 2012-07-09 12:02:27 +0000 +++ src/image.c 2012-07-10 23:24:36 +0000 @@ -1061,7 +1061,7 @@ prepare_image_for_display (struct frame *f, struct image *img) { /* We're about to display IMG, so set its timestamp to `now'. */ - EMACS_GET_TIME (img->timestamp); + img->timestamp = current_emacs_time (); /* If IMG doesn't have a pixmap yet, load it now, using the image type dependent loader function. */ @@ -1520,8 +1520,8 @@ delay = 1600 * delay / nimages / nimages; delay = max (delay, 1); - EMACS_GET_TIME (t); - EMACS_SUB_TIME (old, t, EMACS_TIME_FROM_DOUBLE (delay)); + t = current_emacs_time (); + old = sub_emacs_time (t, EMACS_TIME_FROM_DOUBLE (delay)); for (i = 0; i < c->used; ++i) { @@ -1792,7 +1792,7 @@ } /* We're using IMG, so set its timestamp to `now'. */ - EMACS_GET_TIME (img->timestamp); + img->timestamp = current_emacs_time (); /* Value is the image id. */ return img->id; === modified file 'src/keyboard.c' --- src/keyboard.c 2012-07-10 21:48:34 +0000 +++ src/keyboard.c 2012-07-10 23:24:36 +0000 @@ -2017,12 +2017,11 @@ || EMACS_SECS (poll_timer->interval) != polling_period) { time_t period = max (1, min (polling_period, TYPE_MAXIMUM (time_t))); - EMACS_TIME interval; + EMACS_TIME interval = make_emacs_time (period, 0); if (poll_timer) cancel_atimer (poll_timer); - EMACS_SET_SECS_USECS (interval, period, 0); poll_timer = start_atimer (ATIMER_CONTINUOUS, interval, poll_for_input, NULL); } @@ -2786,13 +2785,8 @@ { KBOARD *kb IF_LINT (= NULL); - if (end_time) - { - EMACS_TIME now; - EMACS_GET_TIME (now); - if (EMACS_TIME_GE (now, *end_time)) - goto exit; - } + if (end_time && EMACS_TIME_LE (*end_time, current_emacs_time ())) + goto exit; /* Actually read a character, waiting if necessary. */ save_getcjmp (save_jump); @@ -3847,13 +3841,12 @@ #endif if (end_time) { - EMACS_TIME duration; - EMACS_GET_TIME (duration); - if (EMACS_TIME_GE (duration, *end_time)) + EMACS_TIME now = current_emacs_time (); + if (EMACS_TIME_LE (*end_time, now)) return Qnil; /* Finished waiting. */ else { - EMACS_SUB_TIME (duration, *end_time, duration); + EMACS_TIME duration = sub_emacs_time (*end_time, now); wait_reading_process_output (min (EMACS_SECS (duration), WAIT_READING_MAX), EMACS_NSECS (duration), @@ -4256,8 +4249,7 @@ if (EMACS_TIME_VALID_P (timer_idleness_start_time)) return; - EMACS_GET_TIME (timer_idleness_start_time); - + timer_idleness_start_time = current_emacs_time (); timer_last_idleness_start_time = timer_idleness_start_time; /* Mark all idle-time timers as once again candidates for running. */ @@ -4278,7 +4270,7 @@ static void timer_stop_idle (void) { - EMACS_SET_INVALID_TIME (timer_idleness_start_time); + timer_idleness_start_time = invalid_emacs_time (); } /* Resume idle timer from last idle start time. */ @@ -4339,7 +4331,7 @@ Lisp_Object timers, idle_timers, chosen_timer; struct gcpro gcpro1, gcpro2, gcpro3; - EMACS_SET_INVALID_TIME (nexttime); + nexttime = invalid_emacs_time (); /* Always consider the ordinary timers. */ timers = Vtimer_list; @@ -4361,11 +4353,10 @@ if (CONSP (timers) || CONSP (idle_timers)) { - EMACS_GET_TIME (now); - if (EMACS_TIME_VALID_P (timer_idleness_start_time)) - EMACS_SUB_TIME (idleness_now, now, timer_idleness_start_time); - else - EMACS_SET_SECS_NSECS (idleness_now, 0, 0); + now = current_emacs_time (); + idleness_now = (EMACS_TIME_VALID_P (timer_idleness_start_time) + ? sub_emacs_time (now, timer_idleness_start_time) + : make_emacs_time (0, 0)); } while (CONSP (timers) || CONSP (idle_timers)) @@ -4374,12 +4365,10 @@ Lisp_Object timer = Qnil, idle_timer = Qnil; EMACS_TIME timer_time, idle_timer_time; EMACS_TIME difference; - EMACS_TIME timer_difference, idle_timer_difference; + EMACS_TIME timer_difference = invalid_emacs_time (); + EMACS_TIME idle_timer_difference = invalid_emacs_time (); int ripe, timer_ripe = 0, idle_timer_ripe = 0; - EMACS_SET_INVALID_TIME (timer_difference); - EMACS_SET_INVALID_TIME (idle_timer_difference); - /* Set TIMER and TIMER_DIFFERENCE based on the next ordinary timer. TIMER_DIFFERENCE is the distance in time from NOW to when @@ -4395,10 +4384,9 @@ } timer_ripe = EMACS_TIME_LE (timer_time, now); - if (timer_ripe) - EMACS_SUB_TIME (timer_difference, now, timer_time); - else - EMACS_SUB_TIME (timer_difference, timer_time, now); + timer_difference = (timer_ripe + ? sub_emacs_time (now, timer_time) + : sub_emacs_time (timer_time, now)); } /* Likewise for IDLE_TIMER and IDLE_TIMER_DIFFERENCE @@ -4413,12 +4401,10 @@ } idle_timer_ripe = EMACS_TIME_LE (idle_timer_time, idleness_now); - if (idle_timer_ripe) - EMACS_SUB_TIME (idle_timer_difference, - idleness_now, idle_timer_time); - else - EMACS_SUB_TIME (idle_timer_difference, - idle_timer_time, idleness_now); + idle_timer_difference = + (idle_timer_ripe + ? sub_emacs_time (idleness_now, idle_timer_time) + : sub_emacs_time (idle_timer_time, idleness_now)); } /* Decide which timer is the next timer, @@ -4474,8 +4460,7 @@ return 0 to indicate that. */ } - EMACS_SET_SECS (nexttime, 0); - EMACS_SET_USECS (nexttime, 0); + nexttime = make_emacs_time (0, 0); } else /* When we encounter a timer that is still waiting, @@ -4527,14 +4512,8 @@ (void) { if (EMACS_TIME_VALID_P (timer_idleness_start_time)) - { - EMACS_TIME now, idleness_now; - - EMACS_GET_TIME (now); - EMACS_SUB_TIME (idleness_now, now, timer_idleness_start_time); - - return make_lisp_time (idleness_now); - } + return make_lisp_time (sub_emacs_time (current_emacs_time (), + timer_idleness_start_time)); return Qnil; } @@ -7224,7 +7203,7 @@ #endif if (input_available_clear_time) - EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0); + *input_available_clear_time = make_emacs_time (0, 0); #ifndef SYNC_INPUT handle_async_input (); @@ -7327,7 +7306,7 @@ /* Tell wait_reading_process_output that it needs to wake up and look around. */ if (input_available_clear_time) - EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0); + *input_available_clear_time = make_emacs_time (0, 0); } break; } @@ -11344,7 +11323,7 @@ quit_char = Ctl ('g'); Vunread_command_events = Qnil; unread_command_char = -1; - EMACS_SET_INVALID_TIME (timer_idleness_start_time); + timer_idleness_start_time = invalid_emacs_time (); total_keys = 0; recent_keys_index = 0; kbd_fetch_ptr = kbd_buffer; === modified file 'src/lread.c' --- src/lread.c 2012-07-10 21:48:34 +0000 +++ src/lread.c 2012-07-10 23:24:36 +0000 @@ -604,8 +604,7 @@ { double duration = extract_float (seconds); EMACS_TIME wait_time = EMACS_TIME_FROM_DOUBLE (duration); - EMACS_GET_TIME (end_time); - EMACS_ADD_TIME (end_time, end_time, wait_time); + end_time = add_emacs_time (current_emacs_time (), wait_time); } /* Read until we get an acceptable event. */ === modified file 'src/makefile.w32-in' --- src/makefile.w32-in 2012-07-07 00:20:56 +0000 +++ src/makefile.w32-in 2012-07-10 23:24:36 +0000 @@ -490,7 +490,6 @@ $(BLD)/atimer.$(O) : \ $(SRC)/atimer.c \ $(SRC)/syssignal.h \ - $(NT_INC)/sys/time.h \ $(NT_INC)/unistd.h \ $(ATIMER_H) \ $(BLOCKINPUT_H) \ === modified file 'src/msdos.c' --- src/msdos.c 2012-07-10 16:53:26 +0000 +++ src/msdos.c 2012-07-10 23:24:36 +0000 @@ -4138,14 +4138,14 @@ EMACS_TIME clnow, cllast, cldiff; gettime (&t); - EMACS_SET_SECS_NSECS (cllast, t.tv_sec, t.tv_nsec); + cllast = make_emacs_time (t.tv_sec, t.tv_nsec); while (!check_input || !detect_input_pending ()) { gettime (&t); - EMACS_SET_SECS_NSECS (clnow, t.tv_sec, t.tv_nsec); - EMACS_SUB_TIME (cldiff, clnow, cllast); - EMACS_SUB_TIME (*timeout, *timeout, cldiff); + clnow = make_emacs_time (t.tv_sec, t.tv_nsec); + cldiff = sub_emacs_time (clnow, cllast); + *timeout = sub_emacs_time (*timeout, cldiff); /* Stop when timeout value crosses zero. */ if (EMACS_TIME_SIGN (*timeout) <= 0) === modified file 'src/nsterm.m' --- src/nsterm.m 2012-07-10 21:48:34 +0000 +++ src/nsterm.m 2012-07-10 23:24:36 +0000 @@ -410,21 +410,16 @@ Blocking timer utility used by ns_ring_bell -------------------------------------------------------------------------- */ { - EMACS_TIME wakeup, delay; - - EMACS_GET_TIME (wakeup); - EMACS_SET_SECS_USECS (delay, 0, usecs); - EMACS_ADD_TIME (wakeup, wakeup, delay); + EMACS_TIME wakeup = add_emacs_time (current_emacs_time (), + make_emacs_time (0, usecs * 1000)); /* Keep waiting until past the time wakeup. */ while (1) { - EMACS_TIME timeout; - - EMACS_GET_TIME (timeout); - if (EMACS_TIME_LE (wakeup, timeout)) + EMACS_TIME now = current_emacs_time (); + if (EMACS_TIME_LE (wakeup, now)) break; - EMACS_SUB_TIME (timeout, wakeup, timeout); + timeout = sub_emacs_time (wakeup, now); /* Try to wait that long--but we might wake up sooner. */ pselect (0, NULL, NULL, NULL, &timeout, NULL); === modified file 'src/process.c' --- src/process.c 2012-07-10 21:48:34 +0000 +++ src/process.c 2012-07-10 23:24:36 +0000 @@ -1851,10 +1851,9 @@ So have an interrupt jar it loose. */ { struct atimer *timer; - EMACS_TIME offset; + EMACS_TIME offset = make_emacs_time (1, 0); stop_polling (); - EMACS_SET_SECS_USECS (offset, 1, 0); timer = start_atimer (ATIMER_RELATIVE, offset, create_process_1, 0); if (forkin >= 0) @@ -4311,9 +4310,8 @@ compute the absolute time to return at. */ if (time_limit || 0 < nsecs) { - EMACS_GET_TIME (end_time); - EMACS_SET_SECS_NSECS (timeout, time_limit, nsecs); - EMACS_ADD_TIME (end_time, end_time, timeout); + timeout = make_emacs_time (time_limit, nsecs); + end_time = add_emacs_time (current_emacs_time (), timeout); } while (1) @@ -4342,18 +4340,18 @@ gobble output available now but don't wait at all. */ - EMACS_SET_SECS_USECS (timeout, 0, 0); + timeout = make_emacs_time (0, 0); } else if (time_limit || 0 < nsecs) { - EMACS_GET_TIME (timeout); - if (EMACS_TIME_LE (end_time, timeout)) + EMACS_TIME now = current_emacs_time (); + if (EMACS_TIME_LE (end_time, now)) break; - EMACS_SUB_TIME (timeout, end_time, timeout); + timeout = sub_emacs_time (end_time, now); } else { - EMACS_SET_SECS_USECS (timeout, 100000, 0); + timeout = make_emacs_time (100000, 0); } /* Normally we run timers here. @@ -4438,7 +4436,7 @@ Atemp = input_wait_mask; Ctemp = write_mask; - EMACS_SET_SECS_USECS (timeout, 0, 0); + timeout = make_emacs_time (0, 0); if ((pselect (max (max_process_desc, max_input_desc) + 1, &Atemp, #ifdef NON_BLOCKING_CONNECT @@ -4590,7 +4588,7 @@ nsecs = XPROCESS (proc)->read_output_delay; } } - EMACS_SET_SECS_NSECS (timeout, 0, nsecs); + timeout = make_emacs_time (0, nsecs); process_output_skip = 0; } #endif @@ -6426,7 +6424,7 @@ /* Tell wait_reading_process_output that it needs to wake up and look around. */ if (input_available_clear_time) - EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0); + *input_available_clear_time = make_emacs_time (0, 0); } /* There was no asynchronous process found for that pid: we have @@ -6444,7 +6442,7 @@ /* Tell wait_reading_process_output that it needs to wake up and look around. */ if (input_available_clear_time) - EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0); + *input_available_clear_time = make_emacs_time (0, 0); } sigchld_end_of_loop: @@ -6857,9 +6855,8 @@ /* What does time_limit really mean? */ if (time_limit || 0 < nsecs) { - EMACS_GET_TIME (end_time); - EMACS_SET_SECS_NSECS (timeout, time_limit, nsecs); - EMACS_ADD_TIME (end_time, end_time, timeout); + timeout = make_emacs_time (time_limit, nsecs); + end_time = add_emacs_time (current_emacs_time (), timeout); } /* Turn off periodic alarms (in case they are in use) @@ -6892,18 +6889,18 @@ gobble output available now but don't wait at all. */ - EMACS_SET_SECS_USECS (timeout, 0, 0); + timeout = make_emacs_time (0, 0); } else if (time_limit || 0 < nsecs) { - EMACS_GET_TIME (timeout); - if (EMACS_TIME_LE (end_time, timeout)) + EMACS_TIME now = current_emacs_time (); + if (EMACS_TIME_LE (end_time, now)) break; - EMACS_SUB_TIME (timeout, end_time, timeout); + timeout = sub_emacs_time (end_time, now); } else { - EMACS_SET_SECS_USECS (timeout, 100000, 0); + timeout = make_emacs_time (100000, 0); } /* If our caller will not immediately handle keyboard events, === modified file 'src/sysdep.c' --- src/sysdep.c 2012-07-10 21:48:34 +0000 +++ src/sysdep.c 2012-07-10 23:24:36 +0000 @@ -2586,7 +2586,6 @@ unsigned long long s = tval / hz; unsigned long long frac = tval % hz; int ns; - EMACS_TIME t; if (TYPE_MAXIMUM (time_t) < s) time_overflow (); @@ -2603,8 +2602,7 @@ ns = frac / hz_per_ns; } - EMACS_SET_SECS_NSECS (t, s, ns); - return t; + return make_emacs_time (s, ns); } static Lisp_Object @@ -2618,9 +2616,7 @@ get_up_time (void) { FILE *fup; - EMACS_TIME up; - - EMACS_SET_SECS_NSECS (up, 0, 0); + EMACS_TIME up = make_emacs_time (0, 0); BLOCK_INPUT; fup = fopen ("/proc/uptime", "r"); @@ -2649,7 +2645,7 @@ upfrac /= 10; upfrac = min (upfrac, EMACS_TIME_RESOLUTION - 1); } - EMACS_SET_SECS_NSECS (up, upsec, upfrac); + up = make_emacs_time (upsec, upfrac); } fclose (fup); } @@ -2874,15 +2870,15 @@ attrs = Fcons (Fcons (Qpri, make_number (priority)), attrs); attrs = Fcons (Fcons (Qnice, make_number (niceness)), attrs); attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (thcount_eint)), attrs); - EMACS_GET_TIME (tnow); + tnow = current_emacs_time (); telapsed = get_up_time (); - EMACS_SUB_TIME (tboot, tnow, telapsed); + tboot = sub_emacs_time (tnow, telapsed); tstart = time_from_jiffies (start, clocks_per_sec); - EMACS_ADD_TIME (tstart, tboot, tstart); + tstart = add_emacs_time (tboot, tstart); attrs = Fcons (Fcons (Qstart, make_lisp_time (tstart)), attrs); attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (vsize/1024)), attrs); attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (4*rss)), attrs); - EMACS_SUB_TIME (telapsed, tnow, tstart); + telapsed = sub_emacs_time (tnow, tstart); attrs = Fcons (Fcons (Qetime, make_lisp_time (telapsed)), attrs); us_time = time_from_jiffies (u_time + s_time, clocks_per_sec); pcpu = (EMACS_TIME_TO_DOUBLE (us_time) @@ -3101,9 +3097,7 @@ static EMACS_TIME timeval_to_EMACS_TIME (struct timeval t) { - EMACS_TIME e; - EMACS_SET_SECS_NSECS (e, t.tv_sec, t.tv_usec * 1000); - return e; + return make_emacs_time (t.tv_sec, t.tv_usec * 1000); } static Lisp_Object @@ -3211,9 +3205,8 @@ attrs); attrs = Fcons (Fcons (Qstime, make_lisp_timeval (proc.ki_rusage.ru_stime)), attrs); - EMACS_ADD_TIME (t, - timeval_to_EMACS_TIME (proc.ki_rusage.ru_utime), - timeval_to_EMACS_TIME (proc.ki_rusage.ru_stime)); + t = add_emacs_time (timeval_to_EMACS_TIME (proc.ki_rusage.ru_utime), + timeval_to_EMACS_TIME (proc.ki_rusage.ru_stime)); attrs = Fcons (Fcons (Qtime, make_lisp_time (t)), attrs); attrs = Fcons (Fcons (Qcutime, @@ -3222,9 +3215,8 @@ attrs = Fcons (Fcons (Qcstime, make_lisp_timeval (proc.ki_rusage_ch.ru_utime)), attrs); - EMACS_ADD_TIME (t, - timeval_to_EMACS_TIME (proc.ki_rusage_ch.ru_utime), - timeval_to_EMACS_TIME (proc.ki_rusage_ch.ru_stime)); + t = add_emacs_time (timeval_to_EMACS_TIME (proc.ki_rusage_ch.ru_utime), + timeval_to_EMACS_TIME (proc.ki_rusage_ch.ru_stime)); attrs = Fcons (Fcons (Qctime, make_lisp_time (t)), attrs); attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (proc.ki_numthreads)), @@ -3236,8 +3228,8 @@ attrs = Fcons (Fcons (Qrss, make_number (proc.ki_rssize * pagesize >> 10)), attrs); - EMACS_GET_TIME (now); - EMACS_SUB_TIME (t, now, timeval_to_EMACS_TIME (proc.ki_start)); + now = current_emacs_time (); + t = sub_emacs_time (now, timeval_to_EMACS_TIME (proc.ki_start)); attrs = Fcons (Fcons (Qetime, make_lisp_time (t)), attrs); len = sizeof fscale; === modified file 'src/systime.h' --- src/systime.h 2012-07-08 23:00:38 +0000 +++ src/systime.h 2012-07-10 23:24:36 +0000 @@ -39,65 +39,92 @@ #endif #endif -#ifdef WINDOWSNT #include /* for 'struct timeval' */ -#endif -/* The type to use to represent temporal intervals. It can be passed +/* The type to use to represent temporal intervals. Its address can be passed as the timeout argument to the pselect system call. */ -#define EMACS_TIME struct timespec +typedef struct timespec EMACS_TIME; /* Resolution of EMACS_TIME time stamps (in units per second), and log base 10 of the resolution. The log must be a positive integer. */ -#define EMACS_TIME_RESOLUTION 1000000000 -#define LOG10_EMACS_TIME_RESOLUTION 9 - -/* EMACS_SECS (TIME) is an rvalue for the seconds component of TIME. - EMACS_SECS_ADDR (time) is the address of the seconds component. - EMACS_SET_SECS (TIME, SECONDS) sets that to SECONDS. - - EMACS_NSECS (TIME) is an rvalue for the nanoseconds component of TIME. - EMACS_SET_NSECS (TIME, NANOSECONDS) sets that to NANOSECONDS. - - EMACS_SET_SECS_NSECS (TIME, SECS, NSECS) sets both components of TIME. */ -#define EMACS_SECS(time) ((time).tv_sec + 0) -#define EMACS_NSECS(time) ((time).tv_nsec + 0) -#define EMACS_SECS_ADDR(time) (&(time).tv_sec) -#define EMACS_SET_SECS(time, seconds) ((time).tv_sec = (seconds)) -#define EMACS_SET_NSECS(time, ns) ((time).tv_nsec = (ns)) -#define EMACS_SET_SECS_NSECS(time, s, ns) \ - ((void) (EMACS_SET_SECS (time, s), EMACS_SET_NSECS (time, ns))) - -/* Convenience macros for older code that counts microseconds. */ -#define EMACS_SET_USECS(time, us) ((void) EMACS_SET_NSECS (time, (us) * 1000)) -#define EMACS_SET_SECS_USECS(time, secs, usecs) \ - (EMACS_SET_SECS (time, secs), EMACS_SET_USECS (time, usecs)) - -/* Set TIME to an invalid time stamp. */ -#define EMACS_SET_INVALID_TIME(time) EMACS_SET_SECS_NSECS(time, 0, -1) - -/* Set TIME to the current system time. */ -#define EMACS_GET_TIME(time) gettime (&(time)) - -/* Put into DEST the result of adding SRC1 to SRC2, or of subtracting - SRC2 from SRC1. On overflow, store an extremal value: ergo, if - time_t is unsigned, return 0 if the true answer would be negative. */ -#define EMACS_ADD_TIME(dest, src1, src2) ((dest) = timespec_add (src1, src2)) -#define EMACS_SUB_TIME(dest, src1, src2) ((dest) = timespec_sub (src1, src2)) +enum { EMACS_TIME_RESOLUTION = 1000000000 }; +enum { LOG10_EMACS_TIME_RESOLUTION = 9 }; + +/* EMACS_SECS (TIME) is the seconds component of TIME. + EMACS_NSECS (TIME) is the nanoseconds component of TIME. + emacs_secs_addr (PTIME) is the address of *PTIME's seconds component. */ +static inline time_t EMACS_SECS (EMACS_TIME t) { return t.tv_sec; } +static inline int EMACS_NSECS (EMACS_TIME t) { return t.tv_nsec; } +static inline time_t *emacs_secs_addr (EMACS_TIME *t) { return &t->tv_sec; } + +/* Return an Emacs time with seconds S and nanoseconds NS. */ +static inline EMACS_TIME +make_emacs_time (time_t s, int ns) +{ + EMACS_TIME r = { s, ns }; + return r; +} + +/* Return an invalid Emacs time. */ +static inline EMACS_TIME +invalid_emacs_time (void) +{ + EMACS_TIME r = { 0, -1 }; + return r; +} + +/* Return current system time. */ +static inline EMACS_TIME +current_emacs_time (void) +{ + EMACS_TIME r; + gettime (&r); + return r; +} + +/* Return the result of adding A to B, or of subtracting B from A. + On overflow, store an extremal value: ergo, if time_t is unsigned, + return 0 if the true answer would be negative. */ +static inline EMACS_TIME +add_emacs_time (EMACS_TIME a, EMACS_TIME b) +{ + return timespec_add (a, b); +} +static inline EMACS_TIME +sub_emacs_time (EMACS_TIME a, EMACS_TIME b) +{ + return timespec_sub (a, b); +} /* Return the sign of the valid time stamp TIME, either -1, 0, or 1. */ -#define EMACS_TIME_SIGN(time) timespec_sign (time) +static inline int +EMACS_TIME_SIGN (EMACS_TIME t) +{ + return timespec_sign (t); +} /* Return 1 if TIME is a valid time stamp. */ -#define EMACS_TIME_VALID_P(time) (0 <= (time).tv_nsec) +static inline int +EMACS_TIME_VALID_P (EMACS_TIME t) +{ + return 0 <= t.tv_nsec; +} /* Convert the double D to the greatest EMACS_TIME not greater than D. On overflow, return an extremal value. Return the minimum EMACS_TIME if D is not a number. */ -#define EMACS_TIME_FROM_DOUBLE(d) dtotimespec (d) +static inline EMACS_TIME +EMACS_TIME_FROM_DOUBLE (double d) +{ + return dtotimespec (d); +} /* Convert the Emacs time T to an approximate double value D. */ -#define EMACS_TIME_TO_DOUBLE(t) timespectod (t) +static inline double +EMACS_TIME_TO_DOUBLE (EMACS_TIME t) +{ + return timespectod (t); +} /* defined in sysdep.c */ extern int set_file_times (int, const char *, EMACS_TIME, EMACS_TIME); @@ -118,12 +145,35 @@ #endif /* Compare times T1 and T2 for equality, inequality etc. */ - -#define EMACS_TIME_EQ(T1, T2) (timespec_cmp (T1, T2) == 0) -#define EMACS_TIME_NE(T1, T2) (timespec_cmp (T1, T2) != 0) -#define EMACS_TIME_GT(T1, T2) (timespec_cmp (T1, T2) > 0) -#define EMACS_TIME_GE(T1, T2) (timespec_cmp (T1, T2) >= 0) -#define EMACS_TIME_LT(T1, T2) (timespec_cmp (T1, T2) < 0) -#define EMACS_TIME_LE(T1, T2) (timespec_cmp (T1, T2) <= 0) +static inline int +EMACS_TIME_EQ (EMACS_TIME t1, EMACS_TIME t2) +{ + return timespec_cmp (t1, t2) == 0; +} +static inline int +EMACS_TIME_NE (EMACS_TIME t1, EMACS_TIME t2) +{ + return timespec_cmp (t1, t2) != 0; +} +static inline int +EMACS_TIME_GT (EMACS_TIME t1, EMACS_TIME t2) +{ + return timespec_cmp (t1, t2) > 0; +} +static inline int +EMACS_TIME_GE (EMACS_TIME t1, EMACS_TIME t2) +{ + return timespec_cmp (t1, t2) >= 0; +} +static inline int +EMACS_TIME_LT (EMACS_TIME t1, EMACS_TIME t2) +{ + return timespec_cmp (t1, t2) < 0; +} +static inline int +EMACS_TIME_LE (EMACS_TIME t1, EMACS_TIME t2) +{ + return timespec_cmp (t1, t2) <= 0; +} #endif /* EMACS_SYSTIME_H */ === modified file 'src/undo.c' --- src/undo.c 2012-07-07 01:57:42 +0000 +++ src/undo.c 2012-07-10 23:24:36 +0000 @@ -517,9 +517,9 @@ && CONSP (XCDR (XCDR (XCDR (cdr)))) && INTEGERP (XCAR (XCDR (XCDR (XCDR (cdr))))) && XINT (XCAR (XCDR (XCDR (XCDR (cdr))))) < 0) - EMACS_SET_SECS_NSECS - (mod_time, 0, - XINT (XCAR (XCDR (XCDR (XCDR (cdr))))) / 1000); + mod_time = + (make_emacs_time + (0, XINT (XCAR (XCDR (XCDR (XCDR (cdr))))) / 1000)); else mod_time = lisp_time_argument (cdr); === modified file 'src/w32.c' --- src/w32.c 2012-07-05 06:32:41 +0000 +++ src/w32.c 2012-07-10 23:24:36 +0000 @@ -1969,7 +1969,7 @@ changed. We could fix that by using GetSystemTime and GetTimeZoneInformation, but that doesn't seem necessary, since Emacs always calls gettimeofday with the 2nd argument NULL (see - EMACS_GET_TIME). */ + current_emacs_time). */ if (tz) { tz->tz_minuteswest = tb.timezone; /* minutes west of Greenwich */ === modified file 'src/xdisp.c' --- src/xdisp.c 2012-07-10 21:48:34 +0000 +++ src/xdisp.c 2012-07-10 23:24:36 +0000 @@ -29308,14 +29308,14 @@ if (INTEGERP (Vhourglass_delay) && XINT (Vhourglass_delay) > 0) - EMACS_SET_SECS_NSECS (delay, - min (XINT (Vhourglass_delay), TYPE_MAXIMUM (time_t)), - 0); + delay = make_emacs_time (min (XINT (Vhourglass_delay), + TYPE_MAXIMUM (time_t)), + 0); else if (FLOATP (Vhourglass_delay) && XFLOAT_DATA (Vhourglass_delay) > 0) delay = EMACS_TIME_FROM_DOUBLE (XFLOAT_DATA (Vhourglass_delay)); else - EMACS_SET_SECS_NSECS (delay, DEFAULT_HOURGLASS_DELAY, 0); + delay = make_emacs_time (DEFAULT_HOURGLASS_DELAY, 0); hourglass_atimer = start_atimer (ATIMER_RELATIVE, delay, show_hourglass, NULL); === modified file 'src/xgselect.c' --- src/xgselect.c 2012-07-05 18:35:48 +0000 +++ src/xgselect.c 2012-07-10 23:24:36 +0000 @@ -88,8 +88,8 @@ if (tmo_in_millisec >= 0) { - EMACS_SET_SECS_USECS (tmo, tmo_in_millisec/1000, - 1000 * (tmo_in_millisec % 1000)); + tmo = make_emacs_time (tmo_in_millisec / 1000, + 1000 * 1000 * (tmo_in_millisec % 1000)); if (!timeout || EMACS_TIME_LT (tmo, *timeout)) tmop = &tmo; } === modified file 'src/xterm.c' --- src/xterm.c 2012-07-10 08:43:46 +0000 +++ src/xterm.c 2012-07-10 23:24:36 +0000 @@ -3168,26 +3168,22 @@ x_flush (f); { - EMACS_TIME wakeup, delay; - - EMACS_GET_TIME (wakeup); - EMACS_SET_SECS_NSECS (delay, 0, 150 * 1000 * 1000); - EMACS_ADD_TIME (wakeup, wakeup, delay); + EMACS_TIME delay = make_emacs_time (0, 150 * 1000 * 1000); + EMACS_TIME wakeup = add_emacs_time (current_emacs_time (), delay); /* Keep waiting until past the time wakeup or any input gets available. */ while (! detect_input_pending ()) { - EMACS_TIME current, timeout; - - EMACS_GET_TIME (current); + EMACS_TIME current = current_emacs_time (); + EMACS_TIME timeout; /* Break if result would not be positive. */ if (EMACS_TIME_LE (wakeup, current)) break; /* How long `select' should wait. */ - EMACS_SET_SECS_NSECS (timeout, 0, 10 * 1000 * 1000); + timeout = make_emacs_time (0, 10 * 1000 * 1000); /* Try to wait that long--but we might wake up sooner. */ pselect (0, NULL, NULL, NULL, &timeout, NULL); @@ -8810,9 +8806,8 @@ /* Set timeout to 0.1 second. Hopefully not noticeable. Maybe it should be configurable. */ - EMACS_SET_SECS_USECS (tmo, 0, 100000); - EMACS_GET_TIME (tmo_at); - EMACS_ADD_TIME (tmo_at, tmo_at, tmo); + tmo = make_emacs_time (0, 100 * 1000 * 1000); + tmo_at = add_emacs_time (current_emacs_time (), tmo); while (pending_event_wait.eventtype) { @@ -8825,11 +8820,11 @@ FD_ZERO (&fds); FD_SET (fd, &fds); - EMACS_GET_TIME (time_now); + time_now = current_emacs_time (); if (EMACS_TIME_LT (tmo_at, time_now)) break; - EMACS_SUB_TIME (tmo, tmo_at, time_now); + tmo = sub_emacs_time (tmo_at, time_now); if (pselect (fd + 1, &fds, NULL, NULL, &tmo, NULL) == 0) break; /* Timeout */ } @@ -10602,9 +10597,7 @@ BLOCK_INPUT; if (!x_timeout_atimer_activated_flag) { - EMACS_TIME interval; - - EMACS_SET_SECS_USECS (interval, 0, 100000); + EMACS_TIME interval = make_emacs_time (0, 100 * 1000 * 1000); start_atimer (ATIMER_RELATIVE, interval, x_process_timeouts, 0); x_timeout_atimer_activated_flag = 1; } ------------------------------------------------------------ revno: 109005 committer: Paul Eggert branch nick: trunk timestamp: Tue 2012-07-10 15:40:34 -0700 message: * bytecode.c (targets): Suppress -Woverride-init warnings. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-10 21:48:34 +0000 +++ src/ChangeLog 2012-07-10 22:40:34 +0000 @@ -1,5 +1,7 @@ 2012-07-10 Paul Eggert + * bytecode.c (targets): Suppress -Woverride-init warnings. + Simplify by avoiding confusing use of strncpy etc. * doc.c (Fsnarf_documentation): * fileio.c (Ffile_name_directory, Fsubstitute_in_file_name): === modified file 'src/bytecode.c' --- src/bytecode.c 2012-07-10 14:25:22 +0000 +++ src/bytecode.c 2012-07-10 22:40:34 +0000 @@ -660,6 +660,11 @@ the table clearer. */ #define LABEL(OP) [OP] = &&insn_ ## OP +#if (__GNUC__ == 4 && 6 <= __GNUC_MINOR__) || 4 < __GNUC__ +# pragma GCC diagnostic push +# pragma GCC diagnostic ignored "-Woverride-init" +#endif + /* This is the dispatch table for the threaded interpreter. */ static const void *const targets[256] = { @@ -670,6 +675,11 @@ BYTE_CODES #undef DEFINE }; + +#if (__GNUC__ == 4 && 6 <= __GNUC_MINOR__) || 4 < __GNUC__ +# pragma GCC diagnostic pop +#endif + #endif ------------------------------------------------------------ revno: 109004 committer: Glenn Morris branch nick: trunk timestamp: Tue 2012-07-10 18:38:06 -0400 message: NEWS copyedits diff: === modified file 'etc/NEWS' --- etc/NEWS 2012-07-10 00:57:55 +0000 +++ etc/NEWS 2012-07-10 22:38:06 +0000 @@ -189,8 +189,9 @@ *** `desktop-path' no longer includes the "." directory. Desktop files are now located in ~/.emacs.d by default. -** A new mode for Python. -This provides several new features, including: +** Python mode + +A new version of python.el, which provides several new features, including: per-buffer shells, better indentation, Python 3 support, and improved shell-interaction compatible with iPython (and virtually any other text based shell). @@ -243,11 +244,15 @@ python-switch-to-python | python-shell-switch-to-shell python-describe-symbol | python-eldoc-at-point -** VHDL-mode -- Support for ghdl (free vhdl compiler). Now default. -- Add/update support for VHDL-AMS packages. -- Update to VHDL'02 standard. -- Accept \r and \f as whitespace. +** VHDL mode + +*** The free software compiler GHDL is supported (and now the default). + +*** Support for the VHDL-AMS packages has been added/updated. + +*** Updated to the 2002 revision of the VHDL standard. + +*** Accepts \r and \f as whitespace. ** Diff mode ------------------------------------------------------------ revno: 109003 committer: Paul Eggert branch nick: trunk timestamp: Tue 2012-07-10 14:48:34 -0700 message: Simplify by avoiding confusing use of strncpy etc. diff: === modified file 'lib-src/ChangeLog' --- lib-src/ChangeLog 2012-07-09 16:38:45 +0000 +++ lib-src/ChangeLog 2012-07-10 21:48:34 +0000 @@ -1,3 +1,22 @@ +2012-07-10 Paul Eggert + + Simplify by avoiding confusing use of strncpy etc. + * etags.c (write_classname, C_entries): + Use sprintf rather than strncpy or strncat. + * etags.c (consider_token, C_entries, HTML_labels, Prolog_functions) + (Erlang_functions, substitute, readline_internal, savenstr): + * movemail.c (mail_spool_name): + Use memcpy rather than strncpy or strncat when either will do. + * make-docfile.c (write_c_args): + Use memcmp rather than strncmp when either will do. + * movemail.c (pop_retr): + * pop.c (pop_stat, pop_list, pop_multi_first, pop_last) + (socket_connection, pop_getline, sendline, getok): + Use snprintf rather than strncpy or strncat. + * movemail.c (concat): Remove; no longer needed. + (xmalloc): Define only if needed, now that concat has gone away. + Return void *. All uses changed. + 2012-07-09 Paul Eggert Add GCC-style 'const' attribute to functions that can use it. === modified file 'lib-src/etags.c' --- lib-src/etags.c 2012-07-09 16:38:45 +0000 +++ lib-src/etags.c 2012-07-10 21:48:34 +0000 @@ -2642,17 +2642,11 @@ } for (i = 1; i < cstack.nl; i++) { - char *s; - int slen; - - s = cstack.cname[i]; + char *s = cstack.cname[i]; if (s == NULL) continue; - slen = strlen (s); - len += slen + qlen; - linebuffer_setlen (cn, len); - strncat (cn->buffer, qualifier, qlen); - strncat (cn->buffer, s, slen); + linebuffer_setlen (cn, len + qlen + strlen (s)); + len += sprintf (cn->buffer + len, "%s%s", qualifier, s); } } @@ -2867,7 +2861,7 @@ fvdef = fvnone; objdef = omethodtag; linebuffer_setlen (&token_name, len); - strncpy (token_name.buffer, str, len); + memcpy (token_name.buffer, str, len); token_name.buffer[len] = '\0'; return TRUE; } @@ -2879,10 +2873,11 @@ case omethodparm: if (parlev == 0) { + int oldlen = token_name.len; fvdef = fvnone; objdef = omethodtag; - linebuffer_setlen (&token_name, token_name.len + len); - strncat (token_name.buffer, str, len); + linebuffer_setlen (&token_name, oldlen + len); + memcpy (token_name.buffer + oldlen, str, len); return TRUE; } return FALSE; @@ -3311,12 +3306,12 @@ && nestlev > 0 && definedef == dnone) /* in struct body */ { + int len; write_classname (&token_name, qualifier); - linebuffer_setlen (&token_name, - token_name.len+qlen+toklen); - strcat (token_name.buffer, qualifier); - strncat (token_name.buffer, - newlb.buffer + tokoff, toklen); + len = token_name.len; + linebuffer_setlen (&token_name, len+qlen+toklen); + sprintf (token_name.buffer + len, "%s%.*s", + qualifier, toklen, newlb.buffer + tokoff); token.named = TRUE; } else if (objdef == ocatseen) @@ -3324,11 +3319,8 @@ { int len = strlen (objtag) + 2 + toklen; linebuffer_setlen (&token_name, len); - strcpy (token_name.buffer, objtag); - strcat (token_name.buffer, "("); - strncat (token_name.buffer, - newlb.buffer + tokoff, toklen); - strcat (token_name.buffer, ")"); + sprintf (token_name.buffer, "%s(%.*s)", + objtag, toklen, newlb.buffer + tokoff); token.named = TRUE; } else if (objdef == omethodtag @@ -3352,8 +3344,8 @@ len -= 1; } linebuffer_setlen (&token_name, len); - strncpy (token_name.buffer, - newlb.buffer + off, len); + memcpy (token_name.buffer, + newlb.buffer + off, len); token_name.buffer[len] = '\0'; if (defun) while (--len >= 0) @@ -3364,8 +3356,8 @@ else { linebuffer_setlen (&token_name, toklen); - strncpy (token_name.buffer, - newlb.buffer + tokoff, toklen); + memcpy (token_name.buffer, + newlb.buffer + tokoff, toklen); token_name.buffer[toklen] = '\0'; /* Name macros and members. */ token.named = (structdef == stagseen @@ -5161,7 +5153,7 @@ for (end = dbp; *end != '\0' && intoken (*end); end++) continue; linebuffer_setlen (&token_name, end - dbp); - strncpy (token_name.buffer, dbp, end - dbp); + memcpy (token_name.buffer, dbp, end - dbp); token_name.buffer[end - dbp] = '\0'; dbp = end; @@ -5261,7 +5253,7 @@ else if (len + 1 > allocated) xrnew (last, len + 1, char); allocated = len + 1; - strncpy (last, cp, len); + memcpy (last, cp, len); last[len] = '\0'; } } @@ -5434,7 +5426,7 @@ else if (len + 1 > allocated) xrnew (last, len + 1, char); allocated = len + 1; - strncpy (last, cp, len); + memcpy (last, cp, len); last[len] = '\0'; } } @@ -5817,7 +5809,7 @@ { dig = *out - '0'; diglen = regs->end[dig] - regs->start[dig]; - strncpy (t, in + regs->start[dig], diglen); + memcpy (t, in + regs->start[dig], diglen); t += diglen; } else @@ -6040,7 +6032,7 @@ filebuf.size *= 2; xrnew (filebuf.buffer, filebuf.size, char); } - strncpy (filebuf.buffer + filebuf.len, lbp->buffer, lbp->len); + memcpy (filebuf.buffer + filebuf.len, lbp->buffer, lbp->len); filebuf.len += lbp->len; filebuf.buffer[filebuf.len++] = '\n'; filebuf.buffer[filebuf.len] = '\0'; @@ -6263,7 +6255,7 @@ register char *dp; dp = xnew (len + 1, char); - strncpy (dp, cp, len); + memcpy (dp, cp, len); dp[len] = '\0'; return dp; } === modified file 'lib-src/make-docfile.c' --- lib-src/make-docfile.c 2012-07-06 19:50:17 +0000 +++ lib-src/make-docfile.c 2012-07-10 21:48:34 +0000 @@ -541,7 +541,7 @@ /* In C code, `default' is a reserved word, so we spell it `defalt'; demangle that here. */ - if (ident_length == 6 && strncmp (ident_start, "defalt", 6) == 0) + if (ident_length == 6 && memcmp (ident_start, "defalt", 6) == 0) fprintf (out, "DEFAULT"); else while (ident_length-- > 0) === modified file 'lib-src/movemail.c' --- lib-src/movemail.c 2012-06-24 17:39:14 +0000 +++ lib-src/movemail.c 2012-07-10 21:48:34 +0000 @@ -141,8 +141,9 @@ static void error (const char *s1, const char *s2, const char *s3); static _Noreturn void pfatal_with_name (char *name); static _Noreturn void pfatal_and_delete (char *name); -static char *concat (const char *s1, const char *s2, const char *s3); -static long *xmalloc (unsigned int size); +#ifdef MAIL_USE_MAILLOCK +static void *xmalloc (size_t size); +#endif #ifdef MAIL_USE_POP static int popmail (char *mailbox, char *outfile, int preserve, char *password, int reverse_order); static int pop_retr (popserver server, int msgno, FILE *arg); @@ -301,7 +302,7 @@ inname_dirlen && !IS_DIRECTORY_SEP (inname[inname_dirlen - 1]); inname_dirlen--) continue; - tempname = (char *) xmalloc (inname_dirlen + sizeof "EXXXXXX"); + tempname = xmalloc (inname_dirlen + sizeof "EXXXXXX"); while (1) { @@ -583,8 +584,8 @@ if (stat (MAILDIR, &stat1) < 0) return NULL; - indir = (char *) xmalloc (fname - inname + 1); - strncpy (indir, inname, fname - inname); + indir = xmalloc (fname - inname + 1); + memcpy (indir, inname, fname - inname); indir[fname-inname] = '\0'; @@ -644,32 +645,18 @@ fatal ("%s for %s", s, name); } -/* Return a newly-allocated string whose contents concatenate those of s1, s2, s3. */ - -static char * -concat (const char *s1, const char *s2, const char *s3) -{ - size_t len1 = strlen (s1), len2 = strlen (s2), len3 = strlen (s3); - char *result = (char *) xmalloc (len1 + len2 + len3 + 1); - - strcpy (result, s1); - strcpy (result + len1, s2); - strcpy (result + len1 + len2, s3); - *(result + len1 + len2 + len3) = 0; - - return result; -} - +#ifdef MAIL_USE_MAILLOCK /* Like malloc but get fatal error if memory is exhausted. */ -static long * -xmalloc (unsigned int size) +static void * +xmalloc (size_t size) { - long *result = (long *) malloc (size); + void *result = malloc (size); if (!result) fatal ("virtual memory exhausted", 0, 0); return result; } +#endif /* This is the guts of the interface to the Post Office Protocol. */ @@ -851,10 +838,7 @@ if (pop_retrieve_first (server, msgno, &line)) { - char *msg = concat ("Error from POP server: ", pop_error, ""); - strncpy (Errmsg, msg, sizeof (Errmsg)); - Errmsg[sizeof (Errmsg)-1] = '\0'; - free (msg); + snprintf (Errmsg, sizeof Errmsg, "Error from POP server: %s", pop_error); return (NOTOK); } @@ -873,10 +857,7 @@ if (ret) { - char *msg = concat ("Error from POP server: ", pop_error, ""); - strncpy (Errmsg, msg, sizeof (Errmsg)); - Errmsg[sizeof (Errmsg)-1] = '\0'; - free (msg); + snprintf (Errmsg, sizeof Errmsg, "Error from POP server: %s", pop_error); return (NOTOK); } === modified file 'lib-src/pop.c' --- lib-src/pop.c 2012-06-26 01:05:39 +0000 +++ lib-src/pop.c 2012-07-10 21:48:34 +0000 @@ -340,10 +340,7 @@ if (strncmp (fromserver, "+OK ", 4)) { if (0 == strncmp (fromserver, "-ERR", 4)) - { - strncpy (pop_error, fromserver, ERROR_MAX); - pop_error[ERROR_MAX-1] = '\0'; - } + snprintf (pop_error, ERROR_MAX, "%s", fromserver); else { strcpy (pop_error, @@ -444,10 +441,7 @@ if (strncmp (fromserver, "+OK ", 4)) { if (! strncmp (fromserver, "-ERR", 4)) - { - strncpy (pop_error, fromserver, ERROR_MAX); - pop_error[ERROR_MAX-1] = '\0'; - } + snprintf (pop_error, ERROR_MAX, "%s", fromserver); else { strcpy (pop_error, @@ -686,8 +680,7 @@ if (0 == strncmp (*response, "-ERR", 4)) { - strncpy (pop_error, *response, ERROR_MAX); - pop_error[ERROR_MAX-1] = '\0'; + snprintf (pop_error, ERROR_MAX, "%s", *response); return (-1); } else if (0 == strncmp (*response, "+OK", 3)) @@ -860,8 +853,7 @@ if (! strncmp (fromserver, "-ERR", 4)) { - strncpy (pop_error, fromserver, ERROR_MAX); - pop_error[ERROR_MAX-1] = '\0'; + snprintf (pop_error, ERROR_MAX, "%s", fromserver); return (-1); } else if (strncmp (fromserver, "+OK ", 4)) @@ -1061,9 +1053,8 @@ sock = socket (PF_INET, SOCK_STREAM, 0); if (sock < 0) { - strcpy (pop_error, POP_SOCKET_ERROR); - strncat (pop_error, strerror (errno), - ERROR_MAX - sizeof (POP_SOCKET_ERROR)); + snprintf (pop_error, ERROR_MAX, "%s%s", + POP_SOCKET_ERROR, strerror (errno)); return (-1); } @@ -1139,9 +1130,7 @@ if (! connect_ok) { CLOSESOCKET (sock); - strcpy (pop_error, CONNECT_ERROR); - strncat (pop_error, strerror (errno), - ERROR_MAX - sizeof (CONNECT_ERROR)); + snprintf (pop_error, ERROR_MAX, "%s%s", CONNECT_ERROR, strerror (errno)); return (-1); } @@ -1159,9 +1148,8 @@ krb5_auth_con_free (kcontext, auth_context); if (kcontext) krb5_free_context (kcontext); - strcpy (pop_error, KRB_ERROR); - strncat (pop_error, error_message (rem), - ERROR_MAX - sizeof (KRB_ERROR)); + snprintf (pop_error, ERROR_MAX, "%s%s", + KRB_ERROR, error_message (rem)); CLOSESOCKET (sock); return (-1); } @@ -1199,30 +1187,19 @@ krb5_free_principal (kcontext, server); if (rem) { - strcpy (pop_error, KRB_ERROR); - strncat (pop_error, error_message (rem), - ERROR_MAX - sizeof (KRB_ERROR)); + int pop_error_len = snprintf (pop_error, ERROR_MAX, "%s%s", + KRB_ERROR, error_message (rem)); #if defined HAVE_KRB5_ERROR_TEXT if (err_ret && err_ret->text.length) { - strncat (pop_error, " [server says '", - ERROR_MAX - strlen (pop_error) - 1); - strncat (pop_error, err_ret->text.data, - min (ERROR_MAX - strlen (pop_error) - 1, - err_ret->text.length)); - strncat (pop_error, "']", - ERROR_MAX - strlen (pop_error) - 1); + int errlen = err_ret->text.length; + snprintf (pop_error + pop_error_len, ERROR_MAX - pop_error_len, + " [server says '.*%s']", errlen, err_ret->text.data); } #elif defined HAVE_KRB5_ERROR_E_TEXT - if (err_ret && err_ret->e_text && strlen (*err_ret->e_text)) - { - strncat (pop_error, " [server says '", - ERROR_MAX - strlen (pop_error) - 1); - strncat (pop_error, *err_ret->e_text, - ERROR_MAX - strlen (pop_error) - 1); - strncat (pop_error, "']", - ERROR_MAX - strlen (pop_error) - 1); - } + if (err_ret && err_ret->e_text && **err_ret->e_text) + snprintf (pop_error + pop_error_len, ERRMAX - pop_error_len, + " [server says '%s']", *err_ret->e_text); #endif if (err_ret) krb5_free_error (kcontext, err_ret); @@ -1243,9 +1220,7 @@ free ((char *) ticket); if (rem != KSUCCESS) { - strcpy (pop_error, KRB_ERROR); - strncat (pop_error, krb_err_txt[rem], - ERROR_MAX - sizeof (KRB_ERROR)); + snprintf (pop_error, ERROR_MAX, "%s%s", KRB_ERROR, krb_err_txt[rem]); CLOSESOCKET (sock); return (-1); } @@ -1350,9 +1325,8 @@ server->buffer_size - server->data - 1, 0); if (ret < 0) { - strcpy (pop_error, GETLINE_ERROR); - strncat (pop_error, strerror (errno), - ERROR_MAX - sizeof (GETLINE_ERROR)); + snprintf (pop_error, ERROR_MAX, "%s%s", + GETLINE_ERROR, strerror (errno)); pop_trash (server); return (-1); } @@ -1436,9 +1410,7 @@ if (ret < 0) { pop_trash (server); - strcpy (pop_error, SENDLINE_ERROR); - strncat (pop_error, strerror (errno), - ERROR_MAX - sizeof (SENDLINE_ERROR)); + snprintf (pop_error, ERROR_MAX, "%s%s", SENDLINE_ERROR, strerror (errno)); return (ret); } @@ -1500,8 +1472,7 @@ return (0); else if (! strncmp (fromline, "-ERR", 4)) { - strncpy (pop_error, fromline, ERROR_MAX); - pop_error[ERROR_MAX-1] = '\0'; + snprintf (pop_error, ERROR_MAX, "%s", fromline); return (-1); } else === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-10 19:04:14 +0000 +++ src/ChangeLog 2012-07-10 21:48:34 +0000 @@ -1,3 +1,37 @@ +2012-07-10 Paul Eggert + + Simplify by avoiding confusing use of strncpy etc. + * doc.c (Fsnarf_documentation): + * fileio.c (Ffile_name_directory, Fsubstitute_in_file_name): + * frame.c (Fmake_terminal_frame): + * gtkutil.c (get_utf8_string): + * lread.c (openp): + * nsmenu.m (ns_update_menubar): + * regex.c (regerror): + Prefer memcpy to strncpy and strncat when either will do. + * fileio.c (Fsubstitute_in_file_name): + * keyboard.c (MULTI_LETTER_MOD, parse_modifiers_uncached) + (menu_separator_name_p): + * nsmenu.m (ns_update_menubar): + Prefer memcmp to strncmp when either will do. + * nsterm.m: Include . + (ns_get_color): + * s/gnu-linux.h, s/sol2-6.h, s/unixware.h (PTY_TTY_NAME_SPRINTF): + Prefer snprintf to strncpy. + * nsterm.m (ns_term_init): + * widget.c (set_frame_size) [0]: Prefer xstrdup to xmalloc + strncpy. + * nsterm.m (ns_term_init): + Avoid the need for strncpy, by using build_string or + make_unibyte_string directly. Use dtoastr, not snprintf. + * process.c (Fmake_network_process): Diagnose service names that + are too long, rather than silently truncating them or creating + non-null-terminated names. + (Fnetwork_interface_info): Likewise, for interface names. + * sysdep.c (system_process_attributes) [GNU_LINUX]: + Prefer sprintf to strncat. + * xdisp.c (debug_method_add) [GLYPH_DEBUG]: + Prefer vsnprintf to vsprintf + strncpy. + 2012-07-10 Glenn Morris * dispnew.c (PENDING_OUTPUT_COUNT) [!__GNU_LIBRARY__]: === modified file 'src/doc.c' --- src/doc.c 2012-07-10 16:53:26 +0000 +++ src/doc.c 2012-07-10 21:48:34 +0000 @@ -645,7 +645,7 @@ { ptrdiff_t len = end - p - 2; char *fromfile = alloca (len + 1); - strncpy (fromfile, &p[2], len); + memcpy (fromfile, &p[2], len); fromfile[len] = 0; if (fromfile[len-1] == 'c') fromfile[len-1] = 'o'; === modified file 'src/fileio.c' --- src/fileio.c 2012-07-10 08:43:46 +0000 +++ src/fileio.c 2012-07-10 21:48:34 +0000 @@ -365,7 +365,7 @@ if (p == beg + 4 && IS_DIRECTORY_SEP (*beg) && beg[1] == ':') { - strncpy (res, beg, 2); + memcpy (res, beg, 2); beg += 2; r += 2; } @@ -1648,7 +1648,7 @@ /* Copy out the variable name. */ target = alloca (s - o + 1); - strncpy (target, o, s - o); + memcpy (target, o, s - o); target[s - o] = 0; #ifdef DOS_NT strupr (target); /* $home == $HOME etc. */ @@ -1711,7 +1711,7 @@ /* Copy out the variable name. */ target = alloca (s - o + 1); - strncpy (target, o, s - o); + memcpy (target, o, s - o); target[s - o] = 0; #ifdef DOS_NT strupr (target); /* $home == $HOME etc. */ @@ -1732,13 +1732,13 @@ orig = make_unibyte_string (o, orig_length); decoded = DECODE_FILE (orig); decoded_length = SBYTES (decoded); - strncpy (x, SSDATA (decoded), decoded_length); + memcpy (x, SDATA (decoded), decoded_length); x += decoded_length; /* If environment variable needed decoding, return value needs to be multibyte. */ if (decoded_length != orig_length - || strncmp (SSDATA (decoded), o, orig_length)) + || memcmp (SDATA (decoded), o, orig_length)) multibyte = 1; } } === modified file 'src/frame.c' --- src/frame.c 2012-07-10 16:53:26 +0000 +++ src/frame.c 2012-07-10 21:48:34 +0000 @@ -646,7 +646,7 @@ if (!NILP (tty)) { name = alloca (SBYTES (tty) + 1); - strncpy (name, SSDATA (tty), SBYTES (tty)); + memcpy (name, SSDATA (tty), SBYTES (tty)); name[SBYTES (tty)] = 0; } @@ -657,7 +657,7 @@ if (!NILP (tty_type)) { type = alloca (SBYTES (tty_type) + 1); - strncpy (type, SSDATA (tty_type), SBYTES (tty_type)); + memcpy (type, SSDATA (tty_type), SBYTES (tty_type)); type[SBYTES (tty_type)] = 0; } === modified file 'src/gtkutil.c' --- src/gtkutil.c 2012-07-06 15:02:29 +0000 +++ src/gtkutil.c 2012-07-10 21:48:34 +0000 @@ -529,7 +529,7 @@ &bytes_written, &err)) && err->code == G_CONVERT_ERROR_ILLEGAL_SEQUENCE) { - strncpy (up, (char *)p, bytes_written); + memcpy (up, p, bytes_written); sprintf (up + bytes_written, "\\%03o", p[bytes_written]); up += bytes_written+4; p += bytes_written+1; === modified file 'src/keyboard.c' --- src/keyboard.c 2012-07-10 08:43:46 +0000 +++ src/keyboard.c 2012-07-10 21:48:34 +0000 @@ -6134,7 +6134,7 @@ #define MULTI_LETTER_MOD(BIT, NAME, LEN) \ if (i + LEN + 1 <= SBYTES (name) \ - && ! strncmp (SSDATA (name) + i, NAME, LEN)) \ + && ! memcmp (SDATA (name) + i, NAME, LEN)) \ { \ this_mod_end = i + LEN; \ this_mod = BIT; \ @@ -6172,13 +6172,13 @@ if (! (modifiers & (down_modifier | drag_modifier | double_modifier | triple_modifier)) && i + 7 == SBYTES (name) - && strncmp (SSDATA (name) + i, "mouse-", 6) == 0 + && memcmp (SDATA (name) + i, "mouse-", 6) == 0 && ('0' <= SREF (name, i + 6) && SREF (name, i + 6) <= '9')) modifiers |= click_modifier; if (! (modifiers & (double_modifier | triple_modifier)) && i + 6 < SBYTES (name) - && strncmp (SSDATA (name) + i, "wheel-", 6) == 0) + && memcmp (SDATA (name) + i, "wheel-", 6) == 0) modifiers |= click_modifier; if (modifier_end) @@ -6630,7 +6630,7 @@ #define MULTI_LETTER_MOD(BIT, NAME, LEN) \ if (LEN == SBYTES (name) \ - && ! strncmp (SSDATA (name), NAME, LEN)) \ + && ! memcmp (SDATA (name), NAME, LEN)) \ return BIT; case 'A': @@ -7418,7 +7418,7 @@ if (!label) return 0; else if (strlen (label) > 3 - && strncmp (label, "--", 2) == 0 + && memcmp (label, "--", 2) == 0 && label[2] != '-') { int i; === modified file 'src/lread.c' --- src/lread.c 2012-07-10 08:43:46 +0000 +++ src/lread.c 2012-07-10 21:48:34 +0000 @@ -1495,26 +1495,14 @@ /* Concatenate path element/specified name with the suffix. If the directory starts with /:, remove that. */ - if (SCHARS (filename) > 2 - && SREF (filename, 0) == '/' - && SREF (filename, 1) == ':') - { - fnlen = SBYTES (filename) - 2; - strncpy (fn, SSDATA (filename) + 2, fnlen); - fn[fnlen] = '\0'; - } - else - { - fnlen = SBYTES (filename); - strncpy (fn, SSDATA (filename), fnlen); - fn[fnlen] = '\0'; - } - - if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */ - { - strncat (fn, SSDATA (XCAR (tail)), lsuffix); - fnlen += lsuffix; - } + int prefixlen = ((SCHARS (filename) > 2 + && SREF (filename, 0) == '/' + && SREF (filename, 1) == ':') + ? 2 : 0); + fnlen = SBYTES (filename) - prefixlen; + memcpy (fn, SDATA (filename) + prefixlen, fnlen); + memcpy (fn + fnlen, SDATA (XCAR (tail)), lsuffix + 1); + fnlen += lsuffix; /* Check that the file exists and is not a directory. */ /* We used to only check for handlers on non-absolute file names: if (absolute) === modified file 'src/nsmenu.m' --- src/nsmenu.m 2012-07-05 18:35:48 +0000 +++ src/nsmenu.m 2012-07-10 21:48:34 +0000 @@ -426,7 +426,8 @@ break; else continue; - if (strncmp (previous_strings[i], SDATA (string), 10)) + if (memcmp (previous_strings[i], SDATA (string), + min (10, SBYTES (string) + 1))) break; } @@ -447,7 +448,8 @@ break; if (n < 100) - strncpy (previous_strings[i/4], SDATA (string), 10); + memcpy (previous_strings[i/4], min (10, SBYTES (string) + 1), + SDATA (string)); wv = xmalloc_widget_value (); wv->name = SSDATA (string); === modified file 'src/nsterm.m' --- src/nsterm.m 2012-07-10 01:25:07 +0000 +++ src/nsterm.m 2012-07-10 21:48:34 +0000 @@ -37,6 +37,7 @@ #include #include #include +#include #include "lisp.h" #include "blockinput.h" @@ -1442,21 +1443,16 @@ [scanner scanFloat: &b]; } else if (!strncmp(name, "rgb:", 4)) /* A newer X11 format -- rgb:r/g/b */ - { - strncpy (hex, name + 4, 19); - hex[19] = '\0'; - scaling = (strlen(hex) - 2) / 3; - } + scaling = (snprintf (hex, sizeof hex, "%s", name + 4) - 2) / 3; else if (name[0] == '#') /* An old X11 format; convert to newer */ { int len = (strlen(name) - 1); int start = (len % 3 == 0) ? 1 : len / 4 + 1; int i; scaling = strlen(name+start) / 3; - for (i=0; i<3; i++) { - strncpy(hex + i * (scaling + 1), name + start + i * scaling, scaling); - hex[(i+1) * (scaling + 1) - 1] = '/'; - } + for (i = 0; i < 3; i++) + snprintf (hex + i * (scaling + 1), "%.*s/", scaling, + name + start + i * scaling); hex[3 * (scaling + 1) - 1] = '\0'; } @@ -4107,10 +4103,7 @@ ns_display_name_list); dpyinfo->name_list_element = XCAR (ns_display_name_list); - /* Set the name of the terminal. */ - terminal->name = xmalloc (SBYTES (display_name) + 1); - strncpy (terminal->name, SDATA (display_name), SBYTES (display_name)); - terminal->name[SBYTES (display_name)] = 0; + terminal->name = xstrdup (SSDATA (display_name)); UNBLOCK_INPUT; @@ -4167,14 +4160,14 @@ } { - char c[128]; #ifdef NS_IMPL_GNUSTEP - strncpy (c, gnustep_base_version, sizeof (c)); + Vwindow_system_version = build_string (gnustep_base_version); #else /*PSnextrelease (128, c); */ - snprintf (c, sizeof (c), "%g", NSAppKitVersionNumber); + char c[DBL_BUFSIZE_BOUND]; + int len = dtoastr (c, sizeof c, 0, 0, NSAppKitVersionNumber); + Vwindow_system_version = make_unibyte_string (c, len); #endif - Vwindow_system_version = build_string (c); } delete_keyboard_wait_descriptor (0); === modified file 'src/process.c' --- src/process.c 2012-07-09 21:12:08 +0000 +++ src/process.c 2012-07-10 21:48:34 +0000 @@ -3013,7 +3013,9 @@ CHECK_STRING (service); memset (&address_un, 0, sizeof address_un); address_un.sun_family = AF_LOCAL; - strncpy (address_un.sun_path, SSDATA (service), sizeof address_un.sun_path); + if (sizeof address_un.sun_path <= SBYTES (service)) + error ("Service name too long"); + strcpy (address_un.sun_path, SSDATA (service)); ai.ai_addr = (struct sockaddr *) &address_un; ai.ai_addrlen = sizeof address_un; goto open_socket; @@ -3717,8 +3719,9 @@ CHECK_STRING (ifname); - memset (rq.ifr_name, 0, sizeof rq.ifr_name); - strncpy (rq.ifr_name, SSDATA (ifname), sizeof (rq.ifr_name)); + if (sizeof rq.ifr_name <= SBYTES (ifname)) + error ("interface name too long"); + strcpy (rq.ifr_name, SSDATA (ifname)); s = socket (AF_INET, SOCK_STREAM, 0); if (s < 0) === modified file 'src/regex.c' --- src/regex.c 2012-07-05 18:35:48 +0000 +++ src/regex.c 2012-07-10 21:48:34 +0000 @@ -6644,7 +6644,7 @@ { if (msg_size > errbuf_size) { - strncpy (errbuf, msg, errbuf_size - 1); + memcpy (errbuf, msg, errbuf_size - 1); errbuf[errbuf_size - 1] = 0; } else === modified file 'src/s/gnu-linux.h' --- src/s/gnu-linux.h 2012-06-12 19:03:32 +0000 +++ src/s/gnu-linux.h 2012-07-10 21:48:34 +0000 @@ -63,8 +63,7 @@ close (fd); \ return -1; \ } \ - strncpy (pty_name, ptyname, sizeof (pty_name)); \ - pty_name[sizeof (pty_name) - 1] = 0; \ + snprintf (pty_name, sizeof pty_name, "%s", ptyname); \ sigunblock (sigmask (SIGCHLD)); \ } === modified file 'src/s/sol2-6.h' --- src/s/sol2-6.h 2012-04-14 06:18:49 +0000 +++ src/s/sol2-6.h 2012-07-10 21:48:34 +0000 @@ -54,8 +54,7 @@ { emacs_close (fd); return -1; } \ if (!(ptyname = ptsname (fd))) \ { emacs_close (fd); return -1; } \ - strncpy (pty_name, ptyname, sizeof (pty_name)); \ - pty_name[sizeof (pty_name) - 1] = 0; \ + snprintf (pty_name, sizeof pty_name, "%s", ptyname); \ } #define GC_SETJMP_WORKS 1 === modified file 'src/s/unixware.h' --- src/s/unixware.h 2012-07-10 07:37:17 +0000 +++ src/s/unixware.h 2012-07-10 21:48:34 +0000 @@ -40,8 +40,7 @@ fatal("could not unlock slave pty"); \ if (!(ptyname = ptsname(fd))) \ fatal ("could not enable slave pty"); \ - strncpy(pty_name, ptyname, sizeof(pty_name)); \ - pty_name[sizeof(pty_name) - 1] = 0; \ + snprintf (pty_name, sizeof pty_name, "%s", ptyname); \ } /* Conservative garbage collection has not been tested, so for now === modified file 'src/sysdep.c' --- src/sysdep.c 2012-07-07 18:16:15 +0000 +++ src/sysdep.c 2012-07-10 21:48:34 +0000 @@ -2744,9 +2744,11 @@ char procbuf[1025], *p, *q; int fd; ssize_t nread; - const char *cmd = NULL; + static char const default_cmd[] = "???"; + const char *cmd = default_cmd; + int cmdsize = sizeof default_cmd - 1; char *cmdline = NULL; - ptrdiff_t cmdsize = 0, cmdline_size; + ptrdiff_t cmdline_size; unsigned char c; printmax_t proc_id; int ppid, pgrp, sess, tty, tpgid, thcount; @@ -2808,11 +2810,6 @@ } else q = NULL; - if (cmd == NULL) - { - cmd = "???"; - cmdsize = 3; - } /* Command name is encoded in locale-coding-system; decode it. */ cmd_str = make_unibyte_string (cmd, cmdsize); decoded_cmd = code_convert_string_norecord (cmd_str, @@ -2950,14 +2947,9 @@ } if (!cmdline_size) { - if (!cmd) - cmd = "???"; - if (!cmdsize) - cmdsize = strlen (cmd); cmdline_size = cmdsize + 2; cmdline = xmalloc (cmdline_size + 1); - strcpy (cmdline, "["); - strcat (strncat (cmdline, cmd, cmdsize), "]"); + sprintf (cmdline, "[%.*s]", cmdsize, cmd); } emacs_close (fd); /* Command line is encoded in locale-coding-system; decode it. */ === modified file 'src/widget.c' --- src/widget.c 2012-07-05 06:32:41 +0000 +++ src/widget.c 2012-07-10 21:48:34 +0000 @@ -429,25 +429,15 @@ { /* the tricky things with the sign is to make sure that -0 is printed -0. */ - int len; - char *tem; sprintf (shell_position, "=%c%d%c%d", flags & XNegative ? '-' : '+', x < 0 ? -x : x, flags & YNegative ? '-' : '+', y < 0 ? -y : y); - len = strlen (shell_position) + 1; - tem = xmalloc (len); - strncpy (tem, shell_position, len); - XtVaSetValues (wmshell, XtNgeometry, tem, NULL); + XtVaSetValues (wmshell, XtNgeometry, xstrdup (shell_position), NULL); } else if (flags & (WidthValue | HeightValue)) { - int len; - char *tem; sprintf (shell_position, "=%dx%d", pixel_width, pixel_height); - len = strlen (shell_position) + 1; - tem = xmalloc (len); - strncpy (tem, shell_position, len); - XtVaSetValues (wmshell, XtNgeometry, tem, NULL); + XtVaSetValues (wmshell, XtNgeometry, xstrdup (shell_position), NULL); } /* If the geometry spec we're using has W/H components, mark the size === modified file 'src/xdisp.c' --- src/xdisp.c 2012-07-10 08:43:46 +0000 +++ src/xdisp.c 2012-07-10 21:48:34 +0000 @@ -12492,23 +12492,21 @@ static void debug_method_add (struct window *w, char const *fmt, ...) { - char buffer[512]; char *method = w->desired_matrix->method; int len = strlen (method); int size = sizeof w->desired_matrix->method; int remaining = size - len - 1; va_list ap; - va_start (ap, fmt); - vsprintf (buffer, fmt, ap); - va_end (ap); if (len && remaining) { method[len] = '|'; --remaining, ++len; } - strncpy (method + len, buffer, remaining); + va_start (ap, fmt); + vsnprintf (method + len, remaining + 1, fmt, ap); + va_end (ap); if (trace_redisplay_p) fprintf (stderr, "%p (%s): %s\n", @@ -12517,7 +12515,7 @@ && STRINGP (BVAR (XBUFFER (w->buffer), name))) ? SSDATA (BVAR (XBUFFER (w->buffer), name)) : "no buffer"), - buffer); + method + len); } #endif /* GLYPH_DEBUG */ ------------------------------------------------------------ revno: 109002 committer: Glenn Morris branch nick: trunk timestamp: Tue 2012-07-10 15:04:14 -0400 message: * dispnew.c (PENDING_OUTPUT_COUNT) [!__GNU_LIBRARY__]: Clarify fallback case. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-10 16:53:26 +0000 +++ src/ChangeLog 2012-07-10 19:04:14 +0000 @@ -1,3 +1,8 @@ +2012-07-10 Glenn Morris + + * dispnew.c (PENDING_OUTPUT_COUNT) [!__GNU_LIBRARY__]: + Clarify fallback case. + 2012-07-10 Dmitry Antipov Use XCAR and XCDR instead of Fcar and Fcdr where possible. === modified file 'src/dispnew.c' --- src/dispnew.c 2012-07-05 18:35:48 +0000 +++ src/dispnew.c 2012-07-10 19:04:14 +0000 @@ -65,28 +65,29 @@ /* Get number of chars of output now in the buffer of a stdio stream. This ought to be built in stdio, but it isn't. Some s- files override this because their stdio internals differ. */ - #ifdef __GNU_LIBRARY__ /* The s- file might have overridden the definition with one that works for the system's C library. But we are using the GNU C library, so this is the right definition for every system. */ - #ifdef GNU_LIBRARY_PENDING_OUTPUT_COUNT #define PENDING_OUTPUT_COUNT GNU_LIBRARY_PENDING_OUTPUT_COUNT #else #undef PENDING_OUTPUT_COUNT #define PENDING_OUTPUT_COUNT(FILE) ((FILE)->__bufp - (FILE)->__buffer) #endif -#else /* not __GNU_LIBRARY__ */ -#if !defined (PENDING_OUTPUT_COUNT) && HAVE_STDIO_EXT_H && HAVE___FPENDING + +/* not __GNU_LIBRARY__ and no PENDING_OUTPUT_COUNT defined */ +#elif !defined (PENDING_OUTPUT_COUNT) + +#if HAVE_STDIO_EXT_H && HAVE___FPENDING #include #define PENDING_OUTPUT_COUNT(FILE) __fpending (FILE) -#endif -#ifndef PENDING_OUTPUT_COUNT +#else #define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_ptr - (FILE)->_base) #endif -#endif /* not __GNU_LIBRARY__ */ + +#endif /* not __GNU_LIBRARY__ and no PENDING_OUTPUT_COUNT defined */ #if defined (HAVE_TERM_H) && defined (GNU_LINUX) #include /* for tgetent */ ------------------------------------------------------------ revno: 109001 committer: Dmitry Antipov branch nick: trunk timestamp: Tue 2012-07-10 20:53:26 +0400 message: Use XCAR and XCDR instead of Fcar and Fcdr where possible. * admin/coccinelle/list_loop.cocci: Semantic patch to convert from Fcdr to XCDR and consistently use CONSP in the list iteration loops. * admin/coccinelle/vector_contents.cocci: Fix indentation. * src/callint.c, src/coding.c, src/doc.c, src/editfns.c, src/eval.c, * src/font.c, src/fontset.c, src/frame.c, src/gnutls.c, src/minibuf.c, * src/msdos.c, src/textprop.c, src/w32fns.c, src/w32menu.c, src/window.c, * src/xmenu.c: Changed to use XCAR and XCDR where argument type is known to be a Lisp_Cons. diff: === modified file 'admin/ChangeLog' --- admin/ChangeLog 2012-07-10 11:51:54 +0000 +++ admin/ChangeLog 2012-07-10 16:53:26 +0000 @@ -1,3 +1,9 @@ +2012-07-10 Dmitry Antipov + + * coccinelle/list_loop.cocci: Semantic patch to convert from Fcdr + to XCDR and consistently use CONSP in the list iteration loops. + * coccinelle/vector_contents.cocci: Fix indentation. + 2012-07-10 Stefan Monnier * bzrmerge.el: Use cl-lib. === added file 'admin/coccinelle/list_loop.cocci' --- admin/coccinelle/list_loop.cocci 1970-01-01 00:00:00 +0000 +++ admin/coccinelle/list_loop.cocci 2012-07-10 16:53:26 +0000 @@ -0,0 +1,19 @@ +// Omit redundant type check, consistently use CONSP. +@@ +identifier A; +expression X; +statement S; +@@ +( +for (A = X; +- !NILP (A); ++ CONSP (A); +- A = Fcdr (A)) ++ A = XCDR (A)) +S +| +for (A = X; CONSP (A); +- A = Fcdr (A)) ++ A = XCDR (A)) +S +) === modified file 'admin/coccinelle/vector_contents.cocci' --- admin/coccinelle/vector_contents.cocci 2012-06-24 16:18:41 +0000 +++ admin/coccinelle/vector_contents.cocci 2012-07-10 16:53:26 +0000 @@ -11,6 +11,6 @@ - XVECTOR (I1)->contents[E1] = E2 + ASET (I1, E1, E2) | --XVECTOR (I1)->contents[E1] -+AREF (I1, E1) +- XVECTOR (I1)->contents[E1] ++ AREF (I1, E1) ) === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-10 14:25:22 +0000 +++ src/ChangeLog 2012-07-10 16:53:26 +0000 @@ -1,3 +1,11 @@ +2012-07-10 Dmitry Antipov + + Use XCAR and XCDR instead of Fcar and Fcdr where possible. + * callint.c, coding.c, doc.c, editfns.c, eval.c, font.c, fontset.c, + * frame.c, gnutls.c, minibuf.c, msdos.c, textprop.c, w32fns.c, + * w32menu.c, window.c, xmenu.c: Changed to use XCAR and XCDR + where argument type is known to be a Lisp_Cons. + 2012-07-10 Tom Tromey * bytecode.c (BYTE_CODE_THREADED): New macro. === modified file 'src/callint.c' --- src/callint.c 2012-07-05 18:35:48 +0000 +++ src/callint.c 2012-07-10 16:53:26 +0000 @@ -205,7 +205,7 @@ if (CONSP (elt)) { Lisp_Object presflag, carelt; - carelt = Fcar (elt); + carelt = XCAR (elt); /* If it is (if X Y), look at Y. */ if (EQ (carelt, Qif) && EQ (Fnthcdr (make_number (3), elt), Qnil)) === modified file 'src/coding.c' --- src/coding.c 2012-07-10 08:43:46 +0000 +++ src/coding.c 2012-07-10 16:53:26 +0000 @@ -9791,7 +9791,7 @@ val = args[coding_arg_ccl_valids]; valids = Fmake_string (make_number (256), make_number (0)); - for (tail = val; !NILP (tail); tail = Fcdr (tail)) + for (tail = val; CONSP (tail); tail = XCDR (tail)) { int from, to; @@ -9892,7 +9892,7 @@ CHECK_NUMBER_CDR (reg_usage); request = Fcopy_sequence (args[coding_arg_iso2022_request]); - for (tail = request; ! NILP (tail); tail = Fcdr (tail)) + for (tail = request; CONSP (tail); tail = XCDR (tail)) { int id; Lisp_Object tmp1; === modified file 'src/doc.c' --- src/doc.c 2012-07-05 18:35:48 +0000 +++ src/doc.c 2012-07-10 16:53:26 +0000 @@ -381,7 +381,7 @@ } else if (CONSP (fun)) { - funcar = Fcar (fun); + funcar = XCAR (fun); if (!SYMBOLP (funcar)) xsignal1 (Qinvalid_function, fun); else if (EQ (funcar, Qkeymap)) === modified file 'src/editfns.c' --- src/editfns.c 2012-07-09 12:02:27 +0000 +++ src/editfns.c 2012-07-10 16:53:26 +0000 @@ -1915,7 +1915,7 @@ tm.tm_isdst = -1; if (CONSP (zone)) - zone = Fcar (zone); + zone = XCAR (zone); if (NILP (zone)) { BLOCK_INPUT; === modified file 'src/eval.c' --- src/eval.c 2012-07-05 18:35:48 +0000 +++ src/eval.c 2012-07-10 16:53:26 +0000 @@ -2070,8 +2070,8 @@ error ("Lisp nesting exceeds `max-lisp-eval-depth'"); } - original_fun = Fcar (form); - original_args = Fcdr (form); + original_fun = XCAR (form); + original_args = XCDR (form); backtrace.next = backtrace_list; backtrace_list = &backtrace; === modified file 'src/font.c' --- src/font.c 2012-07-10 07:59:31 +0000 +++ src/font.c 2012-07-10 16:53:26 +0000 @@ -1827,7 +1827,7 @@ CHECK_CONS (otf_features); CHECK_SYMBOL (XCAR (otf_features)); otf_features = XCDR (otf_features); - for (val = Fcar (otf_features); ! NILP (val); val = Fcdr (val)) + for (val = Fcar (otf_features); CONSP (val); val = XCDR (val)) { CHECK_SYMBOL (Fcar (val)); if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4) @@ -1835,7 +1835,7 @@ SDATA (SYMBOL_NAME (XCAR (val)))); } otf_features = XCDR (otf_features); - for (val = Fcar (otf_features); ! NILP (val); val = Fcdr (val)) + for (val = Fcar (otf_features); CONSP (val); val = XCDR (val)) { CHECK_SYMBOL (Fcar (val)); if (SBYTES (SYMBOL_NAME (XCAR (val))) > 4) === modified file 'src/fontset.c' --- src/fontset.c 2012-07-10 08:43:46 +0000 +++ src/fontset.c 2012-07-10 16:53:26 +0000 @@ -1668,7 +1668,7 @@ Fset_char_table_range (fontset, Qt, Qnil); } - for (; ! NILP (fontlist); fontlist = Fcdr (fontlist)) + for (; CONSP (fontlist); fontlist = XCDR (fontlist)) { Lisp_Object elt, script; === modified file 'src/frame.c' --- src/frame.c 2012-07-10 08:43:46 +0000 +++ src/frame.c 2012-07-10 16:53:26 +0000 @@ -2754,7 +2754,7 @@ struct gcpro gcpro1, gcpro2; i = 0; - for (tail = alist; CONSP (tail); tail = Fcdr (tail)) + for (tail = alist; CONSP (tail); tail = XCDR (tail)) i++; parms = alloca (i * sizeof *parms); === modified file 'src/gnutls.c' --- src/gnutls.c 2012-06-29 06:28:37 +0000 +++ src/gnutls.c 2012-07-10 16:53:26 +0000 @@ -871,7 +871,7 @@ int file_format = GNUTLS_X509_FMT_PEM; Lisp_Object tail; - for (tail = trustfiles; !NILP (tail); tail = Fcdr (tail)) + for (tail = trustfiles; CONSP (tail); tail = XCDR (tail)) { Lisp_Object trustfile = Fcar (tail); if (STRINGP (trustfile)) @@ -893,7 +893,7 @@ } } - for (tail = crlfiles; !NILP (tail); tail = Fcdr (tail)) + for (tail = crlfiles; CONSP (tail); tail = XCDR (tail)) { Lisp_Object crlfile = Fcar (tail); if (STRINGP (crlfile)) @@ -913,7 +913,7 @@ } } - for (tail = keylist; !NILP (tail); tail = Fcdr (tail)) + for (tail = keylist; CONSP (tail); tail = XCDR (tail)) { Lisp_Object keyfile = Fcar (Fcar (tail)); Lisp_Object certfile = Fcar (Fcdr (tail)); === modified file 'src/minibuf.c' --- src/minibuf.c 2012-07-09 12:02:27 +0000 +++ src/minibuf.c 2012-07-10 16:53:26 +0000 @@ -425,7 +425,7 @@ if (CONSP (initial)) { Lisp_Object backup_n = Fcdr (initial); - initial = Fcar (initial); + initial = XCAR (initial); CHECK_STRING (initial); if (!NILP (backup_n)) { === modified file 'src/msdos.c' --- src/msdos.c 2012-07-09 12:02:27 +0000 +++ src/msdos.c 2012-07-10 16:53:26 +0000 @@ -1618,7 +1618,7 @@ /* Extract parm names and values into those vectors. */ i = 0; - for (tail = alist; CONSP (tail); tail = Fcdr (tail)) + for (tail = alist; CONSP (tail); tail = XCDR (tail)) { Lisp_Object elt; === modified file 'src/textprop.c' --- src/textprop.c 2012-07-03 18:24:42 +0000 +++ src/textprop.c 2012-07-10 16:53:26 +0000 @@ -271,7 +271,7 @@ /* Go through each element of LIST. */ for (tail1 = list; CONSP (tail1); tail1 = XCDR (tail1)) { - sym = Fcar (tail1); + sym = XCAR (tail1); /* Go through i's plist, looking for tail1 */ for (tail2 = i->plist; CONSP (tail2); tail2 = XCDR (XCDR (tail2))) === modified file 'src/w32fns.c' --- src/w32fns.c 2012-07-10 08:43:46 +0000 +++ src/w32fns.c 2012-07-10 16:53:26 +0000 @@ -678,7 +678,7 @@ elt = XCAR (tail); if (!CONSP (elt)) continue; - tem = Fcar (elt); + tem = XCAR (elt); if (lstrcmpi (SDATA (tem), colorname) == 0) { === modified file 'src/w32menu.c' --- src/w32menu.c 2012-06-16 12:24:15 +0000 +++ src/w32menu.c 2012-07-10 16:53:26 +0000 @@ -162,8 +162,7 @@ } else if (CONSP (position)) { - Lisp_Object tem; - tem = Fcar (position); + Lisp_Object tem = XCAR (position); if (CONSP (tem)) window = Fcar (Fcdr (position)); else === modified file 'src/window.c' --- src/window.c 2012-07-06 05:07:44 +0000 +++ src/window.c 2012-07-10 16:53:26 +0000 @@ -4854,7 +4854,7 @@ else { if (CONSP (arg)) - arg = Fcar (arg); + arg = XCAR (arg); CHECK_NUMBER (arg); window_scroll (window, XINT (arg), 0, 1); } === modified file 'src/xmenu.c' --- src/xmenu.c 2012-07-05 18:35:48 +0000 +++ src/xmenu.c 2012-07-10 16:53:26 +0000 @@ -258,8 +258,7 @@ } else if (CONSP (position)) { - Lisp_Object tem; - tem = Fcar (position); + Lisp_Object tem = XCAR (position); if (CONSP (tem)) window = Fcar (Fcdr (position)); else ------------------------------------------------------------ revno: 109000 committer: Tom Tromey branch nick: trunk timestamp: Tue 2012-07-10 08:25:22 -0600 message: Implement token threading * bytecode.c (BYTE_CODE_THREADED): New macro. (BYTE_CODES): New macro. Replaces all old byte-code defines. (enum byte_code_op): New type. (CASE, NEXT, FIRST, CASE_DEFAULT, CASE_ABORT): New macros. (exec_byte_code): Use them. Use token threading when applicable. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-10 08:43:46 +0000 +++ src/ChangeLog 2012-07-10 14:25:22 +0000 @@ -1,3 +1,11 @@ +2012-07-10 Tom Tromey + + * bytecode.c (BYTE_CODE_THREADED): New macro. + (BYTE_CODES): New macro. Replaces all old byte-code defines. + (enum byte_code_op): New type. + (CASE, NEXT, FIRST, CASE_DEFAULT, CASE_ABORT): New macros. + (exec_byte_code): Use them. Use token threading when applicable. + 2012-07-10 Dmitry Antipov Optimize pure C strings initialization. === modified file 'src/bytecode.c' --- src/bytecode.c 2012-07-05 18:35:48 +0000 +++ src/bytecode.c 2012-07-10 14:25:22 +0000 @@ -54,6 +54,14 @@ /* #define BYTE_CODE_SAFE */ /* #define BYTE_CODE_METER */ +/* If BYTE_CODE_THREADED is defined, then the interpreter will be + indirect threaded, using GCC's computed goto extension. This code, + as currently implemented, is incompatible with BYTE_CODE_SAFE and + BYTE_CODE_METER. */ +#if defined (__GNUC__) && !defined (BYTE_CODE_SAFE) && !defined (BYTE_CODE_METER) +#define BYTE_CODE_THREADED +#endif + #ifdef BYTE_CODE_METER @@ -83,158 +91,204 @@ /* Byte codes: */ -#define Bstack_ref 0 /* Actually, Bstack_ref+0 is not implemented: use dup. */ -#define Bvarref 010 -#define Bvarset 020 -#define Bvarbind 030 -#define Bcall 040 -#define Bunbind 050 - -#define Bnth 070 -#define Bsymbolp 071 -#define Bconsp 072 -#define Bstringp 073 -#define Blistp 074 -#define Beq 075 -#define Bmemq 076 -#define Bnot 077 -#define Bcar 0100 -#define Bcdr 0101 -#define Bcons 0102 -#define Blist1 0103 -#define Blist2 0104 -#define Blist3 0105 -#define Blist4 0106 -#define Blength 0107 -#define Baref 0110 -#define Baset 0111 -#define Bsymbol_value 0112 -#define Bsymbol_function 0113 -#define Bset 0114 -#define Bfset 0115 -#define Bget 0116 -#define Bsubstring 0117 -#define Bconcat2 0120 -#define Bconcat3 0121 -#define Bconcat4 0122 -#define Bsub1 0123 -#define Badd1 0124 -#define Beqlsign 0125 -#define Bgtr 0126 -#define Blss 0127 -#define Bleq 0130 -#define Bgeq 0131 -#define Bdiff 0132 -#define Bnegate 0133 -#define Bplus 0134 -#define Bmax 0135 -#define Bmin 0136 -#define Bmult 0137 - -#define Bpoint 0140 -/* Was Bmark in v17. */ -#define Bsave_current_buffer 0141 /* Obsolete. */ -#define Bgoto_char 0142 -#define Binsert 0143 -#define Bpoint_max 0144 -#define Bpoint_min 0145 -#define Bchar_after 0146 -#define Bfollowing_char 0147 -#define Bpreceding_char 0150 -#define Bcurrent_column 0151 -#define Bindent_to 0152 -#ifdef BYTE_CODE_SAFE -#define Bscan_buffer 0153 /* No longer generated as of v18. */ -#endif -#define Beolp 0154 -#define Beobp 0155 -#define Bbolp 0156 -#define Bbobp 0157 -#define Bcurrent_buffer 0160 -#define Bset_buffer 0161 -#define Bsave_current_buffer_1 0162 /* Replacing Bsave_current_buffer. */ -#if 0 -#define Bread_char 0162 /* No longer generated as of v19 */ -#endif -#ifdef BYTE_CODE_SAFE -#define Bset_mark 0163 /* this loser is no longer generated as of v18 */ -#endif -#define Binteractive_p 0164 /* Obsolete since Emacs-24.1. */ - -#define Bforward_char 0165 -#define Bforward_word 0166 -#define Bskip_chars_forward 0167 -#define Bskip_chars_backward 0170 -#define Bforward_line 0171 -#define Bchar_syntax 0172 -#define Bbuffer_substring 0173 -#define Bdelete_region 0174 -#define Bnarrow_to_region 0175 -#define Bwiden 0176 -#define Bend_of_line 0177 - -#define Bconstant2 0201 -#define Bgoto 0202 -#define Bgotoifnil 0203 -#define Bgotoifnonnil 0204 -#define Bgotoifnilelsepop 0205 -#define Bgotoifnonnilelsepop 0206 -#define Breturn 0207 -#define Bdiscard 0210 -#define Bdup 0211 - -#define Bsave_excursion 0212 -#define Bsave_window_excursion 0213 /* Obsolete since Emacs-24.1. */ -#define Bsave_restriction 0214 -#define Bcatch 0215 - -#define Bunwind_protect 0216 -#define Bcondition_case 0217 -#define Btemp_output_buffer_setup 0220 /* Obsolete since Emacs-24.1. */ -#define Btemp_output_buffer_show 0221 /* Obsolete since Emacs-24.1. */ - -#define Bunbind_all 0222 /* Obsolete. Never used. */ - -#define Bset_marker 0223 -#define Bmatch_beginning 0224 -#define Bmatch_end 0225 -#define Bupcase 0226 -#define Bdowncase 0227 - -#define Bstringeqlsign 0230 -#define Bstringlss 0231 -#define Bequal 0232 -#define Bnthcdr 0233 -#define Belt 0234 -#define Bmember 0235 -#define Bassq 0236 -#define Bnreverse 0237 -#define Bsetcar 0240 -#define Bsetcdr 0241 -#define Bcar_safe 0242 -#define Bcdr_safe 0243 -#define Bnconc 0244 -#define Bquo 0245 -#define Brem 0246 -#define Bnumberp 0247 -#define Bintegerp 0250 - -#define BRgoto 0252 -#define BRgotoifnil 0253 -#define BRgotoifnonnil 0254 -#define BRgotoifnilelsepop 0255 -#define BRgotoifnonnilelsepop 0256 - -#define BlistN 0257 -#define BconcatN 0260 -#define BinsertN 0261 - -/* Bstack_ref is code 0. */ -#define Bstack_set 0262 -#define Bstack_set2 0263 -#define BdiscardN 0266 - -#define Bconstant 0300 +#define BYTE_CODES \ +DEFINE (Bstack_ref, 0) /* Actually, Bstack_ref+0 is not implemented: use dup. */ \ +DEFINE (Bstack_ref1, 1) \ +DEFINE (Bstack_ref2, 2) \ +DEFINE (Bstack_ref3, 3) \ +DEFINE (Bstack_ref4, 4) \ +DEFINE (Bstack_ref5, 5) \ +DEFINE (Bstack_ref6, 6) \ +DEFINE (Bstack_ref7, 7) \ +DEFINE (Bvarref, 010) \ +DEFINE (Bvarref1, 011) \ +DEFINE (Bvarref2, 012) \ +DEFINE (Bvarref3, 013) \ +DEFINE (Bvarref4, 014) \ +DEFINE (Bvarref5, 015) \ +DEFINE (Bvarref6, 016) \ +DEFINE (Bvarref7, 017) \ +DEFINE (Bvarset, 020) \ +DEFINE (Bvarset1, 021) \ +DEFINE (Bvarset2, 022) \ +DEFINE (Bvarset3, 023) \ +DEFINE (Bvarset4, 024) \ +DEFINE (Bvarset5, 025) \ +DEFINE (Bvarset6, 026) \ +DEFINE (Bvarset7, 027) \ +DEFINE (Bvarbind, 030) \ +DEFINE (Bvarbind1, 031) \ +DEFINE (Bvarbind2, 032) \ +DEFINE (Bvarbind3, 033) \ +DEFINE (Bvarbind4, 034) \ +DEFINE (Bvarbind5, 035) \ +DEFINE (Bvarbind6, 036) \ +DEFINE (Bvarbind7, 037) \ +DEFINE (Bcall, 040) \ +DEFINE (Bcall1, 041) \ +DEFINE (Bcall2, 042) \ +DEFINE (Bcall3, 043) \ +DEFINE (Bcall4, 044) \ +DEFINE (Bcall5, 045) \ +DEFINE (Bcall6, 046) \ +DEFINE (Bcall7, 047) \ +DEFINE (Bunbind, 050) \ +DEFINE (Bunbind1, 051) \ +DEFINE (Bunbind2, 052) \ +DEFINE (Bunbind3, 053) \ +DEFINE (Bunbind4, 054) \ +DEFINE (Bunbind5, 055) \ +DEFINE (Bunbind6, 056) \ +DEFINE (Bunbind7, 057) \ + \ +DEFINE (Bnth, 070) \ +DEFINE (Bsymbolp, 071) \ +DEFINE (Bconsp, 072) \ +DEFINE (Bstringp, 073) \ +DEFINE (Blistp, 074) \ +DEFINE (Beq, 075) \ +DEFINE (Bmemq, 076) \ +DEFINE (Bnot, 077) \ +DEFINE (Bcar, 0100) \ +DEFINE (Bcdr, 0101) \ +DEFINE (Bcons, 0102) \ +DEFINE (Blist1, 0103) \ +DEFINE (Blist2, 0104) \ +DEFINE (Blist3, 0105) \ +DEFINE (Blist4, 0106) \ +DEFINE (Blength, 0107) \ +DEFINE (Baref, 0110) \ +DEFINE (Baset, 0111) \ +DEFINE (Bsymbol_value, 0112) \ +DEFINE (Bsymbol_function, 0113) \ +DEFINE (Bset, 0114) \ +DEFINE (Bfset, 0115) \ +DEFINE (Bget, 0116) \ +DEFINE (Bsubstring, 0117) \ +DEFINE (Bconcat2, 0120) \ +DEFINE (Bconcat3, 0121) \ +DEFINE (Bconcat4, 0122) \ +DEFINE (Bsub1, 0123) \ +DEFINE (Badd1, 0124) \ +DEFINE (Beqlsign, 0125) \ +DEFINE (Bgtr, 0126) \ +DEFINE (Blss, 0127) \ +DEFINE (Bleq, 0130) \ +DEFINE (Bgeq, 0131) \ +DEFINE (Bdiff, 0132) \ +DEFINE (Bnegate, 0133) \ +DEFINE (Bplus, 0134) \ +DEFINE (Bmax, 0135) \ +DEFINE (Bmin, 0136) \ +DEFINE (Bmult, 0137) \ + \ +DEFINE (Bpoint, 0140) \ +/* Was Bmark in v17. */ \ +DEFINE (Bsave_current_buffer, 0141) /* Obsolete. */ \ +DEFINE (Bgoto_char, 0142) \ +DEFINE (Binsert, 0143) \ +DEFINE (Bpoint_max, 0144) \ +DEFINE (Bpoint_min, 0145) \ +DEFINE (Bchar_after, 0146) \ +DEFINE (Bfollowing_char, 0147) \ +DEFINE (Bpreceding_char, 0150) \ +DEFINE (Bcurrent_column, 0151) \ +DEFINE (Bindent_to, 0152) \ +DEFINE (Beolp, 0154) \ +DEFINE (Beobp, 0155) \ +DEFINE (Bbolp, 0156) \ +DEFINE (Bbobp, 0157) \ +DEFINE (Bcurrent_buffer, 0160) \ +DEFINE (Bset_buffer, 0161) \ +DEFINE (Bsave_current_buffer_1, 0162) /* Replacing Bsave_current_buffer. */ \ +DEFINE (Binteractive_p, 0164) /* Obsolete since Emacs-24.1. */ \ + \ +DEFINE (Bforward_char, 0165) \ +DEFINE (Bforward_word, 0166) \ +DEFINE (Bskip_chars_forward, 0167) \ +DEFINE (Bskip_chars_backward, 0170) \ +DEFINE (Bforward_line, 0171) \ +DEFINE (Bchar_syntax, 0172) \ +DEFINE (Bbuffer_substring, 0173) \ +DEFINE (Bdelete_region, 0174) \ +DEFINE (Bnarrow_to_region, 0175) \ +DEFINE (Bwiden, 0176) \ +DEFINE (Bend_of_line, 0177) \ + \ +DEFINE (Bconstant2, 0201) \ +DEFINE (Bgoto, 0202) \ +DEFINE (Bgotoifnil, 0203) \ +DEFINE (Bgotoifnonnil, 0204) \ +DEFINE (Bgotoifnilelsepop, 0205) \ +DEFINE (Bgotoifnonnilelsepop, 0206) \ +DEFINE (Breturn, 0207) \ +DEFINE (Bdiscard, 0210) \ +DEFINE (Bdup, 0211) \ + \ +DEFINE (Bsave_excursion, 0212) \ +DEFINE (Bsave_window_excursion, 0213) /* Obsolete since Emacs-24.1. */ \ +DEFINE (Bsave_restriction, 0214) \ +DEFINE (Bcatch, 0215) \ + \ +DEFINE (Bunwind_protect, 0216) \ +DEFINE (Bcondition_case, 0217) \ +DEFINE (Btemp_output_buffer_setup, 0220) /* Obsolete since Emacs-24.1. */ \ +DEFINE (Btemp_output_buffer_show, 0221) /* Obsolete since Emacs-24.1. */ \ + \ +DEFINE (Bunbind_all, 0222) /* Obsolete. Never used. */ \ + \ +DEFINE (Bset_marker, 0223) \ +DEFINE (Bmatch_beginning, 0224) \ +DEFINE (Bmatch_end, 0225) \ +DEFINE (Bupcase, 0226) \ +DEFINE (Bdowncase, 0227) \ + \ +DEFINE (Bstringeqlsign, 0230) \ +DEFINE (Bstringlss, 0231) \ +DEFINE (Bequal, 0232) \ +DEFINE (Bnthcdr, 0233) \ +DEFINE (Belt, 0234) \ +DEFINE (Bmember, 0235) \ +DEFINE (Bassq, 0236) \ +DEFINE (Bnreverse, 0237) \ +DEFINE (Bsetcar, 0240) \ +DEFINE (Bsetcdr, 0241) \ +DEFINE (Bcar_safe, 0242) \ +DEFINE (Bcdr_safe, 0243) \ +DEFINE (Bnconc, 0244) \ +DEFINE (Bquo, 0245) \ +DEFINE (Brem, 0246) \ +DEFINE (Bnumberp, 0247) \ +DEFINE (Bintegerp, 0250) \ + \ +DEFINE (BRgoto, 0252) \ +DEFINE (BRgotoifnil, 0253) \ +DEFINE (BRgotoifnonnil, 0254) \ +DEFINE (BRgotoifnilelsepop, 0255) \ +DEFINE (BRgotoifnonnilelsepop, 0256) \ + \ +DEFINE (BlistN, 0257) \ +DEFINE (BconcatN, 0260) \ +DEFINE (BinsertN, 0261) \ + \ +/* Bstack_ref is code 0. */ \ +DEFINE (Bstack_set, 0262) \ +DEFINE (Bstack_set2, 0263) \ +DEFINE (BdiscardN, 0266) \ + \ +DEFINE (Bconstant, 0300) + +enum byte_code_op +{ +#define DEFINE(name, value) name = value, + BYTE_CODES +#undef DEFINE + +#ifdef BYTE_CODE_SAFE + Bscan_buffer = 0153, /* No longer generated as of v18. */ + Bset_mark = 0163 /* this loser is no longer generated as of v18 */ +#endif +}; /* Whether to maintain a `top' and `bottom' field in the stack frame. */ #define BYTE_MAINTAIN_TOP (BYTE_CODE_SAFE || BYTE_MARK_STACK) @@ -560,27 +614,83 @@ this_op = op = FETCH; METER_CODE (prev_op, op); #else +#ifndef BYTE_CODE_THREADED op = FETCH; #endif - - switch (op) - { - case Bvarref + 7: +#endif + + /* The interpreter can be compiled one of two ways: as an + ordinary switch-based interpreter, or as a threaded + interpreter. The threaded interpreter relies on GCC's + computed goto extension, so it is not available everywhere. + Threading provides a performance boost. These macros are how + we allow the code to be compiled both ways. */ +#ifdef BYTE_CODE_THREADED + /* The CASE macro introduces an instruction's body. It is + either a label or a case label. */ +#define CASE(OP) insn_ ## OP + /* NEXT is invoked at the end of an instruction to go to the + next instruction. It is either a computed goto, or a + plain break. */ +#define NEXT goto *(targets[op = FETCH]) + /* FIRST is like NEXT, but is only used at the start of the + interpreter body. In the switch-based interpreter it is the + switch, so the threaded definition must include a semicolon. */ +#define FIRST NEXT; + /* Most cases are labeled with the CASE macro, above. + CASE_DEFAULT is one exception; it is used if the interpreter + being built requires a default case. The threaded + interpreter does not, because the dispatch table is + completely filled. */ +#define CASE_DEFAULT + /* This introduces an instruction that is known to call abort. */ +#define CASE_ABORT CASE (Bstack_ref): CASE (default) +#else + /* See above for the meaning of the various defines. */ +#define CASE(OP) case OP +#define NEXT break +#define FIRST switch (op) +#define CASE_DEFAULT case 255: default: +#define CASE_ABORT case 0 +#endif + +#ifdef BYTE_CODE_THREADED + + /* A convenience define that saves us a lot of typing and makes + the table clearer. */ +#define LABEL(OP) [OP] = &&insn_ ## OP + + /* This is the dispatch table for the threaded interpreter. */ + static const void *const targets[256] = + { + [0 ... (Bconstant - 1)] = &&insn_default, + [Bconstant ... 255] = &&insn_Bconstant, + +#define DEFINE(name, value) LABEL (name) , + BYTE_CODES +#undef DEFINE + }; +#endif + + + FIRST + { + CASE (Bvarref7): op = FETCH2; goto varref; - case Bvarref: - case Bvarref + 1: - case Bvarref + 2: - case Bvarref + 3: - case Bvarref + 4: - case Bvarref + 5: + CASE (Bvarref): + CASE (Bvarref1): + CASE (Bvarref2): + CASE (Bvarref3): + CASE (Bvarref4): + CASE (Bvarref5): op = op - Bvarref; goto varref; /* This seems to be the most frequently executed byte-code among the Bvarref's, so avoid a goto here. */ - case Bvarref+6: + CASE (Bvarref6): op = FETCH; varref: { @@ -605,10 +715,10 @@ AFTER_POTENTIAL_GC (); } PUSH (v2); - break; + NEXT; } - case Bgotoifnil: + CASE (Bgotoifnil): { Lisp_Object v1; MAYBE_GC (); @@ -620,10 +730,10 @@ CHECK_RANGE (op); stack.pc = stack.byte_string_start + op; } - break; + NEXT; } - case Bcar: + CASE (Bcar): { Lisp_Object v1; v1 = TOP; @@ -637,28 +747,28 @@ wrong_type_argument (Qlistp, v1); AFTER_POTENTIAL_GC (); } - break; + NEXT; } - case Beq: + CASE (Beq): { Lisp_Object v1; v1 = POP; TOP = EQ (v1, TOP) ? Qt : Qnil; - break; + NEXT; } - case Bmemq: + CASE (Bmemq): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fmemq (TOP, v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bcdr: + CASE (Bcdr): { Lisp_Object v1; v1 = TOP; @@ -672,24 +782,23 @@ wrong_type_argument (Qlistp, v1); AFTER_POTENTIAL_GC (); } - break; - break; + NEXT; } - case Bvarset: - case Bvarset+1: - case Bvarset+2: - case Bvarset+3: - case Bvarset+4: - case Bvarset+5: + CASE (Bvarset): + CASE (Bvarset1): + CASE (Bvarset2): + CASE (Bvarset3): + CASE (Bvarset4): + CASE (Bvarset5): op -= Bvarset; goto varset; - case Bvarset+7: + CASE (Bvarset7): op = FETCH2; goto varset; - case Bvarset+6: + CASE (Bvarset6): op = FETCH; varset: { @@ -712,54 +821,54 @@ } } (void) POP; - break; + NEXT; - case Bdup: + CASE (Bdup): { Lisp_Object v1; v1 = TOP; PUSH (v1); - break; + NEXT; } /* ------------------ */ - case Bvarbind+6: + CASE (Bvarbind6): op = FETCH; goto varbind; - case Bvarbind+7: + CASE (Bvarbind7): op = FETCH2; goto varbind; - case Bvarbind: - case Bvarbind+1: - case Bvarbind+2: - case Bvarbind+3: - case Bvarbind+4: - case Bvarbind+5: + CASE (Bvarbind): + CASE (Bvarbind1): + CASE (Bvarbind2): + CASE (Bvarbind3): + CASE (Bvarbind4): + CASE (Bvarbind5): op -= Bvarbind; varbind: /* Specbind can signal and thus GC. */ BEFORE_POTENTIAL_GC (); specbind (vectorp[op], POP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bcall+6: + CASE (Bcall6): op = FETCH; goto docall; - case Bcall+7: + CASE (Bcall7): op = FETCH2; goto docall; - case Bcall: - case Bcall+1: - case Bcall+2: - case Bcall+3: - case Bcall+4: - case Bcall+5: + CASE (Bcall): + CASE (Bcall1): + CASE (Bcall2): + CASE (Bcall3): + CASE (Bcall4): + CASE (Bcall5): op -= Bcall; docall: { @@ -782,47 +891,47 @@ #endif TOP = Ffuncall (op + 1, &TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bunbind+6: + CASE (Bunbind6): op = FETCH; goto dounbind; - case Bunbind+7: + CASE (Bunbind7): op = FETCH2; goto dounbind; - case Bunbind: - case Bunbind+1: - case Bunbind+2: - case Bunbind+3: - case Bunbind+4: - case Bunbind+5: + CASE (Bunbind): + CASE (Bunbind1): + CASE (Bunbind2): + CASE (Bunbind3): + CASE (Bunbind4): + CASE (Bunbind5): op -= Bunbind; dounbind: BEFORE_POTENTIAL_GC (); unbind_to (SPECPDL_INDEX () - op, Qnil); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bunbind_all: /* Obsolete. Never used. */ + CASE (Bunbind_all): /* Obsolete. Never used. */ /* To unbind back to the beginning of this frame. Not used yet, but will be needed for tail-recursion elimination. */ BEFORE_POTENTIAL_GC (); unbind_to (count, Qnil); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bgoto: + CASE (Bgoto): MAYBE_GC (); BYTE_CODE_QUIT; op = FETCH2; /* pc = FETCH2 loses since FETCH2 contains pc++ */ CHECK_RANGE (op); stack.pc = stack.byte_string_start + op; - break; + NEXT; - case Bgotoifnonnil: + CASE (Bgotoifnonnil): { Lisp_Object v1; MAYBE_GC (); @@ -834,10 +943,10 @@ CHECK_RANGE (op); stack.pc = stack.byte_string_start + op; } - break; + NEXT; } - case Bgotoifnilelsepop: + CASE (Bgotoifnilelsepop): MAYBE_GC (); op = FETCH2; if (NILP (TOP)) @@ -847,9 +956,9 @@ stack.pc = stack.byte_string_start + op; } else DISCARD (1); - break; + NEXT; - case Bgotoifnonnilelsepop: + CASE (Bgotoifnonnilelsepop): MAYBE_GC (); op = FETCH2; if (!NILP (TOP)) @@ -859,15 +968,15 @@ stack.pc = stack.byte_string_start + op; } else DISCARD (1); - break; + NEXT; - case BRgoto: + CASE (BRgoto): MAYBE_GC (); BYTE_CODE_QUIT; stack.pc += (int) *stack.pc - 127; - break; + NEXT; - case BRgotoifnil: + CASE (BRgotoifnil): { Lisp_Object v1; MAYBE_GC (); @@ -878,10 +987,10 @@ stack.pc += (int) *stack.pc - 128; } stack.pc++; - break; + NEXT; } - case BRgotoifnonnil: + CASE (BRgotoifnonnil): { Lisp_Object v1; MAYBE_GC (); @@ -892,10 +1001,10 @@ stack.pc += (int) *stack.pc - 128; } stack.pc++; - break; + NEXT; } - case BRgotoifnilelsepop: + CASE (BRgotoifnilelsepop): MAYBE_GC (); op = *stack.pc++; if (NILP (TOP)) @@ -904,9 +1013,9 @@ stack.pc += op - 128; } else DISCARD (1); - break; + NEXT; - case BRgotoifnonnilelsepop: + CASE (BRgotoifnonnilelsepop): MAYBE_GC (); op = *stack.pc++; if (!NILP (TOP)) @@ -915,31 +1024,31 @@ stack.pc += op - 128; } else DISCARD (1); - break; + NEXT; - case Breturn: + CASE (Breturn): result = POP; goto exit; - case Bdiscard: + CASE (Bdiscard): DISCARD (1); - break; + NEXT; - case Bconstant2: + CASE (Bconstant2): PUSH (vectorp[FETCH2]); - break; + NEXT; - case Bsave_excursion: + CASE (Bsave_excursion): record_unwind_protect (save_excursion_restore, save_excursion_save ()); - break; + NEXT; - case Bsave_current_buffer: /* Obsolete since ??. */ - case Bsave_current_buffer_1: + CASE (Bsave_current_buffer): /* Obsolete since ??. */ + CASE (Bsave_current_buffer_1): record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ()); - break; + NEXT; - case Bsave_window_excursion: /* Obsolete since 24.1. */ + CASE (Bsave_window_excursion): /* Obsolete since 24.1. */ { register ptrdiff_t count1 = SPECPDL_INDEX (); record_unwind_protect (Fset_window_configuration, @@ -948,29 +1057,29 @@ TOP = Fprogn (TOP); unbind_to (count1, TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bsave_restriction: + CASE (Bsave_restriction): record_unwind_protect (save_restriction_restore, save_restriction_save ()); - break; + NEXT; - case Bcatch: /* FIXME: ill-suited for lexbind. */ + CASE (Bcatch): /* FIXME: ill-suited for lexbind. */ { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; TOP = internal_catch (TOP, eval_sub, v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bunwind_protect: /* FIXME: avoid closure for lexbind. */ + CASE (Bunwind_protect): /* FIXME: avoid closure for lexbind. */ record_unwind_protect (Fprogn, POP); - break; + NEXT; - case Bcondition_case: /* FIXME: ill-suited for lexbind. */ + CASE (Bcondition_case): /* FIXME: ill-suited for lexbind. */ { Lisp_Object handlers, body; handlers = POP; @@ -978,18 +1087,18 @@ BEFORE_POTENTIAL_GC (); TOP = internal_lisp_condition_case (TOP, body, handlers); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Btemp_output_buffer_setup: /* Obsolete since 24.1. */ + CASE (Btemp_output_buffer_setup): /* Obsolete since 24.1. */ BEFORE_POTENTIAL_GC (); CHECK_STRING (TOP); temp_output_buffer_setup (SSDATA (TOP)); AFTER_POTENTIAL_GC (); TOP = Vstandard_output; - break; + NEXT; - case Btemp_output_buffer_show: /* Obsolete since 24.1. */ + CASE (Btemp_output_buffer_show): /* Obsolete since 24.1. */ { Lisp_Object v1; BEFORE_POTENTIAL_GC (); @@ -999,10 +1108,10 @@ /* pop binding of standard-output */ unbind_to (SPECPDL_INDEX () - 1, Qnil); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bnth: + CASE (Bnth): { Lisp_Object v1, v2; EMACS_INT n; @@ -1017,173 +1126,173 @@ immediate_quit = 0; TOP = CAR (v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bsymbolp: + CASE (Bsymbolp): TOP = SYMBOLP (TOP) ? Qt : Qnil; - break; + NEXT; - case Bconsp: + CASE (Bconsp): TOP = CONSP (TOP) ? Qt : Qnil; - break; + NEXT; - case Bstringp: + CASE (Bstringp): TOP = STRINGP (TOP) ? Qt : Qnil; - break; + NEXT; - case Blistp: + CASE (Blistp): TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil; - break; + NEXT; - case Bnot: + CASE (Bnot): TOP = NILP (TOP) ? Qt : Qnil; - break; + NEXT; - case Bcons: + CASE (Bcons): { Lisp_Object v1; v1 = POP; TOP = Fcons (TOP, v1); - break; + NEXT; } - case Blist1: + CASE (Blist1): TOP = Fcons (TOP, Qnil); - break; + NEXT; - case Blist2: + CASE (Blist2): { Lisp_Object v1; v1 = POP; TOP = Fcons (TOP, Fcons (v1, Qnil)); - break; + NEXT; } - case Blist3: + CASE (Blist3): DISCARD (2); TOP = Flist (3, &TOP); - break; + NEXT; - case Blist4: + CASE (Blist4): DISCARD (3); TOP = Flist (4, &TOP); - break; + NEXT; - case BlistN: + CASE (BlistN): op = FETCH; DISCARD (op - 1); TOP = Flist (op, &TOP); - break; + NEXT; - case Blength: + CASE (Blength): BEFORE_POTENTIAL_GC (); TOP = Flength (TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Baref: + CASE (Baref): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Faref (TOP, v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Baset: + CASE (Baset): { Lisp_Object v1, v2; BEFORE_POTENTIAL_GC (); v2 = POP; v1 = POP; TOP = Faset (TOP, v1, v2); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bsymbol_value: + CASE (Bsymbol_value): BEFORE_POTENTIAL_GC (); TOP = Fsymbol_value (TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bsymbol_function: + CASE (Bsymbol_function): BEFORE_POTENTIAL_GC (); TOP = Fsymbol_function (TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bset: + CASE (Bset): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fset (TOP, v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bfset: + CASE (Bfset): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Ffset (TOP, v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bget: + CASE (Bget): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fget (TOP, v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bsubstring: + CASE (Bsubstring): { Lisp_Object v1, v2; BEFORE_POTENTIAL_GC (); v2 = POP; v1 = POP; TOP = Fsubstring (TOP, v1, v2); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bconcat2: + CASE (Bconcat2): BEFORE_POTENTIAL_GC (); DISCARD (1); TOP = Fconcat (2, &TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bconcat3: + CASE (Bconcat3): BEFORE_POTENTIAL_GC (); DISCARD (2); TOP = Fconcat (3, &TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bconcat4: + CASE (Bconcat4): BEFORE_POTENTIAL_GC (); DISCARD (3); TOP = Fconcat (4, &TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case BconcatN: + CASE (BconcatN): op = FETCH; BEFORE_POTENTIAL_GC (); DISCARD (op - 1); TOP = Fconcat (op, &TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bsub1: + CASE (Bsub1): { Lisp_Object v1; v1 = TOP; @@ -1198,10 +1307,10 @@ TOP = Fsub1 (v1); AFTER_POTENTIAL_GC (); } - break; + NEXT; } - case Badd1: + CASE (Badd1): { Lisp_Object v1; v1 = TOP; @@ -1216,10 +1325,10 @@ TOP = Fadd1 (v1); AFTER_POTENTIAL_GC (); } - break; + NEXT; } - case Beqlsign: + CASE (Beqlsign): { Lisp_Object v1, v2; BEFORE_POTENTIAL_GC (); @@ -1237,57 +1346,57 @@ } else TOP = (XINT (v1) == XINT (v2) ? Qt : Qnil); - break; + NEXT; } - case Bgtr: + CASE (Bgtr): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fgtr (TOP, v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Blss: + CASE (Blss): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Flss (TOP, v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bleq: + CASE (Bleq): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fleq (TOP, v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bgeq: + CASE (Bgeq): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fgeq (TOP, v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bdiff: + CASE (Bdiff): BEFORE_POTENTIAL_GC (); DISCARD (1); TOP = Fminus (2, &TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bnegate: + CASE (Bnegate): { Lisp_Object v1; v1 = TOP; @@ -1302,209 +1411,209 @@ TOP = Fminus (1, &TOP); AFTER_POTENTIAL_GC (); } - break; + NEXT; } - case Bplus: + CASE (Bplus): BEFORE_POTENTIAL_GC (); DISCARD (1); TOP = Fplus (2, &TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bmax: + CASE (Bmax): BEFORE_POTENTIAL_GC (); DISCARD (1); TOP = Fmax (2, &TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bmin: + CASE (Bmin): BEFORE_POTENTIAL_GC (); DISCARD (1); TOP = Fmin (2, &TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bmult: + CASE (Bmult): BEFORE_POTENTIAL_GC (); DISCARD (1); TOP = Ftimes (2, &TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bquo: + CASE (Bquo): BEFORE_POTENTIAL_GC (); DISCARD (1); TOP = Fquo (2, &TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Brem: + CASE (Brem): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Frem (TOP, v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bpoint: + CASE (Bpoint): { Lisp_Object v1; XSETFASTINT (v1, PT); PUSH (v1); - break; + NEXT; } - case Bgoto_char: + CASE (Bgoto_char): BEFORE_POTENTIAL_GC (); TOP = Fgoto_char (TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Binsert: + CASE (Binsert): BEFORE_POTENTIAL_GC (); TOP = Finsert (1, &TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case BinsertN: + CASE (BinsertN): op = FETCH; BEFORE_POTENTIAL_GC (); DISCARD (op - 1); TOP = Finsert (op, &TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bpoint_max: + CASE (Bpoint_max): { Lisp_Object v1; XSETFASTINT (v1, ZV); PUSH (v1); - break; + NEXT; } - case Bpoint_min: + CASE (Bpoint_min): { Lisp_Object v1; XSETFASTINT (v1, BEGV); PUSH (v1); - break; + NEXT; } - case Bchar_after: + CASE (Bchar_after): BEFORE_POTENTIAL_GC (); TOP = Fchar_after (TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bfollowing_char: + CASE (Bfollowing_char): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = Ffollowing_char (); AFTER_POTENTIAL_GC (); PUSH (v1); - break; + NEXT; } - case Bpreceding_char: + CASE (Bpreceding_char): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = Fprevious_char (); AFTER_POTENTIAL_GC (); PUSH (v1); - break; + NEXT; } - case Bcurrent_column: + CASE (Bcurrent_column): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); XSETFASTINT (v1, current_column ()); AFTER_POTENTIAL_GC (); PUSH (v1); - break; + NEXT; } - case Bindent_to: + CASE (Bindent_to): BEFORE_POTENTIAL_GC (); TOP = Findent_to (TOP, Qnil); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Beolp: + CASE (Beolp): PUSH (Feolp ()); - break; + NEXT; - case Beobp: + CASE (Beobp): PUSH (Feobp ()); - break; + NEXT; - case Bbolp: + CASE (Bbolp): PUSH (Fbolp ()); - break; + NEXT; - case Bbobp: + CASE (Bbobp): PUSH (Fbobp ()); - break; + NEXT; - case Bcurrent_buffer: + CASE (Bcurrent_buffer): PUSH (Fcurrent_buffer ()); - break; + NEXT; - case Bset_buffer: + CASE (Bset_buffer): BEFORE_POTENTIAL_GC (); TOP = Fset_buffer (TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Binteractive_p: /* Obsolete since 24.1. */ + CASE (Binteractive_p): /* Obsolete since 24.1. */ PUSH (Finteractive_p ()); - break; + NEXT; - case Bforward_char: + CASE (Bforward_char): BEFORE_POTENTIAL_GC (); TOP = Fforward_char (TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bforward_word: + CASE (Bforward_word): BEFORE_POTENTIAL_GC (); TOP = Fforward_word (TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bskip_chars_forward: + CASE (Bskip_chars_forward): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fskip_chars_forward (TOP, v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bskip_chars_backward: + CASE (Bskip_chars_backward): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fskip_chars_backward (TOP, v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bforward_line: + CASE (Bforward_line): BEFORE_POTENTIAL_GC (); TOP = Fforward_line (TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bchar_syntax: + CASE (Bchar_syntax): { int c; @@ -1516,51 +1625,51 @@ MAKE_CHAR_MULTIBYTE (c); XSETFASTINT (TOP, syntax_code_spec[(int) SYNTAX (c)]); } - break; + NEXT; - case Bbuffer_substring: + CASE (Bbuffer_substring): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fbuffer_substring (TOP, v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bdelete_region: + CASE (Bdelete_region): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fdelete_region (TOP, v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bnarrow_to_region: + CASE (Bnarrow_to_region): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fnarrow_to_region (TOP, v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bwiden: + CASE (Bwiden): BEFORE_POTENTIAL_GC (); PUSH (Fwiden ()); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bend_of_line: + CASE (Bend_of_line): BEFORE_POTENTIAL_GC (); TOP = Fend_of_line (TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bset_marker: + CASE (Bset_marker): { Lisp_Object v1, v2; BEFORE_POTENTIAL_GC (); @@ -1568,72 +1677,72 @@ v2 = POP; TOP = Fset_marker (TOP, v2, v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bmatch_beginning: + CASE (Bmatch_beginning): BEFORE_POTENTIAL_GC (); TOP = Fmatch_beginning (TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bmatch_end: + CASE (Bmatch_end): BEFORE_POTENTIAL_GC (); TOP = Fmatch_end (TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bupcase: + CASE (Bupcase): BEFORE_POTENTIAL_GC (); TOP = Fupcase (TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bdowncase: + CASE (Bdowncase): BEFORE_POTENTIAL_GC (); TOP = Fdowncase (TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bstringeqlsign: + CASE (Bstringeqlsign): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fstring_equal (TOP, v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bstringlss: + CASE (Bstringlss): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fstring_lessp (TOP, v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bequal: + CASE (Bequal): { Lisp_Object v1; v1 = POP; TOP = Fequal (TOP, v1); - break; + NEXT; } - case Bnthcdr: + CASE (Bnthcdr): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fnthcdr (TOP, v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Belt: + CASE (Belt): { Lisp_Object v1, v2; if (CONSP (TOP)) @@ -1659,87 +1768,91 @@ TOP = Felt (TOP, v1); AFTER_POTENTIAL_GC (); } - break; + NEXT; } - case Bmember: + CASE (Bmember): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fmember (TOP, v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bassq: + CASE (Bassq): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fassq (TOP, v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bnreverse: + CASE (Bnreverse): BEFORE_POTENTIAL_GC (); TOP = Fnreverse (TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bsetcar: + CASE (Bsetcar): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fsetcar (TOP, v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bsetcdr: + CASE (Bsetcdr): { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; TOP = Fsetcdr (TOP, v1); AFTER_POTENTIAL_GC (); - break; + NEXT; } - case Bcar_safe: + CASE (Bcar_safe): { Lisp_Object v1; v1 = TOP; TOP = CAR_SAFE (v1); - break; + NEXT; } - case Bcdr_safe: + CASE (Bcdr_safe): { Lisp_Object v1; v1 = TOP; TOP = CDR_SAFE (v1); - break; + NEXT; } - case Bnconc: + CASE (Bnconc): BEFORE_POTENTIAL_GC (); DISCARD (1); TOP = Fnconc (2, &TOP); AFTER_POTENTIAL_GC (); - break; + NEXT; - case Bnumberp: + CASE (Bnumberp): TOP = (NUMBERP (TOP) ? Qt : Qnil); - break; + NEXT; - case Bintegerp: + CASE (Bintegerp): TOP = INTEGERP (TOP) ? Qt : Qnil; - break; + NEXT; #ifdef BYTE_CODE_SAFE + /* These are intentionally written using 'case' syntax, + because they are incompatible with the threaded + interpreter. */ + case Bset_mark: BEFORE_POTENTIAL_GC (); error ("set-mark is an obsolete bytecode"); @@ -1752,49 +1865,49 @@ break; #endif - case 0: + CASE_ABORT: /* Actually this is Bstack_ref with offset 0, but we use Bdup for that instead. */ - /* case Bstack_ref: */ + /* CASE (Bstack_ref): */ abort (); /* Handy byte-codes for lexical binding. */ - case Bstack_ref+1: - case Bstack_ref+2: - case Bstack_ref+3: - case Bstack_ref+4: - case Bstack_ref+5: + CASE (Bstack_ref1): + CASE (Bstack_ref2): + CASE (Bstack_ref3): + CASE (Bstack_ref4): + CASE (Bstack_ref5): { Lisp_Object *ptr = top - (op - Bstack_ref); PUSH (*ptr); - break; + NEXT; } - case Bstack_ref+6: + CASE (Bstack_ref6): { Lisp_Object *ptr = top - (FETCH); PUSH (*ptr); - break; + NEXT; } - case Bstack_ref+7: + CASE (Bstack_ref7): { Lisp_Object *ptr = top - (FETCH2); PUSH (*ptr); - break; + NEXT; } - case Bstack_set: + CASE (Bstack_set): /* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos. */ { Lisp_Object *ptr = top - (FETCH); *ptr = POP; - break; + NEXT; } - case Bstack_set2: + CASE (Bstack_set2): { Lisp_Object *ptr = top - (FETCH2); *ptr = POP; - break; + NEXT; } - case BdiscardN: + CASE (BdiscardN): op = FETCH; if (op & 0x80) { @@ -1802,10 +1915,10 @@ top[-op] = TOP; } DISCARD (op); - break; + NEXT; - case 255: - default: + CASE_DEFAULT + CASE (Bconstant): #ifdef BYTE_CODE_SAFE if (op < Bconstant) { @@ -1819,6 +1932,7 @@ #else PUSH (vectorp[op - Bconstant]); #endif + NEXT; } } ------------------------------------------------------------ revno: 108999 committer: Michael Albinus branch nick: trunk timestamp: Tue 2012-07-10 14:16:40 +0200 message: * eshell/esh-ext.el (eshell-remote-command): Remove remote part of command, just in case. The function is not needed anymore. (eshell-external-command): Do not call `eshell-remote-command' diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-07-10 11:51:54 +0000 +++ lisp/ChangeLog 2012-07-10 12:16:40 +0000 @@ -1,3 +1,9 @@ +2012-07-10 Michael Albinus + + * eshell/esh-ext.el (eshell-remote-command): Remove remote part of + command, just in case. The function is not needed anymore. + (eshell-external-command): Do not call `eshell-remote-command'. + 2012-07-10 Stefan Monnier Reduce use of (require 'cl). === modified file 'lisp/eshell/esh-ext.el' --- lisp/eshell/esh-ext.el 2012-02-04 09:57:09 +0000 +++ lisp/eshell/esh-ext.el 2012-07-10 12:16:40 +0000 @@ -188,6 +188,7 @@ causing the user to wonder if anything's really going on..." (let ((outbuf (generate-new-buffer " *eshell remote output*")) (errbuf (generate-new-buffer " *eshell remote error*")) + (command (or (file-remote-p command 'localname) command)) (exitcode 1)) (unwind-protect (progn @@ -205,8 +206,8 @@ (defun eshell-external-command (command args) "Insert output from an external COMMAND, using ARGS." (setq args (eshell-stringify-list (eshell-flatten-list args))) - (if (file-remote-p default-directory) - (eshell-remote-command command args)) +; (if (file-remote-p default-directory) +; (eshell-remote-command command args)) (let ((interp (eshell-find-interpreter command))) (assert interp) (if (functionp (car interp)) ------------------------------------------------------------ revno: 108998 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2012-07-10 07:51:54 -0400 message: Reduce use of (require 'cl). * admin/bzrmerge.el: Use cl-lib. * leim/quail/hangul.el: Don't require CL. * leim/quail/ipa.el: Use cl-lib. * vc/smerge-mode.el, vc/pcvs.el, vc/pcvs-util.el, vc/pcvs-info.el: * vc/diff-mode.el, vc/cvs-status.el, uniquify.el, scroll-bar.el: * register.el, progmodes/sh-script.el, net/gnutls.el, net/dbus.el: * msb.el, mpc.el, minibuffer.el, international/ucs-normalize.el: * international/quail.el, info-xref.el, imenu.el, image-mode.el: * font-lock.el, filesets.el, edmacro.el, doc-view.el, bookmark.el: * battery.el, avoid.el, abbrev.el: Use cl-lib. * vc/pcvs-parse.el, vc/pcvs-defs.el, vc/log-view.el, vc/log-edit.el: * vc/diff.el, simple.el, pcomplete.el, lpr.el, comint.el, loadhist.el: * jit-lock.el, international/iso-ascii.el, info.el, frame.el, bs.el: * emulation/crisp.el, electric.el, dired.el, cus-dep.el, composite.el: * calculator.el, autorevert.el, apropos.el: Don't require CL. * emacs-bytecomp.el (byte-recompile-directory, display-call-tree) (byte-compile-unfold-bcf, byte-compile-check-variable): * emacs-byte-opt.el (byte-compile-trueconstp) (byte-compile-nilconstp): * emacs-autoload.el (make-autoload): Use pcase. * face-remap.el (text-scale-adjust): Simplify pcase patterns. diff: === modified file 'admin/ChangeLog' --- admin/ChangeLog 2012-07-09 04:52:49 +0000 +++ admin/ChangeLog 2012-07-10 11:51:54 +0000 @@ -1,3 +1,7 @@ +2012-07-10 Stefan Monnier + + * bzrmerge.el: Use cl-lib. + 2012-07-09 Paul Eggert Rename configure.in to configure.ac (Bug#11603). @@ -30,8 +34,8 @@ * coccinelle: New subdirectory * coccinelle/README: Documentation stub. * coccinelle/vector_contents.cocci: Semantic patch to replace direct - access to `contents' member of Lisp_Vector objects with AREF and ASET - where appropriate. + access to `contents' member of Lisp_Vector objects with AREF and ASET + where appropriate. 2012-06-22 Paul Eggert @@ -50,9 +54,9 @@ 2012-06-13 Andreas Schwab - * make-emacs: Rename --union-type to --check-lisp-type. Define - CHECK_LISP_OBJECT_TYPE insted of USE_LISP_UNION_TYPE. - * CPP-DEFINES (DEBUG_LISP_OBJECT_TYPE): Renamed from + * make-emacs: Rename --union-type to --check-lisp-type. + Define CHECK_LISP_OBJECT_TYPE insted of USE_LISP_UNION_TYPE. + * CPP-DEFINES (DEBUG_LISP_OBJECT_TYPE): Rename from USE_LISP_UNION_TYPE. 2012-06-03 Glenn Morris @@ -223,11 +227,11 @@ * unidata/makefile.w32-in (all): Remove src/biditype.h and src/bidimirror.h. - (../../src/biditype.h, ../../src/bidimirror.h): Deleted. + (../../src/biditype.h, ../../src/bidimirror.h): Delete. * unidata/Makefile.in (all): Remove src/biditype.h and src/bidimirror.h. - (../../src/biditype.h, ../../src/bidimirror.h): Deleted. + (../../src/biditype.h, ../../src/bidimirror.h): Delete. 2011-07-07 Juanma Barranquero @@ -238,8 +242,8 @@ * unidata/unidata-gen.el (unidata-dir): New variable. (unidata-setup-list): Expand unidata-text-file in unidata-dir. - (unidata-prop-alist): INDEX element may be a function. New - optional element VAL-LIST (for general-category and bidi-class). + (unidata-prop-alist): INDEX element may be a function. + New optional element VAL-LIST (for general-category and bidi-class). New entry `mirroring'. (unidata-prop-default, unidata-prop-val-list): New subst. (unidata-get-character, unidata-put-character): Delete them. @@ -595,13 +599,13 @@ 2009-04-17 Kenichi Handa - * unidata/unidata-gen.el (unidata-get-decomposition): Adjust - Hangle decomposition rule to Unicode. + * unidata/unidata-gen.el (unidata-get-decomposition): + Adjust Hangle decomposition rule to Unicode. 2009-04-09 Kenichi Handa - * unidata/unidata-gen.el (unidata-describe-decomposition): Return - a string with a composition property to disable combining + * unidata/unidata-gen.el (unidata-describe-decomposition): + Return a string with a composition property to disable combining characters being composed. 2009-03-11 Miles Bader @@ -1096,7 +1100,7 @@ 2005-10-17 Bill Wohler - * FOR-RELEASE (DOCUMENTATION): Removed lisp/toolbar from list + * FOR-RELEASE (DOCUMENTATION): Remove lisp/toolbar from list since it's gone. Also marked mh-e as done. 2005-10-11 Juanma Barranquero @@ -1143,7 +1147,7 @@ 2005-03-30 Marcelo Toledo - * FOR-RELEASE (Documentation): Added check the Emacs Tutorial. + * FOR-RELEASE (Documentation): Add check the Emacs Tutorial. The first line of every tutorial must begin with a sentence saying "Emacs Tutorial" in the respective language. This should be followed by "See end for copying conditions", likewise in the === modified file 'admin/bzrmerge.el' --- admin/bzrmerge.el 2012-05-02 07:12:52 +0000 +++ admin/bzrmerge.el 2012-07-10 11:51:54 +0000 @@ -24,8 +24,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) ; assert +(eval-when-compile (require 'cl-lib)) (defvar bzrmerge-skip-regexp "back[- ]?port\\|merge\\|sync\\|re-?generate\\|bump version\\|from trunk\\|\ @@ -256,17 +255,17 @@ ;; Do a "skip" (i.e. merge the meta-data only). (setq beg (1- (car skip))) (while (and skip (or (null merge) (< (car skip) (car merge)))) - (assert (> (car skip) (or end beg))) + (cl-assert (> (car skip) (or end beg))) (setq end (pop skip))) (message "Skipping %s..%s" beg end) (bzrmerge-add-metadata from end)) (t ;; Do a "normal" merge. - (assert (or (null skip) (< (car merge) (car skip)))) + (cl-assert (or (null skip) (< (car merge) (car skip)))) (setq beg (1- (car merge))) (while (and merge (or (null skip) (< (car merge) (car skip)))) - (assert (> (car merge) (or end beg))) + (cl-assert (> (car merge) (or end beg))) (setq end (pop merge))) (message "Merging %s..%s" beg end) (if (with-temp-buffer === modified file 'leim/ChangeLog' --- leim/ChangeLog 2012-06-12 04:35:14 +0000 +++ leim/ChangeLog 2012-07-10 11:51:54 +0000 @@ -1,3 +1,9 @@ +2012-07-10 Stefan Monnier + + * quail/ipa.el: Use cl-lib. + + * quail/hangul.el: Don't require CL. + 2012-06-12 Nguyen Thai Ngoc Duy * quail/vnvi.el: New file (Bug#4747). === modified file 'leim/quail/hangul.el' --- leim/quail/hangul.el 2012-01-19 07:21:25 +0000 +++ leim/quail/hangul.el 2012-07-10 11:51:54 +0000 @@ -30,7 +30,6 @@ ;;; Code: (require 'quail) -(eval-when-compile (require 'cl)) ; for setf (require 'hanja-util) ;; Hangul double Jamo table. === modified file 'leim/quail/ipa.el' --- leim/quail/ipa.el 2012-01-19 07:21:25 +0000 +++ leim/quail/ipa.el 2012-07-10 11:51:54 +0000 @@ -29,7 +29,7 @@ ;;; Code: (require 'quail) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (quail-define-package "ipa" "IPA" "IPA" t @@ -277,13 +277,13 @@ (setq quail-keymap (list (string quail-keymap))) (if (stringp quail-keymap) (setq quail-keymap (list quail-keymap)) - (assert (vectorp quail-keymap) t) + (cl-assert (vectorp quail-keymap) t) (setq quail-keymap (append quail-keymap nil)))) (list (apply 'vector (mapcar #'(lambda (entry) - (assert (char-or-string-p entry) t) + (cl-assert (char-or-string-p entry) t) (format "%s%s" to-prepend (if (integerp entry) (string entry) entry))) quail-keymap)))) @@ -318,18 +318,18 @@ (dolist (underscoring underscore-map) (cond ((null underscoring)) ((eq (length underscoring) 2) - (setq underscore-map-entry (second underscoring)) + (setq underscore-map-entry (cl-second underscoring)) (setcdr underscoring (ipa-x-sampa-prepend-to-keymap-entry pre-underscore-map underscore-map-entry))) ((eq (length underscoring) 3) - (setq underscore-map-entry (second (third underscoring))) - (setcdr (third underscoring) + (setq underscore-map-entry (cl-second (cl-third underscoring))) + (setcdr (cl-third underscoring) (ipa-x-sampa-prepend-to-keymap-entry pre-underscore-map underscore-map-entry))) (t - (assert (null t) t - "Can't handle subtrees of this level right now.")))) - (append underscore-map (list (list ?< (second x-sampa-submap-entry)))))) + (cl-assert (null t) t + "Can't handle subtrees of this level right now.")))) + (append underscore-map (list (list ?< (cl-second x-sampa-submap-entry)))))) (quail-define-package "ipa-x-sampa" "IPA" "IPA-X" t === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-07-10 11:27:27 +0000 +++ lisp/ChangeLog 2012-07-10 11:51:54 +0000 @@ -1,5 +1,25 @@ 2012-07-10 Stefan Monnier + Reduce use of (require 'cl). + * vc/smerge-mode.el, vc/pcvs.el, vc/pcvs-util.el, vc/pcvs-info.el: + * vc/diff-mode.el, vc/cvs-status.el, uniquify.el, scroll-bar.el: + * register.el, progmodes/sh-script.el, net/gnutls.el, net/dbus.el: + * msb.el, mpc.el, minibuffer.el, international/ucs-normalize.el: + * international/quail.el, info-xref.el, imenu.el, image-mode.el: + * font-lock.el, filesets.el, edmacro.el, doc-view.el, bookmark.el: + * battery.el, avoid.el, abbrev.el: Use cl-lib. + * vc/pcvs-parse.el, vc/pcvs-defs.el, vc/log-view.el, vc/log-edit.el: + * vc/diff.el, simple.el, pcomplete.el, lpr.el, comint.el, loadhist.el: + * jit-lock.el, international/iso-ascii.el, info.el, frame.el, bs.el: + * emulation/crisp.el, electric.el, dired.el, cus-dep.el, composite.el: + * calculator.el, autorevert.el, apropos.el: Don't require CL. + * emacs-lisp/bytecomp.el (byte-recompile-directory, display-call-tree) + (byte-compile-unfold-bcf, byte-compile-check-variable): + * emacs-lisp/byte-opt.el (byte-compile-trueconstp) + (byte-compile-nilconstp): + * emacs-lisp/autoload.el (make-autoload): Use pcase. + * face-remap.el (text-scale-adjust): Simplify pcase patterns. + * emacs-lisp/gv.el (cond): Make it a valid place. (if): Simplify slightly. === modified file 'lisp/abbrev.el' --- lisp/abbrev.el 2012-04-23 05:44:49 +0000 +++ lisp/abbrev.el 2012-07-10 11:51:54 +0000 @@ -31,7 +31,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defgroup abbrev-mode nil "Word abbreviations mode." @@ -540,7 +540,7 @@ (dotimes (i (length table)) (aset table i 0)) ;; Preserve the table's properties. - (assert sym) + (cl-assert sym) (let ((newsym (intern "" table))) (set newsym nil) ; Make sure it won't be confused for an abbrev. (setplist newsym (symbol-plist sym))) @@ -583,8 +583,8 @@ \(define-abbrev TABLE NAME EXPANSION &optional HOOK COUNT SYSTEM)." (when (and (consp props) (or (null (car props)) (numberp (car props)))) ;; Old-style calling convention. - (setq props (list* :count (car props) - (if (cadr props) (list :system (cadr props)))))) + (setq props `(:count ,(car props) + ,@(if (cadr props) (list :system (cadr props)))))) (unless (plist-get props :count) (setq props (plist-put props :count 0))) (let ((system-flag (plist-get props :system)) @@ -621,7 +621,7 @@ (let ((badchars ()) (pos 0)) (while (string-match "\\W" abbrev pos) - (pushnew (aref abbrev (match-beginning 0)) badchars) + (cl-pushnew (aref abbrev (match-beginning 0)) badchars) (setq pos (1+ pos))) (error "Some abbrev characters (%s) are not word constituents %s" (apply 'string (nreverse badchars)) @@ -836,8 +836,7 @@ (interactive) (run-hooks 'pre-abbrev-expand-hook) (with-wrapper-hook abbrev-expand-functions () - (destructuring-bind (&optional sym name wordstart wordend) - (abbrev--before-point) + (pcase-let ((`(,sym ,name ,wordstart ,wordend) (abbrev--before-point))) (when sym (let ((startpos (copy-marker (point) t)) (endmark (copy-marker wordend t))) === modified file 'lisp/apropos.el' --- lisp/apropos.el 2012-04-23 15:38:48 +0000 +++ lisp/apropos.el 2012-07-10 11:51:54 +0000 @@ -36,12 +36,12 @@ ;; Fixed bug, current-local-map can return nil. ;; Change, doesn't calculate key-bindings unless needed. ;; Added super-apropos capability, changed print functions. -;;; Made fast-apropos and super-apropos share code. -;;; Sped up fast-apropos again. +;; Made fast-apropos and super-apropos share code. +;; Sped up fast-apropos again. ;; Added apropos-do-all option. -;;; Added fast-command-apropos. +;; Added fast-command-apropos. ;; Changed doc strings to comments for helping functions. -;;; Made doc file buffer read-only, buried it. +;; Made doc file buffer read-only, buried it. ;; Only call substitute-command-keys if do-all set. ;; Optionally use configurable faces to make the output more legible. @@ -57,7 +57,6 @@ ;;; Code: (require 'button) -(eval-when-compile (require 'cl)) (defgroup apropos nil "Apropos commands for users and programmers." @@ -640,11 +639,11 @@ (setq lh (cdr lh))))) (unless lh-entry (error "Unknown library `%s'" file))) (dolist (x (cdr lh-entry)) - (case (car-safe x) + (pcase (car-safe x) ;; (autoload (push (cdr x) autoloads)) - (require (push (cdr x) requires)) - (provide (push (cdr x) provides)) - (t (push (or (cdr-safe x) x) symbols)))) + (`require (push (cdr x) requires)) + (`provide (push (cdr x) provides)) + (_ (push (or (cdr-safe x) x) symbols)))) (let ((apropos-pattern "")) ;Dummy binding for apropos-symbols-internal. (apropos-symbols-internal symbols apropos-do-all === modified file 'lisp/autorevert.el' --- lisp/autorevert.el 2012-04-22 13:58:00 +0000 +++ lisp/autorevert.el 2012-07-10 11:51:54 +0000 @@ -94,9 +94,6 @@ (require 'timer) -(eval-when-compile (require 'cl)) - - ;; Custom Group: ;; ;; The two modes will be placed next to Auto Save Mode under the === modified file 'lisp/avoid.el' --- lisp/avoid.el 2012-04-19 17:20:26 +0000 +++ lisp/avoid.el 2012-07-10 11:51:54 +0000 @@ -67,7 +67,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defgroup avoid nil "Make mouse pointer stay out of the way of editing." @@ -206,30 +206,30 @@ (let* ((fra-or-win (assoc-default 'frame-or-window mouse-avoidance-banish-position 'eq)) - (list-values (case fra-or-win - (frame (list 0 0 (frame-width) (frame-height))) - (window (window-edges)))) - (alist (loop for v in list-values - for k in '(left top right bottom) - collect (cons k v))) + (list-values (pcase fra-or-win + (`frame (list 0 0 (frame-width) (frame-height))) + (`window (window-edges)))) + (alist (cl-loop for v in list-values + for k in '(left top right bottom) + collect (cons k v))) (side (assoc-default 'side - mouse-avoidance-banish-position 'eq)) + mouse-avoidance-banish-position #'eq)) (side-dist (assoc-default 'side-pos - mouse-avoidance-banish-position 'eq)) + mouse-avoidance-banish-position #'eq)) (top-or-bottom (assoc-default 'top-or-bottom - mouse-avoidance-banish-position 'eq)) + mouse-avoidance-banish-position #'eq)) (top-or-bottom-dist (assoc-default 'top-or-bottom-pos - mouse-avoidance-banish-position 'eq)) - (side-fn (case side - (left '+) - (right '-))) - (top-or-bottom-fn (case top-or-bottom - (top '+) - (bottom '-)))) + mouse-avoidance-banish-position #'eq)) + (side-fn (pcase side + (`left '+) + (`right '-))) + (top-or-bottom-fn (pcase top-or-bottom + (`top '+) + (`bottom '-)))) (cons (funcall side-fn ; -/+ (assoc-default side alist 'eq) ; right or left side-dist) ; distance from side === modified file 'lisp/battery.el' --- lisp/battery.el 2012-04-20 08:48:50 +0000 +++ lisp/battery.el 2012-07-10 11:51:54 +0000 @@ -31,8 +31,7 @@ ;;; Code: (require 'timer) -(eval-when-compile (require 'cl)) - +(eval-when-compile (require 'cl-lib)) (defgroup battery nil "Display battery status information." @@ -360,16 +359,16 @@ (when (re-search-forward "present: +yes$" nil t) (when (re-search-forward "design capacity: +\\([0-9]+\\) m[AW]h$" nil t) - (incf design-capacity (string-to-number (match-string 1)))) + (cl-incf design-capacity (string-to-number (match-string 1)))) (when (re-search-forward "last full capacity: +\\([0-9]+\\) m[AW]h$" nil t) - (incf last-full-capacity (string-to-number (match-string 1)))) + (cl-incf last-full-capacity (string-to-number (match-string 1)))) (when (re-search-forward "design capacity warning: +\\([0-9]+\\) m[AW]h$" nil t) - (incf warn (string-to-number (match-string 1)))) + (cl-incf warn (string-to-number (match-string 1)))) (when (re-search-forward "design capacity low: +\\([0-9]+\\) m[AW]h$" nil t) - (incf low (string-to-number (match-string 1))))))) + (cl-incf low (string-to-number (match-string 1))))))) (setq full-capacity (if (> last-full-capacity 0) last-full-capacity design-capacity)) (and capacity rate === modified file 'lisp/bookmark.el' --- lisp/bookmark.el 2012-06-27 21:15:13 +0000 +++ lisp/bookmark.el 2012-07-10 11:51:54 +0000 @@ -33,7 +33,7 @@ ;;; Code: (require 'pp) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;;; Misc comments: ;; @@ -2015,11 +2015,11 @@ (tmp-list ())) (while (let ((char (read-key (concat prompt bookmark-search-pattern)))) - (case char - ((?\e ?\r) nil) ; RET or ESC break the search loop. + (pcase char + ((or ?\e ?\r) nil) ; RET or ESC break the search loop. (?\C-g (setq bookmark-quit-flag t) nil) (?\d (pop tmp-list) t) ; Delete last char of pattern with DEL - (t + (_ (if (characterp char) (push char tmp-list) (setq unread-command-events @@ -2034,9 +2034,9 @@ (defun bookmark-bmenu-filter-alist-by-regexp (regexp) "Filter `bookmark-alist' with bookmarks matching REGEXP and rebuild list." (let ((bookmark-alist - (loop for i in bookmark-alist - when (string-match regexp (car i)) collect i into new - finally return new))) + (cl-loop for i in bookmark-alist + when (string-match regexp (car i)) collect i into new + finally return new))) (bookmark-bmenu-list))) === modified file 'lisp/bs.el' --- lisp/bs.el 2012-04-19 16:50:07 +0000 +++ lisp/bs.el 2012-07-10 11:51:54 +0000 @@ -124,8 +124,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - ;; ---------------------------------------------------------------------- ;; Globals for customization ;; ---------------------------------------------------------------------- @@ -830,10 +828,10 @@ (interactive) (let ((res (with-current-buffer (bs--current-buffer) - (setq bs-buffer-show-mark (case bs-buffer-show-mark - ((nil) 'never) - ((never) 'always) - (t nil)))))) + (setq bs-buffer-show-mark (pcase bs-buffer-show-mark + (`nil 'never) + (`never 'always) + (_ nil)))))) (bs--update-current-line) (bs--set-window-height) (bs--show-config-message res))) === modified file 'lisp/calculator.el' --- lisp/calculator.el 2012-06-02 10:56:09 +0000 +++ lisp/calculator.el 2012-07-10 11:51:54 +0000 @@ -43,8 +43,6 @@ ;;; History: ;; I hate history. -(eval-when-compile (require 'cl)) - ;;;===================================================================== ;;; Customization: === modified file 'lisp/comint.el' --- lisp/comint.el 2012-07-02 16:18:02 +0000 +++ lisp/comint.el 2012-07-10 11:51:54 +0000 @@ -101,7 +101,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) (require 'ring) (require 'ansi-color) (require 'regexp-opt) ;For regexp-opt-charset. === modified file 'lisp/composite.el' --- lisp/composite.el 2012-02-02 09:07:29 +0000 +++ lisp/composite.el 2012-07-10 11:51:54 +0000 @@ -29,8 +29,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - (defconst reference-point-alist '((tl . 0) (tc . 1) (tr . 2) (Bl . 3) (Bc . 4) (Br . 5) === modified file 'lisp/cus-dep.el' --- lisp/cus-dep.el 2012-06-26 16:23:01 +0000 +++ lisp/cus-dep.el 2012-07-10 11:51:54 +0000 @@ -25,7 +25,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) (require 'widget) (require 'cus-face) === modified file 'lisp/dired.el' --- lisp/dired.el 2012-06-22 07:30:33 +0000 +++ lisp/dired.el 2012-07-10 11:51:54 +0000 @@ -34,8 +34,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - ;;; Customizable variables (defgroup dired nil === modified file 'lisp/doc-view.el' --- lisp/doc-view.el 2012-06-26 16:23:01 +0000 +++ lisp/doc-view.el 2012-07-10 11:51:54 +0000 @@ -133,7 +133,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'dired) (require 'image-mode) (require 'jka-compr) @@ -259,9 +259,9 @@ (setq ol nil)) (if ol (progn - (assert (eq (overlay-buffer ol) (current-buffer))) + (cl-assert (eq (overlay-buffer ol) (current-buffer))) (setq ol (copy-overlay ol))) - (assert (not (get-char-property (point-min) 'display))) + (cl-assert (not (get-char-property (point-min) 'display))) (setq ol (make-overlay (point-min) (point-max) nil t)) (overlay-put ol 'doc-view t)) (overlay-put ol 'window (car winprops)) @@ -892,30 +892,30 @@ (defun doc-view-doc->txt (txt callback) "Convert the current document to text and call CALLBACK when done." (make-directory (doc-view-current-cache-dir) t) - (case doc-view-doc-type - (pdf + (pcase doc-view-doc-type + (`pdf ;; Doc is a PDF, so convert it to TXT (doc-view-pdf->txt doc-view-buffer-file-name txt callback)) - (ps + (`ps ;; Doc is a PS, so convert it to PDF (which will be converted to ;; TXT thereafter). (let ((pdf (expand-file-name "doc.pdf" (doc-view-current-cache-dir)))) (doc-view-ps->pdf doc-view-buffer-file-name pdf (lambda () (doc-view-pdf->txt pdf txt callback))))) - (dvi + (`dvi ;; Doc is a DVI. This means that a doc.pdf already exists in its ;; cache subdirectory. (doc-view-pdf->txt (expand-file-name "doc.pdf" (doc-view-current-cache-dir)) txt callback)) - (odf + (`odf ;; Doc is some ODF (or MS Office) doc. This means that a doc.pdf ;; already exists in its cache subdirectory. (doc-view-pdf->txt (expand-file-name "doc.pdf" (doc-view-current-cache-dir)) txt callback)) - (t (error "DocView doesn't know what to do")))) + (_ (error "DocView doesn't know what to do")))) (defun doc-view-ps->pdf (ps pdf callback) "Convert PS to PDF asynchronously and call CALLBACK when finished." @@ -950,14 +950,14 @@ (let ((png-file (expand-file-name "page-%d.png" (doc-view-current-cache-dir)))) (make-directory (doc-view-current-cache-dir) t) - (case doc-view-doc-type - (dvi + (pcase doc-view-doc-type + (`dvi ;; DVI files have to be converted to PDF before Ghostscript can process ;; it. (let ((pdf (expand-file-name "doc.pdf" doc-view-current-cache-dir))) (doc-view-dvi->pdf doc-view-buffer-file-name pdf (lambda () (doc-view-pdf/ps->png pdf png-file))))) - (odf + (`odf ;; ODF files have to be converted to PDF before Ghostscript can ;; process it. (let ((pdf (expand-file-name "doc.pdf" doc-view-current-cache-dir)) @@ -973,11 +973,11 @@ ;; Rename to doc.pdf (rename-file opdf pdf) (doc-view-pdf/ps->png pdf png-file))))) - (pdf + (`pdf (let ((pages (doc-view-active-pages))) ;; Convert PDF to PNG images starting with the active pages. (doc-view-pdf->png doc-view-buffer-file-name png-file pages))) - (t + (_ ;; Convert to PNG images. (doc-view-pdf/ps->png doc-view-buffer-file-name png-file))))) @@ -1103,7 +1103,7 @@ (and (not (member pagefile prev-pages)) (member pagefile doc-view-current-files))) (with-selected-window win - (assert (eq (current-buffer) buffer)) + (cl-assert (eq (current-buffer) buffer)) (doc-view-goto-page page)))))))) (defun doc-view-buffer-message () === modified file 'lisp/edmacro.el' --- lisp/edmacro.el 2012-06-11 15:52:50 +0000 +++ lisp/edmacro.el 2012-07-10 11:51:54 +0000 @@ -63,8 +63,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'kmacro) @@ -319,17 +318,18 @@ mac)))) (if no-keys (when cmd - (loop for key in (where-is-internal cmd '(keymap)) do - (global-unset-key key))) + (cl-loop for key in (where-is-internal cmd '(keymap)) do + (global-unset-key key))) (when keys (if (= (length mac) 0) - (loop for key in keys do (global-unset-key key)) - (loop for key in keys do - (global-set-key key - (or cmd - (if (and mac-counter mac-format) - (kmacro-lambda-form mac mac-counter mac-format) - mac)))))))))) + (cl-loop for key in keys do (global-unset-key key)) + (cl-loop for key in keys do + (global-set-key key + (or cmd + (if (and mac-counter mac-format) + (kmacro-lambda-form + mac mac-counter mac-format) + mac)))))))))) (kill-buffer buf) (when (buffer-name obuf) (switch-to-buffer obuf)) @@ -437,9 +437,9 @@ (one-line (eq verbose 1))) (if one-line (setq verbose nil)) (when (stringp macro) - (loop for i below (length macro) do - (when (>= (aref rest-mac i) 128) - (incf (aref rest-mac i) (- ?\M-\^@ 128))))) + (cl-loop for i below (length macro) do + (when (>= (aref rest-mac i) 128) + (cl-incf (aref rest-mac i) (- ?\M-\^@ 128))))) (while (not (eq (aref rest-mac 0) 'end-macro)) (let* ((prefix (or (and (integerp (aref rest-mac 0)) @@ -448,57 +448,58 @@ '(digit-argument negative-argument)) (let ((i 1)) (while (memq (aref rest-mac i) (cdr mdigs)) - (incf i)) + (cl-incf i)) (and (not (memq (aref rest-mac i) pkeys)) (prog1 (vconcat "M-" (edmacro-subseq rest-mac 0 i) " ") - (callf edmacro-subseq rest-mac i))))) + (cl-callf edmacro-subseq rest-mac i))))) (and (eq (aref rest-mac 0) ?\C-u) (eq (key-binding [?\C-u]) 'universal-argument) (let ((i 1)) (while (eq (aref rest-mac i) ?\C-u) - (incf i)) + (cl-incf i)) (and (not (memq (aref rest-mac i) pkeys)) - (prog1 (loop repeat i concat "C-u ") - (callf edmacro-subseq rest-mac i))))) + (prog1 (cl-loop repeat i concat "C-u ") + (cl-callf edmacro-subseq rest-mac i))))) (and (eq (aref rest-mac 0) ?\C-u) (eq (key-binding [?\C-u]) 'universal-argument) (let ((i 1)) (when (eq (aref rest-mac i) ?-) - (incf i)) + (cl-incf i)) (while (memq (aref rest-mac i) '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) - (incf i)) + (cl-incf i)) (and (not (memq (aref rest-mac i) pkeys)) (prog1 (vconcat "C-u " (edmacro-subseq rest-mac 1 i) " ") - (callf edmacro-subseq rest-mac i))))))) + (cl-callf edmacro-subseq rest-mac i))))))) (bind-len (apply 'max 1 - (loop for map in maps - for b = (lookup-key map rest-mac) - when b collect b))) + (cl-loop for map in maps + for b = (lookup-key map rest-mac) + when b collect b))) (key (edmacro-subseq rest-mac 0 bind-len)) (fkey nil) tlen tkey - (bind (or (loop for map in maps for b = (lookup-key map key) - thereis (and (not (integerp b)) b)) + (bind (or (cl-loop for map in maps for b = (lookup-key map key) + thereis (and (not (integerp b)) b)) (and (setq fkey (lookup-key local-function-key-map rest-mac)) (setq tlen fkey tkey (edmacro-subseq rest-mac 0 tlen) fkey (lookup-key local-function-key-map tkey)) - (loop for map in maps - for b = (lookup-key map fkey) - when (and (not (integerp b)) b) - do (setq bind-len tlen key tkey) - and return b - finally do (setq fkey nil))))) + (cl-loop for map in maps + for b = (lookup-key map fkey) + when (and (not (integerp b)) b) + do (setq bind-len tlen key tkey) + and return b + finally do (setq fkey nil))))) (first (aref key 0)) - (text (loop for i from bind-len below (length rest-mac) - for ch = (aref rest-mac i) - while (and (integerp ch) - (> ch 32) (< ch maxkey) (/= ch 92) - (eq (key-binding (char-to-string ch)) - 'self-insert-command) - (or (> i (- (length rest-mac) 2)) - (not (eq ch (aref rest-mac (+ i 1)))) - (not (eq ch (aref rest-mac (+ i 2)))))) - finally return i)) + (text + (cl-loop for i from bind-len below (length rest-mac) + for ch = (aref rest-mac i) + while (and (integerp ch) + (> ch 32) (< ch maxkey) (/= ch 92) + (eq (key-binding (char-to-string ch)) + 'self-insert-command) + (or (> i (- (length rest-mac) 2)) + (not (eq ch (aref rest-mac (+ i 1)))) + (not (eq ch (aref rest-mac (+ i 2)))))) + finally return i)) desc) (if (stringp bind) (setq bind nil)) (cond ((and (eq bind 'self-insert-command) (not prefix) @@ -509,7 +510,7 @@ (setq desc (concat (edmacro-subseq rest-mac 0 text))) (when (string-match "^[ACHMsS]-." desc) (setq text 2) - (callf substring desc 0 2)) + (cl-callf substring desc 0 2)) (not (string-match "^;;\\|^<.*>$\\|^\\\\[0-9]+$\\|^[0-9]+\\*." desc)))) @@ -535,17 +536,17 @@ (cond ((integerp ch) (concat - (loop for pf across "ACHMsS" - for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@ - ?\M-\^@ ?\s-\^@ ?\S-\^@) - when (/= (logand ch bit) 0) - concat (format "%c-" pf)) + (cl-loop for pf across "ACHMsS" + for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@ + ?\M-\^@ ?\s-\^@ ?\S-\^@) + when (/= (logand ch bit) 0) + concat (format "%c-" pf)) (let ((ch2 (logand ch (1- (lsh 1 18))))) (cond ((<= ch2 32) - (case ch2 + (pcase ch2 (0 "NUL") (9 "TAB") (10 "LFD") (13 "RET") (27 "ESC") (32 "SPC") - (t + (_ (format "C-%c" (+ (if (<= ch2 26) 96 64) ch2))))) @@ -563,30 +564,30 @@ (let ((times 1) (pos bind-len)) (while (not (edmacro-mismatch rest-mac rest-mac 0 bind-len pos (+ bind-len pos))) - (incf times) - (incf pos bind-len)) + (cl-incf times) + (cl-incf pos bind-len)) (when (> times 1) (setq desc (format "%d*%s" times desc)) (setq bind-len (* bind-len times))))) (setq rest-mac (edmacro-subseq rest-mac bind-len)) (if verbose (progn - (unless (equal res "") (callf concat res "\n")) - (callf concat res desc) + (unless (equal res "") (cl-callf concat res "\n")) + (cl-callf concat res desc) (when (and bind (or (stringp bind) (symbolp bind))) - (callf concat res + (cl-callf concat res (make-string (max (- 3 (/ (length desc) 8)) 1) 9) ";; " (if (stringp bind) bind (symbol-name bind)))) (setq len 0)) (if (and (> (+ len (length desc) 2) 72) (not one-line)) (progn - (callf concat res "\n ") + (cl-callf concat res "\n ") (setq len 1)) (unless (equal res "") - (callf concat res " ") - (incf len))) - (callf concat res desc) - (incf len (length desc))))) + (cl-callf concat res " ") + (cl-incf len))) + (cl-callf concat res desc) + (cl-incf len (length desc))))) res)) (defun edmacro-mismatch (cl-seq1 cl-seq2 cl-start1 cl-end1 cl-start2 cl-end2) @@ -638,9 +639,9 @@ The string represents the same events; Meta is indicated by bit 7. This function assumes that the events can be stored in a string." (setq seq (copy-sequence seq)) - (loop for i below (length seq) do - (when (logand (aref seq i) 128) - (setf (aref seq i) (logand (aref seq i) 127)))) + (cl-loop for i below (length seq) do + (when (logand (aref seq i) 128) + (setf (aref seq i) (logand (aref seq i) 127)))) seq) (defun edmacro-fix-menu-commands (macro &optional noerror) @@ -655,7 +656,7 @@ ((eq (car ev) 'switch-frame)) ((equal ev '(menu-bar)) (push 'menu-bar result)) - ((equal (cadadr ev) '(menu-bar)) + ((equal (cl-cadadr ev) '(menu-bar)) (push (vector 'menu-bar (car ev)) result)) ;; It would be nice to do pop-up menus, too, but not enough ;; info is recorded in macros to make this possible. @@ -715,30 +716,31 @@ (t (let ((orig-word word) (prefix 0) (bits 0)) (while (string-match "^[ACHMsS]-." word) - (incf bits (cdr (assq (aref word 0) + (cl-incf bits (cdr (assq (aref word 0) '((?A . ?\A-\^@) (?C . ?\C-\^@) (?H . ?\H-\^@) (?M . ?\M-\^@) (?s . ?\s-\^@) (?S . ?\S-\^@))))) - (incf prefix 2) - (callf substring word 2)) + (cl-incf prefix 2) + (cl-callf substring word 2)) (when (string-match "^\\^.$" word) - (incf bits ?\C-\^@) - (incf prefix) - (callf substring word 1)) + (cl-incf bits ?\C-\^@) + (cl-incf prefix) + (cl-callf substring word 1)) (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r") ("LFD" . "\n") ("TAB" . "\t") ("ESC" . "\e") ("SPC" . " ") ("DEL" . "\177"))))) (when found (setq word (cdr found)))) (when (string-match "^\\\\[0-7]+$" word) - (loop for ch across word - for n = 0 then (+ (* n 8) ch -48) - finally do (setq word (vector n)))) + (cl-loop for ch across word + for n = 0 then (+ (* n 8) ch -48) + finally do (setq word (vector n)))) (cond ((= bits 0) (setq key word)) ((and (= bits ?\M-\^@) (stringp word) (string-match "^-?[0-9]+$" word)) - (setq key (loop for x across word collect (+ x bits)))) + (setq key (cl-loop for x across word + collect (+ x bits)))) ((/= (length word) 1) (error "%s must prefix a single character, not %s" (substring orig-word 0 prefix) word)) @@ -752,7 +754,7 @@ (t (setq key (list (+ bits (aref word 0))))))))) (when key - (loop repeat times do (callf vconcat res key))))) + (cl-loop repeat times do (cl-callf vconcat res key))))) (when (and (>= (length res) 4) (eq (aref res 0) ?\C-x) (eq (aref res 1) ?\() @@ -760,13 +762,13 @@ (eq (aref res (- (length res) 1)) ?\))) (setq res (edmacro-subseq res 2 -2))) (if (and (not need-vector) - (loop for ch across res - always (and (characterp ch) - (let ((ch2 (logand ch (lognot ?\M-\^@)))) - (and (>= ch2 0) (<= ch2 127)))))) - (concat (loop for ch across res - collect (if (= (logand ch ?\M-\^@) 0) - ch (+ ch 128)))) + (cl-loop for ch across res + always (and (characterp ch) + (let ((ch2 (logand ch (lognot ?\M-\^@)))) + (and (>= ch2 0) (<= ch2 127)))))) + (concat (cl-loop for ch across res + collect (if (= (logand ch ?\M-\^@) 0) + ch (+ ch 128)))) res))) (provide 'edmacro) === modified file 'lisp/electric.el' --- lisp/electric.el 2012-04-19 22:02:25 +0000 +++ lisp/electric.el 2012-07-10 11:51:54 +0000 @@ -38,8 +38,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - ;; This loop is the guts for non-standard modes which retain control ;; until some event occurs. It is a `do-forever', the only way out is ;; to throw. It assumes that you have set up the keymap, window, and @@ -394,16 +392,16 @@ (not (nth 8 (save-excursion (syntax-ppss pos))))) (let ((end (copy-marker (point) t))) (goto-char pos) - (case (if (functionp rule) (funcall rule) rule) + (pcase (if (functionp rule) (funcall rule) rule) ;; FIXME: we used `newline' down here which called ;; self-insert-command and ran post-self-insert-hook recursively. ;; It happened to make electric-indent-mode work automatically with ;; electric-layout-mode (at the cost of re-indenting lines ;; multiple times), but I'm not sure it's what we want. - (before (goto-char (1- pos)) (skip-chars-backward " \t") + (`before (goto-char (1- pos)) (skip-chars-backward " \t") (unless (bolp) (insert "\n"))) - (after (insert "\n")) ; FIXME: check eolp before inserting \n? - (around (save-excursion + (`after (insert "\n")) ; FIXME: check eolp before inserting \n? + (`around (save-excursion (goto-char (1- pos)) (skip-chars-backward " \t") (unless (bolp) (insert "\n"))) (insert "\n"))) ; FIXME: check eolp before inserting \n? === modified file 'lisp/emacs-lisp/autoload.el' --- lisp/emacs-lisp/autoload.el 2012-06-13 12:46:33 +0000 +++ lisp/emacs-lisp/autoload.el 2012-07-10 11:51:54 +0000 @@ -155,13 +155,14 @@ define-overloadable-function)) (let* ((macrop (memq car '(defmacro defmacro*))) (name (nth 1 form)) - (args (cl-case car - ((defun defmacro defun* defmacro* - define-overloadable-function) (nth 2 form)) - ((define-skeleton) '(&optional str arg)) - ((define-generic-mode define-derived-mode - define-compilation-mode) nil) - (t))) + (args (pcase car + ((or `defun `defmacro + `defun* `defmacro* `cl-defun `cl-defmacro + `define-overloadable-function) (nth 2 form)) + (`define-skeleton '(&optional str arg)) + ((or `define-generic-mode `define-derived-mode + `define-compilation-mode) nil) + (_ t))) (body (nthcdr (or (get car 'doc-string-elt) 3) form)) (doc (if (stringp (car body)) (pop body)))) ;; Add the usage form at the end where describe-function-1 === modified file 'lisp/emacs-lisp/byte-opt.el' --- lisp/emacs-lisp/byte-opt.el 2012-07-02 08:00:05 +0000 +++ lisp/emacs-lisp/byte-opt.el 2012-07-10 11:51:54 +0000 @@ -630,10 +630,10 @@ (while (eq (car-safe form) 'progn) (setq form (car (last (cdr form))))) (cond ((consp form) - (cl-case (car form) - (quote (cadr form)) + (pcase (car form) + (`quote (cadr form)) ;; Can't use recursion in a defsubst. - ;; (progn (byte-compile-trueconstp (car (last (cdr form))))) + ;; (`progn (byte-compile-trueconstp (car (last (cdr form))))) )) ((not (symbolp form))) ((eq form t)) @@ -644,10 +644,10 @@ (while (eq (car-safe form) 'progn) (setq form (car (last (cdr form))))) (cond ((consp form) - (cl-case (car form) - (quote (null (cadr form))) + (pcase (car form) + (`quote (null (cadr form))) ;; Can't use recursion in a defsubst. - ;; (progn (byte-compile-nilconstp (car (last (cdr form))))) + ;; (`progn (byte-compile-nilconstp (car (last (cdr form))))) )) ((not (symbolp form)) nil) ((null form)))) === modified file 'lisp/emacs-lisp/bytecomp.el' --- lisp/emacs-lisp/bytecomp.el 2012-07-04 14:42:59 +0000 +++ lisp/emacs-lisp/bytecomp.el 2012-07-10 11:51:54 +0000 @@ -1591,10 +1591,11 @@ (not (auto-save-file-name-p source)) (not (string-equal dir-locals-file (file-name-nondirectory source)))) - (progn (cl-case (byte-recompile-file source force arg) - (no-byte-compile (setq skip-count (1+ skip-count))) - ((t) (setq file-count (1+ file-count))) - ((nil) (setq fail-count (1+ fail-count)))) + (progn (incf + (pcase (byte-recompile-file source force arg) + (`no-byte-compile skip-count) + (`t file-count) + (_ fail-count))) (or noninteractive (message "Checking %s..." directory)) (if (not (eq last-dir directory)) @@ -2974,12 +2975,12 @@ ;; Old-style byte-code. (cl-assert (listp fargs)) (while fargs - (cl-case (car fargs) - (&optional (setq fargs (cdr fargs))) - (&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1)) + (pcase (car fargs) + (`&optional (setq fargs (cdr fargs))) + (`&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1)) (push (cadr fargs) dynbinds) (setq fargs nil)) - (t (push (pop fargs) dynbinds)))) + (_ (push (pop fargs) dynbinds)))) (unless fmax2 (setq fmax2 (* 2 (length dynbinds))))) (cond ((<= (+ alen alen) fmax2) @@ -3024,10 +3025,10 @@ (and od (not (memq var byte-compile-not-obsolete-vars)) (not (memq var byte-compile-global-not-obsolete-vars)) - (or (cl-case (nth 1 od) - (set (not (eq access-type 'reference))) - (get (eq access-type 'reference)) - (t t))))) + (or (pcase (nth 1 od) + (`set (not (eq access-type 'reference))) + (`get (eq access-type 'reference)) + (_ t))))) (byte-compile-warn-obsolete var)))) (defsubst byte-compile-dynamic-variable-op (base-op var) @@ -4351,21 +4352,21 @@ (if byte-compile-call-tree-sort (setq byte-compile-call-tree (sort byte-compile-call-tree - (cl-case byte-compile-call-tree-sort - (callers + (pcase byte-compile-call-tree-sort + (`callers (lambda (x y) (< (length (nth 1 x)) (length (nth 1 y))))) - (calls + (`calls (lambda (x y) (< (length (nth 2 x)) (length (nth 2 y))))) - (calls+callers + (`calls+callers (lambda (x y) (< (+ (length (nth 1 x)) (length (nth 2 x))) (+ (length (nth 1 y)) (length (nth 2 y)))))) - (name + (`name (lambda (x y) (string< (car x) (car y)))) - (t (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode" + (_ (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode" byte-compile-call-tree-sort)))))) (message "Generating call tree...") (let ((rest byte-compile-call-tree) === modified file 'lisp/emulation/crisp.el' --- lisp/emulation/crisp.el 2012-06-02 10:56:09 +0000 +++ lisp/emulation/crisp.el 2012-07-10 11:51:54 +0000 @@ -54,8 +54,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - ;; local variables (defgroup crisp nil @@ -361,7 +359,7 @@ (when crisp-mode ;; Make menu entries show M-u or f14 in preference to C-x u. (put 'undo :advertised-binding - (list* [?\M-u] [f14] (get 'undo :advertised-binding))) + `([?\M-u] [f14] ,@(get 'undo :advertised-binding))) ;; Force transient-mark-mode, so that the marking routines work as ;; expected. If the user turns off transient mark mode, most ;; things will still work fine except the crisp-(copy|kill) === modified file 'lisp/face-remap.el' --- lisp/face-remap.el 2012-06-17 08:53:31 +0000 +++ lisp/face-remap.el 2012-07-10 11:51:54 +0000 @@ -315,9 +315,9 @@ (let* ((base (event-basic-type ev)) (step (pcase base - ((or `?+ `?=) inc) - (`?- (- inc)) - (`?0 0) + ((or ?+ ?=) inc) + (?- (- inc)) + (?0 0) (t inc)))) (text-scale-increase step) ;; FIXME: do it after every "iteration of the loop". === modified file 'lisp/filesets.el' --- lisp/filesets.el 2012-02-28 08:17:21 +0000 +++ lisp/filesets.el 2012-07-10 11:51:54 +0000 @@ -88,9 +88,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) - +(eval-when-compile (require 'cl-lib)) ;;; Some variables @@ -1286,11 +1284,11 @@ (or entry (filesets-get-external-viewer filename))))) (filesets-alist-get def - (case event - ((on-open-all) ':ignore-on-open-all) - ((on-grep) ':ignore-on-read-text) - ((on-cmd) nil) - ((on-close-all) nil)) + (pcase event + (`on-open-all ':ignore-on-open-all) + (`on-grep ':ignore-on-read-text) + (`on-cmd nil) + (`on-close-all nil)) nil t))) (defun filesets-filetype-get-prop (property filename &optional entry) @@ -1559,11 +1557,9 @@ (defun filesets-get-fileset-from-name (name &optional mode) "Get fileset definition for NAME." - (case mode - ((:ingroup :tree) - name) - (t - (assoc name filesets-data)))) + (pcase mode + ((or `:ingroup `:tree) name) + (_ (assoc name filesets-data)))) ;;; commands @@ -1720,22 +1716,22 @@ Assume MODE (see `filesets-entry-mode'), if provided." (let* ((mode (or mode (filesets-entry-mode entry))) - (fl (case mode - ((:files) + (fl (pcase mode + (:files (filesets-entry-get-files entry)) - ((:file) + (:file (list (filesets-entry-get-file entry))) - ((:ingroup) + (:ingroup (let ((entry (expand-file-name (if (stringp entry) entry (filesets-entry-get-master entry))))) (cons entry (filesets-ingroup-cache-get entry)))) - ((:tree) + (:tree (let ((dir (nth 0 entry)) (patt (nth 1 entry))) (filesets-directory-files dir patt ':files t))) - ((:pattern) + (:pattern (let ((dirpatt (filesets-entry-get-pattern entry))) (if dirpatt (let ((dir (filesets-entry-get-pattern--dir dirpatt)) @@ -1904,12 +1900,12 @@ (let* ((result nil) (factor (ceiling (/ (float bl) filesets-max-submenu-length)))) - (do ((data submenu-body (cdr data)) - (n 1 (+ n 1)) - (count 0 (+ count factor))) + (cl-do ((data submenu-body (cdr data)) + (n 1 (+ n 1)) + (count 0 (+ count factor))) ((or (> count bl) (null data))) -; (let ((sl (subseq submenu-body count + ;; (let ((sl (subseq submenu-body count (let ((sl (filesets-sublist submenu-body count (let ((x (+ count factor))) (if (>= bl x) @@ -1926,7 +1922,7 @@ `((,(concat (filesets-get-shortcut n) (let ((rv "")) - (do ((x sl (cdr x))) + (cl-do ((x sl (cdr x))) ((null x)) (let ((y (concat (elt (car x) 0) (if (null (cdr x)) @@ -1952,8 +1948,8 @@ "Get submenu epilog for SOMETHING (usually a fileset). If mode is :tree or :ingroup, SOMETHING is some weird construct and LOOKUP-NAME is used as lookup name for retrieving fileset specific settings." - (case mode - ((:tree) + (pcase mode + (:tree `("---" ["Close all files" (filesets-close ',mode ',something ',lookup-name)] ["Run Command" (filesets-run-cmd nil ',something ',mode)] @@ -1962,14 +1958,14 @@ ,@(when rebuild-flag `(["Rebuild this submenu" (filesets-rebuild-this-submenu ',lookup-name)])))) - ((:ingroup) + (:ingroup `("---" ["Close all files" (filesets-close ',mode ',something ',lookup-name)] ["Run Command" (filesets-run-cmd nil ',something ',mode)] ,@(when rebuild-flag `(["Rebuild this submenu" (filesets-rebuild-this-submenu ',lookup-name)])))) - ((:pattern) + (:pattern `("---" ["Close all files" (filesets-close ',mode ',something)] ["Run Command" (filesets-run-cmd nil ',something ',mode)] @@ -1986,7 +1982,7 @@ ,@(when rebuild-flag `(["Rebuild this submenu" (filesets-rebuild-this-submenu ',lookup-name)])))) - ((:files) + (:files `("---" [,(concat "Close all files") (filesets-close ',mode ',something)] ["Run Command" (filesets-run-cmd nil ',something ',mode)] @@ -1997,7 +1993,7 @@ ,@(when rebuild-flag `(["Rebuild this submenu" (filesets-rebuild-this-submenu ',lookup-name)])))) - (t + (_ (filesets-error 'error "Filesets: malformed definition of " something)))) (defun filesets-ingroup-get-data (master pos &optional fun) @@ -2249,15 +2245,15 @@ (filesets-verbosity (filesets-entry-get-verbosity entry)) (this-lookup-name (concat (filesets-get-shortcut count) lookup-name))) - (case mode - ((:file) + (pcase mode + (:file (let* ((file (filesets-entry-get-file entry))) `[,this-lookup-name (filesets-file-open nil ',file ',lookup-name)])) - (t + (_ `(,this-lookup-name - ,@(case mode - ((:pattern) + ,@(pcase mode + (:pattern (let* ((files (filesets-get-filelist entry mode 'on-ls)) (dirpatt (filesets-entry-get-pattern entry)) (pattname (apply 'concat (cons "Pattern: " dirpatt))) @@ -2276,7 +2272,7 @@ files)) ,@(filesets-get-menu-epilog lookup-name mode lookup-name t)))) - ((:ingroup) + (:ingroup (let* ((master (filesets-entry-get-master entry))) ;;(filesets-message 3 "Filesets: parsing %S" master) `([,(concat "Inclusion Group: " @@ -2288,12 +2284,12 @@ ,@(filesets-wrap-submenu (filesets-build-ingroup-submenu lookup-name master)) ,@(filesets-get-menu-epilog master mode lookup-name t)))) - ((:tree) + (:tree (let* ((dirpatt (filesets-entry-get-tree entry)) (dir (car dirpatt)) (patt (cadr dirpatt))) (filesets-build-dir-submenu entry lookup-name dir patt))) - ((:files) + (:files (let ((files (filesets-get-filelist entry mode 'on-open-all)) (count 0)) `([,(concat "Files: " lookup-name) @@ -2331,9 +2327,9 @@ (setq filesets-has-changed-flag nil) (setq filesets-updated-buffers nil) (setq filesets-update-cache-file-flag t) - (do ((data (filesets-conditional-sort filesets-data (function car)) - (cdr data)) - (count 1 (+ count 1))) + (cl-do ((data (filesets-conditional-sort filesets-data (function car)) + (cdr data)) + (count 1 (+ count 1))) ((null data)) (let* ((this (car data)) (name (filesets-data-get-name this)) === modified file 'lisp/font-lock.el' --- lisp/font-lock.el 2012-06-08 16:39:49 +0000 +++ lisp/font-lock.el 2012-07-10 11:51:54 +0000 @@ -207,7 +207,7 @@ ;;; Code: (require 'syntax) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;; Define core `font-lock' group. (defgroup font-lock '((jit-lock custom-group)) @@ -614,9 +614,6 @@ (eval-when-compile ;; - ;; We don't do this at the top-level as we only use non-autoloaded macros. - (require 'cl) - ;; ;; Borrowed from lazy-lock.el. ;; We use this to preserve or protect things when modifying text properties. (defmacro save-buffer-state (&rest body) @@ -917,10 +914,10 @@ (declare-function lazy-lock-mode "lazy-lock") (defun font-lock-turn-on-thing-lock () - (case (font-lock-value-in-major-mode font-lock-support-mode) - (fast-lock-mode (fast-lock-mode t)) - (lazy-lock-mode (lazy-lock-mode t)) - (jit-lock-mode + (pcase (font-lock-value-in-major-mode font-lock-support-mode) + (`fast-lock-mode (fast-lock-mode t)) + (`lazy-lock-mode (lazy-lock-mode t)) + (`jit-lock-mode ;; Prepare for jit-lock (remove-hook 'after-change-functions 'font-lock-after-change-function t) @@ -1654,7 +1651,7 @@ ;; Fontify each item in `font-lock-keywords' from `start' to `end'. (while keywords (if loudly (message "Fontifying %s... (regexps..%s)" bufname - (make-string (incf count) ?.))) + (make-string (cl-incf count) ?.))) ;; ;; Find an occurrence of `matcher' from `start' to `end'. (setq keyword (car keywords) matcher (car keyword)) === modified file 'lisp/frame.el' --- lisp/frame.el 2012-06-02 10:56:09 +0000 +++ lisp/frame.el 2012-07-10 11:51:54 +0000 @@ -25,8 +25,6 @@ ;;; Commentary: ;;; Code: -(eval-when-compile (require 'cl)) - (defvar frame-creation-function-alist (list (cons nil (if (fboundp 'tty-create-frame-with-faces) === modified file 'lisp/hexl.el' --- lisp/hexl.el 2012-05-29 09:09:38 +0000 +++ lisp/hexl.el 2012-07-10 11:51:54 +0000 @@ -41,7 +41,7 @@ ;;; Code: (require 'eldoc) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl)) ;For letf (default-value 'major-mode). ;; ;; vars here === modified file 'lisp/image-mode.el' --- lisp/image-mode.el 2012-05-29 06:16:49 +0000 +++ lisp/image-mode.el 2012-07-10 11:51:54 +0000 @@ -34,7 +34,7 @@ ;;; Code: (require 'image) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;;; Image mode window-info management. @@ -70,12 +70,11 @@ winprops)) (defun image-mode-window-get (prop &optional winprops) + (declare (gv-setter (lambda (val) + `(image-mode-window-put ,prop ,val ,winprops)))) (unless (consp winprops) (setq winprops (image-mode-winprops winprops))) (cdr (assq prop (cdr winprops)))) -(defsetf image-mode-window-get (prop &optional winprops) (val) - `(image-mode-window-put ,prop ,val ,winprops)) - (defun image-mode-window-put (prop val &optional winprops) (unless (consp winprops) (setq winprops (image-mode-winprops winprops))) (setcdr winprops (cons (cons prop val) @@ -692,20 +691,20 @@ close to a multiple of 90, see `image-transform-right-angle-fudge'." (cond ((< (abs (- (mod (+ image-transform-rotation 90) 180) 90)) image-transform-right-angle-fudge) - (assert (not (zerop width)) t) + (cl-assert (not (zerop width)) t) (setq image-transform-rotation (float (round image-transform-rotation)) image-transform-scale (/ (float length) width)) (cons length nil)) ((< (abs (- (mod (+ image-transform-rotation 45) 90) 45)) image-transform-right-angle-fudge) - (assert (not (zerop height)) t) + (cl-assert (not (zerop height)) t) (setq image-transform-rotation (float (round image-transform-rotation)) image-transform-scale (/ (float length) height)) (cons nil length)) (t - (assert (not (and (zerop width) (zerop height))) t) + (cl-assert (not (and (zerop width) (zerop height))) t) (setq image-transform-scale (/ (float (1- length)) (image-transform-width width height))) ;; Assume we have a w x h image and an angle A, and let l = @@ -743,12 +742,12 @@ (unless (numberp image-transform-resize) (let ((size (image-display-size (image-get-display-property) t))) (cond ((eq image-transform-resize 'fit-width) - (assert (= (car size) + (cl-assert (= (car size) (- (nth 2 (window-inside-pixel-edges)) (nth 0 (window-inside-pixel-edges)))) t)) ((eq image-transform-resize 'fit-height) - (assert (= (cdr size) + (cl-assert (= (cdr size) (- (nth 3 (window-inside-pixel-edges)) (nth 1 (window-inside-pixel-edges)))) t)))))) === modified file 'lisp/imenu.el' --- lisp/imenu.el 2012-05-08 14:19:08 +0000 +++ lisp/imenu.el 2012-07-10 11:51:54 +0000 @@ -59,7 +59,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -481,7 +481,7 @@ (i 0)) (while remain (push (pop remain) sublist) - (incf i) + (cl-incf i) (and (= i n) ;; We have finished a sublist (progn (push (nreverse sublist) result) @@ -593,17 +593,17 @@ t)) (defun imenu--create-keymap (title alist &optional cmd) - (list* 'keymap title - (mapcar - (lambda (item) - (list* (car item) (car item) - (cond - ((imenu--subalist-p item) - (imenu--create-keymap (car item) (cdr item) cmd)) - (t - `(lambda () (interactive) - ,(if cmd `(,cmd ',item) (list 'quote item))))))) - alist))) + `(keymap ,title + ,@(mapcar + (lambda (item) + `(,(car item) ,(car item) + ,@(cond + ((imenu--subalist-p item) + (imenu--create-keymap (car item) (cdr item) cmd)) + (t + `(lambda () (interactive) + ,(if cmd `(,cmd ',item) (list 'quote item))))))) + alist))) (defun imenu--in-alist (str alist) "Check whether the string STR is contained in multi-level ALIST." === modified file 'lisp/info-xref.el' --- lisp/info-xref.el 2012-01-19 07:21:25 +0000 +++ lisp/info-xref.el 2012-07-10 11:51:54 +0000 @@ -45,8 +45,7 @@ ;;; Code: (require 'info) -(eval-when-compile - (require 'cl)) ;; for `incf' +(eval-when-compile (require 'cl-lib)) ;; for `incf' ;;----------------------------------------------------------------------------- ;; vaguely generic @@ -239,11 +238,11 @@ ;; if the file exists, try the node (cond ((not (cdr (assoc file info-xref-xfile-alist))) - (incf info-xref-unavail)) + (cl-incf info-xref-unavail)) ((info-xref-goto-node-p node) - (incf info-xref-good)) + (cl-incf info-xref-good)) (t - (incf info-xref-bad) + (cl-incf info-xref-bad) (info-xref-output-error "no such node: %s" node))))))) @@ -447,8 +446,8 @@ (if (eq :tag (cadr link)) (setq link (cddr link))) (if (info-xref-goto-node-p (cadr link)) - (incf info-xref-good) - (incf info-xref-bad) + (cl-incf info-xref-good) + (cl-incf info-xref-bad) ;; symbol-file gives nil for preloaded variables, would need ;; to copy what describe-variable does to show the right place (info-xref-output "Symbol `%s' (file %s): cannot goto node: %s" === modified file 'lisp/info.el' --- lisp/info.el 2012-07-08 08:26:21 +0000 +++ lisp/info.el 2012-07-10 11:51:54 +0000 @@ -32,8 +32,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - (defgroup info nil "Info subsystem." :group 'help === modified file 'lisp/international/iso-ascii.el' --- lisp/international/iso-ascii.el 2012-02-08 02:12:24 +0000 +++ lisp/international/iso-ascii.el 2012-07-10 11:51:54 +0000 @@ -32,7 +32,6 @@ ;;; Code: (require 'disp-table) -(eval-when-compile (require 'cl)) (defgroup iso-ascii nil "Set up char tables for ISO 8859/1 on ASCII terminals." @@ -167,9 +166,14 @@ With a prefix argument ARG, enable the mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil." - :variable (eq standard-display-table iso-ascii-display-table) - (unless standard-display-table - (setq standard-display-table iso-ascii-standard-display-table))) + :variable ((eq standard-display-table iso-ascii-display-table) + . (lambda (v) + (setq standard-display-table + (cond + (v iso-ascii-display-table) + ((eq standard-display-table iso-ascii-display-table) + iso-ascii-standard-display-table) + (t standard-display-table)))))) (provide 'iso-ascii) === modified file 'lisp/international/quail.el' --- lisp/international/quail.el 2012-04-10 20:14:33 +0000 +++ lisp/international/quail.el 2012-07-10 11:51:54 +0000 @@ -53,7 +53,7 @@ ;;; Code: (require 'help-mode) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defgroup quail nil "Quail: multilingual input method." @@ -2395,10 +2395,10 @@ (let ((last-col-elt (or (nth (1- (* (1+ col) newrows)) single-list) (car (last single-list))))) - (incf width (+ (max 3 (length (car last-col-elt))) - 1 single-trans-width 1)))) + (cl-incf width (+ (max 3 (length (car last-col-elt))) + 1 single-trans-width 1)))) (< width window-width)) - (incf cols)) + (cl-incf cols)) (setq rows (/ (+ len cols -1) cols)) ;Round up. (let ((key-width (max 3 (length (car (nth (1- rows) single-list)))))) (insert "key") === modified file 'lisp/international/ucs-normalize.el' --- lisp/international/ucs-normalize.el 2012-01-19 07:21:25 +0000 +++ lisp/international/ucs-normalize.el 2012-07-10 11:51:54 +0000 @@ -109,7 +109,7 @@ (defconst ucs-normalize-version "1.2") -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (declare-function nfd "ucs-normalize" (char)) @@ -179,7 +179,7 @@ (let ((char 0) ccc decomposition) (mapc (lambda (start-end) - (do ((char (car start-end) (+ char 1))) ((> char (cdr start-end))) + (cl-do ((char (car start-end) (+ char 1))) ((> char (cdr start-end))) (setq ccc (ucs-normalize-ccc char)) (setq decomposition (get-char-code-property char 'decomposition)) @@ -270,7 +270,7 @@ (let (decomposition alist) (mapc (lambda (start-end) - (do ((char (car start-end) (+ char 1))) ((> char (cdr start-end))) + (cl-do ((char (car start-end) (+ char 1))) ((> char (cdr start-end))) (setq decomposition (funcall decomposition-function char)) (if decomposition (setq alist (cons (cons char @@ -391,7 +391,7 @@ (let (entries decomposition composition) (mapc (lambda (start-end) - (do ((i (car start-end) (+ i 1))) ((> i (cdr start-end))) + (cl-do ((i (car start-end) (+ i 1))) ((> i (cdr start-end))) (setq decomposition (string-to-list (with-temp-buffer === modified file 'lisp/jit-lock.el' --- lisp/jit-lock.el 2012-01-19 07:21:25 +0000 +++ lisp/jit-lock.el 2012-07-10 11:51:54 +0000 @@ -29,8 +29,6 @@ (eval-when-compile - (require 'cl) - (defmacro with-buffer-prepared-for-jit-lock (&rest body) "Execute BODY in current buffer, overriding several variables. Preserves the `buffer-modified-p' state of the current buffer." === modified file 'lisp/loadhist.el' --- lisp/loadhist.el 2012-05-13 03:05:06 +0000 +++ lisp/loadhist.el 2012-07-10 11:51:54 +0000 @@ -29,8 +29,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - (defun feature-symbols (feature) "Return the file and list of definitions associated with FEATURE. The value is actually the element of `load-history' @@ -254,11 +252,11 @@ (dolist (x unload-function-defs-list) (if (consp x) - (case (car x) + (pcase (car x) ;; Remove any feature names that this file provided. - (provide + (`provide (setq features (delq (cdr x) features))) - ((defun autoload) + ((or `defun `autoload) (let ((fun (cdr x))) (when (fboundp fun) (when (fboundp 'ad-unadvise) @@ -270,9 +268,9 @@ ;; (t . SYMBOL) comes before (defun . SYMBOL) ;; and says we should restore SYMBOL's autoload ;; when we undefine it. - ((t) (setq restore-autoload (cdr x))) - ((require defface) nil) - (t (message "Unexpected element %s in load-history" x))) + (`t (setq restore-autoload (cdr x))) + ((or `require `defface) nil) + (_ (message "Unexpected element %s in load-history" x))) ;; Kill local values as much as possible. (dolist (buf (buffer-list)) (with-current-buffer buf === modified file 'lisp/lpr.el' --- lisp/lpr.el 2012-01-19 07:21:25 +0000 +++ lisp/lpr.el 2012-07-10 11:51:54 +0000 @@ -29,8 +29,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - ;;;###autoload (defvar lpr-windows-system (memq system-type '(ms-dos windows-nt)) @@ -281,10 +279,10 @@ (if (markerp end) (set-marker end nil)) (message "Spooling%s...done%s%s" switch-string - (case (count-lines (point-min) (point-max)) + (pcase (count-lines (point-min) (point-max)) (0 "") (1 ": ") - (t ":\n")) + (_ ":\n")) (buffer-string))))))) ;; This function copies the text between start and end === modified file 'lisp/minibuffer.el' --- lisp/minibuffer.el 2012-06-29 06:28:37 +0000 +++ lisp/minibuffer.el 2012-07-10 11:51:54 +0000 @@ -81,7 +81,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;;; Completion table manipulation @@ -224,10 +224,10 @@ (cond ((eq (car-safe action) 'boundaries) (let ((beg (or (and (eq (car-safe res) 'boundaries) (cadr res)) 0))) - (list* 'boundaries - (max (length s1) - (+ beg (- (length s1) (length s2)))) - (and (eq (car-safe res) 'boundaries) (cddr res))))) + `(boundaries + ,(max (length s1) + (+ beg (- (length s1) (length s2)))) + . ,(and (eq (car-safe res) 'boundaries) (cddr res))))) ((stringp res) (if (eq t (compare-strings res 0 (length s2) s2 nil nil completion-ignore-case)) @@ -267,7 +267,7 @@ (if (eq (car-safe action) 'boundaries) (let* ((len (length prefix)) (bound (completion-boundaries string table pred (cdr action)))) - (list* 'boundaries (+ (car bound) len) (cdr bound))) + `(boundaries ,(+ (car bound) len) . ,(cdr bound))) (let ((comp (complete-with-action action table string pred))) (cond ;; In case of try-completion, add the prefix. @@ -300,8 +300,8 @@ (cdr terminator) (regexp-quote terminator))) (max (and terminator-regexp (string-match terminator-regexp suffix)))) - (list* 'boundaries (car bounds) - (min (cdr bounds) (or max (length suffix)))))) + `(boundaries ,(car bounds) + . ,(min (cdr bounds) (or max (length suffix)))))) ((eq action nil) (let ((comp (try-completion string table pred))) (if (consp terminator) (setq terminator (car terminator))) @@ -408,7 +408,7 @@ (qsuffix (cdr action)) (ufull (if (zerop (length qsuffix)) ustring (funcall unquote (concat string qsuffix)))) - (_ (assert (string-prefix-p ustring ufull))) + (_ (cl-assert (string-prefix-p ustring ufull))) (usuffix (substring ufull (length ustring))) (boundaries (completion-boundaries ustring table pred usuffix)) (qlboundary (car (funcall requote (car boundaries) string))) @@ -418,7 +418,7 @@ (- (car (funcall requote urfullboundary (concat string qsuffix))) (length string)))))) - (list* 'boundaries qlboundary qrboundary))) + `(boundaries ,qlboundary . ,qrboundary))) ;; In "normal" use a c-t-with-quoting completion table should never be ;; called with action in (t nil) because `completion--unquote' should have @@ -466,18 +466,18 @@ (let ((ustring (funcall unquote string)) (uprefix (funcall unquote (substring string 0 pred)))) ;; We presume (more or less) that `concat' and `unquote' commute. - (assert (string-prefix-p uprefix ustring)) + (cl-assert (string-prefix-p uprefix ustring)) (list ustring table (length uprefix) (lambda (unquoted-result op) (pcase op - (`1 ;;try + (1 ;;try (if (not (stringp (car-safe unquoted-result))) unquoted-result (completion--twq-try string ustring (car unquoted-result) (cdr unquoted-result) unquote requote))) - (`2 ;;all + (2 ;;all (let* ((last (last unquoted-result)) (base (or (cdr last) 0))) (when last @@ -527,12 +527,12 @@ (`(,qfullpos . ,qfun) (funcall requote (+ boundary (length prefix)) string)) (qfullprefix (substring string 0 qfullpos)) - (_ (assert (completion--string-equal-p - (funcall unquote qfullprefix) - (concat (substring ustring 0 boundary) prefix)) - t)) + (_ (cl-assert (completion--string-equal-p + (funcall unquote qfullprefix) + (concat (substring ustring 0 boundary) prefix)) + t)) (qboundary (car (funcall requote boundary string))) - (_ (assert (<= qboundary qfullpos))) + (_ (cl-assert (<= qboundary qfullpos))) ;; FIXME: this split/quote/concat business messes up the carefully ;; placed completions-common-part and completions-first-difference ;; faces. We could try within the mapcar loop to search for the @@ -555,11 +555,11 @@ ;; which only get quoted when needed by choose-completion. (nconc (mapcar (lambda (completion) - (assert (string-prefix-p prefix completion 'ignore-case) t) + (cl-assert (string-prefix-p prefix completion 'ignore-case) t) (let* ((new (substring completion (length prefix))) (qnew (funcall qfun new)) (qcompletion (concat qprefix qnew))) - (assert + (cl-assert (completion--string-equal-p (funcall unquote (concat (substring string 0 qboundary) @@ -994,9 +994,9 @@ 'exact 'unknown)))) ;; Show the completion table, if requested. ((not exact) - (if (case completion-auto-help - (lazy (eq this-command last-command)) - (t completion-auto-help)) + (if (pcase completion-auto-help + (`lazy (eq this-command last-command)) + (_ completion-auto-help)) (minibuffer-completion-help) (completion--message "Next char not unique"))) ;; If the last exact completion and this one were the same, it @@ -1041,9 +1041,9 @@ ((and completion-cycling completion-all-sorted-completions) (minibuffer-force-complete) t) - (t (case (completion--do-completion) + (t (pcase (completion--do-completion) (#b000 nil) - (t t))))) + (_ t))))) (defun completion--cache-all-sorted-completions (comps) (add-hook 'after-change-functions @@ -1203,15 +1203,15 @@ (t ;; Call do-completion, but ignore errors. - (case (condition-case nil + (pcase (condition-case nil (completion--do-completion nil 'expect-exact) (error 1)) - ((#b001 #b011) (exit-minibuffer)) + ((or #b001 #b011) (exit-minibuffer)) (#b111 (if (not minibuffer-completion-confirm) (exit-minibuffer) (minibuffer-message "Confirm") nil)) - (t nil)))))) + (_ nil)))))) (defun completion--try-word-completion (string table predicate point md) (let ((comp (completion-try-completion string table predicate point md))) @@ -1306,9 +1306,9 @@ is added, provided that matches some possible completion. Return nil if there is no valid completion, else t." (interactive) - (case (completion--do-completion 'completion--try-word-completion) + (pcase (completion--do-completion 'completion--try-word-completion) (#b000 nil) - (t t))) + (_ t))) (defface completions-annotations '((t :inherit italic)) "Face to use for annotations in the *Completions* buffer.") @@ -1555,7 +1555,7 @@ (defun completion--done (string &optional finished message) (let* ((exit-fun (plist-get completion-extra-properties :exit-function)) (pre-msg (and exit-fun (current-message)))) - (assert (memq finished '(exact sole finished unknown))) + (cl-assert (memq finished '(exact sole finished unknown))) ;; FIXME: exit-fun should receive `finished' as a parameter. (when exit-fun (when (eq finished 'unknown) @@ -1727,7 +1727,7 @@ Point needs to be somewhere between START and END. PREDICATE (a function called with no arguments) says when to exit." - (assert (<= start (point)) (<= (point) end)) + (cl-assert (<= start (point)) (<= (point) end)) (with-wrapper-hook ;; FIXME: Maybe we should use this hook to provide a "display ;; completions" operation as well. @@ -1794,7 +1794,7 @@ (unless (equal "*Completions*" (buffer-name (window-buffer))) (minibuffer-hide-completions)) ;; (add-hook 'pre-command-hook #'completion-in-region--prech) - (assert completion-in-region-mode-predicate) + (cl-assert completion-in-region-mode-predicate) (setq completion-in-region-mode--predicate completion-in-region-mode-predicate) (add-hook 'post-command-hook #'completion-in-region--postch) @@ -1837,10 +1837,10 @@ ;; always return the same kind of data, but this breaks down with functions ;; like comint-completion-at-point or mh-letter-completion-at-point, which ;; could be sometimes safe and sometimes misbehaving (and sometimes neither). - (if (case which - (all t) - (safe (member fun completion--capf-safe-funs)) - (optimist (not (member fun completion--capf-misbehave-funs)))) + (if (pcase which + (`all t) + (`safe (member fun completion--capf-safe-funs)) + (`optimist (not (member fun completion--capf-misbehave-funs)))) (let ((res (funcall fun))) (cond ((and (consp res) (not (functionp res))) @@ -2046,10 +2046,10 @@ (if (eq action 'metadata) '(metadata (category . environment-variable)) (let ((suffix (cdr action))) - (list* 'boundaries - (or (match-beginning 2) (match-beginning 1)) - (when (string-match "[^[:alnum:]_]" suffix) - (match-beginning 0))))))) + `(boundaries + ,(or (match-beginning 2) (match-beginning 1)) + . ,(when (string-match "[^[:alnum:]_]" suffix) + (match-beginning 0))))))) (t (if (eq (aref string (1- beg)) ?{) (setq table (apply-partially 'completion-table-with-terminator @@ -2074,14 +2074,14 @@ ((eq (car-safe action) 'boundaries) (let ((start (length (file-name-directory string))) (end (string-match-p "/" (cdr action)))) - (list* 'boundaries - ;; if `string' is "C:" in w32, (file-name-directory string) - ;; returns "C:/", so `start' is 3 rather than 2. - ;; Not quite sure what is The Right Fix, but clipping it - ;; back to 2 will work for this particular case. We'll - ;; see if we can come up with a better fix when we bump - ;; into more such problematic cases. - (min start (length string)) end))) + `(boundaries + ;; if `string' is "C:" in w32, (file-name-directory string) + ;; returns "C:/", so `start' is 3 rather than 2. + ;; Not quite sure what is The Right Fix, but clipping it + ;; back to 2 will work for this particular case. We'll + ;; see if we can come up with a better fix when we bump + ;; into more such problematic cases. + ,(min start (length string)) . ,end))) ((eq action 'lambda) (if (zerop (length string)) @@ -2663,7 +2663,7 @@ (setq p0 (1+ p))) (push 'any pattern) (setq p0 p)) - (incf p)) + (cl-incf p)) ;; An empty string might be erroneously added at the beginning. ;; It should be avoided properly, but it's so easy to remove it here. @@ -2688,7 +2688,7 @@ (defun completion-pcm--all-completions (prefix pattern table pred) "Find all completions for PATTERN in TABLE obeying PRED. PATTERN is as returned by `completion-pcm--string->pattern'." - ;; (assert (= (car (completion-boundaries prefix table pred "")) + ;; (cl-assert (= (car (completion-boundaries prefix table pred "")) ;; (length prefix))) ;; Find an initial list of possible completions. (if (completion-pcm--pattern-trivial-p pattern) @@ -2762,9 +2762,9 @@ ;; The prefix has no completions at all, so we should try and fix ;; that first. (let ((substring (substring prefix 0 -1))) - (destructuring-bind (subpat suball subprefix _subsuffix) - (completion-pcm--find-all-completions - substring table pred (length substring) filter) + (pcase-let ((`(,subpat ,suball ,subprefix ,_subsuffix) + (completion-pcm--find-all-completions + substring table pred (length substring) filter))) (let ((sep (aref prefix (1- (length prefix)))) ;; Text that goes between the new submatches and the ;; completion substring. @@ -2828,8 +2828,8 @@ (list pattern all prefix suffix))))) (defun completion-pcm-all-completions (string table pred point) - (destructuring-bind (pattern all &optional prefix _suffix) - (completion-pcm--find-all-completions string table pred point) + (pcase-let ((`(,pattern ,all ,prefix ,_suffix) + (completion-pcm--find-all-completions string table pred point))) (when all (nconc (completion-pcm--hilit-commonality pattern all) (length prefix))))) @@ -2928,7 +2928,7 @@ ;; `any' it could lead to a merged completion that ;; doesn't itself match the candidates. (let ((suffix (completion--common-suffix comps))) - (assert (stringp suffix)) + (cl-assert (stringp suffix)) (unless (equal suffix "") (push suffix res))))) (setq fixed ""))))) @@ -2992,11 +2992,11 @@ (cons (concat prefix merged suffix) (+ newpos (length prefix))))))) (defun completion-pcm-try-completion (string table pred point) - (destructuring-bind (pattern all prefix suffix) - (completion-pcm--find-all-completions - string table pred point - (if minibuffer-completing-file-name - 'completion-pcm--filename-try-filter)) + (pcase-let ((`(,pattern ,all ,prefix ,suffix) + (completion-pcm--find-all-completions + string table pred point + (if minibuffer-completing-file-name + 'completion-pcm--filename-try-filter)))) (completion-pcm--merge-try pattern all prefix suffix))) ;;; Substring completion @@ -3017,15 +3017,17 @@ (list all pattern prefix suffix (car bounds)))) (defun completion-substring-try-completion (string table pred point) - (destructuring-bind (all pattern prefix suffix _carbounds) - (completion-substring--all-completions string table pred point) + (pcase-let ((`(,all ,pattern ,prefix ,suffix ,_carbounds) + (completion-substring--all-completions + string table pred point))) (if minibuffer-completing-file-name (setq all (completion-pcm--filename-try-filter all))) (completion-pcm--merge-try pattern all prefix suffix))) (defun completion-substring-all-completions (string table pred point) - (destructuring-bind (all pattern prefix _suffix _carbounds) - (completion-substring--all-completions string table pred point) + (pcase-let ((`(,all ,pattern ,prefix ,_suffix ,_carbounds) + (completion-substring--all-completions + string table pred point))) (when all (nconc (completion-pcm--hilit-commonality pattern all) (length prefix))))) === modified file 'lisp/mpc.el' --- lisp/mpc.el 2012-04-26 12:43:28 +0000 +++ lisp/mpc.el 2012-07-10 11:51:54 +0000 @@ -92,7 +92,7 @@ ;; UI-commands : mpc- ;; internal : mpc-- -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defgroup mpc () "Client for the Music Player Daemon (mpd)." @@ -292,7 +292,7 @@ (defconst mpc--proc-alist-to-alists-starters '(file directory)) (defun mpc--proc-alist-to-alists (alist) - (assert (or (null alist) + (cl-assert (or (null alist) (memq (caar alist) mpc--proc-alist-to-alists-starters))) (let ((starter (caar alist)) (alists ()) @@ -457,7 +457,7 @@ (let ((old-status mpc-status)) ;; Update the alist. (setq mpc-status (mpc-proc-buf-to-alist)) - (assert mpc-status) + (cl-assert mpc-status) (unless (equal old-status mpc-status) ;; Run the relevant refresher functions. (dolist (pair mpc-status-callbacks) @@ -544,7 +544,7 @@ ;; (defun mpc--queue-pop () ;; (when mpc-queue ;Can be nil if out of sync. ;; (let ((song (car mpc-queue))) -;; (assert song) +;; (cl-assert song) ;; (push (if (and (consp song) (cddr song)) ;; ;; The queue's first element is itself a list of ;; ;; songs, where the first element isn't itself a song @@ -553,7 +553,7 @@ ;; (prog1 (if (consp song) (cadr song) song) ;; (setq mpc-queue (cdr mpc-queue)))) ;; mpc-queue-back) -;; (assert (stringp (car mpc-queue-back)))))) +;; (cl-assert (stringp (car mpc-queue-back)))))) ;; (defun mpc--queue-refresh () ;; ;; Maintain the queue. @@ -611,7 +611,7 @@ (i 0)) (mapcar (lambda (s) (prog1 (cons (cons 'Pos (number-to-string i)) s) - (incf i))) + (cl-incf i))) l))) ((eq tag 'Search) (mpc-proc-buf-to-alists @@ -827,8 +827,8 @@ (list "move" song-pos dest-pos)) (if (< song-pos dest-pos) ;; This move has shifted dest-pos by 1. - (decf dest-pos)) - (incf i))) + (cl-decf dest-pos)) + (cl-incf i))) ;; Sort them from last to first, so the renumbering ;; caused by the earlier deletions affect ;; later ones a bit less. @@ -972,8 +972,8 @@ (right-align (match-end 1)) (text (if (eq info 'self) (symbol-name tag) - (case tag - ((Time Duration) + (pcase tag + ((or `Time `Duration) (let ((time (cdr (or (assq 'time info) (assq 'Time info))))) (setq pred (list nil)) ;Just assume it's never eq. (when time @@ -981,7 +981,7 @@ (string-match ":" time)) (substring time (match-end 0)) time))))) - (Cover + (`Cover (let* ((dir (file-name-directory (cdr (assq 'file info)))) (cover (concat dir "cover.jpg")) (file (condition-case err @@ -1004,7 +1004,7 @@ (mpc-tempfiles-add image tempfile))) (setq size nil) (propertize dir 'display image)))) - (t (let ((val (cdr (assq tag info)))) + (_ (let ((val (cdr (assq tag info)))) ;; For Streaming URLs, there's no other info ;; than the URL in `file'. Pretend it's in `Title'. (when (and (null val) (eq tag 'Title)) @@ -1222,7 +1222,7 @@ (beginning-of-line)) (defun mpc-select-make-overlay () - (assert (not (get-char-property (point) 'mpc-select))) + (cl-assert (not (get-char-property (point) 'mpc-select))) (let ((ol (make-overlay (line-beginning-position) (line-beginning-position 2)))) (overlay-put ol 'mpc-select t) @@ -1258,7 +1258,7 @@ (> (overlay-end ol) (point))) (delete-overlay ol) (push ol ols))) - (assert (= (1+ (length ols)) (length mpc-select))) + (cl-assert (= (1+ (length ols)) (length mpc-select))) (setq mpc-select ols))) ;; We're trying to select *ALL* additionally to others. ((mpc-tagbrowser-all-p) nil) @@ -1286,12 +1286,12 @@ (while (and (zerop (forward-line 1)) (get-char-property (point) 'mpc-select)) (setq end (1+ (point))) - (incf after)) + (cl-incf after)) (goto-char mid) (while (and (zerop (forward-line -1)) (get-char-property (point) 'mpc-select)) (setq start (point)) - (incf before)) + (cl-incf before)) (if (and (= after 0) (= before 0)) ;; Shortening an already minimum-size region: do nothing. nil @@ -1315,13 +1315,13 @@ (start (line-beginning-position))) (while (and (zerop (forward-line 1)) (not (get-char-property (point) 'mpc-select))) - (incf count)) + (cl-incf count)) (unless (get-char-property (point) 'mpc-select) (setq count nil)) (goto-char start) (while (and (zerop (forward-line -1)) (not (get-char-property (point) 'mpc-select))) - (incf before)) + (cl-incf before)) (unless (get-char-property (point) 'mpc-select) (setq before nil)) (when (and before (or (null count) (< before count))) @@ -1430,7 +1430,7 @@ (mpc-select-save (widen) (goto-char (point-min)) - (assert (looking-at (regexp-quote mpc-tagbrowser-all-name))) + (cl-assert (looking-at (regexp-quote mpc-tagbrowser-all-name))) (forward-line 1) (let ((inhibit-read-only t)) (delete-region (point) (point-max)) @@ -1916,7 +1916,7 @@ (cdr (assq 'file song1)) (cdr (assq 'file song2))))) (and (integerp cmp) (< cmp 0))))))) - (incf totaltime (string-to-number (or (cdr (assq 'Time song)) "0"))) + (cl-incf totaltime (string-to-number (or (cdr (assq 'Time song)) "0"))) (mpc-format mpc-songs-format song) (delete-char (- (skip-chars-backward " "))) ;Remove trailing space. (insert "\n") @@ -2040,7 +2040,7 @@ (- (point) (car prev))) next prev) (or next prev))))) - (assert sn) + (cl-assert sn) (mpc-proc-cmd (concat "play " sn)))))))))) (define-derived-mode mpc-songs-mode mpc-mode "MPC-song" @@ -2155,12 +2155,12 @@ (dolist (song (car context)) (and (zerop (forward-line -1)) (eq (get-text-property (point) 'mpc-file) song) - (incf count))) + (cl-incf count))) (goto-char pos) (dolist (song (cdr context)) (and (zerop (forward-line 1)) (eq (get-text-property (point) 'mpc-file) song) - (incf count))) + (cl-incf count))) count)) (defun mpc-songpointer-refresh-hairy () @@ -2201,13 +2201,13 @@ ((< score context-size) nil) (t ;; Score is equal and increasing context might help: try it. - (incf context-size) + (cl-incf context-size) (let ((new-context (mpc-songpointer-context context-size plbuf))) (if (null new-context) ;; There isn't more context: choose one arbitrarily ;; and keep looking for a better match elsewhere. - (decf context-size) + (cl-decf context-size) (setq context new-context) (setq score (mpc-songpointer-score context pos)) (save-excursion === modified file 'lisp/msb.el' --- lisp/msb.el 2012-04-09 13:05:48 +0000 +++ lisp/msb.el 2012-07-10 11:51:54 +0000 @@ -77,13 +77,13 @@ ;; hacked on by Dave Love. ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) -;;; -;;; Some example constants to be used for `msb-menu-cond'. See that -;;; variable for more information. Please note that if the condition -;;; returns `multi', then the buffer can appear in several menus. -;;; +;; +;; Some example constants to be used for `msb-menu-cond'. See that +;; variable for more information. Please note that if the condition +;; returns `multi', then the buffer can appear in several menus. +;; (defconst msb--few-menus '(((and (boundp 'server-buffer-clients) server-buffer-clients @@ -702,18 +702,18 @@ (multi-flag nil) function-info-list) (setq function-info-list - (loop for fi - across function-info-vector - if (and (setq result - (eval (aref fi 1))) ;Test CONDITION - (not (and (eq result 'no-multi) - multi-flag)) - (progn (when (eq result 'multi) - (setq multi-flag t)) - t)) - collect fi - until (and result - (not (eq result 'multi))))) + (cl-loop for fi + across function-info-vector + if (and (setq result + (eval (aref fi 1))) ;Test CONDITION + (not (and (eq result 'no-multi) + multi-flag)) + (progn (when (eq result 'multi) + (setq multi-flag t)) + t)) + collect fi + until (and result + (not (eq result 'multi))))) (when (and (not function-info-list) (not result)) (error "No catch-all in msb-menu-cond!")) @@ -817,7 +817,7 @@ (defun msb--mode-menu-cond () (let ((key msb-modes-key)) (mapcar (lambda (item) - (incf key) + (cl-incf key) (list `( eq major-mode (quote ,(car item))) key (concat (cdr item) " (%d)"))) @@ -841,18 +841,18 @@ (> msb-display-most-recently-used 0)) (let* ((buffers (cdr (buffer-list))) (most-recently-used - (loop with n = 0 - for buffer in buffers - if (with-current-buffer buffer - (and (not (msb-invisible-buffer-p)) - (not (eq major-mode 'dired-mode)))) - collect (with-current-buffer buffer - (cons (funcall msb-item-handling-function - buffer - max-buffer-name-length) - buffer)) - and do (incf n) - until (>= n msb-display-most-recently-used)))) + (cl-loop with n = 0 + for buffer in buffers + if (with-current-buffer buffer + (and (not (msb-invisible-buffer-p)) + (not (eq major-mode 'dired-mode)))) + collect (with-current-buffer buffer + (cons (funcall msb-item-handling-function + buffer + max-buffer-name-length) + buffer)) + and do (cl-incf n) + until (>= n msb-display-most-recently-used)))) (cons (if (stringp msb-most-recently-used-title) (format msb-most-recently-used-title (length most-recently-used)) @@ -899,29 +899,29 @@ (when file-buffers (setq file-buffers (mapcar (lambda (buffer-list) - (list* msb-files-by-directory-sort-key - (car buffer-list) - (sort - (mapcar (lambda (buffer) - (cons (with-current-buffer buffer - (funcall - msb-item-handling-function - buffer - max-buffer-name-length)) - buffer)) - (cdr buffer-list)) - (lambda (item1 item2) - (string< (car item1) (car item2)))))) + `(,msb-files-by-directory-sort-key + ,(car buffer-list) + ,@(sort + (mapcar (lambda (buffer) + (cons (with-current-buffer buffer + (funcall + msb-item-handling-function + buffer + max-buffer-name-length)) + buffer)) + (cdr buffer-list)) + (lambda (item1 item2) + (string< (car item1) (car item2)))))) (msb--choose-file-menu file-buffers)))) ;; Now make the menu - a list of (TITLE . BUFFER-LIST) (let* (menu (most-recently-used (msb--most-recently-used-menu max-buffer-name-length)) (others (nconc file-buffers - (loop for elt - across function-info-vector - for value = (msb--create-sort-item elt) - if value collect value)))) + (cl-loop for elt + across function-info-vector + for value = (msb--create-sort-item elt) + if value collect value)))) (setq menu (mapcar 'cdr ;Remove the SORT-KEY ;; Sort the menus - not the items. @@ -1039,7 +1039,7 @@ (tmp-list nil)) (while (< count msb-max-menu-items) (push (pop list) tmp-list) - (incf count)) + (cl-incf count)) (setq tmp-list (nreverse tmp-list)) (setq sub-name (concat (car (car tmp-list)) "...")) (push (nconc (list mcount sub-name @@ -1076,7 +1076,7 @@ (cons (buffer-name (cdr item)) (cons (car item) end))) (cdr sub-menu)))) - (nconc (list (incf mcount) (car sub-menu) + (nconc (list (cl-incf mcount) (car sub-menu) 'keymap (car sub-menu)) (msb--split-menus buffers)))))) raw-menu))) === modified file 'lisp/net/dbus.el' --- lisp/net/dbus.el 2012-06-13 11:56:53 +0000 +++ lisp/net/dbus.el 2012-07-10 11:51:54 +0000 @@ -45,8 +45,7 @@ (defvar dbus-registered-objects-table) ;; Pacify byte compiler. -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'xml) @@ -494,20 +493,20 @@ (dolist (flag flags) (setq arg (+ arg - (case flag + (pcase flag (:allow-replacement 1) (:replace-existing 2) (:do-not-queue 4) - (t (signal 'wrong-type-argument (list flag))))))) + (_ (signal 'wrong-type-argument (list flag))))))) (setq reply (dbus-call-method bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "RequestName" service arg)) - (case reply + (pcase reply (1 :primary-owner) (2 :in-queue) (3 :exists) (4 :already-owner) - (t (signal 'dbus-error (list "Could not register service" service)))))) + (_ (signal 'dbus-error (list "Could not register service" service)))))) (defun dbus-unregister-service (bus service) "Unregister all objects related to SERVICE from D-Bus BUS. @@ -536,11 +535,11 @@ (let ((reply (dbus-call-method bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ReleaseName" service))) - (case reply + (pcase reply (1 :released) (2 :non-existent) (3 :not-owner) - (t (signal 'dbus-error (list "Could not unregister service" service)))))) + (_ (signal 'dbus-error (list "Could not unregister service" service)))))) (defun dbus-register-signal (bus service path interface signal handler &rest args) @@ -803,7 +802,7 @@ ;; Service. (string-equal service (cadr e)) ;; Non-empty object path. - (caddr e) + (cl-caddr e) (throw :found t))))) dbus-registered-objects-table) nil)))) @@ -1383,7 +1382,7 @@ bus service path dbus-interface-properties "GetAll" :timeout 500 interface) result) - (add-to-list 'result (cons (car dict) (caadr dict)) 'append))))) + (add-to-list 'result (cons (car dict) (cl-caadr dict)) 'append))))) (defun dbus-register-property (bus service path interface property access value @@ -1581,7 +1580,7 @@ (if (cadr entry2) ;; "sv". (dolist (entry3 (cadr entry2)) - (setcdr entry3 (caadr entry3))) + (setcdr entry3 (cl-caadr entry3))) (setcdr entry2 nil))))) ;; Fallback: collect the information. Slooow! === modified file 'lisp/net/gnutls.el' --- lisp/net/gnutls.el 2012-05-16 02:49:19 +0000 +++ lisp/net/gnutls.el 2012-07-10 11:51:54 +0000 @@ -35,7 +35,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defgroup gnutls nil "Emacs interface to the GnuTLS library." @@ -120,7 +120,7 @@ (declare-function gnutls-boot "gnutls.c" (proc type proplist)) (declare-function gnutls-errorp "gnutls.c" (error)) -(defun* gnutls-negotiate +(cl-defun gnutls-negotiate (&rest spec &key process type hostname priority-string trustfiles crlfiles keylist min-prime-bits === modified file 'lisp/pcomplete.el' --- lisp/pcomplete.el 2012-04-25 18:53:57 +0000 +++ lisp/pcomplete.el 2012-07-10 11:51:54 +0000 @@ -118,7 +118,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) (require 'comint) (defgroup pcomplete nil @@ -875,9 +874,9 @@ ;; The env-var is "out of bounds". (if (eq action t) (complete-with-action action table newstring pred) - (list* 'boundaries - (+ (car bounds) (- orig-length (length newstring))) - (cdr bounds))) + `(boundaries + ,(+ (car bounds) (- orig-length (length newstring))) + . ,(cdr bounds))) ;; The env-var is in the file bounds. (if (eq action t) (let ((comps (complete-with-action @@ -886,9 +885,9 @@ ;; Strip the part of each completion that's actually ;; coming from the env-var. (mapcar (lambda (s) (substring s len)) comps)) - (list* 'boundaries - (+ envpos (- orig-length (length newstring))) - (cdr bounds)))))))))) + `(boundaries + ,(+ envpos (- orig-length (length newstring))) + . ,(cdr bounds)))))))))) (defsubst pcomplete-all-entries (&optional regexp predicate) "Like `pcomplete-entries', but doesn't ignore any entries." === modified file 'lisp/progmodes/sh-script.el' --- lisp/progmodes/sh-script.el 2012-05-11 14:24:50 +0000 +++ lisp/progmodes/sh-script.el 2012-07-10 11:51:54 +0000 @@ -198,7 +198,7 @@ (eval-when-compile (require 'skeleton) - (require 'cl) + (require 'cl-lib) (require 'comint)) (require 'executable) @@ -987,31 +987,31 @@ (while (and state (progn (skip-chars-forward "^'\\\\\"`$()" limit) (< (point) limit))) ;; unescape " inside a $( ... ) construct. - (case (char-after) - (?\' (case state - (double-quote nil) - (t (forward-char 1) (skip-chars-forward "^'" limit)))) + (pcase (char-after) + (?\' (pcase state + (`double-quote nil) + (_ (forward-char 1) (skip-chars-forward "^'" limit)))) (?\\ (forward-char 1)) - (?\" (case state - (double-quote (setq state (pop states))) - (t (push state states) (setq state 'double-quote))) + (?\" (pcase state + (`double-quote (setq state (pop states))) + (_ (push state states) (setq state 'double-quote))) (if state (put-text-property (point) (1+ (point)) 'syntax-table '(1)))) - (?\` (case state - (backquote (setq state (pop states))) - (t (push state states) (setq state 'backquote)))) + (?\` (pcase state + (`backquote (setq state (pop states))) + (_ (push state states) (setq state 'backquote)))) (?\$ (if (not (eq (char-after (1+ (point))) ?\()) nil (forward-char 1) - (case state - (t (push state states) (setq state 'code))))) - (?\( (case state - (double-quote nil) - (t (push state states) (setq state 'code)))) - (?\) (case state - (double-quote nil) - (t (setq state (pop states))))) - (t (error "Internal error in sh-font-lock-quoted-subshell"))) + (pcase state + (_ (push state states) (setq state 'code))))) + (?\( (pcase state + (`double-quote nil) + (_ (push state states) (setq state 'code)))) + (?\) (pcase state + (`double-quote nil) + (_ (setq state (pop states))))) + (_ (error "Internal error in sh-font-lock-quoted-subshell"))) (forward-char 1))))) @@ -1105,7 +1105,6 @@ (save-excursion (sh-font-lock-quoted-subshell end))))))) (point) end)) - (defun sh-font-lock-syntactic-face-function (state) (let ((q (nth 3 state))) (if q @@ -1649,7 +1648,7 @@ (cond ((zerop (length prev)) (if newline - (progn (assert words) (setq res 'word)) + (progn (cl-assert words) (setq res 'word)) (setq words t) (condition-case nil (forward-sexp -1) @@ -1661,7 +1660,7 @@ ((assoc prev smie-grammar) (setq res 'word)) (t (if newline - (progn (assert words) (setq res 'word)) + (progn (cl-assert words) (setq res 'word)) (setq words t))))) (eq res 'keyword))) === modified file 'lisp/register.el' --- lisp/register.el 2012-01-19 07:21:25 +0000 +++ lisp/register.el 2012-07-10 11:51:54 +0000 @@ -28,7 +28,7 @@ ;; pieces of buffer state to named variables. The entry points are ;; documented in the Emacs user's manual. -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (declare-function semantic-insert-foreign-tag "semantic/tag" (foreign-tag)) (declare-function semantic-tag-buffer "semantic/tag" (tag)) @@ -52,7 +52,7 @@ ;;; Code: -(defstruct +(cl-defstruct (registerv (:constructor nil) (:constructor registerv--make (&optional data print-func jump-func insert-func)) @@ -64,7 +64,7 @@ (jump-func nil :read-only t) (insert-func nil :read-only t)) -(defun* registerv-make (data &key print-func jump-func insert-func) +(cl-defun registerv-make (data &key print-func jump-func insert-func) "Create a register value object. DATA can be any value. @@ -150,7 +150,7 @@ (let ((val (get-register register))) (cond ((registerv-p val) - (assert (registerv-jump-func val) nil + (cl-assert (registerv-jump-func val) nil "Don't know how to jump to register %s" (single-key-description register)) (funcall (registerv-jump-func val) (registerv-data val))) @@ -325,7 +325,7 @@ (let ((val (get-register register))) (cond ((registerv-p val) - (assert (registerv-insert-func val) nil + (cl-assert (registerv-insert-func val) nil "Don't know how to insert register %s" (single-key-description register)) (funcall (registerv-insert-func val) (registerv-data val))) === modified file 'lisp/scroll-bar.el' --- lisp/scroll-bar.el 2012-06-22 13:42:38 +0000 +++ lisp/scroll-bar.el 2012-07-10 11:51:54 +0000 @@ -29,7 +29,7 @@ ;;; Code: (require 'mouse) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;;;; Utilities. @@ -112,8 +112,9 @@ ;; If it is set again, that is for real. (setq scroll-bar-mode-explicit t) -(defun get-scroll-bar-mode () scroll-bar-mode) -(defsetf get-scroll-bar-mode set-scroll-bar-mode) +(defun get-scroll-bar-mode () + (declare (gv-setter set-scroll-bar-mode)) + scroll-bar-mode) (define-minor-mode scroll-bar-mode "Toggle vertical scroll bars on all frames (Scroll Bar mode). === modified file 'lisp/simple.el' --- lisp/simple.el 2012-07-08 06:09:21 +0000 +++ lisp/simple.el 2012-07-10 11:51:54 +0000 @@ -28,8 +28,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) ;For define-minor-mode. - (declare-function widget-convert "wid-edit" (type &rest args)) (declare-function shell-mode "shell" ()) === modified file 'lisp/uniquify.el' --- lisp/uniquify.el 2012-01-19 07:21:25 +0000 +++ lisp/uniquify.el 2012-07-10 11:51:54 +0000 @@ -83,7 +83,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;;; User-visible variables @@ -174,7 +174,7 @@ ;;; Utilities ;; uniquify-fix-list data structure -(defstruct (uniquify-item +(cl-defstruct (uniquify-item (:constructor nil) (:copier nil) (:constructor uniquify-make-item (base dirname buffer &optional proposed))) @@ -340,7 +340,7 @@ (defun uniquify-get-proposed-name (base dirname &optional depth) (unless depth (setq depth uniquify-min-dir-content)) - (assert (equal (directory-file-name dirname) dirname)) ;No trailing slash. + (cl-assert (equal (directory-file-name dirname) dirname)) ;No trailing slash. ;; Distinguish directories by adding extra separator. (if (and uniquify-trailing-separator-p === modified file 'lisp/vc/cvs-status.el' --- lisp/vc/cvs-status.el 2012-04-09 13:05:48 +0000 +++ lisp/vc/cvs-status.el 2012-07-10 11:51:54 +0000 @@ -28,7 +28,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'pcvs-util) ;;; @@ -165,7 +165,7 @@ ;; Tagelt, tag element ;; -(defstruct (cvs-tag +(cl-defstruct (cvs-tag (:constructor nil) (:constructor cvs-tag-make (vlist &optional name type)) @@ -235,9 +235,9 @@ (save-excursion (or (= (forward-line 1) 0) (insert "\n")) (cvs-tree-print rest printer column)))) - (assert (>= prefix column)) + (cl-assert (>= prefix column)) (move-to-column prefix t) - (assert (eolp)) + (cl-assert (eolp)) (insert (cvs-car name)) (dolist (br (cvs-cdr rev)) (let* ((column (current-column)) @@ -258,7 +258,7 @@ (defun cvs-tree-merge (tree1 tree2) "Merge tags trees TREE1 and TREE2 into one. BEWARE: because of stability issues, this is not a symmetric operation." - (assert (and (listp tree1) (listp tree2))) + (cl-assert (and (listp tree1) (listp tree2))) (cond ((null tree1) tree2) ((null tree2) tree1) @@ -273,10 +273,10 @@ (l2 (length vl2))) (cond ((= l1 l2) - (case (cvs-tag-compare tag1 tag2) - (more1 (list* rev2 (cvs-tree-merge tree1 (cdr tree2)))) - (more2 (list* rev1 (cvs-tree-merge (cdr tree1) tree2))) - (equal + (pcase (cvs-tag-compare tag1 tag2) + (`more1 (cons rev2 (cvs-tree-merge tree1 (cdr tree2)))) + (`more2 (cons rev1 (cvs-tree-merge (cdr tree1) tree2))) + (`equal (cons (cons (cvs-tag-merge tag1 tag2) (cvs-tree-merge (cvs-cdr rev1) (cvs-cdr rev2))) (cvs-tree-merge (cdr tree1) (cdr tree2)))))) @@ -399,35 +399,35 @@ Otherwise, default to ASCII chars like +, - and |.") (defconst cvs-tree-char-space - (case cvs-tree-use-charset - (jisx0208 (make-char 'japanese-jisx0208 33 33)) - (unicode " ") - (t " "))) + (pcase cvs-tree-use-charset + (`jisx0208 (make-char 'japanese-jisx0208 33 33)) + (`unicode " ") + (_ " "))) (defconst cvs-tree-char-hbar - (case cvs-tree-use-charset - (jisx0208 (make-char 'japanese-jisx0208 40 44)) - (unicode "━") - (t "--"))) + (pcase cvs-tree-use-charset + (`jisx0208 (make-char 'japanese-jisx0208 40 44)) + (`unicode "━") + (_ "--"))) (defconst cvs-tree-char-vbar - (case cvs-tree-use-charset - (jisx0208 (make-char 'japanese-jisx0208 40 45)) - (unicode "┃") - (t "| "))) + (pcase cvs-tree-use-charset + (`jisx0208 (make-char 'japanese-jisx0208 40 45)) + (`unicode "┃") + (_ "| "))) (defconst cvs-tree-char-branch - (case cvs-tree-use-charset - (jisx0208 (make-char 'japanese-jisx0208 40 50)) - (unicode "┣") - (t "+-"))) + (pcase cvs-tree-use-charset + (`jisx0208 (make-char 'japanese-jisx0208 40 50)) + (`unicode "┣") + (_ "+-"))) (defconst cvs-tree-char-eob ;end of branch - (case cvs-tree-use-charset - (jisx0208 (make-char 'japanese-jisx0208 40 49)) - (unicode "┗") - (t "`-"))) + (pcase cvs-tree-use-charset + (`jisx0208 (make-char 'japanese-jisx0208 40 49)) + (`unicode "┗") + (_ "`-"))) (defconst cvs-tree-char-bob ;beginning of branch - (case cvs-tree-use-charset - (jisx0208 (make-char 'japanese-jisx0208 40 51)) - (unicode "┳") - (t "+-"))) + (pcase cvs-tree-use-charset + (`jisx0208 (make-char 'japanese-jisx0208 40 51)) + (`unicode "┳") + (_ "+-"))) (defun cvs-tag-lessp (tag1 tag2) (eq (cvs-tag-compare tag1 tag2) 'more2)) @@ -485,9 +485,9 @@ (pe t) ;"prev equal" (nas nil)) ;"next afters" to be returned (insert " ") - (do* ((vs vlist (cdr vs)) - (ps prev (cdr ps)) - (as after (cdr as))) + (cl-do* ((vs vlist (cdr vs)) + (ps prev (cdr ps)) + (as after (cdr as))) ((and (null as) (null vs) (null ps)) (let ((revname (cvs-status-vl-to-str vlist))) (if (cvs-every 'identity (cvs-map 'equal prev vlist)) === modified file 'lisp/vc/diff-mode.el' --- lisp/vc/diff-mode.el 2012-06-29 06:28:37 +0000 +++ lisp/vc/diff-mode.el 2012-07-10 11:51:54 +0000 @@ -53,7 +53,7 @@ ;; - Handle `diff -b' output in context->unified. ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defvar add-log-buffer-file-name-function) @@ -493,14 +493,15 @@ ;; We may have a first evaluation of `end' thanks to the hunk header. (unless end (setq end (and (re-search-forward - (case style - (unified (concat (if diff-valid-unified-empty-line - "^[^-+# \\\n]\\|" "^[^-+# \\]\\|") - ;; A `unified' header is ambiguous. - diff-file-header-re)) - (context "^[^-+#! \\]") - (normal "^[^<>#\\]") - (t "^[^-+#!<> \\]")) + (pcase style + (`unified + (concat (if diff-valid-unified-empty-line + "^[^-+# \\\n]\\|" "^[^-+# \\]\\|") + ;; A `unified' header is ambiguous. + diff-file-header-re)) + (`context "^[^-+#! \\]") + (`normal "^[^<>#\\]") + (_ "^[^-+#!<> \\]")) nil t) (match-beginning 0))) (when diff-valid-unified-empty-line @@ -710,7 +711,7 @@ (save-excursion (let ((n 0)) (goto-char start) - (while (re-search-forward re end t) (incf n)) + (while (re-search-forward re end t) (cl-incf n)) n))) (defun diff-splittable-p () @@ -834,16 +835,16 @@ ;; use any previously used preference (cdr (assoc fs diff-remembered-files-alist)) ;; try to be clever and use previous choices as an inspiration - (dolist (rf diff-remembered-files-alist) + (cl-dolist (rf diff-remembered-files-alist) (let ((newfile (diff-merge-strings (caar rf) (car fs) (cdr rf)))) - (if (and newfile (file-exists-p newfile)) (return newfile)))) + (if (and newfile (file-exists-p newfile)) (cl-return newfile)))) ;; look for each file in turn. If none found, try again but ;; ignoring the first level of directory, ... - (do* ((files fs (delq nil (mapcar 'diff-filename-drop-dir files))) - (file nil nil)) + (cl-do* ((files fs (delq nil (mapcar 'diff-filename-drop-dir files))) + (file nil nil)) ((or (null files) - (setq file (do* ((files files (cdr files)) - (file (car files) (car files))) + (setq file (cl-do* ((files files (cdr files)) + (file (car files) (car files))) ;; Use file-regular-p to avoid ;; /dev/null, directories, etc. ((or (null file) (file-regular-p file)) @@ -862,7 +863,7 @@ (diff-find-file-name old noprompt (match-string 1))) ;; if all else fails, ask the user (unless noprompt - (let ((file (expand-file-name (or (first fs) "")))) + (let ((file (expand-file-name (or (car fs) "")))) (setq file (read-file-name (format "Use file %s: " file) (file-name-directory file) file t @@ -940,21 +941,23 @@ (let ((modif nil) last-pt) (while (progn (setq last-pt (point)) (= (forward-line -1) 0)) - (case (char-after) + (pcase (char-after) (?\s (insert " ") (setq modif nil) (backward-char 1)) (?+ (delete-region (point) last-pt) (setq modif t)) (?- (if (not modif) - (progn (forward-char 1) - (insert " ")) - (delete-char 1) - (insert "! ")) - (backward-char 2)) + (progn (forward-char 1) + (insert " ")) + (delete-char 1) + (insert "! ")) + (backward-char 2)) (?\\ (when (save-excursion (forward-line -1) - (= (char-after) ?+)) - (delete-region (point) last-pt) (setq modif t))) + (= (char-after) ?+)) + (delete-region (point) last-pt) + (setq modif t))) ;; diff-valid-unified-empty-line. - (?\n (insert " ") (setq modif nil) (backward-char 2)) - (t (setq modif nil)))))) + (?\n (insert " ") (setq modif nil) + (backward-char 2)) + (_ (setq modif nil)))))) (goto-char (point-max)) (save-excursion (insert "--- " line2 "," @@ -967,7 +970,8 @@ (if (not (save-excursion (re-search-forward "^+" nil t))) (delete-region (point) (point-max)) (let ((modif nil) (delete nil)) - (if (save-excursion (re-search-forward "^\\+.*\n-" nil t)) + (if (save-excursion (re-search-forward "^\\+.*\n-" + nil t)) ;; Normally, lines in a substitution come with ;; first the removals and then the additions, and ;; the context->unified function follows this @@ -976,22 +980,22 @@ ;; context->unified as an undo command. (setq reversible nil)) (while (not (eobp)) - (case (char-after) + (pcase (char-after) (?\s (insert " ") (setq modif nil) (backward-char 1)) (?- (setq delete t) (setq modif t)) (?+ (if (not modif) - (progn (forward-char 1) - (insert " ")) - (delete-char 1) - (insert "! ")) - (backward-char 2)) + (progn (forward-char 1) + (insert " ")) + (delete-char 1) + (insert "! ")) + (backward-char 2)) (?\\ (when (save-excursion (forward-line 1) - (not (eobp))) - (setq delete t) (setq modif t))) + (not (eobp))) + (setq delete t) (setq modif t))) ;; diff-valid-unified-empty-line. (?\n (insert " ") (setq modif nil) (backward-char 2) (setq reversible nil)) - (t (setq modif nil))) + (_ (setq modif nil))) (let ((last-pt (point))) (forward-line 1) (when delete @@ -1051,17 +1055,18 @@ (goto-char pt1) (forward-line 1) (while (< (point) pt2) - (case (char-after) + (pcase (char-after) (?! (delete-char 2) (insert "-") (forward-line 1)) (?- (forward-char 1) (delete-char 1) (forward-line 1)) - (?\s ;merge with the other half of the chunk + (?\s ;merge with the other half of the chunk (let* ((endline2 (save-excursion (goto-char pt2) (forward-line 1) (point)))) - (case (char-after pt2) - ((?! ?+) + (pcase (char-after pt2) + ((or ?! ?+) (insert "+" - (prog1 (buffer-substring (+ pt2 2) endline2) + (prog1 + (buffer-substring (+ pt2 2) endline2) (delete-region pt2 endline2)))) (?\s (unless (= (- endline2 pt2) @@ -1075,9 +1080,9 @@ (delete-char 1) (forward-line 1)) (?\\ (forward-line 1)) - (t (setq reversible nil) + (_ (setq reversible nil) (delete-char 1) (forward-line 1))))) - (t (setq reversible nil) (forward-line 1)))) + (_ (setq reversible nil) (forward-line 1)))) (while (looking-at "[+! ] ") (if (/= (char-after) ?!) (forward-char 1) (delete-char 1) (insert "+")) @@ -1155,13 +1160,13 @@ (replace-match "@@ -\\8 +\\7 @@" nil) (forward-line 1) (let ((c (char-after)) first last) - (while (case (setq c (char-after)) + (while (pcase (setq c (char-after)) (?- (setq first (or first (point))) - (delete-char 1) (insert "+") t) + (delete-char 1) (insert "+") t) (?+ (setq last (or last (point))) - (delete-char 1) (insert "-") t) - ((?\\ ?#) t) - (t (when (and first last (< first last)) + (delete-char 1) (insert "-") t) + ((or ?\\ ?#) t) + (_ (when (and first last (< first last)) (insert (delete-and-extract-region first last))) (setq first nil last nil) (memq c (if diff-valid-unified-empty-line @@ -1184,13 +1189,13 @@ (concat diff-hunk-header-re-unified "\\|[-*][-*][-*] [0-9,]+ [-*][-*][-*][-*]$" "\\|--- .+\n\\+\\+\\+ "))) - (case (char-after) - (?\s (incf space)) - (?+ (incf plus)) - (?- (incf minus)) - (?! (incf bang)) - ((?\\ ?#) nil) - (t (setq space 0 plus 0 minus 0 bang 0))) + (pcase (char-after) + (?\s (cl-incf space)) + (?+ (cl-incf plus)) + (?- (cl-incf minus)) + (?! (cl-incf bang)) + ((or ?\\ ?#) nil) + (_ (setq space 0 plus 0 minus 0 bang 0))) (cond ((looking-at diff-hunk-header-re-unified) (let* ((old1 (match-string 2)) @@ -1432,7 +1437,7 @@ (cond ((and (memq (char-after) '(?\s ?! ?+ ?-)) (memq (char-after (1+ (point))) '(?\s ?\t))) - (decf count) t) + (cl-decf count) t) ((or (zerop count) (= count lines)) nil) ((memq (char-after) '(?! ?+ ?-)) (if (not (and (eq (char-after (1+ (point))) ?\n) @@ -1483,8 +1488,8 @@ (after (string-to-number (or (match-string 4) "1")))) (forward-line) (while - (case (char-after) - (?\s (decf before) (decf after) t) + (pcase (char-after) + (?\s (cl-decf before) (cl-decf after) t) (?- (if (and (looking-at diff-file-header-re) (zerop before) (zerop after)) @@ -1494,15 +1499,15 @@ ;; line so that our code which doesn't count lines ;; will not get confused. (progn (save-excursion (insert "\n")) nil) - (decf before) t)) - (?+ (decf after) t) - (t + (cl-decf before) t)) + (?+ (cl-decf after) t) + (_ (cond ((and diff-valid-unified-empty-line ;; Not just (eolp) so we don't infloop at eob. (eq (char-after) ?\n) (> before 0) (> after 0)) - (decf before) (decf after) t) + (cl-decf before) (cl-decf after) t) ((and (zerop before) (zerop after)) nil) ((or (< before 0) (< after 0)) (error (if (or (zerop before) (zerop after)) @@ -1719,16 +1724,17 @@ With a prefix argument, REVERSE the hunk." (interactive "P") - (destructuring-bind (buf line-offset pos old new &optional switched) - ;; Sometimes we'd like to have the following behavior: if REVERSE go - ;; to the new file, otherwise go to the old. But that means that by - ;; default we use the old file, which is the opposite of the default - ;; for diff-goto-source, and is thus confusing. Also when you don't - ;; know about it it's pretty surprising. - ;; TODO: make it possible to ask explicitly for this behavior. - ;; - ;; This is duplicated in diff-test-hunk. - (diff-find-source-location nil reverse) + (pcase-let ((`(,buf ,line-offset ,pos ,old ,new ,switched) + ;; Sometimes we'd like to have the following behavior: if + ;; REVERSE go to the new file, otherwise go to the old. + ;; But that means that by default we use the old file, which is + ;; the opposite of the default for diff-goto-source, and is thus + ;; confusing. Also when you don't know about it it's + ;; pretty surprising. + ;; TODO: make it possible to ask explicitly for this behavior. + ;; + ;; This is duplicated in diff-test-hunk. + (diff-find-source-location nil reverse))) (cond ((null line-offset) (error "Can't find the text to patch")) @@ -1771,8 +1777,8 @@ "See whether it's possible to apply the current hunk. With a prefix argument, try to REVERSE the hunk." (interactive "P") - (destructuring-bind (buf line-offset pos src _dst &optional switched) - (diff-find-source-location nil reverse) + (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched) + (diff-find-source-location nil reverse))) (set-window-point (display-buffer buf) (+ (car pos) (cdr src))) (diff-hunk-status-msg line-offset (diff-xor reverse switched) t))) @@ -1791,8 +1797,8 @@ ;; This is a convenient detail when using smerge-diff. (if event (posn-set-point (event-end event))) (let ((rev (not (save-excursion (beginning-of-line) (looking-at "[-<]"))))) - (destructuring-bind (buf line-offset pos src _dst &optional switched) - (diff-find-source-location other-file rev) + (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,switched) + (diff-find-source-location other-file rev))) (pop-to-buffer buf) (goto-char (+ (car pos) (cdr src))) (diff-hunk-status-msg line-offset (diff-xor rev switched) t)))) @@ -1809,10 +1815,11 @@ (when (looking-at diff-hunk-header-re) (forward-line 1) (re-search-forward "^[^ ]" nil t)) - (destructuring-bind (&optional buf _line-offset pos src dst switched) - ;; Use `noprompt' since this is used in which-func-mode and such. - (ignore-errors ;Signals errors in place of prompting. - (diff-find-source-location nil nil 'noprompt)) + (pcase-let ((`(,buf ,_line-offset ,pos ,src ,dst ,switched) + (ignore-errors ;Signals errors in place of prompting. + ;; Use `noprompt' since this is used in which-func-mode + ;; and such. + (diff-find-source-location nil nil 'noprompt)))) (when buf (beginning-of-line) (or (when (memq (char-after) '(?< ?-)) @@ -1835,7 +1842,7 @@ "Re-diff the current hunk, ignoring whitespace differences." (interactive) (let* ((char-offset (- (point) (diff-beginning-of-hunk t))) - (opts (case (char-after) (?@ "-bu") (?* "-bc") (t "-b"))) + (opts (pcase (char-after) (?@ "-bu") (?* "-bc") (_ "-b"))) (line-nb (and (or (looking-at "[^0-9]+\\([0-9]+\\)") (error "Can't find line number")) (string-to-number (match-string 1)))) @@ -1857,13 +1864,13 @@ (let ((status (call-process diff-command nil t nil opts file1 file2))) - (case status - (0 nil) ;Nothing to reformat. + (pcase status + (0 nil) ;Nothing to reformat. (1 (goto-char (point-min)) - ;; Remove the file-header. - (when (re-search-forward diff-hunk-header-re nil t) - (delete-region (point-min) (match-beginning 0)))) - (t (goto-char (point-max)) + ;; Remove the file-header. + (when (re-search-forward diff-hunk-header-re nil t) + (delete-region (point-min) (match-beginning 0)))) + (_ (goto-char (point-max)) (unless (bolp) (insert "\n")) (insert hunk))) (setq hunk (buffer-string)) @@ -1942,14 +1949,14 @@ (remove-overlays beg end 'diff-mode 'fine) (goto-char beg) - (case style - (unified + (pcase style + (`unified (while (re-search-forward "^\\(?:-.*\n\\)+\\(\\)\\(?:\\+.*\n\\)+" end t) (smerge-refine-subst (match-beginning 0) (match-end 1) (match-end 1) (match-end 0) nil 'diff-refine-preproc props-r props-a))) - (context + (`context (let* ((middle (save-excursion (re-search-forward "^---"))) (other middle)) (while (re-search-forward "^\\(?:!.*\n\\)+" middle t) @@ -1964,7 +1971,7 @@ 'diff-refine-preproc (unless diff-use-changed-face props-r) (unless diff-use-changed-face props-a))))) - (t ;; Normal diffs. + (_ ;; Normal diffs. (let ((beg1 (1+ (point)))) (when (re-search-forward "^---.*\n" end t) ;; It's a combined add&remove, so there's something to do. === modified file 'lisp/vc/diff.el' --- lisp/vc/diff.el 2012-04-27 14:16:02 +0000 +++ lisp/vc/diff.el 2012-07-10 11:51:54 +0000 @@ -32,8 +32,6 @@ (declare-function diff-setup-whitespace "diff-mode" ()) -(eval-when-compile (require 'cl)) - (defgroup diff nil "Comparing files with `diff'." :group 'tools) === modified file 'lisp/vc/log-edit.el' --- lisp/vc/log-edit.el 2012-05-13 03:05:06 +0000 +++ lisp/vc/log-edit.el 2012-07-10 11:51:54 +0000 @@ -29,7 +29,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) (require 'add-log) ; for all the ChangeLog goodies (require 'pcvs-util) (require 'ring) === modified file 'lisp/vc/log-view.el' --- lisp/vc/log-view.el 2012-02-11 23:02:29 +0000 +++ lisp/vc/log-view.el 2012-07-10 11:51:54 +0000 @@ -109,7 +109,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) (require 'pcvs-util) (autoload 'vc-find-revision "vc") (autoload 'vc-diff-internal "vc") === modified file 'lisp/vc/pcvs-defs.el' --- lisp/vc/pcvs-defs.el 2012-04-09 13:05:48 +0000 +++ lisp/vc/pcvs-defs.el 2012-07-10 11:51:54 +0000 @@ -26,7 +26,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) (require 'pcvs-util) ;;;; ------------------------------------------------------- === modified file 'lisp/vc/pcvs-info.el' --- lisp/vc/pcvs-info.el 2012-01-19 07:21:25 +0000 +++ lisp/vc/pcvs-info.el 2012-07-10 11:51:54 +0000 @@ -31,7 +31,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'pcvs-util) ;;(require 'pcvs-defs) @@ -146,7 +146,7 @@ ;; Constructor: -(defstruct (cvs-fileinfo +(cl-defstruct (cvs-fileinfo (:constructor nil) (:copier nil) (:constructor -cvs-create-fileinfo (type dir file full-log @@ -274,10 +274,10 @@ (string= file (file-name-nondirectory file))) (setq check 'type) (symbolp type) (setq check 'consistency) - (case type - (DIRCHANGE (and (null subtype) (string= "." file))) - ((NEED-UPDATE ADDED MISSING DEAD MODIFIED MESSAGE UP-TO-DATE - REMOVED NEED-MERGE CONFLICT UNKNOWN MESSAGE) + (pcase type + (`DIRCHANGE (and (null subtype) (string= "." file))) + ((or `NEED-UPDATE `ADDED `MISSING `DEAD `MODIFIED `MESSAGE + `UP-TO-DATE `REMOVED `NEED-MERGE `CONFLICT `UNKNOWN) t))) fi (error "Invalid :%s in cvs-fileinfo %s" check fi)))) @@ -325,9 +325,9 @@ (defun cvs-add-face (str face &optional keymap &rest props) (when keymap (when (keymapp keymap) - (setq props (list* 'keymap keymap props))) - (setq props (list* 'mouse-face 'highlight props))) - (add-text-properties 0 (length str) (list* 'font-lock-face face props) str) + (setq props `(keymap ,keymap ,@props))) + (setq props `(mouse-face highlight ,@props))) + (add-text-properties 0 (length str) `(font-lock-face ,face ,@props) str) str) (defun cvs-fileinfo-pp (fileinfo) @@ -337,15 +337,15 @@ (let ((type (cvs-fileinfo->type fileinfo)) (subtype (cvs-fileinfo->subtype fileinfo))) (insert - (case type - (DIRCHANGE (concat "In directory " - (cvs-add-face (cvs-fileinfo->full-name fileinfo) - 'cvs-header t 'cvs-goal-column t) - ":")) - (MESSAGE + (pcase type + (`DIRCHANGE (concat "In directory " + (cvs-add-face (cvs-fileinfo->full-name fileinfo) + 'cvs-header t 'cvs-goal-column t) + ":")) + (`MESSAGE (cvs-add-face (format "Message: %s" (cvs-fileinfo->full-log fileinfo)) 'cvs-msg)) - (t + (_ (let* ((status (if (cvs-fileinfo->marked fileinfo) (cvs-add-face "*" 'cvs-marked) " ")) @@ -354,10 +354,10 @@ (base (or (cvs-fileinfo->base-rev fileinfo) "")) (head (cvs-fileinfo->head-rev fileinfo)) (type - (let ((str (case type + (let ((str (pcase type ;;(MOD-CONFLICT "Not Removed") - (DEAD "") - (t (capitalize (symbol-name type))))) + (`DEAD "") + (_ (capitalize (symbol-name type))))) (face (let ((sym (intern (concat "cvs-fi-" (downcase (symbol-name type)) === modified file 'lisp/vc/pcvs-parse.el' --- lisp/vc/pcvs-parse.el 2012-01-19 07:21:25 +0000 +++ lisp/vc/pcvs-parse.el 2012-07-10 11:51:54 +0000 @@ -32,8 +32,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - (require 'pcvs-util) (require 'pcvs-info) @@ -117,7 +115,7 @@ then assign the variables as specified in MATCHES (via `setq')." (cons 'cvs-do-match (cons re (mapcar (lambda (match) - `(cons ',(first match) ,(second match))) + `(cons ',(car match) ,(cadr match))) matches)))) (defun cvs-do-match (re &rest matches) @@ -150,8 +148,8 @@ (cvs-or (funcall parse-spec) - (dolist (re cvs-parse-ignored-messages) - (when (cvs-match re) (return t))) + (cl-dolist (re cvs-parse-ignored-messages) + (when (cvs-match re) (cl-return t))) ;; This is a parse error. Create a message-type fileinfo. (and @@ -221,7 +219,7 @@ ;; ?: Unknown file. (let ((code (aref c 0))) (cvs-parsed-fileinfo - (case code + (pcase code (?M 'MODIFIED) (?A 'ADDED) (?R 'REMOVED) @@ -238,7 +236,7 @@ (if (re-search-forward "^<<<<<<< " nil t) 'CONFLICT 'NEED-MERGE)))) (?J 'NEED-MERGE) ;not supported by standard CVS - ((?U ?P) + ((or ?U ?P) (if dont-change-disc 'NEED-UPDATE (cons 'UP-TO-DATE (if (eq code ?U) 'UPDATED 'PATCHED))))) path 'trust))) === modified file 'lisp/vc/pcvs-util.el' --- lisp/vc/pcvs-util.el 2012-04-16 23:57:09 +0000 +++ lisp/vc/pcvs-util.el 2012-07-10 11:51:54 +0000 @@ -26,7 +26,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;;;; ;;;; list processing @@ -63,7 +63,7 @@ (while (and l (> n 1)) (setcdr nl (list (pop l))) (setq nl (cdr nl)) - (decf n)) + (cl-decf n)) ret)))) (defun cvs-partition (p l) @@ -130,10 +130,10 @@ (if noreuse (generate-new-buffer name) (get-buffer-create name))) (unless noreuse - (dolist (buf (buffer-list)) + (cl-dolist (buf (buffer-list)) (with-current-buffer buf (when (equal name list-buffers-directory) - (return buf))))) + (cl-return buf))))) (with-current-buffer (create-file-buffer name) (setq list-buffers-directory name) (current-buffer)))) @@ -195,10 +195,10 @@ ;;;; (interactive ) support function ;;;; -(defstruct (cvs-qtypedesc - (:constructor nil) (:copier nil) - (:constructor cvs-qtypedesc-create - (str2obj obj2str &optional complete hist-sym require))) +(cl-defstruct (cvs-qtypedesc + (:constructor nil) (:copier nil) + (:constructor cvs-qtypedesc-create + (str2obj obj2str &optional complete hist-sym require))) str2obj obj2str hist-sym @@ -231,10 +231,10 @@ ;;;; Flags handling ;;;; -(defstruct (cvs-flags - (:constructor nil) - (:constructor -cvs-flags-make - (desc defaults &optional qtypedesc hist-sym))) +(cl-defstruct (cvs-flags + (:constructor nil) + (:constructor -cvs-flags-make + (desc defaults &optional qtypedesc hist-sym))) defaults persist desc qtypedesc hist-sym) (defmacro cvs-flags-define (sym defaults === modified file 'lisp/vc/pcvs.el' --- lisp/vc/pcvs.el 2012-06-23 15:38:23 +0000 +++ lisp/vc/pcvs.el 2012-07-10 11:51:54 +0000 @@ -118,7 +118,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'ewoc) ;Ewoc was once cookie (require 'pcvs-defs) (require 'pcvs-util) @@ -219,21 +219,21 @@ (autoload 'cvs-status-get-tags "cvs-status") (defun cvs-tags-list () "Return a list of acceptable tags, ready for completions." - (assert (cvs-buffer-p)) + (cl-assert (cvs-buffer-p)) (let ((marked (cvs-get-marked))) - (list* '("BASE") '("HEAD") - (when marked - (with-temp-buffer - (process-file cvs-program - nil ;no input - t ;output to current-buffer - nil ;don't update display while running - "status" - "-v" - (cvs-fileinfo->full-name (car marked))) - (goto-char (point-min)) - (let ((tags (cvs-status-get-tags))) - (when (listp tags) tags))))))) + `(("BASE") ("HEAD") + ,@(when marked + (with-temp-buffer + (process-file cvs-program + nil ;no input + t ;output to current-buffer + nil ;don't update display while running + "status" + "-v" + (cvs-fileinfo->full-name (car marked))) + (goto-char (point-min)) + (let ((tags (cvs-status-get-tags))) + (when (listp tags) tags))))))) (defvar cvs-tag-history nil) (defconst cvs-qtypedesc-tag @@ -426,16 +426,16 @@ ;; look for another cvs buffer visiting the same directory (save-excursion (unless new - (dolist (buffer (cons (current-buffer) (buffer-list))) + (cl-dolist (buffer (cons (current-buffer) (buffer-list))) (set-buffer buffer) (and (cvs-buffer-p) - (case cvs-reuse-cvs-buffer - (always t) - (subdir + (pcase cvs-reuse-cvs-buffer + (`always t) + (`subdir (or (string-prefix-p default-directory dir) (string-prefix-p dir default-directory))) - (samedir (string= default-directory dir))) - (return buffer))))) + (`samedir (string= default-directory dir))) + (cl-return buffer))))) ;; we really have to create a new buffer: ;; we temporarily bind cwd to "" to prevent ;; create-file-buffer from using directory info @@ -478,7 +478,7 @@ ;;(set-buffer buf) buffer)))))) -(defun* cvs-cmd-do (cmd dir flags fis new +(cl-defun cvs-cmd-do (cmd dir flags fis new &key cvsargs noexist dont-change-disc noshow) (let* ((dir (file-name-as-directory (abbreviate-file-name (expand-file-name dir)))) @@ -501,7 +501,7 @@ ;; cvsbuf)))) (defun cvs-run-process (args fis postprocess &optional single-dir) - (assert (cvs-buffer-p cvs-buffer)) + (cl-assert (cvs-buffer-p cvs-buffer)) (save-current-buffer (let ((procbuf (current-buffer)) (cvsbuf cvs-buffer) @@ -521,9 +521,9 @@ (let ((inhibit-read-only t)) (insert "pcl-cvs: descending directory " dir "\n")) ;; loop to find the same-dir-elems - (do* ((files () (cons (cvs-fileinfo->file fi) files)) - (fis fis (cdr fis)) - (fi (car fis) (car fis))) + (cl-do* ((files () (cons (cvs-fileinfo->file fi) files)) + (fis fis (cdr fis)) + (fi (car fis) (car fis))) ((not (and fis (string= dir (cvs-fileinfo->dir fi)))) (list dir files fis)))))) (dir (nth 0 dir+files+rest)) @@ -813,7 +813,7 @@ (while (and tin (cvs-fileinfo< fi (ewoc-data tin))) (setq tin (ewoc-prev c tin))) (if (null tin) (ewoc-enter-first c fi) ;empty collection - (assert (not (cvs-fileinfo< fi (ewoc-data tin)))) + (cl-assert (not (cvs-fileinfo< fi (ewoc-data tin)))) (let ((next-tin (ewoc-next c tin))) (while (not (or (null next-tin) (cvs-fileinfo< fi (ewoc-data next-tin)))) @@ -871,15 +871,15 @@ (let* ((type (cvs-fileinfo->type fi)) (subtype (cvs-fileinfo->subtype fi)) (keep - (case type + (pcase type ;; remove temp messages and keep the others - (MESSAGE (not (or rm-msgs (eq subtype 'TEMP)))) + (`MESSAGE (not (or rm-msgs (eq subtype 'TEMP)))) ;; remove entries - (DEAD nil) + (`DEAD nil) ;; handled also? - (UP-TO-DATE (not rm-handled)) + (`UP-TO-DATE (not rm-handled)) ;; keep the rest - (t (not (run-hook-with-args-until-success + (_ (not (run-hook-with-args-until-success 'cvs-cleanup-functions fi)))))) ;; mark dirs for removal @@ -1389,7 +1389,7 @@ fis)))) (nreverse fis))) -(defun* cvs-mode-marked (filter &optional cmd +(cl-defun cvs-mode-marked (filter &optional cmd &key read-only one file noquery) "Get the list of marked FIS. CMD is used to determine whether to use the marks or not. @@ -1474,7 +1474,7 @@ (let ((msg (buffer-substring-no-properties (point-min) (point-max)))) (cvs-mode!) ;;(pop-to-buffer cvs-buffer) - (cvs-mode-do "commit" (list* "-m" msg flags) 'commit))) + (cvs-mode-do "commit" `("-m" ,msg ,@flags) 'commit))) ;;;; Editing existing commit log messages. @@ -1604,7 +1604,7 @@ (or current-prefix-arg (not cvs-add-default-message))) (read-from-minibuffer "Enter description: ") (or cvs-add-default-message ""))) - (flags (list* "-m" msg flags)) + (flags `("-m" ,msg ,@flags)) (postproc ;; setup postprocessing for the directory entries (when dirs @@ -1845,7 +1845,7 @@ (setq ret t))) ret))) -(defun* cvs-mode-run (cmd flags fis +(cl-defun cvs-mode-run (cmd flags fis &key (buf (cvs-temp-buffer)) dont-change-disc cvsargs postproc) "Generic cvs-mode- function. @@ -1887,7 +1887,7 @@ (cvs-run-process args fis postproc single-dir)))) -(defun* cvs-mode-do (cmd flags filter +(cl-defun cvs-mode-do (cmd flags filter &key show dont-change-disc cvsargs postproc) "Generic cvs-mode- function. Executes `cvs CVSARGS CMD FLAGS' on the selected files. === modified file 'lisp/vc/smerge-mode.el' --- lisp/vc/smerge-mode.el 2012-05-25 00:55:40 +0000 +++ lisp/vc/smerge-mode.el 2012-07-10 11:51:54 +0000 @@ -43,7 +43,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'diff-mode) ;For diff-auto-refine-mode. (require 'newcomment) @@ -716,7 +716,7 @@ (while (or (not (match-end i)) (< (point) (match-beginning i)) (>= (point) (match-end i))) - (decf i)) + (cl-decf i)) i)) (defun smerge-keep-current () @@ -779,7 +779,7 @@ (filename (or (match-string 1) "")) (_ (re-search-forward smerge-end-re)) - (_ (assert (< orig-point (match-end 0)))) + (_ (cl-assert (< orig-point (match-end 0)))) (other-end (match-beginning 0)) (end (match-end 0)) @@ -1073,12 +1073,12 @@ (forward-line 1) ;Skip hunk header. (and (re-search-forward "^[0-9]" nil 'move) ;Skip hunk body. (goto-char (match-beginning 0)))) - ;; (assert (or (null last1) (< (overlay-start last1) end1))) - ;; (assert (or (null last2) (< (overlay-start last2) end2))) + ;; (cl-assert (or (null last1) (< (overlay-start last1) end1))) + ;; (cl-assert (or (null last2) (< (overlay-start last2) end2))) (if smerge-refine-weight-hack (progn - ;; (assert (or (null last1) (<= (overlay-end last1) end1))) - ;; (assert (or (null last2) (<= (overlay-end last2) end2))) + ;; (cl-assert (or (null last1) (<= (overlay-end last1) end1))) + ;; (cl-assert (or (null last2) (<= (overlay-end last2) end2))) ) ;; smerge-refine-forward-function when calling in chopup may ;; have stopped because it bumped into EOB whereas in @@ -1290,8 +1290,8 @@ (progn (pop-mark) (mark)) (when current-prefix-arg (pop-mark) (mark)))) ;; Start from the end so as to avoid problems with pos-changes. - (destructuring-bind (pt1 pt2 pt3 &optional pt4) - (sort (list* pt1 pt2 pt3 (if pt4 (list pt4))) '>=) + (pcase-let ((`(,pt1 ,pt2 ,pt3 ,pt4) + (sort `(,pt1 ,pt2 ,pt3 ,@(if pt4 (list pt4))) '>=))) (goto-char pt1) (beginning-of-line) (insert ">>>>>>> OTHER\n") (goto-char pt2) (beginning-of-line) ------------------------------------------------------------ revno: 108997 committer: Juanma Barranquero branch nick: trunk timestamp: Tue 2012-07-10 13:46:31 +0200 message: nt/config.nt: Sync with autogen/config.in. diff: === modified file 'nt/ChangeLog' --- nt/ChangeLog 2012-07-09 16:38:45 +0000 +++ nt/ChangeLog 2012-07-10 11:46:31 +0000 @@ -1,3 +1,7 @@ +2012-07-10 Juanma Barranquero + + * config.nt: Sync with autogen/config.in. + 2012-07-09 Paul Eggert * config.nt (ATTRIBUTE_CONST): Add, to sync with configure.ac. === modified file 'nt/config.nt' --- nt/config.nt 2012-07-09 16:38:45 +0000 +++ nt/config.nt 2012-07-10 11:46:31 +0000 @@ -71,6 +71,12 @@ /* Define to 1 if using 'alloca.c'. */ #undef C_ALLOCA +/* Extra bits to be or'd in with any pointers stored in a Lisp_Object. */ +#undef DATA_SEG_BITS + +/* Address of the start of the data segment. */ +#undef DATA_START + /* Define to 1 for DGUX with . */ #undef DGUX @@ -1097,10 +1103,13 @@ /* Define to the version of this package. */ #undef PACKAGE_VERSION +/* Number of chars of output in the buffer of a stdio stream. */ +#undef PENDING_OUTPUT_COUNT + /* Define to empty to suppress deprecation warnings when building with --enable-gcc-warnings and with libpng versions before 1.5, which lack png_longjmp. */ -#undef PNG_DEPRECATED +#undef PNG_DEPSTRUCT /* Define to 1 if pthread_sigmask(), when it fails, returns -1 and sets errno. */ ------------------------------------------------------------ revno: 108996 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2012-07-10 07:27:27 -0400 message: * lisp/emacs-lisp/gv.el (cond): Make it a valid place. (if): Simplify slightly. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-07-10 09:26:04 +0000 +++ lisp/ChangeLog 2012-07-10 11:27:27 +0000 @@ -1,5 +1,8 @@ 2012-07-10 Stefan Monnier + * emacs-lisp/gv.el (cond): Make it a valid place. + (if): Simplify slightly. + * emacs-lisp/pcase.el (pcase): Accept self-quoting exps as "upatterns". (pcase--self-quoting-p): New function. (pcase--u1): Use it. === modified file 'lisp/emacs-lisp/gv.el' --- lisp/emacs-lisp/gv.el 2012-06-22 21:24:54 +0000 +++ lisp/emacs-lisp/gv.el 2012-07-10 11:27:27 +0000 @@ -361,22 +361,54 @@ (put 'if 'gv-expander (lambda (do test then &rest else) - (let ((v (make-symbol "v"))) - (if (macroexp-small-p (funcall do 'dummy (lambda (_) 'dummy))) - ;; This duplicates the `do' code, which is a problem if that - ;; code is large, but otherwise results in more efficient code. - `(if ,test ,(gv-get then do) - ,@(macroexp-unprogn (gv-get (macroexp-progn else) do))) - (macroexp-let2 nil b test - (macroexp-let2 nil - gv `(if ,b ,(gv-letplace (getter setter) then - `(cons (lambda () ,getter) - (lambda (,v) ,(funcall setter v)))) - ,(gv-letplace (getter setter) (macroexp-progn else) - `(cons (lambda () ,getter) - (lambda (,v) ,(funcall setter v))))) - (funcall do `(funcall (car ,gv)) - (lambda (v) `(funcall (cdr ,gv) ,v))))))))) + (if (macroexp-small-p (funcall do 'dummy (lambda (_) 'dummy))) + ;; This duplicates the `do' code, which is a problem if that + ;; code is large, but otherwise results in more efficient code. + `(if ,test ,(gv-get then do) + ,@(macroexp-unprogn (gv-get (macroexp-progn else) do))) + (let ((v (make-symbol "v"))) + (macroexp-let2 nil + gv `(if ,test ,(gv-letplace (getter setter) then + `(cons (lambda () ,getter) + (lambda (,v) ,(funcall setter v)))) + ,(gv-letplace (getter setter) (macroexp-progn else) + `(cons (lambda () ,getter) + (lambda (,v) ,(funcall setter v))))) + (funcall do `(funcall (car ,gv)) + (lambda (v) `(funcall (cdr ,gv) ,v)))))))) + +(put 'cond 'gv-expander + (lambda (do &rest branches) + (if (macroexp-small-p (funcall do 'dummy (lambda (_) 'dummy))) + ;; This duplicates the `do' code, which is a problem if that + ;; code is large, but otherwise results in more efficient code. + `(cond + ,@(mapcar (lambda (branch) + (if (cdr branch) + (cons (car branch) + (macroexp-unprogn + (gv-get (macroexp-progn (cdr branch)) do))) + (gv-get (car branch) do))) + branches)) + (let ((v (make-symbol "v"))) + (macroexp-let2 nil + gv `(cond + ,@(mapcar + (lambda (branch) + (if (cdr branch) + `(,(car branch) + ,@(macroexp-unprogn + (gv-letplace (getter setter) + (macroexp-progn (cdr branch)) + `(cons (lambda () ,getter) + (lambda (,v) ,(funcall setter v)))))) + (gv-letplace (getter setter) + (car branch) + `(cons (lambda () ,getter) + (lambda (,v) ,(funcall setter v)))))) + branches)) + (funcall do `(funcall (car ,gv)) + (lambda (v) `(funcall (cdr ,gv) ,v)))))))) ;;; Even more debatable extensions. ------------------------------------------------------------ revno: 108995 committer: Glenn Morris branch nick: trunk timestamp: Tue 2012-07-10 06:17:29 -0400 message: Auto-commit of generated files. diff: === modified file 'autogen/config.in' --- autogen/config.in 2012-07-09 10:17:37 +0000 +++ autogen/config.in 2012-07-10 10:17:29 +0000 @@ -66,6 +66,12 @@ /* Define to 1 if using 'alloca.c'. */ #undef C_ALLOCA +/* Extra bits to be or'd in with any pointers stored in a Lisp_Object. */ +#undef DATA_SEG_BITS + +/* Address of the start of the data segment. */ +#undef DATA_START + /* Define to 1 for DGUX with . */ #undef DGUX @@ -1089,10 +1095,13 @@ /* Define to the version of this package. */ #undef PACKAGE_VERSION +/* Number of chars of output in the buffer of a stdio stream. */ +#undef PENDING_OUTPUT_COUNT + /* Define to empty to suppress deprecation warnings when building with --enable-gcc-warnings and with libpng versions before 1.5, which lack png_longjmp. */ -#undef PNG_DEPRECATED +#undef PNG_DEPSTRUCT /* Define to 1 if pthread_sigmask(), when it fails, returns -1 and sets errno. */ @@ -1501,6 +1510,8 @@ ATTRIBUTE_FORMAT ((__printf__, formatstring_parameter, first_argument)) #endif +#define ATTRIBUTE_CONST _GL_ATTRIBUTE_CONST + /* Some versions of GNU/Linux define noinline in their headers. */ #ifdef noinline #undef noinline === modified file 'autogen/configure' --- autogen/configure 2012-07-09 10:17:37 +0000 +++ autogen/configure 2012-07-10 10:17:29 +0000 @@ -7161,7 +7161,6 @@ # The following lines should be removable at some point. nw="$nw -Wstack-protector" nw="$nw -Wstrict-overflow" - nw="$nw -Wsuggest-attribute=const" nw="$nw -Wsuggest-attribute=pure" @@ -20266,7 +20265,7 @@ else -$as_echo "#define PNG_DEPRECATED /**/" >>confdefs.h +$as_echo "#define PNG_DEPSTRUCT /**/" >>confdefs.h fi @@ -22661,6 +22660,41 @@ ;; esac + + + + + +case $opsys in + cygwin | darwin | freebsd | netbsd | openbsd ) + $as_echo "#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base)" >>confdefs.h + + ;; + + unixware) + $as_echo "#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->__ptr - (FILE)->__base)" >>confdefs.h + + ;; + + gnu) + $as_echo "#define DATA_START ({ extern int data_start; (char *) &data_start; })" >>confdefs.h + + ;; + + hpux*) + $as_echo "#define DATA_START 0x40000000" >>confdefs.h + + $as_echo "#define DATA_SEG_BITS 0x40000000" >>confdefs.h + + ;; + irix6-5) + $as_echo "#define DATA_START 0x10000000" >>confdefs.h + + $as_echo "#define DATA_SEG_BITS 0x10000000" >>confdefs.h + + ;; +esac + case $opsys in gnu-kfreebsd) opsysfile="s/gnu-linux.h" ;; ------------------------------------------------------------ revno: 108994 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2012-07-10 05:26:04 -0400 message: * lisp/emacs-lisp/pcase.el (pcase): Accept self-quoting exps as "upatterns". (pcase--self-quoting-p): New function. (pcase--u1): Use it. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2012-07-10 01:11:08 +0000 +++ lisp/ChangeLog 2012-07-10 09:26:04 +0000 @@ -1,3 +1,9 @@ +2012-07-10 Stefan Monnier + + * emacs-lisp/pcase.el (pcase): Accept self-quoting exps as "upatterns". + (pcase--self-quoting-p): New function. + (pcase--u1): Use it. + 2012-07-10 Glenn Morris * emacs-lisp/authors.el (authors-fixed-entries): @@ -31,8 +37,8 @@ 2012-07-07 Chong Yidong * simple.el (yank-pop-change-selection): Doc fix (Bug#11361). - (interprogram-cut-function, interprogram-paste-function): Mention - that we typically mean the clipboard. + (interprogram-cut-function, interprogram-paste-function): + Mention that we typically mean the clipboard. 2012-07-06 Glenn Morris @@ -71,8 +77,8 @@ 2012-07-06 Andreas Schwab - * calendar/cal-dst.el (calendar-current-time-zone): Return - calendar-current-time-zone-cache if non-nil. + * calendar/cal-dst.el (calendar-current-time-zone): + Return calendar-current-time-zone-cache if non-nil. 2012-07-06 Glenn Morris @@ -85,8 +91,8 @@ * net/tramp.el (tramp-drop-volume-letter): Provide an XEmacs compatible declaration. - * net/tramp-cmds.el (tramp-append-tramp-buffers): Protect - `list-load-path-shadows' call. + * net/tramp-cmds.el (tramp-append-tramp-buffers): + Protect `list-load-path-shadows' call. * net/tramp-compat.el (top): Require packages, which aren't autoloaded anymore for XEmacs. Protect call of === modified file 'lisp/emacs-lisp/pcase.el' --- lisp/emacs-lisp/pcase.el 2012-06-22 13:42:38 +0000 +++ lisp/emacs-lisp/pcase.el 2012-07-10 09:26:04 +0000 @@ -94,6 +94,7 @@ UPatterns can take the following forms: _ matches anything. + SELFQUOTING matches itself. This includes keywords, numbers, and strings. SYMBOL matches anything and binds it to SYMBOL. (or UPAT...) matches if any of the patterns matches. (and UPAT...) matches if all the patterns match. @@ -509,6 +510,9 @@ (and (memq sexp vars) (not (memq sexp res)) (push sexp res)) res)) +(defun pcase--self-quoting-p (upat) + (or (keywordp upat) (numberp upat) (stringp upat))) + ;; It's very tempting to use `pcase' below, tho obviously, it'd create ;; bootstrapping problems. (defun pcase--u1 (matches code vars rest) @@ -605,6 +609,9 @@ `(let* ,env ,call)))) (pcase--u1 matches code vars then-rest) (pcase--u else-rest)))) + ((pcase--self-quoting-p upat) + (put sym 'pcase-used t) + (pcase--q1 sym upat matches code vars rest)) ((symbolp upat) (put sym 'pcase-used t) (if (not (assq upat vars)) @@ -636,14 +643,16 @@ (memq-fine t)) (when all (dolist (alt (cdr upat)) - (unless (and (eq (car-safe alt) '\`) - (or (symbolp (cadr alt)) (integerp (cadr alt)) - (setq memq-fine nil) - (stringp (cadr alt)))) + (unless (or (pcase--self-quoting-p alt) + (and (eq (car-safe alt) '\`) + (or (symbolp (cadr alt)) (integerp (cadr alt)) + (setq memq-fine nil) + (stringp (cadr alt))))) (setq all nil)))) (if all ;; Use memq for (or `a `b `c `d) rather than a big tree. - (let* ((elems (mapcar 'cadr (cdr upat))) + (let* ((elems (mapcar (lambda (x) (if (consp x) (cadr x) x)) + (cdr upat))) (splitrest (pcase--split-rest sym (lambda (pat) (pcase--split-member elems pat)) rest)) ------------------------------------------------------------ revno: 108993 committer: Dmitry Antipov branch nick: trunk timestamp: Tue 2012-07-10 12:43:46 +0400 message: Optimize pure C strings initialization. * lisp.h (make_pure_string): Fix prototype. (build_pure_c_string): New function, defined as static inline. This provides a better opportunity to optimize away calls to strlen when the function is called with compile-time constant argument. * alloc.c (make_pure_c_string): Fix comment. Change to add nchars argument, adjust users accordingly. Use build_pure_c_string where appropriate. * buffer.c, coding.c, data.c, dbusbind.c, fileio.c, fontset.c, frame.c, * keyboard.c, keymap.c, lread.c, search.c, syntax.c, w32fns.c, xdisp.c, * xfaces.c, xfns.c, xterm.c: Use build_pure_c_string where appropriate. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-10 07:59:31 +0000 +++ src/ChangeLog 2012-07-10 08:43:46 +0000 @@ -1,5 +1,19 @@ 2012-07-10 Dmitry Antipov + Optimize pure C strings initialization. + * lisp.h (make_pure_string): Fix prototype. + (build_pure_c_string): New function, defined as static inline. This + provides a better opportunity to optimize away calls to strlen when + the function is called with compile-time constant argument. + * alloc.c (make_pure_c_string): Fix comment. Change to add nchars + argument, adjust users accordingly. Use build_pure_c_string where + appropriate. + * buffer.c, coding.c, data.c, dbusbind.c, fileio.c, fontset.c, frame.c, + * keyboard.c, keymap.c, lread.c, search.c, syntax.c, w32fns.c, xdisp.c, + * xfaces.c, xfns.c, xterm.c: Use build_pure_c_string where appropriate. + +2012-07-10 Dmitry Antipov + Avoid calls to strlen in miscellaneous functions. * buffer.c (init_buffer): Use precalculated len, adjust if needed. * font.c (Ffont_xlfd_name): Likewise. Change to call make_string. === modified file 'src/alloc.c' --- src/alloc.c 2012-07-09 16:06:19 +0000 +++ src/alloc.c 2012-07-10 08:43:46 +0000 @@ -5212,15 +5212,14 @@ return string; } -/* Return a string a string allocated in pure space. Do not allocate - the string data, just point to DATA. */ +/* Return a string allocated in pure space. Do not + allocate the string data, just point to DATA. */ Lisp_Object -make_pure_c_string (const char *data) +make_pure_c_string (const char *data, ptrdiff_t nchars) { Lisp_Object string; struct Lisp_String *s; - ptrdiff_t nchars = strlen (data); s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String); s->size = nchars; @@ -6842,7 +6841,7 @@ not be able to allocate the memory to hold it. */ Vmemory_signal_data = pure_cons (Qerror, - pure_cons (make_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"), Qnil)); + pure_cons (build_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"), Qnil)); DEFVAR_LISP ("memory-full", Vmemory_full, doc: /* Non-nil means Emacs cannot get much more Lisp memory. */); === modified file 'src/buffer.c' --- src/buffer.c 2012-07-10 07:59:31 +0000 +++ src/buffer.c 2012-07-10 08:43:46 +0000 @@ -4898,7 +4898,7 @@ /* Must do these before making the first buffer! */ /* real setup is done in bindings.el */ - BVAR (&buffer_defaults, mode_line_format) = make_pure_c_string ("%-"); + BVAR (&buffer_defaults, mode_line_format) = build_pure_c_string ("%-"); BVAR (&buffer_defaults, header_line_format) = Qnil; BVAR (&buffer_defaults, abbrev_mode) = Qnil; BVAR (&buffer_defaults, overwrite_mode) = Qnil; @@ -5028,7 +5028,7 @@ current_buffer = 0; all_buffers = 0; - QSFundamental = make_pure_c_string ("Fundamental"); + QSFundamental = build_pure_c_string ("Fundamental"); Qfundamental_mode = intern_c_string ("fundamental-mode"); BVAR (&buffer_defaults, major_mode) = Qfundamental_mode; @@ -5043,10 +5043,10 @@ Fput (Qkill_buffer_hook, Qpermanent_local, Qt); /* super-magic invisible buffer */ - Vprin1_to_string_buffer = Fget_buffer_create (make_pure_c_string (" prin1")); + Vprin1_to_string_buffer = Fget_buffer_create (build_pure_c_string (" prin1")); Vbuffer_alist = Qnil; - Fset_buffer (Fget_buffer_create (make_pure_c_string ("*scratch*"))); + Fset_buffer (Fget_buffer_create (build_pure_c_string ("*scratch*"))); inhibit_modification_hooks = 0; } @@ -5201,7 +5201,7 @@ Fput (Qprotected_field, Qerror_conditions, pure_cons (Qprotected_field, pure_cons (Qerror, Qnil))); Fput (Qprotected_field, Qerror_message, - make_pure_c_string ("Attempt to modify a protected field")); + build_pure_c_string ("Attempt to modify a protected field")); DEFVAR_BUFFER_DEFAULTS ("default-mode-line-format", mode_line_format, === modified file 'src/coding.c' --- src/coding.c 2012-07-05 18:35:48 +0000 +++ src/coding.c 2012-07-10 08:43:46 +0000 @@ -10350,7 +10350,7 @@ Vcode_conversion_reused_workbuf = Qnil; staticpro (&Vcode_conversion_workbuf_name); - Vcode_conversion_workbuf_name = make_pure_c_string (" *code-conversion-work*"); + Vcode_conversion_workbuf_name = build_pure_c_string (" *code-conversion-work*"); reused_workbuf_in_use = 0; @@ -10413,7 +10413,7 @@ Fput (Qcoding_system_error, Qerror_conditions, pure_cons (Qcoding_system_error, pure_cons (Qerror, Qnil))); Fput (Qcoding_system_error, Qerror_message, - make_pure_c_string ("Invalid coding system")); + build_pure_c_string ("Invalid coding system")); /* Intern this now in case it isn't already done. Setting this variable twice is harmless. @@ -10686,22 +10686,22 @@ DEFVAR_LISP ("eol-mnemonic-unix", eol_mnemonic_unix, doc: /* *String displayed in mode line for UNIX-like (LF) end-of-line format. */); - eol_mnemonic_unix = make_pure_c_string (":"); + eol_mnemonic_unix = build_pure_c_string (":"); DEFVAR_LISP ("eol-mnemonic-dos", eol_mnemonic_dos, doc: /* *String displayed in mode line for DOS-like (CRLF) end-of-line format. */); - eol_mnemonic_dos = make_pure_c_string ("\\"); + eol_mnemonic_dos = build_pure_c_string ("\\"); DEFVAR_LISP ("eol-mnemonic-mac", eol_mnemonic_mac, doc: /* *String displayed in mode line for MAC-like (CR) end-of-line format. */); - eol_mnemonic_mac = make_pure_c_string ("/"); + eol_mnemonic_mac = build_pure_c_string ("/"); DEFVAR_LISP ("eol-mnemonic-undecided", eol_mnemonic_undecided, doc: /* *String displayed in mode line when end-of-line format is not yet determined. */); - eol_mnemonic_undecided = make_pure_c_string (":"); + eol_mnemonic_undecided = build_pure_c_string (":"); DEFVAR_LISP ("enable-character-translation", Venable_character_translation, doc: /* @@ -10839,7 +10839,7 @@ plist[10] = intern_c_string (":for-unibyte"); plist[11] = args[coding_arg_for_unibyte] = Qt; plist[12] = intern_c_string (":docstring"); - plist[13] = make_pure_c_string ("Do no conversion.\n\ + plist[13] = build_pure_c_string ("Do no conversion.\n\ \n\ When you visit a file with this coding, the file is read into a\n\ unibyte buffer as is, thus each byte of a file is treated as a\n\ @@ -10857,7 +10857,7 @@ plist[8] = intern_c_string (":charset-list"); plist[9] = args[coding_arg_charset_list] = Fcons (Qascii, Qnil); plist[11] = args[coding_arg_for_unibyte] = Qnil; - plist[13] = make_pure_c_string ("No conversion on encoding, automatic conversion on decoding."); + plist[13] = build_pure_c_string ("No conversion on encoding, automatic conversion on decoding."); plist[15] = args[coding_arg_eol_type] = Qnil; args[coding_arg_plist] = Flist (16, plist); Fdefine_coding_system_internal (coding_arg_max, args); === modified file 'src/data.c' --- src/data.c 2012-07-05 18:35:48 +0000 +++ src/data.c 2012-07-10 08:43:46 +0000 @@ -3011,11 +3011,11 @@ Fput (Qerror, Qerror_conditions, error_tail); Fput (Qerror, Qerror_message, - make_pure_c_string ("error")); + build_pure_c_string ("error")); #define PUT_ERROR(sym, tail, msg) \ Fput (sym, Qerror_conditions, pure_cons (sym, tail)); \ - Fput (sym, Qerror_message, make_pure_c_string (msg)) + Fput (sym, Qerror_message, build_pure_c_string (msg)) PUT_ERROR (Qquit, Qnil, "Quit"); @@ -3042,7 +3042,7 @@ arith_tail = pure_cons (Qarith_error, error_tail); Fput (Qarith_error, Qerror_conditions, arith_tail); - Fput (Qarith_error, Qerror_message, make_pure_c_string ("Arithmetic error")); + Fput (Qarith_error, Qerror_message, build_pure_c_string ("Arithmetic error")); PUT_ERROR (Qbeginning_of_buffer, error_tail, "Beginning of buffer"); PUT_ERROR (Qend_of_buffer, error_tail, "End of buffer"); === modified file 'src/dbusbind.c' --- src/dbusbind.c 2012-07-09 12:02:27 +0000 +++ src/dbusbind.c 2012-07-10 08:43:46 +0000 @@ -1712,7 +1712,7 @@ Fput (Qdbus_error, Qerror_conditions, list2 (Qdbus_error, Qerror)); Fput (Qdbus_error, Qerror_message, - make_pure_c_string ("D-Bus error")); + build_pure_c_string ("D-Bus error")); DEFSYM (QCdbus_system_bus, ":system"); DEFSYM (QCdbus_session_bus, ":session"); @@ -1744,7 +1744,7 @@ Vdbus_compiled_version, doc: /* The version of D-Bus Emacs is compiled against. */); #ifdef DBUS_VERSION_STRING - Vdbus_compiled_version = make_pure_c_string (DBUS_VERSION_STRING); + Vdbus_compiled_version = build_pure_c_string (DBUS_VERSION_STRING); #else Vdbus_compiled_version = Qnil; #endif === modified file 'src/fileio.c' --- src/fileio.c 2012-07-10 06:23:45 +0000 +++ src/fileio.c 2012-07-10 08:43:46 +0000 @@ -5647,17 +5647,17 @@ Fput (Qfile_error, Qerror_conditions, Fpurecopy (list2 (Qfile_error, Qerror))); Fput (Qfile_error, Qerror_message, - make_pure_c_string ("File error")); + build_pure_c_string ("File error")); Fput (Qfile_already_exists, Qerror_conditions, Fpurecopy (list3 (Qfile_already_exists, Qfile_error, Qerror))); Fput (Qfile_already_exists, Qerror_message, - make_pure_c_string ("File already exists")); + build_pure_c_string ("File already exists")); Fput (Qfile_date_error, Qerror_conditions, Fpurecopy (list3 (Qfile_date_error, Qfile_error, Qerror))); Fput (Qfile_date_error, Qerror_message, - make_pure_c_string ("Cannot set file date")); + build_pure_c_string ("Cannot set file date")); DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist, doc: /* Alist of elements (REGEXP . HANDLER) for file names handled specially. === modified file 'src/fontset.c' --- src/fontset.c 2012-07-05 18:35:48 +0000 +++ src/fontset.c 2012-07-10 08:43:46 +0000 @@ -2164,7 +2164,7 @@ staticpro (&Vdefault_fontset); FONTSET_ID (Vdefault_fontset) = make_number (0); FONTSET_NAME (Vdefault_fontset) - = make_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default"); + = build_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default"); ASET (Vfontset_table, 0, Vdefault_fontset); next_fontset_id = 1; @@ -2210,7 +2210,7 @@ DEFVAR_LISP ("fontset-alias-alist", Vfontset_alias_alist, doc: /* Alist of fontset names vs the aliases. */); Vfontset_alias_alist = Fcons (Fcons (FONTSET_NAME (Vdefault_fontset), - make_pure_c_string ("fontset-default")), + build_pure_c_string ("fontset-default")), Qnil); DEFVAR_LISP ("vertical-centering-font-regexp", === modified file 'src/frame.c' --- src/frame.c 2012-07-09 12:02:27 +0000 +++ src/frame.c 2012-07-10 08:43:46 +0000 @@ -477,7 +477,7 @@ Vframe_list = Fcons (frame, Vframe_list); tty_frame_count = 1; - f->name = make_pure_c_string ("F1"); + f->name = build_pure_c_string ("F1"); f->visible = 1; f->async_visible = 1; === modified file 'src/keyboard.c' --- src/keyboard.c 2012-07-05 18:35:48 +0000 +++ src/keyboard.c 2012-07-10 08:43:46 +0000 @@ -11441,7 +11441,7 @@ pending_funcalls = Qnil; staticpro (&pending_funcalls); - Vlispy_mouse_stem = make_pure_c_string ("mouse"); + Vlispy_mouse_stem = build_pure_c_string ("mouse"); staticpro (&Vlispy_mouse_stem); /* Tool-bars. */ === modified file 'src/keymap.c' --- src/keymap.c 2012-07-05 18:35:48 +0000 +++ src/keymap.c 2012-07-10 08:43:46 +0000 @@ -3705,11 +3705,11 @@ Ffset (intern_c_string ("Control-X-prefix"), control_x_map); exclude_keys - = pure_cons (pure_cons (make_pure_c_string ("DEL"), make_pure_c_string ("\\d")), - pure_cons (pure_cons (make_pure_c_string ("TAB"), make_pure_c_string ("\\t")), - pure_cons (pure_cons (make_pure_c_string ("RET"), make_pure_c_string ("\\r")), - pure_cons (pure_cons (make_pure_c_string ("ESC"), make_pure_c_string ("\\e")), - pure_cons (pure_cons (make_pure_c_string ("SPC"), make_pure_c_string (" ")), + = pure_cons (pure_cons (build_pure_c_string ("DEL"), build_pure_c_string ("\\d")), + pure_cons (pure_cons (build_pure_c_string ("TAB"), build_pure_c_string ("\\t")), + pure_cons (pure_cons (build_pure_c_string ("RET"), build_pure_c_string ("\\r")), + pure_cons (pure_cons (build_pure_c_string ("ESC"), build_pure_c_string ("\\e")), + pure_cons (pure_cons (build_pure_c_string ("SPC"), build_pure_c_string (" ")), Qnil))))); staticpro (&exclude_keys); === modified file 'src/lisp.h' --- src/lisp.h 2012-07-09 16:38:45 +0000 +++ src/lisp.h 2012-07-10 08:43:46 +0000 @@ -2626,7 +2626,15 @@ extern Lisp_Object make_specified_string (const char *, ptrdiff_t, ptrdiff_t, int); extern Lisp_Object make_pure_string (const char *, ptrdiff_t, ptrdiff_t, int); -extern Lisp_Object make_pure_c_string (const char *data); +extern Lisp_Object make_pure_c_string (const char *, ptrdiff_t); + +/* Make a string allocated in pure space, use STR as string data. */ + +static inline Lisp_Object +build_pure_c_string (const char *str) +{ + return make_pure_c_string (str, strlen (str)); +} /* Make a string from the data at STR, treating it as multibyte if the data warrants. */ === modified file 'src/lread.c' --- src/lread.c 2012-07-10 07:59:31 +0000 +++ src/lread.c 2012-07-10 08:43:46 +0000 @@ -3700,7 +3700,7 @@ with the extra copy. */ abort (); - return Fintern (make_pure_c_string (str), obarray); + return Fintern (make_pure_c_string (str, len), obarray); } DEFUN ("intern", Fintern, Sintern, 1, 2, 0, @@ -3941,7 +3941,7 @@ initial_obarray = Vobarray; staticpro (&initial_obarray); - Qunbound = Fmake_symbol (make_pure_c_string ("unbound")); + Qunbound = Fmake_symbol (build_pure_c_string ("unbound")); /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the NILP (Vpurify_flag) check in intern_c_string. */ Qnil = make_number (-1); Vpurify_flag = make_number (1); @@ -4441,8 +4441,8 @@ This list should not include the empty string. `load' and related functions try to append these suffixes, in order, to the specified file name if a Lisp suffix is allowed or required. */); - Vload_suffixes = Fcons (make_pure_c_string (".elc"), - Fcons (make_pure_c_string (".el"), Qnil)); + Vload_suffixes = Fcons (build_pure_c_string (".elc"), + Fcons (build_pure_c_string (".el"), Qnil)); DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes, doc: /* List of suffixes that indicate representations of \ the same file. @@ -4575,7 +4575,7 @@ When the regular expression matches, the file is considered to be safe to load. See also `load-dangerous-libraries'. */); Vbytecomp_version_regexp - = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)"); + = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)"); Qlexical_binding = intern ("lexical-binding"); staticpro (&Qlexical_binding); === modified file 'src/search.c' --- src/search.c 2012-07-05 18:35:48 +0000 +++ src/search.c 2012-07-10 08:43:46 +0000 @@ -3056,12 +3056,12 @@ Fput (Qsearch_failed, Qerror_conditions, pure_cons (Qsearch_failed, pure_cons (Qerror, Qnil))); Fput (Qsearch_failed, Qerror_message, - make_pure_c_string ("Search failed")); + build_pure_c_string ("Search failed")); Fput (Qinvalid_regexp, Qerror_conditions, pure_cons (Qinvalid_regexp, pure_cons (Qerror, Qnil))); Fput (Qinvalid_regexp, Qerror_message, - make_pure_c_string ("Invalid regexp")); + build_pure_c_string ("Invalid regexp")); last_thing_searched = Qnil; staticpro (&last_thing_searched); === modified file 'src/syntax.c' --- src/syntax.c 2012-07-05 18:35:48 +0000 +++ src/syntax.c 2012-07-10 08:43:46 +0000 @@ -3475,7 +3475,7 @@ Fput (Qscan_error, Qerror_conditions, pure_cons (Qscan_error, pure_cons (Qerror, Qnil))); Fput (Qscan_error, Qerror_message, - make_pure_c_string ("Scan error")); + build_pure_c_string ("Scan error")); DEFVAR_BOOL ("parse-sexp-ignore-comments", parse_sexp_ignore_comments, doc: /* Non-nil means `forward-sexp', etc., should treat comments as whitespace. */); === modified file 'src/w32fns.c' --- src/w32fns.c 2012-07-06 20:00:42 +0000 +++ src/w32fns.c 2012-07-10 08:43:46 +0000 @@ -6798,7 +6798,7 @@ Fput (Qundefined_color, Qerror_conditions, pure_cons (Qundefined_color, pure_cons (Qerror, Qnil))); Fput (Qundefined_color, Qerror_message, - make_pure_c_string ("Undefined color")); + build_pure_c_string ("Undefined color")); staticpro (&w32_grabbed_keys); w32_grabbed_keys = Qnil; === modified file 'src/xdisp.c' --- src/xdisp.c 2012-07-09 12:02:27 +0000 +++ src/xdisp.c 2012-07-10 08:43:46 +0000 @@ -28728,7 +28728,7 @@ staticpro (&echo_area_buffer[0]); staticpro (&echo_area_buffer[1]); - Vmessages_buffer_name = make_pure_c_string ("*Messages*"); + Vmessages_buffer_name = build_pure_c_string ("*Messages*"); staticpro (&Vmessages_buffer_name); mode_line_proptrans_alist = Qnil; @@ -28809,7 +28809,7 @@ DEFVAR_LISP ("overlay-arrow-string", Voverlay_arrow_string, doc: /* String to display as an arrow in non-window frames. See also `overlay-arrow-position'. */); - Voverlay_arrow_string = make_pure_c_string ("=>"); + Voverlay_arrow_string = build_pure_c_string ("=>"); DEFVAR_LISP ("overlay-arrow-variable-list", Voverlay_arrow_variable_list, doc: /* List of variables (symbols) which hold markers for overlay arrows. @@ -28915,10 +28915,10 @@ Vicon_title_format = Vframe_title_format = pure_cons (intern_c_string ("multiple-frames"), - pure_cons (make_pure_c_string ("%b"), + pure_cons (build_pure_c_string ("%b"), pure_cons (pure_cons (empty_unibyte_string, pure_cons (intern_c_string ("invocation-name"), - pure_cons (make_pure_c_string ("@"), + pure_cons (build_pure_c_string ("@"), pure_cons (intern_c_string ("system-name"), Qnil)))), Qnil))); === modified file 'src/xfaces.c' --- src/xfaces.c 2012-07-07 19:23:41 +0000 +++ src/xfaces.c 2012-07-10 08:43:46 +0000 @@ -6643,7 +6643,7 @@ This stipple pattern is used on monochrome displays instead of shades of gray for a face background color. See `set-face-stipple' for possible values for this variable. */); - Vface_default_stipple = make_pure_c_string ("gray3"); + Vface_default_stipple = build_pure_c_string ("gray3"); DEFVAR_LISP ("tty-defined-color-alist", Vtty_defined_color_alist, doc: /* An alist of defined terminal colors and their RGB values. === modified file 'src/xfns.c' --- src/xfns.c 2012-07-06 20:00:42 +0000 +++ src/xfns.c 2012-07-10 08:43:46 +0000 @@ -5828,7 +5828,7 @@ Fput (Qundefined_color, Qerror_conditions, pure_cons (Qundefined_color, pure_cons (Qerror, Qnil))); Fput (Qundefined_color, Qerror_message, - make_pure_c_string ("Undefined color")); + build_pure_c_string ("Undefined color")); DEFVAR_LISP ("x-pointer-shape", Vx_pointer_shape, doc: /* The shape of the pointer when over text. === modified file 'src/xterm.c' --- src/xterm.c 2012-07-05 18:35:48 +0000 +++ src/xterm.c 2012-07-10 08:43:46 +0000 @@ -10845,7 +10845,7 @@ last_mouse_press_frame = Qnil; #ifdef USE_GTK - xg_default_icon_file = make_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg"); + xg_default_icon_file = build_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg"); staticpro (&xg_default_icon_file); DEFSYM (Qx_gtk_map_stock, "x-gtk-map-stock"); ------------------------------------------------------------ revno: 108992 committer: Dmitry Antipov branch nick: trunk timestamp: Tue 2012-07-10 11:59:31 +0400 message: Avoid calls to strlen in miscellaneous functions. * buffer.c (init_buffer): Use precalculated len, adjust if needed. * font.c (Ffont_xlfd_name): Likewise. Change to call make_string. * lread.c (openp): Likewise. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-10 07:37:17 +0000 +++ src/ChangeLog 2012-07-10 07:59:31 +0000 @@ -1,11 +1,18 @@ 2012-07-10 Dmitry Antipov + Avoid calls to strlen in miscellaneous functions. + * buffer.c (init_buffer): Use precalculated len, adjust if needed. + * font.c (Ffont_xlfd_name): Likewise. Change to call make_string. + * lread.c (openp): Likewise. + +2012-07-10 Dmitry Antipov + Avoid calls to strlen in path processing functions. * fileio.c (file_name_as_directory): Add comment. Change to add srclen argument and return the length of result. Adjust users accordingly. (directory_file_name): Fix comment. Change to add srclen argument, - swap 1nd and 2st arguments to obey the common convention. Adjust + swap 1st and 2nd arguments to obey the common convention. Adjust users accordingly. * filelock.c (fill_in_lock_file_name): Avoid calls to strlen. === modified file 'src/buffer.c' --- src/buffer.c 2012-07-09 12:02:27 +0000 +++ src/buffer.c 2012-07-10 07:59:31 +0000 @@ -5091,9 +5091,10 @@ fatal ("`get_current_dir_name' failed: %s\n", strerror (errno)); pwd[len] = DIRECTORY_SEP; pwd[len + 1] = '\0'; + len++; } - BVAR (current_buffer, directory) = make_unibyte_string (pwd, strlen (pwd)); + BVAR (current_buffer, directory) = make_unibyte_string (pwd, len); if (! NILP (BVAR (&buffer_defaults, enable_multibyte_characters))) /* At this moment, we still don't know how to decode the directory name. So, we keep the bytes in multibyte form so === modified file 'src/font.c' --- src/font.c 2012-07-05 18:35:48 +0000 +++ src/font.c 2012-07-10 07:59:31 +0000 @@ -4218,7 +4218,7 @@ (Lisp_Object font, Lisp_Object fold_wildcards) { char name[256]; - int pixel_size = 0; + int namelen, pixel_size = 0; CHECK_FONT (font); @@ -4232,11 +4232,13 @@ if (NILP (fold_wildcards)) return font_name; strcpy (name, SSDATA (font_name)); + namelen = SBYTES (font_name); goto done; } pixel_size = XFONT_OBJECT (font)->pixel_size; } - if (font_unparse_xlfd (font, pixel_size, name, 256) < 0) + namelen = font_unparse_xlfd (font, pixel_size, name, 256); + if (namelen < 0) return Qnil; done: if (! NILP (fold_wildcards)) @@ -4246,11 +4248,12 @@ while ((p1 = strstr (p0, "-*-*"))) { strcpy (p1, p1 + 2); + namelen -= 2; p0 = p1; } } - return build_string (name); + return make_string (name, namelen); } DEFUN ("clear-font-cache", Fclear_font_cache, Sclear_font_cache, 0, 0, 0, === modified file 'src/lread.c' --- src/lread.c 2012-07-10 01:04:28 +0000 +++ src/lread.c 2012-07-10 07:59:31 +0000 @@ -1489,7 +1489,7 @@ for (tail = NILP (suffixes) ? Fcons (empty_unibyte_string, Qnil) : suffixes; CONSP (tail); tail = XCDR (tail)) { - ptrdiff_t lsuffix = SBYTES (XCAR (tail)); + ptrdiff_t fnlen, lsuffix = SBYTES (XCAR (tail)); Lisp_Object handler; int exists; @@ -1499,20 +1499,22 @@ && SREF (filename, 0) == '/' && SREF (filename, 1) == ':') { - strncpy (fn, SSDATA (filename) + 2, - SBYTES (filename) - 2); - fn[SBYTES (filename) - 2] = 0; + fnlen = SBYTES (filename) - 2; + strncpy (fn, SSDATA (filename) + 2, fnlen); + fn[fnlen] = '\0'; } else { - strncpy (fn, SSDATA (filename), - SBYTES (filename)); - fn[SBYTES (filename)] = 0; + fnlen = SBYTES (filename); + strncpy (fn, SSDATA (filename), fnlen); + fn[fnlen] = '\0'; } if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */ - strncat (fn, SSDATA (XCAR (tail)), lsuffix); - + { + strncat (fn, SSDATA (XCAR (tail)), lsuffix); + fnlen += lsuffix; + } /* Check that the file exists and is not a directory. */ /* We used to only check for handlers on non-absolute file names: if (absolute) @@ -1521,7 +1523,7 @@ handler = Ffind_file_name_handler (filename, Qfile_exists_p); It's not clear why that was the case and it breaks things like (load "/bar.el") where the file is actually "/bar.el.gz". */ - string = build_string (fn); + string = make_string (fn, fnlen); handler = Ffind_file_name_handler (string, Qfile_exists_p); if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate)) { ------------------------------------------------------------ revno: 108991 committer: Glenn Morris branch nick: trunk timestamp: Tue 2012-07-10 00:37:17 -0700 message: Move PENDING_OUTPUT_COUNT from src/s to configure * configure.ac (PENDING_OUTPUT_COUNT): Move here from src/s. * src/s/cygwin.h, src/s/darwin.h, src/s/freebsd.h, src/s/netbsd.h: * src/s/unixware.h: Move PENDING_OUTPUT_COUNT definition to configure. diff: === modified file 'ChangeLog' --- ChangeLog 2012-07-10 07:15:05 +0000 +++ ChangeLog 2012-07-10 07:37:17 +0000 @@ -1,6 +1,7 @@ 2012-07-10 Glenn Morris - * configure.ac (DATA_START, DATA_SEG_BITS): Move here from src/s. + * configure.ac (DATA_START, DATA_SEG_BITS, PENDING_OUTPUT_COUNT): + Move here from src/s. 2012-07-09 Andreas Schwab === modified file 'configure.ac' --- configure.ac 2012-07-10 07:15:05 +0000 +++ configure.ac 2012-07-10 07:37:17 +0000 @@ -3154,7 +3154,19 @@ stored in a Lisp_Object.]) dnl if Emacs uses fewer than 32 bits for the value field of a LISP_OBJECT. +dnl Used in dispnew.c +AH_TEMPLATE(PENDING_OUTPUT_COUNT, [Number of chars of output in the +buffer of a stdio stream.]) + case $opsys in + cygwin | darwin | freebsd | netbsd | openbsd ) + AC_DEFINE(PENDING_OUTPUT_COUNT(FILE), [((FILE)->_p - (FILE)->_bf._base)]) + ;; + + unixware) + AC_DEFINE(PENDING_OUTPUT_COUNT(FILE), [((FILE)->__ptr - (FILE)->__base)]) + ;; + gnu) dnl libc defines data_start. AC_DEFINE(DATA_START, [({ extern int data_start; (char *) &data_start; })]) === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-10 07:15:05 +0000 +++ src/ChangeLog 2012-07-10 07:37:17 +0000 @@ -11,6 +11,9 @@ 2012-07-10 Glenn Morris + * s/cygwin.h, s/darwin.h, s/freebsd.h, s/netbsd.h, s/unixware.h: + Move PENDING_OUTPUT_COUNT definition to configure. + * s/irix6-5.h (DATA_START, DATA_SEG_BITS): * s/hpux10-20.h (DATA_SEG_BITS, DATA_START): * s/gnu.h (DATA_START): Move definitions to configure. === modified file 'src/s/cygwin.h' --- src/s/cygwin.h 2012-06-11 23:17:11 +0000 +++ src/s/cygwin.h 2012-07-10 07:37:17 +0000 @@ -74,8 +74,6 @@ /* Used in various places to enable cygwin-specific code changes. */ #define CYGWIN 1 -#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base) - #define HAVE_SOCKETS /* Emacs supplies its own malloc, but glib (part of Gtk+) calls === modified file 'src/s/darwin.h' --- src/s/darwin.h 2012-07-07 01:03:46 +0000 +++ src/s/darwin.h 2012-07-10 07:37:17 +0000 @@ -92,9 +92,6 @@ also the name of a Mach system call. */ #define init_process emacs_init_process -/* Used in dispnew.c. Copied from freebsd.h. */ -#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base) - /* System uses OXTABS instead of the expected TAB3. (Copied from bsd386.h.) */ #define TAB3 OXTABS === modified file 'src/s/freebsd.h' --- src/s/freebsd.h 2012-04-14 06:18:49 +0000 +++ src/s/freebsd.h 2012-07-10 07:37:17 +0000 @@ -23,8 +23,6 @@ /* Get most of the stuff from bsd-common */ #include "bsd-common.h" -#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base) - /* This silences a few compilation warnings. */ #undef BSD_SYSTEM #if __FreeBSD__ == 1 === modified file 'src/s/netbsd.h' --- src/s/netbsd.h 2012-04-14 06:18:49 +0000 +++ src/s/netbsd.h 2012-07-10 07:37:17 +0000 @@ -21,8 +21,6 @@ /* Get most of the stuff from bsd-common. */ #include "bsd-common.h" -#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base) - #define DEFAULT_SOUND_DEVICE "/dev/audio" /* Greg A. Woods says we must include signal.h === modified file 'src/s/unixware.h' --- src/s/unixware.h 2012-07-07 01:03:46 +0000 +++ src/s/unixware.h 2012-07-10 07:37:17 +0000 @@ -44,8 +44,6 @@ pty_name[sizeof(pty_name) - 1] = 0; \ } -#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->__ptr - (FILE)->__base) - /* Conservative garbage collection has not been tested, so for now play it safe and stick with the old-fashioned way of marking. */ #define GC_MARK_STACK GC_USE_GCPROS_AS_BEFORE ------------------------------------------------------------ revno: 108990 committer: Glenn Morris branch nick: trunk timestamp: Tue 2012-07-10 00:15:05 -0700 message: Move DATA_START, DATA_SEG_BITS from src/s to configure * configure.ac (DATA_START, DATA_SEG_BITS): Move here from src/s. * src/s/irix6-5.h (DATA_START, DATA_SEG_BITS): * src/s/hpux10-20.h (DATA_SEG_BITS, DATA_START): * src/s/gnu.h (DATA_START): Move definitions to configure. diff: === modified file 'ChangeLog' --- ChangeLog 2012-07-09 22:06:31 +0000 +++ ChangeLog 2012-07-10 07:15:05 +0000 @@ -1,3 +1,7 @@ +2012-07-10 Glenn Morris + + * configure.ac (DATA_START, DATA_SEG_BITS): Move here from src/s. + 2012-07-09 Andreas Schwab * configure.ac (PNG_DEPSTRUCT): Define this instead of === modified file 'configure.ac' --- configure.ac 2012-07-09 22:06:31 +0000 +++ configure.ac 2012-07-10 07:15:05 +0000 @@ -3145,6 +3145,32 @@ ;; esac +dnl Used in vm-limit.c +AH_TEMPLATE(DATA_START, [Address of the start of the data segment.]) +dnl Used in lisp.h, emacs.c, mem-limits.h +dnl NEWS.18 describes this as "a number which contains +dnl the high bits to be inclusive or'ed with pointers that are unpacked." +AH_TEMPLATE(DATA_SEG_BITS, [Extra bits to be or'd in with any pointers +stored in a Lisp_Object.]) +dnl if Emacs uses fewer than 32 bits for the value field of a LISP_OBJECT. + +case $opsys in + gnu) + dnl libc defines data_start. + AC_DEFINE(DATA_START, [({ extern int data_start; (char *) &data_start; })]) + ;; + + hpux*) + dnl The data segment on this machine always starts at address 0x40000000. + AC_DEFINE(DATA_START, [0x40000000]) + AC_DEFINE(DATA_SEG_BITS, [0x40000000]) + ;; + irix6-5) + AC_DEFINE(DATA_START, [0x10000000]) + AC_DEFINE(DATA_SEG_BITS, [0x10000000]) + ;; +esac + case $opsys in gnu-kfreebsd) opsysfile="s/gnu-linux.h" ;; === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-10 06:23:45 +0000 +++ src/ChangeLog 2012-07-10 07:15:05 +0000 @@ -11,6 +11,10 @@ 2012-07-10 Glenn Morris + * s/irix6-5.h (DATA_START, DATA_SEG_BITS): + * s/hpux10-20.h (DATA_SEG_BITS, DATA_START): + * s/gnu.h (DATA_START): Move definitions to configure. + * s/irix6-5.h (SETUP_SLAVE_PTY, PTY_NAME_SPRINTF): Drop ifdef guards. We include usg5-4-common.h, which defines them both. === modified file 'src/s/gnu.h' --- src/s/gnu.h 2012-07-10 01:33:53 +0000 +++ src/s/gnu.h 2012-07-10 07:15:05 +0000 @@ -21,9 +21,6 @@ /* Get most of the stuff from bsd-common */ #include "bsd-common.h" -/* libc defines data_start. */ -#define DATA_START ({ extern int data_start; (char *) &data_start; }) - /* It would be harmless to drop the ifdef emacs test. */ #ifdef emacs #include /* Get the definition of _IO_STDIO_H. */ === modified file 'src/s/hpux10-20.h' --- src/s/hpux10-20.h 2012-07-07 01:03:46 +0000 +++ src/s/hpux10-20.h 2012-07-10 07:15:05 +0000 @@ -79,8 +79,3 @@ /* Conservative garbage collection has not been tested, so for now play it safe and stick with the old-fashioned way of marking. */ #define GC_MARK_STACK GC_USE_GCPROS_AS_BEFORE - -/* The data segment on this machine always starts at address 0x40000000. */ -#define DATA_SEG_BITS 0x40000000 - -#define DATA_START 0x40000000 === modified file 'src/s/irix6-5.h' --- src/s/irix6-5.h 2012-07-10 01:49:46 +0000 +++ src/s/irix6-5.h 2012-07-10 07:15:05 +0000 @@ -82,10 +82,3 @@ /* Tested on Irix 6.5. SCM worked on earlier versions. */ #define GC_SETJMP_WORKS 1 - - -/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers which - were stored in a Lisp_Object (as Emacs uses fewer than 32 bits for - the value field of a LISP_OBJECT). */ -#define DATA_START 0x10000000 -#define DATA_SEG_BITS 0x10000000 ------------------------------------------------------------ revno: 108989 committer: Dmitry Antipov branch nick: trunk timestamp: Tue 2012-07-10 10:23:45 +0400 message: Avoid calls to strlen in path processing functions. * fileio.c (file_name_as_directory): Add comment. Change to add srclen argument and return the length of result. Adjust users accordingly. (directory_file_name): Fix comment. Change to add srclen argument, swap 1nd and 2st arguments to obey the common convention. Adjust users accordingly. * filelock.c (fill_in_lock_file_name): Avoid calls to strlen. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2012-07-10 01:49:46 +0000 +++ src/ChangeLog 2012-07-10 06:23:45 +0000 @@ -1,3 +1,14 @@ +2012-07-10 Dmitry Antipov + + Avoid calls to strlen in path processing functions. + * fileio.c (file_name_as_directory): Add comment. Change to add + srclen argument and return the length of result. Adjust users + accordingly. + (directory_file_name): Fix comment. Change to add srclen argument, + swap 1nd and 2st arguments to obey the common convention. Adjust + users accordingly. + * filelock.c (fill_in_lock_file_name): Avoid calls to strlen. + 2012-07-10 Glenn Morris * s/irix6-5.h (SETUP_SLAVE_PTY, PTY_NAME_SPRINTF): Drop ifdef guards. === modified file 'src/fileio.c' --- src/fileio.c 2012-07-07 01:57:42 +0000 +++ src/fileio.c 2012-07-10 06:23:45 +0000 @@ -453,32 +453,33 @@ return Ffile_name_directory (filename); } - -static char * -file_name_as_directory (char *out, const char *in) +/* Convert from file name SRC of length SRCLEN to directory name + in DST. On UNIX, just make sure there is a terminating /. + Return the length of DST. */ + +static ptrdiff_t +file_name_as_directory (char *dst, const char *src, ptrdiff_t srclen) { - ptrdiff_t len = strlen (in); - - if (len == 0) + if (srclen == 0) { - out[0] = '.'; - out[1] = '/'; - out[2] = 0; - return out; + dst[0] = '.'; + dst[1] = '/'; + dst[2] = '\0'; + return 2; } - strcpy (out, in); + strcpy (dst, src); - /* For Unix syntax, Append a slash if necessary */ - if (!IS_DIRECTORY_SEP (out[len - 1])) + if (!IS_DIRECTORY_SEP (dst[srclen - 1])) { - out[len] = DIRECTORY_SEP; - out[len + 1] = '\0'; + dst[srclen] = DIRECTORY_SEP; + dst[srclen + 1] = '\0'; + srclen++; } #ifdef DOS_NT - dostounix_filename (out); + dostounix_filename (dst); #endif - return out; + return srclen; } DEFUN ("file-name-as-directory", Ffile_name_as_directory, @@ -492,6 +493,7 @@ (Lisp_Object file) { char *buf; + ptrdiff_t length; Lisp_Object handler; CHECK_STRING (file); @@ -511,39 +513,34 @@ } buf = alloca (SBYTES (file) + 10); - file_name_as_directory (buf, SSDATA (file)); - return make_specified_string (buf, -1, strlen (buf), - STRING_MULTIBYTE (file)); + length = file_name_as_directory (buf, SSDATA (file), SBYTES (file)); + return make_specified_string (buf, -1, length, STRING_MULTIBYTE (file)); } -/* - * Convert from directory name to filename. - * On UNIX, it's simple: just make sure there isn't a terminating / - - * Value is nonzero if the string output is different from the input. - */ - -static int -directory_file_name (char *src, char *dst) +/* Convert from directory name SRC of length SRCLEN to + file name in DST. On UNIX, just make sure there isn't + a terminating /. Return the length of DST. */ + +static ptrdiff_t +directory_file_name (char *dst, char *src, ptrdiff_t srclen) { - ptrdiff_t slen; - - slen = strlen (src); - /* Process as Unix format: just remove any final slash. But leave "/" unchanged; do not change it to "". */ strcpy (dst, src); - if (slen > 1 - && IS_DIRECTORY_SEP (dst[slen - 1]) + if (srclen > 1 + && IS_DIRECTORY_SEP (dst[srclen - 1]) #ifdef DOS_NT - && !IS_ANY_SEP (dst[slen - 2]) + && !IS_ANY_SEP (dst[srclen - 2]) #endif ) - dst[slen - 1] = 0; + { + dst[srclen - 1] = 0; + srclen--; + } #ifdef DOS_NT dostounix_filename (dst); #endif - return 1; + return srclen; } DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name, @@ -556,6 +553,7 @@ (Lisp_Object directory) { char *buf; + ptrdiff_t length; Lisp_Object handler; CHECK_STRING (directory); @@ -576,9 +574,8 @@ } buf = alloca (SBYTES (directory) + 20); - directory_file_name (SSDATA (directory), buf); - return make_specified_string (buf, -1, strlen (buf), - STRING_MULTIBYTE (directory)); + length = directory_file_name (buf, SSDATA (directory), SBYTES (directory)); + return make_specified_string (buf, -1, length, STRING_MULTIBYTE (directory)); } static const char make_temp_name_tbl[64] = @@ -1130,8 +1127,9 @@ } if (!IS_DIRECTORY_SEP (nm[0])) { - char * tmp = alloca (strlen (newdir) + strlen (nm) + 2); - file_name_as_directory (tmp, newdir); + ptrdiff_t newlen = strlen (newdir); + char *tmp = alloca (newlen + strlen (nm) + 2); + file_name_as_directory (tmp, newdir, newlen); strcat (tmp, nm); nm = tmp; } @@ -1180,6 +1178,7 @@ /* Get rid of any slash at the end of newdir, unless newdir is just / or // (an incomplete UNC name). */ length = strlen (newdir); + tlen = length + 1; if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1]) #ifdef WINDOWSNT && !(length == 2 && IS_DIRECTORY_SEP (newdir[0])) @@ -1189,12 +1188,15 @@ char *temp = alloca (length); memcpy (temp, newdir, length - 1); temp[length - 1] = 0; + length--; newdir = temp; } - tlen = length + 1; } else - tlen = 0; + { + length = 0; + tlen = 0; + } /* Now concatenate the directory and name to new space in the stack frame. */ tlen += strlen (nm) + 1; @@ -1225,7 +1227,7 @@ strcpy (target, newdir); } else - file_name_as_directory (target, newdir); + file_name_as_directory (target, newdir, length); } strcat (target, nm); === modified file 'src/filelock.c' --- src/filelock.c 2012-07-09 12:02:27 +0000 +++ src/filelock.c 2012-07-10 06:23:45 +0000 @@ -300,6 +300,7 @@ static void fill_in_lock_file_name (register char *lockfile, register Lisp_Object fn) { + ptrdiff_t length = SBYTES (fn); register char *p; struct stat st; int count = 0; @@ -309,14 +310,14 @@ /* Shift the nondirectory part of the file name (including the null) right two characters. Here is one of the places where we'd have to do something to support 14-character-max file names. */ - for (p = lockfile + strlen (lockfile); p != lockfile && *p != '/'; p--) + for (p = lockfile + length; p != lockfile && *p != '/'; p--) p[2] = *p; /* Insert the `.#'. */ p[1] = '.'; p[2] = '#'; - p = p + strlen (p); + p = p + length + 2; while (lstat (lockfile, &st) == 0 && !S_ISLNK (st.st_mode)) {