commit 35f5afbca1779f7b6d1d78cae97437a56fd5a9ba (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Fri Nov 13 11:23:35 2015 +0200 Fix last change in shr.el * lisp/net/shr.el (shr--have-one-fringe-p): Rename from have-fringes-p. All callers changed. Doc fix. (Bug#21895) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 23e2dc1..a48d098 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -203,9 +203,8 @@ cid: URL as the argument.") (goto-char begin) (shr-insert-document dom)))) -(defun have-fringes-p () - "Return t if fringe-columns is bound, and either (fringe-columns 'left) or -\(fringe-columns 'right) returns nonzero." +(defun shr--have-one-fringe-p () + "Return non-nil if we know at least one of the fringes has non-zero width." (and (fboundp 'fringe-columns) (or (not (zerop (fringe-columns 'right))) (not (zerop (fringe-columns 'left)))))) @@ -237,13 +236,13 @@ DOM should be a parse tree as generated by (if (not shr-use-fonts) (- (window-body-width) 1 (if (and (null shr-width) - (not (have-fringes-p))) + (not (shr--have-one-fringe-p))) 0 1)) (- (window-body-width nil t) (* 2 (frame-char-width)) (if (and (null shr-width) - (not (have-fringes-p))) + (not (shr--have-one-fringe-p))) (* (frame-char-width) 2) 0)))))) (shr-descend dom) @@ -467,7 +466,7 @@ size, and full-buffer size." ;; to usurp one column for the ;; continuation glyph. (if (and (null shr-width) - (not (have-fringes-p))) + (not (shr--have-one-fringe-p))) (* (frame-char-width) 2) 0)))) (shr-insert text) commit 508e77b7633782176d3de62f9e7828b90b806f3a Author: Eli Zaretskii Date: Fri Nov 13 11:07:43 2015 +0200 Fix last change * src/w32fns.c (syms_of_w32fns) [WINDOWSNT && !HAVE_DBUS]: Don't DEFSYM tray notification symbols if D-Bus is being used. diff --git a/src/w32fns.c b/src/w32fns.c index 475864b..f2d286d 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -9294,6 +9294,7 @@ syms_of_w32fns (void) DEFSYM (Qframes, "frames"); DEFSYM (Qtip_frame, "tip-frame"); DEFSYM (Qunicode_sip, "unicode-sip"); +#if defined WINDOWSNT && !defined HAVE_DBUS DEFSYM (QCicon, ":icon"); DEFSYM (QCtip, ":tip"); DEFSYM (QClevel, ":level"); @@ -9302,6 +9303,7 @@ syms_of_w32fns (void) DEFSYM (QCtimeout, ":timeout"); DEFSYM (QCtitle, ":title"); DEFSYM (QCbody, ":body"); +#endif /* Symbols used elsewhere, but only in MS-Windows-specific code. */ DEFSYM (Qgnutls_dll, "gnutls"); commit d60ed3f33aae3719828dfb515bc9a16570461dd4 Author: Eli Zaretskii Date: Fri Nov 13 11:02:04 2015 +0200 Another fix for MinGW64 and Cygwin builds due to notifications * src/w32fns.c: Ifdef away tray notification code if D-Bus is being compiled into Emacs. (syms_of_w32fns) [WINDOWSNT && !HAVE_DBUS]: Don't defsubr Sw32_notification_notify and Sw32_notification_close if the code is not compiled. Reported by Andy Moreton . diff --git a/src/w32fns.c b/src/w32fns.c index b71002f..475864b 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -8756,7 +8756,7 @@ Internal use only. */) return menubar_in_use ? Qt : Qnil; } -#ifndef __CYGWIN__ +#if defined WINDOWSNT && !defined HAVE_DBUS /*********************************************************************** Tray notifications @@ -9219,7 +9219,7 @@ DEFUN ("w32-notification-close", return Qnil; } -#endif /* !__CYGWIN__ */ +#endif /* WINDOWSNT && !HAVE_DBUS */ /*********************************************************************** @@ -9635,8 +9635,10 @@ This variable has effect only on Windows Vista and later. */); defsubr (&Sw32_window_exists_p); defsubr (&Sw32_battery_status); defsubr (&Sw32__menu_bar_in_use); +#if defined WINDOWSNT && !defined HAVE_DBUS defsubr (&Sw32_notification_notify); defsubr (&Sw32_notification_close); +#endif #ifdef WINDOWSNT defsubr (&Sfile_system_info); commit 805a39bcc94d143b0e60e5cd894cdad32af376c3 Author: YAMAMOTO Mitsuharu Date: Fri Nov 13 12:48:09 2015 +0900 Remove intern calls and XXX comments from Fx_export_frames * src/xfns.c (Fx_export_frames): Use Qpdf, Qpng, Qpostscript, and Qsvg instead of intern calls. Use "postscript" instead of "ps" for consistency with image types. Remove XXX comments. (syms_of_xfns) : DEFSYM it. diff --git a/src/xfns.c b/src/xfns.c index 9071b89..9d90b7b 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -6559,11 +6559,12 @@ present and mapped to the usual X keysyms. */) #ifdef USE_CAIRO DEFUN ("x-export-frames", Fx_export_frames, Sx_export_frames, 0, 2, 0, - doc: /* XXX Experimental. Return image data of FRAMES in TYPE format. + doc: /* Return image data of FRAMES in TYPE format. FRAMES should be nil (the selected frame), a frame, or a list of frames (each of which corresponds to one page). Optional arg TYPE -should be either `pdf' (default), `png', `ps', or `svg'. Supported -types are determined by the compile-time configuration of cairo. */) +should be either `pdf' (default), `png', `postscript', or `svg'. +Supported types are determined by the compile-time configuration of +cairo. */) (Lisp_Object frames, Lisp_Object type) { Lisp_Object result, rest, tmp; @@ -6590,12 +6591,12 @@ types are determined by the compile-time configuration of cairo. */) frames = Fnreverse (tmp); #ifdef CAIRO_HAS_PDF_SURFACE - if (NILP (type) || EQ (type, intern ("pdf"))) /* XXX: Qpdf */ + if (NILP (type) || EQ (type, Qpdf)) surface_type = CAIRO_SURFACE_TYPE_PDF; else #endif #ifdef CAIRO_HAS_PNG_FUNCTIONS - if (EQ (type, intern ("png"))) + if (EQ (type, Qpng)) { if (!NILP (XCDR (frames))) error ("PNG export cannot handle multiple frames."); @@ -6604,12 +6605,12 @@ types are determined by the compile-time configuration of cairo. */) else #endif #ifdef CAIRO_HAS_PS_SURFACE - if (EQ (type, intern ("ps"))) + if (EQ (type, Qpostscript)) surface_type = CAIRO_SURFACE_TYPE_PS; else #endif #ifdef CAIRO_HAS_SVG_SURFACE - if (EQ (type, intern ("svg"))) + if (EQ (type, Qsvg)) { /* For now, we stick to SVG 1.1. */ if (!NILP (XCDR (frames))) @@ -6763,6 +6764,8 @@ syms_of_xfns (void) DEFSYM (Qmono, "mono"); #ifdef USE_CAIRO + DEFSYM (Qpdf, "pdf"); + DEFSYM (Qorientation, "orientation"); DEFSYM (Qtop_margin, "top-margin"); DEFSYM (Qbottom_margin, "bottom-margin"); commit 9463abf4cc7571cf125bf1a637abe1a34241e83d Author: Eric Hanchrow Date: Thu Nov 12 17:23:37 2015 -0800 shr: don't invoke unbound function (Bug#21895) * lisp/net/shr.el (have-fringes-p): New function. (shr-insert-document, shr-fill-text): Use it. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 58deaea..23e2dc1 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -203,6 +203,13 @@ cid: URL as the argument.") (goto-char begin) (shr-insert-document dom)))) +(defun have-fringes-p () + "Return t if fringe-columns is bound, and either (fringe-columns 'left) or +\(fringe-columns 'right) returns nonzero." + (and (fboundp 'fringe-columns) + (or (not (zerop (fringe-columns 'right))) + (not (zerop (fringe-columns 'left)))))) + ;;;###autoload (defun shr-insert-document (dom) "Render the parsed document DOM into the current buffer. @@ -230,19 +237,13 @@ DOM should be a parse tree as generated by (if (not shr-use-fonts) (- (window-body-width) 1 (if (and (null shr-width) - (or (zerop - (fringe-columns 'right)) - (zerop - (fringe-columns 'left)))) + (not (have-fringes-p))) 0 1)) (- (window-body-width nil t) (* 2 (frame-char-width)) (if (and (null shr-width) - (or (zerop - (fringe-columns 'right)) - (zerop - (fringe-columns 'left)))) + (not (have-fringes-p))) (* (frame-char-width) 2) 0)))))) (shr-descend dom) @@ -466,8 +467,7 @@ size, and full-buffer size." ;; to usurp one column for the ;; continuation glyph. (if (and (null shr-width) - (or (zerop (fringe-columns 'right)) - (zerop (fringe-columns 'left)))) + (not (have-fringes-p))) (* (frame-char-width) 2) 0)))) (shr-insert text) commit 6e5186e8a7ccfb9b8fb35b5f4f0371e4f4a68162 Author: Juanma Barranquero Date: Thu Nov 12 23:36:33 2015 +0100 * test/automated/keymaps-test.el: Fix test to make it repeatable (keymap-store_in_keymap-FASTINT-on-nonchars): Reset Buffer-menu-mode-map entry to its initial value to make the test repeatable in interactive sessions (assuming it doesn't fail and crashes Emacs, of course). diff --git a/test/automated/keymap-tests.el b/test/automated/keymap-tests.el index 482ed27..973b240 100644 --- a/test/automated/keymap-tests.el +++ b/test/automated/keymap-tests.el @@ -26,13 +26,17 @@ (ert-deftest keymap-store_in_keymap-FASTINT-on-nonchars () "Check for bug fixed in \"Fix assertion violation in define-key\", commit 86c19714b097aa477d339ed99ffb5136c755a046." - (should-not (eq (lookup-key Buffer-menu-mode-map [32]) 'undefined)) - ;; This will cause an assertion violation if the bug is present. - ;; We could run an inferior Emacs process and check for the return - ;; status, but in some environments an assertion failure triggers - ;; an abort dialog that requires user intervention anyway. - (define-key Buffer-menu-mode-map [(32 . 126)] 'undefined) - (should (eq (lookup-key Buffer-menu-mode-map [32]) 'undefined))) + (let ((def (lookup-key Buffer-menu-mode-map [32]))) + (unwind-protect + (progn + (should-not (eq def 'undefined)) + ;; This will cause an assertion violation if the bug is present. + ;; We could run an inferior Emacs process and check for the return + ;; status, but in some environments an assertion failure triggers + ;; an abort dialog that requires user intervention anyway. + (define-key Buffer-menu-mode-map [(32 . 32)] 'undefined) + (should (eq (lookup-key Buffer-menu-mode-map [32]) 'undefined))) + (define-key Buffer-menu-mode-map [32] def)))) (provide 'keymap-tests) commit 0c928266114aa75c7bfa1842fe5023174d2984c8 Author: Artur Malabarba Date: Thu Nov 12 23:32:40 2015 +0000 * test/automated/cl-lib-tests.el (cl-lib-struct-constructors): Small fix diff --git a/test/automated/cl-lib-tests.el b/test/automated/cl-lib-tests.el index 9b230db..e2429b7 100644 --- a/test/automated/cl-lib-tests.el +++ b/test/automated/cl-lib-tests.el @@ -222,8 +222,8 @@ (def . ,(or `nil `(nil)))) t))))) (ert-deftest cl-lib-struct-constructors () - (should (equal (documentation 'cl-lib--con-2 t) - "Constructor docstring.")) + (should (string-match "\\`Constructor docstring." + (documentation 'cl-lib--con-2 t))) (should (mystruct-p (cl-lib--con-1))) (should (mystruct-p (cl-lib--con-2)))) commit 39dbd1cd0f6cc007722f1d120d3be219d1cb5963 Author: Phillip Lord Date: Thu Nov 12 22:18:59 2015 +0000 : Tests for undo-auto functionality. diff --git a/test/automated/simple-test.el b/test/automated/simple-test.el index 5bfb746..86c9fc2 100644 --- a/test/automated/simple-test.el +++ b/test/automated/simple-test.el @@ -202,5 +202,38 @@ (unless (or noninteractive python) (unload-feature 'python))))) + +;;; auto-boundary tests +(ert-deftest undo-auto--boundary-timer () + (should + undo-auto--current-boundary-timer)) + +(ert-deftest undo-auto--boundaries-added () + ;; The change in the buffer should have caused addition + ;; to undo-auto--undoably-changed-buffers. + (should + (with-temp-buffer + (setq buffer-undo-list nil) + (insert "hello") + (member (current-buffer) undo-auto--undoably-changed-buffers))) + ;; The head of buffer-undo-list should be the insertion event, and + ;; therefore not nil + (should + (with-temp-buffer + (setq buffer-undo-list nil) + (insert "hello") + (car buffer-undo-list))) + ;; Now the head of the buffer-undo-list should be a boundary and so + ;; nil. We have to call auto-boundary explicitly because we are out + ;; of the command loop + (should-not + (with-temp-buffer + (setq buffer-undo-list nil) + (insert "hello") + (car buffer-undo-list) + (undo-auto--boundaries 'test)))) + + + (provide 'simple-test) ;;; simple-test.el ends here commit 20aa42e8204f8f0139ba3880cb32ddf88acc9bf4 Merge: d2f73db 44dfa86 Author: Phillip Lord Date: Thu Nov 12 22:01:22 2015 +0000 ; Merge branch 'fix/no-undo-boundary-on-secondary-buffer-change' Conflicts: src/cmds.c src/keyboard.c commit 44dfa86b7d382b84564d68472da1448d08f48129 Author: Phillip Lord Date: Thu Aug 6 21:33:58 2015 +0100 The heuristic that Emacs uses to add an `undo-boundary' has been reworked, as it interacts poorly with functions on `post-command-hook' or `after-change-functions'. * lisp/simple.el: New section added. * src/cmds.c (remove_excessive_undo_boundaries): Now in lisp. (self_insert_command): Calls simple.el to amalgamate. (delete_char): Calls simple.el to amalgamate. * src/keyboard.c (last_undo_boundary): Removed. * src/undo.c (run_undoable_change): New function. diff --git a/lisp/simple.el b/lisp/simple.el index 00c25db..821c766 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2754,6 +2754,143 @@ with < or <= based on USE-<." '(0 . 0))) '(0 . 0))) +;;; Default undo-boundary addition +;; +;; This section adds a new undo-boundary at either after a command is +;; called or in some cases on a timer called after a change is made in +;; any buffer. +(defvar-local undo-auto--last-boundary-cause nil + "Describe the cause of the last undo-boundary. + +If `explicit', the last boundary was caused by an explicit call to +`undo-boundary', that is one not called by the code in this +section. + +If it is equal to `timer', then the last boundary was inserted +by `undo-auto--boundary-timer'. + +If it is equal to `command', then the last boundary was inserted +automatically after a command, that is by the code defined in +this section. + +If it is equal to a list, then the last boundary was inserted by +an amalgamating command. The car of the list is the number of +times an amalgamating command has been called, and the cdr are the +buffers that were changed during the last command.") + +(defvar undo-auto--current-boundary-timer nil + "Current timer which will run `undo-auto--boundary-timer' or nil. + +If set to non-nil, this will effectively disable the timer.") + +(defvar undo-auto--this-command-amalgamating nil + "Non-nil if `this-command' should be amalgamated. +This variable is set to nil by `undo-auto--boundaries' and is set +by `undo-auto--amalgamate'." ) + +(defun undo-auto--needs-boundary-p () + "Return non-nil if `buffer-undo-list' needs a boundary at the start." + (car-safe buffer-undo-list)) + +(defun undo-auto--last-boundary-amalgamating-number () + "Return the number of amalgamating last commands or nil. +Amalgamating commands are, by default, either +`self-insert-command' and `delete-char', but can be any command +that calls `undo-auto--amalgamate'." + (car-safe undo-auto--last-boundary-cause)) + +(defun undo-auto--ensure-boundary (cause) + "Add an `undo-boundary' to the current buffer if needed. +REASON describes the reason that the boundary is being added; see +`undo-auto--last-boundary' for more information." + (when (and + (undo-auto--needs-boundary-p)) + (let ((last-amalgamating + (undo-auto--last-boundary-amalgamating-number))) + (undo-boundary) + (setq undo-auto--last-boundary-cause + (if (eq 'amalgamate cause) + (cons + (if last-amalgamating (1+ last-amalgamating) 0) + undo-auto--undoably-changed-buffers) + cause))))) + +(defun undo-auto--boundaries (cause) + "Check recently changed buffers and add a boundary if necessary. +REASON describes the reason that the boundary is being added; see +`undo-last-boundary' for more information." + (dolist (b undo-auto--undoably-changed-buffers) + (when (buffer-live-p b) + (with-current-buffer b + (undo-auto--ensure-boundary cause)))) + (setq undo-auto--undoably-changed-buffers nil)) + +(defun undo-auto--boundary-timer () + "Timer which will run `undo--auto-boundary-timer'." + (setq undo-auto--current-boundary-timer nil) + (undo-auto--boundaries 'timer)) + +(defun undo-auto--boundary-ensure-timer () + "Ensure that the `undo-auto-boundary-timer' is set." + (unless undo-auto--current-boundary-timer + (setq undo-auto--current-boundary-timer + (run-at-time 10 nil #'undo-auto--boundary-timer)))) + +(defvar undo-auto--undoably-changed-buffers nil + "List of buffers that have changed recently. + +This list is maintained by `undo-auto--undoable-change' and +`undo-auto--boundaries' and can be affected by changes to their +default values. + +See also `undo-auto--buffer-undoably-changed'.") + +(defun undo-auto--add-boundary () + "Add an `undo-boundary' in appropriate buffers." + (undo-auto--boundaries + (if undo-auto--this-command-amalgamating + 'amalgamate + 'command)) + (setq undo-auto--this-command-amalgamating nil)) + +(defun undo-auto--amalgamate () + "Amalgamate undo if necessary. +This function can be called after an amalgamating command. It +removes the previous `undo-boundary' if a series of such calls +have been made. By default `self-insert-command' and +`delete-char' are the only amalgamating commands, although this +function could be called by any command wishing to have this +behaviour." + (let ((last-amalgamating-count + (undo-auto--last-boundary-amalgamating-number))) + (setq undo-auto--this-command-amalgamating t) + (when + last-amalgamating-count + (if + (and + (< last-amalgamating-count 20) + (eq this-command last-command)) + ;; Amalgamate all buffers that have changed. + (dolist (b (cdr undo-auto--last-boundary-cause)) + (when (buffer-live-p b) + (with-current-buffer + b + (when + ;; The head of `buffer-undo-list' is nil. + ;; `car-safe' doesn't work because + ;; `buffer-undo-list' need not be a list! + (and (listp buffer-undo-list) + (not (car buffer-undo-list))) + (setq buffer-undo-list + (cdr buffer-undo-list)))))) + (setq undo-auto--last-boundary-cause 0))))) + +(defun undo-auto--undoable-change () + "Called after every undoable buffer change." + (add-to-list 'undo-auto--undoably-changed-buffers (current-buffer)) + (undo-auto--boundary-ensure-timer)) +;; End auto-boundary section + (defcustom undo-ask-before-discard nil "If non-nil ask about discarding undo info for the current command. Normally, Emacs discards the undo info for the current command if diff --git a/src/cmds.c b/src/cmds.c index a975a8e..6f19a04 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -220,36 +220,6 @@ to t. */) return Qnil; } -static int nonundocount; - -static void -remove_excessive_undo_boundaries (void) -{ - bool remove_boundary = true; - - if (!EQ (Vthis_command, KVAR (current_kboard, Vlast_command))) - nonundocount = 0; - - if (NILP (Vexecuting_kbd_macro)) - { - if (nonundocount <= 0 || nonundocount >= 20) - { - remove_boundary = false; - nonundocount = 0; - } - nonundocount++; - } - - if (remove_boundary - && CONSP (BVAR (current_buffer, undo_list)) - && NILP (XCAR (BVAR (current_buffer, undo_list))) - /* Only remove auto-added boundaries, not boundaries - added by explicit calls to undo-boundary. */ - && EQ (BVAR (current_buffer, undo_list), last_undo_boundary)) - /* Remove the undo_boundary that was just pushed. */ - bset_undo_list (current_buffer, XCDR (BVAR (current_buffer, undo_list))); -} - DEFUN ("delete-char", Fdelete_char, Sdelete_char, 1, 2, "p\nP", doc: /* Delete the following N characters (previous if N is negative). Optional second arg KILLFLAG non-nil means kill instead (save in kill ring). @@ -265,7 +235,7 @@ because it respects values of `delete-active-region' and `overwrite-mode'. */) CHECK_NUMBER (n); if (abs (XINT (n)) < 2) - remove_excessive_undo_boundaries (); + call0 (Qundo_auto__amalgamate); pos = PT + XINT (n); if (NILP (killflag)) @@ -311,7 +281,7 @@ At the end, it runs `post-self-insert-hook'. */) error ("Negative repetition argument %"pI"d", XFASTINT (n)); if (XFASTINT (n) < 2) - remove_excessive_undo_boundaries (); + call0 (Qundo_auto__amalgamate); /* Barf if the key that invoked this was not a character. */ if (!CHARACTERP (last_command_event)) @@ -321,7 +291,7 @@ At the end, it runs `post-self-insert-hook'. */) XINT (last_command_event)); int val = internal_self_insert (character, XFASTINT (n)); if (val == 2) - nonundocount = 0; + Fset (Qundo_auto__this_command_amalgamating, Qnil); frame_make_pointer_invisible (SELECTED_FRAME ()); } @@ -526,6 +496,10 @@ internal_self_insert (int c, EMACS_INT n) void syms_of_cmds (void) { + DEFSYM (Qundo_auto__amalgamate, "undo-auto--amalgamate"); + DEFSYM (Qundo_auto__this_command_amalgamating, + "undo-auto--this-command-amalgamating"); + DEFSYM (Qkill_forward_chars, "kill-forward-chars"); /* A possible value for a buffer's overwrite-mode variable. */ @@ -555,7 +529,6 @@ keys_of_cmds (void) { int n; - nonundocount = 0; initial_define_key (global_map, Ctl ('I'), "self-insert-command"); for (n = 040; n < 0177; n++) initial_define_key (global_map, n, "self-insert-command"); diff --git a/src/keyboard.c b/src/keyboard.c index 5f86675..1f08e1f 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1278,9 +1278,6 @@ static int read_key_sequence (Lisp_Object *, int, Lisp_Object, bool, bool, bool, bool); static void adjust_point_for_property (ptrdiff_t, bool); -/* The last boundary auto-added to buffer-undo-list. */ -Lisp_Object last_undo_boundary; - /* FIXME: This is wrong rather than test window-system, we should call a new set-selection, which will then dispatch to x-set-selection, or tty-set-selection, or w32-set-selection, ... */ @@ -1505,14 +1502,10 @@ command_loop_1 (void) } #endif - if (NILP (KVAR (current_kboard, Vprefix_arg))) /* FIXME: Why? --Stef */ - { - Lisp_Object undo = BVAR (current_buffer, undo_list); - Fundo_boundary (); - last_undo_boundary - = (EQ (undo, BVAR (current_buffer, undo_list)) - ? Qnil : BVAR (current_buffer, undo_list)); - } + /* Ensure that we have added appropriate undo-boundaries as a + result of changes from the last command. */ + call0 (Qundo_auto__add_boundary); + call1 (Qcommand_execute, Vthis_command); #ifdef HAVE_WINDOW_SYSTEM @@ -11095,6 +11088,8 @@ syms_of_keyboard (void) DEFSYM (Qpre_command_hook, "pre-command-hook"); DEFSYM (Qpost_command_hook, "post-command-hook"); + DEFSYM (Qundo_auto__add_boundary, "undo-auto--add-boundary"); + DEFSYM (Qdeferred_action_function, "deferred-action-function"); DEFSYM (Qdelayed_warnings_hook, "delayed-warnings-hook"); DEFSYM (Qfunction_key, "function-key"); diff --git a/src/lisp.h b/src/lisp.h index 02109d7..aaf52bd 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4174,7 +4174,6 @@ extern void syms_of_casetab (void); extern Lisp_Object echo_message_buffer; extern struct kboard *echo_kboard; extern void cancel_echoing (void); -extern Lisp_Object last_undo_boundary; extern bool input_pending; #ifdef HAVE_STACK_OVERFLOW_HANDLING extern sigjmp_buf return_to_command_loop; diff --git a/src/undo.c b/src/undo.c index 750bc8a..364b37e 100644 --- a/src/undo.c +++ b/src/undo.c @@ -26,10 +26,6 @@ along with GNU Emacs. If not, see . */ #include "commands.h" #include "window.h" -/* Last buffer for which undo information was recorded. */ -/* BEWARE: This is not traced by the GC, so never dereference it! */ -static struct buffer *last_undo_buffer; - /* Position of point last time we inserted a boundary. */ static struct buffer *last_boundary_buffer; static ptrdiff_t last_boundary_position; @@ -41,6 +37,12 @@ static ptrdiff_t last_boundary_position; an undo-boundary. */ static Lisp_Object pending_boundary; +void +run_undoable_change () +{ + call0 (Qundo_auto__undoable_change); +} + /* Record point as it was at beginning of this command (if necessary) and prepare the undo info for recording a change. PT is the position of point that will naturally occur as a result of the @@ -59,15 +61,7 @@ record_point (ptrdiff_t pt) if (NILP (pending_boundary)) pending_boundary = Fcons (Qnil, Qnil); - if ((current_buffer != last_undo_buffer) - /* Don't call Fundo_boundary for the first change. Otherwise we - risk overwriting last_boundary_position in Fundo_boundary with - PT of the current buffer and as a consequence not insert an - undo boundary because last_boundary_position will equal pt in - the test at the end of the present function (Bug#731). */ - && (MODIFF > SAVE_MODIFF)) - Fundo_boundary (); - last_undo_buffer = current_buffer; + run_undoable_change (); at_boundary = ! CONSP (BVAR (current_buffer, undo_list)) || NILP (XCAR (BVAR (current_buffer, undo_list))); @@ -139,9 +133,7 @@ record_marker_adjustments (ptrdiff_t from, ptrdiff_t to) if (NILP (pending_boundary)) pending_boundary = Fcons (Qnil, Qnil); - if (current_buffer != last_undo_buffer) - Fundo_boundary (); - last_undo_buffer = current_buffer; + run_undoable_change (); for (m = BUF_MARKERS (current_buffer); m; m = m->next) { @@ -228,10 +220,6 @@ record_first_change (void) if (EQ (BVAR (current_buffer, undo_list), Qt)) return; - if (current_buffer != last_undo_buffer) - Fundo_boundary (); - last_undo_buffer = current_buffer; - if (base_buffer->base_buffer) base_buffer = base_buffer->base_buffer; @@ -259,15 +247,10 @@ record_property_change (ptrdiff_t beg, ptrdiff_t length, if (NILP (pending_boundary)) pending_boundary = Fcons (Qnil, Qnil); - if (buf != last_undo_buffer) - boundary = true; - last_undo_buffer = buf; - /* Switch temporarily to the buffer that was changed. */ - current_buffer = buf; + set_buffer_internal (buf); - if (boundary) - Fundo_boundary (); + run_undoable_change (); if (MODIFF <= SAVE_MODIFF) record_first_change (); @@ -278,7 +261,8 @@ record_property_change (ptrdiff_t beg, ptrdiff_t length, bset_undo_list (current_buffer, Fcons (entry, BVAR (current_buffer, undo_list))); - current_buffer = obuf; + /* Reset the buffer */ + set_buffer_internal (obuf); } DEFUN ("undo-boundary", Fundo_boundary, Sundo_boundary, 0, 0, 0, @@ -308,6 +292,8 @@ but another undo command will undo to the previous boundary. */) } last_boundary_position = PT; last_boundary_buffer = current_buffer; + + Fset (Qundo_auto__last_boundary_cause, Qexplicit); return Qnil; } @@ -383,7 +369,6 @@ truncate_undo_list (struct buffer *b) && !NILP (Vundo_outer_limit_function)) { Lisp_Object tem; - struct buffer *temp = last_undo_buffer; /* Normally the function this calls is undo-outer-limit-truncate. */ tem = call1 (Vundo_outer_limit_function, make_number (size_so_far)); @@ -394,10 +379,6 @@ truncate_undo_list (struct buffer *b) unbind_to (count, Qnil); return; } - /* That function probably used the minibuffer, and if so, that - changed last_undo_buffer. Change it back so that we don't - force next change to make an undo boundary here. */ - last_undo_buffer = temp; } if (CONSP (next)) @@ -455,6 +436,9 @@ void syms_of_undo (void) { DEFSYM (Qinhibit_read_only, "inhibit-read-only"); + DEFSYM (Qundo_auto__undoable_change, "undo-auto--undoable-change"); + DEFSYM (Qundo_auto__last_boundary_cause, "undo-auto--last-boundary-cause"); + DEFSYM (Qexplicit, "explicit"); /* Marker for function call undo list elements. */ DEFSYM (Qapply, "apply"); @@ -462,7 +446,6 @@ syms_of_undo (void) pending_boundary = Qnil; staticpro (&pending_boundary); - last_undo_buffer = NULL; last_boundary_buffer = NULL; defsubr (&Sundo_boundary); commit d2f73db50bec29724cb1324910350ad24420b174 Author: Juri Linkov Date: Thu Nov 12 22:54:01 2015 +0200 Bind [?\S-\ ] to previous line command in Dired-like modes. * lisp/arc-mode.el (archive-mode-map): * lisp/dired.el (dired-mode-map): * lisp/proced.el (proced-mode-map): * lisp/vc/vc-dir.el (vc-dir-mode-map): Bind [?\S-\ ] to previous line command. (Bug#20790) diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index cf071e2..83aadc9 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -395,6 +395,7 @@ file. Archive and member name will be added." (define-key map "o" 'archive-extract-other-window) (define-key map "p" 'archive-previous-line) (define-key map "\C-p" 'archive-previous-line) + (define-key map [?\S-\ ] 'archive-previous-line) (define-key map [up] 'archive-previous-line) (define-key map "r" 'archive-rename-entry) (define-key map "u" 'archive-unflag) diff --git a/lisp/dired.el b/lisp/dired.el index 049d45d..9ec39af 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1542,7 +1542,8 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map "<" 'dired-prev-dirline) (define-key map ">" 'dired-next-dirline) (define-key map "^" 'dired-up-directory) - (define-key map " " 'dired-next-line) + (define-key map " " 'dired-next-line) + (define-key map [?\S-\ ] 'dired-previous-line) (define-key map [remap next-line] 'dired-next-line) (define-key map [remap previous-line] 'dired-previous-line) ;; hiding diff --git a/lisp/proced.el b/lisp/proced.el index bf7ce24..502a90e 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -463,6 +463,7 @@ Important: the match ends just after the marker.") (define-key km "\C-n" 'next-line) (define-key km "\C-p" 'previous-line) (define-key km "\C-?" 'previous-line) + (define-key km [?\S-\ ] 'previous-line) (define-key km [down] 'next-line) (define-key km [up] 'previous-line) ;; marking diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 9b15e64..3b3fb68 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -271,6 +271,7 @@ See `run-hooks'." (define-key map " " 'vc-dir-next-line) (define-key map "\t" 'vc-dir-next-directory) (define-key map "p" 'vc-dir-previous-line) + (define-key map [?\S-\ ] 'vc-dir-previous-line) (define-key map [backtab] 'vc-dir-previous-directory) ;;; Rebind paragraph-movement commands. (define-key map "\M-}" 'vc-dir-next-directory) commit c1bc6e5d99e6d193c0d02116d4edeed6a0423630 Author: Eli Zaretskii Date: Thu Nov 12 22:40:31 2015 +0200 Fix the MinGW64 and Cygwin-w32 builds * src/w32fns.c (MYNOTIFYICONDATAW_V1_SIZE) (MYNOTIFYICONDATAW_V2_SIZE, MYNOTIFYICONDATAW_V3_SIZE): Define and use instead of the corresponding NOTIFYICONDATAW_Vn_SIZE macros, which cause trouble with MinGW42 headers. Ifdef away tray notifications code for Cygwin. Reported by Andy Moreton . diff --git a/src/w32fns.c b/src/w32fns.c index eed849f..b71002f 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -8756,6 +8756,8 @@ Internal use only. */) return menubar_in_use ? Qt : Qnil; } +#ifndef __CYGWIN__ + /*********************************************************************** Tray notifications ***********************************************************************/ @@ -8781,15 +8783,9 @@ typedef struct MY_NOTIFYICONDATAW { HICON hBalloonIcon; } MY_NOTIFYICONDATAW; -#ifndef NOTIFYICONDATAW_V1_SIZE -# define NOTIFYICONDATAW_V1_SIZE offsetof (MY_NOTIFYICONDATAW, szTip[64]) -#endif -#ifndef NOTIFYICONDATAW_V2_SIZE -# define NOTIFYICONDATAW_V2_SIZE offsetof (MY_NOTIFYICONDATAW, guidItem) -#endif -#ifndef NOTIFYICONDATAW_V3_SIZE -# define NOTIFYICONDATAW_V3_SIZE offsetof (MY_NOTIFYICONDATAW, hBalloonIcon) -#endif +#define MYNOTIFYICONDATAW_V1_SIZE offsetof (MY_NOTIFYICONDATAW, szTip[64]) +#define MYNOTIFYICONDATAW_V2_SIZE offsetof (MY_NOTIFYICONDATAW, guidItem) +#define MYNOTIFYICONDATAW_V3_SIZE offsetof (MY_NOTIFYICONDATAW, hBalloonIcon) #ifndef NIF_INFO # define NIF_INFO 0x00000010 #endif @@ -8901,11 +8897,11 @@ add_tray_notification (struct frame *f, const char *icon, const char *tip, if (shell_dll_version >= MAKEDLLVERULL (6, 1, 0, 0)) /* >= Windows 7 */ nidw.cbSize = sizeof (nidw); else if (shell_dll_version >= MAKEDLLVERULL (6, 0, 0, 0)) /* XP */ - nidw.cbSize = NOTIFYICONDATAW_V3_SIZE; + nidw.cbSize = MYNOTIFYICONDATAW_V3_SIZE; else if (shell_dll_version >= MAKEDLLVERULL (5, 0, 0, 0)) /* W2K */ - nidw.cbSize = NOTIFYICONDATAW_V2_SIZE; + nidw.cbSize = MYNOTIFYICONDATAW_V2_SIZE; else - nidw.cbSize = NOTIFYICONDATAW_V1_SIZE; /* < W2K */ + nidw.cbSize = MYNOTIFYICONDATAW_V1_SIZE; /* < W2K */ nidw.hWnd = FRAME_W32_WINDOW (f); nidw.uID = EMACS_TRAY_NOTIFICATION_ID; nidw.uFlags = NIF_MESSAGE | NIF_ICON | NIF_TIP | NIF_INFO; @@ -8955,7 +8951,7 @@ add_tray_notification (struct frame *f, const char *icon, const char *tip, /* Windows 9X and NT4 support only 64 characters in the Tip, later versions support up to 128. */ - if (nidw.cbSize == NOTIFYICONDATAW_V1_SIZE) + if (nidw.cbSize == MYNOTIFYICONDATAW_V1_SIZE) { tiplen = pMultiByteToWideChar (CP_UTF8, MB_ERR_INVALID_CHARS, tip, utf8_mbslen_lim (tip, 63), @@ -8980,7 +8976,7 @@ add_tray_notification (struct frame *f, const char *icon, const char *tip, wcscpy (nidw.szTip, tipw); /* The rest of the structure is only supported since Windows 2000. */ - if (nidw.cbSize > NOTIFYICONDATAW_V1_SIZE) + if (nidw.cbSize > MYNOTIFYICONDATAW_V1_SIZE) { int slen; @@ -9223,6 +9219,8 @@ DEFUN ("w32-notification-close", return Qnil; } +#endif /* !__CYGWIN__ */ + /*********************************************************************** Initialization commit 1e363a8ea5ac09455f3a44fbb646b5af32bca51c Author: Simen Heggestøyl Date: Thu Nov 12 18:30:37 2015 +0100 Enable sorting of JSON object keys when encoding * lisp/json.el (json-encoding-object-sort-predicate): New variable for specifying a sorting predicate for JSON objects during encoding. (json--plist-to-alist): New utility function. (json-encode-hash-table): Re-use `json-encode-alist' when object keys are to be sorted. (json-encode-alist): Sort output by `json-encoding-object-sort-predicate, when set. (json-encode-plist): Re-use `json-encode-alist' when object keys are to be sorted. (json-pretty-print-buffer-ordered): New command to pretty print the buffer with object keys sorted alphabetically. (json-pretty-print-ordered): New command to pretty print the region with object keys sorted alphabetically. * test/automated/json-tests.el (test-json-plist-to-alist) (test-json-encode-plist, test-json-encode-hash-table) (test-json-encode-alist-with-sort-predicate) (test-json-encode-plist-with-sort-predicate): New tests. * etc/NEWS: Add an entry for the new commands. diff --git a/etc/NEWS b/etc/NEWS index f3df92e..46910b0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -332,6 +332,10 @@ unlike `bookmark-set' which silently updates an existing bookmark. --- *** `json-pretty-print' and `json-pretty-print-buffer' now maintain the ordering of object keys by default. +--- +*** New commands `json-pretty-print-ordered' and +`json-pretty-print-buffer-ordered' pretty prints JSON objects with +object keys sorted alphabetically. ** You can recompute the VC state of a file buffer with `M-x vc-refresh-state' ** Prog mode has some support for multi-mode indentation. diff --git a/lisp/json.el b/lisp/json.el index 97cf993..0214a3e 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -52,6 +52,8 @@ ;;; Code: +(require 'map) + ;; Parameters (defvar json-object-type 'alist @@ -111,6 +113,13 @@ Used only when `json-encoding-pretty-print' is non-nil.") "If non-nil, ] and } closings will be formatted lisp-style, without indentation.") +(defvar json-encoding-object-sort-predicate nil + "Sorting predicate for JSON object keys during encoding. +If nil, no sorting is performed. Else, JSON object keys are +ordered by the specified sort predicate during encoding. For +instance, setting this to `string<' will have JSON object keys +ordered alphabetically.") + (defvar json-pre-element-read-function nil "Function called (if non-nil) by `json-read-array' and `json-read-object' right before reading a JSON array or object, @@ -159,6 +168,15 @@ Unlike `reverse', this keeps the property-value pairs intact." (push prop res))) res)) +(defun json--plist-to-alist (plist) + "Return an alist of the property-value pairs in PLIST." + (let (res) + (while plist + (let ((prop (pop plist)) + (val (pop plist))) + (push (cons prop val) res))) + (nreverse res))) + (defmacro json--with-indentation (body) `(let ((json--encoding-current-indentation (if json-encoding-pretty-print @@ -492,32 +510,39 @@ Please see the documentation of `json-object-type' and `json-key-type'." (defun json-encode-hash-table (hash-table) "Return a JSON representation of HASH-TABLE." - (format "{%s%s}" - (json-join - (let (r) - (json--with-indentation - (maphash - (lambda (k v) - (push (format - (if json-encoding-pretty-print - "%s%s: %s" - "%s%s:%s") - json--encoding-current-indentation - (json-encode-key k) - (json-encode v)) - r)) - hash-table)) - r) - json-encoding-separator) - (if (or (not json-encoding-pretty-print) - json-encoding-lisp-style-closings) - "" - json--encoding-current-indentation))) + (if json-encoding-object-sort-predicate + (json-encode-alist (map-into hash-table 'list)) + (format "{%s%s}" + (json-join + (let (r) + (json--with-indentation + (maphash + (lambda (k v) + (push (format + (if json-encoding-pretty-print + "%s%s: %s" + "%s%s:%s") + json--encoding-current-indentation + (json-encode-key k) + (json-encode v)) + r)) + hash-table)) + r) + json-encoding-separator) + (if (or (not json-encoding-pretty-print) + json-encoding-lisp-style-closings) + "" + json--encoding-current-indentation)))) ;; List encoding (including alists and plists) (defun json-encode-alist (alist) "Return a JSON representation of ALIST." + (when json-encoding-object-sort-predicate + (setq alist + (sort alist (lambda (a b) + (funcall json-encoding-object-sort-predicate + (car a) (car b)))))) (format "{%s%s}" (json-join (json--with-indentation @@ -537,25 +562,27 @@ Please see the documentation of `json-object-type' and `json-key-type'." (defun json-encode-plist (plist) "Return a JSON representation of PLIST." - (let (result) - (json--with-indentation - (while plist - (push (concat - json--encoding-current-indentation - (json-encode-key (car plist)) - (if json-encoding-pretty-print - ": " - ":") - (json-encode (cadr plist))) - result) - (setq plist (cddr plist)))) - (concat "{" - (json-join (nreverse result) json-encoding-separator) - (if (and json-encoding-pretty-print - (not json-encoding-lisp-style-closings)) + (if json-encoding-object-sort-predicate + (json-encode-alist (json--plist-to-alist plist)) + (let (result) + (json--with-indentation + (while plist + (push (concat json--encoding-current-indentation - "") - "}"))) + (json-encode-key (car plist)) + (if json-encoding-pretty-print + ": " + ":") + (json-encode (cadr plist))) + result) + (setq plist (cddr plist)))) + (concat "{" + (json-join (nreverse result) json-encoding-separator) + (if (and json-encoding-pretty-print + (not json-encoding-lisp-style-closings)) + json--encoding-current-indentation + "") + "}")))) (defun json-encode-list (list) "Return a JSON representation of LIST. @@ -698,6 +725,18 @@ Advances point just past JSON object." (txt (delete-and-extract-region begin end))) (insert (json-encode (json-read-from-string txt)))))) +(defun json-pretty-print-buffer-ordered () + "Pretty-print current buffer with object keys ordered." + (interactive) + (let ((json-encoding-object-sort-predicate 'string<)) + (json-pretty-print-buffer))) + +(defun json-pretty-print-ordered (begin end) + "Pretty-print the region with object keys ordered." + (interactive "r") + (let ((json-encoding-object-sort-predicate 'string<)) + (json-pretty-print begin end))) + (provide 'json) ;;; json.el ends here diff --git a/test/automated/json-tests.el b/test/automated/json-tests.el index fa1f548..8f0cd6f 100644 --- a/test/automated/json-tests.el +++ b/test/automated/json-tests.el @@ -28,11 +28,40 @@ (should (equal (json--plist-reverse '(:a 1 :b 2 :c 3)) '(:c 3 :b 2 :a 1)))) +(ert-deftest test-json-plist-to-alist () + (should (equal (json--plist-to-alist '()) '())) + (should (equal (json--plist-to-alist '(:a 1)) '((:a . 1)))) + (should (equal (json--plist-to-alist '(:a 1 :b 2 :c 3)) + '((:a . 1) (:b . 2) (:c . 3))))) + +(ert-deftest test-json-encode-plist () + (let ((plist '(:a 1 :b 2))) + (should (equal (json-encode plist) "{\"a\":1,\"b\":2}")))) + (ert-deftest json-encode-simple-alist () (should (equal (json-encode '((a . 1) (b . 2))) "{\"a\":1,\"b\":2}"))) +(ert-deftest test-json-encode-hash-table () + (let ((hash-table (make-hash-table)) + (json-encoding-object-sort-predicate 'string<)) + (puthash :a 1 hash-table) + (puthash :b 2 hash-table) + (puthash :c 3 hash-table) + (should (equal (json-encode hash-table) + "{\"a\":1,\"b\":2,\"c\":3}")))) + +(ert-deftest test-json-encode-alist-with-sort-predicate () + (let ((alist '((:c . 3) (:a . 1) (:b . 2))) + (json-encoding-object-sort-predicate 'string<)) + (should (equal (json-encode alist) "{\"a\":1,\"b\":2,\"c\":3}")))) + +(ert-deftest test-json-encode-plist-with-sort-predicate () + (let ((plist '(:c 3 :a 1 :b 2)) + (json-encoding-object-sort-predicate 'string<)) + (should (equal (json-encode plist) "{\"a\":1,\"b\":2,\"c\":3}")))) + (ert-deftest json-read-simple-alist () (let ((json-object-type 'alist)) (should (equal (json-read-from-string "{\"a\": 1, \"b\": 2}") commit 9dd7da9945c16aa343080a535ed74eeecf769fd1 Author: Juanma Barranquero Date: Thu Nov 12 17:54:48 2015 +0100 * test/automated/keymap-tests.el: New test file diff --git a/test/automated/keymap-tests.el b/test/automated/keymap-tests.el new file mode 100644 index 0000000..482ed27 --- /dev/null +++ b/test/automated/keymap-tests.el @@ -0,0 +1,39 @@ +;;; keymap-tests.el --- Test suite for src/keymap.c + +;; Copyright (C) 2015 Free Software Foundation, Inc. + +;; Author: Juanma Barranquero + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) + +(ert-deftest keymap-store_in_keymap-FASTINT-on-nonchars () + "Check for bug fixed in \"Fix assertion violation in define-key\", +commit 86c19714b097aa477d339ed99ffb5136c755a046." + (should-not (eq (lookup-key Buffer-menu-mode-map [32]) 'undefined)) + ;; This will cause an assertion violation if the bug is present. + ;; We could run an inferior Emacs process and check for the return + ;; status, but in some environments an assertion failure triggers + ;; an abort dialog that requires user intervention anyway. + (define-key Buffer-menu-mode-map [(32 . 126)] 'undefined) + (should (eq (lookup-key Buffer-menu-mode-map [32]) 'undefined))) + +(provide 'keymap-tests) + +;;; keymap-tests.el ends here