commit 201dfe311868932d10da146808fcdd681948ba53 (HEAD, refs/remotes/origin/master) Author: Noam Postavsky Date: Sun Dec 18 00:00:30 2016 -0500 Fix comment detection on open parens Characters having both open paren syntax and comment start syntax were being detected as open parens even when they should have been part a comment starter (Bug#24870). * src/syntax.c (in_2char_comment_start): New function, extracted from `scan_sexps_forward'. (scan_sexps_forward): Add check for a 2-char comment starter before the loop. Inside the loop, do that check after incrementing the 'from' character index. Move the single char comment syntax cases into the switch instead of special casing them before. * test/src/syntax-tests.el (parse-partial-sexp-paren-comments): (parse-partial-sexp-continue-over-comment-marker): New tests. diff --git a/src/syntax.c b/src/syntax.c index 84147a2dc1..0ee1c746ec 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -3092,6 +3092,36 @@ the prefix syntax flag (p). */) return Qnil; } + +/* If the character at FROM_BYTE is the second part of a 2-character + comment opener based on PREV_FROM_SYNTAX, update STATE and return + true. */ +static bool +in_2char_comment_start (struct lisp_parse_state *state, + int prev_from_syntax, + ptrdiff_t prev_from, + ptrdiff_t from_byte) +{ + int c1, syntax; + if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax) + && (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte), + syntax = SYNTAX_WITH_FLAGS (c1), + SYNTAX_FLAGS_COMSTART_SECOND (syntax))) + { + /* Record the comment style we have entered so that only + the comment-end sequence of the same style actually + terminates the comment section. */ + state->comstyle + = SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_from_syntax); + bool comnested = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) + | SYNTAX_FLAGS_COMMENT_NESTED (syntax)); + state->incomment = comnested ? 1 : -1; + state->comstr_start = prev_from; + return true; + } + return false; +} + /* Parse forward from FROM / FROM_BYTE to END, assuming that FROM has state STATE, and return a description of the state of the parse at END. @@ -3107,8 +3137,6 @@ scan_sexps_forward (struct lisp_parse_state *state, int commentstop) { enum syntaxcode code; - int c1; - bool comnested; struct level { ptrdiff_t last, prev; }; struct level levelstart[100]; struct level *curlevel = levelstart; @@ -3122,7 +3150,6 @@ scan_sexps_forward (struct lisp_parse_state *state, ptrdiff_t prev_from; /* Keep one character before FROM. */ ptrdiff_t prev_from_byte; int prev_from_syntax, prev_prev_from_syntax; - int syntax; bool boundary_stop = commentstop == -1; bool nofence; bool found; @@ -3187,53 +3214,31 @@ do { prev_from = from; \ } else if (start_quoted) goto startquoted; + else if ((from < end) + && (in_2char_comment_start (state, prev_from_syntax, + prev_from, from_byte))) + { + INC_FROM; + prev_from_syntax = Smax; /* the syntax has already been "used up". */ + goto atcomment; + } while (from < end) { - if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax) - && (c1 = FETCH_CHAR (from_byte), - syntax = SYNTAX_WITH_FLAGS (c1), - SYNTAX_FLAGS_COMSTART_SECOND (syntax))) - { - /* Record the comment style we have entered so that only - the comment-end sequence of the same style actually - terminates the comment section. */ - state->comstyle - = SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_from_syntax); - comnested = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) - | SYNTAX_FLAGS_COMMENT_NESTED (syntax)); - state->incomment = comnested ? 1 : -1; - state->comstr_start = prev_from; - INC_FROM; - prev_from_syntax = Smax; /* the syntax has already been - "used up". */ - code = Scomment; - } - else + INC_FROM; + + if ((from < end) + && (in_2char_comment_start (state, prev_from_syntax, + prev_from, from_byte))) { INC_FROM; - code = prev_from_syntax & 0xff; - if (code == Scomment_fence) - { - /* Record the comment style we have entered so that only - the comment-end sequence of the same style actually - terminates the comment section. */ - state->comstyle = ST_COMMENT_STYLE; - state->incomment = -1; - state->comstr_start = prev_from; - code = Scomment; - } - else if (code == Scomment) - { - state->comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax, 0); - state->incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ? - 1 : -1); - state->comstr_start = prev_from; - } + prev_from_syntax = Smax; /* the syntax has already been "used up". */ + goto atcomment; } if (SYNTAX_FLAGS_PREFIX (prev_from_syntax)) continue; + code = prev_from_syntax & 0xff; switch (code) { case Sescape: @@ -3252,24 +3257,15 @@ do { prev_from = from; \ symstarted: while (from < end) { - int symchar = FETCH_CHAR_AS_MULTIBYTE (from_byte); - - if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax) - && (syntax = SYNTAX_WITH_FLAGS (symchar), - SYNTAX_FLAGS_COMSTART_SECOND (syntax))) + if (in_2char_comment_start (state, prev_from_syntax, + prev_from, from_byte)) { - state->comstyle - = SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_from_syntax); - comnested = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) - | SYNTAX_FLAGS_COMMENT_NESTED (syntax)); - state->incomment = comnested ? 1 : -1; - state->comstr_start = prev_from; INC_FROM; - prev_from_syntax = Smax; - code = Scomment; + prev_from_syntax = Smax; /* the syntax has already been "used up". */ goto atcomment; } + int symchar = FETCH_CHAR_AS_MULTIBYTE (from_byte); switch (SYNTAX (symchar)) { case Scharquote: @@ -3290,8 +3286,19 @@ do { prev_from = from; \ curlevel->prev = curlevel->last; break; - case Scomment_fence: /* Can't happen because it's handled above. */ + case Scomment_fence: + /* Record the comment style we have entered so that only + the comment-end sequence of the same style actually + terminates the comment section. */ + state->comstyle = ST_COMMENT_STYLE; + state->incomment = -1; + state->comstr_start = prev_from; + goto atcomment; case Scomment: + state->comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax, 0); + state->incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ? + 1 : -1); + state->comstr_start = prev_from; atcomment: if (commentstop || boundary_stop) goto done; startincomment: diff --git a/test/src/syntax-tests.el b/test/src/syntax-tests.el new file mode 100644 index 0000000000..6edde0b137 --- /dev/null +++ b/test/src/syntax-tests.el @@ -0,0 +1,85 @@ +;;; syntax-tests.el --- tests for syntax.c functions -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) + +(ert-deftest parse-partial-sexp-continue-over-comment-marker () + "Continue a parse that stopped in the middle of a comment marker." + (with-temp-buffer + (let ((table (make-syntax-table))) + (modify-syntax-entry ?/ ". 124") + (modify-syntax-entry ?* ". 23b") + (set-syntax-table table)) + (insert "/*C*/\nX") + (goto-char (point-min)) + (let* ((pointC (progn (search-forward "C") (1- (point)))) + (preC (1- pointC)) + (pointX (progn (search-forward "X") (1- (point)))) + (aftC (+ 2 pointC)) + (ppsC (parse-partial-sexp (point-min) pointC)) + (pps-preC (parse-partial-sexp (point-min) preC)) + (pps-aftC (parse-partial-sexp (point-min) aftC)) + (ppsX (parse-partial-sexp (point-min) pointX))) + ;; C should be inside comment. + (should (= (nth 0 ppsC) 0)) + (should (eq (nth 4 ppsC) t)) + (should (= (nth 8 ppsC) (- pointC 2))) + ;; X should not be in comment or list. + (should (= (nth 0 ppsX) 0)) + (should-not (nth 4 ppsX)) + ;; Try using OLDSTATE. + (should (equal (parse-partial-sexp preC pointC nil nil pps-preC) + ppsC)) + (should (equal (parse-partial-sexp pointC aftC nil nil ppsC) + pps-aftC)) + (should (equal (parse-partial-sexp preC aftC nil nil pps-preC) + pps-aftC)) + (should (equal (parse-partial-sexp aftC pointX nil nil pps-aftC) + ppsX))))) + +(ert-deftest parse-partial-sexp-paren-comments () + "Test syntax parsing with paren comment markers. +Specifically, where the first character of the comment marker is +also has open paren syntax (see Bug#24870)." + (with-temp-buffer + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\{ "(}1nb" table) + (modify-syntax-entry ?\} "){4nb" table) + (modify-syntax-entry ?- ". 123" table) + (set-syntax-table table)) + (insert "{-C-}\nX") + (goto-char (point-min)) + (let* ((pointC (progn (search-forward "C") (1- (point)))) + (pointX (progn (search-forward "X") (1- (point)))) + (ppsC (parse-partial-sexp (point-min) pointC)) + (ppsX (parse-partial-sexp (point-min) pointX))) + ;; C should be inside nestable comment, not list. + (should (= (nth 0 ppsC) 0)) + (should (= (nth 4 ppsC) 1)) + (should (= (nth 8 ppsC) (- pointC 2))) + ;; X should not be in comment or list. + (should (= (nth 0 ppsX) 0)) + (should-not (nth 4 ppsX)) + ;; Try using OLDSTATE. + (should (equal (parse-partial-sexp pointC pointX nil nil ppsC) + ppsX))))) + +;;; syntax-tests.el ends here commit 0c31ff43b6880c84498fbe1f06e1e5809b55e838 Author: Alan Mackenzie Date: Mon Jan 23 19:00:49 2017 +0000 Give , and .@ doc strings. Fixes bug #24561. Also make *Help* links to ``' possible. Also make usable as such doc strings on the function-documentation property of a symbol. * lisp/emacs-lisp/backquote.el (top-level): Give , and '@ doc strings on the function-documentation property. Also give these symbols a reader-construct property. * lisp/help-fns.el (describe-function): Allow the function-documentation property to work. Use princ rather than prin1 to print the function's name when it has a reader-construct property. (help-fns-signature): Don't insert `high-usage' for a reader-construct. (describe-function-1): Adapt to process documentation on the function-documentation property. Print "a reader construct" when appropriate. * lisp/help-mode.el (help-xref-symbol-regexp): Amend this regexp also to match ``'. diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el index 94c561cba0..bb877dd2c9 100644 --- a/lisp/emacs-lisp/backquote.el +++ b/lisp/emacs-lisp/backquote.el @@ -247,4 +247,14 @@ LEVEL is only used internally and indicates the nesting level: tail)) (t (cons 'list heads))))) + +;; Give `,' and `,@' documentation strings which can be examined by C-h f. +(put '\, 'function-documentation + "See `\\=`' (also `pcase') for the usage of `,'.") +(put '\, 'reader-construct t) + +(put '\,@ 'function-documentation + "See `\\=`' for the usage of `,@'.") +(put '\,@ 'reader-construct t) + ;;; backquote.el ends here diff --git a/lisp/help-fns.el b/lisp/help-fns.el index fa16fa0bb6..edbcd9099d 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -115,13 +115,15 @@ When called from lisp, FUNCTION may also be a function object." (if fn (format "Describe function (default %s): " fn) "Describe function: ") - #'help--symbol-completion-table #'fboundp t nil nil + #'help--symbol-completion-table + (lambda (f) (or (fboundp f) (get f 'function-documentation))) + t nil nil (and fn (symbol-name fn))))) (unless (equal val "") (setq fn (intern val))) (unless (and fn (symbolp fn)) (user-error "You didn't specify a function symbol")) - (unless (fboundp fn) + (unless (or (fboundp fn) (get fn 'function-documentation)) (user-error "Symbol's function definition is void: %s" fn)) (list fn))) @@ -144,7 +146,9 @@ When called from lisp, FUNCTION may also be a function object." (save-excursion (with-help-window (help-buffer) - (prin1 function) + (if (get function 'reader-construct) + (princ function) + (prin1 function)) ;; Use " is " instead of a colon so that ;; it is easier to get out the function name using forward-sexp. (princ " is ") @@ -469,7 +473,8 @@ suitable file is found, return nil." (let ((fill-begin (point)) (high-usage (car high)) (high-doc (cdr high))) - (insert high-usage "\n") + (unless (get function 'reader-construct) + (insert high-usage "\n")) (fill-region fill-begin (point)) high-doc))))) @@ -565,18 +570,21 @@ FILE is the file where FUNCTION was probably defined." (or (and advised (advice--cd*r (advice--symbol-function function))) function)) - ;; Get the real definition. + ;; Get the real definition, if any. (def (if (symbolp real-function) - (or (symbol-function real-function) - (signal 'void-function (list real-function))) + (cond ((symbol-function real-function)) + ((get real-function 'function-documentation) + nil) + (t (signal 'void-function (list real-function)))) real-function)) - (aliased (or (symbolp def) - ;; Advised & aliased function. - (and advised (symbolp real-function) - (not (eq 'autoload (car-safe def)))) - (and (subrp def) - (not (string= (subr-name def) - (symbol-name function)))))) + (aliased (and def + (or (symbolp def) + ;; Advised & aliased function. + (and advised (symbolp real-function) + (not (eq 'autoload (car-safe def)))) + (and (subrp def) + (not (string= (subr-name def) + (symbol-name function))))))) (real-def (cond ((and aliased (not (subrp def))) (let ((f real-function)) @@ -605,6 +613,8 @@ FILE is the file where FUNCTION was probably defined." ;; Print what kind of function-like object FUNCTION is. (princ (cond ((or (stringp def) (vectorp def)) "a keyboard macro") + ((get function 'reader-construct) + "a reader construct") ;; Aliases are Lisp functions, so we need to check ;; aliases before functions. (aliased diff --git a/lisp/help-mode.el b/lisp/help-mode.el index a8d7294a5c..3fb793e7aa 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -328,7 +328,7 @@ Commands: "\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)" "[ \t\n]+\\)?" ;; Note starting with word-syntax character: - "['`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\)['’]")) + "['`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\|`\\)['’]")) "Regexp matching doc string references to symbols. The words preceding the quoted symbol can be used in doc strings to