commit 7f129f2ecfbdded5c31e9d9fc8bf11ce0e017000 (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Wed Mar 27 21:51:39 2019 -0700 Simpler way to export HAVE_X_WINDOWS to GDB * src/.gdbinit: Simplify by removing dependency on globals implementation. This is useful for a future performance improvement that I have in mind. * src/alloc.c (enum defined_HAVE_X_WINDOWS, defined_HAVE_X_WINDOWS): New enum and constant. (gdb_make_enums_visible) [__GNUC__]: Use it, to make defined_HAVE_X_WINDOWS visible to GDB. diff --git a/src/.gdbinit b/src/.gdbinit index 7553f07845..b8b303104f 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -1219,24 +1219,12 @@ show environment TERM # terminate_due_to_signal when an assertion failure is non-fatal. break terminate_due_to_signal -# x_error_quitter is defined only on X. But window-system is set up -# only at run time, during Emacs startup, so we need to defer setting -# the breakpoint. init_sys_modes is the first function called on -# every platform after init_display, where window-system is set. -tbreak init_sys_modes -commands - silent - xsymname globals.f_Vinitial_window_system - xgetptr $symname - set $tem = (struct Lisp_String *) $ptr - set $tem = (char *) $tem->u.s.data - # If we are running in synchronous mode, we want a chance to look - # around before Emacs exits. Perhaps we should put the break - # somewhere else instead... - if $tem[0] == 'x' && $tem[1] == '\0' - break x_error_quitter - end - continue +# x_error_quitter is defined only if defined_HAVE_X_WINDOWS. +# If we are running in synchronous mode, we want a chance to look +# around before Emacs exits. Perhaps we should put the break +# somewhere else instead... +if defined_HAVE_X_WINDOWS + break x_error_quitter end diff --git a/src/alloc.c b/src/alloc.c index 3a8bd30c34..e48807c49a 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -7649,6 +7649,12 @@ than 2**N, where N is this variable's value. N should be nonnegative. */); defsubr (&Ssuspicious_object); } +#ifdef HAVE_X_WINDOWS +enum defined_HAVE_X_WINDOWS { defined_HAVE_X_WINDOWS = true }; +#else +enum defined_HAVE_X_WINDOWS { defined_HAVE_X_WINDOWS = false }; +#endif + /* When compiled with GCC, GDB might say "No enum type named pvec_type" if we don't have at least one symbol with that type, and then xbacktrace could fail. Similarly for the other enums and @@ -7667,5 +7673,6 @@ union enum MAX_ALLOCA MAX_ALLOCA; enum More_Lisp_Bits More_Lisp_Bits; enum pvec_type pvec_type; + enum defined_HAVE_X_WINDOWS defined_HAVE_X_WINDOWS; } const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0}; #endif /* __GNUC__ */ commit 81795bb71394aac6d7f6f7fd2656b2eb79a39a4d Author: Paul Eggert Date: Wed Mar 27 21:03:10 2019 -0700 Tweak re_registers allocation * src/regex-emacs.c (re_match_2_internal): No need to allocate one extra trailing search register; Emacs does not use it. Avoid quadratic behavior on reallocation. diff --git a/src/regex-emacs.c b/src/regex-emacs.c index 7629492bcf..8dc6980502 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c @@ -3940,8 +3940,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, } /* Initialize subexpression text positions to -1 to mark ones that no - start_memory/stop_memory has been seen for. Also initialize the - register information struct. */ + start_memory/stop_memory has been seen for. */ for (ptrdiff_t reg = 1; reg < num_regs; reg++) regstart[reg] = regend[reg] = NULL; @@ -4091,10 +4090,8 @@ re_match_2_internal (struct re_pattern_buffer *bufp, { /* Have the register data arrays been allocated? */ if (bufp->regs_allocated == REGS_UNALLOCATED) - { /* No. So allocate them with malloc. We need one - extra element beyond 'num_regs' for the '-1' marker - GNU code uses. */ - ptrdiff_t n = max (RE_NREGS, num_regs + 1); + { /* No. So allocate them with malloc. */ + ptrdiff_t n = max (RE_NREGS, num_regs); regs->start = xnmalloc (n, sizeof *regs->start); regs->end = xnmalloc (n, sizeof *regs->end); regs->num_regs = n; @@ -4104,9 +4101,10 @@ re_match_2_internal (struct re_pattern_buffer *bufp, { /* Yes. If we need more elements than were already allocated, reallocate them. If we need fewer, just leave it alone. */ - if (regs->num_regs < num_regs + 1) + ptrdiff_t n = regs->num_regs; + if (n < num_regs) { - ptrdiff_t n = num_regs + 1; + n = max (n + (n >> 1), num_regs); regs->start = xnrealloc (regs->start, n, sizeof *regs->start); regs->end = xnrealloc (regs->end, n, sizeof *regs->end); @@ -4137,10 +4135,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp, } /* If the regs structure we return has more elements than - were in the pattern, set the extra elements to -1. If - we (re)allocated the registers, this is the case, - because we always allocate enough to have at least one - -1 at the end. */ + were in the pattern, set the extra elements to -1. */ for (ptrdiff_t reg = num_regs; reg < regs->num_regs; reg++) regs->start[reg] = regs->end[reg] = -1; } @@ -5053,13 +5048,10 @@ re_compile_pattern (const char *pattern, ptrdiff_t length, bool posix_backtracking, const char *whitespace_regexp, struct re_pattern_buffer *bufp) { - reg_errcode_t ret; - - /* GNU code is written to assume at least RE_NREGS registers will be set - (and at least one extra will be -1). */ bufp->regs_allocated = REGS_UNALLOCATED; - ret = regex_compile ((re_char *) pattern, length, + reg_errcode_t ret + = regex_compile ((re_char *) pattern, length, posix_backtracking, whitespace_regexp, bufp); diff --git a/src/regex-emacs.h b/src/regex-emacs.h index 95f743dc2f..ddf14e0d9e 100644 --- a/src/regex-emacs.h +++ b/src/regex-emacs.h @@ -98,7 +98,7 @@ struct re_pattern_buffer bool_bf can_be_null : 1; /* If REGS_UNALLOCATED, allocate space in the 'regs' structure - for 'max (RE_NREGS, re_nsub + 1)' groups. + for at least (re_nsub + 1) groups. If REGS_REALLOCATE, reallocate space if necessary. If REGS_FIXED, use what's there. */ unsigned regs_allocated : 2; commit eac5f967ca700c5f47cf673cb4c06b07c4f42ac2 Author: Paul Eggert Date: Wed Mar 27 21:01:04 2019 -0700 No need for m_search_regs_saved in thread.h * src/search.c (save_search_regs, restore_search_regs): Don’t use m_search_regs_saved; it’s equivalent to saved_search_regs.num_regs != 0. * src/thread.h (struct thread_state): Remove m_search_regs_saved. diff --git a/src/search.c b/src/search.c index e55aa767f1..e15e2b94e5 100644 --- a/src/search.c +++ b/src/search.c @@ -3059,18 +3059,14 @@ If optional arg RESEAT is non-nil, make markers on LIST point nowhere. */) static void save_search_regs (void) { - if (!search_regs_saved) + if (saved_search_regs.num_regs == 0) { - saved_search_regs.num_regs = search_regs.num_regs; - saved_search_regs.start = search_regs.start; - saved_search_regs.end = search_regs.end; + saved_search_regs = search_regs; saved_last_thing_searched = last_thing_searched; last_thing_searched = Qnil; search_regs.num_regs = 0; search_regs.start = 0; search_regs.end = 0; - - search_regs_saved = 1; } } @@ -3078,19 +3074,17 @@ save_search_regs (void) void restore_search_regs (void) { - if (search_regs_saved) + if (saved_search_regs.num_regs != 0) { if (search_regs.num_regs > 0) { xfree (search_regs.start); xfree (search_regs.end); } - search_regs.num_regs = saved_search_regs.num_regs; - search_regs.start = saved_search_regs.start; - search_regs.end = saved_search_regs.end; + search_regs = saved_search_regs; last_thing_searched = saved_last_thing_searched; saved_last_thing_searched = Qnil; - search_regs_saved = 0; + saved_search_regs.num_regs = 0; } } diff --git a/src/thread.h b/src/thread.h index 1856fddf4c..50f8f5cbe0 100644 --- a/src/thread.h +++ b/src/thread.h @@ -131,11 +131,6 @@ struct thread_state struct re_registers m_search_regs; #define search_regs (current_thread->m_search_regs) - /* If non-zero the match data have been saved in saved_search_regs - during the execution of a sentinel or filter. */ - bool m_search_regs_saved; -#define search_regs_saved (current_thread->m_search_regs_saved) - struct re_registers m_saved_search_regs; #define saved_search_regs (current_thread->m_saved_search_regs) commit 361e88986f3580a7433a23eec1cf01408e5e3627 Author: Paul Eggert Date: Wed Mar 27 20:58:34 2019 -0700 Fix search_regs memory leak when thread destroyed * src/thread.c (free_search_regs): New function. (finalize_one_thread): Use it. diff --git a/src/thread.c b/src/thread.c index 59e5b6617e..e51d614434 100644 --- a/src/thread.c +++ b/src/thread.c @@ -768,9 +768,21 @@ run_thread (void *state) return NULL; } +static void +free_search_regs (struct re_registers *regs) +{ + if (regs->num_regs != 0) + { + xfree (regs->start); + xfree (regs->end); + } +} + void finalize_one_thread (struct thread_state *state) { + free_search_regs (&state->m_search_regs); + free_search_regs (&state->m_saved_search_regs); sys_cond_destroy (&state->thread_condvar); } commit 4da44cdaaf792c96164ba60076866a9df4d76002 Author: Juri Linkov Date: Wed Mar 27 23:46:39 2019 +0200 * lisp/frame.el (make-frame-on-monitor): Add default value. (Bug#34516) diff --git a/lisp/frame.el b/lisp/frame.el index 7cfe546ca6..6cb1247372 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -676,12 +676,16 @@ The optional argument PARAMETERS specifies additional frame parameters." "Make a frame on monitor MONITOR. The optional argument DISPLAY can be a display name, and the optional argument PARAMETERS specifies additional frame parameters." - (interactive (list (completing-read - (format "Make frame on monitor: ") - (or (delq nil (mapcar (lambda (a) - (cdr (assq 'name a))) - (display-monitor-attributes-list))) - '(""))))) + (interactive + (list + (let* ((default (cdr (assq 'name (frame-monitor-attributes))))) + (completing-read + (format "Make frame on monitor (default %s): " default) + (or (delq nil (mapcar (lambda (a) + (cdr (assq 'name a))) + (display-monitor-attributes-list))) + '("")) + nil nil nil nil default)))) (let* ((monitor-workarea (catch 'done (dolist (a (display-monitor-attributes-list display)) commit 3f87676e7561c65233e56c6d71a70e371406fcca Author: Michael Albinus Date: Wed Mar 27 22:28:03 2019 +0100 * lisp/net/tramp.el (tramp-accept-process-output): Let progress reporter run. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 1d7242ba8f..0e062b7155 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4074,9 +4074,14 @@ for process communication also." (let ((inhibit-read-only t) last-coding-system-used ;; We do not want to run timers. + (tl timer-list) (stimers (with-timeout-suspend)) timer-list timer-idle-list result) + ;; Enable our progress reporter. + (dolist (timer tl) + (if (eq (timer--function timer) #'tramp-progress-reporter-update) + (add-to-list 'timer-list timer))) ;; JUST-THIS-ONE is set due to Bug#12145. (tramp-message proc 10 "%s %s %s %s\n%s" commit 538c66c3069cba8c603d7604ac079992416eb766 Author: Charles A. Roelli Date: Wed Mar 27 20:48:16 2019 +0100 * test/lisp/mail/rmail-tests.el (rmail-autoload): Fix its doc. diff --git a/test/lisp/mail/rmail-tests.el b/test/lisp/mail/rmail-tests.el index 00f4583335..3a0fdbc261 100644 --- a/test/lisp/mail/rmail-tests.el +++ b/test/lisp/mail/rmail-tests.el @@ -23,7 +23,7 @@ (ert-deftest rmail-autoload () - "Tests to see whether reftex-auc has been autoloaded" + "Test that `rmail-edit-current-message' has been autoloaded." (should (fboundp 'rmail-edit-current-message)) (should commit df167575d1ac2d056c8a2ef1fc83d768c09a3d28 Author: Paul Eggert Date: Wed Mar 27 11:43:18 2019 -0700 Tune css-mode regexp * lisp/textmodes/css-mode.el (css--font-lock-keywords): Omit unnecessary \(?: \) in regexp. Suggested by Mattias Engdegård in: https://lists.gnu.org/r/emacs-devel/2019-03/msg01042.html diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index d3ca2d9558..11a77b5bb7 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -892,7 +892,7 @@ cannot be completed sensibly: `custom-ident', (,(concat "@" css-ident-re) (0 font-lock-builtin-face)) ;; Selectors. ;; Allow plain ":root" as a selector. - ("^[ \t]*\\(:root\\)\\(?:[\n \t]*\\){" (1 'css-selector keep)) + ("^[ \t]*\\(:root\\)[\n \t]*{" (1 'css-selector keep)) ;; FIXME: attribute selectors don't work well because they may contain ;; strings which have already been highlighted as f-l-string-face and ;; thus prevent this highlighting from being applied (actually now that commit 6dfd28c3201719cc284183a74dc1cc1344410905 Author: Michael Heerdegen Date: Tue Mar 12 15:13:55 2019 +0100 Improve documentation of 'alist-get' (Bug#34708) * lisp/subr.el (alist-get): Enhance part of docstring explaining usage in place expressions. diff --git a/lisp/subr.el b/lisp/subr.el index 6dc53cd720..f1a1dddd81 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -756,9 +756,31 @@ Elements of ALIST that are not conses are ignored." If KEY is not found in ALIST, return DEFAULT. Use TESTFN to lookup in the alist if non-nil. Otherwise, use `assq'. -This is a generalized variable suitable for use with `setf'. +You can use `alist-get' in PLACE expressions. This will modify +an existing association (more precisely, the first one if +multiple exist), or add a new element to the beginning of ALIST, +destructively modifying the list stored in ALIST. + +Example: + + (setq foo '((a . 0))) + (setf (alist-get 'a foo) 1 + (alist-get 'b foo) 2) + + foo => ((b . 2) (a . 1)) + + When using it to set a value, optional argument REMOVE non-nil -means to remove KEY from ALIST if the new value is `eql' to DEFAULT." +means to remove KEY from ALIST if the new value is `eql' to +DEFAULT (more precisely the first found association will be +deleted from the alist). + +Example: + + (setq foo '((a . 1) (b . 2))) + (setf (alist-get 'b foo nil 'remove) nil) + + foo => ((a . 1))" (ignore remove) ;;Silence byte-compiler. (let ((x (if (not testfn) (assq key alist) commit 92acab73e0dd3921b53eac4f3fba327b7aa4d3aa Author: Paul Eggert Date: Wed Mar 27 11:36:13 2019 -0700 Use regexp-opt-charset to improve regexp tweaks * lisp/emacs-lisp/regexp-opt.el (regexp-opt): Reword confusing sentence in doc string. * lisp/erc/erc.el (erc-lurker-maybe-trim): * lisp/mail/footnote.el (footnote-hebrew-numeric-regex): Improve by using regexp-opt-charset. diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el index fce6a47d98..d883752d71 100644 --- a/lisp/emacs-lisp/regexp-opt.el +++ b/lisp/emacs-lisp/regexp-opt.el @@ -86,9 +86,9 @@ ;;;###autoload (defun regexp-opt (strings &optional paren keep-order) "Return a regexp to match a string in the list STRINGS. -Each string should be unique in STRINGS and should not contain -any regexps, quoted or not. Optional PAREN specifies how the -returned regexp is surrounded by grouping constructs. +Each member of STRINGS is treated as a fixed string, not as a regexp. +Optional PAREN specifies how the returned regexp is surrounded by +grouping constructs. If STRINGS is the empty list, the return value is a regexp that never matches anything. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index e34487de27..d1fa5c7f12 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -67,7 +67,6 @@ (load "erc-loaddefs" nil t) (eval-when-compile (require 'cl-lib)) -(require 'cl-seq) (require 'font-lock) (require 'pp) (require 'thingatpt) @@ -2523,8 +2522,7 @@ Returns NICK unmodified unless `erc-lurker-trim-nicks' is non-nil." (if erc-lurker-trim-nicks (replace-regexp-in-string - (regexp-opt (cl-delete-duplicates - (mapcar #'char-to-string erc-lurker-ignore-chars))) + (regexp-opt-charset (string-to-list erc-lurker-ignore-chars)) "" nick) nick)) diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el index 7f88e30120..81dc11de76 100644 --- a/lisp/mail/footnote.el +++ b/lisp/mail/footnote.el @@ -64,7 +64,6 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) -(require 'cl-seq) (defvar filladapt-token-table) (defgroup footnote nil @@ -364,9 +363,9 @@ Use Unicode characters for footnoting." ("ק" "ר" "ש" "ת" "תק" "תר" "תש" "תת" "תתק"))) (defconst footnote-hebrew-numeric-regex - (concat "[" (cl-delete-duplicates - (apply #'concat (apply #'append footnote-hebrew-numeric))) - "']+")) + (let ((numchars (string-to-list + (apply #'concat (apply #'append footnote-hebrew-numeric))))) + (concat (regexp-opt-charset (cons ?' numchars)) "+"))) ;; (defconst footnote-hebrew-numeric-regex "\\([אבגדהוזחט]'\\)?\\(ת\\)?\\(ת\\)?\\([קרשת]\\)?\\([טיכלמנסעפצ]\\)?\\([אבגדהוזחט]\\)?") (defun footnote--hebrew-numeric (n) @@ -464,6 +463,11 @@ Conversion is done based upon the current selected style." (nth 0 footnote-style-alist))))) (concat ;; Hack to avoid repetition of repetition. + ;; FIXME: I'm not sure the added * makes sense at all; there is + ;; always a single number within the footnote-{start,end}-tag pairs. + ;; Worse, the code goes on and adds yet another + later on, in + ;; footnote-refresh-footnotes, just in case. That makes even less sense. + ;; Likely, both the * and the extra + should go away. (if (string-match "[^\\]\\\\\\{2\\}*[*+?]\\'" regexp) (substring regexp 0 -1) regexp) commit a35a1f6a9406bc98b4ab83489e5dc7843ffacfb6 Author: Eli Zaretskii Date: Wed Mar 27 20:34:22 2019 +0200 Attempt to fix crashes under GDB on Windows 10 * src/pdumper.c (dump_discard_mem) [VM_SUPPORTED == VM_MS_WINDOWS]: Don't pass NULL pointer as last argument to VirtualProtect. Reported by Martin Rudalics . diff --git a/src/coding.c b/src/coding.c index 905c7ced84..c6d9643677 100644 --- a/src/coding.c +++ b/src/coding.c @@ -7798,42 +7798,6 @@ static Lisp_Object Vcode_conversion_reused_workbuf; static bool reused_workbuf_in_use; -/* Return a working buffer of code conversion. MULTIBYTE specifies the - multibyteness of returning buffer. */ - -static Lisp_Object -make_conversion_work_buffer (bool multibyte) -{ - Lisp_Object name, workbuf; - struct buffer *current; - - if (reused_workbuf_in_use) - { - name = Fgenerate_new_buffer_name (Vcode_conversion_workbuf_name, Qnil); - workbuf = Fget_buffer_create (name); - } - else - { - reused_workbuf_in_use = 1; - if (NILP (Fbuffer_live_p (Vcode_conversion_reused_workbuf))) - Vcode_conversion_reused_workbuf - = Fget_buffer_create (Vcode_conversion_workbuf_name); - workbuf = Vcode_conversion_reused_workbuf; - } - current = current_buffer; - set_buffer_internal (XBUFFER (workbuf)); - /* We can't allow modification hooks to run in the work buffer. For - instance, directory_files_internal assumes that file decoding - doesn't compile new regexps. */ - Fset (Fmake_local_variable (Qinhibit_modification_hooks), Qt); - Ferase_buffer (); - bset_undo_list (current_buffer, Qt); - bset_enable_multibyte_characters (current_buffer, multibyte ? Qt : Qnil); - set_buffer_internal (current); - return workbuf; -} - - static void code_conversion_restore (Lisp_Object arg) { @@ -7846,7 +7810,12 @@ code_conversion_restore (Lisp_Object arg) if (EQ (workbuf, Vcode_conversion_reused_workbuf)) reused_workbuf_in_use = 0; else - Fkill_buffer (workbuf); + { + ptrdiff_t count = SPECPDL_INDEX (); + specbind (Qbuffer_list_update_hook, Qnil); + Fkill_buffer (workbuf); + unbind_to (count, Qnil); + } } set_buffer_internal (XBUFFER (current)); } @@ -7857,9 +7826,51 @@ code_conversion_save (bool with_work_buf, bool multibyte) Lisp_Object workbuf = Qnil; if (with_work_buf) - workbuf = make_conversion_work_buffer (multibyte); + { + ptrdiff_t count = SPECPDL_INDEX (); + if (reused_workbuf_in_use) + { + Lisp_Object name + = Fgenerate_new_buffer_name (Vcode_conversion_workbuf_name, Qnil); + specbind (Qbuffer_list_update_hook, Qnil); + workbuf = Fget_buffer_create (name); + unbind_to (count, Qnil); + } + else + { + if (NILP (Fbuffer_live_p (Vcode_conversion_reused_workbuf))) + { + specbind (Qbuffer_list_update_hook, Qnil); + Vcode_conversion_reused_workbuf + = Fget_buffer_create (Vcode_conversion_workbuf_name); + unbind_to (count, Qnil); + } + workbuf = Vcode_conversion_reused_workbuf; + } + } record_unwind_protect (code_conversion_restore, Fcons (Fcurrent_buffer (), workbuf)); + if (!NILP (workbuf)) + { + struct buffer *current = current_buffer; + set_buffer_internal (XBUFFER (workbuf)); + /* We can't allow modification hooks to run in the work buffer. For + instance, directory_files_internal assumes that file decoding + doesn't compile new regexps. */ + Fset (Fmake_local_variable (Qinhibit_modification_hooks), Qt); + Ferase_buffer (); + bset_undo_list (current_buffer, Qt); + bset_enable_multibyte_characters (current_buffer, multibyte ? Qt : Qnil); + if (EQ (workbuf, Vcode_conversion_reused_workbuf)) + reused_workbuf_in_use = 1; + else + { + Fset (Fmake_local_variable (Qkill_buffer_query_functions), Qnil); + Fset (Fmake_local_variable (Qkill_buffer_hook), Qnil); + } + set_buffer_internal (current); + } + return workbuf; } diff --git a/src/pdumper.c b/src/pdumper.c index f459d971c3..8116c75ae8 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -4623,7 +4623,8 @@ dump_discard_mem (void *mem, size_t size) /* Discard COWed pages. */ (void) VirtualFree (mem, size, MEM_DECOMMIT); /* Release the commit charge for the mapping. */ - (void) VirtualProtect (mem, size, PAGE_NOACCESS, NULL); + DWORD old_prot; + (void) VirtualProtect (mem, size, PAGE_NOACCESS, &old_prot); #elif VM_SUPPORTED == VM_POSIX # ifdef HAVE_POSIX_MADVISE /* Discard COWed pages. */ commit a697d1e638eabdb3eb32337fde6d802ef712eaf8 Author: Paul Eggert Date: Wed Mar 27 10:01:21 2019 -0700 Minor xml.el tweaks * lisp/xml.el (xml-name-start-char-re, xml-name-char-re): No need to call concat. (xml-name-char-re): Use \u escapes rather than chars inline, so that the code matches the comments better and is easier to audit. diff --git a/lisp/xml.el b/lisp/xml.el index 44506b971a..2337952f06 100644 --- a/lisp/xml.el +++ b/lisp/xml.el @@ -176,11 +176,11 @@ See also `xml-get-attribute-or-nil'." ;; [4] NameStartChar ;; See the definition of word syntax in `xml-syntax-table'. -(defconst xml-name-start-char-re (concat "[[:word:]:_]")) +(defconst xml-name-start-char-re "[[:word:]:_]") ;; [4a] NameChar ::= NameStartChar | "-" | "." | [0-9] | #xB7 ;; | [#x0300-#x036F] | [#x203F-#x2040] -(defconst xml-name-char-re (concat "[-0-9.[:word:]:_·̀-ͯ‿⁀]")) +(defconst xml-name-char-re "[[:word:]:_.0-9\u00B7\u0300-\u036F\u203F\u2040-]") ;; [5] Name ::= NameStartChar (NameChar)* (defconst xml-name-re (concat xml-name-start-char-re xml-name-char-re "*")) commit 907d11fc5372e899c89739f79c653eed055450cf Author: Michael Albinus Date: Wed Mar 27 16:28:08 2019 +0100 Use connection-local setting for tramp-remote-path * doc/misc/tramp.texi (Remote programs): Mention connection-local settings for `tramp-remote-path'. * lisp/net/tramp-sh.el (tramp-get-remote-path): Expand connection-local variables. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index ea6ad15dc3..ac5aa680d5 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1979,6 +1979,39 @@ preserves the path value, which can be used to update shell supports the login argument @samp{-l}. @end defopt +Starting with Emacs 26, @code{tramp-remote-path} can be set per host +via connection-local +@ifinfo +variables, @xref{Connection Variables, , , emacs}. +@end ifinfo +@ifnotinfo +variables. +@end ifnotinfo +You could define your own search directories like this: + +@lisp +@group +(connection-local-set-profile-variables 'remote-path-with-bin + '((tramp-remote-path . ("~/bin" tramp-default-remote-path)))) +@end group + +@group +(connection-local-set-profile-variables 'remote-path-with-apply-pub-bin + '((tramp-remote-path . ("/appli/pub/bin" tramp-default-remote-path)))) +@end group + +@group +(connection-local-set-profiles + '(:application tramp :machine "randomhost") 'remote-path-with-bin) +@end group + +@group +(connection-local-set-profiles + '(:application tramp :user "anotheruser" :machine "anotherhost") + 'remote-path-with-apply-pub-bin) +@end group +@end lisp + When remote search paths are changed, local @value{tramp} caches must be recomputed. To force @value{tramp} to recompute afresh, call @kbd{M-x tramp-cleanup-this-connection @key{RET}} or friends diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 2b4399f8de..edd9af489e 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -5314,87 +5314,90 @@ Return ATTR." (defun tramp-get-remote-path (vec) "Compile list of remote directories for $PATH. Nonexistent directories are removed from spec." - (with-tramp-connection-property - ;; When `tramp-own-remote-path' is in `tramp-remote-path', we - ;; cache the result for the session only. Otherwise, the result - ;; is cached persistently. - (if (memq 'tramp-own-remote-path tramp-remote-path) - (tramp-get-connection-process vec) - vec) - "remote-path" - (let* ((remote-path (copy-tree tramp-remote-path)) - (elt1 (memq 'tramp-default-remote-path remote-path)) - (elt2 (memq 'tramp-own-remote-path remote-path)) - (default-remote-path - (when elt1 - (or - (tramp-send-command-and-read - vec "echo \\\"`getconf PATH 2>/dev/null`\\\"" 'noerror) - ;; Default if "getconf" is not available. - (progn - (tramp-message - vec 3 - "`getconf PATH' not successful, using default value \"%s\"." - "/bin:/usr/bin") - "/bin:/usr/bin")))) - (own-remote-path - ;; The login shell could return more than just the $PATH - ;; string. So we use `tramp-end-of-heredoc' as marker. - (when elt2 - (or - (tramp-send-command-and-read - vec - (format - "%s %s %s 'echo %s \\\"$PATH\\\"'" - (tramp-get-method-parameter vec 'tramp-remote-shell) - (mapconcat - #'identity - (tramp-get-method-parameter vec 'tramp-remote-shell-login) - " ") - (mapconcat - #'identity - (tramp-get-method-parameter vec 'tramp-remote-shell-args) - " ") - (tramp-shell-quote-argument tramp-end-of-heredoc)) - 'noerror (regexp-quote tramp-end-of-heredoc)) - (progn - (tramp-message - vec 2 "Could not retrieve `tramp-own-remote-path'") - nil))))) - - ;; Replace place holder `tramp-default-remote-path'. - (when elt1 - (setcdr elt1 - (append - (split-string (or default-remote-path "") ":" 'omit) - (cdr elt1))) - (setq remote-path (delq 'tramp-default-remote-path remote-path))) - - ;; Replace place holder `tramp-own-remote-path'. - (when elt2 - (setcdr elt2 - (append - (split-string (or own-remote-path "") ":" 'omit) - (cdr elt2))) - (setq remote-path (delq 'tramp-own-remote-path remote-path))) - - ;; Remove double entries. - (setq elt1 remote-path) - (while (consp elt1) - (while (and (car elt1) (setq elt2 (member (car elt1) (cdr elt1)))) - (setcar elt2 nil)) - (setq elt1 (cdr elt1))) - - ;; Remove non-existing directories. - (delq - nil - (mapcar - (lambda (x) - (and - (stringp x) - (file-directory-p (tramp-make-tramp-file-name vec x 'nohop)) - x)) - remote-path))))) + (with-current-buffer (tramp-get-connection-buffer vec) + ;; Expand connection-local variables. + (tramp-set-connection-local-variables vec) + (with-tramp-connection-property + ;; When `tramp-own-remote-path' is in `tramp-remote-path', we + ;; cache the result for the session only. Otherwise, the + ;; result is cached persistently. + (if (memq 'tramp-own-remote-path tramp-remote-path) + (tramp-get-connection-process vec) + vec) + "remote-path" + (let* ((remote-path (copy-tree tramp-remote-path)) + (elt1 (memq 'tramp-default-remote-path remote-path)) + (elt2 (memq 'tramp-own-remote-path remote-path)) + (default-remote-path + (when elt1 + (or + (tramp-send-command-and-read + vec "echo \\\"`getconf PATH 2>/dev/null`\\\"" 'noerror) + ;; Default if "getconf" is not available. + (progn + (tramp-message + vec 3 + "`getconf PATH' not successful, using default value \"%s\"." + "/bin:/usr/bin") + "/bin:/usr/bin")))) + (own-remote-path + ;; The login shell could return more than just the $PATH + ;; string. So we use `tramp-end-of-heredoc' as marker. + (when elt2 + (or + (tramp-send-command-and-read + vec + (format + "%s %s %s 'echo %s \\\"$PATH\\\"'" + (tramp-get-method-parameter vec 'tramp-remote-shell) + (mapconcat + #'identity + (tramp-get-method-parameter vec 'tramp-remote-shell-login) + " ") + (mapconcat + #'identity + (tramp-get-method-parameter vec 'tramp-remote-shell-args) + " ") + (tramp-shell-quote-argument tramp-end-of-heredoc)) + 'noerror (regexp-quote tramp-end-of-heredoc)) + (progn + (tramp-message + vec 2 "Could not retrieve `tramp-own-remote-path'") + nil))))) + + ;; Replace place holder `tramp-default-remote-path'. + (when elt1 + (setcdr elt1 + (append + (split-string (or default-remote-path "") ":" 'omit) + (cdr elt1))) + (setq remote-path (delq 'tramp-default-remote-path remote-path))) + + ;; Replace place holder `tramp-own-remote-path'. + (when elt2 + (setcdr elt2 + (append + (split-string (or own-remote-path "") ":" 'omit) + (cdr elt2))) + (setq remote-path (delq 'tramp-own-remote-path remote-path))) + + ;; Remove double entries. + (setq elt1 remote-path) + (while (consp elt1) + (while (and (car elt1) (setq elt2 (member (car elt1) (cdr elt1)))) + (setcar elt2 nil)) + (setq elt1 (cdr elt1))) + + ;; Remove non-existing directories. + (delq + nil + (mapcar + (lambda (x) + (and + (stringp x) + (file-directory-p (tramp-make-tramp-file-name vec x 'nohop)) + x)) + remote-path)))))) (defun tramp-get-remote-locale (vec) "Determine remote locale, supporting UTF8 if possible." commit e50bfaaeaeda92955725a06da23feea7137dda44 Author: Basil L. Contovounesios Date: Wed Mar 27 13:56:22 2019 +0000 Avoid recently obsolete seq-contains in css-mode * lisp/textmodes/css-mode.el (css--join-nested-selectors): Replace recently obsolete seq-contains with new predicate seq-contains-p. diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 57ecc9788e..d3ca2d9558 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1557,7 +1557,7 @@ rgb()/rgba()." (prev nil)) (dolist (sel selectors) (cond - ((seq-contains sel ?&) + ((seq-contains-p sel ?&) (setq sel (replace-regexp-in-string "&" prev sel)) (pop processed)) ;; Unless this is the first selector, separate this one and the commit 041d65a0451cba6f67ba9c032ef5cc8eaa36e852 Author: Mattias Engdegård Date: Wed Mar 27 13:34:13 2019 +0100 * lisp/xml.el (xml-name-char-re): Remove superfluous `-' in regexp. diff --git a/lisp/xml.el b/lisp/xml.el index 076291bbb0..44506b971a 100644 --- a/lisp/xml.el +++ b/lisp/xml.el @@ -180,7 +180,7 @@ See also `xml-get-attribute-or-nil'." ;; [4a] NameChar ::= NameStartChar | "-" | "." | [0-9] | #xB7 ;; | [#x0300-#x036F] | [#x203F-#x2040] -(defconst xml-name-char-re (concat "[-0-9.[:word:]:_·̀-ͯ‿-⁀]")) +(defconst xml-name-char-re (concat "[-0-9.[:word:]:_·̀-ͯ‿⁀]")) ;; [5] Name ::= NameStartChar (NameChar)* (defconst xml-name-re (concat xml-name-start-char-re xml-name-char-re "*")) commit 29ec1e48883dbdce8f9f81ac25d9ec38c474cdcb Author: Alan Mackenzie Date: Wed Mar 27 11:50:53 2019 +0000 Improve C++ raw string fontification. Integrate the handling of raw string and ordinary string fontification. * lisp/progmodes/cc-defs.el (c-font-lock-flush) (c-search-forward-char-property-without-value-on-char): new macros. (c-point): In the 'eoll arm, check for eobp. (c-search-forward-char-property-with-value-on-char): Handle the &optional limit argument being nil. (c-clear-char-property-with-value-on-char-function) (c-clear-char-property-with-value-on-char): Return the position of the first cleared property. * lisp/progmodes/cc-engine.el (c-find-decl-prefix-search): Don't spuriously recognize the change of face at a ) as the start of a string (a "pseudo match"). (c-old-beg-rs c-old-end-rs): New variables. (c-raw-string-pos): Analyze raw string delimiters more carefully. (c-raw-string-in-end-delim): New function. (c-depropertize-raw-string): Largely rewritten. (c-before-change-check-raw-strings): New functionality: only remove the syntax-table text properties from raw strings whose delimiters are about to change. (c-propertize-raw-string-id): New function. (c-after-change-re-mark-raw-strings): Remove, incorporating functionality into other functions. (c-propertize-raw-string-opener): Largely rewritten. (c-after-change-re-mark-raw-strings): Removed. (c-after-change-unmark-raw-strings, c-after-change-unmark-raw-strings): New functions. * lisp/progmodes/cc-fonts.el (c-font-lock-raw-strings): Largely rewritten. * lisp/progmodes/cc-langs.el (c-before-font-lock-functions): Replace c-after-change-re-mark-unbalanced-strings by c-after-change-mark-abnormal-strings in the t, c+objc, c++ and java sections. Add c-after-change-unmark-raw-strings and remove c-after-change-re-mark-raw-strings from the c++ section. * lisp/progmodes/cc-mode.el (c-old-BEG c-old-END): Remove. (c-old-END-literality): New variable. (c-depropertize-CPP): Remove syntax-table properties from raw strings within macros. (c-before-change-check-unbalanced-strings): Call c-truncate-semi-nonlit-pos-cache to preserve the integrity of the cache. (c-before-change-check-unbalanced-strings): Call c-truncate-semi-nonlit-pos-cache, largely rewritten. (c-after-change-re-mark-unbalanced-strings): Renamed to c-after-change-mark-abnormal-strings. Call c-maybe-re-mark-raw-string. diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 97272ca9d2..87ddf3ac1e 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -212,6 +212,13 @@ This variant works around bugs in `eval-when-compile' in various `(cl-delete-duplicates ,cl-seq ,@cl-keys) `(delete-duplicates ,cl-seq ,@cl-keys)))) +(defmacro c-font-lock-flush (beg end) + "Declare the region BEG...END's fontification as out-of-date. +On XEmacs and older Emacsen, this refontifies that region immediately." + (if (fboundp 'font-lock-flush) + `(font-lock-flush ,beg ,end) + `(font-lock-fontify-region ,beg ,end))) + (defmacro c-point (position &optional point) "Return the value of certain commonly referenced POSITIONs relative to POINT. The current point is used if POINT isn't specified. POSITION can be @@ -258,10 +265,12 @@ to it is returned. This function does not modify the point or the mark." ((eq position 'eoll) `(save-excursion ,@(if point `((goto-char ,point))) - (while (progn - (end-of-line) - (prog1 (eq (logand 1 (skip-chars-backward "\\\\")) 1))) - (beginning-of-line 2)) + (while (and + (not (eobp)) + (progn + (end-of-line) + (prog1 (eq (logand 1 (skip-chars-backward "\\\\")) 1)))) + (forward-line)) (end-of-line) (point))) @@ -1214,7 +1223,7 @@ Leave point just after the character, and set the match data on this character, and return point. If the search fails, return nil; point is then left undefined." `(let ((char-skip (concat "^" (char-to-string ,char))) - (-limit- ,limit) + (-limit- (or ,limit (point-max))) (-value- ,value)) (while (and @@ -1226,15 +1235,39 @@ nil; point is then left undefined." (search-forward-regexp ".") ; to set the match-data. (point)))) +(defmacro c-search-forward-char-property-without-value-on-char + (property value char &optional limit) + "Search forward for a character CHAR without text property PROPERTY having +a value CHAR. +LIMIT bounds the search. The value comparison is done with `equal'. +PROPERTY must be a constant. + +Leave point just after the character, and set the match data on +this character, and return point. If the search fails, return +nil; point is then left undefined." + `(let ((char-skip (concat "^" (char-to-string ,char))) + (-limit- (or ,limit (point-max))) + (-value- ,value)) + (while + (and + (progn (skip-chars-forward char-skip -limit-) + (< (point) -limit-)) + (equal (c-get-char-property (point) ,property) -value-)) + (forward-char)) + (when (< (point) -limit-) + (search-forward-regexp ".") ; to set the match-data. + (point)))) + (defun c-clear-char-property-with-value-on-char-function (from to property value char) "Remove all text-properties PROPERTY with value VALUE on characters with value CHAR from the region [FROM, TO), as tested by `equal'. These properties are assumed to be over individual characters, having been put there by c-put-char-property. POINT -remains unchanged." +remains unchanged. Return the position of the first removed +property, or nil." (let ((place from) - ) + first) (while ; loop round occurrences of (PROPERTY VALUE) (progn (while ; loop round changes in PROPERTY till we find VALUE @@ -1243,28 +1276,34 @@ remains unchanged." (not (equal (get-text-property place property) value))) (setq place (c-next-single-property-change place property nil to))) (< place to)) - (if (eq (char-after place) char) - (remove-text-properties place (1+ place) (cons property nil))) + (when (eq (char-after place) char) + (remove-text-properties place (1+ place) (cons property nil)) + (or first (setq first place))) ;; Do we have to do anything with stickiness here? - (setq place (1+ place))))) + (setq place (1+ place))) + first)) (defmacro c-clear-char-property-with-value-on-char (from to property value char) "Remove all text-properties PROPERTY with value VALUE on characters with value CHAR from the region [FROM, TO), as tested by `equal'. These properties are assumed to be over individual characters, having been put there by c-put-char-property. POINT -remains unchanged." +remains unchanged. Return the position of the first removed +property, or nil." (if c-use-extents ;; XEmacs `(let ((-property- ,property) - (-char- ,char)) + (-char- ,char) + (first (1+ (point-max)))) (map-extents (lambda (ext val) - (if (and (equal (extent-property ext -property-) val) - (eq (char-after - (extent-start-position ext)) - -char-)) - (delete-extent ext))) - nil ,from ,to ,value nil -property-)) + (when (and (equal (extent-property ext -property-) val) + (eq (char-after + (extent-start-position ext)) + -char-)) + (setq first (min first (extent-start-position ext))) + (delete-extent ext))) + nil ,from ,to ,value nil -property-) + (and (<= first (point-max)) first)) ;; GNU Emacs `(c-clear-char-property-with-value-on-char-function ,from ,to ,property ,value ,char))) @@ -1316,6 +1355,7 @@ with value CHAR in the region [FROM to)." ;(eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el. ; '(progn (def-edebug-spec cc-eval-when-compile (&rest def-form)) +(def-edebug-spec c-font-lock-flush t) (def-edebug-spec c--mapcan t) (def-edebug-spec c--set-difference (form form &rest [symbolp form])) (def-edebug-spec c--intersection (form form &rest [symbolp form])) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index cc3753a7eb..1a8c516490 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -5646,8 +5646,12 @@ comment at the start of cc-engine.el for more info." ;; Pseudo match inside a comment or string literal. Skip out ;; of comments and string literals. (while (progn - (goto-char (c-next-single-property-change - (point) 'face nil cfd-limit)) + (unless + (and (match-end 1) + (c-got-face-at (1- (point)) c-literal-faces) + (not (c-got-face-at (point) c-literal-faces))) + (goto-char (c-next-single-property-change + (point) 'face nil cfd-limit))) (and (< (point) cfd-limit) (c-got-face-at (point) c-literal-faces)))) t) ; Continue the loop over pseudo matches. @@ -6350,9 +6354,8 @@ comment at the start of cc-engine.el for more info." ;; Set by c-common-init in cc-mode.el. (defvar c-new-BEG) (defvar c-new-END) -;; Set by c-after-change in cc-mode.el. -(defvar c-old-BEG) -(defvar c-old-END) +;; Set by c-before-change-check-raw-strings. +(defvar c-old-END-literality) (defun c-before-change-check-<>-operators (beg end) ;; Unmark certain pairs of "< .... >" which are currently marked as @@ -6484,9 +6487,9 @@ comment at the start of cc-engine.el for more info." ;; A valid C++ raw string looks like ;; R"()" ;; , where is an identifier from 0 to 16 characters long, not containing -;; spaces, control characters, double quote or left/right paren. -;; can include anything which isn't the terminating )", including new -;; lines, "s, parentheses, etc. +;; spaces, control characters, or left/right paren. can include +;; anything which isn't the terminating )", including new lines, "s, +;; parentheses, etc. ;; ;; CC Mode handles C++ raw strings by the use of `syntax-table' text ;; properties as follows: @@ -6496,16 +6499,18 @@ comment at the start of cc-engine.el for more info." ;; contents is given the property value "punctuation" (`(1)') to prevent it ;; interacting with the "s in the delimiters. ;; -;; The font locking routine `c-font-lock-c++-raw-strings' (in cc-fonts.el) +;; The font locking routine `c-font-lock-raw-strings' (in cc-fonts.el) ;; recognizes valid raw strings, and fontifies the delimiters (apart from ;; the parentheses) with the default face and the parentheses and the ;; with font-lock-string-face. ;; ;; (ii) A valid, but unterminated, raw string opening delimiter gets the ;; "punctuation" value (`(1)') of the `syntax-table' text property, and the -;; open parenthesis gets the "string fence" value (`(15)'). +;; open parenthesis gets the "string fence" value (`(15)'). When such a +;; delimiter is found, no attempt is made in any way to "correct" any text +;; properties after the delimiter. ;; -;; `c-font-lock-c++-raw-strings' puts c-font-lock-warning-face on the entire +;; `c-font-lock-raw-strings' puts c-font-lock-warning-face on the entire ;; unmatched opening delimiter (from the R up to the open paren), and allows ;; the rest of the buffer to get font-lock-string-face, caused by the ;; unmatched "string fence" `syntax-table' text property value. @@ -6522,10 +6527,14 @@ comment at the start of cc-engine.el for more info." ;; already at the end of the macro, it gets the "punctuation" value, and no ;; "string fence"s are used. ;; -;; The effect on the fontification of either of these tactics is that rest of -;; the macro (if any) after the "(" gets font-lock-string-face, but the rest -;; of the file is fontified normally. +;; The effect on the fontification of either of these tactics is that the +;; rest of the macro (if any) after the "(" gets font-lock-string-face, but +;; the rest of the file is fontified normally. +;; The values of the function `c-raw-string-pos' at before-change-functions' +;; BEG and END. +(defvar c-old-beg-rs nil) +(defvar c-old-end-rs nil) (defun c-raw-string-pos () ;; Get POINT's relationship to any containing raw string. @@ -6542,7 +6551,7 @@ comment at the start of cc-engine.el for more info." ;; characters.) If the raw string is not terminated, E\) and E\" are set to ;; nil. ;; - ;; Note: this routine is dependant upon the correct syntax-table text + ;; Note: this function is dependant upon the correct syntax-table text ;; properties being set. (let ((state (c-state-semi-pp-to-literal (point))) open-quote-pos open-paren-pos close-paren-pos close-quote-pos id) @@ -6555,8 +6564,20 @@ comment at the start of cc-engine.el for more info." (search-backward "\"" (max (- (point) 17) (point-min)) t))) ((and (eq (cadr state) 'string) (goto-char (nth 2 state)) - (or (eq (char-after) ?\") - (search-backward "\"" (max (- (point) 17) (point-min)) t)) + (cond + ((eq (char-after) ?\")) + ((eq (char-after) ?\() + (let ((here (point))) + (goto-char (max (- (point) 18) (point-min))) + (while + (and + (search-forward-regexp + "R\"\\([^ ()\\\n\r\t]\\{0,16\\}\\)(" + (1+ here) 'limit) + (< (point) here))) + (and (eq (point) (1+ here)) + (match-beginning 1) + (goto-char (1- (match-beginning 1))))))) (not (bobp))))) (eq (char-before) ?R) (looking-at "\"\\([^ ()\\\n\r\t]\\{0,16\\}\\)(")) @@ -6579,6 +6600,21 @@ comment at the start of cc-engine.el for more info." (t nil)) open-quote-pos open-paren-pos close-paren-pos close-quote-pos)))) +(defun c-raw-string-in-end-delim (beg end) + ;; If the region (BEG END) intersects a possible raw string terminator, + ;; return a cons of the position of the ) and the position of the " in the + ;; first one found. + (save-excursion + (goto-char (max (- beg 17) (point-min))) + (while + (and + (search-forward-regexp ")\\([^ ()\\\n\r\t]\\{0,16\\}\\)\"" + (min (+ end 17) (point-max)) t) + (<= (point) beg))) + (unless (or (<= (point) beg) + (>= (match-beginning 0) end)) + (cons (match-beginning 0) (match-end 1))))) + (defun c-depropertize-raw-string (id open-quote open-paren bound) ;; Point is immediately after a raw string opening delimiter. Remove any ;; `syntax-table' text properties associated with the delimiter (if it's @@ -6587,29 +6623,55 @@ comment at the start of cc-engine.el for more info." ;; ID, a string, is the delimiter's identifier. OPEN-QUOTE and OPEN-PAREN ;; are the buffer positions of the delimiter's components. BOUND is the ;; bound for searching for a matching closing delimiter; it is usually nil, - ;; but if we're inside a macro, it's the end of the macro. + ;; but if we're inside a macro, it's the end of the macro (i.e. just before + ;; the terminating \n). ;; ;; Point is moved to after the (terminated) raw string, or left after the ;; unmatched opening delimiter, as the case may be. The return value is of ;; no significance. - (let ((open-paren-prop (c-get-char-property open-paren 'syntax-table))) + (let ((open-paren-prop (c-get-char-property open-paren 'syntax-table)) + first) + ;; If the delimiter is "unclosed", or sombody's used " in their id, clear + ;; the 'syntax-table property from all of them. + (setq first (c-clear-char-property-with-value-on-char + open-quote open-paren 'syntax-table '(1) ?\")) + (if first (c-truncate-semi-nonlit-pos-cache first)) (cond ((null open-paren-prop) - ;; A terminated raw string + ;; Should be a terminated raw string... (when (search-forward (concat ")" id "\"") nil t) + ;; Yes, it is. :-) + ;; Clear any '(1)s from "s in the identifier. + (setq first (c-clear-char-property-with-value-on-char + (1+ (match-beginning 0)) (1- (match-end 0)) + 'syntax-table '(1) ?\")) + (if first (c-truncate-semi-nonlit-pos-cache first)) + ;; Clear any random `syntax-table' text properties from the contents. (let* ((closing-paren (match-beginning 0)) - (first-punctuation - (save-match-data - (goto-char (1+ open-paren)) - (and (c-search-forward-char-property 'syntax-table '(1) - closing-paren) - (1- (point))))) - ) - (when first-punctuation - (c-clear-char-property-with-value - first-punctuation (match-beginning 0) 'syntax-table '(1)) - (c-truncate-semi-nonlit-pos-cache first-punctuation) - )))) + (first-st + (and + (< (1+ open-paren) closing-paren) + (or + (and (c-get-char-property (1+ open-paren) 'syntax-table) + (1+ open-paren)) + (and + (setq first + (c-next-single-property-change + (1+ open-paren) 'syntax-table nil closing-paren)) + (< first closing-paren) + first))))) + (when first-st + (c-clear-char-properties first-st (match-beginning 0) + 'syntax-table) + (c-truncate-semi-nonlit-pos-cache first-st)) + (when (c-get-char-property (1- (match-end 0)) 'syntax-table) + ;; Was previously an unterminated (ordinary) string + (save-excursion + (goto-char (1- (match-end 0))) + (when (c-safe (c-forward-sexp)) ; to '(1) at EOL. + (c-clear-char-property (1- (point)) 'syntax-table)) + (c-clear-char-property (1- (match-end 0)) 'syntax-table) + (c-truncate-semi-nonlit-pos-cache (1- (match-end 0)))))))) ((or (and (equal open-paren-prop '(15)) (null bound)) (equal open-paren-prop '(1))) ;; An unterminated raw string either not in a macro, or in a macro with @@ -6623,13 +6685,8 @@ comment at the start of cc-engine.el for more info." (c-clear-char-property open-quote 'syntax-table) (c-truncate-semi-nonlit-pos-cache open-quote) (c-clear-char-property open-paren 'syntax-table) - (let ((after-string-fence-pos - (save-excursion - (goto-char (1+ open-paren)) - (c-search-forward-char-property 'syntax-table '(15) bound)))) - (when after-string-fence-pos - (c-clear-char-property (1- after-string-fence-pos) 'syntax-table))) - )))) + (c-clear-char-property-with-value (1+ open-paren) bound 'syntax-table + '(15)))))) (defun c-depropertize-raw-strings-in-region (start finish) ;; Remove any `syntax-table' text properties associated with C++ raw strings @@ -6669,37 +6726,89 @@ comment at the start of cc-engine.el for more info." (defun c-before-change-check-raw-strings (beg end) ;; This function clears `syntax-table' text properties from C++ raw strings - ;; in the region (c-new-BEG c-new-END). BEG and END are the standard - ;; arguments supplied to any before-change function. + ;; whose delimiters are about to change in the region (c-new-BEG c-new-END). + ;; BEG and END are the standard arguments supplied to any before-change + ;; function. ;; ;; Point is undefined on both entry and exit, and the return value has no ;; significance. ;; ;; This function is called as a before-change function solely due to its ;; membership of the C++ value of `c-get-state-before-change-functions'. + (goto-char end) + ;; We use the following to detect a R"( being swallowed into a string by + ;; the pending change. + (setq c-old-END-literality (c-in-literal)) (c-save-buffer-state - ((beg-rs (progn (goto-char beg) (c-raw-string-pos))) - (beg-plus (if (null beg-rs) - beg - (max beg - (1+ (or (nth 4 beg-rs) (nth 2 beg-rs)))))) - (end-rs (progn (goto-char end) (c-raw-string-pos))) ; FIXME!!! + (;; (beg-rs (progn (goto-char beg) (c-raw-string-pos))) + ;; (end-rs (progn (goto-char end) (c-raw-string-pos))) + ; FIXME!!! ; Optimize this so that we don't call ; `c-raw-string-pos' twice when once ; will do. (2016-06-02). - (end-minus (if (null end-rs) - end - (min end (cadr end-rs)))) - ) - (when beg-rs - (setq c-new-BEG (min c-new-BEG (1- (cadr beg-rs))))) - (c-depropertize-raw-strings-in-region c-new-BEG beg-plus) - - (when end-rs - (setq c-new-END (max c-new-END - (1+ (or (nth 4 end-rs) - (nth 2 end-rs)))))) - (c-depropertize-raw-strings-in-region end-minus c-new-END))) + (term-del (c-raw-string-in-end-delim beg end)) + Rquote close-quote) + (setq c-old-beg-rs (progn (goto-char beg) (c-raw-string-pos)) + c-old-end-rs (progn (goto-char end) (c-raw-string-pos))) + (cond + ;; We're not changing, or we're obliterating raw strings. + ((and (null c-old-beg-rs) (null c-old-end-rs))) + ;; We're changing the putative terminating delimiter of a raw string + ;; containing BEG. + ((and c-old-beg-rs term-del + (or (null (nth 3 c-old-beg-rs)) + (<= (car term-del) (nth 3 c-old-beg-rs)))) + (setq Rquote (1- (cadr c-old-beg-rs)) + close-quote (1+ (cdr term-del))) + (c-depropertize-raw-strings-in-region Rquote close-quote) + (setq c-new-BEG (min c-new-BEG Rquote) + c-new-END (max c-new-END close-quote))) + ;; We're breaking an escaped NL in a raw string in a macro. + ((and c-old-end-rs + (< beg end) + (goto-char end) (eq (char-before) ?\\) + (c-beginning-of-macro)) + (let ((bom (point)) + (eom (progn (c-end-of-macro) (point)))) + (c-depropertize-raw-strings-in-region bom eom) + (setq c-new-BEG (min c-new-BEG bom) + c-new-END (max c-new-END eom)))) + ;; We're changing only the contents of a raw string. + ((and (equal (cdr c-old-beg-rs) (cdr c-old-end-rs)) + (null (car c-old-beg-rs)) (null (car c-old-end-rs)))) + ((or + ;; We're removing (at least part of) the R" of the starting delim of a + ;; raw string: + (null c-old-beg-rs) + (and (eq beg (cadr c-old-beg-rs)) + (< beg end)) + ;; Or we're removing the ( of the starting delim of a raw string. + (and (eq (car c-old-beg-rs) 'open-delim) + (or (null c-old-end-rs) + (not (eq (car c-old-end-rs) 'open-delim)) + (not (equal (cdr c-old-beg-rs) (cdr c-old-end-rs)))))) + (let ((close (nth 4 (or c-old-end-rs c-old-beg-rs)))) + (setq Rquote (1- (cadr (or c-old-end-rs c-old-beg-rs))) + close-quote (if close (1+ close) (point-max)))) + (c-depropertize-raw-strings-in-region Rquote close-quote) + (setq c-new-BEG (min c-new-BEG Rquote) + c-new-END (max c-new-END close-quote))) + ;; We're changing only the text of the identifier of the opening + ;; delimiter of a raw string. + ((and (eq (car c-old-beg-rs) 'open-delim) + (equal c-old-beg-rs c-old-end-rs)))))) + +(defun c-propertize-raw-string-id (start end) + ;; If the raw string identifier between buffer positions START and END + ;; contains any double quote characters, put a punctuation syntax-table text + ;; property on them. The return value is of no significance. + (save-excursion + (goto-char start) + (while (and (skip-chars-forward "^\"" end) + (< (point) end)) + (c-put-char-property (point) 'syntax-table '(1)) + (c-truncate-semi-nonlit-pos-cache (point)) + (forward-char)))) (defun c-propertize-raw-string-opener (id open-quote open-paren bound) ;; Point is immediately after a raw string opening delimiter. Apply any @@ -6709,117 +6818,264 @@ comment at the start of cc-engine.el for more info." ;; ID, a string, is the delimiter's identifier. OPEN-QUOTE and OPEN-PAREN ;; are the buffer positions of the delimiter's components. BOUND is the ;; bound for searching for a matching closing delimiter; it is usually nil, - ;; but if we're inside a macro, it's the end of the macro. - ;; - ;; Point is moved to after the (terminated) raw string, or left after the - ;; unmatched opening delimiter, as the case may be. The return value is of - ;; no significance. - (if (search-forward (concat ")" id "\"") bound t) - (let ((end-string (match-beginning 0)) - (after-quote (match-end 0))) - (goto-char open-paren) - (while (progn (skip-syntax-forward "^\"" end-string) - (< (point) end-string)) - (c-put-char-property (point) 'syntax-table '(1)) ; punctuation - (c-truncate-semi-nonlit-pos-cache (point)) - (forward-char)) - (goto-char after-quote)) - (c-put-char-property open-quote 'syntax-table '(1)) ; punctuation - (c-truncate-semi-nonlit-pos-cache open-quote) - (c-put-char-property open-paren 'syntax-table '(15)) ; generic string - (when bound - ;; In a CPP construct, we try to apply a generic-string `syntax-table' - ;; text property to the last possible character in the string, so that - ;; only characters within the macro get "stringed out". - (goto-char bound) - (if (save-restriction - (narrow-to-region (1+ open-paren) (point-max)) - (re-search-backward - (eval-when-compile - ;; This regular expression matches either an escape pair (which - ;; isn't an escaped NL) (submatch 5) or a non-escaped character - ;; (which isn't itself a backslash) (submatch 10). The long - ;; preambles to these (respectively submatches 2-4 and 6-9) - ;; ensure that we have the correct parity for sequences of - ;; backslashes, etc.. - (concat "\\(" ; 1 - "\\(\\`[^\\]?\\|[^\\][^\\]\\)\\(\\\\\\(.\\|\n\\)\\)*" ; 2-4 - "\\(\\\\.\\)" ; 5 - "\\|" - "\\(\\`\\|[^\\]\\|\\(\\`[^\\]?\\|[^\\][^\\]\\)\\(\\\\\\(.\\|\n\\)\\)+\\)" ; 6-9 - "\\([^\\]\\)" ; 10 - "\\)" - "\\(\\\\\n\\)*\\=")) ; 11 - (1+ open-paren) t)) - (if (match-beginning 10) - (progn - (c-put-char-property (match-beginning 10) 'syntax-table '(15)) - (c-truncate-semi-nonlit-pos-cache (match-beginning 10))) - (c-put-char-property (match-beginning 5) 'syntax-table '(1)) - (c-put-char-property (1+ (match-beginning 5)) 'syntax-table '(15)) - (c-truncate-semi-nonlit-pos-cache (1+ (match-beginning 5)))) - (c-put-char-property open-paren 'syntax-table '(1))) - (goto-char bound)))) - -(defun c-after-change-re-mark-raw-strings (_beg _end _old-len) - ;; This function applies `syntax-table' text properties to C++ raw strings - ;; beginning in the region (c-new-BEG c-new-END). BEG, END, and OLD-LEN are - ;; the standard arguments supplied to any after-change function. + ;; but if we're inside a macro, it's the end of the macro (i.e. the position + ;; of the closing newline). + ;; + ;; Point is moved to after the (terminated) raw string and t is returned, or + ;; it is left after the unmatched opening delimiter and nil is returned. + (c-propertize-raw-string-id (1+ open-quote) open-paren) + (prog1 + (if (search-forward (concat ")" id "\"") bound t) + (let ((end-string (match-beginning 0)) + (after-quote (match-end 0))) + (c-propertize-raw-string-id + (1+ (match-beginning 0)) (1- (match-end 0))) + (goto-char open-paren) + (while (progn (skip-syntax-forward "^\"" end-string) + (< (point) end-string)) + (c-put-char-property (point) 'syntax-table '(1)) ; punctuation + (c-truncate-semi-nonlit-pos-cache (point)) + (forward-char)) + (goto-char after-quote) + t) + (c-put-char-property open-quote 'syntax-table '(1)) ; punctuation + (c-truncate-semi-nonlit-pos-cache open-quote) + (c-put-char-property open-paren 'syntax-table '(15)) ; generic string + (when bound + ;; In a CPP construct, we try to apply a generic-string + ;; `syntax-table' text property to the last possible character in + ;; the string, so that only characters within the macro get + ;; "stringed out". + (goto-char bound) + (if (save-restriction + (narrow-to-region (1+ open-paren) (point-max)) + (re-search-backward + (eval-when-compile + ;; This regular expression matches either an escape pair + ;; (which isn't an escaped NL) (submatch 5) or a + ;; non-escaped character (which isn't itself a backslash) + ;; (submatch 10). The long preambles to these + ;; (respectively submatches 2-4 and 6-9) ensure that we + ;; have the correct parity for sequences of backslashes, + ;; etc.. + (concat "\\(" ; 1 + "\\(\\`[^\\]?\\|[^\\][^\\]\\)\\(\\\\\\(.\\|\n\\)\\)*" ; 2-4 + "\\(\\\\.\\)" ; 5 + "\\|" + "\\(\\`\\|[^\\]\\|\\(\\`[^\\]?\\|[^\\][^\\]\\)\\(\\\\\\(.\\|\n\\)\\)+\\)" ; 6-9 + "\\([^\\]\\)" ; 10 + "\\)" + "\\(\\\\\n\\)*\\=")) ; 11 + (1+ open-paren) t)) + (if (match-beginning 10) + (progn + (c-put-char-property (match-beginning 10) 'syntax-table '(15)) + (c-truncate-semi-nonlit-pos-cache (match-beginning 10))) + (c-put-char-property (match-beginning 5) 'syntax-table '(1)) + (c-put-char-property (1+ (match-beginning 5)) 'syntax-table '(15)) + (c-truncate-semi-nonlit-pos-cache (1+ (match-beginning 5)))) + ;; (c-put-char-property open-paren 'syntax-table '(1)) + ) + (goto-char bound)) + nil) + ;; Ensure the opening delimiter will get refontified. + (c-font-lock-flush (1- open-quote) (1+ open-paren)))) + +(defun c-after-change-unmark-raw-strings (beg end _old-len) + ;; This function removes `syntax-table' text properties from any raw strings + ;; which have been affected by the current change. These are those which + ;; have been "stringed out" and from newly formed raw strings, or any + ;; existing raw string which the new text terminates. BEG, END, and + ;; _OLD-LEN are the standard arguments supplied to any + ;; after-change-function. ;; ;; Point is undefined on both entry and exit, and the return value has no ;; significance. ;; - ;; This function is called as an after-change function solely due to its + ;; This functions is called as an after-change function by virtue of its ;; membership of the C++ value of `c-before-font-lock-functions'. - (c-save-buffer-state () - ;; If the region (c-new-BEG c-new-END) has expanded, remove - ;; `syntax-table' text-properties from the new piece(s). - (when (< c-new-BEG c-old-BEG) - (let ((beg-rs (progn (goto-char c-old-BEG) (c-raw-string-pos)))) - (c-depropertize-raw-strings-in-region - c-new-BEG - (if beg-rs - (1+ (or (nth 4 beg-rs) (nth 2 beg-rs))) - c-old-BEG)))) - (when (> c-new-END c-old-END) - (let ((end-rs (progn (goto-char c-old-END) (c-raw-string-pos)))) - (c-depropertize-raw-strings-in-region - (if end-rs - (cadr end-rs) - c-old-END) - c-new-END))) + ;; (when (< beg end) + (c-save-buffer-state (found eoll state id found-beg found-end) + ;; Has an inserted " swallowed up a R"(, turning it into "...R"(? + (goto-char end) + (setq eoll (c-point 'eoll)) + (when (and (null c-old-END-literality) + (search-forward-regexp "R\"\\([^ ()\\\n\r\t]\\{0,16\\}\\)(" + eoll t)) + (setq state (c-state-semi-pp-to-literal end)) + (when (eq (cadr state) 'string) + (unwind-protect + ;; Temporarily insert a closing string delimiter.... + (progn + (goto-char end) + (cond + ((c-characterp (nth 3 (car state))) + (insert (nth 3 (car state)))) + ((eq (nth 3 (car state)) t) + (insert ?\") + (c-put-char-property end 'syntax-table '(15)))) + (c-truncate-semi-nonlit-pos-cache end) + ;; ....ensure c-new-END extends right to the end of the about + ;; to be un-stringed raw string.... + (save-excursion + (goto-char (match-beginning 1)) + (let ((end-bs (c-raw-string-pos))) + (setq c-new-END + (max c-new-END + (if (nth 4 end-bs) + (1+ (nth 4 end-bs)) + eoll))))) + + ;; ...and clear `syntax-table' text propertes from the + ;; following raw strings. + (c-depropertize-raw-strings-in-region (point) (1+ eoll))) + ;; Remove the temporary string delimiter. + (goto-char end) + (delete-char 1)))) + + ;; Have we just created a new starting id? + (goto-char (max (- beg 18) (point-min))) + (while + (and + (setq found + (search-forward-regexp "R\"\\([^ ()\\\n\r\t]\\{0,16\\}\\)(" + c-new-END 'bound)) + (<= (match-end 0) beg))) + (when (and found (<= (match-beginning 0) end)) + (setq c-new-BEG (min c-new-BEG (match-beginning 0))) + (c-depropertize-raw-strings-in-region c-new-BEG c-new-END)) + + ;; Have we invalidated an opening delimiter by typing into it? + (when (and c-old-beg-rs + (eq (car c-old-beg-rs) 'open-delim) + (equal (c-get-char-property (cadr c-old-beg-rs) + 'syntax-table) + '(1))) + (goto-char (1- (cadr c-old-beg-rs))) + (unless (looking-at "R\"[^ ()\\\n\r\t]\\{0,16\\}(") + (c-clear-char-property (1+ (point)) 'syntax-table) + (c-truncate-semi-nonlit-pos-cache (1+ (point))) + (if (c-search-forward-char-property 'syntax-table '(15) + (c-point 'eol)) + (c-clear-char-property (1- (point)) 'syntax-table)))) + + ;; Have we terminated an existing raw string by inserting or removing + ;; text? + (when (eq c-old-END-literality 'string) + (setq state (c-state-semi-pp-to-literal beg)) + (cond + ;; Possibly terminating a(n un)terminated raw string. + ((eq (nth 3 (car state)) t) + (goto-char (nth 8 (car state))) + (when + (and (eq (char-after) ?\() + (search-backward-regexp + "R\"\\([^ ()\\\n\r\t]\\{0,16\\}\\)\\=" (- (point) 18) t)) + (setq id (match-string-no-properties 1) + found-beg (match-beginning 0) + found-end (1+ (match-end 0))))) + ;; Possibly terminating an already terminated raw string. + ((eq (nth 3 (car state)) ?\") + (goto-char (nth 8 (car state))) + (when + (and (eq (char-before) ?R) + (looking-at "\"\\([^ ()\\\n\r\t]\\{0,16\\}\\)(")) + (setq id (match-string-no-properties 1) + found-beg (1- (point)) + found-end (match-end 0))))) + (when id + (goto-char (max (- beg 18) (point-min))) + (when (search-forward (concat ")" id "\"") (+ end 1 (length id)) t) + ;; Has an earlier close delimiter just been inserted into an + ;; already terminated raw string? + (if (and (eq (nth 3 (car state)) ?\") + (search-forward (concat ")" id "\"") nil t)) + (setq found-end (point))) + (setq c-new-BEG (min c-new-BEG found-beg) + c-new-END (max c-new-END found-end)) + (c-clear-char-properties found-beg found-end 'syntax-table) + (c-truncate-semi-nonlit-pos-cache found-beg)))) + + ;; Are there any raw strings in a newly created macro? + (when (< beg end) + (goto-char beg) + (setq found-beg (point)) + (when (search-forward-regexp c-anchored-cpp-prefix end t) + (c-end-of-macro) + (c-depropertize-raw-strings-in-region found-beg (point)))))) - (goto-char c-new-BEG) - (while (and (< (point) c-new-END) - (re-search-forward - (concat "\\(" ; 1 - c-anchored-cpp-prefix ; 2 - "\\)\\|\\(" ; 3 - "R\"\\([^ ()\\\n\r\t]\\{0,16\\}\\)(" ; 4 - "\\)") - c-new-END t)) - (when (save-excursion - (goto-char (match-beginning 0)) (not (c-in-literal))) - (if (match-beginning 4) ; the id - ;; We've found a raw string. +(defun c-maybe-re-mark-raw-string () + ;; When this function is called, point is immediately after a ". If this " + ;; is the characteristic " of of a raw string delimiter, apply the pertinent + ;; `syntax-table' text properties to the entire raw string (when properly + ;; terminated) or just the delimiter (otherwise). + ;; + ;; If the " is in any way part of a raw string, return non-nil. Otherwise + ;; return nil. + (let ((here (point)) + in-macro macro-end id Rquote found) + (cond + ((and + (eq (char-before (1- (point))) ?R) + (looking-at "\\([^ ()\\\n\r\t]\\{0,16\\}\\)(")) + (save-excursion + (setq in-macro (c-beginning-of-macro)) + (setq macro-end (when in-macro + (c-end-of-macro) + (point) ;; (min (1+ (point)) (point-max)) + ))) + (if (not + (c-propertize-raw-string-opener + (match-string-no-properties 1) ; id + (1- (point)) ; open quote + (match-end 1) ; open paren + macro-end)) ; bound (end of macro) or nil. + (goto-char (or macro-end (point-max)))) + t) + ((save-excursion + (and + (search-backward-regexp ")\\([^ ()\\\n\r\t]\\{0,16\\}\\)\"\\=" nil t) + (setq id (match-string-no-properties 1)) + (let* ((quoted-id (regexp-quote id)) + (quoted-id-depth (regexp-opt-depth quoted-id))) + (while + (and + ;; Search back for an opening delimiter with identifier `id'. + ;; A closing delimiter with `id' "blocks" our search. + (search-backward-regexp ; This could be slow. + (concat "\\(R\"" quoted-id "(\\)" + "\\|" + "\\()" quoted-id "\"\\)") + nil t) + (setq found t) + (if (eq (c-in-literal) 'string) + (match-beginning 1) + (match-beginning (+ 2 quoted-id-depth))))) + (and found + (null (c-in-literal)) + (match-beginning 1))) + (setq Rquote (point)))) + (save-excursion + (goto-char Rquote) + (setq in-macro (c-beginning-of-macro)) + (setq macro-end (when in-macro + (c-end-of-macro) + (point)))) + (if (or (not in-macro) + (<= here macro-end)) + (progn (c-propertize-raw-string-opener - (match-string-no-properties 4) ; id - (1+ (match-beginning 3)) ; open quote - (match-end 4) ; open paren - nil) ; bound - ;; We've found a CPP construct. Search for raw strings within it. - (goto-char (match-beginning 2)) ; the "#" - (c-end-of-macro) - (let ((eom (point))) - (goto-char (match-end 2)) ; after the "#". - (while (and (< (point) eom) - (c-syntactic-re-search-forward - "R\"\\([^ ()\\\n\r\t]\\{0,16\\}\\)(" eom t)) - (c-propertize-raw-string-opener - (match-string-no-properties 1) ; id - (1+ (match-beginning 0)) ; open quote - (match-end 1) ; open paren - eom)))))))) ; bound + id (1+ (point)) (match-end 1) macro-end) + (goto-char here) + t) + (goto-char here) + nil)) + + (t + ;; If the " is in another part of a raw string (whether as part of the + ;; identifier, or in the string itself) the `syntax-table' text + ;; properties on the raw string will be current. So, we can use... + (c-raw-string-pos))))) ;; Handling of small scale constructs like types and names. diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 0b41eff157..e7a3748af4 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1674,25 +1674,36 @@ casts and declarations are fontified. Used on level 2 and higher." (goto-char string-start) (and (eq (char-before) ?R) (looking-at "\"\\([^ ()\\\n\r\t]\\{0,16\\}\\)(") - (match-string-no-properties 1)))))) + (match-string-no-properties 1))))) + (content-start (and raw-id (point)))) + ;; We go round the next loop twice per raw string, once for each "end". (while (< (point) limit) (if raw-id + ;; Search for the raw string end delimiter (progn - (if (search-forward-regexp (concat ")\\(" (regexp-quote raw-id) "\\)\"") - limit 'limit) - (c-put-font-lock-face (match-beginning 1) (point) 'default)) + (when (search-forward-regexp (concat ")\\(" (regexp-quote raw-id) "\\)\"") + limit 'limit) + (c-put-font-lock-face content-start (match-beginning 1) + 'font-lock-string-face) + (c-remove-font-lock-face (match-beginning 1) (point))) (setq raw-id nil)) - + ;; Search for the start of a raw string. (when (search-forward-regexp "R\\(\"\\)\\([^ ()\\\n\r\t]\\{0,16\\}\\)(" limit 'limit) (when - (or (and (eobp) - (eq (c-get-char-property (1- (point)) 'face) - 'font-lock-warning-face)) - (eq (c-get-char-property (point) 'face) 'font-lock-string-face) - (and (equal (c-get-char-property (match-end 2) 'syntax-table) '(1)) - (equal (c-get-char-property (match-beginning 1) 'syntax-table) - '(1)))) + ;; Make sure we're not in a comment or string. + (and + (not (memq (c-get-char-property (match-beginning 0) 'face) + '(font-lock-comment-face font-lock-comment-delimiter-face + font-lock-string-face))) + (or (and (eobp) + (eq (c-get-char-property (1- (point)) 'face) + 'font-lock-warning-face)) + (not (eq (c-get-char-property (point) 'face) 'font-lock-comment-face)) + ;; (eq (c-get-char-property (point) 'face) 'font-lock-string-face) + (and (equal (c-get-char-property (match-end 2) 'syntax-table) '(1)) + (equal (c-get-char-property (match-beginning 1) 'syntax-table) + '(1))))) (let ((paren-prop (c-get-char-property (1- (point)) 'syntax-table))) (if paren-prop (progn @@ -1703,8 +1714,9 @@ casts and declarations are fontified. Used on level 2 and higher." (equal paren-prop '(15)) (not (c-search-forward-char-property 'syntax-table '(15) limit))) (goto-char limit))) - (c-put-font-lock-face (match-beginning 1) (match-end 2) 'default) - (setq raw-id (match-string-no-properties 2))))))))) + (c-remove-font-lock-face (match-beginning 0) (match-end 2)) + (setq raw-id (match-string-no-properties 2)) + (setq content-start (match-end 0))))))))) nil) (defun c-font-lock-c++-lambda-captures (limit) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 7cc8029e0a..22b7b602f1 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -497,25 +497,25 @@ parameters \(point-min) and \(point-max).") ;; For documentation see the following c-lang-defvar of the same name. ;; The value here may be a list of functions or a single function. t '(c-depropertize-new-text - c-after-change-re-mark-unbalanced-strings + c-after-change-mark-abnormal-strings c-change-expand-fl-region) (c objc) '(c-depropertize-new-text c-parse-quotes-after-change - c-after-change-re-mark-unbalanced-strings + c-after-change-mark-abnormal-strings c-extend-font-lock-region-for-macros c-neutralize-syntax-in-CPP c-change-expand-fl-region) c++ '(c-depropertize-new-text + c-after-change-unmark-raw-strings c-parse-quotes-after-change - c-after-change-re-mark-unbalanced-strings + c-after-change-mark-abnormal-strings c-extend-font-lock-region-for-macros - c-after-change-re-mark-raw-strings c-neutralize-syntax-in-CPP c-restore-<>-properties c-change-expand-fl-region) java '(c-depropertize-new-text c-parse-quotes-after-change - c-after-change-re-mark-unbalanced-strings + c-after-change-mark-abnormal-strings c-restore-<>-properties c-change-expand-fl-region) awk '(c-depropertize-new-text diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 8343978fc3..c1fb6aa091 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -678,14 +678,12 @@ that requires a literal mode spec at compile time." (make-variable-buffer-local 'c-new-BEG) (defvar c-new-END 0) (make-variable-buffer-local 'c-new-END) -;; The following two variables record the values of `c-new-BEG' and -;; `c-new-END' just after `c-new-END' has been adjusted for the length of text -;; inserted or removed. They may be read by any after-change function (but -;; should not be altered by one). -(defvar c-old-BEG 0) -(make-variable-buffer-local 'c-old-BEG) -(defvar c-old-END 0) -(make-variable-buffer-local 'c-old-END) + +;; Buffer local variable which notes the value of calling `c-in-literal' just +;; before a change. It is one of 'string, 'c, 'c++ (for the two sorts of +;; comments), or nil. +(defvar c-old-END-literality nil) +(make-variable-buffer-local 'c-old-END-literality) (defun c-common-init (&optional mode) "Common initialization for all CC Mode modes. @@ -900,7 +898,8 @@ Note that the style variables are always made local to the buffer." (defun c-depropertize-CPP (beg end) ;; Remove the punctuation syntax-table text property from the CPP parts of - ;; (c-new-BEG c-new-END). + ;; (c-new-BEG c-new-END), and remove all syntax-table properties from any + ;; raw strings within these CPP parts. ;; ;; This function is in the C/C++/ObjC values of ;; `c-get-state-before-change-functions' and is called exclusively as a @@ -912,6 +911,7 @@ Note that the style variables are always made local to the buffer." (goto-char (match-beginning 1)) (setq m-beg (point)) (c-end-of-macro) + (save-excursion (c-depropertize-raw-strings-in-region m-beg (point))) (c-clear-char-property-with-value m-beg (point) 'syntax-table '(1))) (while (and (< (point) end) @@ -920,14 +920,16 @@ Note that the style variables are always made local to the buffer." (goto-char (match-beginning 1)) (setq m-beg (point)) (c-end-of-macro)) - (if (and ss-found (> (point) end)) - (c-clear-char-property-with-value m-beg (point) 'syntax-table '(1))) + (when (and ss-found (> (point) end)) + (save-excursion (c-depropertize-raw-strings-in-region m-beg (point))) + (c-clear-char-property-with-value m-beg (point) 'syntax-table '(1))) (while (and (< (point) c-new-END) (search-forward-regexp c-anchored-cpp-prefix c-new-END 'bound)) (goto-char (match-beginning 1)) (setq m-beg (point)) (c-end-of-macro) + (save-excursion (c-depropertize-raw-strings-in-region m-beg (point))) (c-clear-char-property-with-value m-beg (point) 'syntax-table '(1))))) @@ -1213,6 +1215,7 @@ Note that the style variables are always made local to the buffer." "\"\\|\\s|" (point-max) t t) (progn (c-clear-char-property (1- (point)) 'syntax-table) + (c-truncate-semi-nonlit-pos-cache (1- (point))) (not (eq (char-before) ?\"))))) (eq (char-before) ?\")) (progn @@ -1247,27 +1250,38 @@ Note that the style variables are always made local to the buffer." (forward-char) (backward-sexp) (c-clear-char-property eoll-1 'syntax-table) + (c-truncate-semi-nonlit-pos-cache eoll-1) (c-clear-char-property (point) 'syntax-table)) ;; Opening " at EOB. (c-clear-char-property (1- (point)) 'syntax-table)) - (if (c-search-backward-char-property 'syntax-table '(15) c-new-BEG) - ;; Opening " on last line of text (without EOL). - (c-clear-char-property (point) 'syntax-table)))) + (when (and (c-search-backward-char-property 'syntax-table '(15) c-new-BEG) + (eq (char-after) ?\")) ; Ignore an unterminated raw string's (. + ;; Opening " on last line of text (without EOL). + (c-clear-char-property (point) 'syntax-table) + (c-truncate-semi-nonlit-pos-cache (point))))) (t (goto-char end) ; point-max - (if (c-search-backward-char-property 'syntax-table '(15) c-new-BEG) - (c-clear-char-property (point) 'syntax-table)))) + (when + (and + (c-search-backward-char-property 'syntax-table '(15) c-new-BEG) + (eq (char-after) ?\")) + (c-clear-char-property (point) 'syntax-table) + (c-truncate-semi-nonlit-pos-cache (point))))) (unless (and c-multiline-string-start-char (not (c-characterp c-multiline-string-start-char))) - (when (eq end-literal-type 'string) - (c-clear-char-property (1- (cdr end-limits)) 'syntax-table)) + (when (and (eq end-literal-type 'string) + (not (eq (char-before (cdr end-limits)) ?\())) + (c-clear-char-property (1- (cdr end-limits)) 'syntax-table) + (c-truncate-semi-nonlit-pos-cache (1- (cdr end-limits)))) - (when (eq beg-literal-type 'string) + (when (and (eq beg-literal-type 'string) + (eq (char-after (car beg-limits)) ?\")) (setq c-new-BEG (min c-new-BEG (car beg-limits))) - (c-clear-char-property (car beg-limits) 'syntax-table))))) + (c-clear-char-property (car beg-limits) 'syntax-table) + (c-truncate-semi-nonlit-pos-cache (car beg-limits)))))) -(defun c-after-change-re-mark-unbalanced-strings (beg end _old-len) +(defun c-after-change-mark-abnormal-strings (beg end _old-len) ;; Mark any unbalanced strings in the region (c-new-BEG c-new-END) with ;; string fence syntax-table text properties. ;; @@ -1318,7 +1332,8 @@ Note that the style variables are always made local to the buffer." (min (1+ (point)) (point-max))))) ((and (null beg-literal-type) (goto-char beg) - (eq (char-before) c-multiline-string-start-char) + (and (not (bobp)) + (eq (char-before) c-multiline-string-start-char)) (memq (char-after) c-string-delims)) (cons (point) (progn @@ -1343,22 +1358,24 @@ Note that the style variables are always made local to the buffer." (while (progn (setq s (parse-partial-sexp (point) c-new-END nil nil s 'syntax-table)) - (and (< (point) c-new-END) - (or (not (nth 3 s)) - (not (memq (char-before) c-string-delims)))))) + (and (< (point) c-new-END) + (or (not (nth 3 s)) + (not (memq (char-before) c-string-delims)))))) ;; We're at the start of a string. (memq (char-before) c-string-delims))) - (if (c-unescaped-nls-in-string-p (1- (point))) - (looking-at "\\(\\\\\\(.\\|\n\\|\r\\)\\|[^\"]\\)*") - (looking-at (cdr (assq (char-before) c-string-innards-re-alist)))) - (cond - ((memq (char-after (match-end 0)) '(?\n ?\r)) - (c-put-char-property (1- (point)) 'syntax-table '(15)) - (c-put-char-property (match-end 0) 'syntax-table '(15))) - ((or (eq (match-end 0) (point-max)) - (eq (char-after (match-end 0)) ?\\)) ; \ at EOB - (c-put-char-property (1- (point)) 'syntax-table '(15)))) - (goto-char (min (1+ (match-end 0)) (point-max))) + (unless (and (c-major-mode-is 'c++-mode) + (c-maybe-re-mark-raw-string)) + (if (c-unescaped-nls-in-string-p (1- (point))) + (looking-at "\\(\\\\\\(.\\|\n|\\\r\\)\\|[^\"]\\)*") + (looking-at (cdr (assq (char-before) c-string-innards-re-alist)))) + (cond + ((memq (char-after (match-end 0)) '(?\n ?\r)) + (c-put-char-property (1- (point)) 'syntax-table '(15)) + (c-put-char-property (match-end 0) 'syntax-table '(15))) + ((or (eq (match-end 0) (point-max)) + (eq (char-after (match-end 0)) ?\\)) ; \ at EOB + (c-put-char-property (1- (point)) 'syntax-table '(15)))) + (goto-char (min (1+ (match-end 0)) (point-max)))) (setq s nil))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1721,7 +1738,6 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") ;; (c-new-BEG c-new-END) will be the region to fontify. It may become ;; larger than (beg end). (setq c-new-END (- (+ c-new-END (- end beg)) old-len)) - (setq c-old-BEG c-new-BEG c-old-END c-new-END) (unless (c-called-from-text-property-change-p) (setq c-just-done-before-change nil) commit c26704483726d454cd554406d41dd7bfde537454 Author: Andreas Schwab Date: Wed Mar 27 10:29:49 2019 +0100 * lisp/calc/calc-forms.el (calc-hms-notation): Fix interactive prompt. diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el index cab48a7f25..fce82d2eaa 100644 --- a/lisp/calc/calc-forms.el +++ b/lisp/calc/calc-forms.el @@ -60,7 +60,7 @@ (defun calc-hms-notation (fmt) - (interactive "sHours-minutes-seconds format (hms, @ \\=' \", etc.): ") + (interactive "sHours-minutes-seconds format (hms, @ ' \", etc.): ") (calc-wrapper (if (string-match "\\`\\([^,; ]+\\)\\([,; ]*\\)\\([^,; ]\\)\\([,; ]*\\)\\([^,; ]\\)\\'" fmt) (progn commit 1d25613265388fbe8ca2c2bf55504e01aae69354 Author: Nicolas Petton Date: Wed Mar 27 10:22:33 2019 +0100 * lisp/emacs-lisp/map.el (map-inplace): Fix the message of the error. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 9a86736fba..54e802edf4 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -399,7 +399,7 @@ If you want to insert an element without modifying MAP, use `map-insert'." ;; and let `map-insert' grow the array? :array (aset map key value))) -(define-error 'map-inplace "Can only modify map in place: %S") +(define-error 'map-inplace "Can only modify map in place") (cl-defgeneric map-insert (map key value) "Return a new map like MAP except that it associates KEY with VALUE.