commit 0a49f158f1598fb92989f3cbdc238a7e5f1bd8a3 (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Sun Jan 22 00:18:40 2017 -0800 Improve uses of CHECK_LIST etc. * src/eval.c (FletX): Report an error for invalid constructs like ‘(let* (a . 0))’, so that ‘let*’ is more consistent with ‘let’. (lambda_arity): Use plain CHECK_CONS. * src/fns.c (CHECK_LIST_END): Move from here to lisp.h. (Fcopy_alist): Remove unnecessary CHECK_LIST call, since concat does that for us. (Fnthcdr, Fmember, Fmemql, Fdelete, Fnreverse): Use CHECK_LIST_END, not CHECK_LIST_CONS. This hoists a runtime check out of the loop. (Fmemq): Simplify and use CHECK_LIST_END instead of CHECK_LIST. (Fassq, Fassoc, Frassq, Frassoc): Simplify and use CHECK_LIST_END instead of CAR. (assq_no_quit, assoc_no_quit): Simplify and assume proper list. (Fnconc): Use plain CHECK_CONS, and do-while instead of while loop. * src/fontset.c (Fnew_fontset): * src/frame.c (Fmodify_frame_parameters): Use CHECK_LIST_END at end, rather than CHECK_LIST at start, for a more-complete check. * src/gfilenotify.c (Fgfile_add_watch): Omit unnecessary CHECK_LIST, since Fmember does that for us. * src/lisp.h (lisp_h_CHECK_LIST_CONS, CHECK_LIST_CONS): Remove; no longer used. (CHECK_LIST_END): New inline function. diff --git a/src/eval.c b/src/eval.c index c05c8d8f8d..01e3db4408 100644 --- a/src/eval.c +++ b/src/eval.c @@ -856,9 +856,7 @@ usage: (let* VARLIST BODY...) */) lexenv = Vinternal_interpreter_environment; - varlist = XCAR (args); - CHECK_LIST (varlist); - while (CONSP (varlist)) + for (varlist = XCAR (args); CONSP (varlist); varlist = XCDR (varlist)) { QUIT; @@ -894,9 +892,8 @@ usage: (let* VARLIST BODY...) */) } else specbind (var, val); - - varlist = XCDR (varlist); } + CHECK_LIST_END (varlist, XCAR (args)); val = Fprogn (XCDR (args)); return unbind_to (count, val); @@ -3098,7 +3095,7 @@ lambda_arity (Lisp_Object fun) if (EQ (XCAR (fun), Qclosure)) { fun = XCDR (fun); /* Drop `closure'. */ - CHECK_LIST_CONS (fun, fun); + CHECK_CONS (fun); } syms_left = XCDR (fun); if (CONSP (syms_left)) diff --git a/src/fns.c b/src/fns.c index 00fa65886f..c65a731f32 100644 --- a/src/fns.c +++ b/src/fns.c @@ -89,12 +89,6 @@ enum { QUIT_COUNT_HEURISTIC = 1 << 16 }; /* Random data-structure functions. */ -static void -CHECK_LIST_END (Lisp_Object x, Lisp_Object y) -{ - CHECK_TYPE (NILP (x), Qlistp, y); -} - DEFUN ("length", Flength, Slength, 1, 1, 0, doc: /* Return the length of vector, list or string SEQUENCE. A byte-code function object is also allowed. @@ -1202,17 +1196,12 @@ are shared, however. Elements of ALIST that are not conses are also shared. */) (Lisp_Object alist) { - register Lisp_Object tem; - - CHECK_LIST (alist); if (NILP (alist)) return alist; - alist = concat (1, &alist, Lisp_Cons, 0); - for (tem = alist; CONSP (tem); tem = XCDR (tem)) + alist = concat (1, &alist, Lisp_Cons, false); + for (Lisp_Object tem = alist; !NILP (tem); tem = XCDR (tem)) { - register Lisp_Object car; - car = XCAR (tem); - + Lisp_Object car = XCAR (tem); if (CONSP (car)) XSETCAR (tem, Fcons (XCAR (car), XCDR (car))); } @@ -1356,16 +1345,20 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, doc: /* Take cdr N times on LIST, return the result. */) (Lisp_Object n, Lisp_Object list) { - EMACS_INT i, num; CHECK_NUMBER (n); - num = XINT (n); - for (i = 0; i < num && !NILP (list); i++) + EMACS_INT num = XINT (n); + Lisp_Object tail = list; + for (EMACS_INT i = 0; i < num; i++) { + if (! CONSP (tail)) + { + CHECK_LIST_END (tail, list); + return Qnil; + } + tail = XCDR (tail); QUIT; - CHECK_LIST_CONS (list, list); - list = XCDR (list); } - return list; + return tail; } DEFUN ("nth", Fnth, Snth, 2, 2, 0, @@ -1392,66 +1385,52 @@ DEFUN ("elt", Felt, Selt, 2, 2, 0, DEFUN ("member", Fmember, Smember, 2, 2, 0, doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `equal'. The value is actually the tail of LIST whose car is ELT. */) - (register Lisp_Object elt, Lisp_Object list) + (Lisp_Object elt, Lisp_Object list) { - register Lisp_Object tail; - for (tail = list; !NILP (tail); tail = XCDR (tail)) + Lisp_Object tail; + for (tail = list; CONSP (tail); tail = XCDR (tail)) { - register Lisp_Object tem; - CHECK_LIST_CONS (tail, list); - tem = XCAR (tail); - if (! NILP (Fequal (elt, tem))) + if (! NILP (Fequal (elt, XCAR (tail)))) return tail; QUIT; } + CHECK_LIST_END (tail, list); return Qnil; } DEFUN ("memq", Fmemq, Smemq, 2, 2, 0, doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eq'. The value is actually the tail of LIST whose car is ELT. */) - (register Lisp_Object elt, Lisp_Object list) + (Lisp_Object elt, Lisp_Object list) { - while (1) + Lisp_Object tail; + for (tail = list; CONSP (tail); tail = XCDR (tail)) { - if (!CONSP (list) || EQ (XCAR (list), elt)) - break; - - list = XCDR (list); - if (!CONSP (list) || EQ (XCAR (list), elt)) - break; - - list = XCDR (list); - if (!CONSP (list) || EQ (XCAR (list), elt)) - break; - - list = XCDR (list); + if (EQ (XCAR (tail), elt)) + return tail; QUIT; } - - CHECK_LIST (list); - return list; + CHECK_LIST_END (tail, list); + return Qnil; } DEFUN ("memql", Fmemql, Smemql, 2, 2, 0, doc: /* Return non-nil if ELT is an element of LIST. Comparison done with `eql'. The value is actually the tail of LIST whose car is ELT. */) - (register Lisp_Object elt, Lisp_Object list) + (Lisp_Object elt, Lisp_Object list) { - register Lisp_Object tail; - if (!FLOATP (elt)) return Fmemq (elt, list); - for (tail = list; !NILP (tail); tail = XCDR (tail)) + Lisp_Object tail; + for (tail = list; CONSP (tail); tail = XCDR (tail)) { - register Lisp_Object tem; - CHECK_LIST_CONS (tail, list); - tem = XCAR (tail); + Lisp_Object tem = XCAR (tail); if (FLOATP (tem) && internal_equal (elt, tem, 0, 0, Qnil)) return tail; QUIT; } + CHECK_LIST_END (tail, list); return Qnil; } @@ -1461,44 +1440,27 @@ The value is actually the first element of LIST whose car is KEY. Elements of LIST that are not conses are ignored. */) (Lisp_Object key, Lisp_Object list) { - while (1) + Lisp_Object tail; + for (tail = list; CONSP (tail); tail = XCDR (tail)) { - if (!CONSP (list) - || (CONSP (XCAR (list)) - && EQ (XCAR (XCAR (list)), key))) - break; - - list = XCDR (list); - if (!CONSP (list) - || (CONSP (XCAR (list)) - && EQ (XCAR (XCAR (list)), key))) - break; - - list = XCDR (list); - if (!CONSP (list) - || (CONSP (XCAR (list)) - && EQ (XCAR (XCAR (list)), key))) - break; - - list = XCDR (list); + if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key)) + return XCAR (tail); QUIT; } - - return CAR (list); + CHECK_LIST_END (tail, list); + return Qnil; } /* Like Fassq but never report an error and do not allow quits. - Use only on lists known never to be circular. */ + Use only on objects known to be non-circular lists. */ Lisp_Object assq_no_quit (Lisp_Object key, Lisp_Object list) { - while (CONSP (list) - && (!CONSP (XCAR (list)) - || !EQ (XCAR (XCAR (list)), key))) - list = XCDR (list); - - return CAR_SAFE (list); + for (; ! NILP (list); list = XCDR (list)) + if (CONSP (XCAR (list)) && EQ (XCAR (XCAR (list)), key)) + return XCAR (list); + return Qnil; } DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, @@ -1506,81 +1468,49 @@ DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, The value is actually the first element of LIST whose car equals KEY. */) (Lisp_Object key, Lisp_Object list) { - Lisp_Object car; - - while (1) + Lisp_Object tail; + for (tail = list; CONSP (tail); tail = XCDR (tail)) { - if (!CONSP (list) - || (CONSP (XCAR (list)) - && (car = XCAR (XCAR (list)), - EQ (car, key) || !NILP (Fequal (car, key))))) - break; - - list = XCDR (list); - if (!CONSP (list) - || (CONSP (XCAR (list)) - && (car = XCAR (XCAR (list)), - EQ (car, key) || !NILP (Fequal (car, key))))) - break; - - list = XCDR (list); - if (!CONSP (list) - || (CONSP (XCAR (list)) - && (car = XCAR (XCAR (list)), - EQ (car, key) || !NILP (Fequal (car, key))))) - break; - - list = XCDR (list); + Lisp_Object car = XCAR (tail); + if (CONSP (car) + && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key)))) + return car; QUIT; } - - return CAR (list); + CHECK_LIST_END (tail, list); + return Qnil; } /* Like Fassoc but never report an error and do not allow quits. - Use only on lists known never to be circular. */ + Use only on objects known to be non-circular lists. */ Lisp_Object assoc_no_quit (Lisp_Object key, Lisp_Object list) { - while (CONSP (list) - && (!CONSP (XCAR (list)) - || (!EQ (XCAR (XCAR (list)), key) - && NILP (Fequal (XCAR (XCAR (list)), key))))) - list = XCDR (list); - - return CONSP (list) ? XCAR (list) : Qnil; + for (; ! NILP (list); list = XCDR (list)) + { + Lisp_Object car = XCAR (list); + if (CONSP (car) + && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key)))) + return car; + } + return Qnil; } DEFUN ("rassq", Frassq, Srassq, 2, 2, 0, doc: /* Return non-nil if KEY is `eq' to the cdr of an element of LIST. The value is actually the first element of LIST whose cdr is KEY. */) - (register Lisp_Object key, Lisp_Object list) + (Lisp_Object key, Lisp_Object list) { - while (1) + Lisp_Object tail; + for (tail = list; CONSP (tail); tail = XCDR (tail)) { - if (!CONSP (list) - || (CONSP (XCAR (list)) - && EQ (XCDR (XCAR (list)), key))) - break; - - list = XCDR (list); - if (!CONSP (list) - || (CONSP (XCAR (list)) - && EQ (XCDR (XCAR (list)), key))) - break; - - list = XCDR (list); - if (!CONSP (list) - || (CONSP (XCAR (list)) - && EQ (XCDR (XCAR (list)), key))) - break; - - list = XCDR (list); + if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key)) + return XCAR (tail); QUIT; } - - return CAR (list); + CHECK_LIST_END (tail, list); + return Qnil; } DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0, @@ -1588,35 +1518,17 @@ DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0, The value is actually the first element of LIST whose cdr equals KEY. */) (Lisp_Object key, Lisp_Object list) { - Lisp_Object cdr; - - while (1) + Lisp_Object tail; + for (tail = list; CONSP (tail); tail = XCDR (tail)) { - if (!CONSP (list) - || (CONSP (XCAR (list)) - && (cdr = XCDR (XCAR (list)), - EQ (cdr, key) || !NILP (Fequal (cdr, key))))) - break; - - list = XCDR (list); - if (!CONSP (list) - || (CONSP (XCAR (list)) - && (cdr = XCDR (XCAR (list)), - EQ (cdr, key) || !NILP (Fequal (cdr, key))))) - break; - - list = XCDR (list); - if (!CONSP (list) - || (CONSP (XCAR (list)) - && (cdr = XCDR (XCAR (list)), - EQ (cdr, key) || !NILP (Fequal (cdr, key))))) - break; - - list = XCDR (list); + Lisp_Object car = XCAR (tail); + if (CONSP (car) + && (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key)))) + return car; QUIT; } - - return CAR (list); + CHECK_LIST_END (tail, list); + return Qnil; } DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0, @@ -1756,10 +1668,8 @@ changing the value of a sequence `foo'. */) { Lisp_Object tail, prev; - for (tail = seq, prev = Qnil; !NILP (tail); tail = XCDR (tail)) + for (tail = seq, prev = Qnil; CONSP (tail); tail = XCDR (tail)) { - CHECK_LIST_CONS (tail, seq); - if (!NILP (Fequal (elt, XCAR (tail)))) { if (NILP (prev)) @@ -1771,6 +1681,7 @@ changing the value of a sequence `foo'. */) prev = tail; QUIT; } + CHECK_LIST_END (tail, seq); } return seq; @@ -1790,14 +1701,14 @@ This function may destructively modify SEQ to produce the value. */) { Lisp_Object prev, tail, next; - for (prev = Qnil, tail = seq; !NILP (tail); tail = next) + for (prev = Qnil, tail = seq; CONSP (tail); tail = next) { QUIT; - CHECK_LIST_CONS (tail, tail); next = XCDR (tail); Fsetcdr (tail, prev); prev = tail; } + CHECK_LIST_END (tail, seq); seq = prev; } else if (VECTORP (seq)) @@ -2498,14 +2409,15 @@ usage: (nconc &rest LISTS) */) if (argnum + 1 == nargs) break; - CHECK_LIST_CONS (tem, tem); + CHECK_CONS (tem); - while (CONSP (tem)) + do { tail = tem; tem = XCDR (tail); QUIT; } + while (CONSP (tem)); tem = args[argnum + 1]; Fsetcdr (tail, tem); diff --git a/src/fontset.c b/src/fontset.c index 33d1d24e5b..850558b08a 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -1677,11 +1677,10 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of `set-fontset-font' for the meaning. */) (Lisp_Object name, Lisp_Object fontlist) { - Lisp_Object fontset; + Lisp_Object fontset, tail; int id; CHECK_STRING (name); - CHECK_LIST (fontlist); name = Fdowncase (name); id = fs_query_fontset (name, 0); @@ -1714,11 +1713,11 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of Fset_char_table_range (fontset, Qt, Qnil); } - for (; CONSP (fontlist); fontlist = XCDR (fontlist)) + for (tail = fontlist; CONSP (tail); tail = XCDR (tail)) { Lisp_Object elt, script; - elt = XCAR (fontlist); + elt = XCAR (tail); script = Fcar (elt); elt = Fcdr (elt); if (CONSP (elt) && (NILP (XCDR (elt)) || CONSP (XCDR (elt)))) @@ -1727,6 +1726,7 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of else Fset_fontset_font (name, script, elt, Qnil, Qappend); } + CHECK_LIST_END (tail, fontlist); return name; } diff --git a/src/frame.c b/src/frame.c index 2c2c1e150d..d0f653fc76 100644 --- a/src/frame.c +++ b/src/frame.c @@ -2691,9 +2691,7 @@ list, but are otherwise ignored. */) (Lisp_Object frame, Lisp_Object alist) { struct frame *f = decode_live_frame (frame); - register Lisp_Object prop, val; - - CHECK_LIST (alist); + Lisp_Object prop, val; /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM @@ -3142,6 +3140,7 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) for (size = 0, tail = alist; CONSP (tail); tail = XCDR (tail)) size++; + CHECK_LIST_END (tail, alist); USE_SAFE_ALLOCA; SAFE_ALLOCA_LISP (parms, 2 * size); diff --git a/src/gfilenotify.c b/src/gfilenotify.c index 6ec5c64282..285a253733 100644 --- a/src/gfilenotify.c +++ b/src/gfilenotify.c @@ -178,20 +178,18 @@ will be reported only in case of the `moved' event. */) if (NILP (Ffile_exists_p (file))) report_file_error ("File does not exist", file); - CHECK_LIST (flags); - if (!FUNCTIONP (callback)) wrong_type_argument (Qinvalid_function, callback); - /* Create GFile name. */ - gfile = g_file_new_for_path (SSDATA (ENCODE_FILE (file))); - /* Assemble flags. */ if (!NILP (Fmember (Qwatch_mounts, flags))) gflags |= G_FILE_MONITOR_WATCH_MOUNTS; if (!NILP (Fmember (Qsend_moved, flags))) gflags |= G_FILE_MONITOR_SEND_MOVED; + /* Create GFile name. */ + gfile = g_file_new_for_path (SSDATA (ENCODE_FILE (file))); + /* Enable watch. */ monitor = g_file_monitor (gfile, gflags, NULL, &gerror); g_object_unref (gfile); diff --git a/src/lisp.h b/src/lisp.h index e774756308..7e91824993 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -310,7 +310,6 @@ error !; # define lisp_h_XLI(o) (o) # define lisp_h_XIL(i) (i) #endif -#define lisp_h_CHECK_LIST_CONS(x, y) CHECK_TYPE (CONSP (x), Qlistp, y) #define lisp_h_CHECK_NUMBER(x) CHECK_TYPE (INTEGERP (x), Qintegerp, x) #define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) #define lisp_h_CHECK_TYPE(ok, predicate, x) \ @@ -367,7 +366,6 @@ error !; #if DEFINE_KEY_OPS_AS_MACROS # define XLI(o) lisp_h_XLI (o) # define XIL(i) lisp_h_XIL (i) -# define CHECK_LIST_CONS(x, y) lisp_h_CHECK_LIST_CONS (x, y) # define CHECK_NUMBER(x) lisp_h_CHECK_NUMBER (x) # define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x) # define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x) @@ -2751,9 +2749,9 @@ CHECK_LIST (Lisp_Object x) } INLINE void -(CHECK_LIST_CONS) (Lisp_Object x, Lisp_Object y) +CHECK_LIST_END (Lisp_Object x, Lisp_Object y) { - lisp_h_CHECK_LIST_CONS (x, y); + CHECK_TYPE (NILP (x), Qlistp, y); } INLINE void commit ade0652cc2a7103cd910accda8165ff8ee7c719f Author: Tino Calancha Date: Sun Jan 22 14:23:45 2017 +0900 Prevent to use tabulated-list--near-rows unbound * lisp/emacs-lisp/tabulated-list.el (tabulated-list-print-entry): Make sure 'tabulated-list--near-rows' is bound before use it (Bug#25506). diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index eadf79ffd4..b6b49b1bfa 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -412,8 +412,13 @@ of column descriptors." (inhibit-read-only t)) (if (> tabulated-list-padding 0) (insert (make-string x ?\s))) - (dotimes (n ncols) - (setq x (tabulated-list-print-col n (aref cols n) x))) + (let ((tabulated-list--near-rows ; Bind it if not bound yet (Bug#25506). + (or (bound-and-true-p tabulated-list--near-rows) + (list (or (tabulated-list-get-entry (point-at-bol 0)) + cols) + cols)))) + (dotimes (n ncols) + (setq x (tabulated-list-print-col n (aref cols n) x)))) (insert ?\n) ;; Ever so slightly faster than calling `put-text-property' twice. (add-text-properties commit ad29e145b16cf2966e3a9df884cbc234f1ae3e51 Author: Juri Linkov Date: Sun Jan 22 01:18:53 2017 +0200 * lisp/simple.el (region-bounds): New function. (region-noncontiguous-p): Use it. http://lists.gnu.org/archive/html/emacs-devel/2017-01/msg00044.html diff --git a/etc/NEWS b/etc/NEWS index 95d03a373f..ca66df6261 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -787,6 +787,11 @@ of an arbitrary function. This generalizes 'subr-arity' for functions that are not built-in primitives. We recommend using this new function instead of 'subr-arity'. +** New function 'region-bounds' can be used in the interactive spec +to provide region boundaries (for rectangular regions more than one) +to an interactively callable function as a single argument instead of +two separate arguments region-beginning and region-end. + +++ ** 'parse-partial-sexp' state has a new element. Element 10 is non-nil when the last character scanned might be the first character diff --git a/lisp/simple.el b/lisp/simple.el index f798cd4384..bdc6abde1f 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5410,11 +5410,15 @@ also checks the value of `use-empty-active-region'." ;; region is active when there's no mark. (progn (cl-assert (mark)) t))) +(defun region-bounds () + "Return the boundaries of the region as a list of (START . END) positions." + (funcall region-extract-function 'bounds)) + (defun region-noncontiguous-p () "Return non-nil if the region contains several pieces. An example is a rectangular region handled as a list of separate contiguous regions for each line." - (> (length (funcall region-extract-function 'bounds)) 1)) + (> (length (region-bounds)) 1)) (defvar redisplay-unhighlight-region-function (lambda (rol) (when (overlayp rol) (delete-overlay rol)))) commit 07d15164271270d09464863d7ec2bfce62d65085 Author: Eli Zaretskii Date: Sat Jan 21 20:31:33 2017 +0200 ; * etc/NEWS: Describe how to disable double-buffering. (Bug#25474) diff --git a/etc/NEWS b/etc/NEWS index 051b97e146..95d03a373f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -116,7 +116,16 @@ dired buffer. ** Emacs now uses double buffering to reduce flicker when editing and resizing graphical Emacs frames on the X Window System. This support requires the DOUBLE-BUFFER extension, which major X servers have -supported for many years. +supported for many years. If your system has this extension, but an +Emacs built with double buffering misbehaves on some displays you use, +you can disable the feature by adding + + '(inhibit-double-buffering . t) + +to default-frame-parameters. Or inject this parameter into the +selected frame by evaluating this form: + + (modify-frame-parameters nil '((inhibit-double-buffering . t))) --- The group 'wp', whose label was "text", is now deprecated. commit de3336051ef74e0c3069374ced5b5fc7bb9fba15 Author: Alan Mackenzie Date: Sat Jan 21 15:14:15 2017 +0000 Fix low-level handling of (big) C macros. In particular, ensure that a comment detected by its syntax is not a CPP construct marked with generic comment delimiter syntax-table text properties. * lisp/progmodes/cc-engine.el (c-beginning-of-macro, c-end-of-macro): Set c-macro-cache-syntactic to nil when the cached macro changes. (c-syntactic-end-of-macro, c-no-comment-end-of-macro) (c-state-semi-pp-to-literal, c-state-full-pp-to-literal) (c-state-pp-to-literal, c-parse-ps-state-to-cache) (c-state-cache-non-literal-place, c-literal-limits, c-literal-start) (c-determine-limit): When checking a parse syntax for a comment, check that we're not in a CPP construct marked by syntax-table generic comment delimiter text property. (c-state-pp-to-literal): Change from a defsubst to a defun. * lisp/progmodes/cc-mode.el (c-neutralize-syntax-in-and-mark-CPP): Check a parse syntax as described above under cc-engine.el. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index e84c4cebf6..fd7aa50840 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -313,7 +313,8 @@ comment at the start of cc-engine.el for more info." (c-macro-is-genuine-p)) (progn (setq c-macro-cache (cons (point) nil) - c-macro-cache-start-pos here) + c-macro-cache-start-pos here + c-macro-cache-syntactic nil) t) (goto-char here) nil)))))) @@ -344,7 +345,8 @@ comment at the start of cc-engine.el for more info." (forward-char) t))) (when (car c-macro-cache) - (setcdr c-macro-cache (point))))) + (setcdr c-macro-cache (point)) + (setq c-macro-cache-syntactic nil)))) (defun c-syntactic-end-of-macro () ;; Go to the end of a CPP directive, or a "safe" pos just before. @@ -364,7 +366,8 @@ comment at the start of cc-engine.el for more info." (goto-char c-macro-cache-syntactic) (setq s (parse-partial-sexp here there)) (while (and (or (nth 3 s) ; in a string - (nth 4 s)) ; in a comment (maybe at end of line comment) + (and (nth 4 s) ; in a comment (maybe at end of line comment) + (not (eq (nth 7 s) 'syntax-table)))) ; Not a pseudo comment (> there here)) ; No infinite loops, please. (setq there (1- (nth 8 s))) (setq s (parse-partial-sexp here there))) @@ -389,7 +392,8 @@ comment at the start of cc-engine.el for more info." (> there here)) ; No infinite loops, please. (setq here (1+ (nth 8 s))) (setq s (parse-partial-sexp here there))) - (when (nth 4 s) + (when (and (nth 4 s) + (not (eq (nth 7 s) 'syntax-table))) ; no pseudo comments. (goto-char (1- (nth 8 s)))) (setq c-macro-cache-no-comment (point))) (point))) @@ -2407,7 +2411,9 @@ comment at the start of cc-engine.el for more info." (s (parse-partial-sexp base here nil nil s)) ty) (cond - ((or (nth 3 s) (nth 4 s)) ; in a string or comment + ((or (nth 3 s) + (and (nth 4 s) + (not (eq (nth 7 s) 'syntax-table)))) ; in a string or comment (setq ty (cond ((nth 3 s) 'string) ((nth 7 s) 'c++) @@ -2453,7 +2459,9 @@ comment at the start of cc-engine.el for more info." (s (parse-partial-sexp base here nil nil s)) ty start) (cond - ((or (nth 3 s) (nth 4 s)) ; in a string or comment + ((or (nth 3 s) + (and (nth 4 s) + (not (eq (nth 7 s) 'syntax-table)))) ; in a string or comment (setq ty (cond ((nth 3 s) 'string) ((nth 7 s) 'c++) @@ -2479,7 +2487,7 @@ comment at the start of cc-engine.el for more info." (t (list s)))))))) -(defsubst c-state-pp-to-literal (from to &optional not-in-delimiter) +(defun c-state-pp-to-literal (from to &optional not-in-delimiter) ;; Do a parse-partial-sexp from FROM to TO, returning either ;; (STATE TYPE (BEG . END)) if TO is in a literal; or ;; (STATE) otherwise, @@ -2498,7 +2506,9 @@ comment at the start of cc-engine.el for more info." (let ((s (parse-partial-sexp from to)) ty co-st) (cond - ((or (nth 3 s) (nth 4 s)) ; in a string or comment + ((or (nth 3 s) + (and (nth 4 s) + (not (eq (nth 7 s) 'syntax-table)))) ; in a string or comment (setq ty (cond ((nth 3 s) 'string) ((nth 7 s) 'c++) @@ -2560,7 +2570,8 @@ comment at the start of cc-engine.el for more info." (cond ((nth 3 state) ; A string (list (point) (nth 3 state) (nth 8 state))) - ((nth 4 state) ; A comment + ((and (nth 4 state) ; A comment + (not (eq (nth 7 state) 'syntax-table))) ; but not a psuedo comment. (list (point) (if (eq (nth 7 state) 1) 'c++ 'c) (nth 8 state))) @@ -2697,7 +2708,7 @@ comment at the start of cc-engine.el for more info." (widen) (save-excursion (let ((pos (c-state-safe-place here))) - (car (cddr (c-state-pp-to-literal pos here))))))) + (car (cddr (c-state-pp-to-literal pos here))))))) (defsubst c-state-lit-beg (pos) ;; Return the start of the literal containing POS, or POS itself. @@ -2708,7 +2719,8 @@ comment at the start of cc-engine.el for more info." ;; Return a position outside of a string/comment/macro at or before POS. ;; STATE is the parse-partial-sexp state at POS. (let ((res (if (or (nth 3 state) ; in a string? - (nth 4 state)) ; in a comment? + (and (nth 4 state) + (not (eq (nth 7 state) 'syntax-table)))) ; in a comment? (nth 8 state) pos))) (save-excursion @@ -3467,7 +3479,7 @@ comment at the start of cc-engine.el for more info." ((and (consp (car c-state-cache)) (> (cdar c-state-cache) here)) ;; CASE 1: The top of the cache is a brace pair which now encloses - ;; `here'. As good-pos, return the address. of the "{". Since we've no + ;; `here'. As good-pos, return the address of the "{". Since we've no ;; knowledge of what's inside these braces, we have no alternative but ;; to direct the caller to scan the buffer from the opening brace. (setq pos (caar c-state-cache)) @@ -4952,7 +4964,8 @@ comment at the start of cc-engine.el for more info." (lit-limits (if lim (let ((s (parse-partial-sexp lim (point)))) - (when (or (nth 3 s) (nth 4 s)) + (when (or (nth 3 s) + (and (nth 4 s) (not (eq (nth 7 s) 'syntax-table)))) (cons (nth 8 s) (progn (parse-partial-sexp (point) (point-max) nil nil @@ -5005,7 +5018,8 @@ point isn't in one. SAFE-POS, if non-nil, is a position before point which is a known \"safe position\", i.e. outside of any string or comment." (if safe-pos (let ((s (parse-partial-sexp safe-pos (point)))) - (and (or (nth 3 s) (nth 4 s)) + (and (or (nth 3 s) + (and (nth 4 s) (not (eq (nth 7 s) 'syntax-table)))) (nth 8 s))) (car (cddr (c-state-semi-pp-to-literal (point)))))) @@ -5106,7 +5120,8 @@ comment at the start of cc-engine.el for more info." 'syntax-table)) ; stop-comment ;; Gather details of the non-literal-bit - starting pos and size. - (setq size (- (if (or (nth 4 s) (nth 3 s)) + (setq size (- (if (or (and (nth 4 s) (not (eq (nth 7 s) 'syntax-table))) + (nth 3 s)) (nth 8 s) (point)) pos)) @@ -5114,7 +5129,8 @@ comment at the start of cc-engine.el for more info." (setq stack (cons (cons pos size) stack))) ;; Move forward to the end of the comment/string. - (if (or (nth 4 s) (nth 3 s)) + (if (or (and (nth 4 s) (not (eq (nth 7 s) 'syntax-table))) + (nth 3 s)) (setq s (parse-partial-sexp (point) start diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 7e3c6ba15a..e2969c607a 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1068,7 +1068,8 @@ Note that the style variables are always made local to the buffer." (parse-partial-sexp pps-position (point) nil nil pps-state) pps-position (point)) (or (nth 3 pps-state) ; in a string? - (nth 4 pps-state)))) ; in a comment? + (and (nth 4 pps-state) + (not (eq (nth 7 pps-state) 'syntax-table)))))) ; in a comment? (goto-char (match-beginning 1)) (setq mbeg (point)) (if (> (c-no-comment-end-of-macro) mbeg)