commit 1daac66a6eedbcbfa32ab920b5c579872d989517 (HEAD, refs/remotes/origin/master) Author: Alan Third Date: Sun Dec 24 15:40:03 2017 +0000 Add macOS character-palette (bug#29837) * lisp/ns-win.el (ns-do-show-character-palette): New function. * src/nsfns.m (Sns_show_character_palette): New function. * src/nsterm.m (EmacsView::insertText): Handle NSAttributedString. diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index c9534b7bb8..aa3113bd34 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -144,6 +144,8 @@ The properties returned may include `top', `left', `height', and `width'." (define-key global-map [?\s-z] 'undo) (define-key global-map [?\s-|] 'shell-command-on-region) (define-key global-map [s-kp-bar] 'shell-command-on-region) +(define-key global-map [C-s- ] 'ns-do-show-character-palette) +(define-key key-translation-map [C-s-268632064] [C-s- ]) ;; (as in Terminal.app) (define-key global-map [s-right] 'ns-next-frame) (define-key global-map [s-left] 'ns-prev-frame) @@ -575,6 +577,12 @@ the last file dropped is selected." (interactive) (ns-emacs-info-panel)) +(declare-function ns-show-character-palette "nsfns.m" ()) + +(defun ns-do-show-character-palette () + (interactive) + (ns-show-character-palette)) + (defun ns-next-frame () "Switch to next visible frame." (interactive) diff --git a/src/nsfns.m b/src/nsfns.m index 3ede63f985..c8b3024626 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -3135,6 +3135,19 @@ The position is returned as a cons cell (X . Y) of the (pt.y - screen.frame.origin.y))); } +DEFUN ("ns-show-character-palette", + Fns_show_character_palette, + Sns_show_character_palette, 0, 0, 0, + doc: /* Show the macOS character palette. */) + (void) +{ + struct frame *f = SELECTED_FRAME (); + EmacsView *view = FRAME_NS_VIEW (f); + [NSApp orderFrontCharacterPalette:view]; + + return Qnil; +} + /* ========================================================================== Class implementations @@ -3326,6 +3339,7 @@ - (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename defsubr (&Sns_frame_restack); defsubr (&Sns_set_mouse_absolute_pixel_position); defsubr (&Sns_mouse_absolute_pixel_position); + defsubr (&Sns_show_character_palette); defsubr (&Sx_display_mm_width); defsubr (&Sx_display_mm_height); defsubr (&Sx_display_screens); diff --git a/src/nsterm.m b/src/nsterm.m index 3f59e33c7b..b80d832ee0 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -6283,11 +6283,18 @@ flag set (this is probably a bug in the OS). by doCommandBySelector: deleteBackward: */ - (void)insertText: (id)aString { - NSString *s = aString; - NSUInteger len = [s length]; + NSString *s; + NSUInteger len; NSTRACE ("[EmacsView insertText:]"); + if ([aString isKindOfClass:[NSAttributedString class]]) + s = [aString string]; + else + s = aString; + + len = [s length]; + if (NS_KEYLOG) NSLog (@"insertText '%@'\tlen = %lu", aString, (unsigned long) len); processingCompose = NO; commit 9a220bbd94f427279dd1130f9fe6524f8a012ef2 Author: Alan Third Date: Mon Jan 1 15:44:24 2018 +0000 Fix build issues on macOS (bug#29931) * configure.ac: On darwin add check for Homebrew texinfo install, and fix incorrect quoting of libxml2 includes. diff --git a/configure.ac b/configure.ac index 4c2644b11d..c574d7dd0d 100644 --- a/configure.ac +++ b/configure.ac @@ -1267,6 +1267,14 @@ esac AC_SUBST([PAXCTL_dumped]) AC_SUBST([PAXCTL_notdumped]) +# Makeinfo on macOS is ancient, check whether there is a more recent +# version installed by Homebrew. +AC_CHECK_PROG(HAVE_BREW, [brew], [yes]) +if test -n "$HAVE_BREW"; then + AC_PATH_PROG([MAKEINFO], [makeinfo], [], + [`brew --prefix texinfo 2>/dev/null`/bin$PATH_SEPARATOR$PATH]) +fi + ## Require makeinfo >= 4.13 (last of the 4.x series) to build the manuals. if test "${MAKEINFO:=makeinfo}" != "no"; then case `($MAKEINFO --version) 2>/dev/null` in @@ -3881,13 +3889,13 @@ if test "${with_xml2}" != "no"; then xcsdkdir="" ;; esac fi - CPPFLAGS="$CPPFLAGS -I$xcsdkdir/usr/include/libxml2" + CPPFLAGS="$CPPFLAGS -isystem${xcsdkdir}/usr/include/libxml2" AC_CHECK_HEADER(libxml/HTMLparser.h, [AC_CHECK_DECL(HTML_PARSE_RECOVER, HAVE_LIBXML2=yes, , [#include ])]) CPPFLAGS="$SAVE_CPPFLAGS" if test "${HAVE_LIBXML2}" = "yes"; then - LIBXML2_CFLAGS="-I'$xcsdkdir/usr/include/libxml2'" + LIBXML2_CFLAGS="-isystem${xcsdkdir}/usr/include/libxml2" LIBXML2_LIBS="-lxml2" fi fi commit 703ac3ea1c1ce381f385469a0e88bc29d3fe83c2 Author: Philipp Stephani Date: Mon Dec 25 22:00:00 2017 +0100 Allow inserting non-BMP characters * src/coding.h (UTF_16_HIGH_SURROGATE_P, UTF_16_LOW_SURROGATE_P): Move from coding.c and document. (surrogates_to_codepoint): New function. * src/nsterm.m (insertText:): Properly handle surrogate pairs. diff --git a/src/coding.c b/src/coding.c index d8bc525026..da62540344 100644 --- a/src/coding.c +++ b/src/coding.c @@ -1515,13 +1515,6 @@ encode_coding_utf_8 (struct coding_system *coding) /* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions". Return true if a text is encoded in one of UTF-16 based coding systems. */ -#define UTF_16_HIGH_SURROGATE_P(val) \ - (((val) & 0xFC00) == 0xD800) - -#define UTF_16_LOW_SURROGATE_P(val) \ - (((val) & 0xFC00) == 0xDC00) - - static bool detect_coding_utf_16 (struct coding_system *coding, struct coding_detection_info *detect_info) diff --git a/src/coding.h b/src/coding.h index 54100ccd31..d90b799d76 100644 --- a/src/coding.h +++ b/src/coding.h @@ -662,6 +662,30 @@ struct coding_system /* Note that this encodes utf-8, not utf-8-emacs, so it's not a no-op. */ #define ENCODE_UTF_8(str) code_convert_string_norecord (str, Qutf_8, true) +/* Return true if VAL is a high surrogate. VAL must be a 16-bit code + unit. */ + +#define UTF_16_HIGH_SURROGATE_P(val) \ + (((val) & 0xFC00) == 0xD800) + +/* Return true if VAL is a low surrogate. VAL must be a 16-bit code + unit. */ + +#define UTF_16_LOW_SURROGATE_P(val) \ + (((val) & 0xFC00) == 0xDC00) + +/* Return the Unicode code point for the given UTF-16 surrogates. */ + +INLINE int +surrogates_to_codepoint (int low, int high) +{ + eassert (0 <= low && low <= 0xFFFF); + eassert (0 <= high && high <= 0xFFFF); + eassert (UTF_16_LOW_SURROGATE_P (low)); + eassert (UTF_16_HIGH_SURROGATE_P (high)); + return 0x10000 + (low - 0xDC00) + ((high - 0xD800) * 0x400); +} + /* Extern declarations. */ extern Lisp_Object code_conversion_save (bool, bool); extern bool encode_coding_utf_8 (struct coding_system *); diff --git a/src/nsterm.m b/src/nsterm.m index dd5c7d91ea..3f59e33c7b 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -6283,14 +6283,13 @@ flag set (this is probably a bug in the OS). by doCommandBySelector: deleteBackward: */ - (void)insertText: (id)aString { - int code; - int len = [(NSString *)aString length]; - int i; + NSString *s = aString; + NSUInteger len = [s length]; NSTRACE ("[EmacsView insertText:]"); if (NS_KEYLOG) - NSLog (@"insertText '%@'\tlen = %d", aString, len); + NSLog (@"insertText '%@'\tlen = %lu", aString, (unsigned long) len); processingCompose = NO; if (!emacs_event) @@ -6300,10 +6299,24 @@ - (void)insertText: (id)aString if (workingText != nil) [self deleteWorkingText]; + /* It might be preferable to use getCharacters:range: below, + cf. https://developer.apple.com/library/content/documentation/Cocoa/Conceptual/CocoaPerformance/Articles/StringDrawing.html#//apple_ref/doc/uid/TP40001445-112378. + However, we probably can't use SAFE_NALLOCA here because it might + exit nonlocally. */ + /* now insert the string as keystrokes */ - for (i =0; i Date: Sun Jan 7 18:50:06 2018 +0100 Make tramp-tests.el more robust on w32 * test/lisp/net/tramp-tests.el (tramp-test21-file-links): Do not call `make-symbolic-link' on w32. (tramp-test36-find-backup-file-name): Call also `convert-standard-filename' due to w32. (tramp--test-windows-nt): New defun. (tramp-test42-auto-load, tramp-test42-delay-load) (tramp-test42-recursive-load, tramp-test42-remote-load-path): Quote command due to w32. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index ec7e25247c..24dfee5513 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2760,9 +2760,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (file-symlink-p tmp-name2))) ;; `tmp-name3' is a local file name. Therefore, the link ;; target remains unchanged, even if quoted. - (make-symbolic-link tmp-name1 tmp-name3) - (should - (string-equal tmp-name1 (file-symlink-p tmp-name3))) + ;; `make-symbolic-link' might not be permitted on w32 systems. + (unless (tramp--test-windows-nt) + (make-symbolic-link tmp-name1 tmp-name3) + (should + (string-equal tmp-name1 (file-symlink-p tmp-name3)))) ;; Check directory as newname. (make-directory tmp-name4) (should-error @@ -2864,15 +2866,17 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (tramp-compat-file-name-quote (concat (file-remote-p tmp-name2) "/penguin:motd:")))) ;; `tmp-name3' is a local file name. - (make-symbolic-link tmp-name1 tmp-name3) - (should (file-symlink-p tmp-name3)) - (should-not (string-equal tmp-name3 (file-truename tmp-name3))) - ;; `file-truename' returns a quoted file name for `tmp-name3'. - ;; We must unquote it. - (should - (string-equal - (tramp-compat-file-name-unquote (file-truename tmp-name1)) - (tramp-compat-file-name-unquote (file-truename tmp-name3))))) + ;; `make-symbolic-link' might not be permitted on w32 systems. + (unless (tramp--test-windows-nt) + (make-symbolic-link tmp-name1 tmp-name3) + (should (file-symlink-p tmp-name3)) + (should-not (string-equal tmp-name3 (file-truename tmp-name3))) + ;; `file-truename' returns a quoted file name for `tmp-name3'. + ;; We must unquote it. + (should + (string-equal + (tramp-compat-file-name-unquote (file-truename tmp-name1)) + (tramp-compat-file-name-unquote (file-truename tmp-name3)))))) ;; Cleanup. (ignore-errors @@ -3961,9 +3965,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (expand-file-name (format "%s~" - ;; This is taken from `make-backup-file-name-1'. + ;; This is taken from `make-backup-file-name-1'. We + ;; call `convert-standard-filename', because on MS + ;; Windows the (local) colons must be replaced by + ;; exclamation marks. (subst-char-in-string - ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1))) + ?/ ?! + (replace-regexp-in-string + "!" "!!" (convert-standard-filename tmp-name1)))) tmp-name2))))) ;; The backup directory is created. (should (file-directory-p tmp-name2))) @@ -3984,9 +3993,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (expand-file-name (format "%s~" - ;; This is taken from `make-backup-file-name-1'. + ;; This is taken from `make-backup-file-name-1'. We + ;; call `convert-standard-filename', because on MS + ;; Windows the (local) colons must be replaced by + ;; exclamation marks. (subst-char-in-string - ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1))) + ?/ ?! + (replace-regexp-in-string + "!" "!!" (convert-standard-filename tmp-name1)))) tmp-name2))))) ;; The backup directory is created. (should (file-directory-p tmp-name2))) @@ -4008,9 +4022,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (expand-file-name (format "%s~" - ;; This is taken from `make-backup-file-name-1'. + ;; This is taken from `make-backup-file-name-1'. We + ;; call `convert-standard-filename', because on MS + ;; Windows the (local) colons must be replaced by + ;; exclamation marks. (subst-char-in-string - ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1))) + ?/ ?! + (replace-regexp-in-string + "!" "!!" (convert-standard-filename tmp-name1)))) tmp-name2))))) ;; The backup directory is created. (should (file-directory-p tmp-name2))) @@ -4116,6 +4135,10 @@ This does not support special file names." (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) 'tramp-sh-file-name-handler)) +(defun tramp--test-windows-nt () + "Check, whether the locale host runs MS Windows." + (eq system-type 'windows-nt)) + (defun tramp--test-windows-nt-and-batch () "Check, whether the locale host runs MS Windows in batch mode. This does not support special characters." @@ -4706,7 +4729,8 @@ process sentinels. They shall not disturb each other." (shell-command-to-string (format "%s -batch -Q -L %s --eval %s" - (expand-file-name invocation-name invocation-directory) + (shell-quote-argument + (expand-file-name invocation-name invocation-directory)) (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) @@ -4738,7 +4762,8 @@ process sentinels. They shall not disturb each other." (shell-command-to-string (format "%s -batch -Q -L %s --eval %s" - (expand-file-name invocation-name invocation-directory) + (shell-quote-argument + (expand-file-name invocation-name invocation-directory)) (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument (format code tm))))))))) @@ -4761,7 +4786,8 @@ process sentinels. They shall not disturb each other." (shell-command-to-string (format "%s -batch -Q -L %s --eval %s" - (expand-file-name invocation-name invocation-directory) + (shell-quote-argument + (expand-file-name invocation-name invocation-directory)) (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument code)))))))) @@ -4788,7 +4814,8 @@ process sentinels. They shall not disturb each other." (shell-command-to-string (format "%s -batch -Q -L %s -l tramp-sh --eval %s" - (expand-file-name invocation-name invocation-directory) + (shell-quote-argument + (expand-file-name invocation-name invocation-directory)) (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) commit f352ea6efd4554cee95568cee72a3dfa00de2abe Author: Philipp Stephani Date: Sun Jan 7 16:47:17 2018 +0100 ; Adapt a unit test to a recent change * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--old-style-backquotes): Fix expected error message. diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 20ac948c35..6ae7cdb9f9 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -540,8 +540,7 @@ literals (Bug#20852)." (let* ((byte-compile-dest-file-function (lambda (_) destination)) (byte-compile-debug t) (err (should-error (byte-compile-file source)))) - (should (equal (cdr err) - '("Loading `nil': old-style backquotes detected!"))))))) + (should (equal (cdr err) '("Old-style backquotes detected!"))))))) (ert-deftest bytecomp-tests-function-put () commit 73526123f2293f1b83fe51d6e30676f84c95c7b6 Author: Philipp Stephani Date: Sun Jan 7 16:44:45 2018 +0100 Remove incorrect use of AUTO_STRING * src/lread.c (load_error_old_style_backquotes): Remove incorrect use of AUTO_STRING. diff --git a/src/lread.c b/src/lread.c index bcf3b7f55c..28d4bf9a4f 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1007,10 +1007,7 @@ static _Noreturn void load_error_old_style_backquotes (void) { if (NILP (Vload_file_name)) - { - AUTO_STRING (message, "Old-style backquotes detected!"); - xsignal1 (Qerror, message); - } + xsignal1 (Qerror, build_string ("Old-style backquotes detected!")); else { AUTO_STRING (format, "Loading `%s': old-style backquotes detected!"); commit bfca19e475c01f13dbacc7f8b7bb1aecf46cb7e4 Author: Tino Calancha Date: Mon Jan 8 00:33:13 2018 +0900 cl-loop: Calculate the array length just once * lisp/emacs-lisp/cl-macs.el (cl--parse-loop-clause): Dont calculate the array length on each iteration (Bug#29866). diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 16f33282ba..9af014cf8e 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -1317,11 +1317,13 @@ For more details, see Info node `(cl)Loop Facility'. ((memq word '(across across-ref)) (let ((temp-vec (make-symbol "--cl-vec--")) + (temp-len (make-symbol "--cl-len--")) (temp-idx (make-symbol "--cl-idx--"))) (push (list temp-vec (pop cl--loop-args)) loop-for-bindings) + (push (list temp-len `(length ,temp-vec)) loop-for-bindings) (push (list temp-idx -1) loop-for-bindings) (push `(< (setq ,temp-idx (1+ ,temp-idx)) - (length ,temp-vec)) + ,temp-len) cl--loop-body) (if (eq word 'across-ref) (push (list var `(aref ,temp-vec ,temp-idx)) @@ -1336,6 +1338,7 @@ For more details, see Info node `(cl)Loop Facility'. (error "Expected `of'")))) (seq (cl--pop2 cl--loop-args)) (temp-seq (make-symbol "--cl-seq--")) + (temp-len (make-symbol "--cl-len--")) (temp-idx (if (eq (car cl--loop-args) 'using) (if (and (= (length (cadr cl--loop-args)) 2) @@ -1346,16 +1349,19 @@ For more details, see Info node `(cl)Loop Facility'. (push (list temp-seq seq) loop-for-bindings) (push (list temp-idx 0) loop-for-bindings) (if ref - (let ((temp-len (make-symbol "--cl-len--"))) + (progn (push (list temp-len `(length ,temp-seq)) loop-for-bindings) (push (list var `(elt ,temp-seq ,temp-idx)) cl--loop-symbol-macs) (push `(< ,temp-idx ,temp-len) cl--loop-body)) + ;; Evaluate seq length just if needed, that is, when seq is not a cons. + (push (list temp-len (or (consp seq) `(length ,temp-seq))) + loop-for-bindings) (push (list var nil) loop-for-bindings) (push `(and ,temp-seq (or (consp ,temp-seq) - (< ,temp-idx (length ,temp-seq)))) + (< ,temp-idx ,temp-len))) cl--loop-body) (push (list var `(if (consp ,temp-seq) (pop ,temp-seq) commit 378be8df8d9075719437c475fbb520dd40d2353b Author: Philipp Stephani Date: Fri Dec 29 21:58:07 2017 +0100 Improve error message for old-style backquotes * src/lread.c (load_error_old_style_backquotes): Improve error message if no file is being loaded. * test/src/lread-tests.el (lread-tests--force-new-style-backquotes): Adapt test. diff --git a/src/lread.c b/src/lread.c index d675b56391..bcf3b7f55c 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1006,8 +1006,16 @@ load_error_handler (Lisp_Object data) static _Noreturn void load_error_old_style_backquotes (void) { - AUTO_STRING (format, "Loading `%s': old-style backquotes detected!"); - xsignal1 (Qerror, CALLN (Fformat_message, format, Vload_file_name)); + if (NILP (Vload_file_name)) + { + AUTO_STRING (message, "Old-style backquotes detected!"); + xsignal1 (Qerror, message); + } + else + { + AUTO_STRING (format, "Loading `%s': old-style backquotes detected!"); + xsignal1 (Qerror, CALLN (Fformat_message, format, Vload_file_name)); + } } static void diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 693c6c09bf..daf5343881 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -183,8 +183,7 @@ literals (Bug#20852)." (ert-deftest lread-tests--force-new-style-backquotes () (let ((data (should-error (read "(` (a b))")))) - (should (equal (cdr data) - '("Loading `nil': old-style backquotes detected!")))) + (should (equal (cdr data) '("Old-style backquotes detected!")))) (should (equal (let ((force-new-style-backquotes t)) (read "(` (a b))")) '(`(a b))))) commit ddb74b2027802ab4416bd8cdb1757a209dd7a63b Author: Philipp Stephani Date: Fri Dec 29 21:50:55 2017 +0100 Add new variable to force new-style backquote interpretation. * src/lread.c (syms_of_lread): Add new variable 'force-new-style-backquotes'. (read_internal_start): Use it. * test/src/lread-tests.el (lread-tests--force-new-style-backquotes): New test. * etc/NEWS: Document new variable. diff --git a/etc/NEWS b/etc/NEWS index c5a4bc3344..f6f36dfc85 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -188,7 +188,8 @@ support, you should set 'eldoc-documentation-function' instead of calling 'eldoc-message' directly. ** Old-style backquotes now generate an error. They have been -generating warnings for a decade. +generating warnings for a decade. To interpret old-style backquotes +as new-style, bind the new variable 'force-new-style-backquotes' to t. * Lisp Changes in Emacs 27.1 diff --git a/src/lread.c b/src/lread.c index da40e99a5e..d675b56391 100644 --- a/src/lread.c +++ b/src/lread.c @@ -147,10 +147,10 @@ static ptrdiff_t prev_saved_doc_string_length; /* This is the file position that string came from. */ static file_offset prev_saved_doc_string_position; -/* True means inside a new-style backquote - with no surrounding parentheses. - Fread initializes this to false, so we need not specbind it - or worry about what happens to it when there is an error. */ +/* True means inside a new-style backquote with no surrounding + parentheses. Fread initializes this to the value of + `force_new_style_backquotes', so we need not specbind it or worry + about what happens to it when there is an error. */ static bool new_backquote_flag; /* A list of file names for files being loaded in Fload. Used to @@ -2187,7 +2187,7 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end) Lisp_Object retval; readchar_count = 0; - new_backquote_flag = 0; + new_backquote_flag = force_new_style_backquotes; /* We can get called from readevalloop which may have set these already. */ if (! HASH_TABLE_P (read_objects_map) @@ -5006,6 +5006,17 @@ Note that if you customize this, obviously it will not affect files that are loaded before your customizations are read! */); load_prefer_newer = 0; + DEFVAR_BOOL ("force-new-style-backquotes", force_new_style_backquotes, + doc: /* Non-nil means to always use the current syntax for backquotes. +If nil, `load' and `read' raise errors when encountering some +old-style variants of backquote and comma. If non-nil, these +constructs are always interpreted as described in the Info node +`(elisp)Backquotes', even if that interpretation is incompatible with +previous versions of Emacs. Setting this variable to non-nil makes +Emacs compatible with the behavior planned for Emacs 28. In Emacs 28, +this variable will become obsolete. */); + force_new_style_backquotes = false; + /* Vsource_directory was initialized in init_lread. */ DEFSYM (Qcurrent_load_list, "current-load-list"); diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index e2d4eaa63c..693c6c09bf 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -181,6 +181,14 @@ literals (Bug#20852)." (list (concat (format-message "Loading `%s': " file-name) "old-style backquotes detected!"))))))) +(ert-deftest lread-tests--force-new-style-backquotes () + (let ((data (should-error (read "(` (a b))")))) + (should (equal (cdr data) + '("Loading `nil': old-style backquotes detected!")))) + (should (equal (let ((force-new-style-backquotes t)) + (read "(` (a b))")) + '(`(a b))))) + (ert-deftest lread-lread--substitute-object-in-subtree () (let ((x (cons 0 1))) (setcar x x) commit 610dad1102cba5fa6111050d30c734b51bcdb77d Author: Philipp Stephani Date: Sun Jan 7 14:14:38 2018 +0100 Revert "Prevent name clashes between CL structures and builtin types" This reverts commit 151496a4b96430924bc148f85b9c8471d1e132b1. That commit breaks bootstrap builds due to a cyclic dependency. diff --git a/etc/NEWS b/etc/NEWS index 4eb620105a..c5a4bc3344 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -190,10 +190,6 @@ calling 'eldoc-message' directly. ** Old-style backquotes now generate an error. They have been generating warnings for a decade. -** Defining a Common Lisp structure using 'cl-defstruct' or -'cl-struct-define' whose name clashes with a builtin type (e.g., -'integer' or 'hash-table') now signals an error. - * Lisp Changes in Emacs 27.1 diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 05cb9b091d..16f33282ba 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -43,7 +43,6 @@ ;;; Code: -(require 'cl-generic) (require 'cl-lib) (require 'macroexp) ;; `gv' is required here because cl-macs can be loaded before loaddefs.el. @@ -2664,9 +2663,6 @@ non-nil value, that slot cannot be set via `setf'. (forms nil) (docstring (if (stringp (car descs)) (pop descs))) pred-form pred-check) - ;; Can't use `cl-check-type' yet. - (unless (cl--struct-name-p name) - (signal 'wrong-type-argument (list 'cl-struct-name-p name 'name))) (setq descs (cons '(cl-tag-slot) (mapcar (function (lambda (x) (if (consp x) x (list x)))) descs))) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 33a1438f69..4e73a4a31b 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -36,7 +36,6 @@ ;;; Code: -(eval-when-compile (require 'cl-generic)) (eval-when-compile (require 'cl-lib)) (eval-when-compile (require 'cl-macs)) ;For cl--struct-class. @@ -51,12 +50,6 @@ (apply #'error string (append sargs args)) (signal 'cl-assertion-failed `(,form ,@sargs))))) -(defun cl--struct-name-p (name) - "Return t if NAME is a valid structure name for `cl-defstruct'." - (and name (symbolp name) (not (keywordp name)) - (not (memq name (eval-when-compile cl--generic-all-builtin-types))) - t)) - ;; When we load this (compiled) file during pre-loading, the cl--struct-class ;; code below will need to access the `cl-struct' info, since it's considered ;; already as its parent (because `cl-struct' was defined while the file was @@ -117,7 +110,6 @@ ;;;###autoload (defun cl-struct-define (name docstring parent type named slots children-sym tag print) - (cl-check-type name cl--struct-name) (unless type ;; Legacy defstruct, using tagged vectors. Enable backward compatibility. (cl-old-struct-compat-mode 1)) diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index 9236ac73b5..f0bde7af39 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -497,13 +497,4 @@ collection clause." vconcat (vector (1+ x))) [2 3 4 5 6]))) - -(ert-deftest cl-defstruct/builtin-type () - (should-error - (macroexpand '(cl-defstruct hash-table)) - :type 'wrong-type-argument) - (should-error - (macroexpand '(cl-defstruct (hash-table (:predicate hash-table-p)))) - :type 'wrong-type-argument)) - ;;; cl-macs-tests.el ends here diff --git a/test/lisp/emacs-lisp/cl-preloaded-tests.el b/test/lisp/emacs-lisp/cl-preloaded-tests.el deleted file mode 100644 index 008a6e629f..0000000000 --- a/test/lisp/emacs-lisp/cl-preloaded-tests.el +++ /dev/null @@ -1,33 +0,0 @@ -;;; cl-preloaded-tests.el --- unit tests for cl-preloaded.el -*- lexical-binding: t; -*- - -;; Copyright (C) 2017 Free Software Foundation, Inc. -;; Author: Philipp Stephani - -;; This file is part of GNU Emacs. - -;; This program 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. - -;; This program 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 this program. If not, see . - -;;; Commentary: - -;; Unit tests for lisp/emacs-lisp/cl-preloaded.el. - -;;; Code: - -(ert-deftest cl-struct-define/builtin-type () - (should-error - (cl-struct-define 'hash-table nil nil 'record nil nil - 'cl-preloaded-tests-tag 'cl-preloaded-tests nil) - :type 'wrong-type-argument)) - -;;; cl-preloaded-tests.el ends here commit 6735df4443fe0aa60862a95c38746edf2b053862 Author: Philipp Stephani Date: Sun Dec 31 17:43:43 2017 +0100 Ignore escape characters for context-sensitive quotes (Bug#29812) * lisp/electric.el (electric-quote-post-self-insert-function): Skip over escape characters when determining whether a context-sensitive quote should be opening or closing. * test/lisp/electric-tests.el (electric-quote-replace-double-escaped-open) (electric-quote-replace-double-escaped-close): New unit tests. diff --git a/lisp/electric.el b/lisp/electric.el index 8343d8c1b1..c00e7c00a5 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -505,6 +505,7 @@ This requotes when a quoting key is typed." (eq last-command-event ?\"))) (save-excursion (backward-char) + (skip-syntax-backward "\\") (or (bobp) (bolp) (memq (char-before) (list q< q<<)) (memq (char-syntax (char-before)) diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el index 44bdbc7b8c..60191bfbba 100644 --- a/test/lisp/electric-tests.el +++ b/test/lisp/electric-tests.el @@ -742,6 +742,24 @@ baz\"\"" :bindings '((electric-quote-replace-double . t)) :test-in-comments nil :test-in-strings nil) +(define-electric-pair-test electric-quote-replace-double-escaped-open + "foo \\" "-----\"" :expected-string "foo \\“" + :expected-point 7 :modes '(emacs-lisp-mode c-mode) + :fixture-fn #'electric-quote-local-mode + :bindings '((electric-quote-replace-double . t) + (electric-quote-comment . t) + (electric-quote-string . t)) + :test-in-comments t :test-in-strings t :test-in-code nil) + +(define-electric-pair-test electric-quote-replace-double-escaped-close + "foo \\“foo\\" "----------\"" :expected-string "foo \\“foo\\”" + :expected-point 12 :modes '(emacs-lisp-mode c-mode) + :fixture-fn #'electric-quote-local-mode + :bindings '((electric-quote-replace-double . t) + (electric-quote-comment . t) + (electric-quote-string . t)) + :test-in-comments t :test-in-strings t :test-in-code nil) + ;; Simulate ‘markdown-mode’: it sets both ‘comment-start’ and ;; ‘comment-use-syntax’, but derives from ‘text-mode’. (define-electric-pair-test electric-quote-markdown-in-text commit f07c325d1f49e4b722f76aa730ac5d084bd0e77a Author: Philipp Stephani Date: Sun Dec 31 18:05:03 2017 +0100 Fix a small bug in electric quoting. Before this commit, if 'electric-quote-replace-double' is non-nil, typing " '" turned into " ‘" even if 'electric-quote-context-sensitive' was nil. * lisp/electric.el (electric-quote-post-self-insert-function): Insert context-sensitive double quote only if the last character is actually a double quote character. * test/lisp/electric-tests.el (electric-quote-replace-double-no-context-single): New unit test. diff --git a/lisp/electric.el b/lisp/electric.el index a694665dbb..8343d8c1b1 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -501,7 +501,8 @@ This requotes when a quoting key is typed." (let ((backtick ?\`)) (if (or (eq last-command-event ?\`) (and (or electric-quote-context-sensitive - electric-quote-replace-double) + (and electric-quote-replace-double + (eq last-command-event ?\"))) (save-excursion (backward-char) (or (bobp) (bolp) diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el index 83e0c678e3..44bdbc7b8c 100644 --- a/test/lisp/electric-tests.el +++ b/test/lisp/electric-tests.el @@ -735,6 +735,13 @@ baz\"\"" :bindings '((electric-quote-replace-double . t)) :test-in-comments nil :test-in-strings nil) +(define-electric-pair-test electric-quote-replace-double-no-context-single + " " "-'" :expected-string " ’" :expected-point 3 + :modes '(text-mode) + :fixture-fn #'electric-quote-local-mode + :bindings '((electric-quote-replace-double . t)) + :test-in-comments nil :test-in-strings nil) + ;; Simulate ‘markdown-mode’: it sets both ‘comment-start’ and ;; ‘comment-use-syntax’, but derives from ‘text-mode’. (define-electric-pair-test electric-quote-markdown-in-text commit 151496a4b96430924bc148f85b9c8471d1e132b1 Author: Philipp Stephani Date: Thu Dec 21 18:25:49 2017 +0100 Prevent name clashes between CL structures and builtin types * lisp/emacs-lisp/cl-preloaded.el (cl-struct-define): Don't allow structures with the same names as builtin types. (cl--struct-name-p): New helper function. * lisp/emacs-lisp/cl-macs.el (cl-defstruct): Don't allow structures with the same names as builtin types. * test/lisp/emacs-lisp/cl-macs-tests.el (cl-defstruct/builtin-type): * test/lisp/emacs-lisp/cl-preloaded-tests.el (cl-struct-define/builtin-type): New unit tests. * etc/NEWS: Document changed behavior. diff --git a/etc/NEWS b/etc/NEWS index c5a4bc3344..4eb620105a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -190,6 +190,10 @@ calling 'eldoc-message' directly. ** Old-style backquotes now generate an error. They have been generating warnings for a decade. +** Defining a Common Lisp structure using 'cl-defstruct' or +'cl-struct-define' whose name clashes with a builtin type (e.g., +'integer' or 'hash-table') now signals an error. + * Lisp Changes in Emacs 27.1 diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 16f33282ba..05cb9b091d 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -43,6 +43,7 @@ ;;; Code: +(require 'cl-generic) (require 'cl-lib) (require 'macroexp) ;; `gv' is required here because cl-macs can be loaded before loaddefs.el. @@ -2663,6 +2664,9 @@ non-nil value, that slot cannot be set via `setf'. (forms nil) (docstring (if (stringp (car descs)) (pop descs))) pred-form pred-check) + ;; Can't use `cl-check-type' yet. + (unless (cl--struct-name-p name) + (signal 'wrong-type-argument (list 'cl-struct-name-p name 'name))) (setq descs (cons '(cl-tag-slot) (mapcar (function (lambda (x) (if (consp x) x (list x)))) descs))) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 4e73a4a31b..33a1438f69 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -36,6 +36,7 @@ ;;; Code: +(eval-when-compile (require 'cl-generic)) (eval-when-compile (require 'cl-lib)) (eval-when-compile (require 'cl-macs)) ;For cl--struct-class. @@ -50,6 +51,12 @@ (apply #'error string (append sargs args)) (signal 'cl-assertion-failed `(,form ,@sargs))))) +(defun cl--struct-name-p (name) + "Return t if NAME is a valid structure name for `cl-defstruct'." + (and name (symbolp name) (not (keywordp name)) + (not (memq name (eval-when-compile cl--generic-all-builtin-types))) + t)) + ;; When we load this (compiled) file during pre-loading, the cl--struct-class ;; code below will need to access the `cl-struct' info, since it's considered ;; already as its parent (because `cl-struct' was defined while the file was @@ -110,6 +117,7 @@ ;;;###autoload (defun cl-struct-define (name docstring parent type named slots children-sym tag print) + (cl-check-type name cl--struct-name) (unless type ;; Legacy defstruct, using tagged vectors. Enable backward compatibility. (cl-old-struct-compat-mode 1)) diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index f0bde7af39..9236ac73b5 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -497,4 +497,13 @@ collection clause." vconcat (vector (1+ x))) [2 3 4 5 6]))) + +(ert-deftest cl-defstruct/builtin-type () + (should-error + (macroexpand '(cl-defstruct hash-table)) + :type 'wrong-type-argument) + (should-error + (macroexpand '(cl-defstruct (hash-table (:predicate hash-table-p)))) + :type 'wrong-type-argument)) + ;;; cl-macs-tests.el ends here diff --git a/test/lisp/emacs-lisp/cl-preloaded-tests.el b/test/lisp/emacs-lisp/cl-preloaded-tests.el new file mode 100644 index 0000000000..008a6e629f --- /dev/null +++ b/test/lisp/emacs-lisp/cl-preloaded-tests.el @@ -0,0 +1,33 @@ +;;; cl-preloaded-tests.el --- unit tests for cl-preloaded.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. +;; Author: Philipp Stephani + +;; This file is part of GNU Emacs. + +;; This program 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. + +;; This program 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 this program. If not, see . + +;;; Commentary: + +;; Unit tests for lisp/emacs-lisp/cl-preloaded.el. + +;;; Code: + +(ert-deftest cl-struct-define/builtin-type () + (should-error + (cl-struct-define 'hash-table nil nil 'record nil nil + 'cl-preloaded-tests-tag 'cl-preloaded-tests nil) + :type 'wrong-type-argument)) + +;;; cl-preloaded-tests.el ends here commit f04a527a9266690e6486c65d303a897b08fc5732 Author: Alan Mackenzie Date: Sun Jan 7 11:16:52 2018 +0000 * fns.c (base64-decode-region): Add signal_after_change call for insertion. diff --git a/src/fns.c b/src/fns.c index aba34fd261..47457e44c8 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3319,6 +3319,7 @@ If the region can't be decoded, signal an error and don't modify the buffer. */ and delete the old. (Insert first in order to preserve markers.) */ TEMP_SET_PT_BOTH (XFASTINT (beg), ibeg); insert_1_both (decoded, inserted_chars, decoded_length, 0, 1, 0); + signal_after_change (XFASTINT (beg), 0, inserted_chars); SAFE_FREE (); /* Delete the original text. */