From 1440dbed544a76ee3b876cb573b5110211e798bb Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Mon, 29 Mar 2021 15:32:40 +0000 Subject: Fix an infinite loop in C++ Mode redisplay. This was bug #47191. * lisp/progmodes/cc-defs.el (c-forward-syntactic-ws, c-backward-syntactic-ws): When point is on the wrong side of a supplied search limit, leave point unmoved rather than setting it to that limit. * lisp/progmodes/cc-engine.el (c-forward-name): After scanning a template argument list (which is not itself subject to a search limit) recalculate the search limit starting from the end point, since these argument lists can legitimately be long. At each of the scanning loops, check point hasn't gone past the limit. --- lisp/progmodes/cc-defs.el | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) (limited to 'lisp/progmodes/cc-defs.el') diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 38fe23b0eaf..536e6766261 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -691,14 +691,16 @@ whitespace. LIMIT sets an upper limit of the forward movement, if specified. If LIMIT or the end of the buffer is reached inside a comment or -preprocessor directive, the point will be left there. +preprocessor directive, the point will be left there. If point starts +on the wrong side of LIMIT, it stays unchanged. Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." (if limit - `(save-restriction - (narrow-to-region (point-min) (or ,limit (point-max))) - (c-forward-sws)) + `(when (< (point) (or ,limit (point-max))) + (save-restriction + (narrow-to-region (point-min) (or ,limit (point-max))) + (c-forward-sws))) '(c-forward-sws))) (defmacro c-backward-syntactic-ws (&optional limit) @@ -710,14 +712,16 @@ whitespace. LIMIT sets a lower limit of the backward movement, if specified. If LIMIT is reached inside a line comment or preprocessor directive then -the point is moved into it past the whitespace at the end. +the point is moved into it past the whitespace at the end. If point +starts on the wrong side of LIMIT, it stays unchanged. Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." (if limit - `(save-restriction - (narrow-to-region (or ,limit (point-min)) (point-max)) - (c-backward-sws)) + `(when (> (point) (or ,limit (point-min))) + (save-restriction + (narrow-to-region (or ,limit (point-min)) (point-max)) + (c-backward-sws))) '(c-backward-sws))) (defmacro c-forward-sexp (&optional count) -- cgit v1.2.3 From 3f5fe0cdfc77b537d2faf148c614d9f8043bf33d Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Sat, 10 Apr 2021 19:18:28 +0000 Subject: Convert CC Mode to lexical binding in Emacs lisp/progmodes/cc-align.el, lisp/progmodes/cc-awk.el, lisp/progmodes/cc-bytecomp.el, lisp/progmodes/cc-cmds.el, lisp/progmodes/cc-defs.el, lisp/progmodes/cc-engine.el, lisp/progmodes/cc-fonts.el, lisp/progmodes/cc-guess.el, lisp/progmodes/cc-langs.el, lisp/progmodes/cc-menus.el, lisp/progmodes/cc-mode.el, lisp/progmodes/cc-styles.el, lisp/progmodes/cc-subword.el, lisp/progmodes/cc-vars.el: Mark these files with a `lexical-binding' setting in line 1. lisp/progmodes/cc-align.el, lisp/progmodes/cc-engine.el, lisp/progmodes/cc-vars.el (c-syntactic-context, c-syntactic-element): Declare these as special variables. lisp/progmodes/cc-bytecomp.el (cc-bytecomp-debug-msg): prefix the parameter ARGS with a _, and remove an `ignore' call. lisp/progmodes/cc-cmds.el (c-where-wrt-brace-construct): Remove `kluge-start', an unused variable. (c-while-widening-to-decl-block): Add an extra parameter, which suppresses the generation of a setting of variable `where'. (c-defun-name-and-limits): Remove variable `where' from the function and use the new argument to the previous macro. lisp/progmodes/cc-engine.el (c-cache-to-parse-ps-state): Remove two unneeded variables, `last' and `intermediate'. lisp/progmodes/cc-fonts.el (c-font-lock-c++-using): Remove unused variable. lisp/progmodes/cc-langs.el (c-vsemi-status-unknown-p-fn): Replace the doc string with the more precise one from stand-alone CC Mode. lisp/progmodes/cc-styles.el (c-set-offset): Give the `ignored' parameter a leading _. --- lisp/progmodes/cc-align.el | 5 ++++- lisp/progmodes/cc-awk.el | 2 +- lisp/progmodes/cc-bytecomp.el | 5 ++--- lisp/progmodes/cc-cmds.el | 39 +++++++++++++++++++++------------------ lisp/progmodes/cc-defs.el | 2 +- lisp/progmodes/cc-engine.el | 17 +++++++++-------- lisp/progmodes/cc-fonts.el | 8 ++++---- lisp/progmodes/cc-guess.el | 2 +- lisp/progmodes/cc-langs.el | 16 +++++++--------- lisp/progmodes/cc-menus.el | 2 +- lisp/progmodes/cc-mode.el | 2 +- lisp/progmodes/cc-styles.el | 4 ++-- lisp/progmodes/cc-vars.el | 5 ++++- 13 files changed, 58 insertions(+), 51 deletions(-) (limited to 'lisp/progmodes/cc-defs.el') diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el index 51d51deef71..9234d0b19b9 100644 --- a/lisp/progmodes/cc-align.el +++ b/lisp/progmodes/cc-align.el @@ -1,4 +1,4 @@ -;;; cc-align.el --- custom indentation functions for CC Mode +;;; cc-align.el --- custom indentation functions for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -44,6 +44,9 @@ (cc-require 'cc-vars) (cc-require 'cc-engine) +(defvar c-syntactic-context) +(defvar c-syntactic-element) + ;; Standard line-up functions ;; diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el index 32289443725..84cc5b115e7 100644 --- a/lisp/progmodes/cc-awk.el +++ b/lisp/progmodes/cc-awk.el @@ -1,4 +1,4 @@ -;;; cc-awk.el --- AWK specific code within cc-mode. +;;; cc-awk.el --- AWK specific code within cc-mode. -*- lexical-binding: t -*- ;; Copyright (C) 1988, 1994, 1996, 2000-2021 Free Software Foundation, ;; Inc. diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el index 3f7caf3c2e9..29f4b81637d 100644 --- a/lisp/progmodes/cc-bytecomp.el +++ b/lisp/progmodes/cc-bytecomp.el @@ -1,4 +1,4 @@ -;;; cc-bytecomp.el --- compile time setup for proper compilation +;;; cc-bytecomp.el --- compile time setup for proper compilation -*- lexical-binding: t -*- ;; Copyright (C) 2000-2021 Free Software Foundation, Inc. @@ -85,8 +85,7 @@ (defvar cc-bytecomp-environment-set nil) -(defmacro cc-bytecomp-debug-msg (&rest args) - (ignore args) +(defmacro cc-bytecomp-debug-msg (&rest _args) ; Change to ARGS when needed. ;;`(message ,@args) ) diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index c8949448271..bee87b68499 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -1,4 +1,4 @@ -;;; cc-cmds.el --- user level commands for CC Mode +;;; cc-cmds.el --- user level commands for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -49,12 +49,11 @@ ; which looks at this. (cc-bytecomp-defun electric-pair-post-self-insert-function) (cc-bytecomp-defvar c-indent-to-body-directives) +(defvar c-syntactic-context) ;; Indentation / Display syntax functions (defvar c-fix-backslashes t) -(defvar c-syntactic-context) - (defun c-indent-line (&optional syntax quiet ignore-point-pos) "Indent the current line according to the syntactic context, if `c-syntactic-indentation' is non-nil. Optional SYNTAX is the @@ -1220,9 +1219,9 @@ numeric argument is supplied, or the point is inside a literal." (self-insert-command (prefix-numeric-value arg))) (setq final-pos (point)) -;;;; 2010-01-31: There used to be code here to put a syntax-table text -;;;; property on the new < or > and its mate (if any) when they are template -;;;; parens. This is now done in an after-change function. +;;;; 2010-01-31: There used to be code here to put a syntax-table text +;;;; property on the new < or > and its mate (if any) when they are template +;;;; parens. This is now done in an after-change function. (when (and (not arg) (not literal)) ;; Have we got a delimiter on a #include directive? @@ -1639,9 +1638,8 @@ No indentation or other \"electric\" behavior is performed." ;; ;; This function might do hidden buffer changes. (save-excursion - (let* (kluge-start - knr-start knr-res - decl-result brace-decl-p + (let* (knr-start knr-res + decl-result (start (point)) (paren-state (c-parse-state)) (least-enclosing (c-least-enclosing-brace paren-state))) @@ -1676,7 +1674,6 @@ No indentation or other \"electric\" behavior is performed." (if (or (and (eolp) (not (eobp))) ; EOL is matched by "\\s>" (not (c-looking-at-non-alphnumspace))) (forward-char)) - (setq kluge-start (point)) (if (and least-enclosing (eq (char-after least-enclosing) ?\()) @@ -1827,12 +1824,14 @@ No indentation or other \"electric\" behavior is performed." nil))) (eval-and-compile - (defmacro c-while-widening-to-decl-block (condition) + (defmacro c-while-widening-to-decl-block (condition &optional no-where) ;; Repeatedly evaluate CONDITION until it returns nil. After each ;; evaluation, if `c-defun-tactic' is set appropriately, widen to innards ;; of the next enclosing declaration block (e.g. namespace, class), or the ;; buffer's original restriction. ;; + ;; If NO-WHERE is non-nil, don't compile in a `(setq where ....)'. + ;; ;; This is a very special purpose macro, which assumes the existence of ;; several variables. It is for use only in c-beginning-of-defun and ;; c-end-of-defun. @@ -1843,7 +1842,8 @@ No indentation or other \"electric\" behavior is performed." (setq paren-state (c-whack-state-after lim paren-state)) (setq lim (c-widen-to-enclosing-decl-scope paren-state orig-point-min orig-point-max)) - (setq where 'in-block)))) + ,@(if (not no-where) + `((setq where 'in-block)))))) (def-edebug-spec c-while-widening-to-decl-block t) @@ -2324,11 +2324,11 @@ with a brace block, at the outermost level of nesting." (c-save-buffer-state ((paren-state (c-parse-state)) (orig-point-min (point-min)) (orig-point-max (point-max)) - lim name limits where) + lim name limits) (setq lim (c-widen-to-enclosing-decl-scope paren-state orig-point-min orig-point-max)) (and lim (setq lim (1- lim))) - (c-while-widening-to-decl-block (not (setq name (c-defun-name-1)))) + (c-while-widening-to-decl-block (not (setq name (c-defun-name-1))) t) (when name (setq limits (c-declaration-limits-1 near)) (cons name limits))) @@ -2944,10 +2944,13 @@ function does not require the declaration to contain a brace block." (c-looking-at-special-brace-list))) (or allow-early-stop (/= here last)) (save-excursion ; Is this a check that we're NOT at top level? -;;;; NO! This seems to check that (i) EITHER we're at the top level; OR (ii) The next enclosing -;;;; level of bracketing is a '{'. HMM. Doesn't seem to make sense. -;;;; 2003/8/8 This might have something to do with the GCC extension "Statement Expressions", e.g. -;;;; while ({stmt1 ; stmt2 ; exp ;}). This form excludes such Statement Expressions. +;;;; NO! This seems to check that (i) EITHER we're at the top level; +;;;; OR (ii) The next enclosing level of bracketing is a '{'. HMM. +;;;; Doesn't seem to make sense. +;;;; 2003/8/8 This might have something to do with the GCC extension +;;;; "Statement Expressions", e.g. +;;;; while ({stmt1 ; stmt2 ; exp ;}). +;;;; This form excludes such Statement Expressions. (or (not (c-safe (up-list -1) t)) (= (char-after) ?{)))) (goto-char last) diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 536e6766261..20dc97db5d7 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -1,4 +1,4 @@ -;;; cc-defs.el --- compile time definitions for CC Mode +;;; cc-defs.el --- compile time definitions for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index cc9833a434e..747a6fd4eda 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -1,4 +1,4 @@ -;;; cc-engine.el --- core syntax guessing engine for CC mode -*- coding: utf-8 -*- +;;; cc-engine.el --- core syntax guessing engine for CC mode -*- lexical-binding:t; coding: utf-8 -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -163,6 +163,8 @@ (defvar c-doc-line-join-re) (defvar c-doc-bright-comment-start-re) (defvar c-doc-line-join-end-ch) +(defvar c-syntactic-context) +(defvar c-syntactic-element) (cc-bytecomp-defvar c-min-syn-tab-mkr) (cc-bytecomp-defvar c-max-syn-tab-mkr) (cc-bytecomp-defun c-clear-syn-tab) @@ -2717,9 +2719,9 @@ comment at the start of cc-engine.el for more info." ;; two char construct (such as a comment opener or an escaped character).) (if (and (consp elt) (>= (length elt) 3)) ;; Inside a string or comment - (let ((depth 0) (containing nil) (last nil) + (let ((depth 0) (containing nil) in-string in-comment - (min-depth 0) com-style com-str-start (intermediate nil) + (min-depth 0) com-style com-str-start (char-1 (nth 3 elt)) ; first char of poss. 2-char construct (pos (car elt)) (type (cadr elt))) @@ -2736,14 +2738,13 @@ comment at the start of cc-engine.el for more info." (1- pos) pos)) (if (memq 'pps-extended-state c-emacs-features) - (list depth containing last + (list depth containing nil in-string in-comment nil min-depth com-style com-str-start - intermediate nil) - (list depth containing last + nil nil) + (list depth containing nil in-string in-comment nil - min-depth com-style com-str-start - intermediate))) + min-depth com-style com-str-start nil))) ;; Not in a string or comment. (if (memq 'pps-extended-state c-emacs-features) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 4e283764ceb..433b4dcf4a8 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1,4 +1,4 @@ -;;; cc-fonts.el --- font lock support for CC Mode +;;; cc-fonts.el --- font lock support for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 2002-2021 Free Software Foundation, Inc. @@ -2287,7 +2287,7 @@ need for `c-font-lock-extra-types'.") ;; font-lock-keyword-face. It always returns NIL to inhibit this and ;; prevent a repeat invocation. See elisp/lispref page "Search-based ;; fontification". - (let (pos after-name) + (let (pos) (while (c-syntactic-re-search-forward c-using-key limit 'end) (while ; Do one declarator of a comma separated list, each time around. (progn @@ -2295,7 +2295,6 @@ need for `c-font-lock-extra-types'.") (setq pos (point)) ; token after "using". (when (and (c-on-identifier) (c-forward-name)) - (setq after-name (point)) (cond ((eq (char-after) ?=) ; using foo = ; (goto-char pos) @@ -2305,7 +2304,8 @@ need for `c-font-lock-extra-types'.") (c-go-up-list-backward) (eq (char-after) ?{) (eq (car (c-beginning-of-decl-1 - (c-determine-limit 1000))) 'same) + (c-determine-limit 1000))) + 'same) (looking-at c-colon-type-list-re))) ;; Inherited protected member: leave unfontified ) diff --git a/lisp/progmodes/cc-guess.el b/lisp/progmodes/cc-guess.el index 1b852ec4910..0824af66b43 100644 --- a/lisp/progmodes/cc-guess.el +++ b/lisp/progmodes/cc-guess.el @@ -1,4 +1,4 @@ -;;; cc-guess.el --- guess indentation values by scanning existing code +;;; cc-guess.el --- guess indentation values by scanning existing code -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2006, 2011-2021 Free Software ;; Foundation, Inc. diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index fa4e73087ef..28a15654277 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -1,4 +1,4 @@ -;;; cc-langs.el --- language specific settings for CC Mode -*- coding: utf-8 -*- +;;; cc-langs.el --- language specific settings for CC Mode -*- lexical-binding: t; coding: utf-8 -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -579,14 +579,12 @@ don't have EOL terminated statements. " (c-lang-defvar c-at-vsemi-p-fn (c-lang-const c-at-vsemi-p-fn)) (c-lang-defconst c-vsemi-status-unknown-p-fn - "Contains a predicate regarding the presence of virtual semicolons. -More precisely, the function answers the question, \"are we unsure whether a -virtual semicolon exists on this line?\". The (admittedly kludgy) purpose of -such a function is to prevent an infinite recursion in -`c-beginning-of-statement-1' when point starts at a `while' token. The function -MUST NOT UNDER ANY CIRCUMSTANCES call `c-beginning-of-statement-1', even -indirectly. This variable contains nil for languages which don't have EOL -terminated statements." + "A function \"are we unsure whether there is a virtual semicolon on this line?\". +The (admittedly kludgy) purpose of such a function is to prevent an infinite +recursion in c-beginning-of-statement-1 when point starts at a `while' token. +The function MUST NOT UNDER ANY CIRCUMSTANCES call `c-beginning-of-statement-1', +even indirectly. This variable contains nil for languages which don't have +EOL terminated statements." t nil (c c++ objc) 'c-macro-vsemi-status-unknown-p awk 'c-awk-vsemi-status-unknown-p) diff --git a/lisp/progmodes/cc-menus.el b/lisp/progmodes/cc-menus.el index 0ff6efb7d37..a099ec1de95 100644 --- a/lisp/progmodes/cc-menus.el +++ b/lisp/progmodes/cc-menus.el @@ -1,4 +1,4 @@ -;;; cc-menus.el --- imenu support for CC Mode +;;; cc-menus.el --- imenu support for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index cfb23d0d45e..dae0062efb5 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1,4 +1,4 @@ -;;; cc-mode.el --- major mode for editing C and similar languages +;;; cc-mode.el --- major mode for editing C and similar languages -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el index 29cbe54c3bd..77cad77711a 100644 --- a/lisp/progmodes/cc-styles.el +++ b/lisp/progmodes/cc-styles.el @@ -1,4 +1,4 @@ -;;; cc-styles.el --- support for styles in CC Mode +;;; cc-styles.el --- support for styles in CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -464,7 +464,7 @@ STYLE using `c-set-style' if the optional SET-P flag is non-nil." offset)) ;;;###autoload -(defun c-set-offset (symbol offset &optional ignored) +(defun c-set-offset (symbol offset &optional _ignored) "Change the value of a syntactic element symbol in `c-offsets-alist'. SYMBOL is the syntactic element symbol to change and OFFSET is the new offset for that syntactic element. The optional argument is not used diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 88ee092da79..b33fea0b48c 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -1,4 +1,4 @@ -;;; cc-vars.el --- user customization variables for CC Mode +;;; cc-vars.el --- user customization variables for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -42,6 +42,9 @@ (cc-require 'cc-defs) +(defvar c-syntactic-context) +(defvar c-syntactic-element) + (cc-eval-when-compile (require 'custom) (require 'widget)) -- cgit v1.2.3 From 31f8ae53beb9bada58750160c1bf7f867ecd442e Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Thu, 15 Apr 2021 10:11:20 +0000 Subject: CC Mode: Put debug specs inside declare forms. Add missing debug specs. * lisp/progmodes/cc-bytecomp.el, lisp/progmodes/cc-cmds.el, lisp/progmodes/cc-defs.el, lisp/progmodes/cc-engine.el, lisp/progmodes/cc-fonts.el, lisp/progmodes/cc-langs.el, lisp/progmodes/cc-mode.el: Change the explicit def-edebug-spec for many macros into a (declare (debug ...) ..) form. Add such forms to macros which were previously lacking def-edebug-spec forms. --- lisp/progmodes/cc-bytecomp.el | 13 +++ lisp/progmodes/cc-cmds.el | 1 + lisp/progmodes/cc-defs.el | 199 ++++++++++++++++-------------------------- lisp/progmodes/cc-engine.el | 41 +++++---- lisp/progmodes/cc-fonts.el | 25 ++---- lisp/progmodes/cc-langs.el | 13 ++- lisp/progmodes/cc-mode.el | 2 + 7 files changed, 124 insertions(+), 170 deletions(-) (limited to 'lisp/progmodes/cc-defs.el') diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el index 29f4b81637d..b3f7020f56e 100644 --- a/lisp/progmodes/cc-bytecomp.el +++ b/lisp/progmodes/cc-bytecomp.el @@ -86,6 +86,7 @@ (defvar cc-bytecomp-environment-set nil) (defmacro cc-bytecomp-debug-msg (&rest _args) ; Change to ARGS when needed. + ;; (declare (debug t)) ;;`(message ,@args) ) @@ -296,6 +297,7 @@ during compilation, but compile in a `require'. Don't use within Having cyclic cc-require's will result in infinite recursion. That's somewhat intentional." + (declare (debug t)) `(progn (eval-when-compile (cc-bytecomp-load (symbol-name ,cc-part))) @@ -308,6 +310,7 @@ time, (ii) generate code to load the file at load time. CC-PART will normally be a quoted name such as \\='cc-fix. CONDITION should not be quoted." + (declare (debug t)) (if (eval condition) (progn (cc-bytecomp-load (symbol-name (eval cc-part))) @@ -322,6 +325,7 @@ after the loading of FILE. CC-PART will normally be a quoted name such as \\='cc-fix. FILE should be a string. CONDITION should not be quoted." + (declare (debug t)) (if (eval condition) (progn (cc-bytecomp-load (symbol-name (eval cc-part))) @@ -332,6 +336,7 @@ should be a string. CONDITION should not be quoted." (defmacro cc-provide (feature) "A replacement for the `provide' form that restores the environment after the compilation. Don't use within `eval-when-compile'." + (declare (debug t)) `(progn (eval-when-compile (cc-bytecomp-restore-environment)) (provide ,feature))) @@ -343,6 +348,7 @@ during compilation. Don't use outside `eval-when-compile' or Having cyclic cc-load's will result in infinite recursion. That's somewhat intentional." + (declare (debug t)) `(or (and (featurep 'cc-bytecomp) (cc-bytecomp-load ,cc-part)) (load ,cc-part nil t nil))) @@ -351,6 +357,7 @@ somewhat intentional." "Force loading of the corresponding .el file in the current directory during compilation, but do a compile time `require' otherwise. Don't use within `eval-when-compile'." + (declare (debug t)) `(eval-when-compile (if (and (fboundp 'cc-bytecomp-is-compiling) (cc-bytecomp-is-compiling)) @@ -362,6 +369,7 @@ use within `eval-when-compile'." "Do a `require' of an external package. This restores and sets up the compilation environment before and afterwards. Don't use within `eval-when-compile'." + (declare (debug t)) `(progn (eval-when-compile (cc-bytecomp-restore-environment)) (require ,feature) @@ -370,6 +378,7 @@ afterwards. Don't use within `eval-when-compile'." (defmacro cc-bytecomp-defvar (var) "Binds the symbol as a variable during compilation of the file, to silence the byte compiler. Don't use within `eval-when-compile'." + (declare (debug nil)) `(eval-when-compile (if (boundp ',var) (cc-bytecomp-debug-msg @@ -397,6 +406,7 @@ definition. That means that this macro will not shut up warnings about incorrect number of arguments. It's dangerous to try to replace existing functions since the byte compiler might need the definition at compile time, e.g. for macros and inline functions." + (declare (debug nil)) `(eval-when-compile (if (fboundp ',fun) (cc-bytecomp-debug-msg @@ -418,6 +428,7 @@ at compile time, e.g. for macros and inline functions." (defmacro cc-bytecomp-put (symbol propname value) "Set a property on a symbol during compilation (and evaluation) of the file. Don't use outside `eval-when-compile'." + (declare (debug t)) `(eval-when-compile (if (not (assoc (cons ,symbol ,propname) cc-bytecomp-original-properties)) (progn @@ -438,6 +449,7 @@ the file. Don't use outside `eval-when-compile'." the compilation. This is the same as using `boundp' but additionally exclude any variables that have been bound during compilation with `cc-bytecomp-defvar'." + (declare (debug t)) (if (and (cc-bytecomp-is-compiling) (memq (car (cdr symbol)) cc-bytecomp-unbound-variables)) nil @@ -448,6 +460,7 @@ exclude any variables that have been bound during compilation with the compilation. This is the same as using `fboundp' but additionally exclude any functions that have been bound during compilation with `cc-bytecomp-defun'." + (declare (debug t)) (let (fun-elem) (if (and (cc-bytecomp-is-compiling) (setq fun-elem (assq (car (cdr symbol)) diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index bee87b68499..bdfdf178d43 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -1835,6 +1835,7 @@ No indentation or other \"electric\" behavior is performed." ;; This is a very special purpose macro, which assumes the existence of ;; several variables. It is for use only in c-beginning-of-defun and ;; c-end-of-defun. + (declare (debug t)) `(while (and ,condition (eq c-defun-tactic 'go-outward) diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 20dc97db5d7..4f79fa9b330 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -125,7 +125,7 @@ The result of the body appears to the compiler as a quoted constant. This variant works around bugs in `eval-when-compile' in various \(X)Emacs versions. See cc-defs.el for details." - + (declare (indent 0) (debug t)) (if c-inside-eval-when-compile ;; XEmacs 21.4.6 has a bug in `eval-when-compile' in that it ;; evaluates its body at macro expansion time if it's nested @@ -170,9 +170,7 @@ This variant works around bugs in `eval-when-compile' in various ;; constant that we eval. That otoh introduce a problem in ;; that a returned lambda expression doesn't get byte ;; compiled (even if `function' is used). - (eval '(let ((c-inside-eval-when-compile t)) ,@body))))) - - (put 'cc-eval-when-compile 'lisp-indent-hook 0)) + (eval '(let ((c-inside-eval-when-compile t)) ,@body)))))) ;;; Macros. @@ -181,6 +179,7 @@ This variant works around bugs in `eval-when-compile' in various ;; between the host [X]Emacsen." ;; The motivation for this macro is to avoid the irritating message ;; "function `mapcan' from cl package called at runtime" produced by Emacs. + (declare (debug t)) (cond ((and (fboundp 'mapcan) (subrp (symbol-function 'mapcan))) @@ -196,18 +195,21 @@ This variant works around bugs in `eval-when-compile' in various (defmacro c--set-difference (liszt1 liszt2 &rest other-args) ;; Macro to smooth out the renaming of `set-difference' in Emacs 24.3. + (declare (debug (form form &rest [symbolp form]))) (if (eq c--cl-library 'cl-lib) `(cl-set-difference ,liszt1 ,liszt2 ,@other-args) `(set-difference ,liszt1 ,liszt2 ,@other-args))) (defmacro c--intersection (liszt1 liszt2 &rest other-args) ;; Macro to smooth out the renaming of `intersection' in Emacs 24.3. + (declare (debug (form form &rest [symbolp form]))) (if (eq c--cl-library 'cl-lib) `(cl-intersection ,liszt1 ,liszt2 ,@other-args) `(intersection ,liszt1 ,liszt2 ,@other-args))) (eval-and-compile (defmacro c--macroexpand-all (form &optional environment) + (declare (debug t)) ;; Macro to smooth out the renaming of `cl-macroexpand-all' in Emacs 24.3. (if (fboundp 'macroexpand-all) `(macroexpand-all ,form ,environment) @@ -215,6 +217,7 @@ This variant works around bugs in `eval-when-compile' in various (defmacro c--delete-duplicates (cl-seq &rest cl-keys) ;; Macro to smooth out the renaming of `delete-duplicates' in Emacs 24.3. + (declare (debug (form &rest [symbolp form]))) (if (eq c--cl-library 'cl-lib) `(cl-delete-duplicates ,cl-seq ,@cl-keys) `(delete-duplicates ,cl-seq ,@cl-keys)))) @@ -222,6 +225,7 @@ This variant works around bugs in `eval-when-compile' in various (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." + (declare (debug t)) (if (fboundp 'font-lock-flush) `(font-lock-flush ,beg ,end) `(font-lock-fontify-region ,beg ,end))) @@ -249,6 +253,7 @@ one of the following symbols: If the referenced position doesn't exist, the closest accessible point to it is returned. This function does not modify the point or the mark." + (declare (debug t)) (if (eq (car-safe position) 'quote) (let ((position (eval position))) (cond @@ -417,6 +422,7 @@ to it is returned. This function does not modify the point or the mark." (defmacro c-is-escaped (pos) ;; Are there an odd number of backslashes before POS? + (declare (debug t)) `(save-excursion (goto-char ,pos) (not (zerop (logand (skip-chars-backward "\\\\") 1))))) @@ -424,6 +430,7 @@ to it is returned. This function does not modify the point or the mark." (defmacro c-will-be-escaped (pos beg end) ;; Will the character after POS be escaped after the removal of (BEG END)? ;; It is assumed that (>= POS END). + (declare (debug t)) `(save-excursion (let ((-end- ,end) count) @@ -436,6 +443,7 @@ to it is returned. This function does not modify the point or the mark." (defmacro c-will-be-unescaped (beg) ;; Would the character after BEG be unescaped? + (declare (debug t)) `(save-excursion (let (count) (goto-char ,beg) @@ -446,6 +454,7 @@ to it is returned. This function does not modify the point or the mark." (defmacro c-next-single-property-change (position prop &optional object limit) ;; See the doc string for either of the defuns expanded to. + (declare (debug t)) (if (and c-use-extents (fboundp 'next-single-char-property-change)) ;; XEmacs >= 2005-01-25 @@ -455,6 +464,7 @@ to it is returned. This function does not modify the point or the mark." (defmacro c-previous-single-property-change (position prop &optional object limit) ;; See the doc string for either of the defuns expanded to. + (declare (debug t)) (if (and c-use-extents (fboundp 'previous-single-char-property-change)) ;; XEmacs >= 2005-01-25 @@ -474,6 +484,7 @@ to it is returned. This function does not modify the point or the mark." (defmacro c-set-region-active (activate) ;; Activate the region if ACTIVE is non-nil, deactivate it ;; otherwise. Covers the differences between Emacs and XEmacs. + (declare (debug t)) (if (fboundp 'zmacs-activate-region) ;; XEmacs. `(if ,activate @@ -483,6 +494,7 @@ to it is returned. This function does not modify the point or the mark." `(setq mark-active ,activate))) (defmacro c-set-keymap-parent (map parent) + (declare (debug t)) (cond ;; XEmacs ((cc-bytecomp-fboundp 'set-keymap-parents) @@ -495,6 +507,7 @@ to it is returned. This function does not modify the point or the mark." (defmacro c-delete-and-extract-region (start end) "Delete the text between START and END and return it." + (declare (debug t)) (if (cc-bytecomp-fboundp 'delete-and-extract-region) ;; Emacs 21.1 and later `(delete-and-extract-region ,start ,end) @@ -505,15 +518,16 @@ to it is returned. This function does not modify the point or the mark." (defmacro c-safe (&rest body) ;; safely execute BODY, return nil if an error occurred + (declare (indent 0) (debug t)) `(condition-case nil (progn ,@body) (error nil))) -(put 'c-safe 'lisp-indent-function 0) (defmacro c-int-to-char (integer) ;; In Emacs, a character is an integer. In XEmacs, a character is a ;; type distinct from an integer. Sometimes we need to convert integers to ;; characters. `c-int-to-char' makes this conversion, if necessary. + (declare (debug t)) (if (fboundp 'int-to-char) `(int-to-char ,integer) integer)) @@ -521,6 +535,7 @@ to it is returned. This function does not modify the point or the mark." (defmacro c-characterp (arg) ;; Return t when ARG is a character (XEmacs) or integer (Emacs), otherwise ;; return nil. + (declare (debug t)) (if (integerp ?c) `(integerp ,arg) `(characterp ,arg))) @@ -567,6 +582,7 @@ to it is returned. This function does not modify the point or the mark." ;; string opener, or after the introductory R of one. The match data is ;; overwritten. On success the opener's identifier will be (match-string ;; 1). Text properties on any characters are ignored. + (declare (debug t)) (if pos `(save-excursion (goto-char ,pos) @@ -628,6 +644,7 @@ If BODY makes a change that unconditionally is undone then wrap this macro inside `c-save-buffer-state'. That way the change can be done even when the buffer is read-only, and without interference from various buffer change hooks." + (declare (indent 0) (debug t)) `(let (-tnt-chng-keep -tnt-chng-state) (unwind-protect @@ -638,7 +655,6 @@ various buffer change hooks." -tnt-chng-state (c-tnt-chng-record-state) -tnt-chng-keep (progn ,@body)) (c-tnt-chng-cleanup -tnt-chng-keep -tnt-chng-state)))) -(put 'c-tentative-buffer-changes 'lisp-indent-function 0) (defun c-tnt-chng-record-state () ;; Used internally in `c-tentative-buffer-changes'. @@ -696,6 +712,7 @@ on the wrong side of LIMIT, it stays unchanged. Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." + (declare (debug t)) (if limit `(when (< (point) (or ,limit (point-max))) (save-restriction @@ -717,6 +734,7 @@ starts on the wrong side of LIMIT, it stays unchanged. Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." + (declare (debug t)) (if limit `(when (> (point) (or ,limit (point-min))) (save-restriction @@ -733,11 +751,13 @@ This is like `forward-sexp' except that it isn't interactive and does not do any user friendly adjustments of the point and that it isn't susceptible to user configurations such as disabling of signals in certain situations." + (declare (debug t)) (or count (setq count 1)) `(goto-char (scan-sexps (point) ,count))) (defmacro c-backward-sexp (&optional count) "See `c-forward-sexp' and reverse directions." + (declare (debug t)) (or count (setq count 1)) `(c-forward-sexp ,(if (numberp count) (- count) `(- ,count)))) @@ -747,6 +767,7 @@ for unbalanced parens. A limit for the search may be given. FROM is assumed to be on the right side of it." + (declare (debug t)) (let ((res (if (featurep 'xemacs) `(scan-lists ,from ,count ,depth nil t) `(c-safe (scan-lists ,from ,count ,depth))))) @@ -774,6 +795,7 @@ leave point unmoved. A LIMIT for the search may be given. The start position is assumed to be before it." + (declare (debug t)) `(let ((dest (c-safe-scan-lists ,(or pos '(point)) 1 0 ,limit))) (when dest (goto-char dest) dest))) @@ -784,6 +806,7 @@ leave point unmoved. A LIMIT for the search may be given. The start position is assumed to be after it." + (declare (debug t)) `(let ((dest (c-safe-scan-lists ,(or pos '(point)) -1 0 ,limit))) (when dest (goto-char dest) dest))) @@ -793,6 +816,7 @@ or nil if no such position exists. The point is used if POS is left out. A limit for the search may be given. The start position is assumed to be before it." + (declare (debug t)) `(c-safe-scan-lists ,(or pos '(point)) 1 1 ,limit)) (defmacro c-up-list-backward (&optional pos limit) @@ -801,6 +825,7 @@ or nil if no such position exists. The point is used if POS is left out. A limit for the search may be given. The start position is assumed to be after it." + (declare (debug t)) `(c-safe-scan-lists ,(or pos '(point)) -1 1 ,limit)) (defmacro c-down-list-forward (&optional pos limit) @@ -809,6 +834,7 @@ or nil if no such position exists. The point is used if POS is left out. A limit for the search may be given. The start position is assumed to be before it." + (declare (debug t)) `(c-safe-scan-lists ,(or pos '(point)) 1 -1 ,limit)) (defmacro c-down-list-backward (&optional pos limit) @@ -817,6 +843,7 @@ or nil if no such position exists. The point is used if POS is left out. A limit for the search may be given. The start position is assumed to be after it." + (declare (debug t)) `(c-safe-scan-lists ,(or pos '(point)) -1 -1 ,limit)) (defmacro c-go-up-list-forward (&optional pos limit) @@ -826,6 +853,7 @@ position exists, otherwise nil is returned and the point isn't moved. A limit for the search may be given. The start position is assumed to be before it." + (declare (debug t)) `(let ((dest (c-up-list-forward ,pos ,limit))) (when dest (goto-char dest) t))) @@ -836,6 +864,7 @@ position exists, otherwise nil is returned and the point isn't moved. A limit for the search may be given. The start position is assumed to be after it." + (declare (debug t)) `(let ((dest (c-up-list-backward ,pos ,limit))) (when dest (goto-char dest) t))) @@ -846,6 +875,7 @@ exists, otherwise nil is returned and the point isn't moved. A limit for the search may be given. The start position is assumed to be before it." + (declare (debug t)) `(let ((dest (c-down-list-forward ,pos ,limit))) (when dest (goto-char dest) t))) @@ -856,6 +886,7 @@ exists, otherwise nil is returned and the point isn't moved. A limit for the search may be given. The start position is assumed to be after it." + (declare (debug t)) `(let ((dest (c-down-list-backward ,pos ,limit))) (when dest (goto-char dest) t))) @@ -967,6 +998,7 @@ be after it." ;; point)? Always returns nil for languages which don't have Virtual ;; semicolons. ;; This macro might do hidden buffer changes. + (declare (debug t)) `(if c-at-vsemi-p-fn (funcall c-at-vsemi-p-fn ,@(if pos `(,pos))))) @@ -984,6 +1016,7 @@ be after it." (defmacro c-benign-error (format &rest args) ;; Formats an error message for the echo area and dings, i.e. like ;; `error' but doesn't abort. + (declare (debug t)) `(progn (message ,format ,@args) (ding))) @@ -993,18 +1026,19 @@ be after it." ;; way to execute code. ;; Maintainers' note: If TABLE is `c++-template-syntax-table', DON'T call ;; any forms inside this that call `c-parse-state'. !!!! + (declare (indent 1) (debug t)) `(let ((c-with-syntax-table-orig-table (syntax-table))) (unwind-protect (progn (set-syntax-table ,table) ,@code) (set-syntax-table c-with-syntax-table-orig-table)))) -(put 'c-with-syntax-table 'lisp-indent-function 1) (defmacro c-skip-ws-forward (&optional limit) "Skip over any whitespace following point. This function skips over horizontal and vertical whitespace and line continuations." + (declare (debug t)) (if limit `(let ((limit (or ,limit (point-max)))) (while (progn @@ -1026,6 +1060,7 @@ continuations." "Skip over any whitespace preceding point. This function skips over horizontal and vertical whitespace and line continuations." + (declare (debug t)) (if limit `(let ((limit (or ,limit (point-min)))) (while (progn @@ -1048,6 +1083,7 @@ continuations." "Return non-nil if the current CC Mode major mode is MODE. MODE is either a mode symbol or a list of mode symbols." + (declare (debug t)) (if c-langs-are-parametric ;; Inside a `c-lang-defconst'. `(c-lang-major-mode-is ,mode) @@ -1130,6 +1166,7 @@ MODE is either a mode symbol or a list of mode symbols." ;; 21) then it's assumed that the property is present on it. ;; ;; This macro does a hidden buffer change. + (declare (debug t)) (setq property (eval property)) (if (or c-use-extents (not (cc-bytecomp-boundp 'text-property-default-nonsticky))) @@ -1147,6 +1184,7 @@ MODE is either a mode symbol or a list of mode symbols." ;; Get the value of the given property on the character at POS if ;; it's been put there by `c-put-char-property'. PROPERTY is ;; assumed to be constant. + (declare (debug t)) (setq property (eval property)) (if c-use-extents ;; XEmacs. @@ -1177,6 +1215,7 @@ MODE is either a mode symbol or a list of mode symbols." ;; constant. ;; ;; This macro does a hidden buffer change. + (declare (debug t)) (setq property (eval property)) (cond (c-use-extents ;; XEmacs. @@ -1199,6 +1238,7 @@ MODE is either a mode symbol or a list of mode symbols." ;; Return the first position in the range [FROM to) where the text property ;; PROPERTY is set, or `most-positive-fixnum' if there is no such position. ;; PROPERTY should be a quoted constant. + (declare (debug t)) `(let ((-from- ,from) (-to- ,to) pos) (cond ((and (< -from- -to-) @@ -1220,6 +1260,7 @@ MODE is either a mode symbol or a list of mode symbols." ;; `syntax-table'. ;; ;; This macro does hidden buffer changes. + (declare (debug t)) (setq property (eval property)) (if c-use-extents ;; XEmacs. @@ -1239,6 +1280,7 @@ MODE is either a mode symbol or a list of mode symbols." (defmacro c-clear-syn-tab-properties (from to) ;; Remove all occurrences of the `syntax-table' and `c-fl-syn-tab' text ;; properties between FROM and TO. + (declare (debug t)) `(let ((-from- ,from) (-to- ,to)) (when (and c-min-syn-tab-mkr c-max-syn-tab-mkr @@ -1260,6 +1302,7 @@ LIMIT bounds the search. The comparison is done with `equal'. Leave point just after the character, and set the match data on this character, and return point. If VALUE isn't found, Return nil; point is then left undefined." + (declare (debug t)) `(let ((place (point))) (while (and @@ -1279,6 +1322,7 @@ LIMIT bounds the search. The comparison is done with `equal'. Leave point just before the character, set the match data on this character, and return point. If VALUE isn't found, Return nil; point is then left undefined." + (declare (debug t)) `(let ((place (point))) (while (and @@ -1322,6 +1366,7 @@ been put there by c-put-char-property. POINT remains unchanged." which have the value VALUE, 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." + (declare (debug t)) (if c-use-extents ;; XEmacs `(let ((-property- ,property)) @@ -1342,6 +1387,7 @@ 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." + (declare (debug t)) `(let ((char-skip (concat "^" (char-to-string ,char))) (-limit- (or ,limit (point-max))) (-value- ,value)) @@ -1365,6 +1411,7 @@ PROPERTY must be a constant. Leave point just before the character, and set the match data on this character, and return point. If the search fails, return nil; point is then left undefined." + (declare (debug t)) `(let ((char-skip (concat "^" (char-to-string ,char))) (-limit- (or ,limit (point-min))) (-value- ,value)) @@ -1388,6 +1435,7 @@ 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." + (declare (debug t)) `(let ((char-skip (concat "^" (char-to-string ,char))) (-limit- (or ,limit (point-max))) (-value- ,value)) @@ -1436,6 +1484,7 @@ by `equal'. These properties are assumed to be over individual characters, having been put there by c-put-char-property. POINT remains unchanged. Return the position of the first removed property, or nil." + (declare (debug t)) (if c-use-extents ;; XEmacs `(let ((-property- ,property) @@ -1459,6 +1508,7 @@ property, or nil." ;; `c-put-char-property' must be a constant. "Put the text property PROPERTY with value VALUE on characters with value CHAR in the region [FROM to)." + (declare (debug t)) `(let ((skip-string (concat "^" (list ,char))) (-to- ,to)) (save-excursion @@ -1481,6 +1531,7 @@ with value CHAR in the region [FROM to)." ;; Put an overlay/extent covering the given range in the current ;; buffer. It's currently undefined whether it's front/end sticky ;; or not. The overlay/extent object is returned. + (declare (debug t)) (if (cc-bytecomp-fboundp 'make-overlay) ;; Emacs. `(let ((ol (make-overlay ,from ,to))) @@ -1494,86 +1545,13 @@ with value CHAR in the region [FROM to)." (defmacro c-delete-overlay (overlay) ;; Deletes an overlay/extent object previously retrieved using ;; `c-put-overlay'. + (declare (debug t)) (if (cc-bytecomp-fboundp 'make-overlay) ;; Emacs. `(delete-overlay ,overlay) ;; XEmacs. `(delete-extent ,overlay))) - -;; Make edebug understand the macros. -;(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])) -(def-edebug-spec c--delete-duplicates (form &rest [symbolp form])) -(def-edebug-spec c-point t) -(def-edebug-spec c-is-escaped t) -(def-edebug-spec c-will-be-escaped t) -(def-edebug-spec c-next-single-property-change t) -(def-edebug-spec c-delete-and-extract-region t) -(def-edebug-spec c-set-region-active t) -(def-edebug-spec c-set-keymap-parent t) -(def-edebug-spec c-safe t) -(def-edebug-spec c-int-to-char t) -(def-edebug-spec c-characterp t) -(def-edebug-spec c-save-buffer-state let*) -(def-edebug-spec c-tentative-buffer-changes t) -(def-edebug-spec c-forward-syntactic-ws t) -(def-edebug-spec c-backward-syntactic-ws t) -(def-edebug-spec c-forward-sexp t) -(def-edebug-spec c-backward-sexp t) -(def-edebug-spec c-safe-scan-lists t) -(def-edebug-spec c-go-list-forward t) -(def-edebug-spec c-go-list-backward t) -(def-edebug-spec c-up-list-forward t) -(def-edebug-spec c-up-list-backward t) -(def-edebug-spec c-down-list-forward t) -(def-edebug-spec c-down-list-backward t) -(def-edebug-spec c-go-up-list-forward t) -(def-edebug-spec c-go-up-list-backward t) -(def-edebug-spec c-go-down-list-forward t) -(def-edebug-spec c-go-down-list-backward t) -(def-edebug-spec c-at-vsemi-p t) -(def-edebug-spec c-add-syntax t) -(def-edebug-spec c-add-class-syntax t) -(def-edebug-spec c-benign-error t) -(def-edebug-spec c-with-syntax-table t) -(def-edebug-spec c-skip-ws-forward t) -(def-edebug-spec c-skip-ws-backward t) -(def-edebug-spec c-major-mode-is t) -(def-edebug-spec c-search-forward-char-property t) -(def-edebug-spec c-search-backward-char-property t) -(def-edebug-spec c-put-char-property t) -(def-edebug-spec c-put-syn-tab t) -(def-edebug-spec c-get-char-property t) -(def-edebug-spec c-clear-char-property t) -(def-edebug-spec c-clear-syn-tab t) -;;(def-edebug-spec c-min-property-position nil) ; invoked only by macros -(def-edebug-spec c-min-property-position t) ; Now invoked from functions (2019-07) -(def-edebug-spec c-clear-char-property-with-value t) -(def-edebug-spec c-clear-char-property-with-value-on-char t) -(def-edebug-spec c-put-char-properties-on-char t) -(def-edebug-spec c-clear-char-properties t) -(def-edebug-spec c-clear-syn-tab-properties t) -(def-edebug-spec c-with-extended-string-fences (form form body)) -(def-edebug-spec c-put-overlay t) -(def-edebug-spec c-delete-overlay t) -(def-edebug-spec c-mark-<-as-paren t) -(def-edebug-spec c-mark->-as-paren t) -(def-edebug-spec c-unmark-<->-as-paren t) -(def-edebug-spec c-with-<->-as-parens-suppressed (body)) -(def-edebug-spec c-self-bind-state-cache (body)) -(def-edebug-spec c-sc-scan-lists-no-category+1+1 t) -(def-edebug-spec c-sc-scan-lists-no-category+1-1 t) -(def-edebug-spec c-sc-scan-lists-no-category-1+1 t) -(def-edebug-spec c-sc-scan-lists-no-category-1-1 t) -(def-edebug-spec c-sc-scan-lists t) -(def-edebug-spec c-sc-parse-partial-sexp t);)) - ;;; Functions. @@ -1604,6 +1582,7 @@ with value CHAR in the region [FROM to)." ;; indirection through the `category' text property. This allows us to ;; toggle the property in all template brackets simultaneously and ;; cheaply. We use this, for instance, in `c-parse-state'. + (declare (debug t)) (if c-use-category `(c-put-char-property ,pos 'category 'c-<-as-paren-syntax) `(c-put-char-property ,pos 'syntax-table c-<-as-paren-syntax))) @@ -1618,6 +1597,7 @@ with value CHAR in the region [FROM to)." ;; indirection through the `category' text property. This allows us to ;; toggle the property in all template brackets simultaneously and ;; cheaply. We use this, for instance, in `c-parse-state'. + (declare (debug t)) (if c-use-category `(c-put-char-property ,pos 'category 'c->-as-paren-syntax) `(c-put-char-property ,pos 'syntax-table c->-as-paren-syntax))) @@ -1631,6 +1611,7 @@ with value CHAR in the region [FROM to)." ;; indirection through the `category' text property. This allows us to ;; toggle the property in all template brackets simultaneously and ;; cheaply. We use this, for instance, in `c-parse-state'. + (declare (debug t)) `(c-clear-char-property ,pos ,(if c-use-category ''category ''syntax-table))) (defsubst c-suppress-<->-as-parens () @@ -1651,50 +1632,13 @@ with value CHAR in the region [FROM to)." ;; Like progn, except that the paren property is suppressed on all ;; template brackets whilst they are running. This macro does a hidden ;; buffer change. + (declare (debug (body))) `(unwind-protect (progn (c-suppress-<->-as-parens) ,@forms) (c-restore-<->-as-parens))) -;;;;;;;;;;;;;;; - -(defmacro c-self-bind-state-cache (&rest forms) - ;; Bind the state cache to itself and execute the FORMS. Return the result - ;; of the last FORM executed. It is assumed that no buffer changes will - ;; happen in FORMS, and no hidden buffer changes which could affect the - ;; parsing will be made by FORMS. - `(let* ((c-state-cache (copy-tree c-state-cache)) - (c-state-cache-good-pos c-state-cache-good-pos) - ;(c-state-nonlit-pos-cache (copy-tree c-state-nonlit-pos-cache)) - ;(c-state-nonlit-pos-cache-limit c-state-nonlit-pos-cache-limit) - ;(c-state-semi-nonlit-pos-cache (copy-tree c-state-semi-nonlit-pos-cache)) - ;(c-state-semi-nonlit-pos-cache-limit c-state-semi-nonlit-pos-cache) - (c-state-brace-pair-desert (copy-tree c-state-brace-pair-desert)) - (c-state-point-min c-state-point-min) - (c-state-point-min-lit-type c-state-point-min-lit-type) - (c-state-point-min-lit-start c-state-point-min-lit-start) - (c-state-min-scan-pos c-state-min-scan-pos) - (c-state-old-cpp-beg-marker (if (markerp c-state-old-cpp-beg-marker) - (copy-marker c-state-old-cpp-beg-marker) - c-state-old-cpp-beg-marker)) - (c-state-old-cpp-beg (if (markerp c-state-old-cpp-beg) - c-state-old-cpp-beg-marker - c-state-old-cpp-beg)) - (c-state-old-cpp-end-marker (if (markerp c-state-old-cpp-end-marker) - (copy-marker c-state-old-cpp-end-marker) - c-state-old-cpp-end-marker)) - (c-state-old-cpp-end (if (markerp c-state-old-cpp-end) - c-state-old-cpp-end-marker - c-state-old-cpp-end)) - (c-parse-state-state c-parse-state-state)) - (prog1 - (progn ,@forms) - (if (markerp c-state-old-cpp-beg-marker) - (move-marker c-state-old-cpp-beg-marker nil)) - (if (markerp c-state-old-cpp-end-marker) - (move-marker c-state-old-cpp-end-marker nil))))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; The following macros are to be used only in `c-parse-state' and its ;; subroutines. Their main purpose is to simplify the handling of C++/Java @@ -1708,6 +1652,7 @@ with value CHAR in the region [FROM to)." ;; Do a (scan-lists FROM 1 1). Any finishing position which either (i) is ;; determined by and angle bracket; or (ii) is inside a macro whose start ;; isn't POINT-MACRO-START doesn't count as a finishing position. + (declare (debug t)) `(let ((here (point)) (pos (scan-lists ,from 1 1))) (while (eq (char-before pos) ?>) @@ -1718,6 +1663,7 @@ with value CHAR in the region [FROM to)." ;; Do a (scan-lists FROM 1 -1). Any finishing position which either (i) is ;; determined by an angle bracket; or (ii) is inside a macro whose start ;; isn't POINT-MACRO-START doesn't count as a finishing position. + (declare (debug t)) `(let ((here (point)) (pos (scan-lists ,from 1 -1))) (while (eq (char-before pos) ?<) @@ -1729,6 +1675,7 @@ with value CHAR in the region [FROM to)." ;; Do a (scan-lists FROM -1 1). Any finishing position which either (i) is ;; determined by and angle bracket; or (ii) is inside a macro whose start ;; isn't POINT-MACRO-START doesn't count as a finishing position. + (declare (debug t)) `(let ((here (point)) (pos (scan-lists ,from -1 1))) (while (eq (char-after pos) ?<) @@ -1739,6 +1686,7 @@ with value CHAR in the region [FROM to)." ;; Do a (scan-lists FROM -1 -1). Any finishing position which either (i) is ;; determined by and angle bracket; or (ii) is inside a macro whose start ;; isn't POINT-MACRO-START doesn't count as a finishing position. + (declare (debug t)) `(let ((here (point)) (pos (scan-lists ,from -1 -1))) (while (eq (char-after pos) ?>) @@ -1747,6 +1695,7 @@ with value CHAR in the region [FROM to)." pos)) (defmacro c-sc-scan-lists (from count depth) + (declare (debug t)) (if c-use-category `(scan-lists ,from ,count ,depth) (cond @@ -1794,6 +1743,7 @@ with value CHAR in the region [FROM to)." (defmacro c-sc-parse-partial-sexp (from to &optional targetdepth stopbefore oldstate) + (declare (debug t)) (if c-use-category `(parse-partial-sexp ,from ,to ,targetdepth ,stopbefore ,oldstate) `(c-sc-parse-partial-sexp-no-category ,from ,to ,targetdepth ,stopbefore @@ -2354,6 +2304,7 @@ system." "Can be used inside a VAL in `c-lang-defconst' to evaluate FORM immediately, i.e. at the same time as the `c-lang-defconst' form itself is evaluated." + (declare (debug t)) ;; Evaluate at macro expansion time, i.e. in the ;; `c--macroexpand-all' inside `c-lang-defconst'. (eval form)) @@ -2396,7 +2347,8 @@ one `c-lang-defconst' for each NAME is permitted per file. If there already is one it will be completely replaced; the value in the earlier definition will not affect `c-lang-const' on the same constant. A file is identified by its base name." - + (declare (indent 1) + (debug (&define name [&optional stringp] [&rest sexp def-form]))) (let* ((sym (intern (symbol-name name) c-lang-constants)) ;; Make `c-lang-const' expand to a straightforward call to ;; `c-get-lang-constant' in `c--macroexpand-all' below. @@ -2487,12 +2439,6 @@ constant. A file is identified by its base name." (c-define-lang-constant ',name ,bindings ,@(and pre-files `(',pre-files)))))) -(put 'c-lang-defconst 'lisp-indent-function 1) -;(eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el. -; ' -(def-edebug-spec c-lang-defconst - (&define name [&optional stringp] [&rest sexp def-form])) - (defun c-define-lang-constant (name bindings &optional pre-files) ;; Used by `c-lang-defconst'. @@ -2548,6 +2494,7 @@ LANG is the name of the language, i.e. the mode name without the language. NAME and LANG are not evaluated so they should not be quoted." + (declare (debug (name &optional symbolp))) (or (symbolp name) (error "Not a symbol: %S" name)) (or (symbolp lang) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 747a6fd4eda..622d9516e16 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -737,6 +737,7 @@ comment at the start of cc-engine.el for more info." '(setq stack (cons (cons state saved-pos) stack))) (defmacro c-bos-pop-state (&optional do-if-done) + (declare (debug t)) `(if (setq state (car (car stack)) saved-pos (cdr (car stack)) stack (cdr stack)) @@ -761,6 +762,7 @@ comment at the start of cc-engine.el for more info." (goto-char pos) (setq sym nil))) (defmacro c-bos-save-error-info (missing got) + (declare (debug t)) `(setq saved-pos (vector pos ,missing ,got))) (defmacro c-bos-report-error () '(unless noerror @@ -1871,51 +1873,51 @@ comment at the start of cc-engine.el for more info." ; (setq in-face (point))) ; (not (eobp))))))) -(defmacro c-debug-sws-msg (&rest args) - (ignore args) +(defmacro c-debug-sws-msg (&rest _args) + ;; (declare (debug t)) ;;`(message ,@args) ) (defmacro c-put-is-sws (beg end) ;; This macro does a hidden buffer change. + (declare (debug t)) `(let ((beg ,beg) (end ,end)) (put-text-property beg end 'c-is-sws t) ,@(when (facep 'c-debug-is-sws-face) '((c-debug-add-face beg end 'c-debug-is-sws-face))))) -(def-edebug-spec c-put-is-sws t) (defmacro c-put-in-sws (beg end) ;; This macro does a hidden buffer change. + (declare (debug t)) `(let ((beg ,beg) (end ,end)) (put-text-property beg end 'c-in-sws t) ,@(when (facep 'c-debug-is-sws-face) '((c-debug-add-face beg end 'c-debug-in-sws-face))))) -(def-edebug-spec c-put-in-sws t) (defmacro c-remove-is-sws (beg end) ;; This macro does a hidden buffer change. + (declare (debug t)) `(let ((beg ,beg) (end ,end)) (remove-text-properties beg end '(c-is-sws nil)) ,@(when (facep 'c-debug-is-sws-face) '((c-debug-remove-face beg end 'c-debug-is-sws-face))))) -(def-edebug-spec c-remove-is-sws t) (defmacro c-remove-in-sws (beg end) ;; This macro does a hidden buffer change. + (declare (debug t)) `(let ((beg ,beg) (end ,end)) (remove-text-properties beg end '(c-in-sws nil)) ,@(when (facep 'c-debug-is-sws-face) '((c-debug-remove-face beg end 'c-debug-in-sws-face))))) -(def-edebug-spec c-remove-in-sws t) (defmacro c-remove-is-and-in-sws (beg end) ;; This macro does a hidden buffer change. + (declare (debug t)) `(let ((beg ,beg) (end ,end)) (remove-text-properties beg end '(c-is-sws nil c-in-sws nil)) ,@(when (facep 'c-debug-is-sws-face) '((c-debug-remove-face beg end 'c-debug-is-sws-face) (c-debug-remove-face beg end 'c-debug-in-sws-face))))) -(def-edebug-spec c-remove-is-and-in-sws t) ;; The type of literal position `end' is in a `before-change-functions' ;; function - one of `c', `c++', `pound', `noise', `attribute' or nil (but NOT @@ -3517,6 +3519,7 @@ mhtml-mode." (defmacro c-state-cache-top-lparen (&optional cache) ;; Return the address of the top left brace/bracket/paren recorded in CACHE ;; (default `c-state-cache') (or nil). + (declare (debug t)) (let ((cash (or cache 'c-state-cache))) `(if (consp (car ,cash)) (caar ,cash) @@ -3525,6 +3528,7 @@ mhtml-mode." (defmacro c-state-cache-top-paren (&optional cache) ;; Return the address of the latest brace/bracket/paren (whether left or ;; right) recorded in CACHE (default `c-state-cache') or nil. + (declare (debug t)) (let ((cash (or cache 'c-state-cache))) `(if (consp (car ,cash)) (cdar ,cash) @@ -3533,6 +3537,7 @@ mhtml-mode." (defmacro c-state-cache-after-top-paren (&optional cache) ;; Return the position just after the latest brace/bracket/paren (whether ;; left or right) recorded in CACHE (default `c-state-cache') or nil. + (declare (debug t)) (let ((cash (or cache 'c-state-cache))) `(if (consp (car ,cash)) (cdar ,cash) @@ -4487,6 +4492,7 @@ mhtml-mode." (defmacro c-state-maybe-marker (place marker) ;; If PLACE is non-nil, return a marker marking it, otherwise nil. ;; We (re)use MARKER. + (declare (debug (form symbolp))) `(let ((-place- ,place)) (and -place- (or ,marker (setq ,marker (make-marker))) @@ -5973,6 +5979,7 @@ comment at the start of cc-engine.el for more info." ; spots and the preceding token end.") (defmacro c-debug-put-decl-spot-faces (match-pos decl-pos) + (declare (debug t)) (when (facep 'c-debug-decl-spot-face) `(c-save-buffer-state ((match-pos ,match-pos) (decl-pos ,decl-pos)) (c-debug-add-face (max match-pos (point-min)) decl-pos @@ -5980,6 +5987,7 @@ comment at the start of cc-engine.el for more info." (c-debug-add-face decl-pos (min (1+ decl-pos) (point-max)) 'c-debug-decl-spot-face)))) (defmacro c-debug-remove-decl-spot-faces (beg end) + (declare (debug t)) (when (facep 'c-debug-decl-spot-face) `(c-save-buffer-state () (c-debug-remove-face ,beg ,end 'c-debug-decl-spot-face) @@ -7774,6 +7782,7 @@ comment at the start of cc-engine.el for more info." (defvar c-last-identifier-range nil) (defmacro c-record-type-id (range) + (declare (debug t)) (if (eq (car-safe range) 'cons) ;; Always true. `(setq c-record-type-identifiers @@ -7784,6 +7793,7 @@ comment at the start of cc-engine.el for more info." (cons range c-record-type-identifiers)))))) (defmacro c-record-ref-id (range) + (declare (debug t)) (if (eq (car-safe range) 'cons) ;; Always true. `(setq c-record-ref-identifiers @@ -7809,6 +7819,7 @@ comment at the start of cc-engine.el for more info." ;; if TYPE is 'type or as a reference if TYPE is 'ref. ;; ;; This macro might do hidden buffer changes. + (declare (debug t)) `(let (res) (setq c-last-identifier-range nil) (while (if (setq res ,(if (eq type 'type) @@ -7833,6 +7844,7 @@ comment at the start of cc-engine.el for more info." ;; `c-forward-keyword-prefixed-id'. ;; ;; This macro might do hidden buffer changes. + (declare (debug t)) `(while (and (progn ,(when update-safe-pos '(setq safe-pos (point))) @@ -8776,6 +8788,7 @@ comment at the start of cc-engine.el for more info." (defmacro c-pull-open-brace (ps) ;; Pull the next open brace from PS (which has the form of paren-state), ;; skipping over any brace pairs. Returns NIL when PS is exhausted. + (declare (debug (symbolp))) `(progn (while (consp (car ,ps)) (setq ,ps (cdr ,ps))) @@ -8891,6 +8904,7 @@ comment at the start of cc-engine.el for more info." ;; a comma. If either of or bracketed is missing, ;; throw nil to 'level. If the terminating } or ) is unmatched, throw nil ;; to 'done. This is not a general purpose macro! + (declare (debug t)) `(while (eq (char-before) ?,) (backward-char) (c-backward-syntactic-ws ,limit) @@ -9284,6 +9298,7 @@ This function might do hidden buffer changes." ;; sometimes consumes the identifier in the declaration as a type. ;; This is used to "backtrack" and make the last type be treated as ;; an identifier instead. + (declare (debug nil)) `(progn ,(unless short ;; These identifiers are bound only in the inner let. @@ -14686,18 +14701,6 @@ Cannot combine absolute offsets %S and %S in `add' method" (current-column))) indent))) - -(def-edebug-spec c-bos-pop-state t) -(def-edebug-spec c-bos-save-error-info t) -(def-edebug-spec c-state-cache-top-lparen t) -(def-edebug-spec c-state-cache-top-paren t) -(def-edebug-spec c-state-cache-after-top-paren t) -(def-edebug-spec c-state-maybe-marker (form symbolp)) -(def-edebug-spec c-record-type-id t) -(def-edebug-spec c-record-ref-id t) -(def-edebug-spec c-forward-keyword-prefixed-id t) -(def-edebug-spec c-forward-id-comma-list t) -(def-edebug-spec c-pull-open-brace (symbolp)) (cc-provide 'cc-engine) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 433b4dcf4a8..fdef0840cda 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -218,6 +218,7 @@ ;; incorrectly. ;; ;; This function does a hidden buffer change. + (declare (debug t)) (if (fboundp 'font-lock-set-face) ;; Note: This function has no docstring in XEmacs so it might be ;; considered internal. @@ -228,6 +229,7 @@ ;; This is the inverse of `c-put-font-lock-face'. ;; ;; This function does a hidden buffer change. + (declare (debug t)) (if (fboundp 'font-lock-remove-face) `(font-lock-remove-face ,from ,to) `(remove-text-properties ,from ,to '(face nil)))) @@ -238,11 +240,13 @@ ;; region should include them. ;; ;; This function does a hidden buffer change. + (declare (debug t)) (if (featurep 'xemacs) `(c-put-font-lock-face (1+ ,from) (1- ,to) 'font-lock-string-face) `(c-put-font-lock-face ,from ,to 'font-lock-string-face))) (defmacro c-fontify-types-and-refs (varlist &rest body) + (declare (indent 1) (debug let*)) ;; Like `let', but additionally activates `c-record-type-identifiers' ;; and `c-record-ref-identifiers', and fontifies the recorded ranges ;; accordingly on exit. @@ -253,7 +257,6 @@ ,@varlist) (prog1 (progn ,@body) (c-fontify-recorded-types-and-refs)))) - (put 'c-fontify-types-and-refs 'lisp-indent-function 1) (defun c-skip-comments-and-strings (limit) ;; If the point is within a region fontified as a comment or @@ -482,20 +485,7 @@ ;; In the next form, check that point hasn't been moved beyond ;; `limit' in any of the above stanzas. ,(c-make-font-lock-search-form (car normal) (cdr normal) t) - nil)))) - -; (eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el. -; '(progn -(def-edebug-spec c-put-font-lock-face t) -(def-edebug-spec c-remove-font-lock-face t) -(def-edebug-spec c-put-font-lock-string-face t) - (def-edebug-spec c-fontify-types-and-refs let*) - (def-edebug-spec c-make-syntactic-matcher t) - ;; If there are literal quoted or backquoted highlight specs in - ;; the call to `c-make-font-lock-search-function' then let's - ;; instrument the forms in them. - (def-edebug-spec c-make-font-lock-search-function - (form &rest &or ("quote" (&rest form)) ("`" (&rest form)) form)));)) + nil))))) (defun c-fontify-recorded-types-and-refs () ;; Convert the ranges recorded on `c-record-type-identifiers' and @@ -2712,6 +2702,7 @@ need for `pike-font-lock-extra-types'.") (defmacro c-set-doc-comment-re-element (suffix) ;; Set the variable `c-doc-line-join-re' to a buffer local value suitable ;; for the current doc comment style, or kill the local value. + (declare (debug t)) (let ((var (intern (concat "c-doc" suffix)))) `(let* ((styles (c-get-doc-comment-style)) elts) @@ -2738,6 +2729,7 @@ need for `pike-font-lock-extra-types'.") (defmacro c-set-doc-comment-char-list (suffix) ;; Set the variable 'c-doc-' to the list of *-, which must ;; be characters, and * represents the doc comment style. + (declare (debug t)) (let ((var (intern (concat "c-doc" suffix)))) `(let* ((styles (c-get-doc-comment-style)) elts) @@ -2783,7 +2775,7 @@ need for `pike-font-lock-extra-types'.") ;; is used as a flag in other code to skip comments. ;; ;; This function might do hidden buffer changes. - + (declare (indent 2)) (let (comment-beg region-beg) (if (memq (get-text-property (point) 'face) '(font-lock-comment-face font-lock-comment-delimiter-face)) @@ -2866,7 +2858,6 @@ need for `pike-font-lock-extra-types'.") (goto-char region-end))))) nil) -(put 'c-font-lock-doc-comments 'lisp-indent-function 2) (defun c-find-invalid-doc-markup (regexp limit) ;; Used to fontify invalid markup in doc comments after the correct diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 4c5d043593c..70b0d13df38 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -159,7 +159,9 @@ evaluated and bound to VAR when the result from the macro `c-lang-const' is typically used in VAL to get the right value for the language being initialized, and such calls will be macro expanded to the evaluated constant value at compile time." - + (declare (indent defun) + (debug (&define name def-form + &optional &or ("quote" symbolp) stringp))) (when (and (not doc) (eq (car-safe val) 'c-lang-const) (eq (nth 1 val) var) @@ -191,6 +193,7 @@ Emacs variable like `comment-start'. `c-lang-const' is typically used in VAL to get the right value for the language being initialized, and such calls will be macro expanded to the evaluated constant value at compile time." + (declare (debug (&define name def-form))) (let ((elem (assq var (cdr c-emacs-variable-inits)))) (if elem (setcdr elem (list val)) ; Maybe remove "list", sometime. 2006-07-19 @@ -200,13 +203,6 @@ the evaluated constant value at compile time." ;; Return the symbol, like the other def* forms. `',var) -(put 'c-lang-defvar 'lisp-indent-function 'defun) -; (eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el. -; ' -(def-edebug-spec c-lang-defvar - (&define name def-form &optional &or ("quote" symbolp) stringp)) -(def-edebug-spec c-lang-setvar (&define name def-form)) - ;; Suppress "might not be defined at runtime" warning. ;; This file is only used when compiling other cc files. (declare-function cl-delete-duplicates "cl-seq" (cl-seq &rest cl-keys)) @@ -4093,6 +4089,7 @@ accomplish that conveniently." This macro is expanded at compile time to a form tailored for the mode in question, so MODE must be a constant. Therefore MODE is not evaluated and should not be quoted." + (declare (debug nil)) `(funcall ,(c-make-init-lang-vars-fun mode))) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index dae0062efb5..a8f16627722 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -969,6 +969,7 @@ Note that the style variables are always made local to the buffer." (defmacro c-run-mode-hooks (&rest hooks) ;; Emacs 21.1 has introduced a system with delayed mode hooks that ;; requires the use of the new function `run-mode-hooks'. + (declare (debug t)) (if (cc-bytecomp-fboundp 'run-mode-hooks) `(run-mode-hooks ,@hooks) `(progn ,@(mapcar (lambda (hook) `(run-hooks ,hook)) hooks)))) @@ -2503,6 +2504,7 @@ This function is called from `c-common-init', once per mode initialization." ;; Emacs < 22 and XEmacs (defmacro c-advise-fl-for-region (function) + (declare (debug t)) `(defadvice ,function (before get-awk-region activate) ;; Make sure that any string/regexp is completely font-locked. (when c-buffer-is-cc-mode -- cgit v1.2.3 From 84a2a4715b98e05ee37382d817ebe2ba9f2e03ce Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Sun, 2 May 2021 15:22:36 +0000 Subject: * lisp/progmodes/cc-defs (c-save-buffer-state): Amend debug spec, t to let* This should solve part of bug #48100. --- lisp/progmodes/cc-defs.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/progmodes/cc-defs.el') diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 4f79fa9b330..02292327581 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -615,7 +615,7 @@ must not be within a `c-save-buffer-state', since the user then wouldn't be able to undo them. The return value is the value of the last form in BODY." - (declare (debug t) (indent 1)) + (declare (debug let*) (indent 1)) (if (fboundp 'with-silent-modifications) `(with-silent-modifications (let* ,varlist ,@body)) `(let* ((modified (buffer-modified-p)) (buffer-undo-list t) -- cgit v1.2.3 From 3783e7fb4dbf4ed9620d6e3d54ef3462331e6660 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Tue, 4 May 2021 20:56:37 +0100 Subject: Remove unused lexical variables in cc-defs.el * lisp/progmodes/cc-defs.el (c-sc-scan-lists-no-category+1+1) (c-sc-scan-lists-no-category+1-1, c-sc-scan-lists-no-category-1+1) (c-sc-scan-lists-no-category-1-1): Remove unused lexical variable 'here' to pacify byte-compilation warnings in cc-engine.el. --- lisp/progmodes/cc-defs.el | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) (limited to 'lisp/progmodes/cc-defs.el') diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 02292327581..5d93435066f 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -1653,8 +1653,7 @@ with value CHAR in the region [FROM to)." ;; determined by and angle bracket; or (ii) is inside a macro whose start ;; isn't POINT-MACRO-START doesn't count as a finishing position. (declare (debug t)) - `(let ((here (point)) - (pos (scan-lists ,from 1 1))) + `(let ((pos (scan-lists ,from 1 1))) (while (eq (char-before pos) ?>) (setq pos (scan-lists pos 1 1))) pos)) @@ -1664,8 +1663,7 @@ with value CHAR in the region [FROM to)." ;; determined by an angle bracket; or (ii) is inside a macro whose start ;; isn't POINT-MACRO-START doesn't count as a finishing position. (declare (debug t)) - `(let ((here (point)) - (pos (scan-lists ,from 1 -1))) + `(let ((pos (scan-lists ,from 1 -1))) (while (eq (char-before pos) ?<) (setq pos (scan-lists pos 1 1)) (setq pos (scan-lists pos 1 -1))) @@ -1676,8 +1674,7 @@ with value CHAR in the region [FROM to)." ;; determined by and angle bracket; or (ii) is inside a macro whose start ;; isn't POINT-MACRO-START doesn't count as a finishing position. (declare (debug t)) - `(let ((here (point)) - (pos (scan-lists ,from -1 1))) + `(let ((pos (scan-lists ,from -1 1))) (while (eq (char-after pos) ?<) (setq pos (scan-lists pos -1 1))) pos)) @@ -1687,8 +1684,7 @@ with value CHAR in the region [FROM to)." ;; determined by and angle bracket; or (ii) is inside a macro whose start ;; isn't POINT-MACRO-START doesn't count as a finishing position. (declare (debug t)) - `(let ((here (point)) - (pos (scan-lists ,from -1 -1))) + `(let ((pos (scan-lists ,from -1 -1))) (while (eq (char-after pos) ?>) (setq pos (scan-lists pos -1 1)) (setq pos (scan-lists pos -1 -1))) -- cgit v1.2.3 From c4d34d24e36c7f7c54cf3ec3e5d76e3e8fc005aa Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Thu, 12 Aug 2021 19:04:28 +0000 Subject: CC Mode: Enhance C++ Mode raw strings to multi-line strings for any language * lisp/progmodes/cc-defs.el (cadar, caddr, cdddr): Add defsubsts for these for when they are missing from the host Emacs. (c-point): Add new `position' 'boll "beginning of logical line". (c-clear-char-properties): Return the position of the lowest removed property. * lisp/progmodes/cc-engine.el (c-full-pp-to-literal): Fix for rare case where LIMIT < START in parse-partial-sexp. (c-old-beg-rs, c-old-end-rs, c-raw-string-end-delim-disrupted) (c-raw-string-pos, c-raw-string-in-end-delim, c-depropertize-raw-string) (c-depropertize-raw-strings-in-region, c-before-change-check-raw-strings) (c-propertize-raw-string-id, c-propertize-raw-string-opener): Old functions and variables removed or renamed "raw" -> "ml" and adapted. (c-old-beg-ml, c-old-1-beg-ml, c-old-end-ml, c-beg-pos, c-end-pos) (c-ml-string-end-delim-disrupted, c-depropertize-ml-string-delims) (c-ml-string-delims-around-point,c-position-wrt-ml-delims) (c-before-change-check-ml-strings, c-after-change-unmark-ml-strings) (c-maybe-re-mark-ml-string, c-propertize-ml-string-id) (c-propertize-ml-string-opener, c-depropertize-ml-string) (c-depropertize-ml-strings-in-region): New functions and variables adapted and possibly renamed from "raw" -> "ml". (c-ml-string-make-closer-re, c-ml-string-make-opener-re) (c-c++-make-ml-string-closer-re, c-c++-make-ml-string-opener-re) (c-get-ml-closer, c-ml-string-opener-around-point) (c-ml-string-opener-intersects-region, c-ml-string-opener-at-or-around-point) (c-ml-string-back-to-neutral, c-ml-string-in-end-delim, c-neutralize-pos) (c-neutralized-prop): New functions and variables. * lisp/progmodes/cc-fonts.el (c-basic-matchers-before): Replace c-font-lock-raw-strings with c-font-lock-ml-strings. (c-font-lock-ml-strings): New function taking the place of the old c-font-lock-ml-strings. * lisp/progmodes/cc-langs.el (c-get-state-before-change-functions): Move c-depropertize-CPP to the second item of the C++ entry, and replace c-before-change-check-raw-strings by c-before-change-check-ml-strings. Add a new entry for Pike Mode. (c-before-font-lock-functions): (Replace c-after-change-unmark-raw-strings by c-after-change-unmark-ml-strings in the C++ entry, and add a new entry for Pike Mode. (c-ml-string-backslash-escapes, c-ml-string-non-punc-skip-chars) (c-ml-string-opener-re, c-ml-string-max-opener-len, c-ml-string-any-closer-re) (c-ml-string-max-closer-len, c-ml-string-max-closer-len-no-leader) (c-ml-string-back-closer-re, c-make-ml-string-closer-re-function) (c-make-ml-string-opener-re-function, c-ml-string-cpp-or-opener-re) (c-cpp-or-ml-match-offset): New c-lang-defconsts and c-land-defvars. (c-multiline-string-start-char): Remove the Pike Mode setting. * lisp/progmodes/cc-mode.el (c-depropertize-CPP): Test for general ml strings rather than C++ raw strings. (c-unescaped-nls-in-string-p): Handle languages with ml strings. (c-clear-string-fences): Fix bug with wrong parenthesisation. (c-before-change-check-unbalanced-strings) (c-after-change-mark-abnormal-strings, c-after-change-escape-NL-in-string): Adapt for multi-line strings. --- lisp/progmodes/cc-defs.el | 53 +- lisp/progmodes/cc-engine.el | 1339 +++++++++++++++++++++++++++---------------- lisp/progmodes/cc-fonts.el | 121 ++-- lisp/progmodes/cc-langs.el | 195 ++++++- lisp/progmodes/cc-mode.el | 69 +-- 5 files changed, 1196 insertions(+), 581 deletions(-) (limited to 'lisp/progmodes/cc-defs.el') diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 5d93435066f..01bd64cb5c3 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -174,6 +174,10 @@ This variant works around bugs in `eval-when-compile' in various ;;; Macros. +(or (fboundp 'cadar) (defsubst cadar (elt) (car (cdar elt)))) +(or (fboundp 'caddr) (defsubst caddr (elt) (car (cddr elt)))) +(or (fboundp 'cdddr) (defsubst cdddr (elt) (cdr (cddr elt)))) + (defmacro c--mapcan (fun liszt) ;; CC Mode equivalent of `mapcan' which bridges the difference ;; between the host [X]Emacsen." @@ -236,6 +240,7 @@ The current point is used if POINT isn't specified. POSITION can be one of the following symbols: `bol' -- beginning of line +`boll' -- beginning of logical line (i.e. without preceding escaped NL) `eol' -- end of line `eoll' -- end of logical line (i.e. without escaped NL) `bod' -- beginning of defun @@ -266,6 +271,15 @@ to it is returned. This function does not modify the point or the mark." (beginning-of-line) (point)))) + ((eq position 'boll) + `(save-excursion + ,@(if point `((goto-char ,point))) + (while (progn (beginning-of-line) + (when (not (bobp)) + (eq (char-before (1- (point))) ?\\))) + (backward-char)) + (point))) + ((eq position 'eol) (if (and (cc-bytecomp-fboundp 'line-end-position) (not point)) '(line-end-position) @@ -1254,6 +1268,9 @@ MODE is either a mode symbol or a list of mode symbols." ;; region that has been put with `c-put-char-property'. PROPERTY is ;; assumed to be constant. ;; + ;; The returned value is the buffer position of the lowest character + ;; whose PROPERTY was removed, or nil if there was none. + ;; ;; Note that this function does not clean up the property from the ;; lists of the `rear-nonsticky' properties in the region, if such ;; are used. Thus it should not be used for common properties like @@ -1262,20 +1279,28 @@ MODE is either a mode symbol or a list of mode symbols." ;; This macro does hidden buffer changes. (declare (debug t)) (setq property (eval property)) - (if c-use-extents - ;; XEmacs. - `(map-extents (lambda (ext ignored) - (delete-extent ext)) - nil ,from ,to nil nil ',property) - ;; Emacs. - (if (and (fboundp 'syntax-ppss) - (eq `,property 'syntax-table)) - `(let ((-from- ,from) (-to- ,to)) - (setq c-syntax-table-hwm - (min c-syntax-table-hwm - (c-min-property-position -from- -to- ',property))) - (remove-text-properties -from- -to- '(,property nil))) - `(remove-text-properties ,from ,to '(,property nil))))) + `(let* ((-to- ,to) + (ret (c-min-property-position ,from -to- ',property))) + (if (< ret -to-) + (progn + ,(cond + (c-use-extents + ;; XEmacs + `(map-extents (lambda (ext ignored) + (delete-extent ext)) + nil ret -to- nil nil ',property)) + ((and (fboundp 'syntax-ppss) + (eq property 'syntax-table)) + ;; Emacs 'syntax-table + `(progn + (setq c-syntax-table-hwm + (min c-syntax-table-hwm ret)) + (remove-text-properties ret -to- '(,property nil)))) + (t + ;; Emacs other property. + `(remove-text-properties ret -to- '(,property nil)))) + ret) + nil))) (defmacro c-clear-syn-tab-properties (from to) ;; Remove all occurrences of the `syntax-table' and `c-fl-syn-tab' text diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 984a75c4b83..4222dbefa9d 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -170,6 +170,7 @@ (cc-bytecomp-defun c-clear-syn-tab) (cc-bytecomp-defun c-clear-string-fences) (cc-bytecomp-defun c-restore-string-fences) +(cc-bytecomp-defun c-remove-string-fences) ;; Make declarations for all the `c-lang-defvar' variables in cc-langs. @@ -3140,21 +3141,21 @@ comment at the start of cc-engine.el for more info." (setq base far-base s far-s end nil)))) - (when - (or - (and (> here base) (null end)) - (null (nth 8 s)) - (and end (>= here end)) - (not - (or - (and (nth 3 s) ; string - (not (eq (char-before here) ?\\))) - (and (nth 4 s) (not (nth 7 s)) ; Block comment - (not (memq (char-before here) - c-block-comment-awkward-chars))) - (and (nth 4 s) (nth 7 s) ; Line comment - (not (memq (char-before here) '(?\\ ?\n))))))) + (cond + ((or (and (> here base) (null end)) + (null (nth 8 s)) + (and end (>= here end))) (setq s (parse-partial-sexp base here nil nil s))) + ((or (and (nth 3 s) ; string + (eq (char-before here) ?\\)) + (and (nth 4 s) (not (nth 7 s)) ; block comment + (memq (char-before here) c-block-comment-awkward-chars)) + (and (nth 4 s) (nth 7 s) ; line comment + (memq (char-before here) '(?\\ ?\n)))) + (setq s + (if (>= here base) + (parse-partial-sexp base here nil nil s) + (parse-partial-sexp (nth 8 s) here))))) (cond ((or (nth 3 s) (and (nth 4 s) @@ -7167,554 +7168,932 @@ comment at the start of cc-engine.el for more info." (goto-char c-new-END))))) -;; Functions to handle C++ raw strings. +;; Handling of CC Mode multi-line strings. ;; -;; A valid C++ raw string looks like -;; R"()" -;; , where is an identifier from 0 to 16 characters long, not containing -;; spaces, control characters, or left/right paren. can include -;; anything which isn't the terminating )", including new lines, "s, -;; parentheses, etc. +;; By a "multi-line string" is meant a string opened by a "decorated" +;; double-quote mark, and which can continue over several lines without the +;; need to escape the newlines, terminating at a closer, a possibly +;; "decorated" double-quote mark. The string can usually contain double +;; quotes without them being quoted, whether or not backslashes quote the +;; following character being a matter of configuration. ;; -;; CC Mode handles C++ raw strings by the use of `syntax-table' text +;; CC Mode handles multi-line strings by the use of `syntax-table' text ;; properties as follows: ;; -;; (i) On a validly terminated raw string, no `syntax-table' text properties -;; are applied to the opening and closing delimiters, but any " in the -;; contents is given the property value "punctuation" (`(1)') to prevent it -;; interacting with the "s in the delimiters. +;; (i) On a validly terminated ml string, syntax-table text-properties are +;; applied as needed to the opener, so that the " character in the opener +;; (or (usually) the first of them if there are several) retains its normal +;; syntax, and any other characters with obtrusive syntax are given +;; "punctuation" '(1) properties. Similarly, the " character in the closer +;; retains its normal syntax, and characters with obtrusive syntax are +;; "punctuated out" as before. ;; -;; 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. +;; The font locking routine `c-font-lock-ml-strings' (in cc-fonts.el) +;; recognizes validly terminated ml strings and fontifies (typically) the +;; innermost character of each delimiter in font-lock-string-face and the +;; rest of those delimiters in the default face. The contents, of course, +;; are in 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)'). When such a -;; delimiter is found, no attempt is made in any way to "correct" any text -;; properties after the delimiter. +;; (ii) A valid, but unterminated, ml string's opening delimiter gets the +;; "punctuation" value (`(1)') of the `syntax-table' text property on its ", +;; and the last char of the opener gets the "string fence" value '(15). +;; (The latter takes precedence over the former.) When such a delimiter is +;; found, no attempt is made in any way to "correct" any text properties +;; after the delimiter. ;; -;; `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. +;; `c-font-lock-ml-strings' puts c-font-lock-warning-face on the entire +;; unmatched opening delimiter, and allows the tail of the buffer to get +;; font-lock-string-face, caused by the unmatched "string fence" +;; `syntax-table' text property value. ;; -;; (iii) Inside a macro, a valid raw string is handled as in (i). An -;; unmatched opening delimiter is handled slightly differently. In addition -;; to the "punctuation" and "string fence" properties on the delimiter, -;; another "string fence" `syntax-table' property is applied to the last -;; possible character of the macro before the terminating linefeed (if there -;; is such a character after the "("). This "last possible" character is +;; (iii) Inside a macro, a valid ml string is handled as in (i). An unmatched +;; opening delimiter is handled slightly differently. In addition to the +;; "punctuation" and "string fence" properties on the delimiter, another +;; "string fence" `syntax-table' property is applied to the last possible +;; character of the macro before the terminating linefeed (if there is such +;; a character after the delimiter). This "last possible" character is ;; never a backslash escaping the end of line. If the character preceding ;; this "last possible" character is itself a backslash, this preceding -;; character gets a "punctuation" `syntax-table' value. If the "(" is -;; already at the end of the macro, it gets the "punctuation" value, and no -;; "string fence"s are used. +;; character gets a "punctuation" `syntax-table' value. If the last +;; character of the closing delimiter is 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 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) -;; Whether a buffer change has disrupted or will disrupt the terminating id of -;; a raw string. -(defvar c-raw-string-end-delim-disrupted nil) - -(defun c-raw-string-pos () - ;; Get POINT's relationship to any containing raw string. - ;; If point isn't in a raw string, return nil. - ;; Otherwise, return the following list: - ;; - ;; (POS B\" B\( E\) E\") - ;; - ;; , where POS is the symbol `open-delim' if point is in the opening - ;; delimiter, the symbol `close-delim' if it's in the closing delimiter, and - ;; nil if it's in the string body. B\", B\(, E\), E\" are the positions of - ;; the opening and closing quotes and parentheses of a correctly terminated - ;; raw string. (N.B.: E\) and E\" are NOT on the "outside" of these - ;; characters.) If the raw string is not terminated, E\) and E\" are set to +(defun c-ml-string-make-closer-re (_opener) + "Return c-ml-string-any-closer-re. + +This is a suitable language specific value of +`c-make-ml-string-closer-re-function' for most languages with +multi-line strings (but not C++, for example)." + c-ml-string-any-closer-re) + +(defun c-ml-string-make-opener-re (_closer) + "Return c-ml-string-opener-re. + +This is a suitable language specific value of +`c-make-ml-string-opener-re-function' for most languages with +multi-line strings (but not C++, for example)." + c-ml-string-opener-re) + +(defun c-c++-make-ml-string-closer-re (opener) + "Construct a regexp for a C++ raw string closer matching OPENER." + (concat "\\()" (regexp-quote (substring opener 2 -1)) "\\(\"\\)\\)")) + +(defun c-c++-make-ml-string-opener-re (closer) + "Construct a regexp for a C++ raw string opener matching CLOSER." + (concat "\\(R\\(\"\\)" (regexp-quote (substring closer 1 -1)) "(\\)")) + +;; The positions of various components of mult-line strings surrounding BEG, +;; END and (1- BEG) (of before-change-functions) as returned by +;; `c-ml-string-delims-around-point'. +(defvar c-old-beg-ml nil) +(defvar c-old-1-beg-ml nil) ; only non-nil when `c-old-beg-ml' is nil. +(defvar c-old-end-ml nil) +;; The values of the function `c-position-wrt-ml-delims' at +;; before-change-function's BEG and END. +(defvar c-beg-pos nil) +(defvar c-end-pos nil) +;; Whether a buffer change has disrupted or will disrupt the terminator of an +;; multi-line string. +(defvar c-ml-string-end-delim-disrupted nil) + +(defun c-depropertize-ml-string-delims (string-delims) + ;; Remove any syntax-table text properties from the multi-line string + ;; delimiters specified by STRING-DELIMS, the output of + ;; `c-ml-string-delims-around-point'. + (let (found) + (if (setq found (c-clear-char-properties (caar string-delims) + (cadar string-delims) + 'syntax-table)) + (c-truncate-lit-pos-cache found)) + (when (cdr string-delims) + (if (setq found (c-clear-char-properties (cadr string-delims) + (caddr string-delims) + 'syntax-table)) + (c-truncate-lit-pos-cache found))))) + +(defun c-get-ml-closer (open-delim) + ;; Return the closer, a three element dotted list of the closer's start, its + ;; end and the position of the double quote, matching the given multi-line + ;; string OPENER, also such a three element dotted list. Otherwise return + ;; nil. All pertinent syntax-table text properties must be in place. + (save-excursion + (goto-char (cadr open-delim)) + (and (not (equal (c-get-char-property (1- (point)) 'syntax-table) + '(15))) + (re-search-forward (funcall c-make-ml-string-closer-re-function + (buffer-substring-no-properties + (car open-delim) (cadr open-delim))) + nil t) + (cons (match-beginning 1) + (cons (match-end 1) (match-beginning 2)))))) + +(defun c-ml-string-opener-around-point () + ;; If point is inside an ml string opener, return a dotted list of the start + ;; and end of that opener, and the position of its double-quote. That list + ;; will not include any "context characters" before or after the opener. If + ;; an opener is found, the match-data will indicate it, with (match-string + ;; 1) being the entire delimiter, and (match-string 2) the "main" double + ;; quote. Otherwise the match-data is undefined. + (let ((here (point)) found) + (goto-char (max (- here (1- c-ml-string-max-opener-len)) (point-min))) + (while + (and + (setq found + (search-forward-regexp + c-ml-string-opener-re + (min (+ here (1- c-ml-string-max-opener-len)) (point-max)) + 'bound)) + (<= (match-end 1) here))) + (prog1 + (and found + (< (match-beginning 1) here) + (cons (match-beginning 1) + (cons (match-end 1) (match-beginning 2)))) + (goto-char here)))) + +(defun c-ml-string-opener-intersects-region (&optional start finish) + ;; If any part of the region [START FINISH] is inside an ml-string opener, + ;; return a dotted list of the start, end and double-quote position of that + ;; opener. That list wlll not include any "context characters" before or + ;; after the opener. If an opener is found, the match-data will indicate + ;; it, with (match-string 1) being the entire delimiter, and (match-string + ;; 2) the "main" double-quote. Otherwise, the match-data is undefined. + ;; Both START and FINISH default to point. FINISH may not be at an earlier + ;; buffer position than START. + (let ((here (point)) found) + (or finish (setq finish (point))) + (or start (setq start (point))) + (goto-char (max (- start (1- c-ml-string-max-opener-len)) (point-min))) + (while + (and + (setq found + (search-forward-regexp + c-ml-string-opener-re + (min (+ finish (1- c-ml-string-max-opener-len)) (point-max)) + 'bound)) + (<= (match-end 1) start))) + (prog1 + (and found + (< (match-beginning 1) finish) + (cons (match-beginning 1) + (cons (match-end 1) (match-beginning 2)))) + (goto-char here)))) + +(defun c-ml-string-opener-at-or-around-point (&optional position) + ;; If POSITION (default point) is at or inside an ml string opener, return a + ;; dotted list of the start and end of that opener, and the position of the + ;; double-quote in it. That list will not include any "context characters" + ;; before or after the opener. + (let ((here (point)) + found) + (or position (setq position (point))) + (goto-char (max (- position (1- c-ml-string-max-opener-len)) (point-min))) + (while + (and + (setq found + (search-forward-regexp + c-ml-string-opener-re + (min (+ position c-ml-string-max-opener-len) (point-max)) + 'bound)) + (<= (match-end 1) position))) + (prog1 + (and found + (<= (match-beginning 1) position) + (cons (match-beginning 1) + (cons (match-end 1) (match-beginning 2)))) + (goto-char here)))) + +(defun c-ml-string-back-to-neutral (opening-point) + ;; Given OPENING-POINT, the position of the start of a multiline string + ;; opening delimiter, move point back to a neutral position within the ml + ;; string. It is assumed that point is within the innards of or the closing + ;; delimiter of string opened by OPEN-DELIM. + (let ((opener-end (save-excursion + (goto-char opening-point) + (looking-at c-ml-string-opener-re) + (match-end 1)))) + (if (not c-ml-string-back-closer-re) + (goto-char (max (c-point 'boll) opener-end)) + (re-search-backward c-ml-string-back-closer-re + (max opener-end + (c-point 'eopl)) + 'bound)))) + +(defun c-ml-string-in-end-delim (beg end open-delim) + ;; If the region (BEG END) intersects or touches a possible multiline string + ;; terminator, return a cons of the position of the start and end of the + ;; first such terminator. The syntax-table text properties must be in a + ;; consistent state when using this function. OPEN-DELIM is the three + ;; element dotted list of the start, end, and double quote position of the + ;; multiline string opener that BEG is in, or nil if it isn't in one. + (save-excursion + (goto-char beg) + (when open-delim + (if (<= beg (cadr open-delim)) + (goto-char (cadr open-delim)) + (c-ml-string-back-to-neutral (car open-delim)))) + (or (and c-ml-string-back-closer-re + (looking-at c-ml-string-any-closer-re) + (eq (c-in-literal) 'string) + (goto-char (match-end 0))) + (progn + (while + (and + (search-forward-regexp + c-ml-string-any-closer-re + (min (+ end c-ml-string-max-closer-len-no-leader) (point-max)) + t) + (save-excursion + (goto-char (match-end 1)) + (not (c-in-literal))) + (<= (point) beg) + (not (save-excursion + (goto-char (match-beginning 2)) + (c-literal-start))))))) + + (unless (or (and (not (eobp)) + (<= (point) beg)) + (> (match-beginning 0) beg) + (progn (goto-char (match-beginning 2)) + (not (c-literal-start)))) + (cons (match-beginning 1) (match-end 1))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun c-ml-string-delims-around-point () + ;; Get POINT's relationship to any containing multi-line string or such a + ;; multi-line string which point is at the end of. + ;; + ;; If point isn't thus situated, return nil. + ;; Otherwise return the following cons: + ;; + ;; (OPENER . CLOSER) + ;; + ;; , where each of OPENER and CLOSER is a dotted list of the form + ;; + ;; (START-DELIM END-DELIM . QUOTE-POSITION) + ;; + ;; , the bounds of the delimiters and the buffer position of the ?" in the + ;; delimiter. If the ml-string is not validly terminated, CLOSER is instead ;; nil. ;; ;; Note: this function is dependent upon the correct syntax-table text ;; properties being set. - (let ((state (c-semi-pp-to-literal (point))) - open-quote-pos open-paren-pos close-paren-pos close-quote-pos id) - (save-excursion - (when - (and - (cond - ((null (cadr state)) - (or (eq (char-after) ?\") - (search-backward "\"" (max (- (point) 17) (point-min)) t))) - ((and (eq (cadr state) 'string) - (goto-char (nth 2 state)) - (cond - ((eq (char-after) ?\")) - ((eq (char-after) ?\() - (let ((here (point))) - (goto-char (max (- (point) 18) (point-min))) - (while - (and - (search-forward-regexp - c-c++-raw-string-opener-re - (1+ here) 'limit) - (< (point) here))) - (and (eq (point) (1+ here)) - (match-beginning 1) - (goto-char (1- (match-beginning 1))))))) - (not (bobp))))) - (c-at-c++-raw-string-opener)) - (setq open-quote-pos (point) - open-paren-pos (match-end 1) - id (match-string-no-properties 1)) - (goto-char (1+ open-paren-pos)) - (when (and (not (c-get-char-property open-paren-pos 'syntax-table)) - (search-forward (concat ")" id "\"") nil t)) - (setq close-paren-pos (match-beginning 0) - close-quote-pos (1- (point)))))) - (and open-quote-pos - (list - (cond - ((<= (point) open-paren-pos) - 'open-delim) - ((and close-paren-pos - (> (point) close-paren-pos)) - 'close-delim) - (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 - ;; unmatched) or the raw string. - ;; - ;; 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 (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)) - 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-lit-pos-cache first)) + (let ((here (point)) + (state (c-semi-pp-to-literal (point))) + open-dlist close-dlist ret found opener) (cond - ((null open-paren-prop) - ;; 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-lit-pos-cache first)) - ;; Clear any random `syntax-table' text properties from the contents. - (let* ((closing-paren (match-beginning 0)) - (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-lit-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-lit-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 - ;; the open parenthesis right up against the end of macro - (c-clear-char-property open-quote 'syntax-table) - (c-truncate-lit-pos-cache open-quote) - (c-clear-char-property open-paren 'syntax-table)) - (t - ;; An unterminated string in a macro, with at least one char after the - ;; open paren - (c-clear-char-property open-quote 'syntax-table) - (c-truncate-lit-pos-cache open-quote) - (c-clear-char-property open-paren '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 - ;; contained in the region (START FINISH). Point is undefined at entry and - ;; exit, and the return value has no significance. - (goto-char start) - (while (and (< (point) finish) - (re-search-forward - (concat "\\(" ; 1 - c-anchored-cpp-prefix ; 2 - "\\)\\|\\(" ; 3 - c-c++-raw-string-opener-re ; 4 - "\\)") - finish 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 - (c-depropertize-raw-string - (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 - c-c++-raw-string-opener-re eom t)) - (c-depropertize-raw-string - (match-string-no-properties 1) ; id - (1+ (match-beginning 0)) ; open quote - (match-end 1) ; open paren - eom))))))) ; bound. - -(defun c-before-change-check-raw-strings (beg end) - ;; This function clears `syntax-table' text properties from C++ raw strings - ;; 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. + ((or + ;; Is HERE between the start of an opener and the "? + (and (null (cadr state)) + (progn + ;; Search for the start of the opener. + (goto-char (max (- (point) (1- c-ml-string-max-opener-len)) + (point-min))) + (setq found nil) + ;; In the next loop, skip over any complete ml strings, or an ml + ;; string opener which is in a macro not containing HERE, or an + ;; apparent "opener" which is in a comment or string. + (while + (and (re-search-forward c-ml-string-opener-re + (+ here (1- c-ml-string-max-opener-len)) + t) + (< (match-beginning 1) here) + (or + (save-excursion + (goto-char (match-beginning 1)) + (or (c-in-literal) + (and (c-beginning-of-macro) + (< (progn (c-end-of-macro) (point)) + here)))) + (and + (setq found (match-beginning 1)) + (<= (point) here) + (save-match-data + (re-search-forward + (funcall c-make-ml-string-closer-re-function + (match-string-no-properties 1)) + here t)) + (<= (point) here)))) + (setq found nil)) + found)) + ;; Is HERE after the "? + (and (eq (cadr state) 'string) + (goto-char (nth 2 state)) + (c-ml-string-opener-at-or-around-point))) + (setq open-dlist (cons (match-beginning 1) + (cons (match-end 1) (match-beginning 2)))) + (goto-char (cadr open-dlist)) + (setq ret + (cons open-dlist + (if (re-search-forward + (funcall c-make-ml-string-closer-re-function + (match-string-no-properties 1)) + nil t) + (cons (match-beginning 1) + (cons (match-end 1) (match-beginning 2))) + nil))) + (goto-char here) + ret) + ;; Is HERE between the " and the end of the closer? + ((and (null (cadr state)) + (progn + (if (null c-ml-string-back-closer-re) + (goto-char (max (- here (1- c-ml-string-max-closer-len)) + (point-min))) + (goto-char here) + (re-search-backward c-ml-string-back-closer-re nil t)) + (re-search-forward c-ml-string-any-closer-re + (+ here -1 c-ml-string-max-closer-len-no-leader) + t)) + (>= (match-end 1) here) + (<= (match-end 2) here) + (setq close-dlist (cons (match-beginning 1) + (cons (match-end 1) (match-beginning 2)))) + (goto-char (car close-dlist)) + (setq state (c-semi-pp-to-literal (point))) + (eq (cadr state) 'string) + (goto-char (nth 2 state)) + (setq opener (c-ml-string-opener-around-point)) + (goto-char (cadr opener)) + (setq open-dlist (cons (match-beginning 1) + (cons (match-end 1) (match-beginning 2)))) + (re-search-forward (funcall c-make-ml-string-closer-re-function + (match-string-no-properties 1)) + nil t)) + (goto-char here) + (cons open-dlist close-dlist)) + + (t (goto-char here) + nil)))) + +(defun c-position-wrt-ml-delims (ml-string-delims) + ;; Given ML-STRING-DELIMS, a structure produced by + ;; `c-ml-string-delims-around-point' called at point, return one of the + ;; following indicating where POINT is with respect to the multi-line + ;; string: + ;; o - nil; not in the string. + ;; o - open-delim: in the open-delimiter. + ;; o - close-delim: in the close-delimiter. + ;; o - after-close: just after the close-delimiter + ;; o - string: inside the delimited string. + (cond + ((null ml-string-delims) + nil) + ((< (point) (cadar ml-string-delims)) + 'open-delim) + ((or (null (cdr ml-string-delims)) + (<= (point) (cadr ml-string-delims))) + 'string) + ((eq (point) (caddr ml-string-delims)) + 'after-close) + (t 'close-delim))) + +(defun c-before-change-check-ml-strings (beg end) + ;; This function clears `syntax-table' text properties from multi-line + ;; strings 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'. + ;; membership of mode-specific value of + ;; `c-get-state-before-change-functions'. (goto-char end) - (setq c-raw-string-end-delim-disrupted nil) + (setq c-ml-string-end-delim-disrupted nil) ;; 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)) + (goto-char beg) + (setq c-old-beg-ml (c-ml-string-delims-around-point)) + (setq c-beg-pos (c-position-wrt-ml-delims c-old-beg-ml)) + (setq c-old-1-beg-ml + (and (not (or c-old-beg-ml (bobp))) + (goto-char (1- beg)) + (c-ml-string-delims-around-point))) + (goto-char end) + (setq c-old-end-ml + (if (or (eq end beg) + (and c-old-beg-ml + (>= end (caar c-old-beg-ml)) + (or (null (cdr c-old-beg-ml)) + (< end (caddr c-old-beg-ml))))) + c-old-beg-ml + (c-ml-string-delims-around-point))) + (setq c-end-pos (c-position-wrt-ml-delims c-old-end-ml)) + (c-save-buffer-state - ((term-del (c-raw-string-in-end-delim beg end)) + ((term-del (c-ml-string-in-end-delim beg end (car c-old-beg-ml))) 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 + ;; We're not changing, or we're obliterating ml strings. + ((and (null c-beg-pos) (null c-end-pos))) + ;; We're changing the putative terminating delimiter of an ml 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))) - (setq c-raw-string-end-delim-disrupted t) - (c-depropertize-raw-strings-in-region Rquote close-quote) + ((and c-beg-pos term-del + (or (null (cdr c-old-beg-ml)) + (<= (car term-del) (cadr c-old-beg-ml)))) + (setq Rquote (caar c-old-beg-ml) + close-quote (cdr term-del)) + (setq c-ml-string-end-delim-disrupted t) + (c-depropertize-ml-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 + ((and c-old-end-ml (< 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) + (c-depropertize-ml-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)))) + ;; Any critical deletion of "s will be handled in + ;; `c-after-change-unmark-ml-strings'. + ((and (equal c-old-beg-ml c-old-end-ml) + (eq c-beg-pos 'string) (eq c-end-pos 'string))) ((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)) + (null c-old-beg-ml) + (and (eq beg (caar c-old-beg-ml)) (< 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) + (and (eq c-beg-pos 'open-delim) + (or (null c-old-end-ml) + (not (eq c-end-pos 'open-delim)) + (not (equal c-old-beg-ml c-old-end-ml)))) + ;; Or we're disrupting a starting delim by typing into it, or removing + ;; characters from it. + (and (eq c-beg-pos 'open-delim) + (eq c-end-pos 'open-delim) + (equal c-old-beg-ml c-old-end-ml))) + (let ((close (caddr (or c-old-end-ml c-old-beg-ml)))) + (setq Rquote (caar (or c-old-end-ml c-old-beg-ml)) + close-quote (or close (point-max)))) + (c-depropertize-ml-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-lit-pos-cache (point)) - (forward-char)))) + c-new-END (max c-new-END close-quote)))))) -(defun c-propertize-raw-string-opener (id open-quote open-paren bound) - ;; Point is immediately after a raw string opening delimiter. Apply any - ;; pertinent `syntax-table' text properties to the delimiter and also the - ;; raw string, should there be a valid matching closing delimiter. - ;; - ;; 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 (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-lit-pos-cache (point)) - (forward-char)) - (goto-char after-quote) - t) - (c-put-char-property open-quote 'syntax-table '(1)) ; punctuation - (c-truncate-lit-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-lit-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-lit-pos-cache (1+ (match-beginning 5)))) - ;; (c-put-char-property open-paren 'syntax-table '(1)) - ) - (goto-char bound)) - nil))) - -(defun c-after-change-unmark-raw-strings (beg end _old-len) - ;; This function removes `syntax-table' text properties from any raw strings +(defun c-after-change-unmark-ml-strings (beg end old-len) + ;; This function removes `syntax-table' text properties from any ml 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 + ;; have been "stringed out" and from newly formed ml strings, or any + ;; existing ml 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 functions is called as an after-change function by virtue of its - ;; membership of the C++ value of `c-before-font-lock-functions'. + ;; membership of the mode's value of `c-before-font-lock-functions'. ;; (when (< beg end) - (c-save-buffer-state (found eoll state id found-beg) - ;; Has an inserted " swallowed up a R"(, turning it into "...R"(? + ;; + ;; Maintainers' note: Be careful with the use of `c-old-beg-ml' and + ;; `c-old-end-ml'; since text has been inserted or removed, most of the + ;; components in these variables will no longer be valid. (caar + ;; c-old-beg-ml) is normally OK, (cadar c-old-beg-ml) often is, any others + ;; will need adjstments. + (c-save-buffer-state (found eoll state opener) + ;; 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 c-ml-string-opener-re eoll t)) + (setq state (c-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-lit-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 (1+ (match-end 1))) ; Count inserted " too. + (setq c-new-END + (max c-new-END + (if (re-search-forward + (funcall c-make-ml-string-closer-re-function + (match-string-no-properties 1)) + nil t) + (1- (match-end 1)) ; 1- For the inserted ". + eoll)))) + + ;; ...and clear `syntax-table' text propertes from the + ;; following raw strings. + (c-depropertize-ml-strings-in-region (point) (1+ eoll))) + ;; Remove the temporary string delimiter. + (goto-char end) + (delete-char 1) + (c-truncate-lit-pos-cache end)))) + + ;; Have we just created a new starting id? + (goto-char beg) + (setq opener + (if (eq beg end) + (c-ml-string-opener-at-or-around-point end) + (c-ml-string-opener-intersects-region beg end))) + (when + (and opener (<= (car opener) end) + (setq state (c-semi-pp-to-literal (car opener))) + (not (cadr state))) + (setq c-new-BEG (min c-new-BEG (car opener))) + (goto-char (cadr opener)) + (when (re-search-forward + (funcall c-make-ml-string-closer-re-function + (buffer-substring-no-properties + (car opener) (cadr opener))) + nil t) ; No bound + (setq c-new-END (max c-new-END (match-end 1)))) + (goto-char c-new-BEG) + (while (c-search-forward-char-property-with-value-on-char + 'syntax-table '(15) ?\" c-new-END) + (c-remove-string-fences (1- (point)))) + (c-depropertize-ml-strings-in-region c-new-BEG c-new-END)) + + ;; Have we matched up with an existing terminator by typing into or + ;; deleting from an opening delimiter? ... or by messing up a raw string's + ;; terminator so that it now matches a later terminator? + (when + (cond + ((or c-ml-string-end-delim-disrupted + (and c-old-beg-ml + (eq c-beg-pos 'open-delim))) + (goto-char (caar c-old-beg-ml))) + ((and (< beg end) + (not c-old-beg-ml) + c-old-1-beg-ml + (save-excursion + (goto-char (1- beg)) + (c-ml-string-back-to-neutral (caar c-old-1-beg-ml)) + (re-search-forward + (funcall c-make-ml-string-closer-re-function + (buffer-substring-no-properties + (caar c-old-1-beg-ml) + (cadar c-old-1-beg-ml))) + nil 'bound) + (> (point) beg))) + (goto-char (caar c-old-1-beg-ml)) + (setq c-new-BEG (min c-new-BEG (point))) + (c-truncate-lit-pos-cache (point)))) + + (when (looking-at c-ml-string-opener-re) + (goto-char (match-end 1)) + (when (re-search-forward (funcall c-make-ml-string-closer-re-function + (match-string-no-properties 1)) + nil t) ; No bound + ;; If what is to be the new delimiter was previously an unterminated + ;; ordinary string, clear the c-fl-syn-tab properties from this old + ;; string. + (when (c-get-char-property (match-beginning 2) 'c-fl-syn-tab) + (c-remove-string-fences (match-beginning 2))) + (setq c-new-END (point-max)) + (c-clear-char-properties (caar (or c-old-beg-ml c-old-1-beg-ml)) + c-new-END + 'syntax-table) + (c-truncate-lit-pos-cache + (caar (or c-old-beg-ml c-old-1-beg-ml)))))) + + ;; Have we disturbed the innards of an ml string, possibly by deleting "s? + (when (and + c-old-beg-ml + (eq c-beg-pos 'string) + (eq beg end)) + (goto-char beg) + (c-ml-string-back-to-neutral (caar c-old-beg-ml)) + (let ((bound (if (cdr c-old-end-ml) + (min (+ (- (caddr c-old-end-ml) old-len) + c-ml-string-max-closer-len-no-leader) + (point-max)) + (point-max))) + (new-END-end-ml-string + (if (cdr c-old-end-ml) + (- (caddr c-old-end-ml) old-len) + (point-max)))) + (when (and + (re-search-forward + (funcall c-make-ml-string-closer-re-function + (buffer-substring-no-properties + (caar c-old-beg-ml) (cadar c-old-beg-ml))) + bound 'bound) + (< (match-end 1) new-END-end-ml-string)) + (setq c-new-END (max new-END-end-ml-string c-new-END)) + (c-clear-char-properties (caar c-old-beg-ml) c-new-END + 'syntax-table) + (setq c-new-BEG (min (caar c-old-beg-ml) c-new-BEG)) + (c-truncate-lit-pos-cache (caar c-old-beg-ml))))) + + ;; Have we terminated an existing raw string by inserting or removing + ;; text? + (when + (and + (< beg end) + (eq c-old-END-literality 'string) + c-old-beg-ml) + ;; Have we just made or modified a closing delimiter? (goto-char end) - (setq eoll (c-point 'eoll)) - (when (and (null c-old-END-literality) - (search-forward-regexp c-c++-raw-string-opener-re eoll t)) - (setq state (c-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-lit-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))) + (c-ml-string-back-to-neutral (caar c-old-beg-ml)) (while (and (setq found - (search-forward-regexp c-c++-raw-string-opener-re - c-new-END 'bound)) - (<= (match-end 0) beg))) + (search-forward-regexp + c-ml-string-any-closer-re + (+ (c-point 'eol end) + (1- c-ml-string-max-closer-len-no-leader)) + t)) + (< (match-end 1) beg)) + (goto-char (match-end 1))) (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 c-c++-raw-string-opener-re) - (c-clear-char-property (1+ (point)) 'syntax-table) - (c-truncate-lit-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 matched up with an existing terminator by typing into an - ;; opening delimiter? ... or by messing up a raw string's terminator so - ;; that it now matches a later terminator? - (when - (or c-raw-string-end-delim-disrupted - (and c-old-beg-rs - (eq (car c-old-beg-rs) 'open-delim))) - (goto-char (cadr c-old-beg-rs)) - (when (looking-at c-c++-raw-string-opener-1-re) - (setq id (match-string-no-properties 1)) - (when (search-forward (concat ")" id "\"") nil t) ; No bound. - (setq c-new-END (point-max)) - (c-clear-char-properties (cadr c-old-beg-rs) c-new-END - 'syntax-table) - (c-truncate-lit-pos-cache (cadr c-old-beg-rs))))) - ;; Have we terminated an existing raw string by inserting or removing - ;; text? - (when (eq c-old-END-literality 'string) - ;; Have we just made or modified a closing delimiter? - (goto-char (max (- beg 18) (point-min))) - (while - (and - (setq found - (search-forward-regexp ")\\([^ ()\\\n\r\t]\\{0,16\\}\\)\"" - (+ end 17) t)) - (< (match-end 0) beg))) - (when (and found (<= (match-beginning 0) end)) - (setq id (match-string-no-properties 1)) - (goto-char (match-beginning 0)) + (let ((opener-re (funcall c-make-ml-string-opener-re-function + (match-string 1)))) (while (and - (setq found (search-backward (concat "R\"" id "(") nil t)) + (setq found (re-search-backward opener-re nil t)) (setq state (c-semi-pp-to-literal (point))) - (memq (nth 3 (car state)) '(t ?\")))) - (when found - (setq c-new-BEG (min (point) c-new-BEG) - c-new-END (point-max)) - (c-clear-syn-tab-properties (point) c-new-END) - (c-truncate-lit-pos-cache (point))))) - - ;; 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) + (memq (nth 3 (car state)) '(t ?\"))))) + (when found + (setq c-new-BEG (min (point) c-new-BEG) + c-new-END (point-max)) + (c-clear-syn-tab-properties (point) c-new-END) + (c-truncate-lit-pos-cache (point))))) + + ;; Are there any raw strings in a newly created macro? + (goto-char (c-point 'bol beg)) + (while (and (< (point) (c-point 'eol end)) + (re-search-forward c-anchored-cpp-prefix (c-point 'eol end) + 'boundt)) + (when (and (<= beg (match-end 1)) + (>= end (match-beginning 1))) + (goto-char (match-beginning 1)) (c-end-of-macro) - (c-depropertize-raw-strings-in-region found-beg (point)))))) + (c-depropertize-ml-strings-in-region + (match-beginning 1) (point)))))) -(defun c-maybe-re-mark-raw-string () +(defun c-maybe-re-mark-ml-string () ;; When this function is called, point is immediately after a " which opens - ;; a string. If this " is the characteristic " of a raw string - ;; opener, apply the pertinent `syntax-table' text properties to the - ;; entire raw string (when properly terminated) or just the delimiter - ;; (otherwise). In either of these cases, return t, otherwise return nil. - ;; - (let (in-macro macro-end) + ;; a string. If this " is the characteristic " of a multi-line string + ;; opener, apply the pertinent `syntax-table' text properties to the entire + ;; ml string (when properly terminated) or just the delimiter (otherwise). + ;; In either of these cases, return t, otherwise return nil. Point is moved + ;; to after the terminated raw string, or to the end of the containing + ;; macro, or to point-max. + ;; + (let (delim in-macro macro-end) (when (and - (eq (char-before (1- (point))) ?R) - (looking-at "\\([^ ()\\\n\r\t]\\{0,16\\}\\)(")) + (setq delim (c-ml-string-opener-at-or-around-point (1- (point)))) + (save-excursion + (goto-char (car delim)) + (not (c-in-literal)))) (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)) + (point) ))) (when (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. + (c-propertize-ml-string-opener + delim + macro-end)) ; bound (end of macro) or nil. (goto-char (or macro-end (point-max)))) t))) +(defun c-propertize-ml-string-id (delim) + ;; Apply punctuation ('(1)) syntax-table text properties to the opening or + ;; closing delimiter given by the three element dotted list DELIM, such that + ;; its "total syntactic effect" is that of a single ". + (save-excursion + (goto-char (car delim)) + (while (and (skip-chars-forward c-ml-string-non-punc-skip-chars + (cadr delim)) + (< (point) (cadr delim))) + (when (not (eq (point) (cddr delim))) + (c-put-char-property (point) 'syntax-table '(1)) + (c-truncate-lit-pos-cache (point))) + (forward-char)))) + +(defun c-propertize-ml-string-opener (delim bound) + ;; DELIM defines the opening delimiter of a multi-line string in the + ;; way returned by `c-ml-string-opener-around-point'. Apply any + ;; pertinent `syntax-table' text properties to this opening delimiter and in + ;; the case of a terminated ml string, also to the innards of the string and + ;; the terminating delimiter. + ;; + ;; BOUND is the end of the macro we're inside (i.e. the position of the + ;; closing newline), if any, otherwise nil. + ;; + ;; Point is undefined at the function start. For a terminated ml string, + ;; point is left after the terminating delimiter and t is returned. For an + ;; unterminated string, point is left at the end of the macro, if any, or + ;; after the unmatched opening delimiter, and nil is returned. + (c-propertize-ml-string-id delim) + (goto-char (cadr delim)) + (if (re-search-forward + (funcall c-make-ml-string-closer-re-function + (buffer-substring-no-properties + (car delim) (cadr delim))) + bound t) + + (let ((end-delim + (cons (match-beginning 1) + (cons (match-end 1) (match-beginning 2))))) + (c-propertize-ml-string-id end-delim) + (goto-char (cadr delim)) + (while (progn (skip-syntax-forward c-ml-string-non-punc-skip-chars + (car end-delim)) + (< (point) (car end-delim))) + (c-put-char-property (point) 'syntax-table '(1)) ; punctuation + (c-truncate-lit-pos-cache (point)) + (forward-char)) + (goto-char (cadr end-delim)) + t) + (c-put-char-property (cddr delim) 'syntax-table '(1)) + (c-put-char-property (1- (cadr delim)) 'syntax-table '(15)) + (c-truncate-lit-pos-cache (1- (cddr delim))) + (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 (cadr delim) (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 + (cadr delim) t)) + (if (match-beginning 10) + (progn + (c-put-char-property (match-beginning 10) 'syntax-table '(15)) + (c-truncate-lit-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-lit-pos-cache (match-beginning 5)))) + (goto-char bound)) + nil)) + +(defvar c-neutralize-pos nil) + ;; Buffer position of character neutralized by punctuation syntax-table + ;; text property ('(1)), or nil if there's no such character. +(defvar c-neutralized-prop nil) + ;; syntax-table text property that was on the character at + ;; `c-neutralize-pos' before it was replaced with '(1), or nil if none. + +(defun c-depropertize-ml-string (string-delims bound) + ;; Remove any `syntax-table' text properties associated with the opening + ;; delimiter of a multi-line string (if it's unmatched) or with the entire + ;; string. Exception: A single punctuation ('(1)) property will be left on + ;; a string character to make the entire set of multi-line strings + ;; syntactically neutral. This is done using the global variable + ;; `c-neutralize-pos', the position of this property (or nil if there is + ;; none). + ;; + ;; STRING-DELIMS, of the form of the output from + ;; `c-ml-string-delims-around-point' defines the current ml string. 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 + ;; (i.e. just before the terminating \n). + ;; + ;; Point is undefined on input, and 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. + + ;; Handle the special case of a closing " previously having been an + ;; unterminated ordinary string. + (when + (and + (cdr string-delims) + (equal (c-get-char-property (cdddr string-delims) ; pos of closing ". + 'syntax-table) + '(15))) + (goto-char (cdddr string-delims)) + (when (c-safe (c-forward-sexp)) ; To '(15) at EOL. + (c-clear-char-property (1- (point)) 'syntax-table) + (c-truncate-lit-pos-cache (1- (point))))) + ;; The '(15) in the closing delimiter will be cleared by the following. + + (c-depropertize-ml-string-delims string-delims) + (let ((bound1 (if (cdr string-delims) + (caddr string-delims) ; end of closing delimiter. + bound)) + first s) + (if (and + bound1 + (setq first (c-clear-char-properties (cadar string-delims) bound1 + 'syntax-table))) + (c-truncate-lit-pos-cache first)) + (setq s (parse-partial-sexp (or c-neutralize-pos (caar string-delims)) + (or bound1 (point-max)))) + (cond + ((not (nth 3 s))) ; Nothing changed by this ml-string. + ((not c-neutralize-pos) ; "New" unbalanced quote in this ml-s. + (setq c-neutralize-pos (nth 8 s)) + (setq c-neutralized-prop (c-get-char-property c-neutralize-pos + 'syntax-table)) + (c-put-char-property c-neutralize-pos 'syntax-table '(1)) + (c-truncate-lit-pos-cache c-neutralize-pos)) + ((eq (nth 3 s) (char-after c-neutralize-pos)) + ;; New unbalanced quote balances old one. + (if c-neutralized-prop + (c-put-char-property c-neutralize-pos 'syntax-table + c-neutralized-prop) + (c-clear-char-property c-neutralize-pos 'syntax-table)) + (c-truncate-lit-pos-cache c-neutralize-pos) + (setq c-neutralize-pos nil)) + ;; New unbalanced quote doesn't balance old one. Nothing to do. + ))) + +(defun c-depropertize-ml-strings-in-region (start finish) + ;; Remove any `syntax-table' text properties associated with multi-line + ;; strings contained in the region (START FINISH). Point is undefined at + ;; entry and exit, and the return value has no significance. + (setq c-neutralize-pos nil) + (goto-char start) + (while (and (< (point) finish) + (re-search-forward + c-ml-string-cpp-or-opener-re + finish t)) + (if (match-beginning (+ c-cpp-or-ml-match-offset 1)) ; opening delimiter + ;; We've found a raw string + (let ((open-delim + (cons (match-beginning (+ c-cpp-or-ml-match-offset 1)) + (cons (match-end (+ c-cpp-or-ml-match-offset 1)) + (match-beginning (+ c-cpp-or-ml-match-offset 2)))))) + (c-depropertize-ml-string + (cons open-delim + (when + (and + (re-search-forward + (funcall c-make-ml-string-closer-re-function + (match-string-no-properties + (+ c-cpp-or-ml-match-offset 1))) + (min (+ finish c-ml-string-max-closer-len-no-leader) + (point-max)) + t) + (<= (match-end 1) finish)) + (cons (match-beginning 1) + (cons (match-end 1) (match-beginning 2))))) + 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 + c-ml-string-opener-re eom t)) + (save-excursion + (let ((open-delim (cons (match-beginning 1) + (cons (match-end 1) + (match-beginning 2))))) + (c-depropertize-ml-string + (cons open-delim + (when (re-search-forward + (funcall c-make-ml-string-closer-re-function + (match-string-no-properties 1)) + eom t) + (cons (match-beginning 1) + (cons (match-end 1) (match-beginning 2))))) + eom))))))) ; bound. + (when c-neutralize-pos + (if c-neutralized-prop + (c-put-char-property c-neutralize-pos 'syntax-table + c-neutralized-prop) + (c-clear-char-property c-neutralize-pos 'syntax-table)) + (c-truncate-lit-pos-cache c-neutralize-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 a7c87125cdd..3c429155abb 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -781,9 +781,9 @@ casts and declarations are fontified. Used on level 2 and higher." ;; Invalid single quotes. c-font-lock-invalid-single-quotes - ;; Fontify C++ raw strings. - ,@(when (c-major-mode-is 'c++-mode) - '(c-font-lock-raw-strings)) + ;; Fontify multiline strings. + ,@(when (c-lang-const c-ml-string-opener-re) + '(c-font-lock-ml-strings)) ;; Fontify keyword constants. ,@(when (c-lang-const c-constant-kwds) @@ -1737,8 +1737,8 @@ casts and declarations are fontified. Used on level 2 and higher." (c-font-lock-declarators limit t in-typedef (not (c-bs-at-toplevel-p (point))))))))))) -(defun c-font-lock-raw-strings (limit) - ;; Fontify C++ raw strings. +(defun c-font-lock-ml-strings (limit) + ;; Fontify multi-line strings. ;; ;; This function will be called from font-lock for a region bounded by POINT ;; and LIMIT, as though it were to identify a keyword for @@ -1748,52 +1748,75 @@ casts and declarations are fontified. Used on level 2 and higher." (let* ((state (c-semi-pp-to-literal (point))) (string-start (and (eq (cadr state) 'string) (car (cddr state)))) - (raw-id (and string-start - (c-at-c++-raw-string-opener string-start) - (match-string-no-properties 1))) - (content-start (and raw-id (point)))) + (open-delim (and string-start + (save-excursion + (goto-char (1+ string-start)) + (c-ml-string-opener-around-point)))) + (string-delims (and open-delim + (cons open-delim (c-get-ml-closer open-delim)))) + found) ;; 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 - (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 - ;; 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 - (c-put-font-lock-face (match-beginning 0) (match-end 0) - 'font-lock-warning-face) - (when - (and - (equal paren-prop '(15)) - (not (c-search-forward-char-property 'syntax-table '(15) limit))) - (goto-char limit))) - (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) + (cond + ;; Point is not in an ml string + ((not string-delims) + (while (and (setq found (re-search-forward c-ml-string-opener-re + limit 'limit)) + (> (match-beginning 0) (point-min)) + (memq (c-get-char-property (1- (match-beginning 0)) 'face) + '(font-lock-comment-face font-lock-string-face + font-lock-comment-delimiter-face)))) + (when found + (setq open-delim (cons (match-beginning 1) + (cons (match-end 1) (match-beginning 2))) + string-delims (cons open-delim (c-get-ml-closer open-delim))) + (goto-char (caar string-delims)))) + + ;; Point is in the body of an ml string. + ((and string-delims + (>= (point) (cadar string-delims)) + (or (not (cdr string-delims)) + (< (point) (cadr string-delims)))) + (if (cdr string-delims) + (goto-char (cadr string-delims)) + (if (equal (c-get-char-property (1- (cadar string-delims)) + 'syntax-table) + '(15)) ; "Always" the case. + ;; The next search should be successful for an unterminated ml + ;; string inside a macro, but not for any other unterminated + ;; string. + (progn + (or (c-search-forward-char-property 'syntax-table '(15) limit) + (goto-char limit)) + (setq string-delims nil)) + (c-benign-error "Missing '(15) syntax-table property at %d" + (1- (cadar string-delims))) + (setq string-delims nil)))) + + ;; Point is at or in a closing delimiter + ((and string-delims + (cdr string-delims) + (>= (point) (cadr string-delims))) + (c-put-font-lock-face (cadr string-delims) (1+ (cadr string-delims)) + 'font-lock-string-face) + (c-remove-font-lock-face (1+ (cadr string-delims)) + (caddr string-delims)) + (goto-char (caddr string-delims)) + (setq string-delims nil)) + + ;; point is at or in an opening delimiter. + (t + (if (cdr string-delims) + (progn + (c-remove-font-lock-face (caar string-delims) + (1- (cadar string-delims))) + (c-put-font-lock-face (1- (cadar string-delims)) + (cadar string-delims) + 'font-lock-string-face)) + (c-put-font-lock-face (caar string-delims) (cadar string-delims) + 'font-lock-warning-face)) + (goto-char (cadar string-delims))))) + nil)) (defun c-font-lock-c++-lambda-captures (limit) ;; Fontify the lambda capture component of C++ lambda declarations. diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 35efadfd8d8..0b125bc43fa 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -453,9 +453,9 @@ so that all identifiers are recognized as words.") ;; The value here may be a list of functions or a single function. t 'c-before-change-check-unbalanced-strings c++ '(c-extend-region-for-CPP - c-before-change-check-raw-strings - c-before-change-check-<>-operators c-depropertize-CPP + c-before-change-check-ml-strings + c-before-change-check-<>-operators c-truncate-bs-cache c-before-change-check-unbalanced-strings c-parse-quotes-before-change) @@ -467,6 +467,8 @@ so that all identifiers are recognized as words.") java '(c-parse-quotes-before-change c-before-change-check-unbalanced-strings c-before-change-check-<>-operators) + pike '(c-before-change-check-ml-strings + c-before-change-check-unbalanced-strings) awk 'c-awk-record-region-clear-NL) (c-lang-defvar c-get-state-before-change-functions (let ((fs (c-lang-const c-get-state-before-change-functions))) @@ -506,7 +508,7 @@ parameters \(point-min) and \(point-max).") c-change-expand-fl-region) c++ '(c-depropertize-new-text c-after-change-escape-NL-in-string - c-after-change-unmark-raw-strings + c-after-change-unmark-ml-strings c-parse-quotes-after-change c-after-change-mark-abnormal-strings c-extend-font-lock-region-for-macros @@ -519,6 +521,11 @@ parameters \(point-min) and \(point-max).") c-after-change-mark-abnormal-strings c-restore-<>-properties c-change-expand-fl-region) + pike '(c-depropertize-new-text + c-after-change-escape-NL-in-string + c-after-change-unmark-ml-strings + c-after-change-mark-abnormal-strings + c-change-expand-fl-region) awk '(c-depropertize-new-text c-awk-extend-and-syntax-tablify-region)) (c-lang-defvar c-before-font-lock-functions @@ -620,6 +627,176 @@ Note that to set up a language to use this, additionally: '(?\"))) (c-lang-defvar c-string-delims (c-lang-const c-string-delims)) + +;; The next section of the code defines multi-line ("ml") strings for each +;; language. By default, there are no ml strings in a language. To configure +;; them, set each needed lang const in the section. See further details in +;; cc-engine.el (search for "Handling of CC Mode multi-line strings."). +(c-lang-defconst c-ml-string-backslash-escapes + ;; N.B. if `c-ml-string-backslash-escapes' is non-nil, you probably need a + ;; `c-ml-string-any-closer-re' that scans backslashed characters, etc. + "If non-nil, a \\ character escapes the next character in a ml string. +Otherwise such a \\ will be marked to be handled as any other character." + t nil + pike t + ) + +(c-lang-defconst c-ml-string-non-punc-skip-chars + ;; A `skip-chars-forward' argument which skips over all ml string characters + ;; which don't need to be marked with punctuation ('(1)) syntax. + t (if (c-lang-const c-ml-string-backslash-escapes) + "^\"" + "^\"\\")) +(c-lang-defvar c-ml-string-non-punc-skip-chars + (c-lang-const c-ml-string-non-punc-skip-chars)) + +(c-lang-defconst c-ml-string-opener-re + "If non-nil, a regexp that matches a multi-line string opener. +It may also match context. + +Such an opener must be at least 2 characters long, and must +contain a \" character. (match-string 1) matches the actual +delimiter and (match-string 2) matches the actual \". If a +delimiter contains several \"s, it is recommended to configure +the first of them as \"the\" \"." + t nil + pike "\\(#\\(\"\\)\\)" + c++ "\\(R\\(\"\\)[^ ()\\\n\r\t]\\{0,16\\}(\\)") +(c-lang-defvar c-ml-string-opener-re (c-lang-const c-ml-string-opener-re)) + +(c-lang-defconst c-ml-string-max-opener-len + "If non-nil, the maximum length of a multi-line string opener." + t nil + pike 2 + c++ 19) +(c-lang-defvar c-ml-string-max-opener-len + (c-lang-const c-ml-string-max-opener-len)) + +(c-lang-defconst c-ml-string-any-closer-re + "If non-nil, a regexp that matches any multi-line string closer. +It may also match context. + +A search for this regexp starting at the end of the corresponding +opener must find the first closer as the first match. + +Such a closer must include a \" character. (match-string 1) +matches the actual delimiter and and (match-string 2) matches the +actual \". If a delimiter contains several \"s, it is +recommended to regard the last of them as \"the\" \"." + t nil + pike "\\(?:\\=\\|[^\\\"]\\)\\(?:\\\\.\\)*\\(\\(\"\\)\\)" + c++ "\\()[^ ()\\n\r\t]\\{0,16\\}\\(\"\\)\\)") +;; csharp "\\(?:\\=\\|[^\"]\\)\\(?:\"\"\\)*\\(\\(\"\\)\\)\\(?:[^\"]\\|\\'\\)" +(c-lang-defvar c-ml-string-any-closer-re + (c-lang-const c-ml-string-any-closer-re)) + +(c-lang-defconst c-ml-string-max-closer-len + "If non-nil, the maximum length of a multi-line string closer. +This must include the length of any \"context trailer\" following +the actual closer and any \"context leader\" preceding it. This +variable is ignored when `c-ml-string-back-closer-re' is non-nil." + t nil + c++ 18) +(c-lang-defvar c-ml-string-max-closer-len + (c-lang-const c-ml-string-max-closer-len)) + +(c-lang-defconst c-ml-string-max-closer-len-no-leader + "If non-nil, the maximum length of a ml string closer without its leader. +By \"leader\" is meant the context bytes preceding the actual +multi-line string closer, that part of +`c-ml-string-any-closer-re''s match preceding (match-beginning 1)." + t nil + pike 1 + ;; 2 + ;; 3 + c++ 18) +(c-lang-defvar c-ml-string-max-closer-len-no-leader + (c-lang-const c-ml-string-max-closer-len-no-leader)) + +(c-lang-defconst c-ml-string-back-closer-re + "A regexp to move back out of a putative ml closer point is in. + +This variable need only be non-nil for languages with multi-line +string closers that can contain an indefinite length \"leader\" +preceding the actual closer. It was designed for formats where +an unbounded number of \\s or \"s might precede the closer +proper, for example in Pike Mode or csharp-mode. + +If point is in a putative multi-line string closer, a backward +regexp search with `c-ml-string-back-closer-re' will leave point +in a \"safe place\", from where a forward regexp search with +`c-ml-string-any-closer-re' can test whether the original +position was inside an actual closer. + +When non-nil, this variable should end in \"\\\\\\==\". Note that +such a backward search will match a minimal string, so a +\"context character\" is probably needed at the start of the +regexp. The value for csharp-mode would be something like +\"\\\\(:?\\\\`\\\\|[^\\\"]\\\\)\\\"*\\\\\\==\"." + t nil + pike "\\(:?\\`\\|[^\\\"]\\)\\(:?\\\\.\\)*\\=" + ;;pike ;; 2 + ;; "\\(:?\\`\\|[^\"]\\)\"*\\=" + ) +(c-lang-defvar c-ml-string-back-closer-re + (c-lang-const c-ml-string-back-closer-re)) + +(c-lang-defconst c-make-ml-string-closer-re-function + "If non-nil, a function which creates a closer regexp matching an opener. + +Such a function is given one argument, a multi-line opener (a +string), and returns a regexp which will match the corresponding +closer. When this regexp matches, (match-string 1) should be the +actual closing delimiter, and (match-string 2) the \"active\" \" +it contains. + +A forward regexp search for this regexp starting at the end of +the opener must find the closer as its first match." + t (if (c-lang-const c-ml-string-any-closer-re) + 'c-ml-string-make-closer-re) + c++ 'c-c++-make-ml-string-closer-re) +(c-lang-defvar c-make-ml-string-closer-re-function + (c-lang-const c-make-ml-string-closer-re-function)) + +(c-lang-defconst c-make-ml-string-opener-re-function + "If non-nil, a function which creates an opener regexp matching a closer. + +Such a function is given one argument, a multi-line closer (a +string), and returns a regexp which will match the corresponding +opener. When this regexp matches, (match-string 1) should be the +actual opening delimiter, and (match-string 2) the \"active\" \" +it contains. + +A backward regexp search for this regexp starting at the start of +the closer might not find the opener as its first match, should +there be copies of the opener contained in the multi-line string." + t (if (c-lang-const c-ml-string-opener-re) + 'c-ml-string-make-opener-re) + c++ 'c-c++-make-ml-string-opener-re) +(c-lang-defvar c-make-ml-string-opener-re-function + (c-lang-const c-make-ml-string-opener-re-function)) + +(c-lang-defconst c-ml-string-cpp-or-opener-re + ;; A regexp which matches either a macro or a multi-line string opener. + t (concat "\\(" + (or (c-lang-const c-anchored-cpp-prefix) "\\`a\\`") + "\\)\\|\\(" + (or (c-lang-const c-ml-string-opener-re) "\\`a\\`") + "\\)")) +(c-lang-defvar c-ml-string-cpp-or-opener-re + (c-lang-const c-ml-string-cpp-or-opener-re)) + +(c-lang-defconst c-cpp-or-ml-match-offset + ;; The offset to be added onto match numbers for a multi-line string in + ;; matches for `c-cpp-or-ml-string-opener-re'. + t (if (c-lang-const c-anchored-cpp-prefix) + (+ 2 (regexp-opt-depth (c-lang-const c-anchored-cpp-prefix))) + 2)) +(c-lang-defvar c-cpp-or-ml-match-offset + (c-lang-const c-cpp-or-ml-match-offset)) +;; End of ml string section. + + (c-lang-defconst c-has-quoted-numbers "Whether the language has numbers quoted like 4'294'967'295." t nil @@ -860,9 +1037,15 @@ literals." "Set if the language supports multiline string literals without escaped newlines. If t, all string literals are multiline. If a character, only literals where the open quote is immediately preceded by that -literal are multiline." - t nil - pike ?#) +literal are multiline. + +Note that from CC Mode 5.36, this character use is obsolete, +having been superseded by the \"multi-line string\" mechanism. +If both mechanisms are set for a language, the newer one prevails +over the old `c-multiline-string-start-char'. See the variables +in the page containing `c-ml-string-opener-re' in cc-langs.el for +further directions." + t nil) (c-lang-defvar c-multiline-string-start-char (c-lang-const c-multiline-string-start-char)) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 51085495bd8..a5df8449ea0 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1003,8 +1003,8 @@ 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) - (when (c-major-mode-is 'c++-mode) - (save-excursion (c-depropertize-raw-strings-in-region m-beg (point)))) + (when c-ml-string-opener-re + (save-excursion (c-depropertize-ml-strings-in-region m-beg (point)))) (c-clear-char-property-with-value m-beg (point) 'syntax-table '(1))) (while (and (< (point) end) @@ -1014,8 +1014,8 @@ Note that the style variables are always made local to the buffer." (setq m-beg (point)) (c-end-of-macro)) (when (and ss-found (> (point) end)) - (when (c-major-mode-is 'c++-mode) - (save-excursion (c-depropertize-raw-strings-in-region m-beg (point)))) + (when c-ml-string-opener-re + (save-excursion (c-depropertize-ml-strings-in-region m-beg (point)))) (c-clear-char-property-with-value m-beg (point) 'syntax-table '(1))) (while (and (< (point) c-new-END) @@ -1023,8 +1023,8 @@ 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) - (when (c-major-mode-is 'c++-mode) - (save-excursion (c-depropertize-raw-strings-in-region m-beg (point)))) + (when c-ml-string-opener-re + (save-excursion (c-depropertize-ml-strings-in-region m-beg (point)))) (c-clear-char-property-with-value m-beg (point) 'syntax-table '(1))))) @@ -1174,12 +1174,15 @@ Note that the style variables are always made local to the buffer." ))))) (defun c-unescaped-nls-in-string-p (&optional quote-pos) - ;; Return whether unescaped newlines can be inside strings. + ;; Return whether unescaped newlines can be inside strings. If the current + ;; language handles multi-line strings, the value of this function is always + ;; nil. ;; ;; QUOTE-POS, if present, is the position of the opening quote of a string. ;; Depending on the language, there might be a special character before it ;; signifying the validity of such NLs. (cond + (c-ml-string-opener-re nil) ((null c-multiline-string-start-char) nil) ((c-characterp c-multiline-string-start-char) (and quote-pos @@ -1323,13 +1326,13 @@ Note that the style variables are always made local to the buffer." (setq pos (c-min-property-position pos c-max-syn-tab-mkr 'c-fl-syn-tab)) (when (< pos c-max-syn-tab-mkr) - (goto-char pos)) - (when (and (save-match-data - (c-search-backward-char-property-with-value-on-char - 'c-fl-syn-tab '(15) ?\" - (max (- (point) 500) (point-min)))) - (not (equal (c-get-char-property (point) 'syntax-table) '(1)))) - (setq pos (1+ pos))) + (goto-char pos) + (when (and (save-match-data + (c-search-backward-char-property-with-value-on-char + 'c-fl-syn-tab '(15) ?\" + (max (- (point) 500) (point-min)))) + (not (equal (c-get-char-property (point) 'syntax-table) '(1)))) + (setq pos (1+ pos)))) (while (< pos c-max-syn-tab-mkr) (setq pos (c-min-property-position pos c-max-syn-tab-mkr 'c-fl-syn-tab)) @@ -1435,7 +1438,8 @@ Note that the style variables are always made local to the buffer." ;; quotes up until the next unescaped EOL. Also guard against the change ;; being the insertion of \ before an EOL, escaping it. (cond - ((c-characterp c-multiline-string-start-char) + ((and (not c-ml-string-opener-re) + (c-characterp c-multiline-string-start-char)) ;; The text about to be inserted might contain a multiline string ;; opener. Set c-new-END after anything which might be affected. ;; Go to the end of the putative multiline string. @@ -1461,7 +1465,8 @@ Note that the style variables are always made local to the buffer." (< (point) (point-max)))))) (setq c-new-END (max (point) c-new-END))) - (c-multiline-string-start-char + ((and (not c-ml-string-opener-re) + c-multiline-string-start-char) (setq c-bc-changed-stringiness (not (eq (eq end-literal-type 'string) (eq beg-literal-type 'string)))) @@ -1506,7 +1511,7 @@ Note that the style variables are always made local to the buffer." ;; Opening " at EOB. (c-clear-syn-tab (1- (point)))) (when (and (c-search-backward-char-property 'syntax-table '(15) c-new-BEG) - (memq (char-after) c-string-delims)) ; Ignore an unterminated raw string's (. + (memq (char-after) c-string-delims)) ; Ignore an unterminated ml string's (. ;; Opening " on last line of text (without EOL). (c-remove-string-fences) (setq c-new-BEG (min c-new-BEG (point)))))) @@ -1520,13 +1525,15 @@ Note that the style variables are always made local to the buffer." (unless (or (and - ;; Don't set c-new-BEG/END if we're in a raw string. + ;; Don't set c-new-BEG/END if we're in an ml string. (eq beg-literal-type 'string) - (c-at-c++-raw-string-opener (car beg-limits))) + (c-ml-string-opener-at-or-around-point (car beg-limits))) (and c-multiline-string-start-char + (not c-ml-string-opener-re) (not (c-characterp c-multiline-string-start-char)))) (when (and (eq end-literal-type 'string) - (not (eq (char-before (cdr end-limits)) ?\()) + (or (memq (char-before (cdr end-limits)) c-string-delims) + (memq (char-before (cdr end-limits)) '(?\n ?\r))) (memq (char-after (car end-limits)) c-string-delims)) (setq c-new-END (max c-new-END (cdr end-limits))) (when (equal (c-get-char-property (car end-limits) 'syntax-table) @@ -1549,6 +1556,7 @@ Note that the style variables are always made local to the buffer." ;; This function is called exclusively as an after-change function via ;; `c-before-font-lock-functions'. (if (and c-multiline-string-start-char + (not c-ml-string-opener-re) (not (c-characterp c-multiline-string-start-char))) ;; Only the last " might need to be marked. (c-save-buffer-state @@ -1591,6 +1599,7 @@ Note that the style variables are always made local to the buffer." ((and (null beg-literal-type) (goto-char beg) (and (not (bobp)) + (not c-ml-string-opener-re) (eq (char-before) c-multiline-string-start-char)) (memq (char-after) c-string-delims)) (cons (point) @@ -1615,6 +1624,7 @@ Note that the style variables are always made local to the buffer." (point)) c-new-END)) s) + (goto-char (cond ((null beg-literal-type) c-new-BEG) @@ -1638,8 +1648,9 @@ Note that the style variables are always made local to the buffer." (and (memq (char-before) c-string-delims) (not (nth 4 s))))) ; Check we're actually out of the ; comment. not stuck at EOB - (unless (and (c-major-mode-is 'c++-mode) - (c-maybe-re-mark-raw-string)) + (unless + (and c-ml-string-opener-re + (c-maybe-re-mark-ml-string)) (if (c-unescaped-nls-in-string-p (1- (point))) (looking-at "\\(\\\\\\(.\\|\n\\)\\|[^\"]\\)*") (looking-at (cdr (assq (char-before) c-string-innards-re-alist)))) @@ -1678,21 +1689,15 @@ Note that the style variables are always made local to the buffer." (progn (goto-char end) (setq lit-start (c-literal-start))) (memq (char-after lit-start) c-string-delims) - (or (not (c-major-mode-is 'c++-mode)) + (or (not c-ml-string-opener-re) (progn (goto-char lit-start) - (and (not (and (eq (char-before) ?R) - (looking-at c-c++-raw-string-opener-1-re))) - (not (and (eq (char-after) ?\() - (equal (c-get-char-property - (point) 'syntax-table) - '(15)))))) + (not (c-ml-string-opener-at-or-around-point))) (save-excursion (c-beginning-of-macro)))) (goto-char (1+ end)) ; After the \ - ;; Search forward for EOLL - (setq lim (re-search-forward "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\\\n\r]\\)*" - nil t)) + ;; Search forward for EOLL. + (setq lim (c-point 'eoll)) (goto-char (1+ end)) (when (c-search-forward-char-property-with-value-on-char 'syntax-table '(15) ?\" lim) -- cgit v1.2.3