------------------------------------------------------------ revno: 117887 fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=18482 committer: Stefan Monnier branch nick: trunk timestamp: Mon 2014-09-15 20:28:28 -0400 message: * lisp/msb.el (msb--make-keymap-menu, msb-menu-bar-update-buffers): Don't add outdated key-shortcut cache. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2014-09-15 00:20:21 +0000 +++ lisp/ChangeLog 2014-09-16 00:28:28 +0000 @@ -1,3 +1,8 @@ +2014-09-16 Stefan Monnier + + * msb.el (msb--make-keymap-menu, msb-menu-bar-update-buffers): + Don't add outdated key-shortcut cache (bug#18482). + 2014-09-15 Glenn Morris * image.el (image-multi-frame-p): Fix thinko - do not force === modified file 'lisp/msb.el' --- lisp/msb.el 2014-02-10 01:34:22 +0000 +++ lisp/msb.el 2014-09-16 00:28:28 +0000 @@ -1064,7 +1064,7 @@ list)) (defun msb--make-keymap-menu (raw-menu) - (let ((end (cons '(nil) 'menu-bar-select-buffer)) + (let ((end 'menu-bar-select-buffer) (mcount 0)) (mapcar (lambda (sub-menu) @@ -1105,13 +1105,12 @@ (setcdr (nthcdr msb-max-menu-items frames) nil)) (setq frames-menu (nconc - (list 'frame f-title '(nil) 'keymap f-title) + (list 'frame f-title 'keymap f-title) (mapcar (lambda (frame) (nconc (list (frame-parameter frame 'name) - (frame-parameter frame 'name) - (cons nil nil)) + (frame-parameter frame 'name)) `(lambda () (interactive) (menu-bar-select-frame ,frame)))) frames))))) ------------------------------------------------------------ revno: 117886 committer: Eli Zaretskii branch nick: trunk timestamp: Mon 2014-09-15 18:51:57 +0300 message: Support playing on MS-Windows non-ASCII sound files using Unicode APIs. src/sound.c [WINDOWSNT]: Include w32common.h and mbstring.h. (SOUND_WARNING) [WINDOWSNT]: Include in do..while and improve the error message format. Use message_with_string to have non-ASCII file names properly displayed. (do_play_sound) [WINDOWSNT]: Use Unicode APIs to play sound files when w32-unicode-filenames is non-nil, but not on Windows 9X, where these APIs are not available even in UNICOWS.DLL. Improve the format of error messages and include the file name in them where appropriate. (Fplay_sound_internal) [WINDOWSNT]: Make the MS-Windows branch call play-sound-functions, per documentation. src/w32.c (w32_get_long_filename, w32_get_short_filename): Constify the input file name arguments. src/w32.h (w32_get_long_filename, w32_get_short_filename): Update prototypes. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2014-09-15 14:53:23 +0000 +++ src/ChangeLog 2014-09-15 15:51:57 +0000 @@ -1,3 +1,23 @@ +2014-09-15 Eli Zaretskii + + * sound.c [WINDOWSNT]: Include w32common.h and mbstring.h. + (SOUND_WARNING) [WINDOWSNT]: Include in do..while and improve the + error message format. Use message_with_string to have non-ASCII + file names properly displayed. + (do_play_sound) [WINDOWSNT]: Use Unicode APIs to play sound files + when w32-unicode-filenames is non-nil, but not on Windows 9X, + where these APIs are not available even in UNICOWS.DLL. Improve + the format of error messages and include the file name in them + where appropriate. + (Fplay_sound_internal) [WINDOWSNT]: Make the MS-Windows branch + call play-sound-functions, per documentation. + + * w32.c (w32_get_long_filename, w32_get_short_filename): Constify + the input file name arguments. + + * w32.h (w32_get_long_filename, w32_get_short_filename): Update + prototypes. + 2014-09-15 Dmitry Antipov If USE_LOCAL_ALLOCATORS, allocate some Lisp objects on stack. === modified file 'src/sound.c' --- src/sound.c 2014-09-15 00:20:21 +0000 +++ src/sound.c 2014-09-15 15:51:57 +0000 @@ -86,10 +86,12 @@ /* BEGIN: Windows Specific Includes */ #include #include +#include #include #include #include "coding.h" +#include "w32common.h" #include "w32.h" /* END: Windows Specific Includes */ @@ -1207,38 +1209,83 @@ /* BEGIN: Windows specific functions */ -#define SOUND_WARNING(fun, error, text) \ - { \ - char buf[1024]; \ - char err_string[MAXERRORLENGTH]; \ - fun (error, err_string, sizeof (err_string)); \ - _snprintf (buf, sizeof (buf), "%s\nError: %s", \ - text, err_string); \ - sound_warning (buf); \ - } +#define SOUND_WARNING(func, error, text) \ + do { \ + char buf[1024]; \ + char err_string[MAXERRORLENGTH]; \ + func (error, err_string, sizeof (err_string)); \ + _snprintf (buf, sizeof (buf), "%s\nMCI Error: %s", \ + text, err_string); \ + message_with_string ("%s", build_string (buf), 1); \ + } while (0) static int do_play_sound (const char *psz_file, unsigned long ui_volume) { int i_result = 0; MCIERROR mci_error = 0; - char sz_cmd_buf[520] = {0}; - char sz_ret_buf[520] = {0}; + char sz_cmd_buf_a[520]; + char sz_ret_buf_a[520]; MMRESULT mm_result = MMSYSERR_NOERROR; unsigned long ui_volume_org = 0; BOOL b_reset_volume = FALSE; - - memset (sz_cmd_buf, 0, sizeof (sz_cmd_buf)); - memset (sz_ret_buf, 0, sizeof (sz_ret_buf)); - sprintf (sz_cmd_buf, - "open \"%s\" alias GNUEmacs_PlaySound_Device wait", - psz_file); - mci_error = mciSendString (sz_cmd_buf, sz_ret_buf, sizeof (sz_ret_buf), NULL); + char warn_text[560]; + + /* Since UNICOWS.DLL includes only a stub for mciSendStringW, we + need to encode the file in the ANSI codepage on Windows 9X even + if w32_unicode_filenames is non-zero. */ + if (w32_major_version <= 4 || !w32_unicode_filenames) + { + char fname_a[MAX_PATH], shortname[MAX_PATH], *fname_to_use; + + filename_to_ansi (psz_file, fname_a); + fname_to_use = fname_a; + /* If the file name is not encodable in ANSI, try its short 8+3 + alias. This will only work if w32_unicode_filenames is + non-zero. */ + if (_mbspbrk ((const unsigned char *)fname_a, + (const unsigned char *)"?")) + { + if (w32_get_short_filename (psz_file, shortname, MAX_PATH)) + fname_to_use = shortname; + else + mci_error = MCIERR_FILE_NOT_FOUND; + } + + if (!mci_error) + { + memset (sz_cmd_buf_a, 0, sizeof (sz_cmd_buf_a)); + memset (sz_ret_buf_a, 0, sizeof (sz_ret_buf_a)); + sprintf (sz_cmd_buf_a, + "open \"%s\" alias GNUEmacs_PlaySound_Device wait", + fname_to_use); + mci_error = mciSendStringA (sz_cmd_buf_a, + sz_ret_buf_a, sizeof (sz_ret_buf_a), NULL); + } + } + else + { + wchar_t sz_cmd_buf_w[520]; + wchar_t sz_ret_buf_w[520]; + wchar_t fname_w[MAX_PATH]; + + filename_to_utf16 (psz_file, fname_w); + memset (sz_cmd_buf_w, 0, sizeof (sz_cmd_buf_w)); + memset (sz_ret_buf_w, 0, sizeof (sz_ret_buf_w)); + /* _swprintf is not available on Windows 9X, so we construct the + UTF-16 command string by hand. */ + wcscpy (sz_cmd_buf_w, L"open \""); + wcscat (sz_cmd_buf_w, fname_w); + wcscat (sz_cmd_buf_w, L"\" alias GNUEmacs_PlaySound_Device wait"); + mci_error = mciSendStringW (sz_cmd_buf_w, + sz_ret_buf_w, ARRAYELTS (sz_ret_buf_w) , NULL); + } if (mci_error != 0) { - SOUND_WARNING (mciGetErrorString, mci_error, - "The open mciSendString command failed to open " - "the specified sound file."); + strcpy (warn_text, + "mciSendString: 'open' command failed to open sound file "); + strcat (warn_text, psz_file); + SOUND_WARNING (mciGetErrorString, mci_error, warn_text); i_result = (int) mci_error; return i_result; } @@ -1252,44 +1299,47 @@ if (mm_result != MMSYSERR_NOERROR) { SOUND_WARNING (waveOutGetErrorText, mm_result, - "waveOutSetVolume failed to set the volume level " - "of the WAVE_MAPPER device.\n" - "As a result, the user selected volume level will " - "not be used."); + "waveOutSetVolume: failed to set the volume level" + " of the WAVE_MAPPER device.\n" + "As a result, the user selected volume level will" + " not be used."); } } else { SOUND_WARNING (waveOutGetErrorText, mm_result, - "waveOutGetVolume failed to obtain the original " - "volume level of the WAVE_MAPPER device.\n" - "As a result, the user selected volume level will " - "not be used."); + "waveOutGetVolume: failed to obtain the original" + " volume level of the WAVE_MAPPER device.\n" + "As a result, the user selected volume level will" + " not be used."); } } - memset (sz_cmd_buf, 0, sizeof (sz_cmd_buf)); - memset (sz_ret_buf, 0, sizeof (sz_ret_buf)); - strcpy (sz_cmd_buf, "play GNUEmacs_PlaySound_Device wait"); - mci_error = mciSendString (sz_cmd_buf, sz_ret_buf, sizeof (sz_ret_buf), NULL); + memset (sz_cmd_buf_a, 0, sizeof (sz_cmd_buf_a)); + memset (sz_ret_buf_a, 0, sizeof (sz_ret_buf_a)); + strcpy (sz_cmd_buf_a, "play GNUEmacs_PlaySound_Device wait"); + mci_error = mciSendStringA (sz_cmd_buf_a, sz_ret_buf_a, sizeof (sz_ret_buf_a), + NULL); if (mci_error != 0) { - SOUND_WARNING (mciGetErrorString, mci_error, - "The play mciSendString command failed to play the " - "opened sound file."); + strcpy (warn_text, + "mciSendString: 'play' command failed to play sound file "); + strcat (warn_text, psz_file); + SOUND_WARNING (mciGetErrorString, mci_error, warn_text); i_result = (int) mci_error; } - memset (sz_cmd_buf, 0, sizeof (sz_cmd_buf)); - memset (sz_ret_buf, 0, sizeof (sz_ret_buf)); - strcpy (sz_cmd_buf, "close GNUEmacs_PlaySound_Device wait"); - mci_error = mciSendString (sz_cmd_buf, sz_ret_buf, sizeof (sz_ret_buf), NULL); + memset (sz_cmd_buf_a, 0, sizeof (sz_cmd_buf_a)); + memset (sz_ret_buf_a, 0, sizeof (sz_ret_buf_a)); + strcpy (sz_cmd_buf_a, "close GNUEmacs_PlaySound_Device wait"); + mci_error = mciSendStringA (sz_cmd_buf_a, sz_ret_buf_a, sizeof (sz_ret_buf_a), + NULL); if (b_reset_volume == TRUE) { mm_result = waveOutSetVolume ((HWAVEOUT) WAVE_MAPPER, ui_volume_org); if (mm_result != MMSYSERR_NOERROR) { SOUND_WARNING (waveOutGetErrorText, mm_result, - "waveOutSetVolume failed to reset the original volume " - "level of the WAVE_MAPPER device."); + "waveOutSetVolume: failed to reset the original" + " volume level of the WAVE_MAPPER device."); } } return i_result; @@ -1307,13 +1357,11 @@ { Lisp_Object attrs[SOUND_ATTR_SENTINEL]; ptrdiff_t count = SPECPDL_INDEX (); - -#ifndef WINDOWSNT Lisp_Object file; + Lisp_Object args[2]; struct gcpro gcpro1, gcpro2; - Lisp_Object args[2]; -#else /* WINDOWSNT */ - Lisp_Object lo_file; + +#ifdef WINDOWSNT unsigned long ui_volume_tmp = UINT_MAX; unsigned long ui_volume = UINT_MAX; #endif /* WINDOWSNT */ @@ -1386,11 +1434,8 @@ #else /* WINDOWSNT */ - lo_file = Fexpand_file_name (attrs[SOUND_FILE], Vdata_directory); - lo_file = ENCODE_FILE (lo_file); - /* Since UNICOWS.DLL includes only a stub for mciSendStringW, we - need to encode the file in the ANSI codepage. */ - lo_file = ansi_encode_filename (lo_file); + file = Fexpand_file_name (attrs[SOUND_FILE], Vdata_directory); + file = ENCODE_FILE (file); if (INTEGERP (attrs[SOUND_VOLUME])) { ui_volume_tmp = XFASTINT (attrs[SOUND_VOLUME]); @@ -1399,6 +1444,13 @@ { ui_volume_tmp = XFLOAT_DATA (attrs[SOUND_VOLUME]) * 100; } + + GCPRO2 (sound, file); + + args[0] = Qplay_sound_functions; + args[1] = sound; + Frun_hook_with_args (2, args); + /* Based on some experiments I have conducted, a value of 100 or less for the sound volume is much too low. You cannot even hear it. @@ -1412,7 +1464,9 @@ { ui_volume = ui_volume_tmp * (UINT_MAX / 100); } - do_play_sound (SDATA (lo_file), ui_volume); + (void)do_play_sound (SSDATA (file), ui_volume); + + UNGCPRO; #endif /* WINDOWSNT */ === modified file 'src/w32.c' --- src/w32.c 2014-09-15 00:20:21 +0000 +++ src/w32.c 2014-09-15 15:51:57 +0000 @@ -2294,7 +2294,7 @@ /* Get long name for file, if possible (assumed to be absolute). */ BOOL -w32_get_long_filename (char * name, char * buf, int size) +w32_get_long_filename (const char * name, char * buf, int size) { char * o = buf; char * p; @@ -2345,7 +2345,7 @@ } unsigned int -w32_get_short_filename (char * name, char * buf, int size) +w32_get_short_filename (const char * name, char * buf, int size) { if (w32_unicode_filenames) { === modified file 'src/w32.h' --- src/w32.h 2014-08-29 19:18:06 +0000 +++ src/w32.h 2014-09-15 15:51:57 +0000 @@ -144,10 +144,10 @@ extern int w32_valid_pointer_p (void *, int); /* Get long (aka "true") form of file name, if it exists. */ -extern BOOL w32_get_long_filename (char * name, char * buf, int size); +extern BOOL w32_get_long_filename (const char * name, char * buf, int size); /* Get the short (a.k.a. "8+3") form of a file name. */ -extern unsigned int w32_get_short_filename (char *, char *, int); +extern unsigned int w32_get_short_filename (const char *, char *, int); /* Prepare our standard handles for proper inheritance by child processes. */ extern void prepare_standard_handles (int in, int out, ------------------------------------------------------------ revno: 117885 committer: Dmitry Antipov branch nick: trunk timestamp: Mon 2014-09-15 18:53:23 +0400 message: If USE_LOCAL_ALLOCATORS, allocate some Lisp objects on stack. * lisp.h (local_cons, local_list1, local_list2, local_list3) [USE_LOCAL_ALLOCATORS]: New macros. [!USE_LOCAL_ALLOCATORS]: Fall back to regular functions. (build_local_string): Avoid argument name expansion clash with make_local_string. * alloc.c (toplevel) [USE_LOCAL_ALLOCATORS && GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS]: Preprocessor guard to avoid impossible configuration. * charset.c (Ffind_charset_region, Ffind_charset_string): Use make_local_vector. * lread.c (read1, substitute_object_recurse): Use scoped_cons. * textprop.c (Fput_text_property, Fadd_face_text_property): Use scoped_list2. (copy_text_properties): Use local_cons and local_list3. * chartab.c (uniprop_table): * data.c (wrong_choice, wrong_range): * doc.c (get_doc_string): * editfns.c (format2): * fileio.c (Fexpand_file_name, auto_save_error): * fns.c (Fyes_or_no_p): * font.c (font_parse_xlfd, font_parse_family_registry, font_add_log): * fontset.c (Fset_fontset_font): * keyboard.c (echo_add_key, echo_dash, parse_menu_item) (read_char_minibuf_menu_prompt): * keymap.c (silly_event_symbol_error, describe_vector): * menu.c (single_menu_item): * minibuf.c (Fread_buffer): * process.c (status_message, Fformat_network_address) (server_accept_connection): Use make_local_string and build_local_string. Prefer compound literals where appropriate. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2014-09-15 05:09:44 +0000 +++ src/ChangeLog 2014-09-15 14:53:23 +0000 @@ -1,3 +1,37 @@ +2014-09-15 Dmitry Antipov + + If USE_LOCAL_ALLOCATORS, allocate some Lisp objects on stack. + * lisp.h (local_cons, local_list1, local_list2, local_list3) + [USE_LOCAL_ALLOCATORS]: New macros. + [!USE_LOCAL_ALLOCATORS]: Fall back to regular functions. + (build_local_string): Avoid argument name expansion clash with + make_local_string. + * alloc.c (toplevel) + [USE_LOCAL_ALLOCATORS && GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS]: + Preprocessor guard to avoid impossible configuration. + * charset.c (Ffind_charset_region, Ffind_charset_string): + Use make_local_vector. + * lread.c (read1, substitute_object_recurse): Use scoped_cons. + * textprop.c (Fput_text_property, Fadd_face_text_property): + Use scoped_list2. + (copy_text_properties): Use local_cons and local_list3. + * chartab.c (uniprop_table): + * data.c (wrong_choice, wrong_range): + * doc.c (get_doc_string): + * editfns.c (format2): + * fileio.c (Fexpand_file_name, auto_save_error): + * fns.c (Fyes_or_no_p): + * font.c (font_parse_xlfd, font_parse_family_registry, font_add_log): + * fontset.c (Fset_fontset_font): + * keyboard.c (echo_add_key, echo_dash, parse_menu_item) + (read_char_minibuf_menu_prompt): + * keymap.c (silly_event_symbol_error, describe_vector): + * menu.c (single_menu_item): + * minibuf.c (Fread_buffer): + * process.c (status_message, Fformat_network_address) + (server_accept_connection): Use make_local_string and + build_local_string. Prefer compound literals where appropriate. + 2014-09-15 Daniel Colascione * fns.c (Fsort): Tweak sort docstring. === modified file 'src/alloc.c' --- src/alloc.c 2014-09-11 19:44:25 +0000 +++ src/alloc.c 2014-09-15 14:53:23 +0000 @@ -69,6 +69,12 @@ static bool valgrind_p; #endif +#ifdef USE_LOCAL_ALLOCATORS +# if GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS +# error "Stack-allocated Lisp objects are not compatible with GCPROs" +# endif +#endif + /* GC_CHECK_MARKED_OBJECTS means do sanity checks on allocated objects. Doable only if GC_MARK_STACK. */ #if ! GC_MARK_STACK === modified file 'src/charset.c' --- src/charset.c 2014-09-11 13:21:19 +0000 +++ src/charset.c 2014-09-15 14:53:23 +0000 @@ -1569,7 +1569,7 @@ from_byte = CHAR_TO_BYTE (from); - charsets = Fmake_vector (make_number (charset_table_used), Qnil); + charsets = make_local_vector (charset_table_used, Qnil); while (1) { find_charsets_in_text (BYTE_POS_ADDR (from_byte), stop - from, @@ -1606,7 +1606,7 @@ CHECK_STRING (str); - charsets = Fmake_vector (make_number (charset_table_used), Qnil); + charsets = make_local_vector (charset_table_used, Qnil); find_charsets_in_text (SDATA (str), SCHARS (str), SBYTES (str), charsets, table, STRING_MULTIBYTE (str)); === modified file 'src/chartab.c' --- src/chartab.c 2014-07-08 07:17:04 +0000 +++ src/chartab.c 2014-09-15 14:53:23 +0000 @@ -1307,7 +1307,7 @@ { struct gcpro gcpro1; GCPRO1 (val); - result = Fload (concat2 (build_string ("international/"), table), + result = Fload (concat2 (build_local_string ("international/"), table), Qt, Qt, Qt, Qt); UNGCPRO; if (NILP (result)) === modified file 'src/data.c' --- src/data.c 2014-09-13 04:41:54 +0000 +++ src/data.c 2014-09-15 14:53:23 +0000 @@ -988,8 +988,9 @@ for (obj = choice; !NILP (obj); obj = XCDR (obj)) { args[i++] = SYMBOL_NAME (XCAR (obj)); - args[i++] = build_string (NILP (XCDR (obj)) ? " should be specified" - : (NILP (XCDR (XCDR (obj))) ? " or " : ", ")); + args[i++] = build_local_string + (NILP (XCDR (obj)) ? " should be specified" + : (NILP (XCDR (XCDR (obj))) ? " or " : ", ")); } obj = Fconcat (i, args); @@ -1003,14 +1004,11 @@ static void wrong_range (Lisp_Object min, Lisp_Object max, Lisp_Object wrong) { - Lisp_Object args[4]; - - args[0] = build_string ("Value should be from "); - args[1] = Fnumber_to_string (min); - args[2] = build_string (" to "); - args[3] = Fnumber_to_string (max); - - xsignal2 (Qerror, Fconcat (4, args), wrong); + xsignal2 (Qerror, Fconcat (4, ((Lisp_Object []) + { build_local_string ("Value should be from "), + Fnumber_to_string (min), + build_local_string (" to "), + Fnumber_to_string (max) })), wrong); } /* Store NEWVAL into SYMBOL, where VALCONTENTS is found in the value cell === modified file 'src/doc.c' --- src/doc.c 2014-09-07 07:04:01 +0000 +++ src/doc.c 2014-09-15 14:53:23 +0000 @@ -146,8 +146,8 @@ if (fd < 0) { SAFE_FREE (); - return concat3 (build_string ("Cannot open doc string file \""), - file, build_string ("\"\n")); + return concat3 (build_local_string ("Cannot open doc string file \""), + file, build_local_string ("\"\n")); } } count = SPECPDL_INDEX (); === modified file 'src/editfns.c' --- src/editfns.c 2014-09-07 07:04:01 +0000 +++ src/editfns.c 2014-09-15 14:53:23 +0000 @@ -4362,11 +4362,8 @@ Lisp_Object format2 (const char *string1, Lisp_Object arg0, Lisp_Object arg1) { - Lisp_Object args[3]; - args[0] = build_string (string1); - args[1] = arg0; - args[2] = arg1; - return Fformat (3, args); + return Fformat (3, ((Lisp_Object []) + { build_local_string (string1), arg0, arg1 })); } DEFUN ("char-equal", Fchar_equal, Schar_equal, 2, 2, 0, === modified file 'src/fileio.c' --- src/fileio.c 2014-09-13 04:41:54 +0000 +++ src/fileio.c 2014-09-15 14:53:23 +0000 @@ -1162,11 +1162,11 @@ char newdir_utf8[MAX_UTF8_PATH]; filename_from_ansi (newdir, newdir_utf8); - tem = build_string (newdir_utf8); + tem = build_local_string (newdir_utf8); } else #endif - tem = build_string (newdir); + tem = build_local_string (newdir); newdirlim = newdir + SBYTES (tem); if (multibyte && !STRING_MULTIBYTE (tem)) { @@ -1198,7 +1198,7 @@ /* `getpwnam' may return a unibyte string, which will bite us since we expect the directory to be multibyte. */ - tem = build_string (newdir); + tem = build_local_string (newdir); newdirlim = newdir + SBYTES (tem); if (multibyte && !STRING_MULTIBYTE (tem)) { @@ -1231,7 +1231,7 @@ adir = NULL; else if (multibyte) { - Lisp_Object tem = build_string (adir); + Lisp_Object tem = build_local_string (adir); tem = DECODE_FILE (tem); newdirlim = adir + SBYTES (tem); @@ -1332,7 +1332,7 @@ getcwd (adir, adir_size); if (multibyte) { - Lisp_Object tem = build_string (adir); + Lisp_Object tem = build_local_string (adir); tem = DECODE_FILE (tem); newdirlim = adir + SBYTES (tem); @@ -5408,7 +5408,7 @@ static Lisp_Object auto_save_error (Lisp_Object error_val) { - Lisp_Object args[3], msg; + Lisp_Object msg; int i; struct gcpro gcpro1; @@ -5416,10 +5416,10 @@ ring_bell (XFRAME (selected_frame)); - args[0] = build_string ("Auto-saving %s: %s"); - args[1] = BVAR (current_buffer, name); - args[2] = Ferror_message_string (error_val); - msg = Fformat (3, args); + msg = Fformat (3, ((Lisp_Object []) + { build_local_string ("Auto-saving %s: %s"), + BVAR (current_buffer, name), + Ferror_message_string (error_val) })); GCPRO1 (msg); for (i = 0; i < 3; ++i) === modified file 'src/fns.c' --- src/fns.c 2014-09-15 05:09:44 +0000 +++ src/fns.c 2014-09-15 14:53:23 +0000 @@ -2706,7 +2706,6 @@ (Lisp_Object prompt) { register Lisp_Object ans; - Lisp_Object args[2]; struct gcpro gcpro1; CHECK_STRING (prompt); @@ -2725,10 +2724,8 @@ return obj; } - args[0] = prompt; - args[1] = build_string ("(yes or no) "); - prompt = Fconcat (2, args); - + prompt = Fconcat (2, ((Lisp_Object []) + { prompt, build_local_string ("(yes or no) ") })); GCPRO1 (prompt); while (1) === modified file 'src/font.c' --- src/font.c 2014-09-13 04:41:54 +0000 +++ src/font.c 2014-09-15 14:53:23 +0000 @@ -1190,12 +1190,12 @@ { val = prop[XLFD_ENCODING_INDEX]; if (! NILP (val)) - val = concat2 (build_string ("*-"), SYMBOL_NAME (val)); + val = concat2 (build_local_string ("*-"), SYMBOL_NAME (val)); } else if (NILP (prop[XLFD_ENCODING_INDEX])) - val = concat2 (SYMBOL_NAME (val), build_string ("-*")); + val = concat2 (SYMBOL_NAME (val), build_local_string ("-*")); else - val = concat3 (SYMBOL_NAME (val), build_string ("-"), + val = concat3 (SYMBOL_NAME (val), build_local_string ("-"), SYMBOL_NAME (prop[XLFD_ENCODING_INDEX])); if (! NILP (val)) ASET (font, FONT_REGISTRY_INDEX, Fintern (val, Qnil)); @@ -1793,9 +1793,9 @@ if (! p1) { if (SDATA (registry)[len - 1] == '*') - registry = concat2 (registry, build_string ("-*")); + registry = concat2 (registry, build_local_string ("-*")); else - registry = concat2 (registry, build_string ("*-*")); + registry = concat2 (registry, build_local_string ("*-*")); } registry = Fdowncase (registry); ASET (font_spec, FONT_REGISTRY_INDEX, Fintern (registry, Qnil)); @@ -5022,7 +5022,7 @@ if (FONTP (arg)) { Lisp_Object tail, elt; - Lisp_Object equalstr = build_string ("="); + Lisp_Object equalstr = build_local_string ("="); val = Ffont_xlfd_name (arg, Qt); for (tail = AREF (arg, FONT_EXTRA_INDEX); CONSP (tail); @@ -5056,7 +5056,7 @@ val = Ffont_xlfd_name (result, Qt); if (! FONT_SPEC_P (result)) val = concat3 (SYMBOL_NAME (AREF (result, FONT_TYPE_INDEX)), - build_string (":"), val); + build_local_string (":"), val); result = val; } else if (CONSP (result)) === modified file 'src/fontset.c' --- src/fontset.c 2014-09-07 07:04:01 +0000 +++ src/fontset.c 2014-09-15 14:53:23 +0000 @@ -1462,7 +1462,7 @@ registry = AREF (font_spec, FONT_REGISTRY_INDEX); if (! NILP (registry)) registry = Fdowncase (SYMBOL_NAME (registry)); - encoding = find_font_encoding (concat3 (family, build_string ("-"), + encoding = find_font_encoding (concat3 (family, build_local_string ("-"), registry)); if (NILP (encoding)) encoding = Qascii; === modified file 'src/keyboard.c' --- src/keyboard.c 2014-09-07 22:27:59 +0000 +++ src/keyboard.c 2014-09-15 14:53:23 +0000 @@ -566,14 +566,14 @@ if (XINT (last_char) == '-' && XINT (prev_char) != ' ') Faset (echo_string, idx, make_number (' ')); else - echo_string = concat2 (echo_string, build_string (" ")); + echo_string = concat2 (echo_string, build_local_string (" ")); } else if (STRINGP (echo_string) && SCHARS (echo_string) > 0) - echo_string = concat2 (echo_string, build_string (" ")); + echo_string = concat2 (echo_string, build_local_string (" ")); kset_echo_string (current_kboard, - concat2 (echo_string, make_string (buffer, ptr - buffer))); + concat2 (echo_string, make_local_string (buffer, ptr - buffer))); SAFE_FREE (); } @@ -632,7 +632,7 @@ but make it go away when the next character is added. */ kset_echo_string (current_kboard, - concat2 (KVAR (current_kboard, echo_string), build_string ("-"))); + concat2 (KVAR (current_kboard, echo_string), build_local_string ("-"))); echo_now (); } @@ -7883,7 +7883,8 @@ /* The previous code preferred :key-sequence to :keys, so we preserve this behavior. */ if (STRINGP (keyeq) && !CONSP (keyhint)) - keyeq = concat2 (build_string (" "), Fsubstitute_command_keys (keyeq)); + keyeq = concat2 (build_local_string (" "), + Fsubstitute_command_keys (keyeq)); else { Lisp_Object prefix = keyeq; @@ -7926,8 +7927,7 @@ if (STRINGP (XCDR (prefix))) tem = concat2 (tem, XCDR (prefix)); } - keyeq = concat2 (build_string (" "), tem); - /* keyeq = concat3(build_string(" ("),tem,build_string(")")); */ + keyeq = concat2 (build_local_string (" "), tem); } else keyeq = Qnil; @@ -8632,9 +8632,9 @@ Lisp_Object selected = AREF (item_properties, ITEM_PROPERTY_SELECTED); if (EQ (tem, QCradio)) - tem = build_string (NILP (selected) ? "(*) " : "( ) "); + tem = build_local_string (NILP (selected) ? "(*) " : "( ) "); else - tem = build_string (NILP (selected) ? "[X] " : "[ ] "); + tem = build_local_string (NILP (selected) ? "[X] " : "[ ] "); s = concat2 (tem, s); } === modified file 'src/keymap.c' --- src/keymap.c 2014-09-07 07:04:01 +0000 +++ src/keymap.c 2014-09-15 14:53:23 +0000 @@ -1342,7 +1342,7 @@ *p = 0; c = reorder_modifiers (c); - keystring = concat2 (build_string (new_mods), XCDR (assoc)); + keystring = concat2 (build_local_string (new_mods), XCDR (assoc)); error ("To bind the key %s, use [?%s], not [%s]", SDATA (SYMBOL_NAME (c)), SDATA (keystring), @@ -2245,7 +2245,7 @@ if (CONSP (key) && INTEGERP (XCAR (key)) && INTEGERP (XCDR (key))) /* An interval from a map-char-table. */ return concat3 (Fsingle_key_description (XCAR (key), no_angles), - build_string (".."), + build_local_string (".."), Fsingle_key_description (XCDR (key), no_angles)); key = EVENT_HEAD (key); @@ -3444,7 +3444,7 @@ { Lisp_Object tem; tem = Fkey_description (prefix, Qnil); - elt_prefix = concat2 (tem, build_string (" ")); + elt_prefix = concat2 (tem, build_local_string (" ")); } prefix = Qnil; } === modified file 'src/lisp.h' --- src/lisp.h 2014-09-11 09:14:45 +0000 +++ src/lisp.h 2014-09-15 14:53:23 +0000 @@ -4605,6 +4605,20 @@ # define USE_LOCAL_ALLOCATORS +/* Return a function-scoped cons whose car is X and cdr is Y. */ + +# define local_cons(x, y) \ + ({ \ + struct Lisp_Cons *c = alloca (sizeof (struct Lisp_Cons)); \ + c->car = (x); \ + c->u.cdr = (y); \ + make_lisp_ptr (c, Lisp_Cons); \ + }) + +# define local_list1(x) local_cons (x, Qnil) +# define local_list2(x, y) local_cons (x, local_list1 (y)) +# define local_list3(x, y, z) local_cons (x, local_list2 (y, z)) + /* Return a function-scoped vector of length SIZE, with each element being INIT. */ @@ -4643,12 +4657,17 @@ /* Return a function-scoped string with contents DATA. */ -# define build_local_string(data) \ - ({ char const *data_ = data; make_local_string (data_, strlen (data_)); }) +# define build_local_string(data) \ + ({ char const *data1_ = (data); \ + make_local_string (data1_, strlen (data1_)); }) #else /* Safer but slower implementations. */ +# define local_cons(car, cdr) Fcons (car, cdr) +# define local_list1(x) list1 (x) +# define local_list2(x, y) list2 (x, y) +# define local_list3(x, y, z) list3 (x, y, z) # define make_local_vector(size, init) Fmake_vector (make_number (size), init) # define make_local_string(data, nbytes) make_string (data, nbytes) # define build_local_string(data) build_string (data) === modified file 'src/lread.c' --- src/lread.c 2014-09-11 13:02:09 +0000 +++ src/lread.c 2014-09-15 14:53:23 +0000 @@ -2894,7 +2894,7 @@ Lisp_Object placeholder; Lisp_Object cell; - placeholder = Fcons (Qnil, Qnil); + placeholder = scoped_cons (Qnil, Qnil); cell = Fcons (make_number (n), placeholder); read_objects = Fcons (cell, read_objects); @@ -3374,7 +3374,7 @@ substitute_in_interval contains part of the logic. */ INTERVAL root_interval = string_intervals (subtree); - Lisp_Object arg = Fcons (object, placeholder); + Lisp_Object arg = scoped_cons (object, placeholder); traverse_intervals_noorder (root_interval, &substitute_in_interval, arg); @@ -3681,8 +3681,8 @@ in the installed Lisp directory. We don't use Fexpand_file_name because that would make the directory absolute now. */ - elt = concat2 (build_string ("../lisp/"), - Ffile_name_nondirectory (elt)); + elt = concat2 (build_local_string ("../lisp/"), + Ffile_name_nondirectory (elt)); } else if (EQ (elt, Vload_file_name) && ! NILP (elt) === modified file 'src/menu.c' --- src/menu.c 2014-09-07 07:04:01 +0000 +++ src/menu.c 2014-09-15 14:53:23 +0000 @@ -390,7 +390,7 @@ if (!submenu && SREF (tem, 0) != '\0' && SREF (tem, 0) != '-') ASET (menu_items, idx + MENU_ITEMS_ITEM_NAME, - concat2 (build_string (" "), tem)); + concat2 (build_local_string (" "), tem)); idx += MENU_ITEMS_ITEM_LENGTH; } } @@ -399,14 +399,14 @@ /* Calculate prefix, if any, for this item. */ if (EQ (type, QCtoggle)) - prefix = build_string (NILP (selected) ? "[ ] " : "[X] "); + prefix = build_local_string (NILP (selected) ? "[ ] " : "[X] "); else if (EQ (type, QCradio)) - prefix = build_string (NILP (selected) ? "( ) " : "(*) "); + prefix = build_local_string (NILP (selected) ? "( ) " : "(*) "); } /* Not a button. If we have earlier buttons, then we need a prefix. */ else if (!skp->notbuttons && SREF (item_string, 0) != '\0' && SREF (item_string, 0) != '-') - prefix = build_string (" "); + prefix = build_local_string (" "); if (!NILP (prefix)) item_string = concat2 (prefix, item_string); @@ -416,7 +416,7 @@ || FRAME_MSDOS_P (XFRAME (Vmenu_updating_frame))) && !NILP (map)) /* Indicate visually that this is a submenu. */ - item_string = concat2 (item_string, build_string (" >")); + item_string = concat2 (item_string, build_local_string (" >")); push_menu_item (item_string, enabled, key, AREF (item_properties, ITEM_PROPERTY_DEF), === modified file 'src/minibuf.c' --- src/minibuf.c 2014-07-27 13:21:30 +0000 +++ src/minibuf.c 2014-09-15 14:53:23 +0000 @@ -1123,7 +1123,7 @@ function, instead of the usual behavior. */) (Lisp_Object prompt, Lisp_Object def, Lisp_Object require_match) { - Lisp_Object args[4], result; + Lisp_Object result; char *s; ptrdiff_t len; ptrdiff_t count = SPECPDL_INDEX (); @@ -1157,10 +1157,9 @@ STRING_MULTIBYTE (prompt)); } - args[0] = build_string ("%s (default %s): "); - args[1] = prompt; - args[2] = CONSP (def) ? XCAR (def) : def; - prompt = Fformat (3, args); + prompt = Fformat (3, ((Lisp_Object []) + { build_local_string ("%s (default %s): "), + prompt, CONSP (def) ? XCAR (def) : def })); } result = Fcompleting_read (prompt, intern ("internal-complete-buffer"), @@ -1168,13 +1167,8 @@ Qbuffer_name_history, def, Qnil); } else - { - args[0] = Vread_buffer_function; - args[1] = prompt; - args[2] = def; - args[3] = require_match; - result = Ffuncall (4, args); - } + result = Ffuncall (4, ((Lisp_Object []) + { Vread_buffer_function, prompt, def, require_match })); return unbind_to (count, result); } === modified file 'src/process.c' --- src/process.c 2014-09-07 07:04:01 +0000 +++ src/process.c 2014-09-15 14:53:23 +0000 @@ -620,7 +620,7 @@ if (c1 != c2) Faset (string, make_number (0), make_number (c2)); } - string2 = build_string (coredump ? " (core dumped)\n" : "\n"); + string2 = build_local_string (coredump ? " (core dumped)\n" : "\n"); return concat2 (string, string2); } else if (EQ (symbol, Qexit)) @@ -630,14 +630,14 @@ if (code == 0) return build_string ("finished\n"); string = Fnumber_to_string (make_number (code)); - string2 = build_string (coredump ? " (core dumped)\n" : "\n"); - return concat3 (build_string ("exited abnormally with code "), + string2 = build_local_string (coredump ? " (core dumped)\n" : "\n"); + return concat3 (build_local_string ("exited abnormally with code "), string, string2); } else if (EQ (symbol, Qfailed)) { string = Fnumber_to_string (make_number (code)); - string2 = build_string ("\n"); + string2 = build_local_string ("\n"); return concat3 (build_string ("failed with code "), string, string2); } @@ -1305,22 +1305,22 @@ if (size == 4 || (size == 5 && !NILP (omit_port))) { - args[0] = build_string ("%d.%d.%d.%d"); + args[0] = build_local_string ("%d.%d.%d.%d"); nargs = 4; } else if (size == 5) { - args[0] = build_string ("%d.%d.%d.%d:%d"); + args[0] = build_local_string ("%d.%d.%d.%d:%d"); nargs = 5; } else if (size == 8 || (size == 9 && !NILP (omit_port))) { - args[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x"); + args[0] = build_local_string ("%x:%x:%x:%x:%x:%x:%x:%x"); nargs = 8; } else if (size == 9) { - args[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d"); + args[0] = build_local_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d"); nargs = 9; } else @@ -1339,16 +1339,12 @@ args[i+1] = p->contents[i]; } - return Fformat (nargs+1, args); + return Fformat (nargs + 1, args); } if (CONSP (address)) - { - Lisp_Object args[2]; - args[0] = build_string (""); - args[1] = Fcar (address); - return Fformat (2, args); - } + return Fformat (2, ((Lisp_Object []) + { build_local_string (""), Fcar (address) })); return Qnil; } @@ -4061,20 +4057,14 @@ { case AF_INET: { - Lisp_Object args[5]; unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr; - args[0] = build_string ("%d.%d.%d.%d"); - args[1] = make_number (*ip++); - args[2] = make_number (*ip++); - args[3] = make_number (*ip++); - args[4] = make_number (*ip++); - host = Fformat (5, args); + + host = Fformat (5, ((Lisp_Object []) + { build_local_string ("%d.%d.%d.%d"), make_number (*ip++), + make_number (*ip++), make_number (*ip++), make_number (*ip++) })); service = make_number (ntohs (saddr.in.sin_port)); - - args[0] = build_string (" <%s:%d>"); - args[1] = host; - args[2] = service; - caller = Fformat (3, args); + caller = Fformat (3, ((Lisp_Object []) + { build_local_string (" <%s:%d>"), host, service })); } break; @@ -4084,16 +4074,14 @@ Lisp_Object args[9]; uint16_t *ip6 = (uint16_t *)&saddr.in6.sin6_addr; int i; - args[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x"); + + args[0] = build_local_string ("%x:%x:%x:%x:%x:%x:%x:%x"); for (i = 0; i < 8; i++) - args[i+1] = make_number (ntohs (ip6[i])); + args[i + 1] = make_number (ntohs (ip6[i])); host = Fformat (9, args); service = make_number (ntohs (saddr.in.sin_port)); - - args[0] = build_string (" <[%s]:%d>"); - args[1] = host; - args[2] = service; - caller = Fformat (3, args); + caller = Fformat (3, ((Lisp_Object []) + { build_local_string (" <[%s]:%d>"), host, service })); } break; #endif @@ -4103,7 +4091,8 @@ #endif default: caller = Fnumber_to_string (make_number (connect_counter)); - caller = concat3 (build_string (" <"), caller, build_string (">")); + caller = concat3 + (build_local_string (" <"), caller, build_local_string (">")); break; } @@ -4202,14 +4191,14 @@ if (!NILP (ps->log)) call3 (ps->log, server, proc, - concat3 (build_string ("accept from "), - (STRINGP (host) ? host : build_string ("-")), - build_string ("\n"))); + concat3 (build_local_string ("accept from "), + (STRINGP (host) ? host : build_local_string ("-")), + build_local_string ("\n"))); exec_sentinel (proc, - concat3 (build_string ("open from "), - (STRINGP (host) ? host : build_string ("-")), - build_string ("\n"))); + concat3 (build_local_string ("open from "), + (STRINGP (host) ? host : build_local_string ("-")), + build_local_string ("\n"))); } /* This variable is different from waiting_for_input in keyboard.c. === modified file 'src/textprop.c' --- src/textprop.c 2014-09-07 07:04:01 +0000 +++ src/textprop.c 2014-09-15 14:53:23 +0000 @@ -1317,9 +1317,10 @@ If the optional fifth argument OBJECT is a buffer (or nil, which means the current buffer), START and END are buffer positions (integers or markers). If OBJECT is a string, START and END are 0-based indices into it. */) - (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object) + (Lisp_Object start, Lisp_Object end, Lisp_Object property, + Lisp_Object value, Lisp_Object object) { - Fadd_text_properties (start, end, list2 (property, value), object); + Fadd_text_properties (start, end, scoped_list2 (property, value), object); return Qnil; } @@ -1360,7 +1361,7 @@ (Lisp_Object start, Lisp_Object end, Lisp_Object face, Lisp_Object append, Lisp_Object object) { - add_text_properties_1 (start, end, list2 (Qface, face), object, + add_text_properties_1 (start, end, scoped_list2 (Qface, face), object, (NILP (append) ? TEXT_PROPERTY_PREPEND : TEXT_PROPERTY_APPEND)); @@ -1909,7 +1910,8 @@ /* Note this can GC when DEST is a buffer. */ Lisp_Object -copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, Lisp_Object pos, Lisp_Object dest, Lisp_Object prop) +copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, + Lisp_Object pos, Lisp_Object dest, Lisp_Object prop) { INTERVAL i; Lisp_Object res; @@ -1962,12 +1964,11 @@ plist = Fcdr (Fcdr (plist)); } if (! NILP (plist)) - { - /* Must defer modifications to the interval tree in case src - and dest refer to the same string or buffer. */ - stuff = Fcons (list3 (make_number (p), make_number (p + len), plist), - stuff); - } + /* Must defer modifications to the interval tree in case + src and dest refer to the same string or buffer. */ + stuff = local_cons + (local_list3 (make_number (p), make_number (p + len), plist), + stuff); i = next_interval (i); if (!i) ------------------------------------------------------------ revno: 117884 committer: Daniel Colascione branch nick: trunk timestamp: Sun 2014-09-14 22:09:44 -0700 message: Tweak sort docstring * fns.c (Fsort): Tweak sort docstring. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2014-09-15 00:20:21 +0000 +++ src/ChangeLog 2014-09-15 05:09:44 +0000 @@ -1,3 +1,7 @@ +2014-09-15 Daniel Colascione + + * fns.c (Fsort): Tweak sort docstring. + 2014-09-15 Eli Zaretskii * w32.c (fcntl): Support O_NONBLOCK fcntl on the write side of pipes. === modified file 'src/fns.c' --- src/fns.c 2014-09-07 07:04:01 +0000 +++ src/fns.c 2014-09-15 05:09:44 +0000 @@ -2005,10 +2005,10 @@ DEFUN ("sort", Fsort, Ssort, 2, 2, 0, doc: /* Sort SEQ, stably, comparing elements using PREDICATE. -Returns the sorted sequence. SEQ should be a list or vector. -If SEQ is a list, it is modified by side effects. PREDICATE -is called with two elements of SEQ, and should return non-nil -if the first element should sort before the second. */) +Returns the sorted sequence. SEQ should be a list or vector. SEQ is +modified by side effects. PREDICATE is called with two elements of +SEQ, and should return non-nil if the first element should sort before +the second. */) (Lisp_Object seq, Lisp_Object predicate) { if (CONSP (seq))