Now on revision 114607. ------------------------------------------------------------ revno: 114607 committer: Dmitry Antipov branch nick: trunk timestamp: Thu 2013-10-10 10:48:42 +0400 message: * keyboard.c (init_kboard): Now static. Add arg to denote window system. Adjust comment. (init_keyboard): Adjust user. (allocate_kboard): New function. (syms_of_keyboard): * nsterm.m (ns_term_init): * term.c (init_tty): * w32term.c (w32_create_terminal): * xterm.c (x_term_init): Use it. * keyboard.h (init_kboard): Remove prototype. (allocate_kboard): Add prototype. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-10 00:37:44 +0000 +++ src/ChangeLog 2013-10-10 06:48:42 +0000 @@ -1,3 +1,17 @@ +2013-10-10 Dmitry Antipov + + * keyboard.c (init_kboard): Now static. Add arg + to denote window system. Adjust comment. + (init_keyboard): Adjust user. + (allocate_kboard): New function. + (syms_of_keyboard): + * nsterm.m (ns_term_init): + * term.c (init_tty): + * w32term.c (w32_create_terminal): + * xterm.c (x_term_init): Use it. + * keyboard.h (init_kboard): Remove prototype. + (allocate_kboard): Add prototype. + 2013-10-10 Barry Fishman (tiny change) * image.c (GIFLIB_MAJOR): Ensure it's defined. @@ -29,7 +43,7 @@ so it shouldn't be used all the time. Perhaps we need two flavors of 'eassert', one for where 'assume' is far more likely to help or to hurt; but that can be done later. - Problem reported by Dmitry Andipov in + Problem reported by Dmitry Antipov in . Also, don't include ; no longer needed. === modified file 'src/keyboard.c' --- src/keyboard.c 2013-10-08 20:04:40 +0000 +++ src/keyboard.c 2013-10-10 06:48:42 +0000 @@ -10790,12 +10790,11 @@ return tem; } - -/* - * Set up a new kboard object with reasonable initial values. - */ -void -init_kboard (KBOARD *kb) +/* Set up a new kboard object with reasonable initial values. + TYPE is a window system for which this keyboard is used. */ + +static void +init_kboard (KBOARD *kb, Lisp_Object type) { kset_overriding_terminal_local_map (kb, Qnil); kset_last_command (kb, Qnil); @@ -10816,13 +10815,27 @@ kb->reference_count = 0; kset_system_key_alist (kb, Qnil); kset_system_key_syms (kb, Qnil); - kset_window_system (kb, Qt); /* Unset. */ + kset_window_system (kb, type); kset_input_decode_map (kb, Fmake_sparse_keymap (Qnil)); kset_local_function_key_map (kb, Fmake_sparse_keymap (Qnil)); Fset_keymap_parent (KVAR (kb, Vlocal_function_key_map), Vfunction_key_map); kset_default_minibuffer_frame (kb, Qnil); } +/* Allocate and basically initialize keyboard + object to use with window system TYPE. */ + +KBOARD * +allocate_kboard (Lisp_Object type) +{ + KBOARD *kb = xmalloc (sizeof *kb); + + init_kboard (kb, type); + kb->next_kboard = all_kboards; + all_kboards = kb; + return kb; +} + /* * Destroy the contents of a kboard object, but not the object itself. * We use this just before deleting it, or if we're going to initialize @@ -10887,10 +10900,9 @@ current_kboard = initial_kboard; /* Re-initialize the keyboard again. */ wipe_kboard (current_kboard); - init_kboard (current_kboard); /* A value of nil for Vwindow_system normally means a tty, but we also use it for the initial terminal since there is no window system there. */ - kset_window_system (current_kboard, Qnil); + init_kboard (current_kboard, Qnil); if (!noninteractive) { @@ -11695,12 +11707,8 @@ variable are `sigusr1' and `sigusr2'. */); Vdebug_on_event = intern_c_string ("sigusr2"); - /* Create the initial keyboard. */ - initial_kboard = xmalloc (sizeof *initial_kboard); - init_kboard (initial_kboard); - /* Vwindow_system is left at t for now. */ - initial_kboard->next_kboard = all_kboards; - all_kboards = initial_kboard; + /* Create the initial keyboard. Qt means 'unset'. */ + initial_kboard = allocate_kboard (Qt); } void === modified file 'src/keyboard.h' --- src/keyboard.h 2013-10-08 20:04:40 +0000 +++ src/keyboard.h 2013-10-10 06:48:42 +0000 @@ -507,7 +507,7 @@ extern bool menu_separator_name_p (const char *); extern bool parse_menu_item (Lisp_Object, int); -extern void init_kboard (KBOARD *); +extern KBOARD *allocate_kboard (Lisp_Object); extern void delete_kboard (KBOARD *); extern void not_single_kboard_state (KBOARD *); extern void push_kboard (struct kboard *); === modified file 'src/nsterm.m' --- src/nsterm.m 2013-10-08 06:12:40 +0000 +++ src/nsterm.m 2013-10-10 06:48:42 +0000 @@ -4169,11 +4169,7 @@ ns_initialize_display_info (dpyinfo); terminal = ns_create_terminal (dpyinfo); - terminal->kboard = xmalloc (sizeof *terminal->kboard); - init_kboard (terminal->kboard); - kset_window_system (terminal->kboard, Qns); - terminal->kboard->next_kboard = all_kboards; - all_kboards = terminal->kboard; + terminal->kboard = allocate_kboard (Qns); /* Don't let the initial kboard remain current longer than necessary. That would cause problems if a file loaded on startup tries to prompt in the mini-buffer. */ === modified file 'src/term.c' --- src/term.c 2013-10-09 20:18:38 +0000 +++ src/term.c 2013-10-10 06:48:42 +0000 @@ -4301,11 +4301,7 @@ tty->mouse_highlight.mouse_face_window = Qnil; #endif - terminal->kboard = xmalloc (sizeof *terminal->kboard); - init_kboard (terminal->kboard); - kset_window_system (terminal->kboard, Qnil); - terminal->kboard->next_kboard = all_kboards; - all_kboards = terminal->kboard; + terminal->kboard = allocate_kboard (Qnil); terminal->kboard->reference_count++; /* Don't let the initial kboard remain current longer than necessary. That would cause problems if a file loaded on startup tries to === modified file 'src/w32term.c' --- src/w32term.c 2013-09-23 03:30:55 +0000 +++ src/w32term.c 2013-10-10 06:48:42 +0000 @@ -6262,11 +6262,7 @@ /* We don't yet support separate terminals on W32, so don't try to share keyboards between virtual terminals that are on the same physical terminal like X does. */ - terminal->kboard = xmalloc (sizeof (KBOARD)); - init_kboard (terminal->kboard); - kset_window_system (terminal->kboard, Qw32); - terminal->kboard->next_kboard = all_kboards; - all_kboards = terminal->kboard; + terminal->kboard = allocate_kboard (Qw32); /* Don't let the initial kboard remain current longer than necessary. That would cause problems if a file loaded on startup tries to prompt in the mini-buffer. */ === modified file 'src/xterm.c' --- src/xterm.c 2013-09-20 20:23:20 +0000 +++ src/xterm.c 2013-10-10 06:48:42 +0000 @@ -9905,15 +9905,7 @@ terminal->kboard = share->terminal->kboard; else { - terminal->kboard = xmalloc (sizeof *terminal->kboard); - init_kboard (terminal->kboard); - kset_window_system (terminal->kboard, Qx); - - /* Add the keyboard to the list before running Lisp code (via - Qvendor_specific_keysyms below), since these are not traced - via terminals but only through all_kboards. */ - terminal->kboard->next_kboard = all_kboards; - all_kboards = terminal->kboard; + terminal->kboard = allocate_kboard (Qx); if (!EQ (XSYMBOL (Qvendor_specific_keysyms)->function, Qunbound)) { ------------------------------------------------------------ revno: 114606 committer: Stefan Monnier branch nick: trunk timestamp: Wed 2013-10-09 22:33:35 -0400 message: * lisp/menu-bar.el (tty-menu-navigation-map): Reduce redundancy. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-10 01:18:01 +0000 +++ lisp/ChangeLog 2013-10-10 02:33:35 +0000 @@ -1,3 +1,7 @@ +2013-10-10 Stefan Monnier + + * menu-bar.el (tty-menu-navigation-map): Reduce redundancy. + 2013-10-10 Andrei Chițu (tiny change) * calendar/icalendar.el (icalendar-import-file): === modified file 'lisp/menu-bar.el' --- lisp/menu-bar.el 2013-10-10 00:32:36 +0000 +++ lisp/menu-bar.el 2013-10-10 02:33:35 +0000 @@ -2271,51 +2271,34 @@ ;; The tty-menu-* are just symbols interpreted by term.c, they are ;; not real commands. - (substitute-key-definition 'keyboard-quit 'tty-menu-exit - map (current-global-map)) - (substitute-key-definition 'keyboard-escape-quit 'tty-menu-exit - map (current-global-map)) + (dolist (bind '((keyboard-quit . tty-menu-exit) + (keyboard-escape-quit . tty-menu-exit) + ;; The following two will need to be revised if we ever + ;; support a right-to-left menu bar. + (forward-char . tty-menu-next-menu) + (backward-char . tty-menu-prev-menu) + (right-char . tty-menu-next-menu) + (left-char . tty-menu-prev-menu) + (next-line . tty-menu-next-item) + (previous-line . tty-menu-prev-item) + (newline . tty-menu-select) + (newline-and-indent . tty-menu-select))) + (substitute-key-definition (car bind) (cdr bind) + map (current-global-map))) + ;; The bindings of menu-bar items are so that clicking on the menu ;; bar when a menu is already shown pops down that menu. ;; FIXME: we should iterate over all the visible menu-bar items, ;; instead of naming them explicitly here. Also, this doesn't ;; include items added by current major mode. - (substitute-key-definition (lookup-key (current-global-map) [menu-bar file]) - 'tty-menu-exit - map (current-global-map)) - (substitute-key-definition (lookup-key (current-global-map) [menu-bar edit]) - 'tty-menu-exit - map (current-global-map)) - (substitute-key-definition (lookup-key (current-global-map) [menu-bar options]) - 'tty-menu-exit - map (current-global-map)) - (substitute-key-definition (lookup-key (current-global-map) [menu-bar buffer]) - 'tty-menu-exit - map (current-global-map)) - (substitute-key-definition (lookup-key (current-global-map) [menu-bar tools]) - 'tty-menu-exit - map (current-global-map)) - (substitute-key-definition (lookup-key (current-global-map) [menu-bar help-menu]) - 'tty-menu-exit - map (current-global-map)) - (substitute-key-definition 'forward-char 'tty-menu-next-menu - map (current-global-map)) - (substitute-key-definition 'backward-char 'tty-menu-prev-menu - map (current-global-map)) - ;; The following two will need to be revised if we ever support - ;; a right-to-left menu bar. - (substitute-key-definition 'right-char 'tty-menu-next-menu - map (current-global-map)) - (substitute-key-definition 'left-char 'tty-menu-prev-menu - map (current-global-map)) - (substitute-key-definition 'next-line 'tty-menu-next-item - map (current-global-map)) - (substitute-key-definition 'previous-line 'tty-menu-prev-item - map (current-global-map)) - (substitute-key-definition 'newline 'tty-menu-select - map (current-global-map)) - (substitute-key-definition 'newline-and-indent 'tty-menu-select - map (current-global-map)) + ;; + ;; FIXME: Why not (define-key map [menu-bat t] 'tty-menu-exit) ? --Stef + (dolist (event '(file edit options buffer tools help-menu)) + (substitute-key-definition + (lookup-key (current-global-map) (vector 'menu-bar event)) + 'tty-menu-exit + map (current-global-map))) + (define-key map [?\C-r] 'tty-menu-select) (define-key map [?\C-j] 'tty-menu-select) (define-key map [return] 'tty-menu-select) === modified file 'test/ChangeLog' --- test/ChangeLog 2013-10-07 13:27:29 +0000 +++ test/ChangeLog 2013-10-10 02:33:35 +0000 @@ -2,6 +2,10 @@ * indent/ruby.rb: Fix a spurious change, add more failing examples. +2013-10-07 Stefan Monnier + + * indent/ruby.rb: Add a few more tests; adjust some indentation. + 2013-10-06 Dmitry Gutov * automated/ruby-mode-tests.el: Add tests for `ruby-forward-sexp' ------------------------------------------------------------ revno: 114605 fixes bug: http://debbugs.gnu.org/15481 committer: Glenn Morris branch nick: trunk timestamp: Wed 2013-10-09 21:29:30 -0400 message: * lib-src/make-docfile.c (search_lisp_doc_at_eol): Use int rather than char with getc. diff: === modified file 'lib-src/ChangeLog' --- lib-src/ChangeLog 2013-09-20 15:34:36 +0000 +++ lib-src/ChangeLog 2013-10-10 01:29:30 +0000 @@ -1,3 +1,8 @@ +2013-10-10 Glenn Morris + + * make-docfile.c (search_lisp_doc_at_eol): + Use int rather than char with getc. (Bug#15481) + 2013-09-20 Paul Eggert A simpler, centralized INLINE. === modified file 'lib-src/make-docfile.c' --- lib-src/make-docfile.c 2013-07-10 23:23:57 +0000 +++ lib-src/make-docfile.c 2013-10-10 01:29:30 +0000 @@ -1075,7 +1075,7 @@ static int search_lisp_doc_at_eol (FILE *infile) { - char c = 0, c1 = 0, c2 = 0; + int c = 0, c1 = 0, c2 = 0; /* Skip until the end of line; remember two previous chars. */ while (c != '\n' && c != '\r' && c != EOF) ------------------------------------------------------------ revno: 114604 fixes bug: http://debbugs.gnu.org/15482 author: Andrei Chi u committer: Glenn Morris branch nick: trunk timestamp: Wed 2013-10-09 21:18:01 -0400 message: * icalendar.el (icalendar-import-file): Fix interactive spec (tiny change) diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-10 01:03:11 +0000 +++ lisp/ChangeLog 2013-10-10 01:18:01 +0000 @@ -1,3 +1,8 @@ +2013-10-10 Andrei Chițu (tiny change) + + * calendar/icalendar.el (icalendar-import-file): + Fix interactive spec. (Bug#15482) + 2013-10-10 Glenn Morris * desktop.el (desktop-save): Default to saving in .emacs.d, === modified file 'lisp/calendar/icalendar.el' --- lisp/calendar/icalendar.el 2013-01-01 09:11:05 +0000 +++ lisp/calendar/icalendar.el 2013-10-10 01:18:01 +0000 @@ -1822,7 +1822,7 @@ non-marking or not." (interactive "fImport iCalendar data from file: \n\ Finto diary file: -p") +P") ;; clean up the diary file (save-current-buffer ;; now load and convert from the ical file ------------------------------------------------------------ revno: 114603 fixes bug: http://debbugs.gnu.org/15319 committer: Glenn Morris branch nick: trunk timestamp: Wed 2013-10-09 21:03:11 -0400 message: * lisp/desktop.el (desktop-save): Default to saving in .emacs.d, since PWD is no longer in desktop-path by default. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-10 00:32:36 +0000 +++ lisp/ChangeLog 2013-10-10 01:03:11 +0000 @@ -1,5 +1,8 @@ 2013-10-10 Glenn Morris + * desktop.el (desktop-save): Default to saving in .emacs.d, + since PWD is no longer in desktop-path by default. (Bug#15319) + * menu-bar.el (menu-bar-options-menu): Remove text-mode auto-fill, now that text mode has a menu with the same entry. (menu-bar-text-mode-auto-fill): Remove now unused func. === modified file 'lisp/desktop.el' --- lisp/desktop.el 2013-08-16 05:15:51 +0000 +++ lisp/desktop.el 2013-10-10 01:03:11 +0000 @@ -1,7 +1,6 @@ ;;; desktop.el --- save partial status of Emacs when killed -*- lexical-binding: t -*- -;; Copyright (C) 1993-1995, 1997, 2000-2013 Free Software Foundation, -;; Inc. +;; Copyright (C) 1993-1995, 1997, 2000-2013 Free Software Foundation, Inc. ;; Author: Morten Welinder ;; Keywords: convenience @@ -922,7 +921,13 @@ Optional parameter RELEASE says whether we're done with this desktop. If AUTO-SAVE is non-nil, compare the saved contents to the one last saved, and don't save the buffer if they are the same." - (interactive "DDirectory to save desktop file in: ") + (interactive (list + ;; Or should we just use (car desktop-path)? + (let ((default (if (member "." desktop-path) + default-directory + user-emacs-directory))) + (read-directory-name "Directory to save desktop file in: " + default default t)))) (setq desktop-dirname (file-name-as-directory (expand-file-name dirname))) (save-excursion (let ((eager desktop-restore-eager) ------------------------------------------------------------ revno: 114602 fixes bug: http://debbugs.gnu.org/15531 author: Barry Fishman committer: Glenn Morris branch nick: trunk timestamp: Wed 2013-10-09 20:37:44 -0400 message: Handle giflib 5 changes (tiny change) * configure.ac: Update for giflib 5. * src/image.c (GIFLIB_MAJOR): Ensure it's defined. (DGifOpen, DGifOpenFileName): Handle giflib 5 syntax. (Bug#15531) diff: === modified file 'ChangeLog' --- ChangeLog 2013-10-08 17:49:20 +0000 +++ ChangeLog 2013-10-10 00:37:44 +0000 @@ -1,3 +1,7 @@ +2013-10-10 Barry Fishman (tiny change) + + * configure.ac: Update for giflib 5. (Bug#15531) + 2013-10-08 Eli Zaretskii * configure.ac (HAVE_MENUS): Define unconditionally. === modified file 'configure.ac' --- configure.ac 2013-09-26 07:37:16 +0000 +++ configure.ac 2013-10-10 00:37:44 +0000 @@ -3106,8 +3106,9 @@ || test "${HAVE_W32}" = "yes"; then AC_CHECK_HEADER(gif_lib.h, # EGifPutExtensionLast only exists from version libungif-4.1.0b1. -# Earlier versions can crash Emacs. - [AC_CHECK_LIB(gif, EGifPutExtensionLast, HAVE_GIF=yes, HAVE_GIF=maybe)]) +# Earlier versions can crash Emacs, but version 5.0 removes EGifPutExtensionLast. + [AC_CHECK_LIB(gif, GifMakeMapObject, HAVE_GIF=yes, + [AC_CHECK_LIB(gif, EGifPutExtensionLast, HAVE_GIF=yes, HAVE_GIF=maybe)])]) if test "$HAVE_GIF" = yes; then LIBGIF=-lgif === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-09 22:39:57 +0000 +++ src/ChangeLog 2013-10-10 00:37:44 +0000 @@ -1,3 +1,8 @@ +2013-10-10 Barry Fishman (tiny change) + + * image.c (GIFLIB_MAJOR): Ensure it's defined. + (DGifOpen, DGifOpenFileName): Handle giflib 5 syntax. (Bug#15531) + 2013-10-09 Paul Eggert * fns.c (sxhash_bool_vector): Fix buffer read overrun. === modified file 'src/image.c' --- src/image.c 2013-09-22 09:31:55 +0000 +++ src/image.c 2013-10-10 00:37:44 +0000 @@ -7219,14 +7219,22 @@ #endif /* HAVE_NTGUI */ +#ifndef GIFLIB_MAJOR +#define GIFLIB_MAJOR 0 +#endif #ifdef WINDOWSNT /* GIF library details. */ DEF_IMGLIB_FN (int, DGifCloseFile, (GifFileType *)); DEF_IMGLIB_FN (int, DGifSlurp, (GifFileType *)); +#if GIFLIB_MAJOR < 5 DEF_IMGLIB_FN (GifFileType *, DGifOpen, (void *, InputFunc)); DEF_IMGLIB_FN (GifFileType *, DGifOpenFileName, (const char *)); +#else +DEF_IMGLIB_FN (GifFileType *, DGifOpen, (void *, InputFunc, int *)); +DEF_IMGLIB_FN (GifFileType *, DGifOpenFileName, (const char *, int *)); +#endif static bool init_gif_functions (void) @@ -7316,7 +7324,11 @@ } /* Open the GIF file. */ +#if GIFLIB_MAJOR < 5 gif = fn_DGifOpenFileName (SSDATA (file)); +#else + gif = fn_DGifOpenFileName (SSDATA (file), NULL); +#endif if (gif == NULL) { image_error ("Cannot open `%s'", file, Qnil); @@ -7337,7 +7349,11 @@ memsrc.len = SBYTES (specified_data); memsrc.index = 0; +#if GIFLIB_MAJOR < 5 gif = fn_DGifOpen (&memsrc, gif_read_from_memory); +#else + gif = fn_DGifOpen (&memsrc, gif_read_from_memory, NULL); +#endif if (!gif) { image_error ("Cannot open memory source `%s'", img->spec, Qnil); ------------------------------------------------------------ revno: 114601 committer: Glenn Morris branch nick: trunk timestamp: Wed 2013-10-09 20:32:36 -0400 message: * lisp/menu-bar.el (menu-bar-options-menu): Remove text-mode auto-fill, now that text mode has a menu with the same entry. (menu-bar-text-mode-auto-fill): Remove now unused func. * lisp/textmodes/text-mode.el (text-mode-map): Use auto-fill help text from menu-bar.el. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-10 00:24:12 +0000 +++ lisp/ChangeLog 2013-10-10 00:32:36 +0000 @@ -1,3 +1,11 @@ +2013-10-10 Glenn Morris + + * menu-bar.el (menu-bar-options-menu): Remove text-mode auto-fill, + now that text mode has a menu with the same entry. + (menu-bar-text-mode-auto-fill): Remove now unused func. + * textmodes/text-mode.el (text-mode-map): + Use auto-fill help text from menu-bar.el. + 2013-10-10 John Anthony (tiny change) * textmodes/text-mode.el (text-mode-map): Add a menu. (Bug#15562) === modified file 'lisp/menu-bar.el' --- lisp/menu-bar.el 2013-10-08 15:11:29 +0000 +++ lisp/menu-bar.el 2013-10-10 00:32:36 +0000 @@ -1102,15 +1102,6 @@ 'tool-bar-lines)))))) menu)) -(defun menu-bar-text-mode-auto-fill () - (interactive) - (toggle-text-mode-auto-fill) - ;; This is somewhat questionable, as `text-mode-hook' - ;; might have changed outside customize. - ;; -- Per Abrahamsen 2002-02-11. - (customize-mark-as-set 'text-mode-hook)) - - (defvar menu-bar-line-wrapping-menu (let ((menu (make-sparse-keymap "Line Wrapping"))) @@ -1275,15 +1266,6 @@ "Case-Insensitive Search %s" "Ignore letter-case in search commands")) - (bindings--define-key menu [auto-fill-mode] - '(menu-item - "Auto Fill in Text Modes" - menu-bar-text-mode-auto-fill - :help "Automatically fill text while typing (Auto Fill mode)" - :button (:toggle . (if (listp text-mode-hook) - (member 'turn-on-auto-fill text-mode-hook) - (eq 'turn-on-auto-fill text-mode-hook))))) - (bindings--define-key menu [line-wrapping] `(menu-item "Line Wrapping in This Buffer" ,menu-bar-line-wrapping-menu)) === modified file 'lisp/textmodes/text-mode.el' --- lisp/textmodes/text-mode.el 2013-10-10 00:24:12 +0000 +++ lisp/textmodes/text-mode.el 2013-10-10 00:32:36 +0000 @@ -1,7 +1,6 @@ ;;; text-mode.el --- text mode, and its idiosyncratic commands -;; Copyright (C) 1985, 1992, 1994, 2001-2013 Free Software Foundation, -;; Inc. +;; Copyright (C) 1985, 1992, 1994, 2001-2013 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: wp @@ -56,7 +55,7 @@ (bindings--define-key map [menu-bar text toggle-text-mode-auto-fill] '(menu-item "Auto Fill" toggle-text-mode-auto-fill :button (:toggle . (memq 'turn-on-auto-fill text-mode-hook)) - :help "Toggle auto fill within text modes")) + :help "Automatically fill text while typing in text modes (Auto Fill mode)")) (bindings--define-key map [menu-bar text paragraph-indent-minor-mode] '(menu-item "Paragraph Indent" paragraph-indent-minor-mode :button (:toggle . (bound-and-true-p paragraph-indent-minor-mode)) ------------------------------------------------------------ revno: 114600 fixes bug: http://debbugs.gnu.org/15562 author: John Anthony committer: Glenn Morris branch nick: trunk timestamp: Wed 2013-10-09 20:24:12 -0400 message: * lisp/textmodes/text-mode.el (text-mode-map): Add a menu (tiny change) diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-09 23:52:46 +0000 +++ lisp/ChangeLog 2013-10-10 00:24:12 +0000 @@ -1,3 +1,7 @@ +2013-10-10 John Anthony (tiny change) + + * textmodes/text-mode.el (text-mode-map): Add a menu. (Bug#15562) + 2013-10-09 Juri Linkov * isearch.el (isearch-pre-command-hook): Use this-single-command-keys === modified file 'lisp/textmodes/text-mode.el' --- lisp/textmodes/text-mode.el 2013-01-01 09:11:05 +0000 +++ lisp/textmodes/text-mode.el 2013-10-10 00:24:12 +0000 @@ -51,6 +51,27 @@ (defvar text-mode-map (let ((map (make-sparse-keymap))) (define-key map "\e\t" 'ispell-complete-word) + (define-key map [menu-bar text] + (cons "Text" (make-sparse-keymap "Text"))) + (bindings--define-key map [menu-bar text toggle-text-mode-auto-fill] + '(menu-item "Auto Fill" toggle-text-mode-auto-fill + :button (:toggle . (memq 'turn-on-auto-fill text-mode-hook)) + :help "Toggle auto fill within text modes")) + (bindings--define-key map [menu-bar text paragraph-indent-minor-mode] + '(menu-item "Paragraph Indent" paragraph-indent-minor-mode + :button (:toggle . (bound-and-true-p paragraph-indent-minor-mode)) + :help "Toggle paragraph indent minor mode")) + (bindings--define-key map [menu-bar text sep] menu-bar-separator) + (bindings--define-key map [menu-bar text center-region] + '(menu-item "Center Region" center-region + :help "Center the marked region" + :enable (region-active-p))) + (bindings--define-key map [menu-bar text center-paragraph] + '(menu-item "Center Paragraph" center-paragraph + :help "Center the current paragraph")) + (bindings--define-key map [menu-bar text center-line] + '(menu-item "Center Line" center-line + :help "Center the current line")) map) "Keymap for `text-mode'. Many other modes, such as `mail-mode', `outline-mode' and `indented-text-mode', ------------------------------------------------------------ revno: 114599 fixes bug: http://debbugs.gnu.org/15568 committer: Juri Linkov branch nick: trunk timestamp: Thu 2013-10-10 02:52:46 +0300 message: * lisp/isearch.el (isearch-pre-command-hook): Use this-single-command-keys instead of this-command-keys. Add universal-argument-more and universal-argument-minus to the list of prefix commands. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-09 18:49:32 +0000 +++ lisp/ChangeLog 2013-10-09 23:52:46 +0000 @@ -1,3 +1,9 @@ +2013-10-09 Juri Linkov + + * isearch.el (isearch-pre-command-hook): Use this-single-command-keys + instead of this-command-keys. Add universal-argument-more and + universal-argument-minus to the list of prefix commands. (Bug#15568) + 2013-10-09 Glenn Morris * vc/vc-svn.el (vc-svn-create-repo): === modified file 'lisp/isearch.el' --- lisp/isearch.el 2013-10-08 23:20:12 +0000 +++ lisp/isearch.el 2013-10-09 23:52:46 +0000 @@ -2230,11 +2230,10 @@ or it is a scrolling command (when `isearch-allow-scroll' is non-nil). Otherwise, exit Isearch (when `search-exit-option' is non-nil) before the command is executed globally with terminated Isearch." - (let* ((key (this-command-keys)) + (let* ((key (this-single-command-keys)) (main-event (aref key 0))) (cond ;; Don't exit Isearch for isearch key bindings. - ;; FIXME: remove prefix arg to lookup key without prefix. ((commandp (lookup-key isearch-mode-map key nil))) ;; Optionally edit the search string instead of exiting. ((eq search-exit-option 'edit) @@ -2242,8 +2241,9 @@ ;; Handle a scrolling function or prefix argument. ((or (and isearch-allow-prefix (memq this-command '(universal-argument - negative-argument - digit-argument))) + universal-argument-more + universal-argument-minus + digit-argument negative-argument))) (and isearch-allow-scroll (or (eq (get this-command 'isearch-scroll) t) (eq (get this-command 'scroll-command) t)))) ------------------------------------------------------------ revno: 114598 committer: Paul Eggert branch nick: trunk timestamp: Wed 2013-10-09 15:39:57 -0700 message: * fns.c (sxhash_bool_vector): Fix buffer read overrun. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-09 20:18:38 +0000 +++ src/ChangeLog 2013-10-09 22:39:57 +0000 @@ -1,3 +1,7 @@ +2013-10-09 Paul Eggert + + * fns.c (sxhash_bool_vector): Fix buffer read overrun. + 2013-10-09 Eli Zaretskii * term.c (tty_menu_activate): Flush the output stream after === modified file 'src/fns.c' --- src/fns.c 2013-10-09 03:32:35 +0000 +++ src/fns.c 2013-10-09 22:39:57 +0000 @@ -4191,7 +4191,9 @@ EMACS_UINT hash = XBOOL_VECTOR (vec)->size; int i, n; - n = min (SXHASH_MAX_LEN, XBOOL_VECTOR (vec)->header.size); + n = min (SXHASH_MAX_LEN, + ((XBOOL_VECTOR (vec)->size + BOOL_VECTOR_BITS_PER_CHAR - 1) + / BOOL_VECTOR_BITS_PER_CHAR)); for (i = 0; i < n; ++i) hash = sxhash_combine (hash, XBOOL_VECTOR (vec)->data[i]); ------------------------------------------------------------ revno: 114597 committer: Eli Zaretskii branch nick: trunk timestamp: Wed 2013-10-09 23:18:38 +0300 message: Fix minor problems in text-mode menu display. src/term.c (tty_menu_activate): Flush the output stream after showing the cursor, and don't mark the frame garbaged at exit from the function. Fixes redisplay glitches when moving from one menu to another. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-09 18:50:14 +0000 +++ src/ChangeLog 2013-10-09 20:18:38 +0000 @@ -1,3 +1,10 @@ +2013-10-09 Eli Zaretskii + + * term.c (tty_menu_activate): Flush the output stream after + showing the cursor, and don't mark the frame garbaged at exit from + the function. Fixes redisplay glitches when moving from one menu + to another. + 2013-10-09 Jan Djärv * nsfns.m (Fns_convert_utf8_nfd_to_nfc): Check input for valid UTF-8 === modified file 'src/term.c' --- src/term.c 2013-10-08 20:04:40 +0000 +++ src/term.c 2013-10-09 20:18:38 +0000 @@ -3428,6 +3428,7 @@ while (statecount--) free_saved_screen (state[statecount].screen_behind); tty_show_cursor (tty); /* turn cursor back on */ + fflush (tty->output); /* Clean up any mouse events that are waiting inside Emacs event queue. These events are likely to be generated before the menu was even @@ -3437,7 +3438,6 @@ discard_mouse_events (); if (!kbd_buffer_events_waiting ()) clear_input_pending (); - SET_FRAME_GARBAGED (sf); return result; } ------------------------------------------------------------ revno: 114596 fixes bug: http://debbugs.gnu.org/15570 committer: Jan D. branch nick: trunk timestamp: Wed 2013-10-09 20:50:14 +0200 message: * nsfns.m (Fns_convert_utf8_nfd_to_nfc): Check input for valid UTF-8 or throw error. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-09 17:56:58 +0000 +++ src/ChangeLog 2013-10-09 18:50:14 +0000 @@ -1,3 +1,8 @@ +2013-10-09 Jan Djärv + + * nsfns.m (Fns_convert_utf8_nfd_to_nfc): Check input for valid UTF-8 + or throw error (Bug#15570). + 2013-10-09 Paul Eggert * intervals.c (temp_set_point_both): Move test into 'eassert', === modified file 'src/nsfns.m' --- src/nsfns.m 2013-09-18 09:23:10 +0000 +++ src/nsfns.m 2013-10-09 18:50:14 +0000 @@ -2048,16 +2048,27 @@ /* TODO: If GNUstep ever implements precomposedStringWithCanonicalMapping, remove this. */ NSString *utfStr; - Lisp_Object ret; + Lisp_Object ret = Qnil; + NSAutoreleasePool *pool; CHECK_STRING (str); - NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init]; - utfStr = [NSString stringWithUTF8String: SSDATA (str)]; + pool = [[NSAutoreleasePool alloc] init]; + utfStr = [NSString stringWithUTF8String: SSDATA (str)]; #ifdef NS_IMPL_COCOA - utfStr = [utfStr precomposedStringWithCanonicalMapping]; + if (utfStr) + utfStr = [utfStr precomposedStringWithCanonicalMapping]; #endif - ret = build_string ([utfStr UTF8String]); + if (utfStr) + { + const char *cstr = [utfStr UTF8String]; + if (cstr) + ret = build_string (cstr); + } + [pool release]; + if (NILP (ret)) + error ("Invalid UTF-8"); + return ret; } ------------------------------------------------------------ revno: 114595 fixes bug: http://debbugs.gnu.org/15446 committer: Glenn Morris branch nick: trunk timestamp: Wed 2013-10-09 14:49:32 -0400 message: * lisp/vc/vc-svn.el (vc-svn-create-repo): Expand paths in file://... url. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-09 17:10:08 +0000 +++ lisp/ChangeLog 2013-10-09 18:49:32 +0000 @@ -1,5 +1,8 @@ 2013-10-09 Glenn Morris + * vc/vc-svn.el (vc-svn-create-repo): + Expand paths in file://... url. (Bug#15446) + * emacs-lisp/authors.el (authors-aliases, authors-fixed-case): Add some entries. (authors): Remove unused local variables. === modified file 'lisp/vc/vc-svn.el' --- lisp/vc/vc-svn.el 2013-10-04 23:47:00 +0000 +++ lisp/vc/vc-svn.el 2013-10-09 18:49:32 +0000 @@ -293,8 +293,10 @@ (defun vc-svn-create-repo () "Create a new SVN repository." (vc-do-command "*vc*" 0 "svnadmin" '("create" "SVN")) + ;; Expand default-directory because svn gets confused by eg + ;; file://~/path/to/file. (Bug#15446). (vc-svn-command "*vc*" 0 "." "checkout" - (concat "file://" default-directory "SVN"))) + (concat "file://" (expand-file-name default-directory) "SVN"))) (autoload 'vc-switches "vc") ------------------------------------------------------------ revno: 114594 author: Paul Eggert committer: Paul Eggert branch nick: trunk timestamp: Wed 2013-10-09 10:56:58 -0700 message: * intervals.c (temp_set_point_both): Move test into 'eassert', for speed. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-09 17:52:38 +0000 +++ src/ChangeLog 2013-10-09 17:56:58 +0000 @@ -1,5 +1,8 @@ 2013-10-09 Paul Eggert + * intervals.c (temp_set_point_both): Move test into 'eassert', + for speed. + * lisp.h (eassert): Don't use 'assume'. Sometimes 'assume' wins in performance, and sometimes it loses, so it shouldn't be used all the time. Perhaps we need two === modified file 'src/intervals.c' --- src/intervals.c 2013-09-22 09:31:55 +0000 +++ src/intervals.c 2013-10-09 17:56:58 +0000 @@ -1792,8 +1792,7 @@ ptrdiff_t charpos, ptrdiff_t bytepos) { /* In a single-byte buffer, the two positions must be equal. */ - if (BUF_ZV (buffer) == BUF_ZV_BYTE (buffer)) - eassert (charpos == bytepos); + eassert (BUF_ZV (buffer) != BUF_ZV_BYTE (buffer) || charpos == bytepos); eassert (charpos <= bytepos); eassert (charpos <= BUF_ZV (buffer) || BUF_BEGV (buffer) <= charpos); ------------------------------------------------------------ revno: 114593 committer: Paul Eggert branch nick: trunk timestamp: Wed 2013-10-09 10:52:38 -0700 message: * lisp.h (eassert): Don't use 'assume'. Sometimes 'assume' wins in performance, and sometimes it loses, so it shouldn't be used all the time. Perhaps we need two flavors of 'eassert', one for where 'assume' is far more likely to help or to hurt; but that can be done later. Problem reported by Dmitry Andipov in . Also, don't include ; no longer needed. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-09 17:17:20 +0000 +++ src/ChangeLog 2013-10-09 17:52:38 +0000 @@ -1,3 +1,14 @@ +2013-10-09 Paul Eggert + + * lisp.h (eassert): Don't use 'assume'. + Sometimes 'assume' wins in performance, and sometimes it loses, + so it shouldn't be used all the time. Perhaps we need two + flavors of 'eassert', one for where 'assume' is far more likely + to help or to hurt; but that can be done later. + Problem reported by Dmitry Andipov in + . + Also, don't include ; no longer needed. + 2013-10-09 Glenn Morris * eval.c (Fcond): Doc tweak. === modified file 'src/lisp.h' --- src/lisp.h 2013-10-08 20:04:40 +0000 +++ src/lisp.h 2013-10-09 17:52:38 +0000 @@ -31,7 +31,6 @@ #include #include -#include INLINE_HEADER_BEGIN @@ -115,11 +114,9 @@ /* Extra internal type checking? */ /* Define an Emacs version of 'assert (COND)'. COND should be free of - side effects; it may be evaluated zero or more times. If COND is false, - Emacs reliably crashes if ENABLE_CHECKING is defined and behavior - is undefined if not. The compiler may assume COND while optimizing. */ + side effects; it may be evaluated zero or more times. */ #ifndef ENABLE_CHECKING -# define eassert(cond) assume (cond) +# define eassert(cond) ((void) (0 && (cond))) /* Check that COND compiles. */ #else /* ENABLE_CHECKING */ extern _Noreturn void die (const char *, const char *, int); @@ -136,7 +133,7 @@ # define eassert(cond) \ (suppress_checking || (cond) \ - ? assume (cond) \ + ? (void) 0 \ : die (# cond, __FILE__, __LINE__)) #endif /* ENABLE_CHECKING */ ------------------------------------------------------------ revno: 114592 committer: Glenn Morris branch nick: trunk timestamp: Wed 2013-10-09 13:17:20 -0400 message: Doc tweaks for cond * doc/lispref/control.texi (Conditionals): Copyedits. * src/eval.c (Fcond): Doc tweak. diff: === modified file 'doc/lispref/ChangeLog' --- doc/lispref/ChangeLog 2013-10-08 17:49:20 +0000 +++ doc/lispref/ChangeLog 2013-10-09 17:17:20 +0000 @@ -1,3 +1,7 @@ +2013-10-09 Glenn Morris + + * control.texi (Conditionals): Copyedits. (Bug#15558) + 2013-10-08 Eli Zaretskii Support menus on text-mode terminals. === modified file 'doc/lispref/control.texi' --- doc/lispref/control.texi 2013-08-09 22:34:05 +0000 +++ doc/lispref/control.texi 2013-10-09 17:17:20 +0000 @@ -218,26 +218,25 @@ @code{cond} tries the clauses in textual order, by evaluating the @var{condition} of each clause. If the value of @var{condition} is non-@code{nil}, the clause ``succeeds''; then @code{cond} evaluates its -@var{body-forms}, and the value of the last of @var{body-forms} becomes -the value of the @code{cond}. The remaining clauses are ignored. +@var{body-forms}, and returns the value of the last of @var{body-forms}. +Any remaining clauses are ignored. If the value of @var{condition} is @code{nil}, the clause ``fails'', so -the @code{cond} moves on to the following clause, trying its -@var{condition}. +the @code{cond} moves on to the following clause, trying its @var{condition}. + +A clause may also look like this: + +@example +(@var{condition}) +@end example + +@noindent +Then, if @var{condition} is non-@code{nil} when tested, the @code{cond} +form returns the value of @var{condition}. If every @var{condition} evaluates to @code{nil}, so that every clause fails, @code{cond} returns @code{nil}. -A clause may also look like this: - -@example -(@var{condition}) -@end example - -@noindent -Then, if @var{condition} is non-@code{nil} when tested, the value of -@var{condition} becomes the value of the @code{cond} form. - The following example has four clauses, which test for the cases where the value of @code{x} is a number, string, buffer and symbol, respectively: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-09 14:53:13 +0000 +++ src/ChangeLog 2013-10-09 17:17:20 +0000 @@ -1,3 +1,7 @@ +2013-10-09 Glenn Morris + + * eval.c (Fcond): Doc tweak. + 2013-10-09 Eli Zaretskii * xfaces.c (x_free_gc) [HAVE_X_WINDOWS, HAVE_NTGUI]: Don't pass === modified file 'src/eval.c' --- src/eval.c 2013-10-03 06:31:06 +0000 +++ src/eval.c 2013-10-09 17:17:20 +0000 @@ -1,6 +1,6 @@ /* Evaluator for GNU Emacs Lisp interpreter. - Copyright (C) 1985-1987, 1993-1995, 1999-2013 Free Software - Foundation, Inc. + +Copyright (C) 1985-1987, 1993-1995, 1999-2013 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -405,9 +405,9 @@ and, if the value is non-nil, this clause succeeds: then the expressions in BODY are evaluated and the last one's value is the value of the cond-form. +If a clause has one element, as in (CONDITION), then the cond-form +returns CONDITION's value, if that is non-nil. If no clause succeeds, cond returns nil. -If a clause has one element, as in (CONDITION), -CONDITION's value if non-nil is returned from the cond-form. usage: (cond CLAUSES...) */) (Lisp_Object args) { ------------------------------------------------------------ revno: 114591 committer: Glenn Morris branch nick: trunk timestamp: Wed 2013-10-09 13:10:08 -0400 message: authors.el trivia * lisp/emacs-lisp/authors.el (authors-aliases, authors-fixed-case): Add some entries. (authors): Remove unused local variables. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-09 03:32:35 +0000 +++ lisp/ChangeLog 2013-10-09 17:10:08 +0000 @@ -1,3 +1,9 @@ +2013-10-09 Glenn Morris + + * emacs-lisp/authors.el (authors-aliases, authors-fixed-case): + Add some entries. + (authors): Remove unused local variables. + 2013-10-09 Stefan Monnier * profiler.el: Create a more coherent calltree from partial backtraces. === modified file 'lisp/emacs-lisp/authors.el' --- lisp/emacs-lisp/authors.el 2013-01-10 02:30:06 +0000 +++ lisp/emacs-lisp/authors.el 2013-10-09 17:10:08 +0000 @@ -51,6 +51,7 @@ ("Bill Rozas" "Guillermo J. Rozas") ("Björn Torkelsson" "Bjorn Torkelsson") ("Brian Fox" "Brian J. Fox") + ("Brian P Templeton" "BT Templeton") ("Brian Sniffen" "Brian T. Sniffen") ("Christoph Wedler" "Christoph.Wedler@sap.com") ("Daniel Pfeiffer" "" @@ -192,7 +193,8 @@ ;; FIXME seems it would be less fragile to check for O', Mc, etc. (defconst authors-fixed-case - '("Bryan O'Sullivan" + '("Brian van den Broek" + "Bryan O'Sullivan" "Christian von Roques" "Christophe de Dinechin" "Craig McDaniel" @@ -206,7 +208,9 @@ "Greg McGary" "Hans de Graaff" "James TD Smith" + "Jay McCarthy" "Joel N. Weber II" + "Matt McClure" "Michael McNamara" "Mike McEwan" "Nelson Jose dos Santos Ferreira" @@ -216,6 +220,7 @@ "Roland McGrath" "Sean O'Halpin" "Sean O'Rourke" + "Thomas DeWeese" "Tijs van Bakel") "List of authors whose names cannot be simply capitalized.") @@ -1023,7 +1028,7 @@ Foundation's distribution of GNU Emacs. To show our appreciation for their public spirit, we list here in alphabetical order a condensed list of their contributions.\n") - (let (authors-author-list a) + (let (authors-author-list) (maphash #'authors-add-to-author-list table) (setq authors-author-list (sort authors-author-list @@ -1032,8 +1037,7 @@ (let ((author (car a)) (wrote (nth 1 a)) (cowrote (nth 2 a)) - (changed (nth 3 a)) - file) + (changed (nth 3 a))) (insert "\n" author ": ") (when wrote (insert "wrote") ------------------------------------------------------------ revno: 114590 fixes bug: http://debbugs.gnu.org/15565 committer: Eli Zaretskii branch nick: trunk timestamp: Wed 2013-10-09 17:53:13 +0300 message: Fix bug #15565 with assertion violations in x_free_gc. src/xfaces.c (x_free_gc) [HAVE_X_WINDOWS, HAVE_NTGUI]: Don't pass expressions with side effects to eassert. diff: === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-09 03:32:35 +0000 +++ src/ChangeLog 2013-10-09 14:53:13 +0000 @@ -1,3 +1,8 @@ +2013-10-09 Eli Zaretskii + + * xfaces.c (x_free_gc) [HAVE_X_WINDOWS, HAVE_NTGUI]: Don't pass + expressions with side effects to eassert. (Bug#15565) + 2013-10-09 Stefan Monnier * fns.c (hashfn_user_defined): Allow hash functions to return any === modified file 'src/xfaces.c' --- src/xfaces.c 2013-09-24 06:43:20 +0000 +++ src/xfaces.c 2013-10-09 14:53:13 +0000 @@ -603,7 +603,7 @@ x_free_gc (struct frame *f, GC gc) { eassert (input_blocked_p ()); - IF_DEBUG (eassert (--ngcs >= 0)); + IF_DEBUG ((--ngcs, eassert (ngcs >= 0))); XFreeGC (FRAME_X_DISPLAY (f), gc); } @@ -629,7 +629,7 @@ static void x_free_gc (struct frame *f, GC gc) { - IF_DEBUG (eassert (--ngcs >= 0)); + IF_DEBUG ((--ngcs, eassert (ngcs >= 0))); xfree (gc); } ------------------------------------------------------------ revno: 114589 committer: Glenn Morris branch nick: trunk timestamp: Wed 2013-10-09 06:17:52 -0400 message: Auto-commit of generated files. diff: === modified file 'autogen/config.in' --- autogen/config.in 2013-10-04 10:17:40 +0000 +++ autogen/config.in 2013-10-09 10:17:52 +0000 @@ -762,9 +762,8 @@ /* Define to 1 if you have the `memrchr' function. */ #undef HAVE_MEMRCHR -/* Define to 1 if you have mouse menus. (This is automatic if you use X, but - the option to specify it remains.) It is also defined with other window - systems that support xmenu.c. */ +/* Define to 1 if you have mouse menus. (This is supported in all + configurations, but the option to specify it remains.) */ #undef HAVE_MENUS /* Define to 1 if you have the `mkostemp' function. */ === modified file 'autogen/configure' --- autogen/configure 2013-10-08 10:17:43 +0000 +++ autogen/configure 2013-10-09 10:17:52 +0000 @@ -10687,11 +10687,8 @@ fi fi -### If we're using X11, we should use the X menu package. -HAVE_MENUS=no -case ${HAVE_X11} in - yes ) HAVE_MENUS=yes ;; -esac +### We always support menus. +HAVE_MENUS=yes # Does the opsystem file prohibit the use of the GNU malloc? # Assume not, until told otherwise. @@ -14318,15 +14315,9 @@ ## Extra CFLAGS applied to src/*.m files. GNU_OBJC_CFLAGS="$GNU_OBJC_CFLAGS -fgnu-runtime -Wno-import -fconstant-string-class=NSConstantString -DGNUSTEP_BASE_LIBRARY=1 -DGNU_GUI_LIBRARY=1 -DGNU_RUNTIME=1 -DGSWARN -DGSDIAGNOSE" fi - # We also have mouse menus. - HAVE_MENUS=yes OTHER_FILES=ns-app fi -if test "${HAVE_W32}" = "yes"; then - HAVE_MENUS=yes -fi - ### Use session management (-lSM -lICE) if available HAVE_X_SM=no LIBXSM= ------------------------------------------------------------ revno: 114588 committer: Stefan Monnier branch nick: trunk timestamp: Tue 2013-10-08 23:32:35 -0400 message: * lisp/profiler.el: Create a more coherent calltree from partial backtraces. (profiler-format): Hide the tail with `invisible' so that C-s can still find the hidden elements. (profiler-calltree-depth): Don't recurse so enthusiastically. (profiler-function-equal): New hash-table-test. (profiler-calltree-build-unified): New function. (profiler-calltree-build): Use it. (profiler-report-make-name-part): Indent the calltree less. (profiler-report-mode): Add visibility specs for profiler-format. (profiler-report-expand-entry, profiler-report-toggle-entry): Expand the whole subtree when provided with a prefix arg. * src/fns.c (hashfn_user_defined): Allow hash functions to return any Lisp_Object. diff: === modified file 'lisp/ChangeLog' --- lisp/ChangeLog 2013-10-09 03:18:01 +0000 +++ lisp/ChangeLog 2013-10-09 03:32:35 +0000 @@ -1,3 +1,17 @@ +2013-10-09 Stefan Monnier + + * profiler.el: Create a more coherent calltree from partial backtraces. + (profiler-format): Hide the tail with `invisible' so that C-s can still + find the hidden elements. + (profiler-calltree-depth): Don't recurse so enthusiastically. + (profiler-function-equal): New hash-table-test. + (profiler-calltree-build-unified): New function. + (profiler-calltree-build): Use it. + (profiler-report-make-name-part): Indent the calltree less. + (profiler-report-mode): Add visibility specs for profiler-format. + (profiler-report-expand-entry, profiler-report-toggle-entry): + Expand the whole subtree when provided with a prefix arg. + 2013-10-09 Dmitry Gutov * progmodes/ruby-mode.el (ruby-smie-rules): Indent after hanging === modified file 'lisp/profiler.el' --- lisp/profiler.el 2013-09-11 01:43:07 +0000 +++ lisp/profiler.el 2013-10-09 03:32:35 +0000 @@ -27,6 +27,7 @@ ;;; Code: (require 'cl-lib) +(require 'pcase) (defgroup profiler nil "Emacs profiler." @@ -86,10 +87,12 @@ (profiler-ensure-string arg))) for len = (length str) if (< width len) - collect (substring str 0 width) into frags + collect (progn (put-text-property (max 0 (- width 2)) len + 'invisible 'profiler str) + str) into frags else collect - (let ((padding (make-string (- width len) ?\s))) + (let ((padding (make-string (max 0 (- width len)) ?\s))) (cl-ecase align (left (concat str padding)) (right (concat padding str)))) @@ -248,10 +251,10 @@ (not (profiler-calltree-count< a b))) (defun profiler-calltree-depth (tree) - (let ((parent (profiler-calltree-parent tree))) - (if (null parent) - 0 - (1+ (profiler-calltree-depth parent))))) + (let ((d 0)) + (while (setq tree (profiler-calltree-parent tree)) + (cl-incf d)) + d)) (defun profiler-calltree-find (tree entry) "Return a child tree of ENTRY under TREE." @@ -269,10 +272,9 @@ (profiler-calltree-walk child function))) (defun profiler-calltree-build-1 (tree log &optional reverse) - ;; FIXME: Do a better job of reconstructing a complete call-tree - ;; when the backtraces have been truncated. Ideally, we should be - ;; able to reduce profiler-max-stack-depth to 3 or 4 and still - ;; get a meaningful call-tree. + ;; This doesn't try to stitch up partial backtraces together. + ;; We still use it for reverse calltrees, but for forward calltrees, we use + ;; profiler-calltree-build-unified instead now. (maphash (lambda (backtrace count) (let ((node tree) @@ -289,6 +291,115 @@ (setq node child))))))) log)) + +(define-hash-table-test 'profiler-function-equal #'function-equal + (lambda (f) (cond + ((byte-code-function-p f) (aref f 1)) + ((eq (car-safe f) 'closure) (cddr f)) + (t f)))) + +(defun profiler-calltree-build-unified (tree log) + ;; Let's try to unify all those partial backtraces into a single + ;; call tree. First, we record in fun-map all the functions that appear + ;; in `log' and where they appear. + (let ((fun-map (make-hash-table :test 'profiler-function-equal)) + (parent-map (make-hash-table :test 'eq)) + (leftover-tree (profiler-make-calltree + :entry (intern "...") :parent tree))) + (push leftover-tree (profiler-calltree-children tree)) + (maphash + (lambda (backtrace _count) + (let ((max (length backtrace))) + ;; Don't record the head elements in there, since we want to use this + ;; fun-map to find parents of partial backtraces, but parents only + ;; make sense if they have something "above". + (dotimes (i (1- max)) + (let ((f (aref backtrace i))) + (when f + (push (cons i backtrace) (gethash f fun-map))))))) + log) + ;; Then, for each partial backtrace, try to find a parent backtrace + ;; (i.e. a backtrace that describes (part of) the truncated part of + ;; the partial backtrace). For a partial backtrace like "[f3 f2 f1]" (f3 + ;; is deeper), any backtrace that includes f1 could be a parent; and indeed + ;; the counts of this partial backtrace could each come from a different + ;; parent backtrace (some of which may not even be in `log'). So we should + ;; consider each backtrace that includes f1 and give it some percentage of + ;; `count'. But we can't know for sure what percentage to give to each + ;; possible parent. + ;; The "right" way might be to give a percentage proportional to the counts + ;; already registered for that parent, or some such statistical principle. + ;; But instead, we will give all our counts to a single "best + ;; matching" parent. So let's look for the best matching parent, and store + ;; the result in parent-map. + ;; Using the "best matching parent" is important also to try and avoid + ;; stitching together backtraces that can't possibly go together. + ;; For example, when the head is `apply' (or `mapcar', ...), we want to + ;; make sure we don't just use any parent that calls `apply', since most of + ;; them would never, in turn, cause apply to call the subsequent function. + (maphash + (lambda (backtrace _count) + (let* ((max (1- (length backtrace))) + (head (aref backtrace max)) + (best-parent nil) + (best-match (1+ max)) + (parents (gethash head fun-map))) + (pcase-dolist (`(,i . ,parent) parents) + (when t ;; (<= (- max i) best-match) ;Else, it can't be better. + (let ((match max) + (imatch i)) + (cl-assert (>= match imatch)) + (cl-assert (function-equal (aref backtrace max) + (aref parent i))) + (while (progn + (cl-decf imatch) (cl-decf match) + (when (> imatch 0) + (function-equal (aref backtrace match) + (aref parent imatch))))) + (when (< match best-match) + (cl-assert (<= (- max i) best-match)) + ;; Let's make sure this parent is not already our child: we + ;; don't want cycles here! + (let ((valid t) + (tmp-parent parent)) + (while (setq tmp-parent + (if (eq tmp-parent backtrace) + (setq valid nil) + (cdr (gethash tmp-parent parent-map))))) + (when valid + (setq best-match match) + (setq best-parent (cons i parent)))))))) + (puthash backtrace best-parent parent-map))) + log) + ;; Now we have a single parent per backtrace, so we have a unified tree. + ;; Let's build the actual call-tree from it. + (maphash + (lambda (backtrace count) + (let ((node tree) + (parents (list (cons -1 backtrace))) + (tmp backtrace) + (max (length backtrace))) + (while (setq tmp (gethash tmp parent-map)) + (push tmp parents) + (setq tmp (cdr tmp))) + (when (aref (cdar parents) (1- max)) + (cl-incf (profiler-calltree-count leftover-tree) count) + (setq node leftover-tree)) + (pcase-dolist (`(,i . ,parent) parents) + (let ((j (1- max))) + (while (> j i) + (let ((f (aref parent j))) + (cl-decf j) + (when f + (let ((child (profiler-calltree-find node f))) + (unless child + (setq child (profiler-make-calltree + :entry f :parent node)) + (push child (profiler-calltree-children node))) + (cl-incf (profiler-calltree-count child) count) + (setq node child))))))))) + log))) + (defun profiler-calltree-compute-percentages (tree) (let ((total-count 0)) ;; FIXME: the memory profiler's total wraps around all too easily! @@ -303,7 +414,9 @@ (cl-defun profiler-calltree-build (log &key reverse) (let ((tree (profiler-make-calltree))) - (profiler-calltree-build-1 tree log reverse) + (if reverse + (profiler-calltree-build-1 tree log reverse) + (profiler-calltree-build-unified tree log)) (profiler-calltree-compute-percentages tree) tree)) @@ -371,7 +484,7 @@ (defun profiler-report-make-name-part (tree) (let* ((entry (profiler-calltree-entry tree)) (depth (profiler-calltree-depth tree)) - (indent (make-string (* (1- depth) 2) ?\s)) + (indent (make-string (* (1- depth) 1) ?\s)) (mark (if (profiler-calltree-leaf-p tree) profiler-report-leaf-mark profiler-report-closed-mark)) @@ -379,7 +492,7 @@ (format "%s%s %s" indent mark entry))) (defun profiler-report-header-line-format (fmt &rest args) - (let* ((header (apply 'profiler-format fmt args)) + (let* ((header (apply #'profiler-format fmt args)) (escaped (replace-regexp-in-string "%" "%%" header))) (concat " " escaped))) @@ -404,7 +517,7 @@ (insert (propertize (concat line "\n") 'calltree tree)))) (defun profiler-report-insert-calltree-children (tree) - (mapc 'profiler-report-insert-calltree + (mapc #'profiler-report-insert-calltree (profiler-calltree-children tree))) @@ -502,6 +615,7 @@ (define-derived-mode profiler-report-mode special-mode "Profiler-Report" "Profiler Report Mode." + (add-to-invisibility-spec '(profiler . t)) (setq buffer-read-only t buffer-undo-list t truncate-lines t)) @@ -531,9 +645,10 @@ (forward-line -1) (profiler-report-move-to-entry)) -(defun profiler-report-expand-entry () - "Expand entry at point." - (interactive) +(defun profiler-report-expand-entry (&optional full) + "Expand entry at point. +With a prefix argument, expand the whole subtree." + (interactive "P") (save-excursion (beginning-of-line) (when (search-forward (concat profiler-report-closed-mark " ") @@ -543,7 +658,14 @@ (let ((inhibit-read-only t)) (replace-match (concat profiler-report-open-mark " ")) (forward-line) - (profiler-report-insert-calltree-children tree) + (let ((first (point)) + (last (copy-marker (point) t))) + (profiler-report-insert-calltree-children tree) + (when full + (goto-char first) + (while (< (point) last) + (profiler-report-expand-entry) + (forward-line 1)))) t)))))) (defun profiler-report-collapse-entry () @@ -568,11 +690,11 @@ (delete-region start (line-beginning-position))))) t))) -(defun profiler-report-toggle-entry () +(defun profiler-report-toggle-entry (&optional arg) "Expand entry at point if the tree is collapsed, otherwise collapse." - (interactive) - (or (profiler-report-expand-entry) + (interactive "P") + (or (profiler-report-expand-entry arg) (profiler-report-collapse-entry))) (defun profiler-report-find-entry (&optional event) === modified file 'src/ChangeLog' --- src/ChangeLog 2013-10-08 20:04:40 +0000 +++ src/ChangeLog 2013-10-09 03:32:35 +0000 @@ -1,3 +1,8 @@ +2013-10-09 Stefan Monnier + + * fns.c (hashfn_user_defined): Allow hash functions to return any + Lisp_Object. + 2013-10-08 Paul Eggert Fix minor problems found by static checking. === modified file 'src/fns.c' --- src/fns.c 2013-09-29 18:50:28 +0000 +++ src/fns.c 2013-10-09 03:32:35 +0000 @@ -3571,9 +3571,7 @@ args[0] = ht->user_hash_function; args[1] = key; hash = Ffuncall (2, args); - if (!INTEGERP (hash)) - signal_error ("Invalid hash code returned from user-supplied hash function", hash); - return XUINT (hash); + return hashfn_eq (ht, hash); } /* An upper bound on the size of a hash table index. It must fit in @@ -4542,9 +4540,9 @@ TEST must be a function taking two arguments and returning non-nil if both arguments are the same. HASH must be a function taking one -argument and return an integer that is the hash code of the argument. -Hash code computation should use the whole value range of integers, -including negative integers. */) +argument and returning an object that is the hash code of the argument. +It should be the case that if (eq (funcall HASH x1) (funcall HASH x2)) +returns nil, then (funcall TEST x1 x2) also returns nil. */) (Lisp_Object name, Lisp_Object test, Lisp_Object hash) { return Fput (name, Qhash_table_test, list2 (test, hash));