diff options
Diffstat (limited to 'lisp/progmodes')
87 files changed, 4773 insertions, 2893 deletions
diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el index ab3ff3aa208..05d8038e87b 100644 --- a/lisp/progmodes/ada-mode.el +++ b/lisp/progmodes/ada-mode.el @@ -21,7 +21,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: ;; This mode is a major mode for editing Ada code. This is a major diff --git a/lisp/progmodes/ada-prj.el b/lisp/progmodes/ada-prj.el index f1b90875044..b86982a75c8 100644 --- a/lisp/progmodes/ada-prj.el +++ b/lisp/progmodes/ada-prj.el @@ -20,7 +20,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/ada-stmt.el b/lisp/progmodes/ada-stmt.el index 2b390688c2b..c8f70b0e4b9 100644 --- a/lisp/progmodes/ada-stmt.el +++ b/lisp/progmodes/ada-stmt.el @@ -23,7 +23,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: ;; This file is now automatically loaded from ada-mode.el, and creates a submenu diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el index 4e196505b6c..5f79afe01ac 100644 --- a/lisp/progmodes/ada-xref.el +++ b/lisp/progmodes/ada-xref.el @@ -22,7 +22,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index 2d09e431f29..82ae1816270 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -20,7 +20,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -619,7 +619,7 @@ COUNT starts with 1. GEN-SEP is used to separate long variable values." '((java-mode ("%sTokenTypes.java") ("%s.java")) (c++-mode ("%sTokenTypes.hpp") ("%s.cpp" "%s.hpp"))) "Language dependent formats which specify generated files. -Each element in this list looks looks like +Each element in this list looks like (MAJOR-MODE (VOCAB-FILE-FORMAT...) (CLASS-FILE-FORMAT...)). The element whose MAJOR-MODE is equal to `antlr-language' is used to diff --git a/lisp/progmodes/asm-mode.el b/lisp/progmodes/asm-mode.el index 2a1dad69877..f6e2d78f3a7 100644 --- a/lisp/progmodes/asm-mode.el +++ b/lisp/progmodes/asm-mode.el @@ -19,7 +19,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/autoconf.el b/lisp/progmodes/autoconf.el index 6d58faa6a66..6e591c1d657 100644 --- a/lisp/progmodes/autoconf.el +++ b/lisp/progmodes/autoconf.el @@ -18,7 +18,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el index 1dd2e3757ed..102c3186200 100644 --- a/lisp/progmodes/bat-mode.el +++ b/lisp/progmodes/bat-mode.el @@ -18,7 +18,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: ;; @@ -84,11 +84,11 @@ . 'bat-label-face) ("\\_<\\(defined\\|set\\)\\_>[ \t]*\\(\\(\\sw\\|\\s_\\)+\\)" (2 font-lock-variable-name-face)) - ("%\\(\\(\\sw\\|\\s_\\)+\\)%" + ("%\\([^%~ \n]+\\)%?" (1 font-lock-variable-name-face)) - ("!\\(\\(\\sw\\|\\s_\\)+\\)!" ; delayed-expansion !variable! + ("!\\([^!%~ \n]+\\)!?" ; delayed-expansion !variable! (1 font-lock-variable-name-face)) - ("%%\\(?:~[adfnpstxz]*\\(?:\\$\\(\\(?:\\sw\\|\\s_\\)+\\):\\)?\\)?\\([]!#$&-:?-[_-{}~]\\)" + ("%%\\(?:~[adfnpstxz]*\\(?:\\$\\(\\(?:\\sw\\|\\s_\\|_\\)+\\):\\)?\\)?\\([]!#$&-:?-[_-{}~]\\)" (1 font-lock-variable-name-face nil t) ; PATH expansion (2 font-lock-variable-name-face)) ; iteration variable or positional parameter ("[ =][-/]+\\(\\w+\\)" diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 210f0356084..7e004ce6a01 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -19,7 +19,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -44,7 +44,7 @@ map) "Keymap used by bug reference buttons.") -;; E.g., "http://gcc.gnu.org/PR%s" +;; E.g., "https://gcc.gnu.org/PR%s" (defvar bug-reference-url-format nil "Format used to turn a bug number into a URL. The bug number is supplied as a string, so this should have a single %s. @@ -73,10 +73,12 @@ so that it is considered safe, see `enable-local-variables'.") "Regular expression matching bug references. The second subexpression should match the bug reference (usually a number)." :type 'string - :safe 'stringp :version "24.3" ; previously defconst :group 'bug-reference) +;;;###autoload +(put 'bug-reference-bug-regexp 'safe-local-variable 'stringp) + (defun bug-reference-set-overlay-properties () "Set properties of bug reference overlays." (put 'bug-reference 'evaporate t) diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el index 0f7e4b598dc..4b326026b80 100644 --- a/lisp/progmodes/cc-align.el +++ b/lisp/progmodes/cc-align.el @@ -26,7 +26,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -159,7 +159,7 @@ Works with: topmost-intro-cont." (c-safe-position (or containing-sexp (point)) c-state-cache) containing-sexp)))) -(defun c-lineup-arglist (langelem) +(defun c-lineup-arglist (_langelem) "Line up the current argument line under the first argument. As a special case, if the indented line is inside a brace block @@ -265,7 +265,7 @@ Works with: arglist-cont, arglist-cont-nonempty." (c-forward-syntactic-ws)) (c-lineup-argcont-scan other-match))))) -(defun c-lineup-arglist-intro-after-paren (langelem) +(defun c-lineup-arglist-intro-after-paren (_langelem) "Line up a line to just after the open paren of the surrounding paren or brace block. @@ -483,7 +483,7 @@ Works with: func-decl-cont." (vector (+ (current-column) c-basic-offset))) c-basic-offset)))) -(defun c-indent-one-line-block (langelem) +(defun c-indent-one-line-block (_langelem) "Indent a one line block `c-basic-offset' extra. E.g.: @@ -506,7 +506,7 @@ Work with: Almost all syntactic symbols, but most useful on *-open." c-basic-offset nil)))) -(defun c-indent-multi-line-block (langelem) +(defun c-indent-multi-line-block (_langelem) "Indent a multi line block `c-basic-offset' extra. E.g.: @@ -642,7 +642,7 @@ Works with: The `c' syntactic symbol." (goto-char (c-langelem-pos langelem))))) (vector (current-column))))))) -(defun c-lineup-comment (langelem) +(defun c-lineup-comment (_langelem) "Line up a comment start according to `c-comment-only-line-offset'. If the comment is lined up with a comment starter on the previous line, that alignment is preserved. @@ -667,7 +667,7 @@ Works with: comment-intro." -1000)) ;jam it against the left side )))) -(defun c-lineup-knr-region-comment (langelem) +(defun c-lineup-knr-region-comment (_langelem) "Line up a comment in the \"K&R region\" with the declaration. That is the region between the function or class header and the beginning of the block. E.g.: @@ -836,7 +836,7 @@ arglist-cont-nonempty." (vector col)))))) -(defun c-lineup-string-cont (langelem) +(defun c-lineup-string-cont (_langelem) "Line up a continued string under the one it continues. A continued string in this sense is where a string literal follows directly after another one. E.g.: @@ -861,7 +861,7 @@ arglist-cont-nonempty." (goto-char pos) (vector (current-column))))))) -(defun c-lineup-template-args (langelem) +(defun c-lineup-template-args (_langelem) "Line up template argument lines under the first argument. To allow this function to be used in a list expression, nil is returned if there's no template argument on the first line. @@ -992,7 +992,7 @@ Works with: objc-method-args-cont." (+ curcol (- prev-col-column (current-column))) c-basic-offset))))) -(defun c-lineup-inexpr-block (langelem) +(defun c-lineup-inexpr-block (_langelem) "Line up the block for constructs that use a block inside an expression, e.g. anonymous classes in Java and lambda functions in Pike. The body is aligned with the start of the header, e.g. with the \"new\" or @@ -1020,7 +1020,7 @@ Works with: inlambda, inexpr-statement, inexpr-class." (goto-char (cdr res)) (vector (current-column)))))) -(defun c-lineup-whitesmith-in-block (langelem) +(defun c-lineup-whitesmith-in-block (_langelem) "Line up lines inside a block in Whitesmith style. It's done in a way that works both when the opening brace hangs and when it doesn't. E.g.: @@ -1084,7 +1084,7 @@ arglist-cont." (vector (+ (current-column) c-basic-offset)))) (vector 0))))) -(defun c-lineup-cpp-define (langelem) +(defun c-lineup-cpp-define (_langelem) "Line up macro continuation lines according to the indentation of the construct preceding the macro. E.g.: @@ -1231,9 +1231,9 @@ Works with: Any syntactic symbol which has an anchor position." (save-excursion (goto-char (c-langelem-pos langelem)) (vector (current-column)))) - -(defun c-lineup-dont-change (langelem) + +(defun c-lineup-dont-change (_langelem) "Do not change the indentation of the current line. Works with: Any syntactic symbol." @@ -1241,7 +1241,7 @@ Works with: Any syntactic symbol." (back-to-indentation) (vector (current-column)))) -(defun c-lineup-respect-col-0 (langelem) +(defun c-lineup-respect-col-0 (_langelem) "If the current line starts at column 0, return [0]. Otherwise return nil. This can be used for comments (in conjunction with, say, @@ -1254,7 +1254,7 @@ anchored there, but reindent other comments." nil))) -(defun c-snug-do-while (syntax pos) +(defun c-snug-do-while (syntax _pos) "Dynamically calculate brace hanginess for do-while statements. Using this function, `while' clauses that end a `do-while' block will remain on the same line as the brace that closes that block. @@ -1272,7 +1272,7 @@ ACTION associated with `block-close' syntax." '(before) '(before after))))) -(defun c-snug-1line-defun-close (syntax pos) +(defun c-snug-1line-defun-close (_syntax pos) "Determine the brace hanginess for an AWK defun-close. If the action/function being closed is a one-liner, keep it so. Otherwise put the closing brace on its own line." diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el index 736f1de2094..488b93eb574 100644 --- a/lisp/progmodes/cc-awk.el +++ b/lisp/progmodes/cc-awk.el @@ -21,7 +21,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -592,7 +592,7 @@ ;; starts at a `while' token. (not (c-get-char-property (c-point 'eol) 'c-awk-NL-prop))) -(defun c-awk-clear-NL-props (beg end) +(defun c-awk-clear-NL-props (beg _end) ;; This function is run from before-change-hooks. It clears the ;; c-awk-NL-prop text property from beg to the end of the buffer (The END ;; parameter is ignored). This ensures that the indentation engine will @@ -847,7 +847,7 @@ ;; Just beyond logical line following the region which is about to be changed. ;; Set in c-awk-record-region-clear-NL and used in c-awk-after-change. -(defun c-awk-record-region-clear-NL (beg end) +(defun c-awk-record-region-clear-NL (_beg end) ;; This function is called exclusively from the before-change-functions hook. ;; It does two things: Finds the end of the (logical) line on which END lies, ;; and clears c-awk-NL-prop text properties from this point onwards. BEG is diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el index e98b3dfa9df..d4bce32f175 100644 --- a/lisp/progmodes/cc-bytecomp.el +++ b/lisp/progmodes/cc-bytecomp.el @@ -21,7 +21,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -86,6 +86,7 @@ (defvar cc-bytecomp-environment-set nil) (defmacro cc-bytecomp-debug-msg (&rest args) + (ignore args) ;;`(message ,@args) ) @@ -252,7 +253,7 @@ perhaps a `cc-bytecomp-restore-environment' is forgotten somewhere")) (cc-bytecomp-debug-msg "cc-bytecomp-restore-environment: Done")))) -(defun cc-bytecomp-load (cc-part) +(defun cc-bytecomp-load (_cc-part) ;; A dummy function which will immediately be overwritten by the ;; following at load time. This should suppress the byte compiler ;; error that the function is "not known to be defined". diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index c05200b3898..471560e19d4 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -26,7 +26,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -51,6 +51,8 @@ ;; 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 @@ -1635,7 +1637,6 @@ defun." (c-save-buffer-state (beginning-of-defun-function end-of-defun-function - (start (point)) (paren-state (c-parse-state)) (orig-point-min (point-min)) (orig-point-max (point-max)) lim ; Position of { which has been widened to. @@ -1759,7 +1760,6 @@ the open-parenthesis that starts a defun; see `beginning-of-defun'." (c-save-buffer-state (beginning-of-defun-function end-of-defun-function - (start (point)) (paren-state (c-parse-state)) (orig-point-min (point-min)) (orig-point-max (point-max)) lim @@ -1821,7 +1821,6 @@ the open-parenthesis that starts a defun; see `beginning-of-defun'." "Return the name of the current defun, or NIL if there isn't one. \"Defun\" here means a function, or other top level construct with a brace block." - (interactive) (c-save-buffer-state (beginning-of-defun-function end-of-defun-function where pos name-end case-fold-search) @@ -1843,19 +1842,33 @@ with a brace block." (unless (eq where 'at-header) (c-backward-to-nth-BOF-{ 1 where) (c-beginning-of-decl-1)) + (when (looking-at c-typedef-key) + (goto-char (match-end 0)) + (c-forward-syntactic-ws)) ;; Pick out the defun name, according to the type of defun. (cond ;; struct, union, enum, or similar: - ((and (looking-at c-type-prefix-key) - (progn (c-forward-token-2 2) ; over "struct foo " - (or (eq (char-after) ?\{) - (looking-at c-symbol-key)))) ; "struct foo bar ..." - (save-match-data (c-forward-token-2)) - (when (eq (char-after) ?\{) - (c-backward-token-2) - (looking-at c-symbol-key)) - (match-string-no-properties 0)) + ((save-excursion + (and + (looking-at c-type-prefix-key) + (consp (c-forward-decl-or-cast-1 (c-point 'bosws) 'top nil)) + (or (not (or (eq (char-after) ?{) + (and c-recognize-knr-p + (c-in-knr-argdecl)))) + (progn (c-backward-syntactic-ws) + (not (eq (char-before) ?\))))))) + (let ((key-pos (point))) + (c-forward-over-token-and-ws) ; over "struct ". + (cond + ((looking-at c-symbol-key) ; "struct foo { ..." + (buffer-substring-no-properties key-pos (match-end 0))) + ((eq (char-after) ?{) ; "struct { ... } foo" + (when (c-go-list-forward) + (c-forward-syntactic-ws) + (when (looking-at c-symbol-key) ; a bit bogus - there might + ; be several identifiers. + (match-string-no-properties 0))))))) ((looking-at "DEFUN\\s-*(") ;"DEFUN\\_>") think of XEmacs! ;; DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory, ...) ==> Ffile_name_directory @@ -1892,15 +1905,24 @@ with a brace block." (t ;; Normal function or initializer. - (when (c-syntactic-re-search-forward "[{(]" nil t) - (backward-char) + (when + (and + (consp (c-forward-decl-or-cast-1 (c-point 'bosws) 'top nil)) + (or (eq (char-after) ?{) + (and c-recognize-knr-p + (c-in-knr-argdecl))) + (progn + (c-backward-syntactic-ws) + (eq (char-before) ?\))) + (c-go-list-backward)) (c-backward-syntactic-ws) (when (eq (char-before) ?\=) ; struct foo bar = {0, 0} ; (c-backward-token-2) (c-backward-syntactic-ws)) (setq name-end (point)) (c-back-over-compound-identifier) - (buffer-substring-no-properties (point) name-end))))))))) + (and (looking-at c-symbol-start) + (buffer-substring-no-properties (point) name-end)))))))))) (defun c-declaration-limits (near) ;; Return a cons of the beginning and end positions of the current @@ -1915,7 +1937,7 @@ with a brace block." (save-restriction (let ((start (point)) (paren-state (c-parse-state)) - lim pos end-pos encl-decl-block where) + lim pos end-pos where) ;; Narrow enclosing brace blocks out, as required by the values of ;; `c-defun-tactic', `near', and the position of point. (when (eq c-defun-tactic 'go-outward) @@ -2041,6 +2063,23 @@ with a brace block." (eq (char-after) ?\{) (cons (point-min) (point-max)))))))) +(defun c-display-defun-name (&optional arg) + "Display the name of the current CC mode defun and the position in it. +With a prefix arg, push the name onto the kill ring too." + (interactive "P") + (save-restriction + (widen) + (c-save-buffer-state ((name (c-defun-name)) + (limits (c-declaration-limits t)) + (point-bol (c-point 'bol))) + (when name + (message "%s. Line %s/%s." name + (1+ (count-lines (car limits) point-bol)) + (count-lines (car limits) (cdr limits))) + (if arg (kill-new name)) + (sit-for 3 t))))) +(put 'c-display-defun-name 'isearch-scroll t) + (defun c-mark-function () "Put mark at end of the current top-level declaration or macro, point at beginning. If point is not inside any then the closest following one is @@ -2085,7 +2124,6 @@ function does not require the declaration to contain a brace block." (defun c-cpp-define-name () "Return the name of the current CPP macro, or NIL if we're not in one." - (interactive) (let (case-fold-search) (save-excursion (and c-opt-cpp-macro-define-start diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index dd8f8afc6a3..bff1c9eb65d 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -26,7 +26,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -44,19 +44,12 @@ (load "cc-bytecomp" nil t))) (eval-and-compile - (defvar c--mapcan-status - (cond ((and (fboundp 'mapcan) - (subrp (symbol-function 'mapcan))) - ;; XEmacs - 'mapcan) - ((locate-file "cl-lib.elc" load-path) - ;; Emacs >= 24.3 - 'cl-mapcan) - (t - ;; Emacs <= 24.2 - nil)))) - -(cc-external-require (if (eq c--mapcan-status 'cl-mapcan) 'cl-lib 'cl)) + (defvar c--cl-library + (if (locate-library "cl-lib") + 'cl-lib + 'cl))) + +(cc-external-require c--cl-library) ; was (cc-external-require 'cl). ACM 2005/11/29. ; Changed from (eval-when-compile (require 'cl)) back to ; cc-external-require, 2015-08-12. @@ -182,9 +175,12 @@ This variant works around bugs in `eval-when-compile' in various ;; The motivation for this macro is to avoid the irritating message ;; "function `mapcan' from cl package called at runtime" produced by Emacs. (cond - ((eq c--mapcan-status 'mapcan) + ((and (fboundp 'mapcan) + (subrp (symbol-function 'mapcan))) + ;; XEmacs and Emacs >= 26. `(mapcan ,fun ,liszt)) - ((eq c--mapcan-status 'cl-mapcan) + ((eq c--cl-library 'cl-lib) + ;; Emacs >= 24.3, < 26. `(cl-mapcan ,fun ,liszt)) (t ;; Emacs <= 24.2. It would be nice to be able to distinguish between @@ -193,13 +189,13 @@ 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. - (if (eq c--mapcan-status 'cl-mapcan) + (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. - (if (eq c--mapcan-status 'cl-mapcan) + (if (eq c--cl-library 'cl-lib) `(cl-intersection ,liszt1 ,liszt2 ,@other-args) `(intersection ,liszt1 ,liszt2 ,@other-args))) @@ -212,7 +208,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. - (if (eq c--mapcan-status 'cl-mapcan) + (if (eq c--cl-library 'cl-lib) `(cl-delete-duplicates ,cl-seq ,@cl-keys) `(delete-duplicates ,cl-seq ,@cl-keys)))) @@ -371,6 +367,8 @@ to it is returned. This function does not modify the point or the mark." (t (error "Unknown buffer position requested: %s" position)))) (point)))) +(defvar lookup-syntax-properties) ;XEmacs. + (eval-and-compile ;; Constant to decide at compilation time whether to use category ;; properties. Currently (2010-03) they're available only on GNU Emacs. @@ -419,6 +417,17 @@ to it is returned. This function does not modify the point or the mark." ;; Emacs. `(setq mark-active ,activate))) +(defmacro c-set-keymap-parent (map parent) + (cond + ;; XEmacs + ((cc-bytecomp-fboundp 'set-keymap-parents) + `(set-keymap-parents ,map ,parent)) + ;; Emacs + ((cc-bytecomp-fboundp 'set-keymap-parent) + `(set-keymap-parent ,map ,parent)) + ;; incompatible + (t (error "CC Mode is incompatible with this version of Emacs")))) + (defmacro c-delete-and-extract-region (start end) "Delete the text between START and END and return it." (if (cc-bytecomp-fboundp 'delete-and-extract-region) @@ -1175,6 +1184,86 @@ been put there by c-put-char-property. POINT remains unchanged." nil ,from ,to ,value nil -property-)) ;; GNU Emacs `(c-clear-char-property-with-value-function ,from ,to ,property ,value))) + +(defmacro c-search-forward-char-property-with-value-on-char + (property value char &optional limit) + "Search forward for a text-property PROPERTY having value VALUE on a +character with value CHAR. +LIMIT bounds the search. The value comparison is done with `equal'. +PROPERTY must be a constant. + +Leave point just after the character, and set the match data on +this character, and return point. If the search fails, return +nil; point is then left undefined." + `(let ((char-skip (concat "^" (char-to-string ,char))) + (-limit- ,limit) + (-value- ,value)) + (while + (and + (progn (skip-chars-forward char-skip -limit-) + (< (point) -limit-)) + (not (equal (c-get-char-property (point) ,property) -value-))) + (forward-char)) + (when (< (point) -limit-) + (search-forward-regexp ".") ; to set the match-data. + (point)))) + +(defun c-clear-char-property-with-value-on-char-function (from to property + value char) + "Remove all text-properties PROPERTY with value VALUE on +characters with value CHAR from the region [FROM, TO), as tested +by `equal'. These properties are assumed to be over individual +characters, having been put there by c-put-char-property. POINT +remains unchanged." + (let ((place from) + ) + (while ; loop round occurrences of (PROPERTY VALUE) + (progn + (while ; loop round changes in PROPERTY till we find VALUE + (and + (< place to) + (not (equal (get-text-property place property) value))) + (setq place (c-next-single-property-change place property nil to))) + (< place to)) + (if (eq (char-after place) char) + (remove-text-properties place (1+ place) (cons property nil))) + ;; Do we have to do anything with stickiness here? + (setq place (1+ place))))) + +(defmacro c-clear-char-property-with-value-on-char (from to property value char) + "Remove all text-properties PROPERTY with value VALUE on +characters with value CHAR from the region [FROM, TO), as tested +by `equal'. These properties are assumed to be over individual +characters, having been put there by c-put-char-property. POINT +remains unchanged." + (if c-use-extents + ;; XEmacs + `(let ((-property- ,property) + (-char- ,char)) + (map-extents (lambda (ext val) + (if (and (equal (extent-property ext -property-) val) + (eq (char-after + (extent-start-position ext)) + -char-)) + (delete-extent ext))) + nil ,from ,to ,value nil -property-)) + ;; Gnu Emacs + `(c-clear-char-property-with-value-on-char-function ,from ,to ,property + ,value ,char))) + +(defmacro c-put-char-properties-on-char (from to property value char) + ;; This needs to be a macro because `property' passed to + ;; `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)." + `(let ((skip-string (concat "^" (list ,char))) + (-to- ,to)) + (save-excursion + (goto-char ,from) + (while (progn (skip-chars-forward skip-string -to-) + (< (point) -to-)) + (c-put-char-property (point) ,property ,value) + (forward-char))))) ;; Macros to put overlays (Emacs) or extents (XEmacs) on buffer text. ;; For our purposes, these are characterized by being possible to @@ -1211,6 +1300,7 @@ been put there by c-put-char-property. POINT remains unchanged." (def-edebug-spec cc-eval-when-compile (&rest def-form)) (def-edebug-spec c-point 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-save-buffer-state let*) (def-edebug-spec c-tentative-buffer-changes t) @@ -1232,6 +1322,8 @@ been put there by c-put-char-property. POINT remains unchanged." (def-edebug-spec c-put-char-property t) (def-edebug-spec c-get-char-property t) (def-edebug-spec c-clear-char-property 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-put-overlay t) (def-edebug-spec c-delete-overlay t) @@ -1777,8 +1869,6 @@ non-nil, a caret is prepended to invert the set." (cc-bytecomp-defvar open-paren-in-column-0-is-defun-start) -(defvar lookup-syntax-properties) ;XEmacs. - (defconst c-emacs-features (let (list) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index aa84ade083c..ab0204cb961 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -26,7 +26,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -132,7 +132,7 @@ ;; ;; 'c-not-decl ;; Put on the brace which introduces a brace list and on the commas -;; which separate the element within it. +;; which separate the elements within it. ;; ;; 'c-awk-NL-prop ;; Used in AWK mode to mark the various kinds of newlines. See @@ -241,14 +241,14 @@ ;; Either nil, or the last character of the macro currently represented by ;; `c-macro-cache' which isn't in a comment. */ -(defun c-invalidate-macro-cache (beg end) +(defun c-invalidate-macro-cache (beg _end) ;; Called from a before-change function. If the change region is before or ;; in the macro characterized by `c-macro-cache' etc., nullify it ;; appropriately. BEG and END are the standard before-change-functions ;; parameters. END isn't used. (cond ((null c-macro-cache)) - ((< beg (car c-macro-cache)) + ((<= beg (car c-macro-cache)) (setq c-macro-cache nil c-macro-cache-start-pos nil c-macro-cache-syntactic nil @@ -834,7 +834,7 @@ comment at the start of cc-engine.el for more info." (c-stmt-delim-chars (if comma-delim c-stmt-delim-chars-with-comma c-stmt-delim-chars)) - c-in-literal-cache c-maybe-labelp after-case:-pos saved + c-maybe-labelp after-case:-pos saved ;; Current position. pos ;; Position of last stmt boundary character (e.g. ;). @@ -1680,6 +1680,7 @@ comment at the start of cc-engine.el for more info." ; (not (eobp))))))) (defmacro c-debug-sws-msg (&rest args) + (ignore args) ;;`(message ,@args) ) @@ -1719,7 +1720,7 @@ comment at the start of cc-engine.el for more info." `((c-debug-remove-face beg end 'c-debug-is-sws-face) (c-debug-remove-face beg end 'c-debug-in-sws-face))))) -;; The type of literal position `end' is in in a `before-change-functions' +;; The type of literal position `end' is in a `before-change-functions' ;; function - one of `c', `c++', `pound', or nil (but NOT `string'). (defvar c-sws-lit-type nil) ;; A cons (START . STOP) of the bounds of the comment or CPP construct @@ -1979,17 +1980,10 @@ comment at the start of cc-engine.el for more info." (end-of-line)) (setq macro-end (point)) ;; Check for an open block comment at the end of the macro. - (goto-char macro-start) - (let (s in-block-comment) - (while - (progn - (setq s (parse-partial-sexp (point) macro-end - nil nil s 'syntax-table)) - (< (point) macro-end)) - (setq in-block-comment - (and (elt s 4) ; in a comment - (null (elt s 7))))) ; a block comment - (if in-block-comment (setq safe-start nil))) + (let ((s (parse-partial-sexp macro-start macro-end))) + (if (and (elt s 4) ; in a comment + (null (elt s 7))) ; a block comment + (setq safe-start nil))) (forward-line 1) ;; Don't cache at eob in case the buffer is narrowed. (not (eobp))) @@ -2790,7 +2784,7 @@ comment at the start of cc-engine.el for more info." (setq pos npos) (setq c-state-nonlit-pos-cache (cons pos c-state-nonlit-pos-cache))) - ;; Add one extra element above HERE so as to to avoid the previous + ;; Add one extra element above HERE so as to avoid the previous ;; expensive calculation when the next call is close to the current ;; one. This is especially useful when inside a large macro. (when npos @@ -3307,7 +3301,6 @@ comment at the start of cc-engine.el for more info." paren+1s ; A list of `paren+1's; used to determine a ; good-pos. bra+1 ; just after L bra-ce. - bra+1s ; list of OLD values of bra+1. mstart) ; start of a macro. (save-excursion @@ -3345,7 +3338,7 @@ comment at the start of cc-engine.el for more info." ;; Insert the opening brace/bracket/paren position. (setq c-state-cache (cons (1- pa+1) c-state-cache)) ;; Clear admin stuff for the next more nested part of the scan. - (setq ren+1 pa+1 pa+1 nil bra+1 nil bra+1s nil) + (setq ren+1 pa+1 pa+1 nil bra+1 nil) t) ; Carry on the loop ;; All open p/b/b's at this nesting level, if any, have probably @@ -3429,7 +3422,7 @@ comment at the start of cc-engine.el for more info." upper-lim ; ,beyond which `c-state-cache' entries are removed scan-back-pos cons-separated - pair-beg pps-point-state target-depth) + pair-beg target-depth) ;; Remove entries beyond HERE. Also remove any entries inside ;; a macro, unless HERE is in the same macro. @@ -3485,9 +3478,6 @@ comment at the start of cc-engine.el for more info." target-depth nil pps-state)) - (if (= (point) pps-point) - (setq pps-point-state pps-state)) - (when (eq (car pps-state) target-depth) (setq pos (point)) ; POS is now just after an R-paren/brace. (cond @@ -3732,11 +3722,10 @@ comment at the start of cc-engine.el for more info." ;; brace pair. (let ((here-bol (c-point 'bol here)) too-high-pa ; recorded {/(/[ next above or just below here, or nil. - dropped-cons ; was the last removed element a brace pair? - pa) + dropped-cons) ; was the last removed element a brace pair? ;; The easy bit - knock over-the-top bits off `c-state-cache'. (while (and c-state-cache - (>= (setq pa (c-state-cache-top-paren)) here)) + (>= (c-state-cache-top-paren) here)) (setq dropped-cons (consp (car c-state-cache)) too-high-pa (c-state-cache-top-lparen) c-state-cache (cdr c-state-cache))) @@ -4308,6 +4297,47 @@ comment at the start of cc-engine.el for more info." "\\w\\|\\s_\\|\\s\"\\|\\s|" "\\w\\|\\s_\\|\\s\"")) +(defun c-forward-over-token-and-ws (&optional balanced) + "Move forward over a token and any following whitespace +Return t if we moved, nil otherwise (i.e. we were at EOB, or a +non-token or BALANCED is non-nil and we can't move). If we +are at syntactic whitespace, move over this in place of a token. + +If BALANCED is non-nil move over any balanced parens we are at, and never move +out of an enclosing paren. + +This function differs from `c-forward-token-2' in that it will move forward +over the final token in a buffer, up to EOB." + (let ((jump-syntax (if balanced + c-jump-syntax-balanced + c-jump-syntax-unbalanced)) + (here (point))) + (when + (condition-case nil + (cond + ((/= (point) + (progn (c-forward-syntactic-ws) (point))) + ;; If we're at whitespace, count this as the token. + t) + ((eobp) nil) + ((looking-at jump-syntax) + (goto-char (scan-sexps (point) 1)) + t) + ((looking-at c-nonsymbol-token-regexp) + (goto-char (match-end 0)) + t) + ((save-restriction + (widen) + (looking-at c-nonsymbol-token-regexp)) + nil) + (t + (forward-char) + t)) + (error (goto-char here) + nil)) + (c-forward-syntactic-ws) + t))) + (defun c-forward-token-2 (&optional count balanced limit) "Move forward by tokens. A token is defined as all symbols and identifiers which aren't @@ -4337,15 +4367,11 @@ comment at the start of cc-engine.el for more info." (if (< count 0) (- (c-backward-token-2 (- count) balanced limit)) - (let ((jump-syntax (if balanced - c-jump-syntax-balanced - c-jump-syntax-unbalanced)) - (last (point)) - (prev (point))) - - (if (zerop count) - ;; If count is zero we should jump if in the middle of a token. - (c-end-of-current-token)) + (let ((here (point)) + (last (point))) + (when (zerop count) + ;; If count is zero we should jump if in the middle of a token. + (c-end-of-current-token)) (save-restriction (if limit (narrow-to-region (point-min) limit)) @@ -4359,43 +4385,15 @@ comment at the start of cc-engine.el for more info." ;; Moved out of bounds. Make sure the returned count isn't zero. (progn (if (zerop count) (setq count 1)) - (goto-char last)) - - ;; Use `condition-case' to avoid having the limit tests - ;; inside the loop. - (condition-case nil - (while (and - (> count 0) - (progn - (setq last (point)) - (cond ((looking-at jump-syntax) - (goto-char (scan-sexps (point) 1)) - t) - ((looking-at c-nonsymbol-token-regexp) - (goto-char (match-end 0)) - t) - ;; `c-nonsymbol-token-regexp' above should always - ;; match if there are correct tokens. Try to - ;; widen to see if the limit was set in the - ;; middle of one, else fall back to treating - ;; the offending thing as a one character token. - ((and limit - (save-restriction - (widen) - (looking-at c-nonsymbol-token-regexp))) - nil) - (t - (forward-char) - t)))) - (c-forward-syntactic-ws) - (setq prev last - count (1- count))) - (error (goto-char last))) - - (when (eobp) - (goto-char prev) - (setq count (1+ count))))) - + (goto-char here)) + (while (and + (> count 0) + (c-forward-over-token-and-ws balanced) + (not (eobp))) + (setq last (point) + count (1- count))) + (if (eobp) + (goto-char last)))) count))) (defun c-backward-token-2 (&optional count balanced limit) @@ -4809,7 +4807,6 @@ comment at the start of cc-engine.el for more info." (c-self-bind-state-cache (let ((start (point)) - state-2 ;; A list of syntactically relevant positions in descending ;; order. It's used to avoid scanning repeatedly over ;; potentially large regions with `parse-partial-sexp' to verify @@ -5028,7 +5025,7 @@ comment at the start of cc-engine.el for more info." ;; Tools for handling comments and string literals. -(defun c-in-literal (&optional lim detect-cpp) +(defun c-in-literal (&optional _lim detect-cpp) "Return the type of literal point is in, if any. The return value is `c' if in a C-style comment, `c++' if in a C++ style comment, `string' if in a string literal, `pound' if DETECT-CPP @@ -5036,9 +5033,6 @@ is non-nil and in a preprocessor line, or nil if somewhere else. Optional LIM is used as the backward limit of the search. If omitted, or nil, `c-beginning-of-defun' is used. -The last point calculated is cached if the cache is enabled, i.e. if -`c-in-literal-cache' is bound to a two element vector. - Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." (save-restriction @@ -5195,16 +5189,25 @@ comment at the start of cc-engine.el for more info." ;; Get a "safe place" approximately TRY-SIZE characters before START. ;; This defsubst doesn't preserve point. (let* ((pos (max (- start try-size) (point-min))) - (s (c-state-semi-pp-to-literal pos))) - (or (car (cddr s)) pos))) + (s (c-state-semi-pp-to-literal pos)) + (cand (or (car (cddr s)) pos))) + (if (>= cand (point-min)) + cand + (parse-partial-sexp pos start nil nil (car s) 'syntax-table) + (point)))) (defun c-determine-limit (how-far-back &optional start try-size) - ;; Return a buffer position HOW-FAR-BACK non-literal characters from START - ;; (default point). This is done by going back further in the buffer then - ;; searching forward for literals. The position found won't be in a - ;; literal. We start searching for the sought position TRY-SIZE (default - ;; twice HOW-FAR-BACK) bytes back from START. This function must be fast. - ;; :-) + ;; Return a buffer position HOW-FAR-BACK non-literal characters from + ;; START (default point). The starting position, either point or + ;; START may not be in a comment or string. + ;; + ;; The position found will not be before POINT-MIN and won't be in a + ;; literal. + ;; + ;; We start searching for the sought position TRY-SIZE (default + ;; twice HOW-FAR-BACK) bytes back from START. + ;; + ;; This function must be fast. :-) (save-excursion (let* ((start (or start (point))) (try-size (or try-size (* 2 how-far-back))) @@ -5260,6 +5263,8 @@ comment at the start of cc-engine.el for more info." (+ (car elt) (- count how-far-back))) ((eq base (point-min)) (point-min)) + ((> base (- start try-size)) ; Can only happen if we hit point-min. + (car elt)) (t (c-determine-limit (- how-far-back count) base try-size)))))) @@ -5418,15 +5423,14 @@ comment at the start of cc-engine.el for more info." (min c-bs-cache-limit pos))) (defun c-update-brace-stack (stack from to) - ;; Give a brace-stack which has the value STACK at position FROM, update it - ;; to it's value at position TO, where TO is after (or equal to) FROM. + ;; Given a brace-stack which has the value STACK at position FROM, update it + ;; to its value at position TO, where TO is after (or equal to) FROM. ;; Return a cons of either TO (if it is outside a literal) and this new ;; value, or of the next position after TO outside a literal and the new ;; value. (let (match kwd-sym (prev-match-pos 1) (s (cdr stack)) - (bound-<> (car stack)) - ) + (bound-<> (car stack))) (save-excursion (cond ((and bound-<> (<= to bound-<>)) @@ -5487,6 +5491,9 @@ comment at the start of cc-engine.el for more info." (setq s (cdr s)))) ((c-keyword-member kwd-sym 'c-flat-decl-block-kwds) (push 0 s)))) + ;; The failing `c-syntactic-re-search-forward' may have left us in the + ;; middle of a token, which might be a significant token. Fix this! + (c-beginning-of-current-token) (cons (point) (cons bound-<> s))))) @@ -5662,11 +5669,13 @@ comment at the start of cc-engine.el for more info." ;; Call CFD-FUN for each possible spot for a declaration, cast or ;; label from the point to CFD-LIMIT. ;; - ;; CFD-FUN is called with point at the start of the spot. It's passed two + ;; CFD-FUN is called with point at the start of the spot. It's passed three ;; arguments: The first is the end position of the token preceding the spot, ;; or 0 for the implicit match at bob. The second is a flag that is t when - ;; the match is inside a macro. Point should be moved forward by at least - ;; one token. + ;; the match is inside a macro. The third is a flag that is t when the + ;; match is at "top level", i.e. outside any brace block, or directly inside + ;; a class or namespace, etc. Point should be moved forward by at least one + ;; token. ;; ;; If CFD-FUN adds `c-decl-end' properties somewhere below the current spot, ;; it should return non-nil to ensure that the next search will find them. @@ -6053,6 +6062,8 @@ comment at the start of cc-engine.el for more info." (setq cfd-macro-end 0) nil)))) ; end of when condition + (when (> cfd-macro-end 0) + (setq cfd-top-level nil)) ; In a macro is "never" at top level. (c-debug-put-decl-spot-faces cfd-match-pos (point)) (if (funcall cfd-fun cfd-match-pos (/= cfd-macro-end 0) cfd-top-level) (setq cfd-prop-match nil)) @@ -6097,7 +6108,8 @@ comment at the start of cc-engine.el for more info." (defsubst c-clear-found-types () ;; Clears `c-found-types'. - (setq c-found-types (make-vector 53 0))) + (setq c-found-types + (make-hash-table :test #'equal :weakness nil))) (defun c-add-type (from to) ;; Add the given region as a type in `c-found-types'. If the region @@ -6111,36 +6123,34 @@ comment at the start of cc-engine.el for more info." ;; ;; This function might do hidden buffer changes. (let ((type (c-syntactic-content from to c-recognize-<>-arglists))) - (unless (intern-soft type c-found-types) - (unintern (substring type 0 -1) c-found-types) - (intern type c-found-types)))) + (unless (gethash type c-found-types) + (remhash (substring type 0 -1) c-found-types) + (puthash type t c-found-types)))) (defun c-unfind-type (name) ;; Remove the "NAME" from c-found-types, if present. - (unintern name c-found-types)) + (remhash name c-found-types)) (defsubst c-check-type (from to) ;; Return non-nil if the given region contains a type in ;; `c-found-types'. ;; ;; This function might do hidden buffer changes. - (intern-soft (c-syntactic-content from to c-recognize-<>-arglists) - c-found-types)) + (gethash (c-syntactic-content from to c-recognize-<>-arglists) c-found-types)) (defun c-list-found-types () ;; Return all the types in `c-found-types' as a sorted list of ;; strings. (let (type-list) - (mapatoms (lambda (type) - (setq type-list (cons (symbol-name type) - type-list))) + (maphash (lambda (type _) + (setq type-list (cons type type-list))) c-found-types) (sort type-list 'string-lessp))) ;; Shut up the byte compiler. (defvar c-maybe-stale-found-type) -(defun c-trim-found-types (beg end old-len) +(defun c-trim-found-types (beg end _old-len) ;; An after change function which, in conjunction with the info in ;; c-maybe-stale-found-type (set in c-before-change), removes a type ;; from `c-found-types', should this type have become stale. For @@ -6410,6 +6420,9 @@ comment at the start of cc-engine.el for more info." (c-clear-<>-pair-props) (forward-char))))))) +(defvar c-restricted-<>-arglists) ;FIXME: Move definition here? +(defvar c-parse-and-markup-<>-arglists) ;FIXME: Move definition here? + (defun c-restore-<>-properties (_beg _end _old-len) ;; This function is called as an after-change function. It restores the ;; category/syntax-table properties on template/generic <..> pairs between @@ -6431,7 +6444,8 @@ comment at the start of cc-engine.el for more info." (not (eq (c-get-char-property (point) 'c-type) 'c-decl-arg-start))))))) (or (c-forward-<>-arglist nil) - (forward-char))))) + (c-forward-over-token-and-ws) + (goto-char c-new-END))))) ;; Functions to handle C++ raw strings. @@ -6716,7 +6730,7 @@ comment at the start of cc-engine.el for more info." (c-put-char-property open-paren 'syntax-table '(1))) (goto-char bound)))) -(defun c-after-change-re-mark-raw-strings (beg end old-len) +(defun c-after-change-re-mark-raw-strings (_beg _end _old-len) ;; This function applies `syntax-table' text properties to C++ raw strings ;; beginning in the region (c-new-BEG c-new-END). BEG, END, and OLD-LEN are ;; the standard arguments supplied to any after-change function. @@ -6937,7 +6951,7 @@ comment at the start of cc-engine.el for more info." ;; recognized are those specified by `c-type-list-kwds', ;; `c-ref-list-kwds', `c-colon-type-list-kwds', ;; `c-paren-nontype-kwds', `c-paren-type-kwds', `c-<>-type-kwds', - ;; and `c-<>-arglist-kwds'. + ;; `c-<>-arglist-kwds', and `c-protection-kwds'. ;; ;; This function records identifier ranges on ;; `c-record-type-identifiers' and `c-record-ref-identifiers' if @@ -7007,6 +7021,17 @@ comment at the start of cc-engine.el for more info." (not (looking-at c-symbol-start)) (c-safe (c-forward-sexp) t)) (c-forward-syntactic-ws) + (setq safe-pos (point))) + + ((and (c-keyword-member kwd-sym 'c-protection-kwds) + (or (null c-post-protection-token) + (and (looking-at c-post-protection-token) + (save-excursion + (goto-char (match-end 0)) + (not (c-end-of-current-token)))))) + (if c-post-protection-token + (goto-char (match-end 0))) + (c-forward-syntactic-ws) (setq safe-pos (point)))) (when (c-keyword-member kwd-sym 'c-colon-type-list-kwds) @@ -7064,6 +7089,7 @@ comment at the start of cc-engine.el for more info." ;; This function might do hidden buffer changes. (let ((start (point)) + (old-found-types (copy-hash-table c-found-types)) ;; If `c-record-type-identifiers' is set then activate ;; recording of any found types that constitute an argument in ;; the arglist. @@ -7079,6 +7105,7 @@ comment at the start of cc-engine.el for more info." (nconc c-record-found-types c-record-type-identifiers))) t) + (setq c-found-types old-found-types) (goto-char start) nil))) @@ -7136,7 +7163,7 @@ comment at the start of cc-engine.el for more info." (let ((c-promote-possible-types t) (c-record-found-types t)) (c-forward-type)) - (c-forward-token-2)))) + (c-forward-over-token-and-ws)))) (c-forward-syntactic-ws) @@ -7398,7 +7425,12 @@ comment at the start of cc-engine.el for more info." (setq pos (point) res subres)))) - ((looking-at c-identifier-start) + ((and (looking-at c-identifier-start) + (or (not (looking-at + c-ambiguous-overloadable-or-identifier-prefix-re)) + (save-excursion + (and (eq (c-forward-token-2) 0) + (not (eq (char-after) ?\()))))) ;; Got a cast operator. (when (c-forward-type) (setq pos (point) @@ -7809,8 +7841,7 @@ comment at the start of cc-engine.el for more info." ;; looking (in C++) like this "FQN::of::base::Class". Move to the start of ;; this construct and return t. If the parsing fails, return nil, leaving ;; point unchanged. - (let ((here (point)) - end) + (let (end) (if (not (c-on-identifier)) nil (c-simple-skip-symbol-backward) @@ -8092,12 +8123,14 @@ comment at the start of cc-engine.el for more info." ;; initializing brace lists. (let (found) (while - (and (progn + (and (< (point) limit) + (progn ;; In the next loop, we keep searching forward whilst ;; we find ":"s which aren't single colons inside C++ ;; "for" statements. (while (and + (< (point) limit) (setq found (c-syntactic-re-search-forward "[;:,]\\|\\s)\\|\\(=\\|\\s(\\)" @@ -8119,7 +8152,7 @@ comment at the start of cc-engine.el for more info." (c-go-up-list-forward)) (setq brackets-after-id t)) (when found (backward-char)) - t)) + (<= (point) limit))) (list id-start id-end brackets-after-id (match-beginning 1) decorated) (goto-char here) @@ -8241,10 +8274,6 @@ comment at the start of cc-engine.el for more info." ;; If `backup-at-type' is nil then the other variables have ;; undefined values. backup-at-type backup-type-start backup-id-start - ;; This stores `kwd-sym' of the symbol before the current one. - ;; This is needed to distinguish the C++11 version of "auto" from - ;; the pre C++11 meaning. - backup-kwd-sym ;; Set if we've found a specifier (apart from "typedef") that makes ;; the defined identifier(s) types. at-type-decl @@ -8352,7 +8381,6 @@ comment at the start of cc-engine.el for more info." (setq backup-at-type at-type backup-type-start type-start backup-id-start id-start - backup-kwd-sym kwd-sym at-type found-type type-start start id-start (point) @@ -8576,7 +8604,13 @@ comment at the start of cc-engine.el for more info." (looking-at c-noise-macro-with-parens-name-re)) (c-forward-noise-clause)) - ((looking-at c-type-decl-suffix-key) + ((and (looking-at c-type-decl-suffix-key) + ;; We avoid recognizing foo(bar) or foo() at top level as a + ;; construct here in C, since we want to recognize this as a + ;; typeless function declaration. + (not (and (c-major-mode-is 'c-mode) + (eq context 'top) + (eq (char-after) ?\))))) (if (eq (char-after) ?\)) (when (> paren-depth 0) (setq paren-depth (1- paren-depth)) @@ -8619,7 +8653,12 @@ comment at the start of cc-engine.el for more info." (save-excursion (goto-char after-paren-pos) (c-forward-syntactic-ws) - (c-forward-type))))) + (or (c-forward-type) + ;; Recognize a top-level typeless + ;; function declaration in C. + (and (c-major-mode-is 'c-mode) + (eq context 'top) + (eq (char-after) ?\)))))))) (setq pos (c-up-list-forward (point))) (eq (char-before pos) ?\))) (c-fdoc-shift-type-backward) @@ -8906,9 +8945,9 @@ comment at the start of cc-engine.el for more info." ;; uncommon (e.g. some placements of "const" in C++) it's not worth ;; the effort to look for them.) -;;; 2008-04-16: commented out the next form, to allow the function to recognize -;;; "foo (int bar)" in CC (an implicit type (in class foo) without a semicolon) -;;; as a(n almost complete) declaration, enabling it to be fontified. +;;; 2008-04-16: commented out the next form, to allow the function to recognize +;;; "foo (int bar)" in CC (an implicit type (in class foo) without a semicolon) +;;; as a(n almost complete) declaration, enabling it to be fontified. ;; CASE 13 ;; (unless (or at-decl-end (looking-at "=[^=]")) ;; If this is a declaration it should end here or its initializer(*) @@ -9036,9 +9075,12 @@ comment at the start of cc-engine.el for more info." ;; (in at least C++) that anything that can be parsed as a declaration ;; is a declaration. Now we're being more defensive and prefer to ;; highlight things like "foo (bar);" as a declaration only if we're - ;; inside an arglist that contains declarations. - ;; CASE 19 - (eq context 'decl)))) + ;; inside an arglist that contains declarations. Update (2017-09): We + ;; now recognize a top-level "foo(bar);" as a declaration in C. + ;; CASE 19 + (or (eq context 'decl) + (and (c-major-mode-is 'c-mode) + (eq context 'top)))))) ;; The point is now after the type decl expression. @@ -9546,6 +9588,7 @@ Note that this function might do hidden buffer changes. See the comment at the start of cc-engine.el for more info." ;; Note to maintainers: this function consumes a great mass of CPU cycles. ;; Its use should thus be minimized as far as possible. + ;; Consider instead using `c-bs-at-toplevel-p'. (let ((paren-state (c-parse-state))) (or (not (c-most-enclosing-brace paren-state)) (c-search-uplist-for-classkey paren-state)))) @@ -9575,8 +9618,15 @@ comment at the start of cc-engine.el for more info." (not (and (c-major-mode-is 'objc-mode) (c-forward-objc-directive))) + ;; Don't confuse #if .... defined(foo) for a function arglist. + (not (and (looking-at c-cpp-expr-functions-key) + (save-excursion + (save-restriction + (widen) + (c-beginning-of-macro lim))))) (setq id-start (car-safe (c-forward-decl-or-cast-1 (c-point 'bosws) 'top nil))) + (numberp id-start) (< id-start beg) ;; There should not be a '=' or ',' between beg and the @@ -9695,8 +9745,8 @@ comment at the start of cc-engine.el for more info." ;; identifiers? (progn (goto-char before-lparen) - (c-forward-token-2) ; to first token inside parens (and + (c-forward-over-token-and-ws) ; to first token inside parens (setq id-start (c-on-identifier)) ; Must be at least one. (catch 'id-list (while @@ -9708,7 +9758,7 @@ comment at the start of cc-engine.el for more info." ids) (c-forward-syntactic-ws) (eq (char-after) ?\,)) - (c-forward-token-2) + (c-forward-over-token-and-ws) (unless (setq id-start (c-on-identifier)) (throw 'id-list nil))) (eq (char-after) ?\))))) @@ -10040,7 +10090,7 @@ comment at the start of cc-engine.el for more info." (c-syntactic-re-search-forward ";" nil 'move t)))) nil))) -(defun c-looking-at-decl-block (containing-sexp goto-start &optional limit) +(defun c-looking-at-decl-block (_containing-sexp goto-start &optional limit) ;; Assuming the point is at an open brace, check if it starts a ;; block that contains another declaration level, i.e. that isn't a ;; statement block or a brace list, and if so return non-nil. @@ -10181,8 +10231,16 @@ comment at the start of cc-engine.el for more info." ;; Could be more restrictive wrt invalid keywords, ;; but that'd only occur in invalid code so there's ;; no use spending effort on it. - (let ((end (match-end 0))) - (unless (c-forward-keyword-clause 0) + (let ((end (match-end 0)) + (kwd-sym (c-keyword-sym (match-string 0)))) + (unless + (and kwd-sym + ;; Moving over a protection kwd and the following + ;; ":" (in C++ Mode) to the next token could take + ;; us all the way up to `kwd-start', leaving us + ;; no chance to update `first-specifier-pos'. + (not (c-keyword-member kwd-sym 'c-protection-kwds)) + (c-forward-keyword-clause 0)) (goto-char end) (c-forward-syntactic-ws))) @@ -10313,7 +10371,7 @@ comment at the start of cc-engine.el for more info." ;; We're at a "{". Move back to the enum-like keyword that starts this ;; declaration and return t, otherwise don't move and return nil. (let ((here (point)) - up-sexp-pos before-identifier) + before-identifier) (when c-recognize-post-brace-list-type-p (c-backward-typed-enum-colon)) (while @@ -10349,16 +10407,20 @@ comment at the start of cc-engine.el for more info." (defun c-looking-at-or-maybe-in-bracelist (&optional containing-sexp lim) ;; Point is at an open brace. If this starts a brace list, return a list ;; whose car is the buffer position of the start of the construct which - ;; introduces the list, and whose cdr is t if we have parsed a keyword - ;; matching `c-opt-inexpr-brace-list-key' (e.g. Java's "new"), nil - ;; otherwise. Otherwise, if point might be inside an enclosing brace list, - ;; return t. If point is definitely neither at nor in a brace list, return - ;; nil. + ;; introduces the list, and whose cdr is the symbol `in-paren' if the brace + ;; is directly enclosed in a parenthesis form (i.e. an arglist), t if we + ;; have parsed a keyword matching `c-opt-inexpr-brace-list-key' (e.g. Java's + ;; "new"), nil otherwise. Otherwise, if point might be inside an enclosing + ;; brace list, return t. If point is definitely neither at nor in a brace + ;; list, return nil. ;; ;; CONTAINING-SEXP is the position of the brace/paren/bracket enclosing ;; POINT, or nil if there is no such position, or we do not know it. LIM is ;; a backward search limit. ;; + ;; The determination of whether the brace starts a brace list is solely by + ;; the context of the brace, not by its contents. + ;; ;; Here, "brace list" does not include the body of an enum. (save-excursion (let ((start (point)) @@ -10368,17 +10430,20 @@ comment at the start of cc-engine.el for more info." (and (c-major-mode-is 'pike-mode) c-decl-block-key)) (braceassignp 'dontknow) - inexpr-brace-list bufpos macro-start res pos after-type-id-pos) + inexpr-brace-list bufpos macro-start res pos after-type-id-pos + in-paren) (setq res (c-backward-token-2 1 t lim)) ;; Checks to do only on the first sexp before the brace. ;; Have we a C++ initialization, without an "="? (if (and (c-major-mode-is 'c++-mode) (cond - ((and (not (eq res 0)) + ((and (or (not (eq res 0)) + (eq (char-after) ?,)) (c-go-up-list-backward nil lim) ; FIXME!!! Check ; `lim' 2016-07-12. (eq (char-after) ?\()) - (setq braceassignp 'c++-noassign)) + (setq braceassignp 'c++-noassign + in-paren 'in-paren)) ((looking-at c-pre-id-bracelist-key)) ((looking-at c-return-key)) ((and (looking-at c-symbol-start) @@ -10387,9 +10452,11 @@ comment at the start of cc-engine.el for more info." (t nil)) (save-excursion (cond - ((not (eq res 0)) + ((or (not (eq res 0)) + (eq (char-after) ?,)) (and (c-go-up-list-backward nil lim) ; FIXME!!! Check `lim' 2016-07-12. - (eq (char-after) ?\())) + (eq (char-after) ?\() + (setq in-paren 'in-paren))) ((looking-at c-pre-id-bracelist-key)) ((looking-at c-return-key)) (t (setq after-type-id-pos (point)) @@ -10428,7 +10495,7 @@ comment at the start of cc-engine.el for more info." (c-backward-syntactic-ws) (eq (char-before) ?\())) ;; Single identifier between '(' and '{'. We have a bracelist. - (cons after-type-id-pos nil)) + (cons after-type-id-pos 'in-paren)) (t (goto-char pos) @@ -10486,14 +10553,14 @@ comment at the start of cc-engine.el for more info." (braceassignp ;; We've hit the beginning of the aggregate list. (c-beginning-of-statement-1 containing-sexp) - (cons (point) inexpr-brace-list)) + (cons (point) (or in-paren inexpr-brace-list))) ((and after-type-id-pos (save-excursion (when (eq (char-after) ?\;) - (c-forward-token-2 1 t)) + (c-forward-over-token-and-ws t)) (setq bufpos (point)) (when (looking-at c-opt-<>-sexp-key) - (c-forward-token-2) + (c-forward-over-token-and-ws) (when (and (eq (char-after) ?<) (c-get-char-property (point) 'syntax-table)) (c-go-list-forward nil after-type-id-pos) @@ -10511,7 +10578,7 @@ comment at the start of cc-engine.el for more info." nil nil)) (and (consp res) (eq (car res) after-type-id-pos)))))) - (cons bufpos inexpr-brace-list)) + (cons bufpos (or in-paren inexpr-brace-list))) ((eq (char-after) ?\;) ;; Brace lists can't contain a semicolon, so we're done. ;; (setq containing-sexp nil) @@ -10535,12 +10602,16 @@ comment at the start of cc-engine.el for more info." (t t)))) ;; The caller can go up one level. ))) -(defun c-inside-bracelist-p (containing-sexp paren-state) +(defun c-inside-bracelist-p (containing-sexp paren-state accept-in-paren) ;; return the buffer position of the beginning of the brace list ;; statement if we're inside a brace list, otherwise return nil. ;; CONTAINING-SEXP is the buffer pos of the innermost containing ;; paren. PAREN-STATE is the remainder of the state of enclosing - ;; braces + ;; braces. ACCEPT-IN-PAREN is non-nil iff we will accept as a brace + ;; list a brace directly enclosed in a parenthesis. + ;; + ;; The "brace list" here is recognized solely by its context, not by + ;; its contents. ;; ;; N.B.: This algorithm can potentially get confused by cpp macros ;; placed in inconvenient locations. It's a trade-off we make for @@ -10555,17 +10626,11 @@ comment at the start of cc-engine.el for more info." ;; this will pick up array/aggregate init lists, even if they are nested. (save-excursion (let ((bufpos t) - lim next-containing) + next-containing) (while (and (eq bufpos t) containing-sexp) (when paren-state - (if (consp (car paren-state)) - (setq lim (cdr (car paren-state)) - paren-state (cdr paren-state)) - (setq lim (car paren-state))) - (when paren-state - (setq next-containing (car paren-state) - paren-state (cdr paren-state)))) + (setq next-containing (c-pull-open-brace paren-state))) (goto-char containing-sexp) (if (c-looking-at-inexpr-block next-containing next-containing) @@ -10574,16 +10639,18 @@ comment at the start of cc-engine.el for more info." ;; containing sexp, so that c-looking-at-inexpr-block ;; doesn't check for an identifier before it. (setq bufpos nil) - (when (or (not (eq (char-after) ?{)) - (eq (setq bufpos (c-looking-at-or-maybe-in-bracelist - next-containing lim)) - t)) - (setq containing-sexp next-containing - lim nil - next-containing nil)))) - (and (consp bufpos) (car bufpos)))))) - -(defun c-looking-at-special-brace-list (&optional lim) + (if (not (eq (char-after) ?{)) + (setq bufpos nil) + (when (eq (setq bufpos (c-looking-at-or-maybe-in-bracelist + next-containing next-containing)) + t) + (setq containing-sexp next-containing + next-containing nil))))) + (and (consp bufpos) + (or accept-in-paren (not (eq (cdr bufpos) 'in-paren))) + (car bufpos)))))) + +(defun c-looking-at-special-brace-list (&optional _lim) ;; If we're looking at the start of a pike-style list, i.e., `({ })', ;; `([ ])', `(< >)', etc., a cons of a cons of its starting and ending ;; positions and its entry in c-special-brace-lists is returned, nil @@ -10646,7 +10713,7 @@ comment at the start of cc-engine.el for more info." (cons (list beg) type))))) (error nil)))) -(defun c-looking-at-bos (&optional lim) +(defun c-looking-at-bos (&optional _lim) ;; Return non-nil if between two statements or declarations, assuming ;; point is not inside a literal or comment. ;; @@ -10659,26 +10726,37 @@ comment at the start of cc-engine.el for more info." (defun c-looking-at-statement-block () ;; Point is at an opening brace. If this is a statement block (i.e. the - ;; elements in it are terminated by semicolons) return t. Otherwise, return - ;; nil. + ;; elements in the block are terminated by semicolons, or the block is + ;; empty, or the block contains a keyword) return t. Otherwise, return nil. (let ((here (point))) (prog1 (if (c-go-list-forward) (let ((there (point))) (backward-char) - (c-syntactic-skip-backward - "^;," here t) + (c-syntactic-skip-backward "^;," here t) (cond ((eq (char-before) ?\;) t) ((eq (char-before) ?,) nil) - (t (goto-char here) - (forward-char) - (and (c-syntactic-re-search-forward "{" there t t) - (progn (backward-char) - (c-looking-at-statement-block)))))) + (t ; We're at (1+ here). + (cond + ((progn (c-forward-syntactic-ws) + (eq (point) (1- there)))) + ((c-syntactic-re-search-forward c-keywords-regexp there t)) + ((c-syntactic-re-search-forward "{" there t t) + (backward-char) + (c-looking-at-statement-block)) + (t nil))))) (forward-char) - (and (c-syntactic-re-search-forward "[;,]" nil t t) - (eq (char-before) ?\;))) + (cond + ((c-syntactic-re-search-forward "[;,]" nil t t) + (eq (char-before) ?\;)) + ((progn (c-forward-syntactic-ws) + (eobp))) + ((c-syntactic-re-search-forward c-keywords-regexp nil t t)) + ((c-syntactic-re-search-forward "{" nil t t) + (backward-char) + (c-looking-at-statement-block)) + (t nil))) (goto-char here)))) (defun c-looking-at-inexpr-block (lim containing-sexp &optional check-at-end) @@ -11208,7 +11286,7 @@ comment at the start of cc-engine.el for more info." containing-decl-open containing-decl-start containing-decl-kwd - paren-state) + _paren-state) ;; The inclass and class-close syntactic symbols are added in ;; several places and some work is needed to fix everything. ;; Therefore it's collected here. @@ -11424,7 +11502,7 @@ comment at the start of cc-engine.el for more info." ;; following result clauses, and most of this function is a ;; single gigantic cond. :P literal char-before-ip before-ws-ip char-after-ip macro-start - in-macro-expr c-syntactic-context placeholder c-in-literal-cache + in-macro-expr c-syntactic-context placeholder step-type tmpsymbol keyword injava-inher special-brace-list tmp-pos containing-< ;; The following record some positions for the containing @@ -11448,6 +11526,7 @@ comment at the start of cc-engine.el for more info." ;; The paren state outside `containing-sexp', or at ;; `indent-point' if `containing-sexp' is nil. (paren-state (c-parse-state)) + (state-cache (copy-tree paren-state)) ;; There's always at most one syntactic element which got ;; an anchor pos. It's stored in syntactic-relpos. syntactic-relpos @@ -11610,7 +11689,7 @@ comment at the start of cc-engine.el for more info." (not (c-at-vsemi-p before-ws-ip)) (not (memq char-after-ip '(?\) ?\] ?,))) (or (not (eq char-before-ip ?})) - (c-looking-at-inexpr-block-backward c-state-cache)) + (c-looking-at-inexpr-block-backward state-cache)) (> (point) (progn ;; Ought to cache the result from the @@ -11688,7 +11767,7 @@ comment at the start of cc-engine.el for more info." (if containing-sexp (progn (goto-char containing-sexp) - (setq lim (c-most-enclosing-brace c-state-cache + (setq lim (c-most-enclosing-brace state-cache containing-sexp)) (c-backward-to-block-anchor lim) (c-add-stmt-syntax 'case-label nil t lim paren-state)) @@ -11714,7 +11793,7 @@ comment at the start of cc-engine.el for more info." (containing-sexp (goto-char containing-sexp) - (setq lim (c-most-enclosing-brace c-state-cache + (setq lim (c-most-enclosing-brace state-cache containing-sexp)) (save-excursion (setq tmpsymbol @@ -11758,7 +11837,7 @@ comment at the start of cc-engine.el for more info." (goto-char (cdr placeholder)) (back-to-indentation) (c-add-stmt-syntax tmpsymbol nil t - (c-most-enclosing-brace c-state-cache (point)) + (c-most-enclosing-brace state-cache (point)) paren-state) (unless (eq (point) (cdr placeholder)) (c-add-syntax (car placeholder)))) @@ -11811,7 +11890,7 @@ comment at the start of cc-engine.el for more info." (cond ((c-backward-over-enum-header) (setq placeholder (c-point 'boi))) - ((consp (setq placeholder + ((consp (setq placeholder (c-looking-at-or-maybe-in-bracelist containing-sexp lim))) (setq tmpsymbol (and (cdr placeholder) 'topmost-intro-cont)) @@ -12181,11 +12260,11 @@ comment at the start of cc-engine.el for more info." (and (eq (char-before) ?}) (save-excursion (let ((start (point))) - (if (and c-state-cache - (consp (car c-state-cache)) - (eq (cdar c-state-cache) (point))) + (if (and state-cache + (consp (car state-cache)) + (eq (cdar state-cache) (point))) ;; Speed up the backward search a bit. - (goto-char (caar c-state-cache))) + (goto-char (caar state-cache))) (c-beginning-of-decl-1 containing-sexp) ; Can't use `lim' here. (setq placeholder (point)) (if (= start (point)) @@ -12342,7 +12421,8 @@ comment at the start of cc-engine.el for more info." ((and (eq char-after-ip ?{) (progn (setq placeholder (c-inside-bracelist-p (point) - paren-state)) + paren-state + nil)) (if placeholder (setq tmpsymbol '(brace-list-open . inexpr-class)) (setq tmpsymbol '(block-open . inexpr-statement) @@ -12424,7 +12504,7 @@ comment at the start of cc-engine.el for more info." (skip-chars-forward " \t")) (goto-char placeholder)) (c-add-stmt-syntax 'arglist-cont-nonempty (list containing-sexp) t - (c-most-enclosing-brace c-state-cache (point)) + (c-most-enclosing-brace state-cache (point)) paren-state)) ;; CASE 7G: we are looking at just a normal arglist @@ -12465,7 +12545,11 @@ comment at the start of cc-engine.el for more info." (save-excursion (goto-char containing-sexp) (c-looking-at-special-brace-list))) - (c-inside-bracelist-p containing-sexp paren-state)))) + (c-inside-bracelist-p containing-sexp paren-state t) + (save-excursion + (goto-char containing-sexp) + (and (eq (char-after) ?{) + (not (c-looking-at-statement-block))))))) (cond ;; CASE 9A: In the middle of a special brace list opener. @@ -12513,7 +12597,7 @@ comment at the start of cc-engine.el for more info." (= (point) containing-sexp))) (if (eq (point) (c-point 'boi)) (c-add-syntax 'brace-list-close (point)) - (setq lim (c-most-enclosing-brace c-state-cache (point))) + (setq lim (c-most-enclosing-brace state-cache (point))) (c-beginning-of-statement-1 lim nil nil t) (c-add-stmt-syntax 'brace-list-close nil t lim paren-state))) @@ -12539,7 +12623,7 @@ comment at the start of cc-engine.el for more info." (goto-char containing-sexp)) (if (eq (point) (c-point 'boi)) (c-add-syntax 'brace-list-intro (point)) - (setq lim (c-most-enclosing-brace c-state-cache (point))) + (setq lim (c-most-enclosing-brace state-cache (point))) (c-beginning-of-statement-1 lim) (c-add-stmt-syntax 'brace-list-intro nil t lim paren-state))) @@ -12561,7 +12645,7 @@ comment at the start of cc-engine.el for more info." ((and (not (memq char-before-ip '(?\; ?:))) (not (c-at-vsemi-p before-ws-ip)) (or (not (eq char-before-ip ?})) - (c-looking-at-inexpr-block-backward c-state-cache)) + (c-looking-at-inexpr-block-backward state-cache)) (> (point) (save-excursion (c-beginning-of-statement-1 containing-sexp) @@ -12695,7 +12779,7 @@ comment at the start of cc-engine.el for more info." (skip-chars-forward " \t")) (goto-char placeholder)) (c-add-stmt-syntax 'template-args-cont (list containing-<) t - (c-most-enclosing-brace c-state-cache (point)) + (c-most-enclosing-brace state-cache (point)) paren-state)) ;; CASE 17: Statement or defun catchall. @@ -12769,7 +12853,7 @@ comment at the start of cc-engine.el for more info." (goto-char (cdr placeholder)) (back-to-indentation) (c-add-stmt-syntax tmpsymbol nil t - (c-most-enclosing-brace c-state-cache (point)) + (c-most-enclosing-brace state-cache (point)) paren-state) (if (/= (point) (cdr placeholder)) (c-add-syntax (car placeholder)))) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 9bae7d9aa2f..d352e5b08c9 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -22,7 +22,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -292,12 +292,17 @@ nil))))) res)))) - (defun c-make-font-lock-search-form (regexp highlights) + (defun c-make-font-lock-search-form (regexp highlights &optional check-point) ;; Return a lisp form which will fontify every occurrence of REGEXP ;; (a regular expression, NOT a function) between POINT and `limit' ;; with HIGHLIGHTS, a list of highlighters as specified on page - ;; "Search-based Fontification" in the elisp manual. - `(while (re-search-forward ,regexp limit t) + ;; "Search-based Fontification" in the elisp manual. If CHECK-POINT + ;; is non-nil, we will check (< (point) limit) in the main loop. + `(while + ,(if check-point + `(and (< (point) limit) + (re-search-forward ,regexp limit t)) + `(re-search-forward ,regexp limit t)) (unless (progn (goto-char (match-beginning 0)) (c-skip-comments-and-strings limit)) @@ -476,7 +481,9 @@ ,(c-make-font-lock-search-form regexp highlights))))) state-stanzas) - ,(c-make-font-lock-search-form (car normal) (cdr normal)) + ;; 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. @@ -702,6 +709,36 @@ stuff. Used on level 1 and higher." t) (c-put-font-lock-face start (1+ start) 'font-lock-warning-face))))) +(defun c-font-lock-invalid-single-quotes (limit) + ;; 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 + ;; font-lock-keyword-face. It always returns NIL to inhibit this and + ;; prevent a repeat invocation. See elisp/lispref page "Search-based + ;; Fontification". + ;; + ;; This function fontifies invalid single quotes with + ;; `font-lock-warning-face'. These are the single quotes which + ;; o - aren't inside a literal; + ;; o - are marked with a syntax-table text property value '(1); and + ;; o - are NOT marked with a non-null c-digit-separator property. + (let ((limits (c-literal-limits)) + state beg end) + (if limits + (goto-char (cdr limits))) ; Even for being in a ' ' + (while (< (point) limit) + (setq beg (point)) + (setq state (parse-partial-sexp (point) limit nil nil nil 'syntax-table)) + (setq end (point)) + (goto-char beg) + (while (progn (skip-chars-forward "^'" end) + (< (point) end)) + (if (and (equal (c-get-char-property (point) 'syntax-table) '(1)) + (not (c-get-char-property (point) 'c-digit-separator))) + (c-put-font-lock-face (point) (1+ (point)) font-lock-warning-face)) + (forward-char)) + (parse-partial-sexp end limit nil nil state 'syntax-table))) + nil) + (c-lang-defconst c-basic-matchers-before "Font lock matchers for basic keywords, labels, references and various other easily recognizable things that should be fontified before generic @@ -723,6 +760,9 @@ casts and declarations are fontified. Used on level 2 and higher." (concat ".\\(" c-string-limit-regexp "\\)") '((c-font-lock-invalid-string))) + ;; 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)) @@ -777,7 +817,8 @@ casts and declarations are fontified. Used on level 2 and higher." (c-backward-syntactic-ws) (setq id-end (point)) (< (skip-chars-backward - ,(c-lang-const c-symbol-chars)) 0)) + ,(c-lang-const c-symbol-chars)) + 0)) (not (get-text-property (point) 'face))) (c-put-font-lock-face (point) id-end c-reference-face-name) @@ -992,7 +1033,8 @@ casts and declarations are fontified. Used on level 2 and higher." (goto-char pos))))) nil) -(defun c-font-lock-declarators (limit list types not-top) +(defun c-font-lock-declarators (limit list types not-top + &optional template-class) ;; Assuming the point is at the start of a declarator in a declaration, ;; fontify the identifier it declares. (If TYPES is set, it does this via ;; the macro `c-fontify-types-and-refs'.) @@ -1006,6 +1048,11 @@ casts and declarations are fontified. Used on level 2 and higher." ;; non-nil, we are not at the top-level ("top-level" includes being directly ;; inside a class or namespace, etc.). ;; + ;; TEMPLATE-CLASS is non-nil when the declaration is in template delimiters + ;; and was introduced by, e.g. "typename" or "class", such that if there is + ;; a default (introduced by "="), it will be fontified as a type. + ;; E.g. "<class X = Y>". + ;; ;; Nil is always returned. The function leaves point at the delimiter after ;; the last declarator it processes. ;; @@ -1013,18 +1060,16 @@ casts and declarations are fontified. Used on level 2 and higher." ;;(message "c-font-lock-declarators from %s to %s" (point) limit) (c-fontify-types-and-refs - ((pos (point)) next-pos id-start id-end + ((pos (point)) next-pos id-start decl-res - paren-depth id-face got-type got-init c-last-identifier-range - (separator-prop (if types 'c-decl-type-start 'c-decl-id-start)) - brackets-after-id) + (separator-prop (if types 'c-decl-type-start 'c-decl-id-start))) ;; The following `while' fontifies a single declarator id each time round. ;; It loops only when LIST is non-nil. (while - (and pos (setq decl-res (c-forward-declarator limit))) + (and pos (setq decl-res (c-forward-declarator))) (setq next-pos (point) id-start (car decl-res) id-face (if (and (eq (char-after) ?\() @@ -1036,7 +1081,7 @@ casts and declarations are fontified. Used on level 2 and higher." (forward-char) (c-forward-syntactic-ws) (looking-at "[*&]"))) - (not (car (cddr decl-res))) ; brackets-after-id + (not (car (cddr decl-res))) (or (not (c-major-mode-is 'c++-mode)) (save-excursion (let (c-last-identifier-range) @@ -1053,7 +1098,7 @@ casts and declarations are fontified. Used on level 2 and higher." (throw 'is-function nil)) ((not (eq got-type 'maybe)) (throw 'is-function t))) - (c-forward-declarator limit t) + (c-forward-declarator nil t) (eq (char-after) ?,)) (forward-char) (c-forward-syntactic-ws)) @@ -1080,6 +1125,13 @@ casts and declarations are fontified. Used on level 2 and higher." (goto-char next-pos) (setq pos nil) ; So as to terminate the enclosing `while' form. + (if (and template-class + (eq got-init ?=) ; C++ "<class X = Y>"? + (c-forward-token-2 1 nil limit) ; Over "=" + (let ((c-promote-possible-types t)) + (c-forward-type t))) ; Over "Y" + (setq list nil)) ; Shouldn't be needed. We can't have a list, here. + (when list ;; Jump past any initializer or function prototype to see if ;; there's a ',' to continue at. @@ -1150,10 +1202,15 @@ casts and declarations are fontified. Used on level 2 and higher." (goto-char match-pos) (backward-char) (c-backward-token-2) - (or (looking-at c-block-stmt-2-key) - (looking-at c-block-stmt-1-2-key) - (looking-at c-typeof-key)))) - (cons nil t)) + (cond + ((looking-at c-paren-stmt-key) + ;; Allow comma separated <> arglists in for statements. + (cons nil nil)) + ((or (looking-at c-block-stmt-2-key) + (looking-at c-block-stmt-1-2-key) + (looking-at c-typeof-key)) + (cons nil t)) + (t nil))))) ;; Near BOB. ((<= match-pos (point-min)) (cons 'arglist t)) @@ -1194,13 +1251,16 @@ casts and declarations are fontified. Used on level 2 and higher." ;; Got a cached hit in some other type of arglist. (type (cons 'arglist t)) - (not-front-decl + ((and not-front-decl ;; The point is within the range of a previously ;; encountered type decl expression, so the arglist ;; is probably one that contains declarations. ;; However, if `c-recognize-paren-inits' is set it ;; might also be an initializer arglist. - ;; + (or (not c-recognize-paren-inits) + (save-excursion + (goto-char match-pos) + (not (c-back-over-member-initializers))))) ;; The result of this check is cached with a char ;; property on the match token, so that we can look ;; it up again when refontifying single lines in a @@ -1211,17 +1271,21 @@ casts and declarations are fontified. Used on level 2 and higher." ;; Got an open paren preceded by an arith operator. ((and (eq (char-before match-pos) ?\() (save-excursion + (goto-char match-pos) (and (zerop (c-backward-token-2 2)) (looking-at c-arithmetic-op-regexp)))) (cons nil nil)) ;; In a C++ member initialization list. ((and (eq (char-before match-pos) ?,) (c-major-mode-is 'c++-mode) - (save-excursion (c-back-over-member-initializers))) + (save-excursion + (goto-char match-pos) + (c-back-over-member-initializers))) (c-put-char-property (1- match-pos) 'c-type 'c-not-decl) (cons 'not-decl nil)) ;; At start of a declaration inside a declaration paren. ((save-excursion + (goto-char match-pos) (and (memq (char-before match-pos) '(?\( ?\,)) (c-go-up-list-backward match-pos) (eq (char-after) ?\() @@ -1296,8 +1360,12 @@ casts and declarations are fontified. Used on level 2 and higher." (c-backward-syntactic-ws) (and (c-simple-skip-symbol-backward) (looking-at c-paren-stmt-key)))) - t))) - + t)) + (template-class (and (eq context '<>) + (save-excursion + (goto-char match-pos) + (c-forward-syntactic-ws) + (looking-at c-template-typename-key))))) ;; Fix the `c-decl-id-start' or `c-decl-type-start' property ;; before the first declarator if it's a list. ;; `c-font-lock-declarators' handles the rest. @@ -1309,10 +1377,9 @@ casts and declarations are fontified. Used on level 2 and higher." (if (cadr decl-or-cast) 'c-decl-type-start 'c-decl-id-start))))) - (c-font-lock-declarators (min limit (point-max)) decl-list - (cadr decl-or-cast) (not toplev))) + (cadr decl-or-cast) (not toplev) template-class)) ;; A declaration has been successfully identified, so do all the ;; fontification of types and refs that've been recorded. @@ -1375,7 +1442,6 @@ casts and declarations are fontified. Used on level 2 and higher." ;; it finds any. That's necessary so that we later will ;; stop inside them to fontify types there. (c-parse-and-markup-<>-arglists t) - lbrace ; position of some {. ;; The font-lock package in Emacs is known to clobber ;; `parse-sexp-lookup-properties' (when it exists). (parse-sexp-lookup-properties @@ -1607,7 +1673,8 @@ casts and declarations are fontified. Used on level 2 and higher." ;; font-lock-keyword-face. It always returns NIL to inhibit this and ;; prevent a repeat invocation. See elisp/lispref page "Search-based ;; fontification". - (let ((decl-search-lim (c-determine-limit 1000)) + (let ((here (point)) + (decl-search-lim (c-determine-limit 1000)) paren-state encl-pos token-end context decl-or-cast start-pos top-level c-restricted-<>-arglists c-recognize-knr-p) ; Strictly speaking, bogus, but it @@ -1624,26 +1691,27 @@ casts and declarations are fontified. Used on level 2 and higher." (when (or (bobp) (memq (char-before) '(?\; ?{ ?}))) (setq token-end (point)) - (c-forward-syntactic-ws) - ;; We're now putatively at the declaration. - (setq start-pos (point)) - (setq paren-state (c-parse-state)) - ;; At top level or inside a "{"? - (if (or (not (setq encl-pos - (c-most-enclosing-brace paren-state))) - (eq (char-after encl-pos) ?\{)) - (progn - (setq top-level (c-at-toplevel-p)) - (let ((got-context (c-get-fontification-context - token-end nil top-level))) - (setq context (car got-context) - c-restricted-<>-arglists (cdr got-context))) - (setq decl-or-cast - (c-forward-decl-or-cast-1 token-end context nil)) - (when (consp decl-or-cast) - (goto-char start-pos) - (c-font-lock-single-decl limit decl-or-cast token-end - context top-level))))))) + (c-forward-syntactic-ws here) + (when (< (point) here) + ;; We're now putatively at the declaration. + (setq start-pos (point)) + (setq paren-state (c-parse-state)) + ;; At top level or inside a "{"? + (if (or (not (setq encl-pos + (c-most-enclosing-brace paren-state))) + (eq (char-after encl-pos) ?\{)) + (progn + (setq top-level (c-at-toplevel-p)) + (let ((got-context (c-get-fontification-context + token-end nil top-level))) + (setq context (car got-context) + c-restricted-<>-arglists (cdr got-context))) + (setq decl-or-cast + (c-forward-decl-or-cast-1 token-end context nil)) + (when (consp decl-or-cast) + (goto-char start-pos) + (c-font-lock-single-decl limit decl-or-cast token-end + context top-level)))))))) nil)) (defun c-font-lock-enclosing-decls (limit) @@ -1667,18 +1735,16 @@ casts and declarations are fontified. Used on level 2 and higher." (eq (char-after ps-elt) ?\{)) (goto-char ps-elt) (c-syntactic-skip-backward "^;{}" decl-search-lim) - (when (or (bobp) - (memq (char-before) '(?\; ?}))) - (c-forward-syntactic-ws) - (setq in-typedef (looking-at c-typedef-key)) - (if in-typedef (c-forward-token-2)) - (when (and c-opt-block-decls-with-vars-key - (looking-at c-opt-block-decls-with-vars-key)) - (goto-char ps-elt) - (when (c-safe (c-forward-sexp)) - (c-forward-syntactic-ws) - (c-font-lock-declarators limit t in-typedef - (not (c-bs-at-toplevel-p (point))))))))))) + (c-forward-syntactic-ws) + (setq in-typedef (looking-at c-typedef-key)) + (if in-typedef (c-forward-over-token-and-ws)) + (when (and c-opt-block-decls-with-vars-key + (looking-at c-opt-block-decls-with-vars-key)) + (goto-char ps-elt) + (when (c-safe (c-forward-sexp)) + (c-forward-syntactic-ws) + (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. @@ -1955,85 +2021,6 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'." 2 font-lock-type-face) `(,(concat "\\<\\(" re "\\)\\>") 1 'font-lock-type-face))) - - ;; Fontify types preceded by `c-type-prefix-kwds' (e.g. "struct"). - ,@(when (c-lang-const c-type-prefix-kwds) - `((,(byte-compile - `(lambda (limit) - (c-fontify-types-and-refs - ((c-promote-possible-types t) - ;; The font-lock package in Emacs is known to clobber - ;; `parse-sexp-lookup-properties' (when it exists). - (parse-sexp-lookup-properties - (cc-eval-when-compile - (boundp 'parse-sexp-lookup-properties)))) - (save-restriction - ;; Narrow to avoid going past the limit in - ;; `c-forward-type'. - (narrow-to-region (point) limit) - (while (re-search-forward - ,(concat "\\<\\(" - (c-make-keywords-re nil - (c-lang-const c-type-prefix-kwds)) - "\\)\\>") - limit t) - (unless (c-skip-comments-and-strings limit) - (c-forward-syntactic-ws) - ;; Handle prefix declaration specifiers. - (while - (or - (when (or (looking-at c-prefix-spec-kwds-re) - (and (c-major-mode-is 'java-mode) - (looking-at "@[A-Za-z0-9]+"))) - (c-forward-keyword-clause 1) - t) - (when (and c-opt-cpp-prefix - (looking-at - c-noise-macro-with-parens-name-re)) - (c-forward-noise-clause) - t))) - ,(if (c-major-mode-is 'c++-mode) - `(when (and (c-forward-type) - (eq (char-after) ?=)) - ;; In C++ we additionally check for a "class - ;; X = Y" construct which is used in - ;; templates, to fontify Y as a type. - (forward-char) - (c-forward-syntactic-ws) - (c-forward-type)) - `(c-forward-type)) - ))))))))) - - ;; Fontify symbols after closing braces as declaration - ;; identifiers under the assumption that they are part of - ;; declarations like "class Foo { ... } foo;". It's too - ;; expensive to check this accurately by skipping past the - ;; brace block, so we use the heuristic that it's such a - ;; declaration if the first identifier is on the same line as - ;; the closing brace. `c-font-lock-declarations' will later - ;; override it if it turns out to be an new declaration, but - ;; it will be wrong if it's an expression (see the test - ;; decls-8.cc). -;; ,@(when (c-lang-const c-opt-block-decls-with-vars-key) -;; `((,(c-make-font-lock-search-function -;; (concat "}" -;; (c-lang-const c-single-line-syntactic-ws) -;; "\\(" ; 1 + c-single-line-syntactic-ws-depth -;; (c-lang-const c-type-decl-prefix-key) -;; "\\|" -;; (c-lang-const c-symbol-key) -;; "\\)") -;; `((c-font-lock-declarators limit t nil) ; That nil says use `font-lock-variable-name-face'; -;; ; t would mean `font-lock-function-name-face'. -;; (progn -;; (c-put-char-property (match-beginning 0) 'c-type -;; 'c-decl-id-start) -;; ; 'c-decl-type-start) -;; (goto-char (match-beginning -;; ,(1+ (c-lang-const -;; c-single-line-syntactic-ws-depth))))) -;; (goto-char (match-end 0))))))) - ;; Fontify the type in C++ "new" expressions. ,@(when (c-major-mode-is 'c++-mode) ;; This pattern is a probably a "(MATCHER . ANCHORED-HIGHLIGHTER)" @@ -2503,7 +2490,7 @@ need for `c++-font-lock-extra-types'.") limit "[-+]" nil - (lambda (match-pos inside-macro &optional top-level) + (lambda (_match-pos _inside-macro &optional _top-level) (forward-char) (c-font-lock-objc-method)))) nil) diff --git a/lisp/progmodes/cc-guess.el b/lisp/progmodes/cc-guess.el index 153b3a31e56..00d8bf08175 100644 --- a/lisp/progmodes/cc-guess.el +++ b/lisp/progmodes/cc-guess.el @@ -22,7 +22,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: ;; @@ -494,8 +494,7 @@ is called with one argument, the guessed style." ;; If an entry in `c-offsets-alist' holds a guessed value, move it to ;; front in the field. In addition alphabetical sort by entry name is done. (setq style (copy-tree style)) - (let ((offsets-alist-cell (assq 'c-offsets-alist style)) - (guessed-syntactic-symbols (c-guess-guessed-syntactic-symbols))) + (let ((offsets-alist-cell (assq 'c-offsets-alist style))) (setcdr offsets-alist-cell (sort (cdr offsets-alist-cell) (lambda (a b) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index a9d5ac34ad4..227b3e16485 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -26,7 +26,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -115,7 +115,7 @@ ;; For Emacs < 22.2. (eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) + (unless (fboundp 'declare-function) (defmacro declare-function (&rest _)))) (eval-when-compile (let ((load-path @@ -130,7 +130,7 @@ ;; This file is not always loaded. See note above. -(cc-external-require (if (eq c--mapcan-status 'cl-mapcan) 'cl-lib 'cl)) +(cc-external-require (if (eq c--cl-library 'cl-lib) 'cl-lib 'cl)) ;;; Setup for the `c-lang-defvar' system. @@ -245,12 +245,12 @@ the evaluated constant value at compile time." (unless (listp (car-safe ops)) (setq ops (list ops))) (cond ((eq opgroup-filter t) - (setq opgroup-filter (lambda (opgroup) t))) + (setq opgroup-filter (lambda (_opgroup) t))) ((not (functionp opgroup-filter)) (setq opgroup-filter `(lambda (opgroup) (memq opgroup ',opgroup-filter))))) (cond ((eq op-filter t) - (setq op-filter (lambda (op) t))) + (setq op-filter (lambda (_op) t))) ((stringp op-filter) (setq op-filter `(lambda (op) (string-match ,op-filter op))))) @@ -474,18 +474,19 @@ so that all identifiers are recognized as words.") ;; The value here may be a list of functions or a single function. t nil c++ '(c-extend-region-for-CPP -; c-before-after-change-extend-region-for-lambda-capture ; doesn't seem needed. c-before-change-check-raw-strings c-before-change-check-<>-operators c-depropertize-CPP - c-before-after-change-digit-quote c-invalidate-macro-cache - c-truncate-bs-cache) + c-truncate-bs-cache + c-parse-quotes-before-change) (c objc) '(c-extend-region-for-CPP c-depropertize-CPP c-invalidate-macro-cache - c-truncate-bs-cache) - ;; java 'c-before-change-check-<>-operators + c-truncate-bs-cache + c-parse-quotes-before-change) + java 'c-parse-quotes-before-change + ;; 'c-before-change-check-<>-operators 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))) @@ -515,18 +516,19 @@ parameters \(point-min) and \(point-max).") t '(c-depropertize-new-text c-change-expand-fl-region) (c objc) '(c-depropertize-new-text + c-parse-quotes-after-change c-extend-font-lock-region-for-macros c-neutralize-syntax-in-and-mark-CPP c-change-expand-fl-region) c++ '(c-depropertize-new-text + c-parse-quotes-after-change c-extend-font-lock-region-for-macros -; c-before-after-change-extend-region-for-lambda-capture ; doesn't seem needed. - c-before-after-change-digit-quote c-after-change-re-mark-raw-strings c-neutralize-syntax-in-and-mark-CPP c-restore-<>-properties c-change-expand-fl-region) java '(c-depropertize-new-text + c-parse-quotes-after-change c-restore-<>-properties c-change-expand-fl-region) awk '(c-depropertize-new-text @@ -609,6 +611,12 @@ EOL terminated statements." (c c++ objc) t) (c-lang-defvar c-has-bitfields (c-lang-const c-has-bitfields)) +(c-lang-defconst c-has-quoted-numbers + "Whether the language has numbers quoted like 4'294'967'295." + t nil + c++ t) +(c-lang-defvar c-has-quoted-numbers (c-lang-const c-has-quoted-numbers)) + (c-lang-defconst c-modified-constant "Regexp that matches a “modified” constant literal such as \"L\\='a\\='\", a “long character”. In particular, this recognizes forms of constant @@ -944,6 +952,11 @@ expression, or nil if there aren't any in the language." '("defined")) pike '("defined" "efun" "constant")) +(c-lang-defconst c-cpp-expr-functions-key + ;; Matches a function in a cpp expression. + t (c-make-keywords-re t (c-lang-const c-cpp-expr-functions))) +(c-lang-defvar c-cpp-expr-functions-key (c-lang-const c-cpp-expr-functions-key)) + (c-lang-defconst c-assignment-operators "List of all assignment operators." t '("=" "*=" "/=" "%=" "+=" "-=" ">>=" "<<=" "&=" "^=" "|=") @@ -1177,6 +1190,24 @@ This regexp is assumed to not match any non-operator identifier." (make-obsolete-variable 'c-opt-op-identitier-prefix 'c-opt-op-identifier-prefix "CC Mode 5.31.4, 2006-04-14") +(c-lang-defconst c-ambiguous-overloadable-or-identifier-prefixes + ;; A list of strings which can be either overloadable operators or + ;; identifier prefixes. + t (c--intersection + (c-filter-ops (c-lang-const c-identifier-ops) + '(prefix) + t) + (c-lang-const c-overloadable-operators) + :test 'string-equal)) + +(c-lang-defconst c-ambiguous-overloadable-or-identifier-prefix-re + ;; A regexp matching strings which can be either overloadable operators + ;; or identifier prefixes. + t (c-make-keywords-re + t (c-lang-const c-ambiguous-overloadable-or-identifier-prefixes))) +(c-lang-defvar c-ambiguous-overloadable-or-identifier-prefix-re + (c-lang-const c-ambiguous-overloadable-or-identifier-prefix-re)) + (c-lang-defconst c-other-op-syntax-tokens "List of the tokens made up of characters in the punctuation or parenthesis syntax classes that have uses other than as expression @@ -1865,6 +1896,17 @@ the type of that expression." t (c-make-keywords-re t (c-lang-const c-typeof-kwds))) (c-lang-defvar c-typeof-key (c-lang-const c-typeof-key)) +(c-lang-defconst c-template-typename-kwds + "Keywords which, within a template declaration, can introduce a +declaration with a type as a default value. This is used only in +C++ Mode, e.g. \"<typename X = Y>\"." + t nil + c++ '("class" "typename")) + +(c-lang-defconst c-template-typename-key + t (c-make-keywords-re t (c-lang-const c-template-typename-kwds))) +(c-lang-defvar c-template-typename-key (c-lang-const c-template-typename-key)) + (c-lang-defconst c-type-prefix-kwds "Keywords where the following name - if any - is a type name, and where the keyword together with the symbol works as a type in @@ -2258,6 +2300,18 @@ one of `c-type-list-kwds', `c-ref-list-kwds', c++ '("private" "protected" "public") objc '("@private" "@protected" "@public")) +(c-lang-defconst c-protection-key + ;; A regexp match an element of `c-protection-kwds' cleanly. + t (c-make-keywords-re t (c-lang-const c-protection-kwds))) +(c-lang-defvar c-protection-key (c-lang-const c-protection-key)) + +(c-lang-defconst c-post-protection-token + "The token which (may) follow a protection keyword, +e.g. the \":\" in C++ Mode's \"public:\". nil if there is no such token." + t nil + c++ ":") +(c-lang-defvar c-post-protection-token (c-lang-const c-post-protection-token)) + (c-lang-defconst c-block-decls-with-vars "Keywords introducing declarations that can contain a block which might be followed by variable declarations, e.g. like \"foo\" in @@ -2844,14 +2898,7 @@ Note that Java specific rules are currently applied to tell this from left-assoc right-assoc right-assoc-sequence) - t)) - - (unambiguous-prefix-ops (c--set-difference nonkeyword-prefix-ops - in-or-postfix-ops - :test 'string-equal)) - (ambiguous-prefix-ops (c--intersection nonkeyword-prefix-ops - in-or-postfix-ops - :test 'string-equal))) + t))) (concat "\\(" diff --git a/lisp/progmodes/cc-menus.el b/lisp/progmodes/cc-menus.el index 126b419128c..7dae8297fd3 100644 --- a/lisp/progmodes/cc-menus.el +++ b/lisp/progmodes/cc-menus.el @@ -25,7 +25,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -117,7 +117,7 @@ A sample value might look like: `\\(_P\\|_PROTO\\)'.") ,(concat "^\\<" ; line MUST start with word char ;; \n added to prevent overflow in regexp matcher. - ;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-02/msg00021.html + ;; https://lists.gnu.org/r/emacs-pretest-bug/2007-02/msg00021.html "[^()\n]*" ; no parentheses before "[^" c-alnum "_:<>~]" ; match any non-identifier char "\\([" c-alpha "_][" c-alnum "_:<>~]*\\)" ; match function name diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index a501ebba256..22dea039cd1 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -25,7 +25,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -225,18 +225,7 @@ control). See \"cc-mode.el\" for more info." (defun c-make-inherited-keymap () (let ((map (make-sparse-keymap))) - ;; Necessary to use `cc-bytecomp-fboundp' below since this - ;; function is called from top-level forms that are evaluated - ;; while cc-bytecomp is active when one does M-x eval-buffer. - (cond - ;; Emacs - ((cc-bytecomp-fboundp 'set-keymap-parent) - (set-keymap-parent map c-mode-base-map)) - ;; XEmacs - ((fboundp 'set-keymap-parents) - (set-keymap-parents map c-mode-base-map)) - ;; incompatible - (t (error "CC Mode is incompatible with this version of Emacs"))) + (c-set-keymap-parent map c-mode-base-map) map)) (defun c-define-abbrev-table (name defs &optional doc) @@ -276,6 +265,8 @@ control). See \"cc-mode.el\" for more info." nil (setq c-mode-base-map (make-sparse-keymap)) + (when (boundp 'prog-mode-map) + (c-set-keymap-parent c-mode-base-map prog-mode-map)) ;; Separate M-BS from C-M-h. The former should remain ;; backward-kill-word. @@ -398,7 +389,8 @@ control). See \"cc-mode.el\" for more info." ;;(define-key c-mode-base-map "\C-c\C-v" 'c-version) ;; (define-key c-mode-base-map "\C-c\C-y" 'c-toggle-hungry-state) Commented out by ACM, 2005-11-22. (define-key c-mode-base-map "\C-c\C-w" 'c-subword-mode) - (define-key c-mode-base-map "\C-c\C-k" 'c-toggle-comment-style)) + (define-key c-mode-base-map "\C-c\C-k" 'c-toggle-comment-style) + (define-key c-mode-base-map "\C-c\C-z" 'c-display-defun-name)) ;; We don't require the outline package, but we configure it a bit anyway. (cc-bytecomp-defvar outline-level) @@ -446,27 +438,36 @@ preferably use the `c-mode-menu' language constant directly." t)))) (defun c-unfind-coalesced-tokens (beg end) - ;; unless the non-empty region (beg end) is entirely WS and there's at - ;; least one character of WS just before or after this region, remove - ;; the tokens which touch the region from `c-found-types' should they - ;; be present. - (or (c-partial-ws-p beg end) - (save-excursion - (progn - (goto-char beg) - (or (eq beg (point-min)) - (c-skip-ws-backward (1- beg)) - (/= (point) beg) - (= (c-backward-token-2) 1) - (c-unfind-type (buffer-substring-no-properties - (point) beg))) - (goto-char end) - (or (eq end (point-max)) - (c-skip-ws-forward (1+ end)) - (/= (point) end) - (progn (forward-char) (c-end-of-current-token) nil) - (c-unfind-type (buffer-substring-no-properties - end (point)))))))) + ;; If removing the region (beg end) would coalesce an identifier ending at + ;; beg with an identifier (fragment) beginning at end, or an identifier + ;; fragment ending at beg with an identifier beginning at end, remove the + ;; pertinent identifier(s) from `c-found-types'. + (save-excursion + (when (< beg end) + (goto-char beg) + (when + (and (not (bobp)) + (progn (c-backward-syntactic-ws) (eq (point) beg)) + (/= (skip-chars-backward c-symbol-chars (1- (point))) 0) + (progn (goto-char beg) (c-forward-syntactic-ws) (<= (point) end)) + (> (point) beg) + (goto-char end) + (looking-at c-symbol-char-key)) + (goto-char beg) + (c-simple-skip-symbol-backward) + (c-unfind-type (buffer-substring-no-properties (point) beg))) + + (goto-char end) + (when + (and (not (eobp)) + (progn (c-forward-syntactic-ws) (eq (point) end)) + (looking-at c-symbol-char-key) + (progn (c-backward-syntactic-ws) (>= (point) beg)) + (< (point) end) + (/= (skip-chars-backward c-symbol-chars (1- (point))) 0)) + (goto-char (1+ end)) + (c-end-of-current-token) + (c-unfind-type (buffer-substring-no-properties end (point))))))) ;; c-maybe-stale-found-type records a place near the region being ;; changed where an element of `found-types' might become stale. It @@ -927,7 +928,7 @@ Note that the style variables are always made local to the buffer." (c-clear-char-property-with-value m-beg (point) 'syntax-table '(1))))) -(defun c-extend-region-for-CPP (beg end) +(defun c-extend-region-for-CPP (_beg _end) ;; Adjust `c-new-BEG', `c-new-END' respectively to the beginning and end of ;; any preprocessor construct they may be in. ;; @@ -951,7 +952,7 @@ Note that the style variables are always made local to the buffer." (when (> (point) c-new-END) (setq c-new-END (min (point) (c-determine-+ve-limit 500 c-new-END))))) -(defun c-depropertize-new-text (beg end old-len) +(defun c-depropertize-new-text (beg end _old-len) ;; Remove from the new text in (BEG END) any and all text properties which ;; might interfere with CC Mode's proper working. ;; @@ -970,7 +971,7 @@ Note that the style variables are always made local to the buffer." (c-clear-char-properties beg end 'c-type) (c-clear-char-properties beg end 'c-awk-NL-prop)))) -(defun c-extend-font-lock-region-for-macros (begg endd old-len) +(defun c-extend-font-lock-region-for-macros (_begg endd _old-len) ;; Extend the region (c-new-BEG c-new-END) to cover all (possibly changed) ;; preprocessor macros; The return value has no significance. ;; @@ -1015,7 +1016,7 @@ Note that the style variables are always made local to the buffer." t) (t nil))))))) -(defun c-neutralize-syntax-in-and-mark-CPP (begg endd old-len) +(defun c-neutralize-syntax-in-and-mark-CPP (_begg _endd _old-len) ;; (i) "Neutralize" every preprocessor line wholly or partially in the ;; changed region. "Restore" lines which were CPP lines before the change ;; and are no longer so. @@ -1083,101 +1084,234 @@ Note that the style variables are always made local to the buffer." (forward-line)) ; no infinite loop with, e.g., "#//" ))))) -(defun c-before-after-change-digit-quote (beg end &optional old-len) - ;; This function either removes or applies the punctuation value ('(1)) of - ;; the `syntax-table' text property on single quote marks which are - ;; separator characters in long integer literals, e.g. "4'294'967'295". It - ;; applies to both decimal/octal and hex literals. (FIXME (2016-06-10): it - ;; should also apply to binary literals.) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Parsing of quotes. +;; +;; Valid digit separators in numbers will get the syntax-table "punctuation" +;; property, '(1), and also the text property `c-digit-separator' value t. +;; +;; Invalid other quotes (i.e. those not validly bounding a single character, +;; or escaped character) will get the syntax-table "punctuation" property, +;; '(1), too. +;; +;; Note that, for convenience, these properties are applied even inside +;; comments and strings. + +(defconst c-maybe-quoted-number-head + (concat + "\\(0\\(" + "\\([Xx]\\([0-9a-fA-F]\\('[0-9a-fA-F]\\|[0-9a-fA-F]\\)*'?\\)?\\)" + "\\|" + "\\([Bb]\\([01]\\('[01]\\|[01]\\)*'?\\)?\\)" + "\\|" + "\\('[0-7]\\|[0-7]\\)*'?" + "\\)" + "\\|" + "[1-9]\\('[0-9]\\|[0-9]\\)*'?" + "\\)") + "Regexp matching the head of a numeric literal, including with digit separators.") + +(defun c-quoted-number-head-before-point () + ;; Return non-nil when the head of a possibly quoted number is found + ;; immediately before point. The value returned in this case is the buffer + ;; position of the start of the head. That position is also in + ;; (match-beginning 0). + (when c-has-quoted-numbers + (save-excursion + (let ((here (point)) + found) + (skip-chars-backward "0-9a-fA-F'") + (if (and (memq (char-before) '(?x ?X)) + (eq (char-before (1- (point))) ?0)) + (backward-char 2)) + (while + (and + (setq found + (search-forward-regexp c-maybe-quoted-number-head here t)) + (< found here))) + (and (eq found here) (match-beginning 0)))))) + +(defconst c-maybe-quoted-number-tail + (concat + "\\(" + "\\([xX']?[0-9a-fA-F]\\('[0-9a-fA-F]\\|[0-9a-fA-F]\\)*\\)" + "\\|" + "\\([bB']?[01]\\('[01]\\|[01]\\)*\\)" + "\\|" + "\\('?[0-9]\\('[0-9]\\|[0-9]\\)*\\)" + "\\)") + "Regexp matching the tail of a numeric literal, including with digit separators. +Note that this is a strict tail, so won't match, e.g. \"0x....\".") + +(defun c-quoted-number-tail-after-point () + ;; Return non-nil when a proper tail of a possibly quoted number is found + ;; immediately after point. The value returned in this case is the buffer + ;; position of the end of the tail. That position is also in (match-end 0). + (when c-has-quoted-numbers + (and (looking-at c-maybe-quoted-number-tail) + (match-end 0)))) + +(defconst c-maybe-quoted-number + (concat + "\\(0\\(" + "\\([Xx][0-9a-fA-F]\\('[0-9a-fA-F]\\|[0-9a-fA-F]\\)*\\)" + "\\|" + "\\([Bb][01]\\('[01]\\|[01]\\)*\\)" + "\\|" + "\\('[0-7]\\|[0-7]\\)*" + "\\)" + "\\|" + "[1-9]\\('[0-9]\\|[0-9]\\)*" + "\\)") + "Regexp matching a numeric literal, including with digit separators.") + +(defun c-quoted-number-straddling-point () + ;; Return non-nil if a definitely quoted number starts before point and ends + ;; after point. In this case the number is bounded by (match-beginning 0) + ;; and (match-end 0). + (when c-has-quoted-numbers + (save-excursion + (let ((here (point)) + (bound (progn (skip-chars-forward "0-9a-fA-F'") (point)))) + (goto-char here) + (when (< (skip-chars-backward "0-9a-fA-F'") 0) + (if (and (memq (char-before) '(?x ?X)) + (eq (char-before (1- (point))) ?0)) + (backward-char 2)) + (while (and (search-forward-regexp c-maybe-quoted-number bound t) + (<= (match-end 0) here))) + (and (< (match-beginning 0) here) + (> (match-end 0) here) + (save-match-data + (goto-char (match-beginning 0)) + (save-excursion (search-forward "'" (match-end 0) t))))))))) + +(defun c-parse-quotes-before-change (beg end) + ;; This function analyzes 's near the region (c-new-BEG c-new-END), amending + ;; those two variables as needed to include 's into that region when they + ;; might be syntactically relevant to the change in progress. ;; - ;; In both uses of the function, the `syntax-table' properties are - ;; removed/applied only on quote marks which appear to be digit separators. + ;; Having amended that region, the function removes pertinent text + ;; properties (syntax-table properties with value '(1) and c-digit-separator + ;; props with value t) from 's in it. This operation is performed even + ;; within strings and comments. ;; - ;; Point is undefined on both entry and exit to this function, and the - ;; return value has no significance. The function is called solely as a - ;; before-change function (see `c-get-state-before-change-functions') and as - ;; an after change function (see `c-before-font-lock-functions', with the - ;; parameters BEG, END, and (optionally) OLD-LEN being given the standard - ;; values for before/after-change functions. - (c-save-buffer-state ((num-begin c-new-BEG) digit-re try-end) + ;; This function is called exclusively as a before-change function via the + ;; variable `c-get-state-before-change-functions'. + (c-save-buffer-state () + (goto-char c-new-BEG) + ;; We need to scan for 's from the BO (logical) line. + (beginning-of-line) + (while (eq (char-before (1- (point))) ?\\) + (beginning-of-line 0)) + (while (and (< (point) c-new-BEG) + (search-forward "'" c-new-BEG t)) + (cond + ((c-quoted-number-straddling-point) + (goto-char (match-end 0)) + (if (> (match-end 0) c-new-BEG) + (setq c-new-BEG (match-beginning 0)))) + ((c-quoted-number-head-before-point) + (if (>= (point) c-new-BEG) + (setq c-new-BEG (match-beginning 0)))) + ((looking-at "\\([^'\\]\\|\\\\.\\)'") + (goto-char (match-end 0)) + (if (> (match-end 0) c-new-BEG) + (setq c-new-BEG (1- (match-beginning 0))))) + ((or (>= (point) (1- c-new-BEG)) + (and (eq (point) (- c-new-BEG 2)) + (eq (char-after) ?\\))) + (setq c-new-BEG (1- (point)))) + (t nil))) + + (goto-char c-new-END) + ;; We will scan from the BO (logical) line. + (beginning-of-line) + (while (eq (char-before (1- (point))) ?\\) + (beginning-of-line 0)) + (while (and (< (point) c-new-END) + (search-forward "'" c-new-END t)) + (cond + ((c-quoted-number-straddling-point) + (goto-char (match-end 0)) + (if (> (match-end 0) c-new-END) + (setq c-new-END (match-end 0)))) + ((c-quoted-number-tail-after-point) + (goto-char (match-end 0)) + (if (> (match-end 0) c-new-END) + (setq c-new-END (match-end 0)))) + ((looking-at "\\([^'\\]\\|\\\\.\\)'") + (goto-char (match-end 0)) + (if (> (match-end 0) c-new-END) + (setq c-new-END (match-end 0)))) + (t nil))) + ;; Having reached c-new-END, handle any 's after it whose context may be + ;; changed by the current buffer change. (goto-char c-new-END) - (when (looking-at "\\(x\\)?[0-9a-fA-F']+") + (cond + ((c-quoted-number-tail-after-point) (setq c-new-END (match-end 0))) - (goto-char c-new-BEG) - (when (looking-at "\\(x?\\)[0-9a-fA-F']") - (if (re-search-backward "\\(0x\\)?[0-9a-fA-F]*\\=" nil t) - (setq c-new-BEG (point)))) + ((looking-at + "\\(\\\\.\\|.\\)?\\('\\([^'\\]\\|\\\\.\\)\\)*'") + (setq c-new-END (match-end 0)))) - (while - (re-search-forward "[0-9a-fA-F]'[0-9a-fA-F]" c-new-END t) - (setq try-end (1- (point))) - (re-search-backward "[^0-9a-fA-F']" num-begin t) - (setq digit-re - (cond - ((and (not (bobp)) (eq (char-before) ?0) (memq (char-after) '(?x ?X))) - "[0-9a-fA-F]") - ((and (eq (char-after (1+ (point))) ?0) - (memq (char-after (+ 2 (point))) '(?b ?B))) - "[01]") - ((memq (char-after (1+ (point))) '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) - "[0-9]") - (t nil))) - (when digit-re - (cond ((eq (char-after) ?x) (forward-char)) - ((looking-at ".?0[Bb]") (goto-char (match-end 0))) - ((looking-at digit-re)) - (t (forward-char))) - (when (not (c-in-literal)) - (let ((num-end ; End of valid sequence of digits/quotes. - (save-excursion - (re-search-forward - (concat "\\=\\(" digit-re "+'\\)*" digit-re "+") nil t) - (point)))) - (setq try-end ; End of sequence of digits/quotes - (save-excursion - (re-search-forward - (concat "\\=\\(" digit-re "\\|'\\)+") nil t) - (point))) - (while (re-search-forward - (concat digit-re "\\('\\)" digit-re) num-end t) - (if old-len ; i.e. are we in an after-change function? - (c-put-char-property (match-beginning 1) 'syntax-table '(1)) - (c-clear-char-property (match-beginning 1) 'syntax-table)) - (backward-char))))) - (goto-char try-end) - (setq num-begin (point))))) - -;; The following doesn't seem needed at the moment (2016-08-15). -;; (defun c-before-after-change-extend-region-for-lambda-capture -;; (_beg _end &optional _old-len) -;; ;; In C++ Mode, extend the region (c-new-BEG c-new-END) to cover any lambda -;; ;; function capture lists we happen to be inside. This function is expected -;; ;; to be called both as a before-change and after change function. -;; ;; -;; ;; Note that these things _might_ be nested, with a capture list looking -;; ;; like: -;; ;; -;; ;; [ ...., &foo = [..](){...}(..), ... ] -;; ;; -;; ;; . What a wonderful language is C++. ;-) -;; (c-save-buffer-state (paren-state pos) -;; (goto-char c-new-BEG) -;; (setq paren-state (c-parse-state)) -;; (while (setq pos (c-pull-open-brace paren-state)) -;; (goto-char pos) -;; (when (c-looking-at-c++-lambda-capture-list) -;; (setq c-new-BEG (min c-new-BEG pos)) -;; (if (c-go-list-forward) -;; (setq c-new-END (max c-new-END (point)))))) - -;; (goto-char c-new-END) -;; (setq paren-state (c-parse-state)) -;; (while (setq pos (c-pull-open-brace paren-state)) -;; (goto-char pos) -;; (when (c-looking-at-c++-lambda-capture-list) -;; (setq c-new-BEG (min c-new-BEG pos)) -;; (if (c-go-list-forward) -;; (setq c-new-END (max c-new-END (point)))))))) + ;; Remove the '(1) syntax-table property from any "'"s within (c-new-BEG + ;; c-new-END). + (goto-char c-new-BEG) + (when (c-search-forward-char-property-with-value-on-char + 'syntax-table '(1) ?\' c-new-END) + (c-invalidate-state-cache (1- (point))) + (c-truncate-semi-nonlit-pos-cache (1- (point))) + (c-clear-char-property-with-value-on-char + (1- (point)) c-new-END + 'syntax-table '(1) + ?') + ;; Remove the c-digit-separator text property from the same "'"s. + (when c-has-quoted-numbers + (c-clear-char-property-with-value-on-char + (1- (point)) c-new-END + 'c-digit-separator t + ?'))))) + +(defun c-parse-quotes-after-change (beg end old-len) + ;; This function applies syntax-table properties (value '(1)) and + ;; c-digit-separator properties as needed to 's within the range (c-new-BEG + ;; c-new-END). This operation is performed even within strings and + ;; comments. + ;; + ;; This function is called exclusively as an after-change function via the + ;; variable `c-before-font-lock-functions'. + (c-save-buffer-state (num-beg num-end) + ;; Apply the needed syntax-table and c-digit-separator text properties to + ;; quotes. + (save-restriction + (goto-char c-new-BEG) + (while (and (< (point) c-new-END) + (search-forward "'" c-new-END 'limit)) + (cond ((and (eq (char-before (1- (point))) ?\\) + ;; Check we've got an odd number of \s, here. + (save-excursion + (backward-char) + (eq (logand (skip-chars-backward "\\\\") 1) 1)))) ; not a real '. + ((c-quoted-number-straddling-point) + (setq num-beg (match-beginning 0) + num-end (match-end 0)) + (c-invalidate-state-cache num-beg) + (c-truncate-semi-nonlit-pos-cache num-beg) + (c-put-char-properties-on-char num-beg num-end + 'syntax-table '(1) ?') + (c-put-char-properties-on-char num-beg num-end + 'c-digit-separator t ?') + (goto-char num-end)) + ((looking-at "\\([^\\']\\|\\\\.\\)'") ; balanced quoted expression. + (goto-char (match-end 0))) + (t + (c-invalidate-state-cache (1- (point))) + (c-truncate-semi-nonlit-pos-cache (1- (point))) + (c-put-char-property (1- (point)) 'syntax-table '(1)))) + ;; Prevent the next `c-quoted-number-straddling-point' getting + ;; confused by already processed single quotes. + (narrow-to-region (point) (point-max)))))) (defun c-before-change (beg end) ;; Function to be put on `before-change-functions'. Primarily, this calls @@ -1393,14 +1527,17 @@ Note that the style variables are always made local to the buffer." (> (point) bod-lim) (progn (c-forward-syntactic-ws) (setq bo-decl (point)) - ;; Are we looking at a keyword such as "template" or - ;; "typedef" which can decorate a type, or the type itself? - (when (or (looking-at c-prefix-spec-kwds-re) - (c-forward-type t)) - ;; We've found another candidate position. - (setq new-pos (min new-pos bo-decl)) - (goto-char bo-decl)) - t) + (or (not (looking-at c-protection-key)) + (c-forward-keyword-clause 1))) + (progn + ;; Are we looking at a keyword such as "template" or + ;; "typedef" which can decorate a type, or the type itself? + (when (or (looking-at c-prefix-spec-kwds-re) + (c-forward-type t)) + ;; We've found another candidate position. + (setq new-pos (min new-pos bo-decl)) + (goto-char bo-decl)) + t) ;; Try and go out a level to search again. (progn (c-backward-syntactic-ws bod-lim) @@ -1421,6 +1558,26 @@ Note that the style variables are always made local to the buffer." (setq new-pos capture-opener)) (and (/= new-pos pos) new-pos))) +(defun c-fl-decl-end (pos) + ;; If POS is inside a declarator, return the end of the token that follows + ;; the declarator, otherwise return nil. + (goto-char pos) + (let ((lit-start (c-literal-start)) + pos1) + (if lit-start (goto-char lit-start)) + (c-backward-syntactic-ws) + (when (setq pos1 (c-on-identifier)) + (goto-char pos1) + (let ((lim (save-excursion + (and (c-beginning-of-macro) + (progn (c-end-of-macro) (point)))))) + (when (and (c-forward-declarator lim) + (or (not (eq (char-after) ?\()) + (c-go-list-forward nil lim)) + (eq (c-forward-token-2 1 nil lim) 0)) + (c-backward-syntactic-ws) + (point)))))) + (defun c-change-expand-fl-region (_beg _end _old-len) ;; Expand the region (c-new-BEG c-new-END) to an after-change font-lock ;; region. This will usually be the smallest sequence of whole lines @@ -1434,18 +1591,16 @@ Note that the style variables are always made local to the buffer." (setq c-new-BEG (or (c-fl-decl-start c-new-BEG) (c-point 'bol c-new-BEG)) c-new-END - (save-excursion - (goto-char c-new-END) - (if (bolp) - (point) - (c-point 'bonl c-new-END)))))) + (or (c-fl-decl-end c-new-END) + (c-point 'bonl c-new-END))))) (defun c-context-expand-fl-region (beg end) ;; Return a cons (NEW-BEG . NEW-END), where NEW-BEG is the beginning of a ;; "local" declaration containing BEG (see `c-fl-decl-start') or BOL BEG is ;; in. NEW-END is beginning of the line after the one END is in. - (cons (or (c-fl-decl-start beg) (c-point 'bol beg)) - (c-point 'bonl end))) + (c-save-buffer-state () + (cons (or (c-fl-decl-start beg) (c-point 'bol beg)) + (or (c-fl-decl-end end) (c-point 'bonl (1- end)))))) (defun c-before-context-fl-expand-region (beg end) ;; Expand the region (BEG END) as specified by @@ -1704,7 +1859,7 @@ Key bindings: ;;;###autoload (defun c-or-c++-mode () - "Analyse buffer and enable either C or C++ mode. + "Analyze buffer and enable either C or C++ mode. Some people and projects use .h extension for C++ header files which is also the one used for C header files. This makes diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el index b3848a74f97..1a8d90bacd3 100644 --- a/lisp/progmodes/cc-styles.el +++ b/lisp/progmodes/cc-styles.el @@ -26,7 +26,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -47,6 +47,7 @@ ;; `c-add-style' often contains references to functions defined there. ;; Silence the compiler. +(cc-bytecomp-defun c-guess-basic-syntax) (cc-bytecomp-defvar adaptive-fill-first-line-regexp) ; Emacs diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index ccd4fd29940..c4213797636 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -26,7 +26,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -87,7 +87,7 @@ use c-constant-symbol instead." :value nil :tag "Symbol" :format "%t: %v\n%d" - :match (lambda (widget value) (symbolp value)) + :match (lambda (_widget value) (symbolp value)) :value-to-internal (lambda (widget value) (let ((s (if (symbolp value) @@ -98,7 +98,7 @@ use c-constant-symbol instead." (setq s (concat s (make-string (- l (length s)) ?\ )))) s)) :value-to-external - (lambda (widget value) + (lambda (_widget value) (if (stringp value) (intern (progn (string-match "\\`[^ ]*" value) @@ -109,14 +109,14 @@ use c-constant-symbol instead." "An integer or the value nil." :value nil :tag "Optional integer" - :match (lambda (widget value) (or (integerp value) (null value)))) + :match (lambda (_widget value) (or (integerp value) (null value)))) (define-widget 'c-symbol-list 'sexp "A single symbol or a list of symbols." :tag "Symbols separated by spaces" :validate 'widget-field-validate :match - (lambda (widget value) + (lambda (_widget value) (or (symbolp value) (catch 'ok (while (listp value) @@ -125,7 +125,7 @@ use c-constant-symbol instead." (setq value (cdr value))) (null value)))) :value-to-internal - (lambda (widget value) + (lambda (_widget value) (cond ((null value) "") ((symbolp value) @@ -138,7 +138,7 @@ use c-constant-symbol instead." (t value))) :value-to-external - (lambda (widget value) + (lambda (_widget value) (if (stringp value) (let (list end) (while (string-match "\\S +" value end) @@ -167,7 +167,7 @@ use c-constant-symbol instead." (defmacro defcustom-c-stylevar (name val doc &rest args) "Define a style variable NAME with VAL and DOC. More precisely, convert the given `:type FOO', mined out of ARGS, -to an aggregate `:type (radio STYLE (PREAMBLE FOO))', append some +to an aggregate `:type (radio STYLE (PREAMBLE FOO))', append some boilerplate documentation to DOC, arrange for the fallback value of NAME to be VAL, and call `custom-declare-variable' to do the rest of the work. @@ -1227,8 +1227,8 @@ As described below, each cons cell in this list has the form: When a line is indented, CC Mode first determines the syntactic context of it by generating a list of symbols called syntactic -elements. The global variable `c-syntactic-context' is bound to the -that list. Each element in the list is in turn a list where the first +elements. The global variable `c-syntactic-context' is bound to that +list. Each element in the list is in turn a list where the first element is a syntactic symbol which tells what kind of construct the indentation point is located within. More elements in the syntactic element lists are optional. If there is one more and it isn't nil, diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el index 5bc7b660633..10881cda527 100644 --- a/lisp/progmodes/cfengine.el +++ b/lisp/progmodes/cfengine.el @@ -20,7 +20,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el index cafd5acb37a..883515e8fc2 100644 --- a/lisp/progmodes/cmacexp.el +++ b/lisp/progmodes/cmacexp.el @@ -27,7 +27,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 31ec5a67d03..4cce47e5d8c 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -21,7 +21,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -127,7 +127,21 @@ and a string describing how the process finished.") (defvar compilation-arguments nil "Arguments that were given to `compilation-start'.") -(defvar compilation-num-errors-found) +(defvar compilation-num-errors-found 0) +(defvar compilation-num-warnings-found 0) +(defvar compilation-num-infos-found 0) + +(defconst compilation-mode-line-errors + '(" [" (:propertize (:eval (int-to-string compilation-num-errors-found)) + face compilation-error + help-echo "Number of errors so far") + " " (:propertize (:eval (int-to-string compilation-num-warnings-found)) + face compilation-warning + help-echo "Number of warnings so far") + " " (:propertize (:eval (int-to-string compilation-num-infos-found)) + face compilation-info + help-echo "Number of informational messages so far") + "]")) ;; If you make any changes to `compilation-error-regexp-alist-alist', ;; be sure to run the ERT test in test/lisp/progmodes/compile-tests.el. @@ -886,10 +900,20 @@ from a different message." :group 'compilation :version "22.1") +(defun compilation-type (type) + (or (and (car type) (match-end (car type)) 1) + (and (cdr type) (match-end (cdr type)) 0) + 2)) + (defun compilation-face (type) - (or (and (car type) (match-end (car type)) compilation-warning-face) - (and (cdr type) (match-end (cdr type)) compilation-info-face) - compilation-error-face)) + (let ((typ (compilation-type type))) + (cond + ((eq typ 1) + compilation-warning-face) + ((eq typ 0) + compilation-info-face) + ((eq typ 2) + compilation-error-face)))) ;; LOC (or location) is a list of (COLUMN LINE FILE-STRUCTURE nil nil) @@ -1334,6 +1358,14 @@ FMTS is a list of format specs for transforming the file name. (compilation-parse-errors start end))) +(defun compilation--note-type (type) + "Note that a new message with severity TYPE was seen. +This updates the appropriate variable used by the mode-line." + (cl-case type + (0 (cl-incf compilation-num-infos-found)) + (1 (cl-incf compilation-num-warnings-found)) + (2 (cl-incf compilation-num-errors-found)))) + (defun compilation-parse-errors (start end &rest rules) "Parse errors between START and END. The errors recognized are the ones specified in RULES which default @@ -1397,14 +1429,17 @@ to `compilation-error-regexp-alist' if RULES is nil." file line end-line col end-col (or type 2) fmt)) (when (integerp file) + (setq type (if (consp type) + (compilation-type type) + (or type 2))) + (compilation--note-type type) + (compilation--put-prop file 'font-lock-face - (if (consp type) - (compilation-face type) - (symbol-value (aref [compilation-info-face - compilation-warning-face - compilation-error-face] - (or type 2)))))) + (symbol-value (aref [compilation-info-face + compilation-warning-face + compilation-error-face] + type)))) (compilation--put-prop line 'font-lock-face compilation-line-face) @@ -1705,7 +1740,7 @@ Returns the compilation buffer created." (setq thisdir default-directory)) (set-buffer-modified-p nil)) ;; Pop up the compilation buffer. - ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01638.html + ;; https://lists.gnu.org/r/emacs-devel/2007-11/msg01638.html (setq outwin (display-buffer outbuf '(nil (allow-no-window . t)))) (with-current-buffer outbuf (let ((process-environment @@ -1768,7 +1803,8 @@ Returns the compilation buffer created." outbuf command)))) ;; Make the buffer's mode line show process state. (setq mode-line-process - '(:propertize ":%s" face compilation-mode-line-run)) + '((:propertize ":%s" face compilation-mode-line-run) + compilation-mode-line-errors)) ;; Set the process as killable without query by default. ;; This allows us to start a new compilation without @@ -1797,7 +1833,8 @@ Returns the compilation buffer created." (message "Executing `%s'..." command) ;; Fake mode line display as if `start-process' were run. (setq mode-line-process - '(:propertize ":run" face compilation-mode-line-run)) + '((:propertize ":run" face compilation-mode-line-run) + compilation-mode-line-errors)) (force-mode-line-update) (sit-for 0) ; Force redisplay (save-excursion @@ -2106,6 +2143,9 @@ Optional argument MINOR indicates this is called from (make-local-variable 'compilation-messages-start) (make-local-variable 'compilation-error-screen-columns) (make-local-variable 'overlay-arrow-position) + (setq-local compilation-num-errors-found 0) + (setq-local compilation-num-warnings-found 0) + (setq-local compilation-num-infos-found 0) (set (make-local-variable 'overlay-arrow-string) "") (setq next-error-overlay-arrow-position nil) (add-hook 'kill-buffer-hook @@ -2195,16 +2235,18 @@ commands of Compilation major mode are available. See (add-text-properties omax (point) (append '(compilation-handle-exit t) nil)) (setq mode-line-process - (let ((out-string (format ":%s [%s]" process-status (cdr status))) - (msg (format "%s %s" mode-name - (replace-regexp-in-string "\n?$" "" - (car status))))) - (message "%s" msg) - (propertize out-string - 'help-echo msg - 'face (if (> exit-status 0) - 'compilation-mode-line-fail - 'compilation-mode-line-exit)))) + (list + (let ((out-string (format ":%s [%s]" process-status (cdr status))) + (msg (format "%s %s" mode-name + (replace-regexp-in-string "\n?$" "" + (car status))))) + (message "%s" msg) + (propertize out-string + 'help-echo msg + 'face (if (> exit-status 0) + 'compilation-mode-line-fail + 'compilation-mode-line-exit))) + compilation-mode-line-errors)) ;; Force mode line redisplay soon. (force-mode-line-update) (if (and opoint (< opoint omax)) @@ -2286,7 +2328,7 @@ and runs `compilation-filter-hook'." (while (,< n 0) (setq opt pt) (or (setq pt (,property-change pt 'compilation-message)) - ;; Handle the case where where the first error message is + ;; Handle the case where the first error message is ;; at the start of the buffer, and n < 0. (if (or (eq (get-text-property ,limit 'compilation-message) (get-text-property opt 'compilation-message)) @@ -2813,7 +2855,7 @@ TRUE-DIRNAME is the `file-truename' of DIRNAME, if given." ;; The gethash used to not use spec-directory, but ;; this leads to errors when files in different ;; directories have the same name: - ;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00463.html + ;; https://lists.gnu.org/r/emacs-devel/2007-08/msg00463.html (or (gethash (cons filename spec-directory) compilation-locs) (puthash (cons filename spec-directory) (compilation--make-file-struct diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index c0f1aaf39d4..e6ab8c4ea60 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -20,7 +20,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Corrections made by Ilya Zakharevich ilyaz@cpan.org @@ -480,7 +480,7 @@ Font for POD headers." (defcustom cperl-highlight-variables-indiscriminately nil "Non-nil means perform additional highlighting on variables. Currently only changes how scalar variables are highlighted. -Note that that variable is only read at initialization time for +Note that the variable is only read at initialization time for the variable `cperl-font-lock-keywords-2', so changing it after you've entered CPerl mode the first time will have no effect." :type 'boolean @@ -701,24 +701,7 @@ This way enabling/disabling of menu items is more correct." ;;; Short extra-docs. (defvar cperl-tips 'please-ignore-this-line - "Get maybe newer version of this package from - http://ilyaz.org/software/emacs -Subdirectory `cperl-mode' may contain yet newer development releases and/or -patches to related files. - -For best results apply to an older Emacs the patches from - ftp://ftp.math.ohio-state.edu/pub/users/ilya/cperl-mode/patches -\(this upgrades syntax-parsing abilities of Emacsen v19.34 and -v20.2 up to the level of Emacs v20.3 - a must for a good Perl -mode.) As of beginning of 2003, XEmacs may provide a similar ability. - -Get support packages choose-color.el (or font-lock-extra.el before -19.30), imenu-go.el from the same place. \(Look for other files there -too... ;-). Get a patch for imenu.el in 19.29. Note that for 19.30 and -later you should use choose-color.el *instead* of font-lock-extra.el -\(and you will not get smart highlighting in C :-(). - -Note that to enable Compile choices in the menu you need to install + "Note that to enable Compile choices in the menu you need to install mode-compile.el. If your Emacs does not default to `cperl-mode' on Perl files, and you @@ -1913,7 +1896,9 @@ or as help on variables `cperl-tips', `cperl-problems', (if cperl-pod-here-scan (or cperl-syntaxify-by-font-lock (progn (or cperl-faces-init (cperl-init-faces-weak)) - (cperl-find-pods-heres))))) + (cperl-find-pods-heres)))) + ;; Setup Flymake + (add-hook 'flymake-diagnostic-functions 'perl-flymake nil t)) ;; Fix for perldb - make default reasonable (defun cperl-db () @@ -2331,7 +2316,7 @@ to nil." nil t)))) ; Only one (progn (forward-word-strictly 1) - (setq name (file-name-base) + (setq name (file-name-base (buffer-file-name)) p (point)) (insert " NAME\n\n" name " - \n\n=head1 SYNOPSIS\n\n\n\n" @@ -3734,7 +3719,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', "\\(\\`\n?\\|^\n\\)=" ; POD "\\|" ;; One extra () before this: - "<<" ; HERE-DOC + "<<~?" ; HERE-DOC "\\(" ; 1 + 1 ;; First variant "BLAH" or just ``. "[ \t]*" ; Yes, whitespace is allowed! @@ -4000,7 +3985,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (setq b (point)) ;; We do not search to max, since we may be called from ;; some hook of fontification, and max is random - (or (and (re-search-forward (concat "^" qtag "$") + (or (and (re-search-forward (concat "^[ \t]*" qtag "$") stop-point 'toend) ;;;(eq (following-char) ?\n) ; XXXX WHY??? ) diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el index e35a76e38cd..f49c8e934a5 100644 --- a/lisp/progmodes/cpp.el +++ b/lisp/progmodes/cpp.el @@ -18,7 +18,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -568,6 +568,14 @@ You can also use the keyboard accelerators indicated like this: [K]ey." (set-window-start nil start) (goto-char pos))) +(defun cpp-locate-user-emacs-file (file) + (locate-user-emacs-file + ;; Remove initial '.' from file. + (if (eq (aref file 0) ?.) + (substring file 1) + file) + file)) + (defun cpp-edit-load () "Load cpp configuration." (interactive) @@ -576,8 +584,8 @@ You can also use the keyboard accelerators indicated like this: [K]ey." nil) ((file-readable-p cpp-config-file) (load-file cpp-config-file)) - ((file-readable-p (concat "~/" cpp-config-file)) - (load-file cpp-config-file))) + ((file-readable-p (cpp-locate-user-emacs-file cpp-config-file)) + (load-file (cpp-locate-user-emacs-file cpp-config-file)))) (if (derived-mode-p 'cpp-edit-mode) (cpp-edit-reset))) @@ -586,7 +594,10 @@ You can also use the keyboard accelerators indicated like this: [K]ey." (interactive) (require 'pp) (with-current-buffer cpp-edit-buffer - (let ((buffer (find-file-noselect cpp-config-file))) + (let* ((config-file (if (file-writable-p cpp-config-file) + cpp-config-file + (cpp-locate-user-emacs-file cpp-config-file))) + (buffer (find-file-noselect config-file))) (set-buffer buffer) (erase-buffer) (pp (list 'setq 'cpp-known-face @@ -601,7 +612,7 @@ You can also use the keyboard accelerators indicated like this: [K]ey." (list 'quote cpp-unknown-writable)) buffer) (pp (list 'setq 'cpp-edit-list (list 'quote cpp-edit-list)) buffer) - (write-file cpp-config-file)))) + (write-file config-file)))) (defun cpp-edit-home () "Switch back to original buffer." diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el index 1c6905a38fe..4b28d5a82aa 100644 --- a/lisp/progmodes/cwarn.el +++ b/lisp/progmodes/cwarn.el @@ -19,7 +19,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el index eb0850e4ec2..6681af55858 100644 --- a/lisp/progmodes/dcl-mode.el +++ b/lisp/progmodes/dcl-mode.el @@ -19,7 +19,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/ebnf-abn.el b/lisp/progmodes/ebnf-abn.el index a3780eb70f4..937f9881ce9 100644 --- a/lisp/progmodes/ebnf-abn.el +++ b/lisp/progmodes/ebnf-abn.el @@ -2,8 +2,8 @@ ;; Copyright (C) 2001-2017 Free Software Foundation, Inc. -;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> +;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: wp, ebnf, PostScript ;; Old-Version: 1.2 ;; Package: ebnf2ps @@ -21,7 +21,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/ebnf-bnf.el b/lisp/progmodes/ebnf-bnf.el index a257d391bf5..9cad4e5f2b6 100644 --- a/lisp/progmodes/ebnf-bnf.el +++ b/lisp/progmodes/ebnf-bnf.el @@ -2,8 +2,8 @@ ;; Copyright (C) 1999-2017 Free Software Foundation, Inc. -;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> +;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: wp, ebnf, PostScript ;; Old-Version: 1.10 ;; Package: ebnf2ps @@ -21,7 +21,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/ebnf-dtd.el b/lisp/progmodes/ebnf-dtd.el index 2bea9547a1f..ee9f7b14e9b 100644 --- a/lisp/progmodes/ebnf-dtd.el +++ b/lisp/progmodes/ebnf-dtd.el @@ -2,8 +2,8 @@ ;; Copyright (C) 2001-2017 Free Software Foundation, Inc. -;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> +;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: wp, ebnf, PostScript ;; Old-Version: 1.1 ;; Package: ebnf2ps @@ -21,7 +21,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/ebnf-ebx.el b/lisp/progmodes/ebnf-ebx.el index 84c67df63fa..6d1e761a1a5 100644 --- a/lisp/progmodes/ebnf-ebx.el +++ b/lisp/progmodes/ebnf-ebx.el @@ -2,8 +2,8 @@ ;; Copyright (C) 2001-2017 Free Software Foundation, Inc. -;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> +;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: wp, ebnf, PostScript ;; Old-Version: 1.2 ;; Package: ebnf2ps @@ -21,7 +21,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/ebnf-iso.el b/lisp/progmodes/ebnf-iso.el index 8847c401508..61a3479a5c3 100644 --- a/lisp/progmodes/ebnf-iso.el +++ b/lisp/progmodes/ebnf-iso.el @@ -2,8 +2,8 @@ ;; Copyright (C) 1999-2017 Free Software Foundation, Inc. -;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> +;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: wp, ebnf, PostScript ;; Old-Version: 1.9 ;; Package: ebnf2ps @@ -21,7 +21,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/ebnf-otz.el b/lisp/progmodes/ebnf-otz.el index 31dfd95e941..f77959e4ca2 100644 --- a/lisp/progmodes/ebnf-otz.el +++ b/lisp/progmodes/ebnf-otz.el @@ -2,8 +2,8 @@ ;; Copyright (C) 1999-2017 Free Software Foundation, Inc. -;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> +;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: wp, ebnf, PostScript ;; Old-Version: 1.0 ;; Package: ebnf2ps @@ -21,7 +21,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/ebnf-yac.el b/lisp/progmodes/ebnf-yac.el index 3aa02a8e0fa..d8916ee4c0d 100644 --- a/lisp/progmodes/ebnf-yac.el +++ b/lisp/progmodes/ebnf-yac.el @@ -2,8 +2,8 @@ ;; Copyright (C) 1999-2017 Free Software Foundation, Inc. -;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> +;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: wp, ebnf, PostScript ;; Old-Version: 1.4 ;; Package: ebnf2ps @@ -21,7 +21,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el index a8229df4aeb..e40104353ac 100644 --- a/lisp/progmodes/ebnf2ps.el +++ b/lisp/progmodes/ebnf2ps.el @@ -1,9 +1,9 @@ -;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript +;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript -*- lexical-binding:t -*- ;; Copyright (C) 1999-2017 Free Software Foundation, Inc. -;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> +;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com> ;; Keywords: wp, ebnf, PostScript ;; Version: 4.4 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre @@ -21,7 +21,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. (defconst ebnf-version "4.4" "ebnf2ps.el, v 4.4 <2007/02/12 vinicius> @@ -30,8 +30,7 @@ Vinicius's last change version. When reporting bugs, please also report the version of Emacs, if any, that ebnf2ps was running with. Please send all bug fixes and enhancements to - Vinicius Jose Latorre <viniciusjl@ig.com.br>. -") + Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>.") ;;; Commentary: @@ -1136,7 +1135,7 @@ Please send all bug fixes and enhancements to ;; Thanks to Drew Adams <drew.adams@oracle.com> for suggestions: ;; - `ebnf-arrow-extra-width', `ebnf-arrow-scale', ;; `ebnf-production-name-p', `ebnf-stop-on-error', -;; `ebnf-file-suffix-regexp'and `ebnf-special-show-delimiter' variables. +;; `ebnf-file-suffix-regexp' and `ebnf-special-show-delimiter' variables. ;; - `ebnf-delete-style', `ebnf-eps-file' and `ebnf-eps-directory' ;; commands. ;; - some docs fix. @@ -1154,6 +1153,7 @@ Please send all bug fixes and enhancements to (require 'ps-print) +(eval-when-compile (require 'cl-lib)) (and (string< ps-print-version "5.2.3") (error "`ebnf2ps' requires `ps-print' package version 5.2.3 or later")) @@ -2047,8 +2047,7 @@ It must be a float between 0.0 (top) and 1.0 (bottom)." (defcustom ebnf-default-width 0.6 - "Specify additional border width over default terminal, non-terminal or -special." + "Additional border width over default terminal, non-terminal or special." :type 'number :version "20" :group 'ebnf2ps) @@ -2252,7 +2251,7 @@ See also `ebnf-print-buffer'." (defun ebnf-print-buffer (&optional filename) "Generate and print a PostScript syntactic chart image of the buffer. -When called with a numeric prefix argument (C-u), prompts the user for +When called with a numeric prefix argument (\\[universal-argument]), prompts the user for the name of a file to save the PostScript image in, instead of sending it to the printer. @@ -2383,6 +2382,7 @@ WARNING: This function does *NOT* ask any confirmation to override existing (ebnf-log-header "(ebnf-eps-buffer)") (ebnf-eps-region (point-min) (point-max))) +(defvar ebnf-eps-executing) ;;;###autoload (defun ebnf-eps-region (from to) @@ -2411,7 +2411,7 @@ WARNING: This function does *NOT* ask any confirmation to override existing ;;;###autoload -(defalias 'ebnf-despool 'ps-despool) +(defalias 'ebnf-despool #'ps-despool) ;;;###autoload @@ -2611,7 +2611,8 @@ See also `ebnf-syntax-buffer'." (defvar ebnf-stack-style nil - "Used in functions `ebnf-reset-style', `ebnf-push-style' and + "Stack of styles. +Used in functions `ebnf-reset-style', `ebnf-push-style' and `ebnf-pop-style'.") @@ -3999,7 +4000,7 @@ See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and % === end EBNF engine " - "EBNF PostScript prologue") + "EBNF PostScript prologue.") (defconst ebnf-eps-prologue @@ -4276,7 +4277,7 @@ See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and }bind def " - "EBNF EPS prologue") + "EBNF EPS prologue.") (defconst ebnf-eps-begin @@ -4292,14 +4293,14 @@ end %%EndProlog " - "EBNF EPS begin") + "EBNF EPS begin.") (defconst ebnf-eps-end "#ebnf2ps#end %%EOF " - "EBNF EPS end") + "EBNF EPS end.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -4329,14 +4330,16 @@ end ;; hacked fom `ps-output-string-prim' (ps-print.el) (defun ebnf-eps-string (string) - (let* ((str (string-as-unibyte string)) + (let* ((str string) (len (length str)) (index 0) (new "(") ; insert start-string delimiter start special) ;; Find and quote special characters as necessary for PS - ;; This skips everything except control chars, non-ASCII chars, (, ) and \. - (while (setq start (string-match "[^]-~ -'*-[]" str index)) + ;; This skips everything except control chars, non-ASCII chars, + ;; (, ), \, and DEL. + (while (setq start (string-match "[[:cntrl:][:nonascii:]\177()\\]" + str index)) (setq special (aref str start) new (concat new (substring str index start) @@ -4536,26 +4539,25 @@ end ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; PostScript generation +(defvar ebnf-tree) -(defun ebnf-generate-eps (ebnf-tree) - (let* ((ps-color-p (and ebnf-color-p (ps-color-device))) +(defun ebnf-generate-eps (tree) + (let* ((ebnf-tree tree) + (ps-color-p (and ebnf-color-p (ps-color-device))) (ps-print-color-scale (if ps-color-p (float (car (ps-color-values "white"))) 1.0)) (ebnf-total (length ebnf-tree)) (ebnf-nprod 0) - (old-ps-output (symbol-function 'ps-output)) - (old-ps-output-string (symbol-function 'ps-output-string)) (eps-buffer (get-buffer-create ebnf-eps-buffer-name)) - ebnf-debug-ps error-msg horizontal + ebnf-debug-ps horizontal prod prod-name prod-width prod-height prod-list file-list) - ;; redefines `ps-output' and `ps-output-string' - (defalias 'ps-output 'ebnf-eps-output) - (defalias 'ps-output-string 'ps-output-string-prim) ;; generate EPS file - (save-excursion - (condition-case data - (progn + (unwind-protect + ;; redefines `ps-output' and `ps-output-string' + (cl-letf (((symbol-function 'ps-output) #'ebnf-eps-output) + ((symbol-function 'ps-output-string) #'ps-output-string-prim)) + (save-excursion (while ebnf-tree (setq prod (car ebnf-tree) prod-name (ebnf-node-name prod) @@ -4573,8 +4575,9 @@ end (if (setq prod-list (cdr (assoc prod-name ebnf-eps-production-list))) ;; insert EPS buffer in all buffer associated with production - (ebnf-eps-production-list prod-list 'file-list horizontal - prod-width prod-height eps-buffer) + (ebnf-eps-production-list + prod-list (gv-ref file-list) horizontal + prod-width prod-height eps-buffer) ;; write EPS file for production (ebnf-eps-finish-and-write eps-buffer (ebnf-eps-filename prod-name))) @@ -4584,17 +4587,10 @@ end (setq ebnf-tree (cdr ebnf-tree))) ;; write and kill temporary buffers (ebnf-eps-write-kill-temp file-list t) - (setq file-list nil)) - ;; handler - ((quit error) - (setq error-msg (error-message-string data))))) - ;; restore `ps-output' and `ps-output-string' - (defalias 'ps-output old-ps-output) - (defalias 'ps-output-string old-ps-output-string) - ;; kill temporary buffers - (kill-buffer eps-buffer) - (ebnf-eps-write-kill-temp file-list nil) - (and error-msg (error error-msg)) + (setq file-list nil))) + ;; kill temporary buffers + (kill-buffer eps-buffer) + (ebnf-eps-write-kill-temp file-list nil)) (message " "))) @@ -4610,10 +4606,10 @@ end ;; insert EPS buffer in all buffer associated with production -(defun ebnf-eps-production-list (prod-list file-list-sym horizontal +(defun ebnf-eps-production-list (prod-list file-list-ref horizontal prod-width prod-height eps-buffer) (while prod-list - (add-to-list file-list-sym (car prod-list)) + (cl-pushnew (car prod-list) (gv-deref file-list-ref) :test #'equal) (with-current-buffer (get-buffer-create (concat " *" (car prod-list) "*")) (goto-char (point-max)) (cond @@ -4647,8 +4643,9 @@ end (setq prod-list (cdr prod-list)))) -(defun ebnf-generate (ebnf-tree) - (let* ((ps-color-p (and ebnf-color-p (ps-color-device))) +(defun ebnf-generate (tree) + (let* ((ebnf-tree tree) + (ps-color-p (and ebnf-color-p (ps-color-device))) (ps-print-color-scale (if ps-color-p (float (car (ps-color-values "white"))) 1.0)) @@ -4658,14 +4655,13 @@ end ps-print-begin-page-hook ps-print-begin-column-hook) (ps-generate (current-buffer) (point-min) (point-max) - 'ebnf-generate-postscript))) + #'ebnf-generate-postscript))) -(defvar ebnf-tree nil) (defvar ebnf-direction "R") -(defun ebnf-generate-postscript (from to) +(defun ebnf-generate-postscript (_from _to) (ebnf-begin-file) (if ebnf-horizontal-max-height (ebnf-generate-with-max-height) @@ -5314,9 +5310,9 @@ killed after process termination." "\n%%DocumentNeededResources: font " (or ebnf-fonts-required (setq ebnf-fonts-required - (mapconcat 'identity + (mapconcat #'identity (ps-remove-duplicates - (mapcar 'ebnf-font-name-select + (mapcar #'ebnf-font-name-select (list ebnf-production-font ebnf-terminal-font ebnf-non-terminal-font @@ -5545,7 +5541,7 @@ killed after process termination." (ebnf-log "(ebnf-dimensions tree)") (let ((ebnf-total (length tree)) (ebnf-nprod 0)) - (mapc 'ebnf-production-dimension tree)) + (mapc #'ebnf-production-dimension tree)) tree) @@ -5925,7 +5921,7 @@ killed after process termination." )))) -(defun ebnf-justify (node seq seq-width width last-p) +(defun ebnf-justify (_node seq seq-width width last-p) (let ((term (car (if last-p (last seq) seq)))) (cond ;; adjust empty term diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index 0b5d7aa11bf..6ea939de661 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -19,7 +19,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -3034,7 +3034,7 @@ the first derived class." :help "Show the base class of this class" :active t] ["Down" ebrowse-switch-member-buffer-to-derived-class - :help "Show a derived class class of this class" + :help "Show a derived class of this class" :active t] ["Next Sibling" ebrowse-switch-member-buffer-to-next-sibling-class :help "Show the next sibling class" diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index b3f452ca5b9..3b24a23b893 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -19,7 +19,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -231,16 +231,21 @@ Blank lines separate paragraphs. Semicolons start comments. (defvar project-vc-external-roots-function) (lisp-mode-variables nil nil 'elisp) (add-hook 'after-load-functions #'elisp--font-lock-flush-elisp-buffers) - (setq-local electric-pair-text-pairs - (append '((?\` . ?\') (?‘ . ?’)) electric-pair-text-pairs)) - (setq-local electric-quote-string t) + (unless noninteractive + (require 'elec-pair) + (defvar electric-pair-text-pairs) + (setq-local electric-pair-text-pairs + (append '((?\` . ?\') (?‘ . ?’)) electric-pair-text-pairs)) + (setq-local electric-quote-string t)) (setq imenu-case-fold-search nil) (add-function :before-until (local 'eldoc-documentation-function) #'elisp-eldoc-documentation-function) (add-hook 'xref-backend-functions #'elisp--xref-backend nil t) (setq-local project-vc-external-roots-function #'elisp-load-path-roots) (add-hook 'completion-at-point-functions - #'elisp-completion-at-point nil 'local)) + #'elisp-completion-at-point nil 'local) + (add-hook 'flymake-diagnostic-functions #'elisp-flymake-checkdoc nil t) + (add-hook 'flymake-diagnostic-functions #'elisp-flymake-byte-compile nil t)) ;; Font-locking support. @@ -807,7 +812,7 @@ non-nil result supercedes the xrefs produced by (apply #'nconc (let (lst) (dolist (sym (apropos-internal regexp)) - (push (elisp--xref-find-definitions sym) lst)) + (push (elisp--xref-find-definitions sym) lst)) (nreverse lst)))) (defvar elisp--xref-identifier-completion-table @@ -894,10 +899,11 @@ Semicolons start comments. ;;; Emacs Lisp Byte-Code mode (eval-and-compile - (defconst emacs-list-byte-code-comment-re + (defconst emacs-lisp-byte-code-comment-re (concat "\\(#\\)@\\([0-9]+\\) " ;; Make sure it's a docstring and not a lazy-loaded byte-code. - "\\(?:[^(]\\|([^\"]\\)"))) + "\\(?:[^(]\\|([^\"]\\)") + "Regular expression matching a dynamic doc string comment.")) (defun elisp--byte-code-comment (end &optional _point) "Try to syntactically mark the #@NNN ....^_ docstrings in byte-code files." @@ -906,7 +912,7 @@ Semicolons start comments. (eq (char-after (nth 8 ppss)) ?#)) (let* ((n (save-excursion (goto-char (nth 8 ppss)) - (when (looking-at emacs-list-byte-code-comment-re) + (when (looking-at emacs-lisp-byte-code-comment-re) (string-to-number (match-string 2))))) ;; `maxdiff' tries to make sure the loop below terminates. (maxdiff n)) @@ -932,7 +938,7 @@ Semicolons start comments. (elisp--byte-code-comment end (point)) (funcall (syntax-propertize-rules - (emacs-list-byte-code-comment-re + (emacs-lisp-byte-code-comment-re (1 (prog1 "< b" (elisp--byte-code-comment end (point)))))) start end)) @@ -1106,7 +1112,7 @@ If CHAR is not a character, return nil." ;; interactive call would use it. ;; FIXME: Is it really the right place for this? (when (eq (car-safe expr) 'interactive) - (setq expr + (setq expr `(call-interactively (lambda (&rest args) ,expr args)))) expr))))) @@ -1171,7 +1177,7 @@ POS specifies the starting position where EXP was found and defaults to point." (and (not (special-variable-p var)) (save-excursion (zerop (car (syntax-ppss (match-beginning 0))))) - (push var vars)))) + (push var vars)))) `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp))))) (defun eval-last-sexp (eval-last-sexp-arg-internal) @@ -1376,7 +1382,7 @@ or elsewhere, return a 1-line docstring." (t (help-function-arglist sym))))) ;; Stringify, and store before highlighting, downcasing, etc. (elisp--last-data-store sym (elisp-function-argstring args) - 'function)))))) + 'function)))))) ;; Highlight, truncate. (if argstring (elisp--highlight-function-argument @@ -1394,13 +1400,14 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." ;; FIXME: This should probably work on the list representation of `args' ;; rather than its string representation. ;; FIXME: This function is much too long, we need to split it up! - (let ((start nil) - (end 0) - (argument-face 'eldoc-highlight-function-argument) - (args-lst (mapcar (lambda (x) - (replace-regexp-in-string - "\\`[(]\\|[)]\\'" "" x)) - (split-string args)))) + (let* ((start nil) + (end 0) + (argument-face 'eldoc-highlight-function-argument) + (args-lst (mapcar (lambda (x) + (replace-regexp-in-string + "\\`[(]\\|[)]\\'" "" x)) + (split-string args))) + (args-lst-ak (cdr (member "&key" args-lst)))) ;; Find the current argument in the argument string. We need to ;; handle `&rest' and informal `...' properly. ;; @@ -1412,12 +1419,12 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." ;; When `&key' is used finding position based on `index' ;; would be wrong, so find the arg at point and determine ;; position in ARGS based on this current arg. - (when (string-match "&key" args) + (when (and args-lst-ak + (>= index (- (length args-lst) (length args-lst-ak)))) (let* (case-fold-search key-have-value (sym-name (symbol-name sym)) - (cur-w (current-word)) - (args-lst-ak (cdr (member "&key" args-lst))) + (cur-w (current-word t)) (limit (save-excursion (when (re-search-backward sym-name nil t) (match-end 0)))) @@ -1425,7 +1432,7 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." (substring cur-w 1) (save-excursion (let (split) - (when (re-search-backward ":\\([^()\n]*\\)" limit t) + (when (re-search-backward ":\\([^ ()\n]*\\)" limit t) (setq split (split-string (match-string 1) " " t)) (prog1 (car split) (when (cdr split) @@ -1437,7 +1444,7 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." args-lst-ak (not (member (upcase cur-a) args-lst-ak)) (upcase (car (last args-lst-ak)))))) - (unless (string= cur-w sym-name) + (unless (or (null cur-w) (string= cur-w sym-name)) ;; The last keyword have already a value ;; i.e :foo a b and cursor is at b. ;; If signature have also `&rest' @@ -1584,5 +1591,157 @@ ARGLIST is either a string, or a list of strings or symbols." (replace-match "(" t t str) str))) +;;; Flymake support + +;; Don't require checkdoc, but forward declare these checkdoc special +;; variables. Autoloading them on `checkdoc-current-buffer' is too +;; late, they won't be bound dynamically. +(defvar checkdoc-create-error-function) +(defvar checkdoc-autofix-flag) +(defvar checkdoc-generate-compile-warnings-flag) +(defvar checkdoc-diagnostic-buffer) + +;;;###autoload +(defun elisp-flymake-checkdoc (report-fn &rest _args) + "A Flymake backend for `checkdoc'. +Calls REPORT-FN directly." + (let (collected) + (let* ((checkdoc-create-error-function + (lambda (text start end &optional unfixable) + (push (list text start end unfixable) collected) + nil)) + (checkdoc-autofix-flag nil) + (checkdoc-generate-compile-warnings-flag nil) + (checkdoc-diagnostic-buffer + (generate-new-buffer " *checkdoc-temp*"))) + (unwind-protect + (save-excursion + ;; checkdoc-current-buffer can error if there are + ;; unbalanced parens, for example, but this shouldn't + ;; disable the backend (bug#29176). + (ignore-errors + (checkdoc-current-buffer t))) + (kill-buffer checkdoc-diagnostic-buffer))) + (funcall report-fn + (cl-loop for (text start end _unfixable) in + collected + collect + (flymake-make-diagnostic + (current-buffer) + start end :note text))) + collected)) + +(defun elisp-flymake--byte-compile-done (report-fn + source-buffer + output-buffer) + (with-current-buffer + source-buffer + (save-excursion + (save-restriction + (widen) + (funcall + report-fn + (cl-loop with data = + (with-current-buffer output-buffer + (goto-char (point-min)) + (search-forward ":elisp-flymake-output-start") + (read (point-marker))) + for (string pos _fill level) in data + do (goto-char pos) + for beg = (if (< (point) (point-max)) + (point) + (line-beginning-position)) + for end = (min + (line-end-position) + (or (cdr + (bounds-of-thing-at-point 'sexp)) + (point-max))) + collect (flymake-make-diagnostic + (current-buffer) + (if (= beg end) (1- beg) beg) + end + level + string))))))) + +(defvar-local elisp-flymake--byte-compile-process nil + "Buffer-local process started for byte-compiling the buffer.") + +;;;###autoload +(defun elisp-flymake-byte-compile (report-fn &rest _args) + "A Flymake backend for elisp byte compilation. +Spawn an Emacs process that byte-compiles a file representing the +current buffer state and calls REPORT-FN when done." + (when elisp-flymake--byte-compile-process + (when (process-live-p elisp-flymake--byte-compile-process) + (kill-process elisp-flymake--byte-compile-process))) + (let ((temp-file (make-temp-file "elisp-flymake-byte-compile")) + (source-buffer (current-buffer))) + (save-restriction + (widen) + (write-region (point-min) (point-max) temp-file nil 'nomessage)) + (let* ((output-buffer (generate-new-buffer " *elisp-flymake-byte-compile*"))) + (setq + elisp-flymake--byte-compile-process + (make-process + :name "elisp-flymake-byte-compile" + :buffer output-buffer + :command (list (expand-file-name invocation-name invocation-directory) + "-Q" + "--batch" + ;; "--eval" "(setq load-prefer-newer t)" ; for testing + "-L" default-directory + "-f" "elisp-flymake--batch-compile-for-flymake" + temp-file) + :connection-type 'pipe + :sentinel + (lambda (proc _event) + (when (eq (process-status proc) 'exit) + (unwind-protect + (cond + ((not (eq proc (with-current-buffer source-buffer + elisp-flymake--byte-compile-process))) + (flymake-log :warning "byte-compile process %s obsolete" proc)) + ((zerop (process-exit-status proc)) + (elisp-flymake--byte-compile-done report-fn + source-buffer + output-buffer)) + (t + (funcall report-fn + :panic + :explanation + (format "byte-compile process %s died" proc)))) + (ignore-errors (delete-file temp-file)) + (kill-buffer output-buffer)))))) + :stderr null-device + :noquery t))) + +(defun elisp-flymake--batch-compile-for-flymake (&optional file) + "Helper for `elisp-flymake-byte-compile'. +Runs in a batch-mode Emacs. Interactively use variable +`buffer-file-name' for FILE." + (interactive (list buffer-file-name)) + (let* ((file (or file + (car command-line-args-left))) + (dummy-elc-file) + (byte-compile-log-buffer + (generate-new-buffer " *dummy-byte-compile-log-buffer*")) + (byte-compile-dest-file-function + (lambda (source) + (setq dummy-elc-file (make-temp-file (file-name-nondirectory source))))) + (collected) + (byte-compile-log-warning-function + (lambda (string &optional position fill level) + (push (list string position fill level) + collected) + t))) + (unwind-protect + (byte-compile-file file) + (ignore-errors + (delete-file dummy-elc-file) + (kill-buffer byte-compile-log-buffer))) + (prin1 :elisp-flymake-output-start) + (terpri) + (pp collected))) + (provide 'elisp-mode) ;;; elisp-mode.el ends here diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 8d635cb6d4d..9b21ee67ed1 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -20,7 +20,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -274,12 +274,9 @@ buffer-local and set them to nil." (run-hook-with-args-until-success 'tags-table-format-functions)) ;;;###autoload -(defun tags-table-mode () +(define-derived-mode tags-table-mode special-mode "Tags Table" "Major mode for tags table file buffers." - (interactive) - (setq major-mode 'tags-table-mode ;FIXME: Use define-derived-mode. - mode-name "Tags Table" - buffer-undo-list t) + (setq buffer-undo-list t) (initialize-new-tags-table)) ;;;###autoload @@ -439,25 +436,25 @@ Returns non-nil if it is a valid table." (progn (set-buffer (get-file-buffer file)) (or verify-tags-table-function (tags-table-mode)) - (if (or (verify-visited-file-modtime (current-buffer)) - ;; Decide whether to revert the file. - ;; revert-without-query can say to revert - ;; or the user can say to revert. - (not (or (let ((tail revert-without-query) - (found nil)) - (while tail - (if (string-match (car tail) buffer-file-name) - (setq found t)) - (setq tail (cdr tail))) - found) - tags-revert-without-query - (yes-or-no-p - (format "Tags file %s has changed, read new contents? " - file))))) - (and verify-tags-table-function - (funcall verify-tags-table-function)) + (unless (or (verify-visited-file-modtime (current-buffer)) + ;; Decide whether to revert the file. + ;; revert-without-query can say to revert + ;; or the user can say to revert. + (not (or (let ((tail revert-without-query) + (found nil)) + (while tail + (if (string-match (car tail) buffer-file-name) + (setq found t)) + (setq tail (cdr tail))) + found) + tags-revert-without-query + (yes-or-no-p + (format "Tags file %s has changed, read new contents? " + file))))) (revert-buffer t t) - (tags-table-mode))) + (tags-table-mode)) + (and verify-tags-table-function + (funcall verify-tags-table-function))) (when (file-exists-p file) (let* ((buf (find-file-noselect file)) (newfile (buffer-file-name buf))) @@ -470,7 +467,9 @@ Returns non-nil if it is a valid table." ;; Only change buffer now that we're done using potentially ;; buffer-local variables. (set-buffer buf) - (tags-table-mode))))) + (tags-table-mode) + (and verify-tags-table-function + (funcall verify-tags-table-function)))))) ;; Subroutine of visit-tags-table-buffer. Search the current tags tables ;; for one that has tags for THIS-FILE (or that includes a table that @@ -599,12 +598,13 @@ Returns t if it visits a tags table, or nil if there are no more in the list." ;; be frobnicated, and CONT will be set non-nil so we don't ;; do it below. (and buffer-file-name - (or - ;; First check only tables already in buffers. - (tags-table-including buffer-file-name t) - ;; Since that didn't find any, now do the - ;; expensive version: reading new files. - (tags-table-including buffer-file-name nil))) + (save-current-buffer + (or + ;; First check only tables already in buffers. + (tags-table-including buffer-file-name t) + ;; Since that didn't find any, now do the + ;; expensive version: reading new files. + (tags-table-including buffer-file-name nil)))) ;; Fourth, use the user variable tags-file-name, if it is ;; not already in the current list. (and tags-file-name @@ -2059,7 +2059,7 @@ see the doc of that variable if you want to add names to the list." (define-derived-mode select-tags-table-mode special-mode "Select Tags Table" "Major mode for choosing a current tags table among those already loaded." - (setq buffer-read-only t)) + ) (defun select-tags-table-select (button) "Select the tags table named on this line." diff --git a/lisp/progmodes/executable.el b/lisp/progmodes/executable.el index da148bd39aa..00c898d261c 100644 --- a/lisp/progmodes/executable.el +++ b/lisp/progmodes/executable.el @@ -18,7 +18,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -83,13 +83,21 @@ When this is `function', only ask when called non-interactively." :type 'regexp :group 'executable) - (defcustom executable-prefix "#!" - "Interpreter magic number prefix inserted when there was no magic number." - :version "24.3" ; "#! " -> "#!" + "Interpreter magic number prefix inserted when there was no magic number. +Use of `executable-prefix-env' is preferable to this option." + :version "26.1" ; deprecated :type 'string :group 'executable) +(defcustom executable-prefix-env nil + "If non-nil, use \"/usr/bin/env\" in interpreter magic number. +If this variable is non-nil, the interpreter magic number inserted +by `executable-set-magic' will be \"#!/usr/bin/env INTERPRETER\", +otherwise it will be \"#!/path/to/INTERPRETER\"." + :version "26.1" + :type 'boolean + :group 'executable) (defcustom executable-chmod 73 "After saving, if the file is not executable, set this mode. @@ -199,7 +207,7 @@ command to find the next error. The buffer is also in `comint-mode' and (defun executable-set-magic (interpreter &optional argument no-query-flag insert-flag) "Set this buffer's interpreter to INTERPRETER with optional ARGUMENT. -The variables `executable-magicless-file-regexp', `executable-prefix', +The variables `executable-magicless-file-regexp', `executable-prefix-env', `executable-insert', `executable-query' and `executable-chmod' control when and how magic numbers are inserted or replaced and scripts made executable." @@ -220,6 +228,14 @@ executable." (and argument (string< "" argument) " ") argument)) + ;; For backward compatibility, allow `executable-prefix-env' to be + ;; overridden by custom `executable-prefix'. + (if (string-match "#!\\([ \t]*/usr/bin/env[ \t]*\\)?$" executable-prefix) + (if executable-prefix-env + (setq argument (concat "/usr/bin/env " + (file-name-nondirectory argument)))) + (setq argument (concat (substring executable-prefix 2) argument))) + (or buffer-read-only (if buffer-file-name (string-match executable-magicless-file-regexp @@ -241,15 +257,13 @@ executable." ;; Make buffer visible before question. (switch-to-buffer (current-buffer)) (y-or-n-p (format-message - "Replace magic number by `%s%s'? " - executable-prefix argument)))) + "Replace magic number by `#!%s'? " + argument)))) (progn (replace-match argument t t nil 1) - (message "Magic number changed to `%s'" - (concat executable-prefix argument))))) - (insert executable-prefix argument ?\n) - (message "Magic number changed to `%s'" - (concat executable-prefix argument))))) + (message "Magic number changed to `#!%s'" argument)))) + (insert "#!" argument ?\n) + (message "Magic number changed to `#!%s'" argument)))) interpreter) diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index b3661bfe3f1..0cd665ca24b 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -19,7 +19,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -133,7 +133,7 @@ ;; f90-indent-region (can be called by calling indent-region) ;; f90-indent-subprogram ;; f90-break-line f90-join-lines -;; f90-fill-region +;; f90-fill-region f90-fill-paragraph ;; f90-insert-end ;; f90-upcase-keywords f90-upcase-region-keywords ;; f90-downcase-keywords f90-downcase-region-keywords @@ -784,6 +784,7 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") ["Indent Region" f90-indent-region :active mark-active] ["Fill Region" f90-fill-region :active mark-active :help "Fill long lines in the region"] + ["Fill Statement/Comment" fill-paragraph :active t] "--" ["Break Line at Point" f90-break-line :active t :help "Break the current line at point"] @@ -909,6 +910,8 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") [ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)" "Regexp matching the definition of a derived type.") +;; Maybe this should include "class default", but the constant is no +;; longer used. (defconst f90-typeis-re "\\_<\\(class\\|type\\)[ \t]*is[ \t]*(" "Regexp matching a CLASS/TYPE IS statement.") @@ -955,10 +958,14 @@ Used in the F90 entry in `hs-special-modes-alist'.") ;; Avoid F2003 "type is" in "select type", ;; and also variables of derived type "type (foo)". ;; "type, foo" must be a block (?). + ;; And a partial effort to avoid "class default". "\\(?:type\\|class\\)[ \t,]\\(" - "[^i(!\n\"& \t]\\|" ; not-i( + "[^id(!\n\"& \t]\\|" ; not-id( "i[^s!\n\"& \t]\\|" ; i not-s - "is\\(?:\\sw\\|\\s_\\)\\)\\|" + "d[^e!\n\"& \t]\\|" ; d not-e + "de[^f!\n\"& \t]\\|" ; de not-f + "def[^a!\n\"& \t]\\|" ; def not-a + "\\(?:is\\|default\\)\\(?:\\sw\\|\\s_\\)\\)\\|" ;; "abstract interface" is F2003; "submodule" is F2008. "program\\|\\(?:abstract[ \t]*\\)?interface\\|\\(?:sub\\)?module\\|" ;; "enum", but not "enumerator". @@ -1179,6 +1186,7 @@ with no args, if that value is non-nil." (set (make-local-variable 'abbrev-all-caps) t) (set (make-local-variable 'normal-auto-fill-function) 'f90-do-auto-fill) (setq indent-tabs-mode nil) ; auto buffer local + (set (make-local-variable 'fill-paragraph-function) 'f90-fill-paragraph) (set (make-local-variable 'font-lock-defaults) '((f90-font-lock-keywords f90-font-lock-keywords-1 f90-font-lock-keywords-2 @@ -1454,7 +1462,7 @@ if all else fails." (not (or (looking-at "end") (looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\ \\|select[ \t]*\\(case\\|type\\)\\|case\\|where\\|forall\\|\ -\\(?:class\\|type\\)[ \t]*is\\|\ +\\(?:class\\|type\\)[ \t]*is\\|class[ \t]*default\\|\ block\\|critical\\|enum\\|associate\\)\\_>") (looking-at "\\(program\\|\\(?:sub\\)?module\\|\ \\(?:abstract[ \t]*\\)?interface\\|block[ \t]*data\\)\\_>") @@ -1880,8 +1888,8 @@ after indenting." ;; FIXME This means f90-calculate-indent gives different answers ;; for comments and preprocessor lines to this function. ;; Better to make f90-calculate-indent return the correct answer? - (cond ((looking-at "!") (setq indent (f90-comment-indent))) - ((looking-at "#") (setq indent 0)) + (cond ((= (following-char) ?!) (setq indent (f90-comment-indent))) + ((= (following-char) ?#) (setq indent 0)) (t (and f90-smart-end (looking-at "end") (f90-match-end)) @@ -2152,6 +2160,20 @@ Like `join-line', but handles F90 syntax." (if (featurep 'xemacs) (zmacs-deactivate-region) (deactivate-mark)))) + +(defun f90-fill-paragraph (&optional justify) + "In a comment, fill it as a paragraph, else fill the current statement. +For use as the value of `fill-paragraph-function'. +Passes optional argument JUSTIFY to `fill-comment-paragraph'. +Always returns non-nil (to prevent `fill-paragraph' being called)." + (interactive "*P") + (or (fill-comment-paragraph justify) + (save-excursion + (f90-next-statement) + (let ((end (if (bobp) (point) (1- (point))))) + (f90-previous-statement) + (f90-fill-region (point) end))) + t)) (defconst f90-end-block-optional-name '("program" "module" "subroutine" "function" "type") diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el new file mode 100644 index 00000000000..e207de5da6c --- /dev/null +++ b/lisp/progmodes/flymake-proc.el @@ -0,0 +1,1208 @@ +;;; flymake-proc.el --- Flymake backend for external tools -*- lexical-binding: t; -*- + +;; Copyright (C) 2003-2017 Free Software Foundation, Inc. + +;; Author: Pavel Kobyakov <pk_at_work@yahoo.com> +;; Maintainer: Leo Liu <sdl.web@gmail.com> +;; Version: 0.3 +;; Keywords: c languages tools + +;; 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 <https://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Flymake is a minor Emacs mode performing on-the-fly syntax checks. +;; +;; This file contains a significant part of the original flymake's +;; implementation, a buffer-checking mechanism that parses the output +;; of an external syntax check tool with regular expressions. +;; +;; That work has been adapted into a flymake "backend" function, +;; `flymake-proc-legacy-flymake' suitable for adding to the +;; `flymake-diagnostic-functions' variable. +;; +;;; Bugs/todo: + +;; - Only uses "Makefile", not "makefile" or "GNUmakefile" +;; (from http://bugs.debian.org/337339). + +;;; Code: + +(require 'cl-lib) + +(require 'flymake) + +(defcustom flymake-proc-compilation-prevents-syntax-check t + "If non-nil, don't start syntax check if compilation is running." + :group 'flymake + :type 'boolean) + +(defcustom flymake-proc-xml-program + (if (executable-find "xmlstarlet") "xmlstarlet" "xml") + "Program to use for XML validation." + :type 'file + :group 'flymake + :version "24.4") + +(defcustom flymake-proc-master-file-dirs '("." "./src" "./UnitTest") + "Dirs where to look for master files." + :group 'flymake + :type '(repeat (string))) + +(defcustom flymake-proc-master-file-count-limit 32 + "Max number of master files to check." + :group 'flymake + :type 'integer) + +(defcustom flymake-proc-ignored-file-name-regexps '() + "Files syntax checking is forbidden for. +Overrides `flymake-proc-allowed-file-name-masks'." + :group 'flymake + :type '(repeat (regexp)) + :version "27.1") + +(defcustom flymake-proc-allowed-file-name-masks + '(("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'" + flymake-proc-simple-make-init + nil + flymake-proc-real-file-name-considering-includes) + ("\\.xml\\'" flymake-proc-xml-init) + ("\\.html?\\'" flymake-proc-xml-init) + ("\\.cs\\'" flymake-proc-simple-make-init) + ;; ("\\.p[ml]\\'" flymake-proc-perl-init) + ("\\.php[345]?\\'" flymake-proc-php-init) + ("\\.h\\'" flymake-proc-master-make-header-init flymake-proc-master-cleanup) + ("\\.java\\'" flymake-proc-simple-make-java-init flymake-proc-simple-java-cleanup) + ("[0-9]+\\.tex\\'" flymake-proc-master-tex-init flymake-proc-master-cleanup) + ("\\.tex\\'" flymake-proc-simple-tex-init) + ("\\.idl\\'" flymake-proc-simple-make-init) + ;; ("\\.cpp\\'" 1) + ;; ("\\.java\\'" 3) + ;; ("\\.h\\'" 2 ("\\.cpp\\'" "\\.c\\'") + ;; ("[ \t]*#[ \t]*include[ \t]*\"\\([\w0-9/\\_\.]*[/\\]*\\)\\(%s\\)\"" 1 2)) + ;; ("\\.idl\\'" 1) + ;; ("\\.odl\\'" 1) + ;; ("[0-9]+\\.tex\\'" 2 ("\\.tex\\'") + ;; ("[ \t]*\\input[ \t]*{\\(.*\\)\\(%s\\)}" 1 2 )) + ;; ("\\.tex\\'" 1) + ) + "Files syntax checking is allowed for. +Variable `flymake-proc-ignored-file-name-regexps' overrides this variable. +This is an alist with elements of the form: + REGEXP INIT [CLEANUP [NAME]] +REGEXP is a regular expression that matches a file name. +INIT is the init function to use. +CLEANUP is the cleanup function to use, default `flymake-proc-simple-cleanup'. +NAME is the file name function to use, default `flymake-proc-get-real-file-name'." + :group 'flymake + :type '(alist :key-type (regexp :tag "File regexp") + :value-type + (list :tag "Handler functions" + (function :tag "Init function") + (choice :tag "Cleanup function" + (const :tag "flymake-proc-simple-cleanup" nil) + function) + (choice :tag "Name function" + (const :tag "flymake-proc-get-real-file-name" nil) + function)))) + +(defvar-local flymake-proc--current-process nil + "Currently active Flymake process for a buffer, if any.") + +(defvar flymake-proc--report-fn nil + "If bound, function used to report back to Flymake's UI.") + +(defun flymake-proc-reformat-err-line-patterns-from-compile-el (original-list) + "Grab error line patterns from ORIGINAL-LIST in compile.el format. +Convert it to Flymake internal format." + (let* ((converted-list '())) + (dolist (item original-list) + (setq item (cdr item)) + (let ((regexp (nth 0 item)) + (file (nth 1 item)) + (line (nth 2 item)) + (col (nth 3 item))) + (if (consp file) (setq file (car file))) + (if (consp line) (setq line (car line))) + (if (consp col) (setq col (car col))) + + (when (not (functionp line)) + (setq converted-list (cons (list regexp file line col) converted-list))))) + converted-list)) + +(defvar flymake-proc-err-line-patterns ; regexp file-idx line-idx col-idx (optional) text-idx(optional), match-end to end of string is error text + (append + '( + ;; MS Visual C++ 6.0 + ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) : \\(\\(error\\|warning\\|fatal error\\) \\(C[0-9]+\\):[ \t\n]*\\(.+\\)\\)" + 1 3 nil 4) + ;; jikes + ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\):[0-9]+:[0-9]+:[0-9]+: \\(\\(Error\\|Warning\\|Caution\\|Semantic Error\\):[ \t\n]*\\(.+\\)\\)" + 1 3 nil 4) + ;; MS midl + ("midl[ ]*:[ ]*\\(command line error .*\\)" + nil nil nil 1) + ;; MS C# + ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\),[0-9]+): \\(\\(error\\|warning\\|fatal error\\) \\(CS[0-9]+\\):[ \t\n]*\\(.+\\)\\)" + 1 3 nil 4) + ;; perl + ("\\(.*\\) at \\([^ \n]+\\) line \\([0-9]+\\)[,.\n]" 2 3 nil 1) + ;; PHP + ("\\(?:Parse\\|Fatal\\) error: \\(.*\\) in \\(.*\\) on line \\([0-9]+\\)" 2 3 nil 1) + ;; LaTeX warnings (fileless) ("\\(LaTeX \\(Warning\\|Error\\): .*\\) on input line \\([0-9]+\\)" 20 3 nil 1) + ;; ant/javac. Note this also matches gcc warnings! + (" *\\(\\[javac\\] *\\)?\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?:[ \t\n]*\\(.+\\)" + 2 4 5 6)) + ;; compilation-error-regexp-alist) + (flymake-proc-reformat-err-line-patterns-from-compile-el compilation-error-regexp-alist-alist)) + "Patterns for matching error/warning lines. Each pattern has the form +\(REGEXP FILE-IDX LINE-IDX COL-IDX ERR-TEXT-IDX). +Use `flymake-proc-reformat-err-line-patterns-from-compile-el' to add patterns +from compile.el") + +(define-obsolete-variable-alias 'flymake-warning-re 'flymake-proc-diagnostic-type-pred "26.1") +(defvar flymake-proc-diagnostic-type-pred + 'flymake-proc-default-guess + "Predicate matching against diagnostic text to detect its type. +Takes a single argument, the diagnostic's text and should return +a value suitable for indexing +`flymake-diagnostic-types-alist' (which see). If the returned +value is nil, a type of `:error' is assumed. For some backward +compatibility, if a non-nil value is returned that doesn't +index that alist, a type of `:warning' is assumed. + +Instead of a function, it can also be a string, a regular +expression. A match indicates `:warning' type, otherwise +`:error'") + +(defun flymake-proc-default-guess (text) + "Guess if TEXT means a warning, a note or an error." + (cond ((string-match "^[wW]arning" text) + :warning) + ((string-match "^[nN]ote" text) + :note) + (t + :error))) + +(defun flymake-proc--get-file-name-mode-and-masks (file-name) + "Return the corresponding entry from `flymake-proc-allowed-file-name-masks'. +If the FILE-NAME matches a regexp from `flymake-proc-ignored-file-name-regexps', +`flymake-proc-allowed-file-name-masks' is not searched." + (unless (stringp file-name) + (error "Invalid file-name")) + (if (cl-find file-name flymake-proc-ignored-file-name-regexps + :test (lambda (fn rex) (string-match rex fn))) + (flymake-log 3 "file %s ignored") + (let ((fnm flymake-proc-allowed-file-name-masks) + (mode-and-masks nil)) + (while (and (not mode-and-masks) fnm) + (if (string-match (car (car fnm)) file-name) + (setq mode-and-masks (cdr (car fnm)))) + (setq fnm (cdr fnm))) + (flymake-log 3 "file %s, init=%s" file-name (car mode-and-masks)) + mode-and-masks))) + +(defun flymake-proc--get-init-function (file-name) + "Return init function to be used for the file." + (let* ((init-f (nth 0 (flymake-proc--get-file-name-mode-and-masks file-name)))) + ;;(flymake-log 0 "calling %s" init-f) + ;;(funcall init-f (current-buffer)) + init-f)) + +(defun flymake-proc--get-cleanup-function (file-name) + "Return cleanup function to be used for the file." + (or (nth 1 (flymake-proc--get-file-name-mode-and-masks file-name)) + 'flymake-proc-simple-cleanup)) + +(defun flymake-proc--get-real-file-name-function (file-name) + (or (nth 2 (flymake-proc--get-file-name-mode-and-masks file-name)) + 'flymake-proc-get-real-file-name)) + +(defvar flymake-proc--find-buildfile-cache (make-hash-table :test #'equal)) + +(defun flymake-proc--get-buildfile-from-cache (dir-name) + "Look up DIR-NAME in cache and return its associated value. +If DIR-NAME is not found, return nil." + (gethash dir-name flymake-proc--find-buildfile-cache)) + +(defun flymake-proc--add-buildfile-to-cache (dir-name buildfile) + "Associate DIR-NAME with BUILDFILE in the buildfile cache." + (puthash dir-name buildfile flymake-proc--find-buildfile-cache)) + +(defun flymake-proc--clear-buildfile-cache () + "Clear the buildfile cache." + (clrhash flymake-proc--find-buildfile-cache)) + +(defun flymake-proc--find-buildfile (buildfile-name source-dir-name) + "Find buildfile starting from current directory. +Buildfile includes Makefile, build.xml etc. +Return its file name if found, or nil if not found." + (or (flymake-proc--get-buildfile-from-cache source-dir-name) + (let* ((file (locate-dominating-file source-dir-name buildfile-name))) + (if file + (progn + (flymake-log 3 "found buildfile at %s" file) + (flymake-proc--add-buildfile-to-cache source-dir-name file) + file) + (progn + (flymake-log 3 "buildfile for %s not found" source-dir-name) + nil))))) + +(defun flymake-proc--fix-file-name (name) + "Replace all occurrences of `\\' with `/'." + (when name + (setq name (expand-file-name name)) + (setq name (abbreviate-file-name name)) + (setq name (directory-file-name name)) + name)) + +(defun flymake-proc--same-files (file-name-one file-name-two) + "Check if FILE-NAME-ONE and FILE-NAME-TWO point to same file. +Return t if so, nil if not." + (equal (flymake-proc--fix-file-name file-name-one) + (flymake-proc--fix-file-name file-name-two))) + +;; This is bound dynamically to pass a parameter to a sort predicate below +(defvar flymake-proc--included-file-name) + +(defun flymake-proc--find-possible-master-files (file-name master-file-dirs masks) + "Find (by name and location) all possible master files. +Name is specified by FILE-NAME and location is specified by +MASTER-FILE-DIRS. Master files include .cpp and .c for .h. +Files are searched for starting from the .h directory and max +max-level parent dirs. File contents are not checked." + (let* ((dirs master-file-dirs) + (files nil) + (done nil)) + + (while (and (not done) dirs) + (let* ((dir (expand-file-name (car dirs) (file-name-directory file-name))) + (masks masks)) + (while (and (file-exists-p dir) (not done) masks) + (let* ((mask (car masks)) + (dir-files (directory-files dir t mask))) + + (flymake-log 3 "dir %s, %d file(s) for mask %s" + dir (length dir-files) mask) + (while (and (not done) dir-files) + (when (not (file-directory-p (car dir-files))) + (setq files (cons (car dir-files) files)) + (when (>= (length files) flymake-proc-master-file-count-limit) + (flymake-log 3 "master file count limit (%d) reached" flymake-proc-master-file-count-limit) + (setq done t))) + (setq dir-files (cdr dir-files)))) + (setq masks (cdr masks)))) + (setq dirs (cdr dirs))) + (when files + (let ((flymake-proc--included-file-name (file-name-nondirectory file-name))) + (setq files (sort files 'flymake-proc--master-file-compare)))) + (flymake-log 3 "found %d possible master file(s)" (length files)) + files)) + +(defun flymake-proc--master-file-compare (file-one file-two) + "Compare two files specified by FILE-ONE and FILE-TWO. +This function is used in sort to move most possible file names +to the beginning of the list (File.h -> File.cpp moved to top)." + (and (equal (file-name-sans-extension flymake-proc--included-file-name) + (file-name-base file-one)) + (not (equal file-one file-two)))) + +(defvar flymake-proc-check-file-limit 8192 + "Maximum number of chars to look at when checking possible master file. +Nil means search the entire file.") + +(defun flymake-proc--check-patch-master-file-buffer + (master-file-temp-buffer + master-file-name patched-master-file-name + source-file-name patched-source-file-name + include-dirs regexp) + "Check if MASTER-FILE-NAME is a master file for SOURCE-FILE-NAME. +If yes, patch a copy of MASTER-FILE-NAME to include PATCHED-SOURCE-FILE-NAME +instead of SOURCE-FILE-NAME. + +For example, foo.cpp is a master file if it includes foo.h. + +When a buffer for MASTER-FILE-NAME exists, use it as a source +instead of reading master file from disk." + (let* ((source-file-nondir (file-name-nondirectory source-file-name)) + (source-file-extension (file-name-extension source-file-nondir)) + (source-file-nonext (file-name-sans-extension source-file-nondir)) + (found nil) + (inc-name nil) + (search-limit flymake-proc-check-file-limit)) + (setq regexp + (format regexp ; "[ \t]*#[ \t]*include[ \t]*\"\\(.*%s\\)\"" + ;; Hack for tex files, where \include often excludes .tex. + ;; Maybe this is safe generally. + (if (and (> (length source-file-extension) 1) + (string-equal source-file-extension "tex")) + (format "%s\\(?:\\.%s\\)?" + (regexp-quote source-file-nonext) + (regexp-quote source-file-extension)) + (regexp-quote source-file-nondir)))) + (unwind-protect + (with-current-buffer master-file-temp-buffer + (if (or (not search-limit) + (> search-limit (point-max))) + (setq search-limit (point-max))) + (flymake-log 3 "checking %s against regexp %s" + master-file-name regexp) + (goto-char (point-min)) + (while (and (< (point) search-limit) + (re-search-forward regexp search-limit t)) + (let ((match-beg (match-beginning 1)) + (match-end (match-end 1))) + + (flymake-log 3 "found possible match for %s" source-file-nondir) + (setq inc-name (match-string 1)) + (and (> (length source-file-extension) 1) + (string-equal source-file-extension "tex") + (not (string-match (format "\\.%s\\'" source-file-extension) + inc-name)) + (setq inc-name (concat inc-name "." source-file-extension))) + (when (eq t (compare-strings + source-file-nondir nil nil + inc-name (- (length inc-name) + (length source-file-nondir)) nil)) + (flymake-log 3 "inc-name=%s" inc-name) + (when (flymake-proc--check-include source-file-name inc-name + include-dirs) + (setq found t) + ;; replace-match is not used here as it fails in + ;; XEmacs with 'last match not a buffer' error as + ;; check-includes calls replace-in-string + (flymake-proc--replace-region + match-beg match-end + (file-name-nondirectory patched-source-file-name)))) + (forward-line 1))) + (when found + (flymake-proc--save-buffer-in-file patched-master-file-name))) + ;;+(flymake-log 3 "killing buffer %s" + ;; (buffer-name master-file-temp-buffer)) + (kill-buffer master-file-temp-buffer)) + ;;+(flymake-log 3 "check-patch master file %s: %s" master-file-name found) + (when found + (flymake-log 2 "found master file %s" master-file-name)) + found)) + +;;; XXX: remove +(defun flymake-proc--replace-region (beg end rep) + "Replace text in BUFFER in region (BEG END) with REP." + (save-excursion + (goto-char end) + ;; Insert before deleting, so as to better preserve markers's positions. + (insert rep) + (delete-region beg end))) + +(defun flymake-proc--read-file-to-temp-buffer (file-name) + "Insert contents of FILE-NAME into newly created temp buffer." + (let* ((temp-buffer (get-buffer-create (generate-new-buffer-name (concat "flymake:" (file-name-nondirectory file-name)))))) + (with-current-buffer temp-buffer + (insert-file-contents file-name)) + temp-buffer)) + +(defun flymake-proc--copy-buffer-to-temp-buffer (buffer) + "Copy contents of BUFFER into newly created temp buffer." + (with-current-buffer + (get-buffer-create (generate-new-buffer-name + (concat "flymake:" (buffer-name buffer)))) + (insert-buffer-substring buffer) + (current-buffer))) + +(defun flymake-proc--check-include (source-file-name inc-name include-dirs) + "Check if SOURCE-FILE-NAME can be found in include path. +Return t if it can be found via include path using INC-NAME." + (if (file-name-absolute-p inc-name) + (flymake-proc--same-files source-file-name inc-name) + (while (and include-dirs + (not (flymake-proc--same-files + source-file-name + (concat (file-name-directory source-file-name) + "/" (car include-dirs) + "/" inc-name)))) + (setq include-dirs (cdr include-dirs))) + include-dirs)) + +(defun flymake-proc--find-buffer-for-file (file-name) + "Check if there exists a buffer visiting FILE-NAME. +Return t if so, nil if not." + (let ((buffer-name (get-file-buffer file-name))) + (if buffer-name + (get-buffer buffer-name)))) + +(defun flymake-proc--create-master-file (source-file-name patched-source-file-name get-incl-dirs-f create-temp-f masks include-regexp) + "Save SOURCE-FILE-NAME with a different name. +Find master file, patch and save it." + (let* ((possible-master-files (flymake-proc--find-possible-master-files source-file-name flymake-proc-master-file-dirs masks)) + (master-file-count (length possible-master-files)) + (idx 0) + (temp-buffer nil) + (master-file-name nil) + (patched-master-file-name nil) + (found nil)) + + (while (and (not found) (< idx master-file-count)) + (setq master-file-name (nth idx possible-master-files)) + (setq patched-master-file-name (funcall create-temp-f master-file-name "flymake_master")) + (if (flymake-proc--find-buffer-for-file master-file-name) + (setq temp-buffer (flymake-proc--copy-buffer-to-temp-buffer (flymake-proc--find-buffer-for-file master-file-name))) + (setq temp-buffer (flymake-proc--read-file-to-temp-buffer master-file-name))) + (setq found + (flymake-proc--check-patch-master-file-buffer + temp-buffer + master-file-name + patched-master-file-name + source-file-name + patched-source-file-name + (funcall get-incl-dirs-f (file-name-directory master-file-name)) + include-regexp)) + (setq idx (1+ idx))) + (if found + (list master-file-name patched-master-file-name) + (progn + (flymake-log 3 "none of %d master file(s) checked includes %s" master-file-count + (file-name-nondirectory source-file-name)) + nil)))) + +(defun flymake-proc--save-buffer-in-file (file-name) + "Save the entire buffer contents into file FILE-NAME. +Create parent directories as needed." + (make-directory (file-name-directory file-name) 1) + (write-region nil nil file-name nil 566) + (flymake-log 3 "saved buffer %s in file %s" (buffer-name) file-name)) + +(defun flymake-proc--diagnostics-for-pattern (proc pattern) + (cl-flet ((guess-type + (pred message) + (cond ((null message) + :error) + ((stringp pred) + (if (string-match pred message) + :warning + :error)) + ((functionp pred) + (let ((probe (funcall pred message))) + (cond ((assoc-default probe + flymake-diagnostic-types-alist) + probe) + (probe + :warning) + (t + :error))))))) + (condition-case-unless-debug err + (cl-loop + with (regexp file-idx line-idx col-idx message-idx) = pattern + while (and + (search-forward-regexp regexp nil t) + ;; If the preceding search spanned more than one line, + ;; move to the start of the line we ended up in. This + ;; preserves the usefulness of the patterns in + ;; `flymake-proc-err-line-patterns', which were + ;; written primarily for flymake's original + ;; line-by-line parsing and thus never spanned + ;; multiple lines. + (if (/= (line-number-at-pos (match-beginning 0)) + (line-number-at-pos)) + (goto-char (line-beginning-position)) + t)) + for fname = (and file-idx (match-string file-idx)) + for message = (and message-idx (match-string message-idx)) + for line-string = (and line-idx (match-string line-idx)) + for line-number = (or (and line-string + (string-to-number line-string)) + 1) + for col-string = (and col-idx (match-string col-idx)) + for col-number = (and col-string + (string-to-number col-string)) + for full-file = (with-current-buffer (process-buffer proc) + (and fname + (funcall + (flymake-proc--get-real-file-name-function + fname) + fname))) + for buffer = (and full-file + (find-buffer-visiting full-file)) + if (and (eq buffer (process-buffer proc)) message) + collect (pcase-let ((`(,beg . ,end) + (flymake-diag-region buffer line-number col-number))) + (flymake-make-diagnostic + buffer beg end + (with-current-buffer buffer + (guess-type flymake-proc-diagnostic-type-pred message)) + message)) + else + do (flymake-log 2 "Reference to file %s is out of scope" fname)) + (error + (flymake-log 1 "Error parsing process output for pattern %s: %s" + pattern err) + nil)))) + +(defun flymake-proc--process-filter (proc string) + "Parse STRING and collect diagnostics info." + (flymake-log 3 "received %d byte(s) of output from process %d" + (length string) (process-id proc)) + (let ((output-buffer (process-get proc 'flymake-proc--output-buffer))) + (when (and (buffer-live-p (process-buffer proc)) + output-buffer) + (with-current-buffer output-buffer + (let ((moving (= (point) (process-mark proc))) + (inhibit-read-only t) + (unprocessed-mark + (or (process-get proc 'flymake-proc--unprocessed-mark) + (set-marker (make-marker) (point-min))))) + (save-excursion + ;; Insert the text, advancing the process marker. + (goto-char (process-mark proc)) + (insert string) + (set-marker (process-mark proc) (point))) + (if moving (goto-char (process-mark proc))) + + ;; check for new diagnostics + ;; + (save-excursion + (goto-char unprocessed-mark) + (dolist (pattern flymake-proc-err-line-patterns) + (let ((new (flymake-proc--diagnostics-for-pattern proc pattern))) + (process-put + proc + 'flymake-proc--collected-diagnostics + (append new + (process-get proc + 'flymake-proc--collected-diagnostics))))) + (process-put proc 'flymake-proc--unprocessed-mark + (point-marker)))))))) + +(defun flymake-proc--process-sentinel (proc _event) + "Sentinel for syntax check buffers." + (let (debug + (pid (process-id proc)) + (source-buffer (process-buffer proc))) + (unwind-protect + (when (buffer-live-p source-buffer) + (with-current-buffer source-buffer + (cond ((process-get proc 'flymake-proc--obsolete) + (flymake-log 3 "proc %s considered obsolete" + pid)) + ((process-get proc 'flymake-proc--interrupted) + (flymake-log 3 "proc %s interrupted by user" + pid)) + ((not (process-live-p proc)) + (let* ((exit-status (process-exit-status proc)) + (command (process-command proc)) + (diagnostics (process-get + proc + 'flymake-proc--collected-diagnostics))) + (flymake-log 2 "process %d exited with code %d" + pid exit-status) + (cond + ((equal 0 exit-status) + (funcall flymake-proc--report-fn diagnostics + :explanation (format "a gift from %s" (process-id proc)) + )) + (diagnostics + ;; non-zero exit but some diagnostics is quite + ;; normal... + (funcall flymake-proc--report-fn diagnostics + :explanation (format "a gift from %s" (process-id proc)))) + ((null diagnostics) + ;; ...but no diagnostics is strange, so panic. + (setq debug debug-on-error) + (flymake-proc--panic + :configuration-error + (format "Command %s errored, but no diagnostics" + command))))))))) + (let ((output-buffer (process-get proc 'flymake-proc--output-buffer))) + (cond (debug + (flymake-log 3 "Output buffer %s kept alive for debugging" + output-buffer)) + (t + (when (buffer-live-p source-buffer) + (with-current-buffer source-buffer + (let ((cleanup-f (flymake-proc--get-cleanup-function + (buffer-file-name)))) + (flymake-log 3 "cleaning up using %s" cleanup-f) + (funcall cleanup-f)))) + (kill-buffer output-buffer))))))) + +(defun flymake-proc--panic (problem explanation) + "Tell Flymake UI about a fatal PROBLEM with this backend. +May only be called in a dynamic environment where +`flymake-proc--report-fn' is bound." + (flymake-log 1 "%s: %s" problem explanation) + (if (and (boundp 'flymake-proc--report-fn) + flymake-proc--report-fn) + (funcall flymake-proc--report-fn :panic + :explanation (format "%s: %s" problem explanation)) + (flymake-error "Trouble telling flymake-ui about problem %s(%s)" + problem explanation))) + +(require 'compile) + +(defun flymake-proc-get-project-include-dirs-imp (basedir) + "Include dirs for the project current file belongs to." + (if (flymake-proc--get-project-include-dirs-from-cache basedir) + (progn + (flymake-proc--get-project-include-dirs-from-cache basedir)) + ;;else + (let* ((command-line (concat "make -C " + (shell-quote-argument basedir) + " DUMPVARS=INCLUDE_DIRS dumpvars")) + (output (shell-command-to-string command-line)) + (lines (split-string output "\n" t)) + (count (length lines)) + (idx 0) + (inc-dirs nil)) + (while (and (< idx count) (not (string-match "^INCLUDE_DIRS=.*" (nth idx lines)))) + (setq idx (1+ idx))) + (when (< idx count) + (let* ((inc-lines (split-string (nth idx lines) " *-I" t)) + (inc-count (length inc-lines))) + (while (> inc-count 0) + (when (not (string-match "^INCLUDE_DIRS=.*" (nth (1- inc-count) inc-lines))) + (push (replace-regexp-in-string "\"" "" (nth (1- inc-count) inc-lines)) inc-dirs)) + (setq inc-count (1- inc-count))))) + (flymake-proc--add-project-include-dirs-to-cache basedir inc-dirs) + inc-dirs))) + +(defvar flymake-proc-get-project-include-dirs-function #'flymake-proc-get-project-include-dirs-imp + "Function used to get project include dirs, one parameter: basedir name.") + +(defun flymake-proc--get-project-include-dirs (basedir) + (funcall flymake-proc-get-project-include-dirs-function basedir)) + +(defun flymake-proc--get-system-include-dirs () + "System include dirs - from the `INCLUDE' env setting." + (let* ((includes (getenv "INCLUDE"))) + (if includes (split-string includes path-separator t) nil))) + +(defvar flymake-proc--project-include-dirs-cache (make-hash-table :test #'equal)) + +(defun flymake-proc--get-project-include-dirs-from-cache (base-dir) + (gethash base-dir flymake-proc--project-include-dirs-cache)) + +(defun flymake-proc--add-project-include-dirs-to-cache (base-dir include-dirs) + (puthash base-dir include-dirs flymake-proc--project-include-dirs-cache)) + +(defun flymake-proc--clear-project-include-dirs-cache () + (clrhash flymake-proc--project-include-dirs-cache)) + +(defun flymake-proc-get-include-dirs (base-dir) + "Get dirs to use when resolving local file names." + (let* ((include-dirs (append '(".") (flymake-proc--get-project-include-dirs base-dir) (flymake-proc--get-system-include-dirs)))) + include-dirs)) + +;; (defun flymake-proc--restore-formatting () +;; "Remove any formatting made by flymake." +;; ) + +;; (defun flymake-proc--get-program-dir (buffer) +;; "Get dir to start program in." +;; (unless (bufferp buffer) +;; (error "Invalid buffer")) +;; (with-current-buffer buffer +;; default-directory)) + +(defun flymake-proc--safe-delete-file (file-name) + (when (and file-name (file-exists-p file-name)) + (delete-file file-name) + (flymake-log 2 "deleted file %s" file-name))) + +(defun flymake-proc--safe-delete-directory (dir-name) + (condition-case-unless-debug nil + (progn + (delete-directory dir-name) + (flymake-log 2 "deleted dir %s" dir-name)) + (error + (flymake-log 1 "Failed to delete dir %s, error ignored" dir-name)))) + + +(defun flymake-proc-legacy-flymake (report-fn &rest args) + "Flymake backend based on the original Flymake implementation. +This function is suitable for inclusion in +`flymake-diagnostic-functions'. For backward compatibility, it +can also be executed interactively independently of +`flymake-mode'." + ;; Interactively, behave as if flymake had invoked us through its + ;; `flymake-diagnostic-functions' with a suitable ID so flymake can + ;; clean up consistently + (interactive (list + (lambda (diags &rest args) + (apply (flymake-make-report-fn 'flymake-proc-legacy-flymake) + diags + (append args '(:force t)))) + :interactive t)) + (let ((interactive (plist-get args :interactive)) + (proc flymake-proc--current-process) + (flymake-proc--report-fn report-fn)) + (when (processp proc) + (process-put proc 'flymake-proc--obsolete t) + (flymake-log 3 "marking %s obsolete" (process-id proc)) + (when (process-live-p proc) + (when interactive + (user-error + "There's already a Flymake process running in this buffer") + (kill-process proc)))) + (when + ;; This particular situation make us not want to error right + ;; away (and disable ourselves), in case the situation changes + ;; in the near future. + (and (or (not flymake-proc-compilation-prevents-syntax-check) + (not (flymake-proc--compilation-is-running)))) + (let ((init-f + (and + buffer-file-name + ;; Since we write temp files in current dir, there's no point + ;; trying if the directory is read-only (bug#8954). + (file-writable-p (file-name-directory buffer-file-name)) + (flymake-proc--get-init-function buffer-file-name)))) + (unless init-f (error "Can't find a suitable init function")) + (flymake-proc--clear-buildfile-cache) + (flymake-proc--clear-project-include-dirs-cache) + + (let* ((cleanup-f (flymake-proc--get-cleanup-function buffer-file-name)) + (cmd-and-args (funcall init-f)) + (cmd (nth 0 cmd-and-args)) + (args (nth 1 cmd-and-args)) + (dir (nth 2 cmd-and-args)) + (success nil)) + (unwind-protect + (cond + ((not cmd-and-args) + (flymake-log 1 "init function %s for %s failed, cleaning up" + init-f buffer-file-name)) + (t + (setq proc + (let ((default-directory (or dir default-directory))) + (when dir + (flymake-log 3 "starting process on dir %s" dir)) + (make-process + :name "flymake-proc" + :buffer (current-buffer) + :command (cons cmd args) + :noquery t + :filter + (lambda (proc string) + (let ((flymake-proc--report-fn report-fn)) + (flymake-proc--process-filter proc string))) + :sentinel + (lambda (proc event) + (let ((flymake-proc--report-fn report-fn)) + (flymake-proc--process-sentinel proc event)))))) + (process-put proc 'flymake-proc--output-buffer + (generate-new-buffer + (format " *flymake output for %s*" (current-buffer)))) + (setq flymake-proc--current-process proc) + (flymake-log 2 "started process %d, command=%s, dir=%s" + (process-id proc) (process-command proc) + default-directory) + (setq success t))) + (unless success + (funcall cleanup-f)))))))) + +(define-obsolete-function-alias 'flymake-start-syntax-check + 'flymake-proc-legacy-flymake "26.1") + +(defun flymake-proc-stop-all-syntax-checks (&optional reason) + "Kill all syntax check processes." + (interactive (list "Interrupted by user")) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (let (p flymake-proc--current-process) + (when (process-live-p p) + (kill-process p) + (process-put p 'flymake-proc--interrupted reason) + (flymake-log 2 "killed process %d" (process-id p))))))) + +(defun flymake-proc--compilation-is-running () + (and (boundp 'compilation-in-progress) + compilation-in-progress)) + +(defun flymake-proc-compile () + "Kill all Flymake syntax checks, start compilation." + (interactive) + (flymake-proc-stop-all-syntax-checks "Stopping for proper compilation") + (call-interactively 'compile)) + +;;;; general init-cleanup and helper routines +(defun flymake-proc-create-temp-inplace (file-name prefix) + (unless (stringp file-name) + (error "Invalid file-name")) + (or prefix + (setq prefix "flymake")) + (let* ((ext (file-name-extension file-name)) + (temp-name (file-truename + (concat (file-name-sans-extension file-name) + "_" prefix + (and ext (concat "." ext)))))) + (flymake-log 3 "create-temp-inplace: file=%s temp=%s" file-name temp-name) + temp-name)) + +(defun flymake-proc-create-temp-with-folder-structure (file-name _prefix) + (unless (stringp file-name) + (error "Invalid file-name")) + + (let* ((dir (file-name-directory file-name)) + ;; Not sure what this slash-pos is all about, but I guess it's just + ;; trying to remove the leading / of absolute file names. + (slash-pos (string-match "/" dir)) + (temp-dir (expand-file-name (substring dir (1+ slash-pos)) + temporary-file-directory))) + + (file-truename (expand-file-name (file-name-nondirectory file-name) + temp-dir)))) + +(defun flymake-proc--delete-temp-directory (dir-name) + "Attempt to delete temp dir created by `flymake-proc-create-temp-with-folder-structure', do not fail on error." + (let* ((temp-dir temporary-file-directory) + (suffix (substring dir-name (1+ (length temp-dir))))) + + (while (> (length suffix) 0) + (setq suffix (directory-file-name suffix)) + ;;+(flymake-log 0 "suffix=%s" suffix) + (flymake-proc--safe-delete-directory + (file-truename (expand-file-name suffix temp-dir))) + (setq suffix (file-name-directory suffix))))) + +(defvar-local flymake-proc--temp-source-file-name nil) +(defvar-local flymake-proc--master-file-name nil) +(defvar-local flymake-proc--temp-master-file-name nil) +(defvar-local flymake-proc--base-dir nil) + +(defun flymake-proc-init-create-temp-buffer-copy (create-temp-f) + "Make a temporary copy of the current buffer, save its name in buffer data and return the name." + (let* ((source-file-name buffer-file-name) + (temp-source-file-name (funcall create-temp-f source-file-name "flymake"))) + + (flymake-proc--save-buffer-in-file temp-source-file-name) + (setq flymake-proc--temp-source-file-name temp-source-file-name) + temp-source-file-name)) + +(defun flymake-proc-simple-cleanup () + "Do cleanup after `flymake-proc-init-create-temp-buffer-copy'. +Delete temp file." + (flymake-proc--safe-delete-file flymake-proc--temp-source-file-name)) + +(defun flymake-proc-get-real-file-name (file-name-from-err-msg) + "Translate file name from error message to \"real\" file name. +Return full-name. Names are real, not patched." + (let* ((real-name nil) + (source-file-name buffer-file-name) + (master-file-name flymake-proc--master-file-name) + (temp-source-file-name flymake-proc--temp-source-file-name) + (temp-master-file-name flymake-proc--temp-master-file-name) + (base-dirs + (list flymake-proc--base-dir + (file-name-directory source-file-name) + (if master-file-name (file-name-directory master-file-name)))) + (files (list (list source-file-name source-file-name) + (list temp-source-file-name source-file-name) + (list master-file-name master-file-name) + (list temp-master-file-name master-file-name)))) + + (when (equal 0 (length file-name-from-err-msg)) + (setq file-name-from-err-msg source-file-name)) + + (setq real-name (flymake-proc--get-full-patched-file-name file-name-from-err-msg base-dirs files)) + ;; if real-name is nil, than file name from err msg is none of the files we've patched + (if (not real-name) + (setq real-name (flymake-proc--get-full-nonpatched-file-name file-name-from-err-msg base-dirs))) + (if (not real-name) + (setq real-name file-name-from-err-msg)) + (setq real-name (flymake-proc--fix-file-name real-name)) + (flymake-log 3 "get-real-file-name: file-name=%s real-name=%s" file-name-from-err-msg real-name) + real-name)) + +(defun flymake-proc--get-full-patched-file-name (file-name-from-err-msg base-dirs files) + (let* ((base-dirs-count (length base-dirs)) + (file-count (length files)) + (real-name nil)) + + (while (and (not real-name) (> base-dirs-count 0)) + (setq file-count (length files)) + (while (and (not real-name) (> file-count 0)) + (let* ((this-dir (nth (1- base-dirs-count) base-dirs)) + (this-file (nth 0 (nth (1- file-count) files))) + (this-real-name (nth 1 (nth (1- file-count) files)))) + ;;+(flymake-log 0 "this-dir=%s this-file=%s this-real=%s msg-file=%s" this-dir this-file this-real-name file-name-from-err-msg) + (when (and this-dir this-file (flymake-proc--same-files + (expand-file-name file-name-from-err-msg this-dir) + this-file)) + (setq real-name this-real-name))) + (setq file-count (1- file-count))) + (setq base-dirs-count (1- base-dirs-count))) + real-name)) + +(defun flymake-proc--get-full-nonpatched-file-name (file-name-from-err-msg base-dirs) + (let* ((real-name nil)) + (if (file-name-absolute-p file-name-from-err-msg) + (setq real-name file-name-from-err-msg) + (let* ((base-dirs-count (length base-dirs))) + (while (and (not real-name) (> base-dirs-count 0)) + (let* ((full-name (expand-file-name file-name-from-err-msg + (nth (1- base-dirs-count) base-dirs)))) + (if (file-exists-p full-name) + (setq real-name full-name)) + (setq base-dirs-count (1- base-dirs-count)))))) + real-name)) + +(defun flymake-proc--init-find-buildfile-dir (source-file-name buildfile-name) + "Find buildfile, store its dir in buffer data and return its dir, if found." + (let* ((buildfile-dir + (flymake-proc--find-buildfile buildfile-name + (file-name-directory source-file-name)))) + (if buildfile-dir + (setq flymake-proc--base-dir buildfile-dir) + (flymake-proc--panic + "NOMK" (format "No buildfile (%s) found for %s" + buildfile-name source-file-name))))) + +(defun flymake-proc--init-create-temp-source-and-master-buffer-copy (get-incl-dirs-f create-temp-f master-file-masks include-regexp) + "Find master file (or buffer), create its copy along with a copy of the source file." + (let* ((source-file-name buffer-file-name) + (temp-source-file-name (flymake-proc-init-create-temp-buffer-copy create-temp-f)) + (master-and-temp-master (flymake-proc--create-master-file + source-file-name temp-source-file-name + get-incl-dirs-f create-temp-f + master-file-masks include-regexp))) + + (if (not master-and-temp-master) + (progn + (flymake-proc--panic + "NOMASTER" + (format-message "cannot find master file for %s" + source-file-name)) + nil) + (setq flymake-proc--master-file-name (nth 0 master-and-temp-master)) + (setq flymake-proc--temp-master-file-name (nth 1 master-and-temp-master))))) + +(defun flymake-proc-master-cleanup () + (flymake-proc-simple-cleanup) + (flymake-proc--safe-delete-file flymake-proc--temp-master-file-name)) + +;;;; make-specific init-cleanup routines +(defun flymake-proc--get-syntax-check-program-args (source-file-name base-dir use-relative-base-dir use-relative-source get-cmd-line-f) + "Create a command line for syntax check using GET-CMD-LINE-F." + (funcall get-cmd-line-f + (if use-relative-source + (file-relative-name source-file-name base-dir) + source-file-name) + (if use-relative-base-dir + (file-relative-name base-dir + (file-name-directory source-file-name)) + base-dir))) + +(defun flymake-proc-get-make-cmdline (source base-dir) + (list "make" + (list "-s" + "-C" + base-dir + (concat "CHK_SOURCES=" source) + "SYNTAX_CHECK_MODE=1" + "check-syntax"))) + +(defun flymake-proc-get-ant-cmdline (source base-dir) + (list "ant" + (list "-buildfile" + (concat base-dir "/" "build.xml") + (concat "-DCHK_SOURCES=" source) + "check-syntax"))) + +(defun flymake-proc-simple-make-init-impl (create-temp-f use-relative-base-dir use-relative-source build-file-name get-cmdline-f) + "Create syntax check command line for a directly checked source file. +Use CREATE-TEMP-F for creating temp copy." + (let* ((args nil) + (source-file-name buffer-file-name) + (buildfile-dir (flymake-proc--init-find-buildfile-dir source-file-name build-file-name))) + (if buildfile-dir + (let* ((temp-source-file-name (flymake-proc-init-create-temp-buffer-copy create-temp-f))) + (setq args (flymake-proc--get-syntax-check-program-args temp-source-file-name buildfile-dir + use-relative-base-dir use-relative-source + get-cmdline-f)))) + args)) + +(defun flymake-proc-simple-make-init () + (flymake-proc-simple-make-init-impl 'flymake-proc-create-temp-inplace t t "Makefile" 'flymake-proc-get-make-cmdline)) + +(defun flymake-proc-master-make-init (get-incl-dirs-f master-file-masks include-regexp) + "Create make command line for a source file checked via master file compilation." + (let* ((make-args nil) + (temp-master-file-name (flymake-proc--init-create-temp-source-and-master-buffer-copy + get-incl-dirs-f 'flymake-proc-create-temp-inplace + master-file-masks include-regexp))) + (when temp-master-file-name + (let* ((buildfile-dir (flymake-proc--init-find-buildfile-dir temp-master-file-name "Makefile"))) + (if buildfile-dir + (setq make-args (flymake-proc--get-syntax-check-program-args + temp-master-file-name buildfile-dir nil nil 'flymake-proc-get-make-cmdline))))) + make-args)) + +(defun flymake-proc--find-make-buildfile (source-dir) + (flymake-proc--find-buildfile "Makefile" source-dir)) + +;;;; .h/make specific +(defun flymake-proc-master-make-header-init () + (flymake-proc-master-make-init + 'flymake-proc-get-include-dirs + '("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'") + "[ \t]*#[ \t]*include[ \t]*\"\\([[:word:]0-9/\\_.]*%s\\)\"")) + +(defun flymake-proc-real-file-name-considering-includes (scraped) + (flymake-proc-get-real-file-name + (let ((case-fold-search t)) + (replace-regexp-in-string "^in file included from[ \t*]" + "" + scraped)))) + +;;;; .java/make specific +(defun flymake-proc-simple-make-java-init () + (flymake-proc-simple-make-init-impl 'flymake-proc-create-temp-with-folder-structure nil nil "Makefile" 'flymake-proc-get-make-cmdline)) + +(defun flymake-proc-simple-ant-java-init () + (flymake-proc-simple-make-init-impl 'flymake-proc-create-temp-with-folder-structure nil nil "build.xml" 'flymake-proc-get-ant-cmdline)) + +(defun flymake-proc-simple-java-cleanup () + "Cleanup after `flymake-proc-simple-make-java-init' -- delete temp file and dirs." + (flymake-proc--safe-delete-file flymake-proc--temp-source-file-name) + (when flymake-proc--temp-source-file-name + (flymake-proc--delete-temp-directory + (file-name-directory flymake-proc--temp-source-file-name)))) + +;;;; perl-specific init-cleanup routines +(defun flymake-proc-perl-init () + (let* ((temp-file (flymake-proc-init-create-temp-buffer-copy + 'flymake-proc-create-temp-inplace)) + (local-file (file-relative-name + temp-file + (file-name-directory buffer-file-name)))) + (list "perl" (list "-wc " local-file)))) + +;;;; php-specific init-cleanup routines +(defun flymake-proc-php-init () + (let* ((temp-file (flymake-proc-init-create-temp-buffer-copy + 'flymake-proc-create-temp-inplace)) + (local-file (file-relative-name + temp-file + (file-name-directory buffer-file-name)))) + (list "php" (list "-f" local-file "-l")))) + +;;;; tex-specific init-cleanup routines +(defun flymake-proc--get-tex-args (file-name) + ;;(list "latex" (list "-c-style-errors" file-name)) + (list "texify" (list "--pdf" "--tex-option=-c-style-errors" file-name))) + +(defun flymake-proc-simple-tex-init () + (flymake-proc--get-tex-args (flymake-proc-init-create-temp-buffer-copy 'flymake-proc-create-temp-inplace))) + +;; Perhaps there should be a buffer-local variable flymake-master-file +;; that people can set to override this stuff. Could inherit from +;; the similar AUCTeX variable. +(defun flymake-proc-master-tex-init () + (let* ((temp-master-file-name (flymake-proc--init-create-temp-source-and-master-buffer-copy + 'flymake-proc-get-include-dirs-dot 'flymake-proc-create-temp-inplace + '("\\.tex\\'") + "[ \t]*\\in\\(?:put\\|clude\\)[ \t]*{\\(.*%s\\)}"))) + (when temp-master-file-name + (flymake-proc--get-tex-args temp-master-file-name)))) + +(defun flymake-proc--get-include-dirs-dot (_base-dir) + '(".")) + +;;;; xml-specific init-cleanup routines +(defun flymake-proc-xml-init () + (list flymake-proc-xml-program + (list "val" (flymake-proc-init-create-temp-buffer-copy + 'flymake-proc-create-temp-inplace)))) + + +;;;; Hook onto flymake-ui +(add-hook 'flymake-diagnostic-functions 'flymake-proc-legacy-flymake) + + +;;;; + +(progn + (define-obsolete-variable-alias 'flymake-compilation-prevents-syntax-check + 'flymake-proc-compilation-prevents-syntax-check "26.1") + (define-obsolete-variable-alias 'flymake-xml-program + 'flymake-proc-xml-program "26.1") + (define-obsolete-variable-alias 'flymake-master-file-dirs + 'flymake-proc-master-file-dirs "26.1") + (define-obsolete-variable-alias 'flymake-master-file-count-limit + 'flymake-proc-master-file-count-limit "26.1" + "Max number of master files to check.") + (define-obsolete-variable-alias 'flymake-allowed-file-name-masks + 'flymake-proc-allowed-file-name-masks "26.1") + (define-obsolete-variable-alias 'flymake-check-file-limit + 'flymake-proc-check-file-limit "26.1") + (define-obsolete-function-alias 'flymake-reformat-err-line-patterns-from-compile-el + 'flymake-proc-reformat-err-line-patterns-from-compile-el "26.1") + (define-obsolete-variable-alias 'flymake-err-line-patterns + 'flymake-proc-err-line-patterns "26.1") + (define-obsolete-function-alias 'flymake-parse-line + 'flymake-proc-parse-line "26.1") + (define-obsolete-function-alias 'flymake-get-include-dirs + 'flymake-proc-get-include-dirs "26.1") + (define-obsolete-function-alias 'flymake-stop-all-syntax-checks + 'flymake-proc-stop-all-syntax-checks "26.1") + (define-obsolete-function-alias 'flymake-compile + 'flymake-proc-compile "26.1") + (define-obsolete-function-alias 'flymake-create-temp-inplace + 'flymake-proc-create-temp-inplace "26.1") + (define-obsolete-function-alias 'flymake-create-temp-with-folder-structure + 'flymake-proc-create-temp-with-folder-structure "26.1") + (define-obsolete-function-alias 'flymake-init-create-temp-buffer-copy + 'flymake-proc-init-create-temp-buffer-copy "26.1") + (define-obsolete-function-alias 'flymake-simple-cleanup + 'flymake-proc-simple-cleanup "26.1") + (define-obsolete-function-alias 'flymake-get-real-file-name + 'flymake-proc-get-real-file-name "26.1") + (define-obsolete-function-alias 'flymake-master-cleanup + 'flymake-proc-master-cleanup "26.1") + (define-obsolete-function-alias 'flymake-get-make-cmdline + 'flymake-proc-get-make-cmdline "26.1") + (define-obsolete-function-alias 'flymake-get-ant-cmdline + 'flymake-proc-get-ant-cmdline "26.1") + (define-obsolete-function-alias 'flymake-simple-make-init-impl + 'flymake-proc-simple-make-init-impl "26.1") + (define-obsolete-function-alias 'flymake-simple-make-init + 'flymake-proc-simple-make-init "26.1") + (define-obsolete-function-alias 'flymake-master-make-init + 'flymake-proc-master-make-init "26.1") + (define-obsolete-function-alias 'flymake-find-make-buildfile + 'flymake-proc--find-make-buildfile "26.1") + (define-obsolete-function-alias 'flymake-master-make-header-init + 'flymake-proc-master-make-header-init "26.1") + (define-obsolete-function-alias 'flymake-simple-make-java-init + 'flymake-proc-simple-make-java-init "26.1") + (define-obsolete-function-alias 'flymake-simple-ant-java-init + 'flymake-proc-simple-ant-java-init "26.1") + (define-obsolete-function-alias 'flymake-simple-java-cleanup + 'flymake-proc-simple-java-cleanup "26.1") + (define-obsolete-function-alias 'flymake-perl-init + 'flymake-proc-perl-init "26.1") + (define-obsolete-function-alias 'flymake-php-init + 'flymake-proc-php-init "26.1") + (define-obsolete-function-alias 'flymake-simple-tex-init + 'flymake-proc-simple-tex-init "26.1") + (define-obsolete-function-alias 'flymake-master-tex-init + 'flymake-proc-master-tex-init "26.1") + (define-obsolete-function-alias 'flymake-xml-init + 'flymake-proc-xml-init "26.1")) + + + +(provide 'flymake-proc) +;;; flymake-proc.el ends here diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index ed34d9aaa52..15a36175970 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1,4 +1,4 @@ -;;; flymake.el --- a universal on-the-fly syntax checker -*- lexical-binding: t; -*- +;;; flymake.el --- A universal on-the-fly syntax checker -*- lexical-binding: t; -*- ;; Copyright (C) 2003-2017 Free Software Foundation, Inc. @@ -20,22 +20,36 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: ;; -;; Flymake is a minor Emacs mode performing on-the-fly syntax checks -;; using the external syntax check tool (for C/C++ this is usually the -;; compiler). - -;;; Bugs/todo: - -;; - Only uses "Makefile", not "makefile" or "GNUmakefile" -;; (from http://bugs.debian.org/337339). - +;; Flymake is a minor Emacs mode performing on-the-fly syntax checks. +;; +;; Flymake collects diagnostic information for multiple sources, +;; called backends, and visually annotates the relevant portions in +;; the buffer. +;; +;; This file contains the UI for displaying and interacting with the +;; results produced by these backends, as well as entry points for +;; backends to hook on to. +;; +;; The main entry points are `flymake-mode' and `flymake-start' +;; +;; The docstrings of these variables are relevant to understanding how +;; Flymake works for both the user and the backend programmer: +;; +;; * `flymake-diagnostic-functions' +;; * `flymake-diagnostic-types-alist' +;; ;;; Code: -(eval-when-compile (require 'cl-lib)) +(require 'cl-lib) +(require 'thingatpt) ; end-of-thing +(require 'warnings) ; warning-numeric-level, display-warning +(require 'compile) ; for some faces +;; when-let*, if-let*, hash-table-keys, hash-table-values: +(eval-when-compile (require 'subr-x)) (defgroup flymake nil "Universal on-the-fly syntax checker." @@ -43,7 +57,8 @@ :link '(custom-manual "(flymake) Top") :group 'tools) -(defcustom flymake-error-bitmap '(exclamation-mark error) +(defcustom flymake-error-bitmap '(flymake-double-exclamation-mark + compilation-error) "Bitmap (a symbol) used in the fringe for indicating errors. The value may also be a list of two elements where the second element specifies the face for the bitmap. For possible bitmap @@ -51,14 +66,13 @@ symbols, see `fringe-bitmaps'. See also `flymake-warning-bitmap'. The option `flymake-fringe-indicator-position' controls how and where this is used." - :group 'flymake :version "24.3" :type '(choice (symbol :tag "Bitmap") (list :tag "Bitmap and face" (symbol :tag "Bitmap") (face :tag "Face")))) -(defcustom flymake-warning-bitmap 'question-mark +(defcustom flymake-warning-bitmap '(exclamation-mark compilation-warning) "Bitmap (a symbol) used in the fringe for indicating warnings. The value may also be a list of two elements where the second element specifies the face for the bitmap. For possible bitmap @@ -66,1176 +80,763 @@ symbols, see `fringe-bitmaps'. See also `flymake-error-bitmap'. The option `flymake-fringe-indicator-position' controls how and where this is used." - :group 'flymake :version "24.3" :type '(choice (symbol :tag "Bitmap") (list :tag "Bitmap and face" (symbol :tag "Bitmap") (face :tag "Face")))) +(defcustom flymake-note-bitmap '(exclamation-mark compilation-info) + "Bitmap (a symbol) used in the fringe for indicating info notes. +The value may also be a list of two elements where the second +element specifies the face for the bitmap. For possible bitmap +symbols, see `fringe-bitmaps'. See also `flymake-error-bitmap'. + +The option `flymake-fringe-indicator-position' controls how and where +this is used." + :version "26.1" + :type '(choice (symbol :tag "Bitmap") + (list :tag "Bitmap and face" + (symbol :tag "Bitmap") + (face :tag "Face")))) + (defcustom flymake-fringe-indicator-position 'left-fringe - "The position to put flymake fringe indicator. + "The position to put Flymake fringe indicator. The value can be nil (do not use indicators), `left-fringe' or `right-fringe'. See `flymake-error-bitmap' and `flymake-warning-bitmap'." - :group 'flymake :version "24.3" :type '(choice (const left-fringe) (const right-fringe) (const :tag "No fringe indicators" nil))) -(defcustom flymake-compilation-prevents-syntax-check t - "If non-nil, don't start syntax check if compilation is running." - :group 'flymake - :type 'boolean) - (defcustom flymake-start-syntax-check-on-newline t "Start syntax check if newline char was added/removed from the buffer." - :group 'flymake :type 'boolean) (defcustom flymake-no-changes-timeout 0.5 - "Time to wait after last change before starting compilation." - :group 'flymake + "Time to wait after last change before automatically checking buffer. +If nil, never start checking buffer automatically like this." :type 'number) (defcustom flymake-gui-warnings-enabled t "Enables/disables GUI warnings." - :group 'flymake :type 'boolean) (make-obsolete-variable 'flymake-gui-warnings-enabled "it no longer has any effect." "26.1") -(defcustom flymake-start-syntax-check-on-find-file t - "Start syntax check on find file." - :group 'flymake +(defcustom flymake-start-on-flymake-mode t + "Start syntax check when `flymake-mode' is enabled. +Specifically, start it when the buffer is actually displayed." :type 'boolean) +(define-obsolete-variable-alias 'flymake-start-syntax-check-on-find-file + 'flymake-start-on-flymake-mode "26.1") + (defcustom flymake-log-level -1 - "Logging level, only messages with level lower or equal will be logged. --1 = NONE, 0 = ERROR, 1 = WARNING, 2 = INFO, 3 = DEBUG" - :group 'flymake + "Obsolete and ignored variable." :type 'integer) +(make-obsolete-variable 'flymake-log-level + "it is superseded by `warning-minimum-log-level.'" + "26.1") -(defcustom flymake-xml-program - (if (executable-find "xmlstarlet") "xmlstarlet" "xml") - "Program to use for XML validation." - :type 'file - :group 'flymake - :version "24.4") - -(defcustom flymake-master-file-dirs '("." "./src" "./UnitTest") - "Dirs where to look for master files." - :group 'flymake - :type '(repeat (string))) - -(defcustom flymake-master-file-count-limit 32 - "Max number of master files to check." - :group 'flymake - :type 'integer) +(defcustom flymake-wrap-around t + "If non-nil, moving to errors wraps around buffer boundaries." + :type 'boolean) -(defcustom flymake-allowed-file-name-masks - '(("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'" flymake-simple-make-init) - ("\\.xml\\'" flymake-xml-init) - ("\\.html?\\'" flymake-xml-init) - ("\\.cs\\'" flymake-simple-make-init) - ("\\.p[ml]\\'" flymake-perl-init) - ("\\.php[345]?\\'" flymake-php-init) - ("\\.h\\'" flymake-master-make-header-init flymake-master-cleanup) - ("\\.java\\'" flymake-simple-make-java-init flymake-simple-java-cleanup) - ("[0-9]+\\.tex\\'" flymake-master-tex-init flymake-master-cleanup) - ("\\.tex\\'" flymake-simple-tex-init) - ("\\.idl\\'" flymake-simple-make-init) - ;; ("\\.cpp\\'" 1) - ;; ("\\.java\\'" 3) - ;; ("\\.h\\'" 2 ("\\.cpp\\'" "\\.c\\'") - ;; ("[ \t]*#[ \t]*include[ \t]*\"\\([\w0-9/\\_\.]*[/\\]*\\)\\(%s\\)\"" 1 2)) - ;; ("\\.idl\\'" 1) - ;; ("\\.odl\\'" 1) - ;; ("[0-9]+\\.tex\\'" 2 ("\\.tex\\'") - ;; ("[ \t]*\\input[ \t]*{\\(.*\\)\\(%s\\)}" 1 2 )) - ;; ("\\.tex\\'" 1) - ) - "Files syntax checking is allowed for. -This is an alist with elements of the form: - REGEXP INIT [CLEANUP [NAME]] -REGEXP is a regular expression that matches a file name. -INIT is the init function to use. -CLEANUP is the cleanup function to use, default `flymake-simple-cleanup'. -NAME is the file name function to use, default `flymake-get-real-file-name'." - :group 'flymake - :type '(alist :key-type (regexp :tag "File regexp") - :value-type - (list :tag "Handler functions" - (function :tag "Init function") - (choice :tag "Cleanup function" - (const :tag "flymake-simple-cleanup" nil) - function) - (choice :tag "Name function" - (const :tag "flymake-get-real-file-name" nil) - function)))) - -(defvar-local flymake-is-running nil - "If t, flymake syntax check process is running for the current buffer.") +(when (fboundp 'define-fringe-bitmap) + (define-fringe-bitmap 'flymake-double-exclamation-mark + (vector #b00000000 + #b00000000 + #b00000000 + #b00000000 + #b01100110 + #b01100110 + #b01100110 + #b01100110 + #b01100110 + #b01100110 + #b01100110 + #b01100110 + #b00000000 + #b01100110 + #b00000000 + #b00000000 + #b00000000))) (defvar-local flymake-timer nil "Timer for starting syntax check.") -(defvar-local flymake-last-change-time nil - "Time of last buffer change.") - (defvar-local flymake-check-start-time nil "Time at which syntax check was started.") -(defvar-local flymake-check-was-interrupted nil - "Non-nil if syntax check was killed by `flymake-compile'.") - -(defvar-local flymake-err-info nil - "Sorted list of line numbers and lists of err info in the form (file, err-text).") - -(defvar-local flymake-new-err-info nil - "Same as `flymake-err-info', effective when a syntax check is in progress.") - -(defun flymake-log (level text &rest args) - "Log a message at level LEVEL. -If LEVEL is higher than `flymake-log-level', the message is -ignored. Otherwise, it is printed using `message'. -TEXT is a format control string, and the remaining arguments ARGS -are the string substitutions (see the function `format')." - (if (<= level flymake-log-level) - (let* ((msg (apply #'format-message text args))) - (message "%s" msg)))) - -(defun flymake-ins-after (list pos val) - "Insert VAL into LIST after position POS. -POS counts from zero." - (let ((tmp (copy-sequence list))) - (setcdr (nthcdr pos tmp) (cons val (nthcdr (1+ pos) tmp))) - tmp)) - -(defun flymake-set-at (list pos val) - "Set VAL at position POS in LIST. -POS counts from zero." - (let ((tmp (copy-sequence list))) - (setcar (nthcdr pos tmp) val) - tmp)) - -(defvar flymake-processes nil - "List of currently active flymake processes.") - -(defvar-local flymake-output-residual nil) - -(defun flymake-get-file-name-mode-and-masks (file-name) - "Return the corresponding entry from `flymake-allowed-file-name-masks'." - (unless (stringp file-name) - (error "Invalid file-name")) - (let ((fnm flymake-allowed-file-name-masks) - (mode-and-masks nil)) - (while (and (not mode-and-masks) fnm) - (if (string-match (car (car fnm)) file-name) - (setq mode-and-masks (cdr (car fnm)))) - (setq fnm (cdr fnm))) - (flymake-log 3 "file %s, init=%s" file-name (car mode-and-masks)) - mode-and-masks)) - -(defun flymake-can-syntax-check-file (file-name) - "Determine whether we can syntax check FILE-NAME. -Return nil if we cannot, non-nil if we can." - (if (flymake-get-init-function file-name) t nil)) - -(defun flymake-get-init-function (file-name) - "Return init function to be used for the file." - (let* ((init-f (nth 0 (flymake-get-file-name-mode-and-masks file-name)))) - ;;(flymake-log 0 "calling %s" init-f) - ;;(funcall init-f (current-buffer)) - init-f)) - -(defun flymake-get-cleanup-function (file-name) - "Return cleanup function to be used for the file." - (or (nth 1 (flymake-get-file-name-mode-and-masks file-name)) - 'flymake-simple-cleanup)) - -(defun flymake-get-real-file-name-function (file-name) - (or (nth 2 (flymake-get-file-name-mode-and-masks file-name)) - 'flymake-get-real-file-name)) - -(defvar flymake-find-buildfile-cache (make-hash-table :test #'equal)) - -(defun flymake-get-buildfile-from-cache (dir-name) - "Look up DIR-NAME in cache and return its associated value. -If DIR-NAME is not found, return nil." - (gethash dir-name flymake-find-buildfile-cache)) - -(defun flymake-add-buildfile-to-cache (dir-name buildfile) - "Associate DIR-NAME with BUILDFILE in the buildfile cache." - (puthash dir-name buildfile flymake-find-buildfile-cache)) - -(defun flymake-clear-buildfile-cache () - "Clear the buildfile cache." - (clrhash flymake-find-buildfile-cache)) - -(defun flymake-find-buildfile (buildfile-name source-dir-name) - "Find buildfile starting from current directory. -Buildfile includes Makefile, build.xml etc. -Return its file name if found, or nil if not found." - (or (flymake-get-buildfile-from-cache source-dir-name) - (let* ((file (locate-dominating-file source-dir-name buildfile-name))) - (if file - (progn - (flymake-log 3 "found buildfile at %s" file) - (flymake-add-buildfile-to-cache source-dir-name file) - file) - (progn - (flymake-log 3 "buildfile for %s not found" source-dir-name) - nil))))) - -(defun flymake-fix-file-name (name) - "Replace all occurrences of `\\' with `/'." - (when name - (setq name (expand-file-name name)) - (setq name (abbreviate-file-name name)) - (setq name (directory-file-name name)) - name)) - -(defun flymake-same-files (file-name-one file-name-two) - "Check if FILE-NAME-ONE and FILE-NAME-TWO point to same file. -Return t if so, nil if not." - (equal (flymake-fix-file-name file-name-one) - (flymake-fix-file-name file-name-two))) - -;; This is bound dynamically to pass a parameter to a sort predicate below -(defvar flymake-included-file-name) - -(defun flymake-find-possible-master-files (file-name master-file-dirs masks) - "Find (by name and location) all possible master files. - -Name is specified by FILE-NAME and location is specified by -MASTER-FILE-DIRS. Master files include .cpp and .c for .h. -Files are searched for starting from the .h directory and max -max-level parent dirs. File contents are not checked." - (let* ((dirs master-file-dirs) - (files nil) - (done nil)) - - (while (and (not done) dirs) - (let* ((dir (expand-file-name (car dirs) (file-name-directory file-name))) - (masks masks)) - (while (and (file-exists-p dir) (not done) masks) - (let* ((mask (car masks)) - (dir-files (directory-files dir t mask))) - - (flymake-log 3 "dir %s, %d file(s) for mask %s" - dir (length dir-files) mask) - (while (and (not done) dir-files) - (when (not (file-directory-p (car dir-files))) - (setq files (cons (car dir-files) files)) - (when (>= (length files) flymake-master-file-count-limit) - (flymake-log 3 "master file count limit (%d) reached" flymake-master-file-count-limit) - (setq done t))) - (setq dir-files (cdr dir-files)))) - (setq masks (cdr masks)))) - (setq dirs (cdr dirs))) - (when files - (let ((flymake-included-file-name (file-name-nondirectory file-name))) - (setq files (sort files 'flymake-master-file-compare)))) - (flymake-log 3 "found %d possible master file(s)" (length files)) - files)) - -(defun flymake-master-file-compare (file-one file-two) - "Compare two files specified by FILE-ONE and FILE-TWO. -This function is used in sort to move most possible file names -to the beginning of the list (File.h -> File.cpp moved to top)." - (and (equal (file-name-sans-extension flymake-included-file-name) - (file-name-base file-one)) - (not (equal file-one file-two)))) - -(defvar flymake-check-file-limit 8192 - "Maximum number of chars to look at when checking possible master file. -Nil means search the entire file.") - -(defun flymake-check-patch-master-file-buffer - (master-file-temp-buffer - master-file-name patched-master-file-name - source-file-name patched-source-file-name - include-dirs regexp) - "Check if MASTER-FILE-NAME is a master file for SOURCE-FILE-NAME. -If yes, patch a copy of MASTER-FILE-NAME to include PATCHED-SOURCE-FILE-NAME -instead of SOURCE-FILE-NAME. - -For example, foo.cpp is a master file if it includes foo.h. - -When a buffer for MASTER-FILE-NAME exists, use it as a source -instead of reading master file from disk." - (let* ((source-file-nondir (file-name-nondirectory source-file-name)) - (source-file-extension (file-name-extension source-file-nondir)) - (source-file-nonext (file-name-sans-extension source-file-nondir)) - (found nil) - (inc-name nil) - (search-limit flymake-check-file-limit)) - (setq regexp - (format regexp ; "[ \t]*#[ \t]*include[ \t]*\"\\(.*%s\\)\"" - ;; Hack for tex files, where \include often excludes .tex. - ;; Maybe this is safe generally. - (if (and (> (length source-file-extension) 1) - (string-equal source-file-extension "tex")) - (format "%s\\(?:\\.%s\\)?" - (regexp-quote source-file-nonext) - (regexp-quote source-file-extension)) - (regexp-quote source-file-nondir)))) - (unwind-protect - (with-current-buffer master-file-temp-buffer - (if (or (not search-limit) - (> search-limit (point-max))) - (setq search-limit (point-max))) - (flymake-log 3 "checking %s against regexp %s" - master-file-name regexp) - (goto-char (point-min)) - (while (and (< (point) search-limit) - (re-search-forward regexp search-limit t)) - (let ((match-beg (match-beginning 1)) - (match-end (match-end 1))) - - (flymake-log 3 "found possible match for %s" source-file-nondir) - (setq inc-name (match-string 1)) - (and (> (length source-file-extension) 1) - (string-equal source-file-extension "tex") - (not (string-match (format "\\.%s\\'" source-file-extension) - inc-name)) - (setq inc-name (concat inc-name "." source-file-extension))) - (when (eq t (compare-strings - source-file-nondir nil nil - inc-name (- (length inc-name) - (length source-file-nondir)) nil)) - (flymake-log 3 "inc-name=%s" inc-name) - (when (flymake-check-include source-file-name inc-name - include-dirs) - (setq found t) - ;; replace-match is not used here as it fails in - ;; XEmacs with 'last match not a buffer' error as - ;; check-includes calls replace-in-string - (flymake-replace-region - match-beg match-end - (file-name-nondirectory patched-source-file-name)))) - (forward-line 1))) - (when found - (flymake-save-buffer-in-file patched-master-file-name))) - ;;+(flymake-log 3 "killing buffer %s" - ;; (buffer-name master-file-temp-buffer)) - (kill-buffer master-file-temp-buffer)) - ;;+(flymake-log 3 "check-patch master file %s: %s" master-file-name found) - (when found - (flymake-log 2 "found master file %s" master-file-name)) - found)) - -;;; XXX: remove -(defun flymake-replace-region (beg end rep) - "Replace text in BUFFER in region (BEG END) with REP." - (save-excursion - (goto-char end) - ;; Insert before deleting, so as to better preserve markers's positions. - (insert rep) - (delete-region beg end))) - -(defun flymake-read-file-to-temp-buffer (file-name) - "Insert contents of FILE-NAME into newly created temp buffer." - (let* ((temp-buffer (get-buffer-create (generate-new-buffer-name (concat "flymake:" (file-name-nondirectory file-name)))))) - (with-current-buffer temp-buffer - (insert-file-contents file-name)) - temp-buffer)) - -(defun flymake-copy-buffer-to-temp-buffer (buffer) - "Copy contents of BUFFER into newly created temp buffer." - (with-current-buffer - (get-buffer-create (generate-new-buffer-name - (concat "flymake:" (buffer-name buffer)))) - (insert-buffer-substring buffer) - (current-buffer))) - -(defun flymake-check-include (source-file-name inc-name include-dirs) - "Check if SOURCE-FILE-NAME can be found in include path. -Return t if it can be found via include path using INC-NAME." - (if (file-name-absolute-p inc-name) - (flymake-same-files source-file-name inc-name) - (while (and include-dirs - (not (flymake-same-files - source-file-name - (concat (file-name-directory source-file-name) - "/" (car include-dirs) - "/" inc-name)))) - (setq include-dirs (cdr include-dirs))) - include-dirs)) - -(defun flymake-find-buffer-for-file (file-name) - "Check if there exists a buffer visiting FILE-NAME. -Return t if so, nil if not." - (let ((buffer-name (get-file-buffer file-name))) - (if buffer-name - (get-buffer buffer-name)))) - -(defun flymake-create-master-file (source-file-name patched-source-file-name get-incl-dirs-f create-temp-f masks include-regexp) - "Save SOURCE-FILE-NAME with a different name. -Find master file, patch and save it." - (let* ((possible-master-files (flymake-find-possible-master-files source-file-name flymake-master-file-dirs masks)) - (master-file-count (length possible-master-files)) - (idx 0) - (temp-buffer nil) - (master-file-name nil) - (patched-master-file-name nil) - (found nil)) - - (while (and (not found) (< idx master-file-count)) - (setq master-file-name (nth idx possible-master-files)) - (setq patched-master-file-name (funcall create-temp-f master-file-name "flymake_master")) - (if (flymake-find-buffer-for-file master-file-name) - (setq temp-buffer (flymake-copy-buffer-to-temp-buffer (flymake-find-buffer-for-file master-file-name))) - (setq temp-buffer (flymake-read-file-to-temp-buffer master-file-name))) - (setq found - (flymake-check-patch-master-file-buffer - temp-buffer - master-file-name - patched-master-file-name - source-file-name - patched-source-file-name - (funcall get-incl-dirs-f (file-name-directory master-file-name)) - include-regexp)) - (setq idx (1+ idx))) - (if found - (list master-file-name patched-master-file-name) - (progn - (flymake-log 3 "none of %d master file(s) checked includes %s" master-file-count - (file-name-nondirectory source-file-name)) - nil)))) - -(defun flymake-save-buffer-in-file (file-name) - "Save the entire buffer contents into file FILE-NAME. -Create parent directories as needed." - (make-directory (file-name-directory file-name) 1) - (write-region nil nil file-name nil 566) - (flymake-log 3 "saved buffer %s in file %s" (buffer-name) file-name)) - -(defun flymake-process-filter (process output) - "Parse OUTPUT and highlight error lines. -It's flymake process filter." - (let ((source-buffer (process-buffer process))) - - (flymake-log 3 "received %d byte(s) of output from process %d" - (length output) (process-id process)) - (when (buffer-live-p source-buffer) - (with-current-buffer source-buffer - (flymake-parse-output-and-residual output))))) - -(defun flymake-process-sentinel (process _event) - "Sentinel for syntax check buffers." - (when (memq (process-status process) '(signal exit)) - (let* ((exit-status (process-exit-status process)) - (command (process-command process)) - (source-buffer (process-buffer process)) - (cleanup-f (flymake-get-cleanup-function (buffer-file-name source-buffer)))) - - (flymake-log 2 "process %d exited with code %d" - (process-id process) exit-status) - (condition-case err - (progn - (flymake-log 3 "cleaning up using %s" cleanup-f) - (when (buffer-live-p source-buffer) - (with-current-buffer source-buffer - (funcall cleanup-f))) - - (delete-process process) - (setq flymake-processes (delq process flymake-processes)) - - (when (buffer-live-p source-buffer) - (with-current-buffer source-buffer - - (flymake-parse-residual) - (flymake-post-syntax-check exit-status command) - (setq flymake-is-running nil)))) - (error - (let ((err-str (format "Error in process sentinel for buffer %s: %s" - source-buffer (error-message-string err)))) - (flymake-log 0 err-str) - (with-current-buffer source-buffer - (setq flymake-is-running nil)))))))) - -(defun flymake-post-syntax-check (exit-status command) +(defun flymake--log-1 (level sublog msg &rest args) + "Do actual work for `flymake-log'." + (let (;; never popup the log buffer + (warning-minimum-level :emergency) + (warning-type-format + (format " [%s %s]" + (or sublog 'flymake) + (current-buffer)))) + (display-warning (list 'flymake sublog) + (apply #'format-message msg args) + (if (numberp level) + (or (nth level + '(:emergency :error :warning :debug :debug) ) + :error) + level) + "*Flymake log*"))) + +(defun flymake-switch-to-log-buffer () + "Go to the *Flymake log* buffer." + (interactive) + (switch-to-buffer "*Flymake log*")) + +;;;###autoload +(defmacro flymake-log (level msg &rest args) + "Log, at level LEVEL, the message MSG formatted with ARGS. +LEVEL is passed to `display-warning', which is used to display +the warning. If this form is included in a byte-compiled file, +the generated warning contains an indication of the file that +generated it." + (let* ((compile-file (and (boundp 'byte-compile-current-file) + (symbol-value 'byte-compile-current-file))) + (sublog (if (and + compile-file + (not load-file-name)) + (intern + (file-name-nondirectory + (file-name-sans-extension compile-file)))))) + `(flymake--log-1 ,level ',sublog ,msg ,@args))) + +(defun flymake-error (text &rest args) + "Format TEXT with ARGS and signal an error for Flymake." + (let ((msg (apply #'format-message text args))) + (flymake-log :error msg) + (error (concat "[Flymake] " msg)))) + +(cl-defstruct (flymake--diag + (:constructor flymake--diag-make)) + buffer beg end type text backend) + +;;;###autoload +(defun flymake-make-diagnostic (buffer + beg + end + type + text) + "Make a Flymake diagnostic for BUFFER's region from BEG to END. +TYPE is a key to `flymake-diagnostic-types-alist' and TEXT is a +description of the problem detected in this region." + (flymake--diag-make :buffer buffer :beg beg :end end :type type :text text)) + +;;;###autoload +(defun flymake-diagnostics (&optional beg end) + "Get Flymake diagnostics in region determined by BEG and END. + +If neither BEG or END is supplied, use the whole buffer, +otherwise if BEG is non-nil and END is nil, consider only +diagnostics at BEG." + (mapcar (lambda (ov) (overlay-get ov 'flymake-diagnostic)) + (flymake--overlays :beg beg :end end))) + +(defmacro flymake--diag-accessor (public internal thing) + "Make PUBLIC an alias for INTERNAL, add doc using THING." + `(defsubst ,public (diag) + ,(format "Get Flymake diagnostic DIAG's %s." (symbol-name thing)) + (,internal diag))) + +(flymake--diag-accessor flymake-diagnostic-buffer flymake--diag-buffer buffer) +(flymake--diag-accessor flymake-diagnostic-text flymake--diag-text text) +(flymake--diag-accessor flymake-diagnostic-type flymake--diag-type type) +(flymake--diag-accessor flymake-diagnostic-beg flymake--diag-beg beg) +(flymake--diag-accessor flymake-diagnostic-end flymake--diag-end end) +(flymake--diag-accessor flymake-diagnostic-backend flymake--diag-backend backend) + +(cl-defun flymake--overlays (&key beg end filter compare key) + "Get flymake-related overlays. +If BEG is non-nil and END is nil, consider only `overlays-at' +BEG. Otherwise consider `overlays-in' the region comprised by BEG +and END, defaulting to the whole buffer. Remove all that do not +verify FILTER, a function, and sort them by COMPARE (using KEY)." (save-restriction (widen) - (setq flymake-err-info flymake-new-err-info) - (setq flymake-new-err-info nil) - (setq flymake-err-info - (flymake-fix-line-numbers - flymake-err-info 1 (count-lines (point-min) (point-max)))) - (flymake-delete-own-overlays) - (flymake-highlight-err-lines flymake-err-info) - (let (err-count warn-count) - (setq err-count (flymake-get-err-count flymake-err-info "e")) - (setq warn-count (flymake-get-err-count flymake-err-info "w")) - (flymake-log 2 "%s: %d error(s), %d warning(s) in %.2f second(s)" - (buffer-name) err-count warn-count - (- (float-time) flymake-check-start-time)) - (setq flymake-check-start-time nil) - - (if (and (equal 0 err-count) (equal 0 warn-count)) - (if (equal 0 exit-status) - (flymake-report-status "" "") ; PASSED - (if (not flymake-check-was-interrupted) - (flymake-report-fatal-status "CFGERR" - (format "Configuration error has occurred while running %s" command)) - (flymake-report-status nil ""))) ; "STOPPED" - (flymake-report-status (format "%d/%d" err-count warn-count) ""))))) - -(defun flymake-parse-output-and-residual (output) - "Split OUTPUT into lines, merge in residual if necessary." - (let* ((buffer-residual flymake-output-residual) - (total-output (if buffer-residual (concat buffer-residual output) output)) - (lines-and-residual (flymake-split-output total-output)) - (lines (nth 0 lines-and-residual)) - (new-residual (nth 1 lines-and-residual))) - (setq flymake-output-residual new-residual) - (setq flymake-new-err-info - (flymake-parse-err-lines - flymake-new-err-info lines)))) - -(defun flymake-parse-residual () - "Parse residual if it's non empty." - (when flymake-output-residual - (setq flymake-new-err-info - (flymake-parse-err-lines - flymake-new-err-info - (list flymake-output-residual))) - (setq flymake-output-residual nil))) - -(defun flymake-er-make-er (line-no line-err-info-list) - (list line-no line-err-info-list)) - -(defun flymake-er-get-line (err-info) - (nth 0 err-info)) - -(defun flymake-er-get-line-err-info-list (err-info) - (nth 1 err-info)) - -(cl-defstruct (flymake-ler - (:constructor nil) - (:constructor flymake-ler-make-ler (file line type text &optional full-file))) - file line type text full-file) - -(defun flymake-ler-set-file (line-err-info file) - (flymake-ler-make-ler file - (flymake-ler-line line-err-info) - (flymake-ler-type line-err-info) - (flymake-ler-text line-err-info) - (flymake-ler-full-file line-err-info))) - -(defun flymake-ler-set-full-file (line-err-info full-file) - (flymake-ler-make-ler (flymake-ler-file line-err-info) - (flymake-ler-line line-err-info) - (flymake-ler-type line-err-info) - (flymake-ler-text line-err-info) - full-file)) - -(defun flymake-ler-set-line (line-err-info line) - (flymake-ler-make-ler (flymake-ler-file line-err-info) - line - (flymake-ler-type line-err-info) - (flymake-ler-text line-err-info) - (flymake-ler-full-file line-err-info))) - -(defun flymake-get-line-err-count (line-err-info-list type) - "Return number of errors of specified TYPE. -Value of TYPE is either \"e\" or \"w\"." - (let* ((idx 0) - (count (length line-err-info-list)) - (err-count 0)) - - (while (< idx count) - (when (equal type (flymake-ler-type (nth idx line-err-info-list))) - (setq err-count (1+ err-count))) - (setq idx (1+ idx))) - err-count)) - -(defun flymake-get-err-count (err-info-list type) - "Return number of errors of specified TYPE for ERR-INFO-LIST." - (let* ((idx 0) - (count (length err-info-list)) - (err-count 0)) - (while (< idx count) - (setq err-count (+ err-count (flymake-get-line-err-count (nth 1 (nth idx err-info-list)) type))) - (setq idx (1+ idx))) - err-count)) - -(defun flymake-fix-line-numbers (err-info-list min-line max-line) - "Replace line numbers with fixed value. -If line-numbers is less than MIN-LINE, set line numbers to MIN-LINE. -If line numbers is greater than MAX-LINE, set line numbers to MAX-LINE. -The reason for this fix is because some compilers might report -line number outside the file being compiled." - (let* ((count (length err-info-list)) - (err-info nil) - (line 0)) - (while (> count 0) - (setq err-info (nth (1- count) err-info-list)) - (setq line (flymake-er-get-line err-info)) - (when (or (< line min-line) (> line max-line)) - (setq line (if (< line min-line) min-line max-line)) - (setq err-info-list (flymake-set-at err-info-list (1- count) - (flymake-er-make-er line - (flymake-er-get-line-err-info-list err-info))))) - (setq count (1- count)))) - err-info-list) - -(defun flymake-highlight-err-lines (err-info-list) - "Highlight error lines in BUFFER using info from ERR-INFO-LIST." - (save-excursion - (dolist (err err-info-list) - (flymake-highlight-line (car err) (nth 1 err))))) - -(defun flymake-overlay-p (ov) - "Determine whether overlay OV was created by flymake." - (and (overlayp ov) (overlay-get ov 'flymake-overlay))) - -(defun flymake-make-overlay (beg end tooltip-text face bitmap) - "Allocate a flymake overlay in range BEG and END." - (when (not (flymake-region-has-flymake-overlays beg end)) - (let ((ov (make-overlay beg end nil t)) - (fringe (and flymake-fringe-indicator-position - (propertize "!" 'display - (cons flymake-fringe-indicator-position - (if (listp bitmap) - bitmap - (list bitmap))))))) - (overlay-put ov 'face face) - (overlay-put ov 'help-echo tooltip-text) - (overlay-put ov 'flymake-overlay t) - (overlay-put ov 'priority 100) - (overlay-put ov 'evaporate t) - (overlay-put ov 'before-string fringe) - ;;+(flymake-log 3 "created overlay %s" ov) - ov) - (flymake-log 3 "created an overlay at (%d-%d)" beg end))) - -(defun flymake-delete-own-overlays () - "Delete all flymake overlays in BUFFER." - (dolist (ol (overlays-in (point-min) (point-max))) - (when (flymake-overlay-p ol) - (delete-overlay ol) - ;;+(flymake-log 3 "deleted overlay %s" ol) - ))) - -(defun flymake-region-has-flymake-overlays (beg end) - "Check if region specified by BEG and END has overlay. -Return t if it has at least one flymake overlay, nil if no overlay." - (let ((ov (overlays-in beg end)) - (has-flymake-overlays nil)) - (while (consp ov) - (when (flymake-overlay-p (car ov)) - (setq has-flymake-overlays t)) - (setq ov (cdr ov))) - has-flymake-overlays)) - -(defface flymake-errline + (let ((ovs (cl-remove-if-not + (lambda (ov) + (and (overlay-get ov 'flymake-diagnostic) + (or (not filter) + (funcall filter ov)))) + (if (and beg (null end)) + (overlays-at beg t) + (overlays-in (or beg (point-min)) + (or end (point-max))))))) + (if compare + (cl-sort ovs compare :key (or key + #'identity)) + ovs)))) + +(defun flymake-delete-own-overlays (&optional filter) + "Delete all Flymake overlays in BUFFER." + (mapc #'delete-overlay (flymake--overlays :filter filter))) + +(defface flymake-error '((((supports :underline (:style wave))) :underline (:style wave :color "Red1")) (t :inherit error)) - "Face used for marking error lines." - :version "24.4" - :group 'flymake) + "Face used for marking error regions." + :version "24.4") -(defface flymake-warnline +(defface flymake-warning '((((supports :underline (:style wave))) - :underline (:style wave :color "DarkOrange")) + :underline (:style wave :color "deep sky blue")) (t :inherit warning)) - "Face used for marking warning lines." - :version "24.4" - :group 'flymake) - -(defun flymake-highlight-line (line-no line-err-info-list) - "Highlight line LINE-NO in current buffer. -Perhaps use text from LINE-ERR-INFO-LIST to enhance highlighting." - (goto-char (point-min)) - (forward-line (1- line-no)) - (pcase-let* ((beg (progn (back-to-indentation) (point))) - (end (progn - (end-of-line) - (skip-chars-backward " \t\f\t\n" beg) - (if (eq (point) beg) - (line-beginning-position 2) - (point)))) - (tooltip-text (mapconcat #'flymake-ler-text line-err-info-list "\n")) - (`(,face ,bitmap) - (if (> (flymake-get-line-err-count line-err-info-list "e") 0) - (list 'flymake-errline flymake-error-bitmap) - (list 'flymake-warnline flymake-warning-bitmap)))) - (flymake-make-overlay beg end tooltip-text face bitmap))) - -(defun flymake-parse-err-lines (err-info-list lines) - "Parse err LINES, store info in ERR-INFO-LIST." - (let* ((count (length lines)) - (idx 0) - (line-err-info nil) - (real-file-name nil) - (source-file-name buffer-file-name) - (get-real-file-name-f (flymake-get-real-file-name-function source-file-name))) - - (while (< idx count) - (setq line-err-info (flymake-parse-line (nth idx lines))) - (when line-err-info - (setq real-file-name (funcall get-real-file-name-f - (flymake-ler-file line-err-info))) - (setq line-err-info (flymake-ler-set-full-file line-err-info real-file-name)) - - (when (flymake-same-files real-file-name source-file-name) - (setq line-err-info (flymake-ler-set-file line-err-info nil)) - (setq err-info-list (flymake-add-err-info err-info-list line-err-info)))) - (flymake-log 3 "parsed `%s', %s line-err-info" (nth idx lines) (if line-err-info "got" "no")) - (setq idx (1+ idx))) - err-info-list)) - -(defun flymake-split-output (output) - "Split OUTPUT into lines. -Return last one as residual if it does not end with newline char. -Returns ((LINES) RESIDUAL)." - (when (and output (> (length output) 0)) - (let* ((lines (split-string output "[\n\r]+" t)) - (complete (equal "\n" (char-to-string (aref output (1- (length output)))))) - (residual nil)) - (when (not complete) - (setq residual (car (last lines))) - (setq lines (butlast lines))) - (list lines residual)))) - -(defun flymake-reformat-err-line-patterns-from-compile-el (original-list) - "Grab error line patterns from ORIGINAL-LIST in compile.el format. -Convert it to flymake internal format." - (let* ((converted-list '())) - (dolist (item original-list) - (setq item (cdr item)) - (let ((regexp (nth 0 item)) - (file (nth 1 item)) - (line (nth 2 item)) - (col (nth 3 item))) - (if (consp file) (setq file (car file))) - (if (consp line) (setq line (car line))) - (if (consp col) (setq col (car col))) - - (when (not (functionp line)) - (setq converted-list (cons (list regexp file line col) converted-list))))) - converted-list)) - -(require 'compile) - -(defvar flymake-err-line-patterns ; regexp file-idx line-idx col-idx (optional) text-idx(optional), match-end to end of string is error text - (append - '( - ;; MS Visual C++ 6.0 - ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) : \\(\\(error\\|warning\\|fatal error\\) \\(C[0-9]+\\):[ \t\n]*\\(.+\\)\\)" - 1 3 nil 4) - ;; jikes - ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\):[0-9]+:[0-9]+:[0-9]+: \\(\\(Error\\|Warning\\|Caution\\|Semantic Error\\):[ \t\n]*\\(.+\\)\\)" - 1 3 nil 4) - ;; MS midl - ("midl[ ]*:[ ]*\\(command line error .*\\)" - nil nil nil 1) - ;; MS C# - ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\),[0-9]+): \\(\\(error\\|warning\\|fatal error\\) \\(CS[0-9]+\\):[ \t\n]*\\(.+\\)\\)" - 1 3 nil 4) - ;; perl - ("\\(.*\\) at \\([^ \n]+\\) line \\([0-9]+\\)[,.\n]" 2 3 nil 1) - ;; PHP - ("\\(?:Parse\\|Fatal\\) error: \\(.*\\) in \\(.*\\) on line \\([0-9]+\\)" 2 3 nil 1) - ;; LaTeX warnings (fileless) ("\\(LaTeX \\(Warning\\|Error\\): .*\\) on input line \\([0-9]+\\)" 20 3 nil 1) - ;; ant/javac. Note this also matches gcc warnings! - (" *\\(\\[javac\\] *\\)?\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\)\\(?::[0-9]+\\)?:[ \t\n]*\\(.+\\)" - 2 4 nil 5)) - ;; compilation-error-regexp-alist) - (flymake-reformat-err-line-patterns-from-compile-el compilation-error-regexp-alist-alist)) - "Patterns for matching error/warning lines. Each pattern has the form -\(REGEXP FILE-IDX LINE-IDX COL-IDX ERR-TEXT-IDX). -Use `flymake-reformat-err-line-patterns-from-compile-el' to add patterns -from compile.el") - -(define-obsolete-variable-alias 'flymake-warning-re 'flymake-warning-predicate "24.4") -(defvar flymake-warning-predicate "^[wW]arning" - "Predicate matching against error text to detect a warning. -Takes a single argument, the error's text and should return non-nil -if it's a warning. -Instead of a function, it can also be a regular expression.") - -(defun flymake-parse-line (line) - "Parse LINE to see if it is an error or warning. -Return its components if so, nil otherwise." - (let ((raw-file-name nil) - (line-no 0) - (err-type "e") - (err-text nil) - (patterns flymake-err-line-patterns) - (matched nil)) - (while (and patterns (not matched)) - (when (string-match (car (car patterns)) line) - (let* ((file-idx (nth 1 (car patterns))) - (line-idx (nth 2 (car patterns)))) - - (setq raw-file-name (if file-idx (match-string file-idx line) nil)) - (setq line-no (if line-idx (string-to-number - (match-string line-idx line)) 0)) - (setq err-text (if (> (length (car patterns)) 4) - (match-string (nth 4 (car patterns)) line) - (flymake-patch-err-text - (substring line (match-end 0))))) - (if (null err-text) - (setq err-text "<no error text>") - (when (cond ((stringp flymake-warning-predicate) - (string-match flymake-warning-predicate err-text)) - ((functionp flymake-warning-predicate) - (funcall flymake-warning-predicate err-text))) - (setq err-type "w"))) - (flymake-log - 3 "parse line: file-idx=%s line-idx=%s file=%s line=%s text=%s" - file-idx line-idx raw-file-name line-no err-text) - (setq matched t))) - (setq patterns (cdr patterns))) - (if matched - (flymake-ler-make-ler raw-file-name line-no err-type err-text) - ()))) - -(defun flymake-find-err-info (err-info-list line-no) - "Find (line-err-info-list pos) for specified LINE-NO." - (if err-info-list - (let* ((line-err-info-list nil) - (pos 0) - (count (length err-info-list))) - - (while (and (< pos count) (< (car (nth pos err-info-list)) line-no)) - (setq pos (1+ pos))) - (when (and (< pos count) (equal (car (nth pos err-info-list)) line-no)) - (setq line-err-info-list (flymake-er-get-line-err-info-list (nth pos err-info-list)))) - (list line-err-info-list pos)) - '(nil 0))) - -(defun flymake-line-err-info-is-less-or-equal (line-one line-two) - (or (string< (flymake-ler-type line-one) (flymake-ler-type line-two)) - (and (string= (flymake-ler-type line-one) (flymake-ler-type line-two)) - (not (flymake-ler-file line-one)) (flymake-ler-file line-two)) - (and (string= (flymake-ler-type line-one) (flymake-ler-type line-two)) - (or (and (flymake-ler-file line-one) (flymake-ler-file line-two)) - (and (not (flymake-ler-file line-one)) (not (flymake-ler-file line-two))))))) - -(defun flymake-add-line-err-info (line-err-info-list line-err-info) - "Update LINE-ERR-INFO-LIST with the error LINE-ERR-INFO. -For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'. -The new element is inserted in the proper position, according to -the predicate `flymake-line-err-info-is-less-or-equal'. -The updated value of LINE-ERR-INFO-LIST is returned." - (if (not line-err-info-list) - (list line-err-info) - (let* ((count (length line-err-info-list)) - (idx 0)) - (while (and (< idx count) (flymake-line-err-info-is-less-or-equal (nth idx line-err-info-list) line-err-info)) - (setq idx (1+ idx))) - (cond ((equal 0 idx) (setq line-err-info-list (cons line-err-info line-err-info-list))) - (t (setq line-err-info-list (flymake-ins-after line-err-info-list (1- idx) line-err-info)))) - line-err-info-list))) - -(defun flymake-add-err-info (err-info-list line-err-info) - "Update ERR-INFO-LIST with the error LINE-ERR-INFO, preserving sort order. -Returns the updated value of ERR-INFO-LIST. -For the format of ERR-INFO-LIST, see `flymake-err-info'. -For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." - (let* ((line-no (if (flymake-ler-file line-err-info) 1 (flymake-ler-line line-err-info))) - (info-and-pos (flymake-find-err-info err-info-list line-no)) - (exists (car info-and-pos)) - (pos (nth 1 info-and-pos)) - (line-err-info-list nil) - (err-info nil)) - - (if exists - (setq line-err-info-list (flymake-er-get-line-err-info-list (car (nthcdr pos err-info-list))))) - (setq line-err-info-list (flymake-add-line-err-info line-err-info-list line-err-info)) - - (setq err-info (flymake-er-make-er line-no line-err-info-list)) - (cond (exists (setq err-info-list (flymake-set-at err-info-list pos err-info))) - ((equal 0 pos) (setq err-info-list (cons err-info err-info-list))) - (t (setq err-info-list (flymake-ins-after err-info-list (1- pos) err-info)))) - err-info-list)) - -(defun flymake-get-project-include-dirs-imp (basedir) - "Include dirs for the project current file belongs to." - (if (flymake-get-project-include-dirs-from-cache basedir) - (progn - (flymake-get-project-include-dirs-from-cache basedir)) - ;;else - (let* ((command-line (concat "make -C " - (shell-quote-argument basedir) - " DUMPVARS=INCLUDE_DIRS dumpvars")) - (output (shell-command-to-string command-line)) - (lines (split-string output "\n" t)) - (count (length lines)) - (idx 0) - (inc-dirs nil)) - (while (and (< idx count) (not (string-match "^INCLUDE_DIRS=.*" (nth idx lines)))) - (setq idx (1+ idx))) - (when (< idx count) - (let* ((inc-lines (split-string (nth idx lines) " *-I" t)) - (inc-count (length inc-lines))) - (while (> inc-count 0) - (when (not (string-match "^INCLUDE_DIRS=.*" (nth (1- inc-count) inc-lines))) - (push (replace-regexp-in-string "\"" "" (nth (1- inc-count) inc-lines)) inc-dirs)) - (setq inc-count (1- inc-count))))) - (flymake-add-project-include-dirs-to-cache basedir inc-dirs) - inc-dirs))) - -(defvar flymake-get-project-include-dirs-function #'flymake-get-project-include-dirs-imp - "Function used to get project include dirs, one parameter: basedir name.") - -(defun flymake-get-project-include-dirs (basedir) - (funcall flymake-get-project-include-dirs-function basedir)) - -(defun flymake-get-system-include-dirs () - "System include dirs - from the `INCLUDE' env setting." - (let* ((includes (getenv "INCLUDE"))) - (if includes (split-string includes path-separator t) nil))) - -(defvar flymake-project-include-dirs-cache (make-hash-table :test #'equal)) - -(defun flymake-get-project-include-dirs-from-cache (base-dir) - (gethash base-dir flymake-project-include-dirs-cache)) - -(defun flymake-add-project-include-dirs-to-cache (base-dir include-dirs) - (puthash base-dir include-dirs flymake-project-include-dirs-cache)) - -(defun flymake-clear-project-include-dirs-cache () - (clrhash flymake-project-include-dirs-cache)) - -(defun flymake-get-include-dirs (base-dir) - "Get dirs to use when resolving local file names." - (let* ((include-dirs (append '(".") (flymake-get-project-include-dirs base-dir) (flymake-get-system-include-dirs)))) - include-dirs)) - -;; (defun flymake-restore-formatting () -;; "Remove any formatting made by flymake." -;; ) - -;; (defun flymake-get-program-dir (buffer) -;; "Get dir to start program in." -;; (unless (bufferp buffer) -;; (error "Invalid buffer")) -;; (with-current-buffer buffer -;; default-directory)) - -(defun flymake-safe-delete-file (file-name) - (when (and file-name (file-exists-p file-name)) - (delete-file file-name) - (flymake-log 1 "deleted file %s" file-name))) - -(defun flymake-safe-delete-directory (dir-name) - (condition-case nil - (progn - (delete-directory dir-name) - (flymake-log 1 "deleted dir %s" dir-name)) - (error - (flymake-log 1 "Failed to delete dir %s, error ignored" dir-name)))) - -(defun flymake-start-syntax-check () - "Start syntax checking for current buffer." - (interactive) - (flymake-log 3 "flymake is running: %s" flymake-is-running) - (when (and (not flymake-is-running) - (flymake-can-syntax-check-file buffer-file-name)) - (when (or (not flymake-compilation-prevents-syntax-check) - (not (flymake-compilation-is-running))) ;+ (flymake-rep-ort-status buffer "COMP") - (flymake-clear-buildfile-cache) - (flymake-clear-project-include-dirs-cache) - - (setq flymake-check-was-interrupted nil) - - (let* ((source-file-name buffer-file-name) - (init-f (flymake-get-init-function source-file-name)) - (cleanup-f (flymake-get-cleanup-function source-file-name)) - (cmd-and-args (funcall init-f)) - (cmd (nth 0 cmd-and-args)) - (args (nth 1 cmd-and-args)) - (dir (nth 2 cmd-and-args))) - (if (not cmd-and-args) - (progn - (flymake-log 0 "init function %s for %s failed, cleaning up" init-f source-file-name) - (funcall cleanup-f)) - (progn - (setq flymake-last-change-time nil) - (flymake-start-syntax-check-process cmd args dir))))))) - -(defun flymake-start-syntax-check-process (cmd args dir) - "Start syntax check process." - (condition-case err - (let* ((process - (let ((default-directory (or dir default-directory))) - (when dir - (flymake-log 3 "starting process on dir %s" dir)) - (apply 'start-file-process - "flymake-proc" (current-buffer) cmd args)))) - (set-process-sentinel process 'flymake-process-sentinel) - (set-process-filter process 'flymake-process-filter) - (set-process-query-on-exit-flag process nil) - (push process flymake-processes) - - (setq flymake-is-running t) - (setq flymake-last-change-time nil) - (setq flymake-check-start-time (float-time)) - - (flymake-report-status nil "*") - (flymake-log 2 "started process %d, command=%s, dir=%s" - (process-id process) (process-command process) - default-directory) - process) - (error - (let* ((err-str - (format-message - "Failed to launch syntax check process `%s' with args %s: %s" - cmd args (error-message-string err))) - (source-file-name buffer-file-name) - (cleanup-f (flymake-get-cleanup-function source-file-name))) - (flymake-log 0 err-str) - (funcall cleanup-f) - (flymake-report-fatal-status "PROCERR" err-str))))) - -(defun flymake-kill-process (proc) - "Kill process PROC." - (kill-process proc) - (let* ((buf (process-buffer proc))) - (when (buffer-live-p buf) - (with-current-buffer buf - (setq flymake-check-was-interrupted t)))) - (flymake-log 1 "killed process %d" (process-id proc))) - -(defun flymake-stop-all-syntax-checks () - "Kill all syntax check processes." - (interactive) - (while flymake-processes - (flymake-kill-process (pop flymake-processes)))) + "Face used for marking warning regions." + :version "24.4") -(defun flymake-compilation-is-running () - (and (boundp 'compilation-in-progress) - compilation-in-progress)) +(defface flymake-note + '((((supports :underline (:style wave))) + :underline (:style wave :color "yellow green")) + (t + :inherit warning)) + "Face used for marking note regions." + :version "26.1") -(defun flymake-compile () - "Kill all flymake syntax checks, start compilation." - (interactive) - (flymake-stop-all-syntax-checks) - (call-interactively 'compile)) - -(defun flymake-on-timer-event (buffer) - "Start a syntax check for buffer BUFFER if necessary." - (when (buffer-live-p buffer) - (with-current-buffer buffer - (when (and (not flymake-is-running) - flymake-last-change-time - (> (- (float-time) flymake-last-change-time) - flymake-no-changes-timeout)) - - (setq flymake-last-change-time nil) - (flymake-log 3 "starting syntax check as more than 1 second passed since last change") - (flymake-start-syntax-check))))) - -(define-obsolete-function-alias 'flymake-display-err-menu-for-current-line - 'flymake-popup-current-error-menu "24.4") - -(defun flymake-popup-current-error-menu (&optional event) - "Pop up a menu with errors/warnings for current line." - (interactive (list last-nonmenu-event)) - (let* ((line-no (line-number-at-pos)) - (errors (or (car (flymake-find-err-info flymake-err-info line-no)) - (user-error "No errors for current line"))) - (menu (mapcar (lambda (x) - (if (flymake-ler-file x) - (cons (format "%s - %s(%d)" - (flymake-ler-text x) - (flymake-ler-file x) - (flymake-ler-line x)) - x) - (list (flymake-ler-text x)))) - errors)) - (event (if (mouse-event-p event) - event - (list 'mouse-1 (posn-at-point)))) - (title (format "Line %d: %d error(s), %d warning(s)" - line-no - (flymake-get-line-err-count errors "e") - (flymake-get-line-err-count errors "w"))) - (choice (x-popup-menu event (list title (cons "" menu))))) - (flymake-log 3 "choice=%s" choice) - (when choice - (flymake-goto-file-and-line (flymake-ler-full-file choice) - (flymake-ler-line choice))))) - -(defun flymake-goto-file-and-line (file line) - "Try to get buffer for FILE and goto line LINE in it." - (if (not (file-exists-p file)) - (flymake-log 1 "File %s does not exist" file) - (find-file file) - (goto-char (point-min)) - (forward-line (1- line)))) - -;; flymake minor mode declarations -(defvar-local flymake-mode-line nil) -(defvar-local flymake-mode-line-e-w nil) -(defvar-local flymake-mode-line-status nil) - -(defun flymake-report-status (e-w &optional status) - "Show status in mode line." - (when e-w - (setq flymake-mode-line-e-w e-w)) - (when status - (setq flymake-mode-line-status status)) - (let* ((mode-line " Flymake")) - (when (> (length flymake-mode-line-e-w) 0) - (setq mode-line (concat mode-line ":" flymake-mode-line-e-w))) - (setq mode-line (concat mode-line flymake-mode-line-status)) - (setq flymake-mode-line mode-line) - (force-mode-line-update))) - -;; Nothing in flymake uses this at all any more, so this is just for +(define-obsolete-face-alias 'flymake-warnline 'flymake-warning "26.1") +(define-obsolete-face-alias 'flymake-errline 'flymake-error "26.1") + +;;;###autoload +(defun flymake-diag-region (buffer line &optional col) + "Compute BUFFER's region (BEG . END) corresponding to LINE and COL. +If COL is nil, return a region just for LINE. Return nil if the +region is invalid." + (condition-case-unless-debug _err + (with-current-buffer buffer + (let ((line (min (max line 1) + (line-number-at-pos (point-max) 'absolute)))) + (save-excursion + (goto-char (point-min)) + (forward-line (1- line)) + (cl-flet ((fallback-bol + () + (back-to-indentation) + (if (eobp) + (line-beginning-position 0) + (point))) + (fallback-eol + (beg) + (progn + (end-of-line) + (skip-chars-backward " \t\f\t\n" beg) + (if (eq (point) beg) + (line-beginning-position 2) + (point))))) + (if (and col (cl-plusp col)) + (let* ((beg (progn (forward-char (1- col)) + (point))) + (sexp-end (ignore-errors (end-of-thing 'sexp))) + (end (or (and sexp-end + (not (= sexp-end beg)) + sexp-end) + (and (< (goto-char (1+ beg)) (point-max)) + (point))))) + (if end + (cons beg end) + (cons (setq beg (fallback-bol)) + (fallback-eol beg)))) + (let* ((beg (fallback-bol)) + (end (fallback-eol beg))) + (cons beg end))))))) + (error (flymake-log :warning "Invalid region line=%s col=%s" line col) + nil))) + +(defvar flymake-diagnostic-functions nil + "Special hook of Flymake backends that check a buffer. + +The functions in this hook diagnose problems in a buffer's +contents and provide information to the Flymake user interface +about where and how to annotate problems diagnosed in a buffer. + +Each backend function must be prepared to accept an arbitrary +number of arguments: + +* the first argument is always REPORT-FN, a callback function + detailed below; + +* the remaining arguments are keyword-value pairs in the + form (:KEY VALUE :KEY2 VALUE2...). Currently, Flymake provides + no such arguments, but backend functions must be prepared to + accept and possibly ignore any number of them. + +Whenever Flymake or the user decides to re-check the buffer, +backend functions are called as detailed above and are expected +to initiate this check, but aren't required to complete it before +exiting: if the computation involved is expensive, especially for +large buffers, that task can be scheduled for the future using +asynchronous processes or other asynchronous mechanisms. + +In any case, backend functions are expected to return quickly or +signal an error, in which case the backend is disabled. Flymake +will not try disabled backends again for any future checks of +this buffer. Certain commands, like turning `flymake-mode' off +and on again, reset the list of disabled backends. + +If the function returns, Flymake considers the backend to be +\"running\". If it has not done so already, the backend is +expected to call the function REPORT-FN with a single argument +REPORT-ACTION also followed by an optional list of keyword-value +pairs in the form (:REPORT-KEY VALUE :REPORT-KEY2 VALUE2...). + +Currently accepted values for REPORT-ACTION are: + +* A (possibly empty) list of diagnostic objects created with + `flymake-make-diagnostic', causing Flymake to annotate the + buffer with this information. + + A backend may call REPORT-FN repeatedly in this manner, but + only until Flymake considers that the most recently requested + buffer check is now obsolete because, say, buffer contents have + changed in the meantime. The backend is only given notice of + this via a renewed call to the backend function. Thus, to + prevent making obsolete reports and wasting resources, backend + functions should first cancel any ongoing processing from + previous calls. + +* The symbol `:panic', signaling that the backend has encountered + an exceptional situation and should be disabled. + +Currently accepted REPORT-KEY arguments are: + +* `:explanation' value should give user-readable details of + the situation encountered, if any. + +* `:force': value should be a boolean suggesting that Flymake + consider the report even if it was somehow unexpected.") + +(put 'flymake-diagnostic-functions 'safe-local-variable #'null) + +(defvar flymake-diagnostic-types-alist + `((:error + . ((flymake-category . flymake-error))) + (:warning + . ((flymake-category . flymake-warning))) + (:note + . ((flymake-category . flymake-note)))) + "Alist ((KEY . PROPS)*) of properties of Flymake diagnostic types. +KEY designates a kind of diagnostic can be anything passed as +`:type' to `flymake-make-diagnostic'. + +PROPS is an alist of properties that are applied, in order, to +the diagnostics of the type designated by KEY. The recognized +properties are: + +* Every property pertaining to overlays, except `category' and + `evaporate' (see Info Node `(elisp)Overlay Properties'), used + to affect the appearance of Flymake annotations. + +* `bitmap', an image displayed in the fringe according to + `flymake-fringe-indicator-position'. The value actually + follows the syntax of `flymake-error-bitmap' (which see). It + is overridden by any `before-string' overlay property. + +* `severity', a non-negative integer specifying the diagnostic's + severity. The higher, the more serious. If the overlay + property `priority' is not specified, `severity' is used to set + it and help sort overlapping overlays. + +* `flymake-category', a symbol whose property list is considered + a default for missing values of any other properties. This is + useful to backend authors when creating new diagnostic types + that differ from an existing type by only a few properties.") + +(put 'flymake-error 'face 'flymake-error) +(put 'flymake-error 'bitmap 'flymake-error-bitmap) +(put 'flymake-error 'severity (warning-numeric-level :error)) +(put 'flymake-error 'mode-line-face 'compilation-error) + +(put 'flymake-warning 'face 'flymake-warning) +(put 'flymake-warning 'bitmap 'flymake-warning-bitmap) +(put 'flymake-warning 'severity (warning-numeric-level :warning)) +(put 'flymake-warning 'mode-line-face 'compilation-warning) + +(put 'flymake-note 'face 'flymake-note) +(put 'flymake-note 'bitmap 'flymake-note-bitmap) +(put 'flymake-note 'severity (warning-numeric-level :debug)) +(put 'flymake-note 'mode-line-face 'compilation-info) + +(defun flymake--lookup-type-property (type prop &optional default) + "Look up PROP for TYPE in `flymake-diagnostic-types-alist'. +If TYPE doesn't declare PROP in either +`flymake-diagnostic-types-alist' or in the symbol of its +associated `flymake-category' return DEFAULT." + (let ((alist-probe (assoc type flymake-diagnostic-types-alist))) + (cond (alist-probe + (let* ((alist (cdr alist-probe)) + (prop-probe (assoc prop alist))) + (if prop-probe + (cdr prop-probe) + (if-let* ((cat (assoc-default 'flymake-category alist)) + (plist (and (symbolp cat) + (symbol-plist cat))) + (cat-probe (plist-member plist prop))) + (cadr cat-probe) + default)))) + (t + default)))) + +(defun flymake--fringe-overlay-spec (bitmap &optional recursed) + (if (and (symbolp bitmap) + (boundp bitmap) + (not recursed)) + (flymake--fringe-overlay-spec + (symbol-value bitmap) t) + (and flymake-fringe-indicator-position + bitmap + (propertize "!" 'display + (cons flymake-fringe-indicator-position + (if (listp bitmap) + bitmap + (list bitmap))))))) + +(defun flymake--highlight-line (diagnostic) + "Highlight buffer with info in DIAGNOSTIC." + (when-let* ((ov (make-overlay + (flymake--diag-beg diagnostic) + (flymake--diag-end diagnostic)))) + ;; First set `category' in the overlay, then copy over every other + ;; property. + ;; + (let ((alist (assoc-default (flymake--diag-type diagnostic) + flymake-diagnostic-types-alist))) + (overlay-put ov 'category (assoc-default 'flymake-category alist)) + (cl-loop for (k . v) in alist + unless (eq k 'category) + do (overlay-put ov k v))) + ;; Now ensure some essential defaults are set + ;; + (cl-flet ((default-maybe + (prop value) + (unless (or (plist-member (overlay-properties ov) prop) + (let ((cat (overlay-get ov + 'flymake-category))) + (and cat + (plist-member (symbol-plist cat) prop)))) + (overlay-put ov prop value)))) + (default-maybe 'bitmap 'flymake-error-bitmap) + (default-maybe 'face 'flymake-error) + (default-maybe 'before-string + (flymake--fringe-overlay-spec + (overlay-get ov 'bitmap))) + (default-maybe 'help-echo + (lambda (window _ov pos) + (with-selected-window window + (mapconcat + #'flymake--diag-text + (flymake-diagnostics pos) + "\n")))) + (default-maybe 'severity (warning-numeric-level :error)) + (default-maybe 'priority (+ 100 (overlay-get ov 'severity)))) + ;; Some properties can't be overridden. + ;; + (overlay-put ov 'evaporate t) + (overlay-put ov 'flymake-diagnostic diagnostic))) + +;; Nothing in Flymake uses this at all any more, so this is just for ;; third-party compatibility. (define-obsolete-function-alias 'flymake-display-warning 'message-box "26.1") -(defun flymake-report-fatal-status (status warning) - "Display a warning and switch flymake mode off." - ;; This first message was always shown by default, and flymake-log - ;; does nothing by default, hence the use of message. - ;; Another option is display-warning. - (if (< flymake-log-level 0) - (message "Flymake: %s. Flymake will be switched OFF" warning)) - (flymake-mode 0) - (flymake-log 0 "switched OFF Flymake mode for buffer %s due to fatal status %s, warning %s" - (buffer-name) status warning)) +(defvar-local flymake--backend-state nil + "Buffer-local hash table of a Flymake backend's state. +The keys to this hash table are functions as found in +`flymake-diagnostic-functions'. The values are structures +of the type `flymake--backend-state', with these slots: + +`running', a symbol to keep track of a backend's replies via its +REPORT-FN argument. A backend is running if this key is +present. If nil, Flymake isn't expecting any replies from the +backend. + +`diags', a (possibly empty) list of recent diagnostic objects +created by the backend with `flymake-make-diagnostic'. + +`reported-p', a boolean indicating if the backend has replied +since it last was contacted. + +`disabled', a string with the explanation for a previous +exceptional situation reported by the backend, nil if the +backend is operating normally.") + +(cl-defstruct (flymake--backend-state + (:constructor flymake--make-backend-state)) + running reported-p disabled diags) + +(defmacro flymake--with-backend-state (backend state-var &rest body) + "Bind BACKEND's STATE-VAR to its state, run BODY." + (declare (indent 2) (debug (sexp sexp &rest form))) + (let ((b (make-symbol "b"))) + `(let* ((,b ,backend) + (,state-var + (or (gethash ,b flymake--backend-state) + (puthash ,b (flymake--make-backend-state) + flymake--backend-state)))) + ,@body))) + +(defun flymake-is-running () + "Tell if Flymake has running backends in this buffer" + (flymake-running-backends)) + +(cl-defun flymake--handle-report (backend token report-action + &key explanation force + &allow-other-keys) + "Handle reports from BACKEND identified by TOKEN. +BACKEND, REPORT-ACTION and EXPLANATION, and FORCE conform to the calling +convention described in `flymake-diagnostic-functions' (which +see). Optional FORCE says to handle a report even if TOKEN was +not expected." + (let* ((state (gethash backend flymake--backend-state)) + (first-report (not (flymake--backend-state-reported-p state)))) + (setf (flymake--backend-state-reported-p state) t) + (let (expected-token + new-diags) + (cond + ((null state) + (flymake-error + "Unexpected report from unknown backend %s" backend)) + ((flymake--backend-state-disabled state) + (flymake-error + "Unexpected report from disabled backend %s" backend)) + ((progn + (setq expected-token (flymake--backend-state-running state)) + (null expected-token)) + ;; should never happen + (flymake-error "Unexpected report from stopped backend %s" backend)) + ((not (or (eq expected-token token) + force)) + (flymake-error "Obsolete report from backend %s with explanation %s" + backend explanation)) + ((eq :panic report-action) + (flymake--disable-backend backend explanation)) + ((not (listp report-action)) + (flymake--disable-backend backend + (format "Unknown action %S" report-action)) + (flymake-error "Expected report, but got unknown key %s" report-action)) + (t + (setq new-diags report-action) + (save-restriction + (widen) + ;; only delete overlays if this is the first report + (when first-report + (flymake-delete-own-overlays + (lambda (ov) + (eq backend + (flymake--diag-backend + (overlay-get ov 'flymake-diagnostic)))))) + (mapc (lambda (diag) + (flymake--highlight-line diag) + (setf (flymake--diag-backend diag) backend)) + new-diags) + (setf (flymake--backend-state-diags state) + (append new-diags (flymake--backend-state-diags state))) + (when flymake-check-start-time + (flymake-log :debug "backend %s reported %d diagnostics in %.2f second(s)" + backend + (length new-diags) + (- (float-time) flymake-check-start-time))) + (when (and (get-buffer (flymake--diagnostics-buffer-name)) + (get-buffer-window (flymake--diagnostics-buffer-name)) + (null (cl-set-difference (flymake-running-backends) + (flymake-reporting-backends)))) + (flymake-show-diagnostics-buffer)))))))) + +(defun flymake-make-report-fn (backend &optional token) + "Make a suitable anonymous report function for BACKEND. +BACKEND is used to help Flymake distinguish different diagnostic +sources. If provided, TOKEN helps Flymake distinguish between +different runs of the same backend." + (let ((buffer (current-buffer))) + (lambda (&rest args) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (apply #'flymake--handle-report backend token args)))))) + +(defun flymake--collect (fn &optional message-prefix) + "Collect Flymake backends matching FN. +If MESSAGE-PREFIX, echo a message using that prefix" + (unless flymake--backend-state + (user-error "Flymake is not initialized")) + (let (retval) + (maphash (lambda (backend state) + (when (funcall fn state) (push backend retval))) + flymake--backend-state) + (when message-prefix + (message "%s%s" + message-prefix + (mapconcat (lambda (s) (format "%s" s)) + retval ", "))) + retval)) + +(defun flymake-running-backends () + "Compute running Flymake backends in current buffer." + (interactive) + (flymake--collect #'flymake--backend-state-running + (and (called-interactively-p 'interactive) + "Running backends: "))) + +(defun flymake-disabled-backends () + "Compute disabled Flymake backends in current buffer." + (interactive) + (flymake--collect #'flymake--backend-state-disabled + (and (called-interactively-p 'interactive) + "Disabled backends: "))) + +(defun flymake-reporting-backends () + "Compute reporting Flymake backends in current buffer." + (interactive) + (flymake--collect #'flymake--backend-state-reported-p + (and (called-interactively-p 'interactive) + "Reporting backends: "))) + +(defun flymake--disable-backend (backend &optional explanation) + "Disable BACKEND because EXPLANATION. +If it is running also stop it." + (flymake-log :warning "Disabling backend %s because %s" backend explanation) + (flymake--with-backend-state backend state + (setf (flymake--backend-state-running state) nil + (flymake--backend-state-disabled state) explanation + (flymake--backend-state-reported-p state) t))) + +(defun flymake--run-backend (backend) + "Run the backend BACKEND, reenabling if necessary." + (flymake-log :debug "Running backend %s" backend) + (let ((run-token (cl-gensym "backend-token"))) + (flymake--with-backend-state backend state + (setf (flymake--backend-state-running state) run-token + (flymake--backend-state-disabled state) nil + (flymake--backend-state-diags state) nil + (flymake--backend-state-reported-p state) nil)) + ;; FIXME: Should use `condition-case-unless-debug' here, but don't + ;; for two reasons: (1) that won't let me catch errors from inside + ;; `ert-deftest' where `debug-on-error' appears to be always + ;; t. (2) In cases where the user is debugging elisp somewhere + ;; else, and using flymake, the presence of a frequently + ;; misbehaving backend in the global hook (most likely the legacy + ;; backend) will trigger an annoying backtrace. + ;; + (condition-case err + (funcall backend + (flymake-make-report-fn backend run-token)) + (error + (flymake--disable-backend backend err))))) + +(defun flymake-start (&optional deferred force) + "Start a syntax check for the current buffer. +DEFERRED is a list of symbols designating conditions to wait for +before actually starting the check. If it is nil (the list is +empty), start it immediately, else defer the check to when those +conditions are met. Currently recognized conditions are +`post-command', for waiting until the current command is over, +`on-display', for waiting until the buffer is actually displayed +in a window. If DEFERRED is t, wait for all known conditions. + +With optional FORCE run even disabled backends. + +Interactively, with a prefix arg, FORCE is t." + (interactive (list nil current-prefix-arg)) + (let ((deferred (if (eq t deferred) + '(post-command on-display) + deferred)) + (buffer (current-buffer))) + (cl-labels + ((start-post-command + () + (remove-hook 'post-command-hook #'start-post-command + nil) + ;; The buffer may have disappeared already, e.g. because of + ;; code like `(with-temp-buffer (python-mode) ...)'. + (when (buffer-live-p buffer) + (with-current-buffer buffer + (flymake-start (remove 'post-command deferred) force)))) + (start-on-display + () + (remove-hook 'window-configuration-change-hook #'start-on-display + 'local) + (flymake-start (remove 'on-display deferred) force))) + (cond ((and (memq 'post-command deferred) + this-command) + (add-hook 'post-command-hook + #'start-post-command + 'append nil)) + ((and (memq 'on-display deferred) + (not (get-buffer-window (current-buffer)))) + (add-hook 'window-configuration-change-hook + #'start-on-display + 'append 'local)) + (t + (setq flymake-check-start-time (float-time)) + (run-hook-wrapped + 'flymake-diagnostic-functions + (lambda (backend) + (cond + ((and (not force) + (flymake--with-backend-state backend state + (flymake--backend-state-disabled state))) + (flymake-log :debug "Backend %s is disabled, not starting" + backend)) + (t + (flymake--run-backend backend))) + nil))))))) + +(defvar flymake-mode-map + (let ((map (make-sparse-keymap))) map) + "Keymap for `flymake-mode'") ;;;###autoload -(define-minor-mode flymake-mode nil - :group 'flymake :lighter flymake-mode-line +(define-minor-mode flymake-mode + "Toggle Flymake mode on or off. +With a prefix argument ARG, enable Flymake mode if ARG is +positive, and disable it otherwise. If called from Lisp, enable +the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. + +Flymake is an Emacs minor mode for on-the-fly syntax checking. +Flymake collects diagnostic information from multiple sources, +called backends, and visually annotates the buffer with the +results. + +Flymake performs these checks while the user is editing. The +customization variables `flymake-start-on-flymake-mode', +`flymake-no-changes-timeout' and +`flymake-start-syntax-check-on-newline' determine the exact +circumstances whereupon Flymake decides to initiate a check of +the buffer. + +The commands `flymake-goto-next-error' and +`flymake-goto-prev-error' can be used to navigate among Flymake +diagnostics annotated in the buffer. + +The visual appearance of each type of diagnostic can be changed +in the variable `flymake-diagnostic-types-alist'. + +Activation or deactivation of backends used by Flymake in each +buffer happens via the special hook +`flymake-diagnostic-functions'. + +Some backends may take longer than others to respond or complete, +and some may decide to disable themselves if they are not +suitable for the current buffer. The commands +`flymake-running-backends', `flymake-disabled-backends' and +`flymake-reporting-backends' summarize the situation, as does the +special *Flymake log* buffer." :group 'flymake :lighter + flymake--mode-line-format :keymap flymake-mode-map (cond - ;; Turning the mode ON. (flymake-mode - (cond - ((not buffer-file-name) - (message "Flymake unable to run without a buffer file name")) - ((not (flymake-can-syntax-check-file buffer-file-name)) - (flymake-log 2 "flymake cannot check syntax in buffer %s" (buffer-name))) - (t - (add-hook 'after-change-functions 'flymake-after-change-function nil t) - (add-hook 'after-save-hook 'flymake-after-save-hook nil t) - (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t) - ;;+(add-hook 'find-file-hook 'flymake-find-file-hook) - - (flymake-report-status "" "") - - (setq flymake-timer - (run-at-time nil 1 'flymake-on-timer-event (current-buffer))) - - (when (and flymake-start-syntax-check-on-find-file - ;; Since we write temp files in current dir, there's no point - ;; trying if the directory is read-only (bug#8954). - (file-writable-p (file-name-directory buffer-file-name))) - (with-demoted-errors - (flymake-start-syntax-check)))))) + (add-hook 'after-change-functions 'flymake-after-change-function nil t) + (add-hook 'after-save-hook 'flymake-after-save-hook nil t) + (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t) + + (setq flymake--backend-state (make-hash-table)) + + (when flymake-start-on-flymake-mode (flymake-start t))) ;; Turning the mode OFF. (t @@ -1248,402 +849,365 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (when flymake-timer (cancel-timer flymake-timer) - (setq flymake-timer nil)) - - (setq flymake-is-running nil)))) + (setq flymake-timer nil))))) + +(defun flymake--schedule-timer-maybe () + "(Re)schedule an idle timer for checking the buffer. +Do it only if `flymake-no-changes-timeout' is non-nil." + (when flymake-timer (cancel-timer flymake-timer)) + (when flymake-no-changes-timeout + (setq + flymake-timer + (run-with-idle-timer + (seconds-to-time flymake-no-changes-timeout) + nil + (lambda (buffer) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (when (and flymake-mode + flymake-no-changes-timeout) + (flymake-log + :debug "starting syntax check after idle for %s seconds" + flymake-no-changes-timeout) + (flymake-start t)) + (setq flymake-timer nil)))) + (current-buffer))))) ;;;###autoload (defun flymake-mode-on () - "Turn flymake mode on." - (flymake-mode 1) - (flymake-log 1 "flymake mode turned ON for buffer %s" (buffer-name))) + "Turn Flymake mode on." + (flymake-mode 1)) ;;;###autoload (defun flymake-mode-off () - "Turn flymake mode off." - (flymake-mode 0) - (flymake-log 1 "flymake mode turned OFF for buffer %s" (buffer-name))) + "Turn Flymake mode off." + (flymake-mode 0)) + +(make-obsolete 'flymake-mode-on 'flymake-mode "26.1") +(make-obsolete 'flymake-mode-off 'flymake-mode "26.1") (defun flymake-after-change-function (start stop _len) "Start syntax check for current buffer if it isn't already running." - ;;+(flymake-log 0 "setting change time to %s" (float-time)) (let((new-text (buffer-substring start stop))) (when (and flymake-start-syntax-check-on-newline (equal new-text "\n")) - (flymake-log 3 "starting syntax check as new-line has been seen") - (flymake-start-syntax-check)) - (setq flymake-last-change-time (float-time)))) + (flymake-log :debug "starting syntax check as new-line has been seen") + (flymake-start t)) + (flymake--schedule-timer-maybe))) (defun flymake-after-save-hook () - (if (local-variable-p 'flymake-mode (current-buffer)) ; (???) other way to determine whether flymake is active in buffer being saved? - (progn - (flymake-log 3 "starting syntax check as buffer was saved") - (flymake-start-syntax-check)))) ; no more mode 3. cannot start check if mode 3 (to temp copies) is active - (???) + (when flymake-mode + (flymake-log :debug "starting syntax check as buffer was saved") + (flymake-start t))) (defun flymake-kill-buffer-hook () (when flymake-timer (cancel-timer flymake-timer) (setq flymake-timer nil))) -;;;###autoload (defun flymake-find-file-hook () - ;;+(when flymake-start-syntax-check-on-find-file - ;;+ (flymake-log 3 "starting syntax check on file open") - ;;+ (flymake-start-syntax-check) - ;;+) - (when (and (not (local-variable-p 'flymake-mode (current-buffer))) - (flymake-can-syntax-check-file buffer-file-name)) + (unless (or flymake-mode + (null flymake-diagnostic-functions)) (flymake-mode) - (flymake-log 3 "automatically turned ON flymake mode"))) - -(defun flymake-get-first-err-line-no (err-info-list) - "Return first line with error." - (when err-info-list - (flymake-er-get-line (car err-info-list)))) - -(defun flymake-get-last-err-line-no (err-info-list) - "Return last line with error." - (when err-info-list - (flymake-er-get-line (nth (1- (length err-info-list)) err-info-list)))) - -(defun flymake-get-next-err-line-no (err-info-list line-no) - "Return next line with error." - (when err-info-list - (let* ((count (length err-info-list)) - (idx 0)) - (while (and (< idx count) (>= line-no (flymake-er-get-line (nth idx err-info-list)))) - (setq idx (1+ idx))) - (if (< idx count) - (flymake-er-get-line (nth idx err-info-list)))))) - -(defun flymake-get-prev-err-line-no (err-info-list line-no) - "Return previous line with error." - (when err-info-list - (let* ((count (length err-info-list))) - (while (and (> count 0) (<= line-no (flymake-er-get-line (nth (1- count) err-info-list)))) - (setq count (1- count))) - (if (> count 0) - (flymake-er-get-line (nth (1- count) err-info-list)))))) - -(defun flymake-skip-whitespace () - "Move forward until non-whitespace is reached." - (while (looking-at "[ \t]") - (forward-char))) - -(defun flymake-goto-line (line-no) - "Go to line LINE-NO, then skip whitespace." - (goto-char (point-min)) - (forward-line (1- line-no)) - (flymake-skip-whitespace)) - -(defun flymake-goto-next-error () - "Go to next error in err ring." + (flymake-log :warning "Turned on in `flymake-find-file-hook'"))) + +(defun flymake-goto-next-error (&optional n filter interactive) + "Go to Nth next Flymake diagnostic that matches FILTER. +Interactively, always move to the next diagnostic. With a prefix +arg, skip any diagnostics with a severity less than `:warning'. + +If `flymake-wrap-around' is non-nil and no more next diagnostics, +resumes search from top. + +FILTER is a list of diagnostic types found in +`flymake-diagnostic-types-alist', or nil, if no filter is to be +applied." + ;; TODO: let filter be a number, a severity below which diags are + ;; skipped. + (interactive (list 1 + (if current-prefix-arg + '(:error :warning)) + t)) + (let* ((n (or n 1)) + (ovs (flymake--overlays :filter + (lambda (ov) + (let ((diag (overlay-get + ov + 'flymake-diagnostic))) + (and diag + (or (not filter) + (memq (flymake--diag-type diag) + filter))))) + :compare (if (cl-plusp n) #'< #'>) + :key #'overlay-start)) + (tail (cl-member-if (lambda (ov) + (if (cl-plusp n) + (> (overlay-start ov) + (point)) + (< (overlay-start ov) + (point)))) + ovs)) + (chain (if flymake-wrap-around + (if tail + (progn (setcdr (last tail) ovs) tail) + (and ovs (setcdr (last ovs) ovs))) + tail)) + (target (nth (1- n) chain))) + (cond (target + (goto-char (overlay-start target)) + (when interactive + (message + "%s" + (funcall (overlay-get target 'help-echo) + (selected-window) target (point))))) + (interactive + (user-error "No more Flymake errors%s" + (if filter + (format " of types %s" filter) + "")))))) + +(defun flymake-goto-prev-error (&optional n filter interactive) + "Go to Nth previous Flymake diagnostic that matches FILTER. +Interactively, always move to the previous diagnostic. With a +prefix arg, skip any diagnostics with a severity less than +`:warning'. + +If `flymake-wrap-around' is non-nil and no more previous +diagnostics, resumes search from bottom. + +FILTER is a list of diagnostic types found in +`flymake-diagnostic-types-alist', or nil, if no filter is to be +applied." + (interactive (list 1 (if current-prefix-arg + '(:error :warning)) + t)) + (flymake-goto-next-error (- (or n 1)) filter interactive)) + + +;;; Mode-line and menu +;;; +(easy-menu-define flymake-menu flymake-mode-map "Flymake" + `("Flymake" + [ "Go to next problem" flymake-goto-next-error t ] + [ "Go to previous problem" flymake-goto-prev-error t ] + [ "Check now" flymake-start t ] + [ "List all problems" flymake-show-diagnostics-buffer t ] + "--" + [ "Go to log buffer" flymake-switch-to-log-buffer t ] + [ "Turn off Flymake" flymake-mode t ])) + +(defvar flymake--mode-line-format `(:eval (flymake--mode-line-format))) + +(put 'flymake--mode-line-format 'risky-local-variable t) + +(defun flymake--mode-line-format () + "Produce a pretty minor mode indicator." + (let* ((known (hash-table-keys flymake--backend-state)) + (running (flymake-running-backends)) + (disabled (flymake-disabled-backends)) + (reported (flymake-reporting-backends)) + (diags-by-type (make-hash-table)) + (all-disabled (and disabled (null running))) + (some-waiting (cl-set-difference running reported))) + (maphash (lambda (_b state) + (mapc (lambda (diag) + (push diag + (gethash (flymake--diag-type diag) + diags-by-type))) + (flymake--backend-state-diags state))) + flymake--backend-state) + `((:propertize " Flymake" + mouse-face mode-line-highlight + help-echo + ,(concat (format "%s known backends\n" (length known)) + (format "%s running\n" (length running)) + (format "%s disabled\n" (length disabled)) + "mouse-1: Display minor mode menu\n" + "mouse-2: Show help for minor mode") + keymap + ,(let ((map (make-sparse-keymap))) + (define-key map [mode-line down-mouse-1] + flymake-menu) + (define-key map [mode-line mouse-2] + (lambda () + (interactive) + (describe-function 'flymake-mode))) + map)) + ,@(pcase-let ((`(,ind ,face ,explain) + (cond ((null known) + `("?" mode-line "No known backends")) + (some-waiting + `("Wait" compilation-mode-line-run + ,(format "Waiting for %s running backend(s)" + (length some-waiting)))) + (all-disabled + `("!" compilation-mode-line-run + "All backends disabled")) + (t + `(nil nil nil))))) + (when ind + `((":" + (:propertize ,ind + face ,face + help-echo ,explain + keymap + ,(let ((map (make-sparse-keymap))) + (define-key map [mode-line mouse-1] + 'flymake-switch-to-log-buffer) + map)))))) + ,@(unless (or all-disabled + (null known)) + (cl-loop + for (type . severity) + in (cl-sort (mapcar (lambda (type) + (cons type (flymake--lookup-type-property + type + 'severity + (warning-numeric-level :error)))) + (cl-union (hash-table-keys diags-by-type) + '(:error :warning))) + #'> + :key #'cdr) + for diags = (gethash type diags-by-type) + for face = (flymake--lookup-type-property type + 'mode-line-face + 'compilation-error) + when (or diags + (>= severity (warning-numeric-level :warning))) + collect `(:propertize + ,(format "%d" (length diags)) + face ,face + mouse-face mode-line-highlight + keymap + ,(let ((map (make-sparse-keymap)) + (type type)) + (define-key map (vector 'mode-line + mouse-wheel-down-event) + (lambda (event) + (interactive "e") + (with-selected-window (posn-window (event-start event)) + (flymake-goto-prev-error 1 (list type) t)))) + (define-key map (vector 'mode-line + mouse-wheel-up-event) + (lambda (event) + (interactive "e") + (with-selected-window (posn-window (event-start event)) + (flymake-goto-next-error 1 (list type) t)))) + map) + help-echo + ,(concat (format "%s diagnostics of type %s\n" + (propertize (format "%d" + (length diags)) + 'face face) + (propertize (format "%s" type) + 'face face)) + (format "%s/%s: previous/next of this type" + mouse-wheel-down-event + mouse-wheel-up-event))) + into forms + finally return + `((:propertize "[") + ,@(cl-loop for (a . rest) on forms by #'cdr + collect a when rest collect + '(:propertize " ")) + (:propertize "]"))))))) + +;;; Diagnostics buffer + +(defvar-local flymake--diagnostics-buffer-source nil) + +(defvar flymake-diagnostics-buffer-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") 'flymake-goto-diagnostic) + (define-key map (kbd "SPC") 'flymake-show-diagnostic) + map)) + +(defun flymake-show-diagnostic (pos &optional other-window) + "Show location of diagnostic at POS." + (interactive (list (point) t)) + (let* ((id (or (tabulated-list-get-id pos) + (user-error "Nothing at point"))) + (diag (plist-get id :diagnostic))) + (with-current-buffer (flymake--diag-buffer diag) + (with-selected-window + (display-buffer (current-buffer) other-window) + (goto-char (flymake--diag-beg diag)) + (pulse-momentary-highlight-region (flymake--diag-beg diag) + (flymake--diag-end diag) + 'highlight)) + (current-buffer)))) + +(defun flymake-goto-diagnostic (pos) + "Show location of diagnostic at POS. +POS can be a buffer position or a button" + (interactive "d") + (pop-to-buffer + (flymake-show-diagnostic (if (button-type pos) (button-start pos) pos)))) + +(defun flymake--diagnostics-buffer-entries () + (with-current-buffer flymake--diagnostics-buffer-source + (cl-loop for diag in + (cl-sort (flymake-diagnostics) #'< :key #'flymake-diagnostic-beg) + for (line . col) = + (save-excursion + (goto-char (flymake--diag-beg diag)) + (cons (line-number-at-pos) + (- (point) + (line-beginning-position)))) + for type = (flymake--diag-type diag) + collect + (list (list :diagnostic diag + :line line + :severity (flymake--lookup-type-property + type + 'severity (warning-numeric-level :error))) + `[,(format "%s" line) + ,(format "%s" col) + ,(propertize (format "%s" type) + 'face (flymake--lookup-type-property + type 'mode-line-face 'flymake-error)) + (,(format "%s" (flymake--diag-text diag)) + mouse-face highlight + help-echo "mouse-2: visit this diagnostic" + face nil + action flymake-goto-diagnostic + mouse-action flymake-goto-diagnostic)])))) + +(define-derived-mode flymake-diagnostics-buffer-mode tabulated-list-mode + "Flymake diagnostics" + "A mode for listing Flymake diagnostics." + (setq tabulated-list-format + `[("Line" 5 (lambda (l1 l2) + (< (plist-get (car l1) :line) + (plist-get (car l2) :line))) + :right-align t) + ("Col" 3 nil :right-align t) + ("Type" 8 (lambda (l1 l2) + (< (plist-get (car l1) :severity) + (plist-get (car l2) :severity)))) + ("Message" 0 t)]) + (setq tabulated-list-entries + 'flymake--diagnostics-buffer-entries) + (tabulated-list-init-header)) + +(defun flymake--diagnostics-buffer-name () + (format "*Flymake diagnostics for %s*" (current-buffer))) + +(defun flymake-show-diagnostics-buffer () + "Show a list of Flymake diagnostics for current buffer." (interactive) - (let ((line-no (flymake-get-next-err-line-no flymake-err-info (line-number-at-pos)))) - (when (not line-no) - (setq line-no (flymake-get-first-err-line-no flymake-err-info)) - (flymake-log 1 "passed end of file")) - (if line-no - (flymake-goto-line line-no) - (flymake-log 1 "no errors in current buffer")))) - -(defun flymake-goto-prev-error () - "Go to previous error in err ring." - (interactive) - (let ((line-no (flymake-get-prev-err-line-no flymake-err-info (line-number-at-pos)))) - (when (not line-no) - (setq line-no (flymake-get-last-err-line-no flymake-err-info)) - (flymake-log 1 "passed beginning of file")) - (if line-no - (flymake-goto-line line-no) - (flymake-log 1 "no errors in current buffer")))) - -(defun flymake-patch-err-text (string) - (if (string-match "^[\n\t :0-9]*\\(.*\\)$" string) - (match-string 1 string) - string)) - -;;;; general init-cleanup and helper routines -(defun flymake-create-temp-inplace (file-name prefix) - (unless (stringp file-name) - (error "Invalid file-name")) - (or prefix - (setq prefix "flymake")) - (let* ((ext (file-name-extension file-name)) - (temp-name (file-truename - (concat (file-name-sans-extension file-name) - "_" prefix - (and ext (concat "." ext)))))) - (flymake-log 3 "create-temp-inplace: file=%s temp=%s" file-name temp-name) - temp-name)) - -(defun flymake-create-temp-with-folder-structure (file-name _prefix) - (unless (stringp file-name) - (error "Invalid file-name")) - - (let* ((dir (file-name-directory file-name)) - ;; Not sure what this slash-pos is all about, but I guess it's just - ;; trying to remove the leading / of absolute file names. - (slash-pos (string-match "/" dir)) - (temp-dir (expand-file-name (substring dir (1+ slash-pos)) - temporary-file-directory))) - - (file-truename (expand-file-name (file-name-nondirectory file-name) - temp-dir)))) - -(defun flymake-delete-temp-directory (dir-name) - "Attempt to delete temp dir created by `flymake-create-temp-with-folder-structure', do not fail on error." - (let* ((temp-dir temporary-file-directory) - (suffix (substring dir-name (1+ (length temp-dir))))) - - (while (> (length suffix) 0) - (setq suffix (directory-file-name suffix)) - ;;+(flymake-log 0 "suffix=%s" suffix) - (flymake-safe-delete-directory - (file-truename (expand-file-name suffix temp-dir))) - (setq suffix (file-name-directory suffix))))) - -(defvar-local flymake-temp-source-file-name nil) -(defvar-local flymake-master-file-name nil) -(defvar-local flymake-temp-master-file-name nil) -(defvar-local flymake-base-dir nil) - -(defun flymake-init-create-temp-buffer-copy (create-temp-f) - "Make a temporary copy of the current buffer, save its name in buffer data and return the name." - (let* ((source-file-name buffer-file-name) - (temp-source-file-name (funcall create-temp-f source-file-name "flymake"))) - - (flymake-save-buffer-in-file temp-source-file-name) - (setq flymake-temp-source-file-name temp-source-file-name) - temp-source-file-name)) - -(defun flymake-simple-cleanup () - "Do cleanup after `flymake-init-create-temp-buffer-copy'. -Delete temp file." - (flymake-safe-delete-file flymake-temp-source-file-name) - (setq flymake-last-change-time nil)) - -(defun flymake-get-real-file-name (file-name-from-err-msg) - "Translate file name from error message to \"real\" file name. -Return full-name. Names are real, not patched." - (let* ((real-name nil) - (source-file-name buffer-file-name) - (master-file-name flymake-master-file-name) - (temp-source-file-name flymake-temp-source-file-name) - (temp-master-file-name flymake-temp-master-file-name) - (base-dirs - (list flymake-base-dir - (file-name-directory source-file-name) - (if master-file-name (file-name-directory master-file-name)))) - (files (list (list source-file-name source-file-name) - (list temp-source-file-name source-file-name) - (list master-file-name master-file-name) - (list temp-master-file-name master-file-name)))) - - (when (equal 0 (length file-name-from-err-msg)) - (setq file-name-from-err-msg source-file-name)) - - (setq real-name (flymake-get-full-patched-file-name file-name-from-err-msg base-dirs files)) - ;; if real-name is nil, than file name from err msg is none of the files we've patched - (if (not real-name) - (setq real-name (flymake-get-full-nonpatched-file-name file-name-from-err-msg base-dirs))) - (if (not real-name) - (setq real-name file-name-from-err-msg)) - (setq real-name (flymake-fix-file-name real-name)) - (flymake-log 3 "get-real-file-name: file-name=%s real-name=%s" file-name-from-err-msg real-name) - real-name)) - -(defun flymake-get-full-patched-file-name (file-name-from-err-msg base-dirs files) - (let* ((base-dirs-count (length base-dirs)) - (file-count (length files)) - (real-name nil)) - - (while (and (not real-name) (> base-dirs-count 0)) - (setq file-count (length files)) - (while (and (not real-name) (> file-count 0)) - (let* ((this-dir (nth (1- base-dirs-count) base-dirs)) - (this-file (nth 0 (nth (1- file-count) files))) - (this-real-name (nth 1 (nth (1- file-count) files)))) - ;;+(flymake-log 0 "this-dir=%s this-file=%s this-real=%s msg-file=%s" this-dir this-file this-real-name file-name-from-err-msg) - (when (and this-dir this-file (flymake-same-files - (expand-file-name file-name-from-err-msg this-dir) - this-file)) - (setq real-name this-real-name))) - (setq file-count (1- file-count))) - (setq base-dirs-count (1- base-dirs-count))) - real-name)) - -(defun flymake-get-full-nonpatched-file-name (file-name-from-err-msg base-dirs) - (let* ((real-name nil)) - (if (file-name-absolute-p file-name-from-err-msg) - (setq real-name file-name-from-err-msg) - (let* ((base-dirs-count (length base-dirs))) - (while (and (not real-name) (> base-dirs-count 0)) - (let* ((full-name (expand-file-name file-name-from-err-msg - (nth (1- base-dirs-count) base-dirs)))) - (if (file-exists-p full-name) - (setq real-name full-name)) - (setq base-dirs-count (1- base-dirs-count)))))) - real-name)) - -(defun flymake-init-find-buildfile-dir (source-file-name buildfile-name) - "Find buildfile, store its dir in buffer data and return its dir, if found." - (let* ((buildfile-dir - (flymake-find-buildfile buildfile-name - (file-name-directory source-file-name)))) - (if buildfile-dir - (setq flymake-base-dir buildfile-dir) - (flymake-log 1 "no buildfile (%s) for %s" buildfile-name source-file-name) - (flymake-report-fatal-status - "NOMK" (format "No buildfile (%s) found for %s" - buildfile-name source-file-name))))) - -(defun flymake-init-create-temp-source-and-master-buffer-copy (get-incl-dirs-f create-temp-f master-file-masks include-regexp) - "Find master file (or buffer), create its copy along with a copy of the source file." - (let* ((source-file-name buffer-file-name) - (temp-source-file-name (flymake-init-create-temp-buffer-copy create-temp-f)) - (master-and-temp-master (flymake-create-master-file - source-file-name temp-source-file-name - get-incl-dirs-f create-temp-f - master-file-masks include-regexp))) - - (if (not master-and-temp-master) - (progn - (flymake-log 1 "cannot find master file for %s" source-file-name) - (flymake-report-status "!" "") ; NOMASTER - nil) - (setq flymake-master-file-name (nth 0 master-and-temp-master)) - (setq flymake-temp-master-file-name (nth 1 master-and-temp-master))))) - -(defun flymake-master-cleanup () - (flymake-simple-cleanup) - (flymake-safe-delete-file flymake-temp-master-file-name)) - -;;;; make-specific init-cleanup routines -(defun flymake-get-syntax-check-program-args (source-file-name base-dir use-relative-base-dir use-relative-source get-cmd-line-f) - "Create a command line for syntax check using GET-CMD-LINE-F." - (funcall get-cmd-line-f - (if use-relative-source - (file-relative-name source-file-name base-dir) - source-file-name) - (if use-relative-base-dir - (file-relative-name base-dir - (file-name-directory source-file-name)) - base-dir))) - -(defun flymake-get-make-cmdline (source base-dir) - (list "make" - (list "-s" - "-C" - base-dir - (concat "CHK_SOURCES=" source) - "SYNTAX_CHECK_MODE=1" - "check-syntax"))) - -(defun flymake-get-ant-cmdline (source base-dir) - (list "ant" - (list "-buildfile" - (concat base-dir "/" "build.xml") - (concat "-DCHK_SOURCES=" source) - "check-syntax"))) - -(defun flymake-simple-make-init-impl (create-temp-f use-relative-base-dir use-relative-source build-file-name get-cmdline-f) - "Create syntax check command line for a directly checked source file. -Use CREATE-TEMP-F for creating temp copy." - (let* ((args nil) - (source-file-name buffer-file-name) - (buildfile-dir (flymake-init-find-buildfile-dir source-file-name build-file-name))) - (if buildfile-dir - (let* ((temp-source-file-name (flymake-init-create-temp-buffer-copy create-temp-f))) - (setq args (flymake-get-syntax-check-program-args temp-source-file-name buildfile-dir - use-relative-base-dir use-relative-source - get-cmdline-f)))) - args)) - -(defun flymake-simple-make-init () - (flymake-simple-make-init-impl 'flymake-create-temp-inplace t t "Makefile" 'flymake-get-make-cmdline)) - -(defun flymake-master-make-init (get-incl-dirs-f master-file-masks include-regexp) - "Create make command line for a source file checked via master file compilation." - (let* ((make-args nil) - (temp-master-file-name (flymake-init-create-temp-source-and-master-buffer-copy - get-incl-dirs-f 'flymake-create-temp-inplace - master-file-masks include-regexp))) - (when temp-master-file-name - (let* ((buildfile-dir (flymake-init-find-buildfile-dir temp-master-file-name "Makefile"))) - (if buildfile-dir - (setq make-args (flymake-get-syntax-check-program-args - temp-master-file-name buildfile-dir nil nil 'flymake-get-make-cmdline))))) - make-args)) - -(defun flymake-find-make-buildfile (source-dir) - (flymake-find-buildfile "Makefile" source-dir)) - -;;;; .h/make specific -(defun flymake-master-make-header-init () - (flymake-master-make-init - 'flymake-get-include-dirs - '("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'") - "[ \t]*#[ \t]*include[ \t]*\"\\([[:word:]0-9/\\_.]*%s\\)\"")) - -;;;; .java/make specific -(defun flymake-simple-make-java-init () - (flymake-simple-make-init-impl 'flymake-create-temp-with-folder-structure nil nil "Makefile" 'flymake-get-make-cmdline)) - -(defun flymake-simple-ant-java-init () - (flymake-simple-make-init-impl 'flymake-create-temp-with-folder-structure nil nil "build.xml" 'flymake-get-ant-cmdline)) - -(defun flymake-simple-java-cleanup () - "Cleanup after `flymake-simple-make-java-init' -- delete temp file and dirs." - (flymake-safe-delete-file flymake-temp-source-file-name) - (when flymake-temp-source-file-name - (flymake-delete-temp-directory - (file-name-directory flymake-temp-source-file-name)))) - -;;;; perl-specific init-cleanup routines -(defun flymake-perl-init () - (let* ((temp-file (flymake-init-create-temp-buffer-copy - 'flymake-create-temp-inplace)) - (local-file (file-relative-name - temp-file - (file-name-directory buffer-file-name)))) - (list "perl" (list "-wc " local-file)))) - -;;;; php-specific init-cleanup routines -(defun flymake-php-init () - (let* ((temp-file (flymake-init-create-temp-buffer-copy - 'flymake-create-temp-inplace)) - (local-file (file-relative-name - temp-file - (file-name-directory buffer-file-name)))) - (list "php" (list "-f" local-file "-l")))) - -;;;; tex-specific init-cleanup routines -(defun flymake-get-tex-args (file-name) - ;;(list "latex" (list "-c-style-errors" file-name)) - (list "texify" (list "--pdf" "--tex-option=-c-style-errors" file-name))) - -(defun flymake-simple-tex-init () - (flymake-get-tex-args (flymake-init-create-temp-buffer-copy 'flymake-create-temp-inplace))) - -;; Perhaps there should be a buffer-local variable flymake-master-file -;; that people can set to override this stuff. Could inherit from -;; the similar AUCTeX variable. -(defun flymake-master-tex-init () - (let* ((temp-master-file-name (flymake-init-create-temp-source-and-master-buffer-copy - 'flymake-get-include-dirs-dot 'flymake-create-temp-inplace - '("\\.tex\\'") - "[ \t]*\\in\\(?:put\\|clude\\)[ \t]*{\\(.*%s\\)}"))) - (when temp-master-file-name - (flymake-get-tex-args temp-master-file-name)))) - -(defun flymake-get-include-dirs-dot (_base-dir) - '(".")) - -;;;; xml-specific init-cleanup routines -(defun flymake-xml-init () - (list flymake-xml-program - (list "val" (flymake-init-create-temp-buffer-copy - 'flymake-create-temp-inplace)))) + (let* ((name (flymake--diagnostics-buffer-name)) + (source (current-buffer)) + (target (or (get-buffer name) + (with-current-buffer (get-buffer-create name) + (flymake-diagnostics-buffer-mode) + (setq flymake--diagnostics-buffer-source source) + (current-buffer))))) + (with-current-buffer target + (revert-buffer) + (display-buffer (current-buffer))))) (provide 'flymake) + +(require 'flymake-proc) + ;;; flymake.el ends here diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el index b15da92a5c1..b73ee2525fd 100644 --- a/lisp/progmodes/fortran.el +++ b/lisp/progmodes/fortran.el @@ -20,7 +20,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index cc9205c0d8a..58552759b95 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -21,7 +21,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Credits: @@ -400,14 +400,22 @@ valid signal handlers.") (const :tag "Unlimited" nil)) :version "22.1") -(defcustom gdb-non-stop-setting t - "When in non-stop mode, stopped threads can be examined while +(defcustom gdb-non-stop-setting (not (eq system-type 'windows-nt)) + "If non-nil, GDB sessions are expected to support the non-stop mode. +When in the non-stop mode, stopped threads can be examined while other threads continue to execute. +If this is non-nil, GDB will be sent the \"set non-stop 1\" command, +and if that results in an error, the non-stop setting will be +turned off automatically. + +On MS-Windows, this is off by default, because MS-Windows targets +don't support the non-stop mode. + GDB session needs to be restarted for this setting to take effect." :type 'boolean :group 'gdb-non-stop - :version "23.2") + :version "26.1") ;; TODO Some commands can't be called with --all (give a notice about ;; it in setting doc) @@ -2188,7 +2196,10 @@ a GDB/MI reply message." (defun gdbmi-bnf-console-stream-output (c-string) "Handler for the console-stream-output GDB/MI output grammar rule." - (gdb-console c-string)) + (gdb-console c-string) + ;; We've written to the GUD console, so we should print the prompt + ;; after the next result-class or async-class. + (setq gdb-first-done-or-error t)) (defun gdbmi-bnf-target-stream-output (_c-string) "Handler for the target-stream-output GDB/MI output grammar rule." @@ -2374,7 +2385,7 @@ file names include non-ASCII characters." ;; sequences are not split between chunks of output of the GDB process ;; due to buffering, and arrive together. Finally, if some string ;; included literal \nnn strings (as opposed to non-ASCII characters -;; converted by by GDB/MI to octal escapes), this decoding will mangle +;; converted by GDB/MI to octal escapes), this decoding will mangle ;; those strings. When/if GDB acquires the ability to not ;; escape-protect non-ASCII characters in its MI output, this kludge ;; should be removed. diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el index f476ac0a566..699ef2eee82 100644 --- a/lisp/progmodes/glasses.el +++ b/lisp/progmodes/glasses.el @@ -19,7 +19,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index b3d8a51ceeb..c2d80223541 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -20,7 +20,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -31,7 +31,6 @@ (require 'compile) - (defgroup grep nil "Run `grep' and display the results." :group 'tools @@ -47,8 +46,8 @@ to avoid computing them again.") (defun grep-apply-setting (symbol value) "Set SYMBOL to VALUE, and update `grep-host-defaults-alist'. SYMBOL should be one of `grep-command', `grep-template', -`grep-use-null-device', `grep-find-command', -`grep-find-template', `grep-find-use-xargs', or +`grep-use-null-device', `grep-find-command' `grep-find-template', +`grep-find-use-xargs', `grep-use-null-filename-separator', or `grep-highlight-matches'." (when grep-host-defaults-alist (let* ((host-id @@ -160,6 +159,15 @@ Customize or call the function `grep-apply-setting'." :set 'grep-apply-setting :group 'grep) +(defcustom grep-use-null-filename-separator 'auto-detect + "If non-nil, use `grep's `--null' option. +This is done to disambiguate file names in `grep's output." + :type '(choice (const :tag "Do Not Use `--null'" nil) + (const :tag "Use `--null'" t) + (other :tag "Not Set" auto-detect)) + :set 'grep-apply-setting + :group 'grep) + ;;;###autoload (defcustom grep-find-command nil "The default find command for \\[grep-find]. @@ -359,31 +367,42 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies ;;;###autoload (defconst grep-regexp-alist - '( - ;; Use a tight regexp to handle weird file names (with colons - ;; in them) as well as possible. E.g., use [1-9][0-9]* rather - ;; than [0-9]+ so as to accept ":034:" in file names. - ("^\\(.*?[^/\n]\\):[ \t]*\\([1-9][0-9]*\\)[ \t]*:" + `((,(concat "^\\(?:" + ;; Parse using NUL characters when `--null' is used. + ;; Note that we must still assume no newlines in + ;; filenames due to "foo: Is a directory." type + ;; messages. + "\\(?1:[^\0\n]+\\)\\(?3:\0\\)\\(?2:[0-9]+\\):" + "\\|" + ;; Fallback if `--null' is not used, use a tight regexp + ;; to handle weird file names (with colons in them) as + ;; well as possible. E.g., use [1-9][0-9]* rather than + ;; [0-9]+ so as to accept ":034:" in file names. + "\\(?1:[^\n:]+?[^\n/:]\\):[\t ]*\\(?2:[1-9][0-9]*\\)[\t ]*:" + "\\)") 1 2 ;; Calculate column positions (col . end-col) of first grep match on a line - ((lambda () - (when grep-highlight-matches - (let* ((beg (match-end 0)) - (end (save-excursion (goto-char beg) (line-end-position))) - (mbeg (text-property-any beg end 'font-lock-face grep-match-face))) - (when mbeg - (- mbeg beg))))) + (,(lambda () + (when grep-highlight-matches + (let* ((beg (match-end 0)) + (end (save-excursion (goto-char beg) (line-end-position))) + (mbeg (text-property-any beg end 'font-lock-face 'grep-match-face))) + (when mbeg + (- mbeg beg))))) . - (lambda () - (when grep-highlight-matches - (let* ((beg (match-end 0)) - (end (save-excursion (goto-char beg) (line-end-position))) - (mbeg (text-property-any beg end 'font-lock-face grep-match-face)) - (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) - (when mend - (- mend beg))))))) + ,(lambda () + (when grep-highlight-matches + (let* ((beg (match-end 0)) + (end (save-excursion (goto-char beg) (line-end-position))) + (mbeg (text-property-any beg end 'font-lock-face 'grep-match-face)) + (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) + (when mend + (- mend beg)))))) + nil nil + (3 '(face nil display ":"))) ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) - "Regexp used to match grep hits. See `compilation-error-regexp-alist'.") + "Regexp used to match grep hits. +See `compilation-error-regexp-alist' for format details.") (defvar grep-first-column 0 ; bug#10594 "Value to use for `compilation-first-column' in grep buffers.") @@ -422,7 +441,9 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies (2 grep-error-face nil t)) ;; "filename-linenumber-" format is used for context lines in GNU grep, ;; "filename=linenumber=" for lines with function names in "git grep -p". - ("^.+?[-=][0-9]+[-=].*\n" (0 grep-context-face))) + ("^.+?\\([-=\0]\\)[0-9]+\\([-=]\\).*\n" (0 grep-context-face) + (1 (if (eq (char-after (match-beginning 1)) ?\0) + `(face nil display ,(match-string 2)))))) "Additional things to highlight in grep output. This gets tacked on the end of the generated expressions.") @@ -538,6 +559,8 @@ This function is called from `compilation-filter-hook'." (grep-use-null-device ,grep-use-null-device) (grep-find-command ,grep-find-command) (grep-find-template ,grep-find-template) + (grep-use-null-filename-separator + ,grep-use-null-filename-separator) (grep-find-use-xargs ,grep-find-use-xargs) (grep-highlight-matches ,grep-highlight-matches))))) (let* ((host-id @@ -550,7 +573,8 @@ This function is called from `compilation-filter-hook'." ;; computed for every host once. (dolist (setting '(grep-command grep-template grep-use-null-device grep-find-command - grep-find-template grep-find-use-xargs + grep-use-null-filename-separator + grep-find-template grep-find-use-xargs grep-highlight-matches)) (set setting (cadr (or (assq setting host-defaults) @@ -576,6 +600,21 @@ This function is called from `compilation-filter-hook'." (concat (regexp-quote hello-file) ":[0-9]+:English"))))))))) + (when (eq grep-use-null-filename-separator 'auto-detect) + (setq grep-use-null-filename-separator + (with-temp-buffer + (let* ((hello-file (expand-file-name "HELLO" data-directory)) + (args `("--null" "-ne" "^English" ,hello-file))) + (if grep-use-null-device + (setq args (append args (list null-device))) + (push "-H" args)) + (and (grep-probe grep-program `(nil t nil ,@args)) + (progn + (goto-char (point-min)) + (looking-at + (concat (regexp-quote hello-file) + "\0[0-9]+:English")))))))) + (when (eq grep-highlight-matches 'auto-detect) (setq grep-highlight-matches (with-temp-buffer @@ -591,6 +630,7 @@ This function is called from `compilation-filter-hook'." grep-template grep-find-template) (let ((grep-options (concat (if grep-use-null-device "-n" "-nH") + (if grep-use-null-filename-separator " --null") (if (grep-probe grep-program `(nil nil nil "-e" "foo" ,null-device) nil 1) @@ -863,7 +903,10 @@ substitution string. Note dynamic scoping of variables.") (read-regexp "Search for" 'grep-tag-default 'grep-regexp-history)) (defun grep-read-files (regexp) - "Read files arg for interactive grep." + "Read a file-name pattern arg for interactive grep. +The pattern can include shell wildcards. As whitespace triggers +completion when entering a pattern, including it requires +quoting, e.g. `\\[quoted-insert]<space>'." (let* ((bn (or (buffer-file-name) (replace-regexp-in-string "<[0-9]+>\\'" "" (buffer-name)))) (fn (and bn @@ -896,7 +939,7 @@ substitution string. Note dynamic scoping of variables.") (car (car grep-files-aliases)))) (files (completing-read (concat "Search for \"" regexp - "\" in files" + "\" in files matching wildcard" (if default (concat " (default " default ")")) ": ") 'read-file-name-internal @@ -913,7 +956,9 @@ substitution string. Note dynamic scoping of variables.") "Run grep, searching for REGEXP in FILES in directory DIR. The search is limited to file names matching shell pattern FILES. FILES may use abbreviations defined in `grep-files-aliases', e.g. -entering `ch' is equivalent to `*.[ch]'. +entering `ch' is equivalent to `*.[ch]'. As whitespace triggers +completion when entering a pattern, including it requires +quoting, e.g. `\\[quoted-insert]<space>'. With \\[universal-argument] prefix, you can edit the constructed shell command line before it is executed. @@ -991,7 +1036,9 @@ This command shares argument histories with \\[rgrep] and \\[grep]." "Recursively grep for REGEXP in FILES in directory tree rooted at DIR. The search is limited to file names matching shell pattern FILES. FILES may use abbreviations defined in `grep-files-aliases', e.g. -entering `ch' is equivalent to `*.[ch]'. +entering `ch' is equivalent to `*.[ch]'. As whitespace triggers +completion when entering a pattern, including it requires +quoting, e.g. `\\[quoted-insert]<space>'. With \\[universal-argument] prefix, you can edit the constructed shell command line before it is executed. diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index e9ca7eade36..7d044b294da 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -20,7 +20,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -1830,7 +1830,7 @@ and source-file directory for your debugger." ;; ;; Type M-n to step over the current line and M-s to step into it. That, ;; along with the JDB 'help' command should get you started. The 'quit' -;; JDB command will get out out of the debugger. There is some truly +;; JDB command will get out of the debugger. There is some truly ;; pathetic JDB documentation available at: ;; ;; http://java.sun.com/products/jdk/1.1/debugging/ diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index b34ea1c4ae1..b1a2a35d55f 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -20,7 +20,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -1657,8 +1657,8 @@ first arg will be `hif-etc'." ;; The original version of hideif evaluates the macro early and store the ;; final values for the defined macro into the symbol database (aka -;; `hide-ifdef-env'). The evaluation process is "strings -> tokens -> parsed -;; tree -> [value]". (The square bracket refers to what's stored in in our +;; `hide-ifdef-env'). The evaluation process is "strings -> tokens -> parsed +;; tree -> [value]". (The square bracket refers to what's stored in our ;; `hide-ifdef-env'.) ;; ;; This forbids the evaluation of an argumented macro since the parameters diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 5328526abd9..f3abf373d4e 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -21,7 +21,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/icon.el b/lisp/progmodes/icon.el index 92a89fef70b..a164b703f18 100644 --- a/lisp/progmodes/icon.el +++ b/lisp/progmodes/icon.el @@ -19,7 +19,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/idlw-complete-structtag.el b/lisp/progmodes/idlw-complete-structtag.el index d2758ccd62e..a7e49b6ea44 100644 --- a/lisp/progmodes/idlw-complete-structtag.el +++ b/lisp/progmodes/idlw-complete-structtag.el @@ -21,7 +21,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -148,9 +148,9 @@ an up-to-date completion list." (not (equal start idlwave-current-tags-completion-pos))) (idlwave-prepare-structure-tag-completion var)) (setq idlwave-current-tags-completion-pos start) - (setq idlwave-completion-help-info + (setq idlwave-completion-help-info (list 'idlwave-complete-structure-tag-help)) - (idlwave-complete-in-buffer 'structtag 'structtag + (idlwave-complete-in-buffer 'structtag 'structtag idlwave-current-struct-tags nil "Select a structure tag" "structure tag") t) ; we did the completion: return t to skip other completions @@ -169,7 +169,7 @@ an up-to-date completion list." (if (derived-mode-p 'idlwave-shell-mode) ;; OK, we are in the shell, do it dynamically (progn - (message "preparing shell tags") + (message "preparing shell tags") ;; The following call puts the tags into `idlwave-current-struct-tags' (idlwave-complete-structure-tag-query-shell var) ;; initialize @@ -191,7 +191,7 @@ an up-to-date completion list." ;; Find possible definitions of the structure. (while (idlwave-find-structure-definition var nil 'all) (let ((tags (idlwave-struct-tags))) - (when tags + (when tags ;; initialize (setq idlwave-sint-structtags nil idlwave-current-tags-buffer (current-buffer) diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index e82ed06164d..244e2b38436 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el @@ -20,7 +20,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index e7497e8e4fd..39d24d4f9d9 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -22,7 +22,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: ;; diff --git a/lisp/progmodes/idlw-toolbar.el b/lisp/progmodes/idlw-toolbar.el index 2fda49d91f4..c53e5e5989a 100644 --- a/lisp/progmodes/idlw-toolbar.el +++ b/lisp/progmodes/idlw-toolbar.el @@ -20,7 +20,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index f070000c867..92a42b1cb94 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -22,7 +22,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -5240,7 +5240,7 @@ Can run from `after-save-hook'." class (cond ((not (boundp 'idlwave-scanning-lib)) (list 'buffer (buffer-file-name))) -; ((string= (downcase (file-name-base)) +; ((string= (downcase (file-name-base (buffer-file-name)) ; (downcase name)) ; (list 'lib)) ; (t (cons 'lib (file-name-nondirectory (buffer-file-name)))) diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el index 7de3a796ae1..e398c3ed64e 100644 --- a/lisp/progmodes/inf-lisp.el +++ b/lisp/progmodes/inf-lisp.el @@ -19,7 +19,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index bae9e52bf0f..1f86909362e 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -22,7 +22,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary @@ -475,6 +475,11 @@ This applies to function movement, marking, and so on." :type 'boolean :group 'js) +(defcustom js-indent-align-list-continuation t + "Align continuation of non-empty ([{ lines in `js-mode'." + :type 'boolean + :group 'js) + (defcustom js-comment-lineup-func #'c-lineup-C-comments "Lineup function for `cc-mode-style', for C comments in `js-mode'." :type 'function @@ -1829,10 +1834,15 @@ This performs fontification according to `js--class-styles'." (save-excursion (back-to-indentation) (if (js--looking-at-operator-p) - (or (not (memq (char-after) '(?- ?+))) - (progn - (forward-comment (- (point))) - (not (memq (char-before) '(?, ?\[ ?\())))) + (if (eq (char-after) ?/) + (prog1 + (not (nth 3 (syntax-ppss (1+ (point))))) + (forward-char -1)) + (or + (not (memq (char-after) '(?- ?+))) + (progn + (forward-comment (- (point))) + (not (memq (char-before) '(?, ?\[ ?\()))))) (and (js--find-newline-backward) (progn (skip-chars-backward " \t") @@ -1967,8 +1977,12 @@ statement spanning multiple lines; otherwise, return nil." (save-excursion (back-to-indentation) (when (not (looking-at js--declaration-keyword-re)) - (when (looking-at js--indent-operator-re) - (goto-char (match-end 0))) + (let ((pt (point))) + (when (looking-at js--indent-operator-re) + (goto-char (match-end 0))) + ;; The "operator" is probably a regexp literal opener. + (when (nth 3 (syntax-ppss)) + (goto-char pt))) (while (and (not at-opening-bracket) (not (bobp)) (let ((pos (point))) @@ -2092,7 +2106,8 @@ indentation is aligned to that column." (switch-keyword-p (looking-at "default\\_>\\|case\\_>[^:]")) (continued-expr-p (js--continued-expression-p))) (goto-char (nth 1 parse-status)) ; go to the opening char - (if (looking-at "[({[]\\s-*\\(/[/*]\\|$\\)") + (if (or (not js-indent-align-list-continuation) + (looking-at "[({[]\\s-*\\(/[/*]\\|$\\)")) (progn ; nothing following the opening paren/bracket (skip-syntax-backward " ") (when (eq (char-before) ?\)) (backward-list)) @@ -2374,6 +2389,10 @@ i.e., customize JSX element indentation with `sgml-basic-offset', (fill-paragraph-function #'c-fill-paragraph)) (c-fill-paragraph justify))) +(defun js-do-auto-fill () + (let ((js--filling-paragraph t)) + (c-do-auto-fill))) + ;;; Type database and Imenu ;; We maintain a cache of semantic information, i.e., the classes and @@ -3857,6 +3876,7 @@ If one hasn't been set, or if it's stale, prompt for a new one." (setq-local comment-start "// ") (setq-local comment-end "") (setq-local fill-paragraph-function #'js-c-fill-paragraph) + (setq-local normal-auto-fill-function #'js-do-auto-fill) ;; Parse cache (add-hook 'before-change-functions #'js--flush-caches t t) diff --git a/lisp/progmodes/ld-script.el b/lisp/progmodes/ld-script.el index 389ddfca6b1..980ef9014c7 100644 --- a/lisp/progmodes/ld-script.el +++ b/lisp/progmodes/ld-script.el @@ -18,7 +18,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -85,10 +85,12 @@ ;; 3.4.5 Other Linker Script Commands "ASSERT" "EXTERN" "FORCE_COMMON_ALLOCATION" "INHIBIT_COMMON_ALLOCATION" "INSERT" "AFTER" "BEFORE" - "NOCROSSREFS" "OUTPUT_ARCH" "LD_FEATURE" - ;; 3.5.2 PROVIDE + "NOCROSSREFS" "NOCROSSREFS_TO" "OUTPUT_ARCH" "LD_FEATURE" + ;; 3.5.2 HIDDEN + "HIDDEN" + ;; 3.5.3 PROVIDE "PROVIDE" - ;; 3.5.3 PROVIDE_HIDDEN + ;; 3.5.4 PROVIDE_HIDDEN "PROVIDE_HIDDEN" ;; 3.6 SECTIONS Command "SECTIONS" @@ -142,6 +144,7 @@ "DEFINED" "LENGTH" "len" "l" "LOADADDR" + "LOG2CEIL" "MAX" "MIN" "NEXT" diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el index b48654ff41b..ebb66fa05ac 100644 --- a/lisp/progmodes/m4-mode.el +++ b/lisp/progmodes/m4-mode.el @@ -18,7 +18,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 5cda7bb219c..4c926f4de95 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -21,7 +21,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/mantemp.el b/lisp/progmodes/mantemp.el index 7a3c0fb0357..93119b1e8d0 100644 --- a/lisp/progmodes/mantemp.el +++ b/lisp/progmodes/mantemp.el @@ -19,7 +19,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el index 33772263884..a47ae28a4af 100644 --- a/lisp/progmodes/meta-mode.el +++ b/lisp/progmodes/meta-mode.el @@ -19,7 +19,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el index f884de1fcca..6d2d64af960 100644 --- a/lisp/progmodes/mixal-mode.el +++ b/lisp/progmodes/mixal-mode.el @@ -21,7 +21,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: ;; Major mode for the mix asm language. @@ -30,7 +30,7 @@ ;; For optimal use, also use GNU MDK. Compiling needs mixasm, running ;; and debugging needs mixvm and mixvm.el from GNU MDK. You can get ;; GNU MDK from `https://savannah.gnu.org/projects/mdk/' and -;; `ftp://ftp.gnu.org/pub/gnu/mdk'. +;; `https://ftp.gnu.org/pub/gnu/mdk'. ;; ;; To use this mode, place the following in your init file: ;; `(load-file "/PATH-TO-FILE/mixal-mode.el")'. diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index ac9ba630c4e..dc6bba44f32 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -20,7 +20,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -37,7 +37,7 @@ (defgroup octave nil "Editing Octave code." :link '(custom-manual "(octave-mode)Top") - :link '(url-link "http://www.gnu.org/s/octave") + :link '(url-link "https://www.gnu.org/s/octave") :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) :group 'languages) @@ -612,7 +612,7 @@ Key bindings: (defcustom inferior-octave-prompt ;; For Octave >= 3.8, default is always 'octave', see - ;; http://hg.savannah.gnu.org/hgweb/octave/rev/708173343c50 + ;; https://hg.savannah.gnu.org/hgweb/octave/rev/708173343c50 "\\(?:^octave\\(?:.bin\\|.exe\\)?\\(?:-[.0-9]+\\)?\\(?::[0-9]+\\)?\\|^debug\\|^\\)>+ " "Regexp to match prompts for the inferior Octave process." :type 'regexp) @@ -839,7 +839,7 @@ startup file, `~/.emacs-octave'." (inferior-octave-send-list-and-digest (list "more off;\n" (unless (equal inferior-octave-output-string ">> ") - ;; See http://hg.savannah.gnu.org/hgweb/octave/rev/708173343c50 + ;; See https://hg.savannah.gnu.org/hgweb/octave/rev/708173343c50 "PS1 ('octave> ');\n") (when (and inferior-octave-startup-file (file-exists-p inferior-octave-startup-file)) @@ -867,7 +867,7 @@ startup file, `~/.emacs-octave'." (defun inferior-octave-completion-at-point () "Return the data to complete the Octave symbol at point." - ;; http://debbugs.gnu.org/14300 + ;; https://debbugs.gnu.org/14300 (unless (string-match-p "/" (or (comint--match-partial-filename) "")) (let ((beg (save-excursion (skip-syntax-backward "w_" (comint-line-beginning-position)) @@ -1497,7 +1497,7 @@ current buffer file unless called with a prefix arg \\[universal-argument]." (string (buffer-substring-no-properties beg end)) line) (with-current-buffer inferior-octave-buffer - ;; http://lists.gnu.org/archive/html/emacs-devel/2013-10/msg00095.html + ;; https://lists.gnu.org/r/emacs-devel/2013-10/msg00095.html (compilation-forget-errors) (setq inferior-octave-output-list nil) (while (not (string-equal string "")) diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el index 6a61564b446..12353c4fafd 100644 --- a/lisp/progmodes/opascal.el +++ b/lisp/progmodes/opascal.el @@ -20,7 +20,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el index a7d0624a74a..5f893b87c2e 100644 --- a/lisp/progmodes/pascal.el +++ b/lisp/progmodes/pascal.el @@ -18,7 +18,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index 3def37a2ea8..f3cb8109133 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -23,7 +23,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -135,7 +135,7 @@ '(;; Functions (nil "^[ \t]*sub\\s-+\\([-[:alnum:]+_:]+\\)" 1) ;;Variables - ("Variables" "^\\(?:my\\|our\\)\\s-+\\([$@%][-[:alnum:]+_:]+\\)\\s-*=" 1) + ("Variables" "^[ \t]*\\(?:anon\\|argument\\|has\\|local\\|my\\|our\\|state\\|supersede\\)\\s-+\\([$@%][-[:alnum:]+_:]+\\)\\s-*=" 1) ("Packages" "^[ \t]*package\\s-+\\([-[:alnum:]+_:]+\\);" 1) ("Doc sections" "^=head[0-9][ \t]+\\(.*\\)" 1)) "Imenu generic expression for Perl mode. See `imenu-generic-expression'.") @@ -179,8 +179,9 @@ "BEGIN" "END" "return" "exec" "eval") t) "\\>") ;; - ;; Fontify local and my keywords as types. - ("\\<\\(local\\|my\\)\\>" . font-lock-type-face) + ;; Fontify declarators and prefixes as types. + ("\\<\\(anon\\|argument\\|has\\|local\\|my\\|our\\|state\\|supersede\\)\\>" . font-lock-type-face) ; declarators + ("\\<\\(let\\|temp\\)\\>" . font-lock-type-face) ; prefixes ;; ;; Fontify function, variable and file name references. ("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face) @@ -213,25 +214,6 @@ (regexp-opt perl--syntax-exp-intro-keywords) "\\|[-?:.,;|&+*=!~({[]\\|\\(^\\)\\)[ \t\n]*"))) -;; FIXME: handle here-docs and regexps. -;; <<EOF <<"EOF" <<'EOF' (no space) -;; see `man perlop' -;; ?...? -;; /.../ -;; m [...] -;; m /.../ -;; q /.../ = '...' -;; qq /.../ = "..." -;; qx /.../ = `...` -;; qr /.../ = precompiled regexp =~=~ m/.../ -;; qw /.../ -;; s /.../.../ -;; s <...> /.../ -;; s '...'...' -;; tr /.../.../ -;; y /.../.../ -;; -;; <file*glob> (defun perl-syntax-propertize-function (start end) (let ((case-fold-search nil)) (goto-char start) @@ -324,23 +306,25 @@ ((concat "\\(?:" ;; << "EOF", << 'EOF', or << \EOF - "<<[ \t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\)" + "<<\\(~\\)?[ \t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\)" ;; The <<EOF case which needs perl--syntax-exp-intro-regexp, to ;; disambiguate with the left-bitshift operator. - "\\|" perl--syntax-exp-intro-regexp "<<\\(?1:\\sw+\\)\\)" + "\\|" perl--syntax-exp-intro-regexp "<<\\(?2:\\sw+\\)\\)" ".*\\(\n\\)") - (3 (let* ((st (get-text-property (match-beginning 3) 'syntax-table)) - (name (match-string 1))) - (goto-char (match-end 1)) + (4 (let* ((st (get-text-property (match-beginning 4) 'syntax-table)) + (name (match-string 2)) + (indented (match-beginning 1))) + (goto-char (match-end 2)) (if (save-excursion (nth 8 (syntax-ppss (match-beginning 0)))) ;; Leave the property of the newline unchanged. st (cons (car (string-to-syntax "< c")) ;; Remember the names of heredocs found on this line. - (cons (pcase (aref name 0) - (`?\\ (substring name 1)) - ((or `?\" `?\' `?\`) (substring name 1 -1)) - (_ name)) + (cons (cons (pcase (aref name 0) + (`?\\ (substring name 1)) + ((or `?\" `?\' `?\`) (substring name 1 -1)) + (_ name)) + indented) (cdr st))))))) ;; We don't call perl-syntax-propertize-special-constructs directly ;; from the << rule, because there might be other elements (between @@ -383,7 +367,9 @@ (goto-char (nth 8 state))) (while (and names (re-search-forward - (concat "^" (regexp-quote (pop names)) "\n") + (pcase-let ((`(,name . ,indented) (pop names))) + (concat "^" (if indented "[ \t]*") + (regexp-quote name) "\n")) limit 'move)) (unless names (put-text-property (1- (point)) (point) 'syntax-table @@ -595,6 +581,73 @@ create a new comment." (match-string-no-properties 1)))) +;;; Flymake support +(defcustom perl-flymake-command '("perl" "-w" "-c") + "External tool used to check Perl source code. +This is a non empty list of strings, the checker tool possibly +followed by required arguments. Once launched it will receive +the Perl source to be checked as its standard input." + :group 'perl + :type '(repeat string)) + +(defvar-local perl--flymake-proc nil) + +;;;###autoload +(defun perl-flymake (report-fn &rest _args) + "Perl backend for Flymake. Launches +`perl-flymake-command' (which see) and passes to its standard +input the contents of the current buffer. The output of this +command is analyzed for error and warning messages." + (unless (executable-find (car perl-flymake-command)) + (error "Cannot find a suitable checker")) + + (when (process-live-p perl--flymake-proc) + (kill-process perl--flymake-proc)) + + (let ((source (current-buffer))) + (save-restriction + (widen) + (setq + perl--flymake-proc + (make-process + :name "perl-flymake" :noquery t :connection-type 'pipe + :buffer (generate-new-buffer " *perl-flymake*") + :command perl-flymake-command + :sentinel + (lambda (proc _event) + (when (eq 'exit (process-status proc)) + (unwind-protect + (if (with-current-buffer source (eq proc perl--flymake-proc)) + (with-current-buffer (process-buffer proc) + (goto-char (point-min)) + (cl-loop + while (search-forward-regexp + "^\\(.+\\) at - line \\([0-9]+\\)" + nil t) + for msg = (match-string 1) + for (beg . end) = (flymake-diag-region + source + (string-to-number (match-string 2))) + for type = + (if (string-match + "\\(Scalar value\\|Useless use\\|Unquoted string\\)" + msg) + :warning + :error) + collect (flymake-make-diagnostic source + beg + end + type + msg) + into diags + finally (funcall report-fn diags))) + (flymake-log :debug "Canceling obsolete check %s" + proc)) + (kill-buffer (process-buffer proc))))))) + (process-send-region perl--flymake-proc (point-min) (point-max)) + (process-send-eof perl--flymake-proc)))) + + (defvar perl-mode-hook nil "Normal hook to run when entering Perl mode.") @@ -679,7 +732,9 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'." ;; Setup outline-minor-mode. (setq-local outline-regexp perl-outline-regexp) (setq-local outline-level 'perl-outline-level) - (setq-local add-log-current-defun-function #'perl-current-defun-name)) + (setq-local add-log-current-defun-function #'perl-current-defun-name) + ;; Setup Flymake + (add-hook 'flymake-diagnostic-functions #'perl-flymake nil t)) ;; This is used by indent-for-comment ;; to decide how much to indent a comment in Perl code @@ -692,7 +747,9 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'." (define-obsolete-function-alias 'electric-perl-terminator 'perl-electric-terminator "22.1") (defun perl-electric-noindent-p (_char) - (unless (eolp) 'no-indent)) + ;; To reproduce the old behavior, ;, {, }, and : are made electric, but + ;; we only want them to be electric at EOL. + (unless (or (bolp) (eolp)) 'no-indent)) (defun perl-electric-terminator (arg) "Insert character and maybe adjust indentation. diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el index 8f66f1c9541..f727e458b2b 100644 --- a/lisp/progmodes/prog-mode.el +++ b/lisp/progmodes/prog-mode.el @@ -19,7 +19,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -225,11 +225,11 @@ on the symbol." (apply #'font-lock-flush prettify-symbols--current-symbol-bounds) (setq prettify-symbols--current-symbol-bounds nil)) ;; Unprettify the current symbol. - (when-let ((c (get-prop-as-list 'composition)) - (s (get-prop-as-list 'prettify-symbols-start)) - (e (get-prop-as-list 'prettify-symbols-end)) - (s (apply #'min s)) - (e (apply #'max e))) + (when-let* ((c (get-prop-as-list 'composition)) + (s (get-prop-as-list 'prettify-symbols-start)) + (e (get-prop-as-list 'prettify-symbols-end)) + (s (apply #'min s)) + (e (apply #'max e))) (with-silent-modifications (setq prettify-symbols--current-symbol-bounds (list s e)) (remove-text-properties s e '(composition)))))) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index ed1d564752c..93a945edaa4 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -15,7 +15,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -307,7 +307,11 @@ DIRS must contain directory names." (defun project-find-regexp (regexp) "Find all matches for REGEXP in the current project's roots. With \\[universal-argument] prefix, you can specify the directory -to search in, and the file name pattern to search for." +to search in, and the file name pattern to search for. The +pattern may use abbreviations defined in `grep-files-aliases', +e.g. entering `ch' is equivalent to `*.[ch]'. As whitespace +triggers completion when entering a pattern, including it +requires quoting, e.g. `\\[quoted-insert]<space>'." (interactive (list (project--read-regexp))) (let* ((pr (project-current t)) (dirs (if current-prefix-arg diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index c234cca3ff9..13cd6be9f7d 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -26,7 +26,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;; Original author: Masanobu UMEDA <umerin(at)mse(dot)kyutech(dot)ac(dot)jp> ;; Parts of this file was taken from a modified version of the original @@ -358,13 +358,15 @@ The version numbers are of the format (Major . Minor)." (defcustom prolog-indent-width 4 "The indentation width used by the editing buffer." :group 'prolog-indentation - :type 'integer) + :type 'integer + :safe 'integerp) (defcustom prolog-left-indent-regexp "\\(;\\|\\*?->\\)" "Regexp for `prolog-electric-if-then-else-flag'." :version "24.1" :group 'prolog-indentation - :type 'regexp) + :type 'regexp + :safe 'stringp) (defcustom prolog-paren-indent-p nil "If non-nil, increase indentation for parenthesis expressions. @@ -374,14 +376,16 @@ right (if this variable is non-nil) or in the same way as for compound terms (if this variable is nil, default)." :version "24.1" :group 'prolog-indentation - :type 'boolean) + :type 'boolean + :safe 'booleanp) (defcustom prolog-paren-indent 4 "The indentation increase for parenthesis expressions. Only used in ( If -> Then ; Else) and ( Disj1 ; Disj2 ) style expressions." :version "24.1" :group 'prolog-indentation - :type 'integer) + :type 'integer + :safe 'integerp) (defcustom prolog-parse-mode 'beg-of-clause "The parse mode used (decides from which point parsing is done). diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el index 7e2b7fdf79f..69ea3a70f56 100644 --- a/lisp/progmodes/ps-mode.el +++ b/lisp/progmodes/ps-mode.el @@ -28,7 +28,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 464b931cffc..9e09bfc5941 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -23,7 +23,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -80,7 +80,7 @@ ;; Using the "console" subcommand to start IPython in server-client ;; mode is known to fail intermittently due a bug on IPython itself -;; (see URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=18052#27'). +;; (see URL `https://debbugs.gnu.org/cgi/bugreport.cgi?bug=18052#27'). ;; There seems to be a race condition in the IPython server (A.K.A ;; kernel) when code is sent while it is still initializing, sometimes ;; causing the shell to get stalled. With that said, if an IPython @@ -97,7 +97,7 @@ ;; Missing or delayed output used to happen due to differences between ;; Operating Systems' pipe buffering (e.g. CPython 3.3.4 in Windows 7. -;; See URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=17304'). To +;; See URL `https://debbugs.gnu.org/cgi/bugreport.cgi?bug=17304'). To ;; avoid this, the `python-shell-unbuffered' defaults to non-nil and ;; controls whether `python-shell-calculate-process-environment' ;; should set the "PYTHONUNBUFFERED" environment variable on startup: @@ -273,7 +273,7 @@ (autoload 'help-function-arglist "help-fns") ;;;###autoload -(add-to-list 'auto-mode-alist (cons (purecopy "\\.pyw?\\'") 'python-mode)) +(add-to-list 'auto-mode-alist (cons (purecopy "\\.py[iw]?\\'") 'python-mode)) ;;;###autoload (add-to-list 'interpreter-mode-alist (cons (purecopy "python[0-9.]*") 'python-mode)) @@ -640,10 +640,14 @@ The type returned can be `comment', `string' or `paren'." ((python-rx string-delimiter) (0 (ignore (python-syntax-stringify)))))) -(defconst python--prettify-symbols-alist +(defvar python-prettify-symbols-alist '(("lambda" . ?λ) ("and" . ?∧) - ("or" . ?∨))) + ("or" . ?∨)) + "Value for `prettify-symbols-alist' in `python-mode'.") + +(define-obsolete-variable-alias 'python--prettify-symbols-alist + 'python-prettify-symbols-alist "26.1") (defsubst python-syntax-count-quotes (quote-char &optional point limit) "Count number of quotes around point (max is 3). @@ -1253,7 +1257,11 @@ This function is intended to be added to `post-self-insert-hook.' If a line renders a paren alone, after adding a char before it, the line will be re-indented automatically if needed." (when (and electric-indent-mode - (eq (char-before) last-command-event)) + (eq (char-before) last-command-event) + (not (python-syntax-context 'string)) + (save-excursion + (beginning-of-line) + (not (python-syntax-context 'string (syntax-ppss))))) (cond ;; Electric indent inside parens ((and @@ -2109,20 +2117,25 @@ remote host, the returned value is intended for (defun python-shell-calculate-exec-path () "Calculate `exec-path'. Prepends `python-shell-exec-path' and adds the binary directory -for virtualenv if `python-shell-virtualenv-root' is set. If -`default-directory' points to a remote host, the returned value -appends `python-shell-remote-exec-path' instead of `exec-path'." +for virtualenv if `python-shell-virtualenv-root' is set - this +will use the python interpreter from inside the virtualenv when +starting the shell. If `default-directory' points to a remote host, +the returned value appends `python-shell-remote-exec-path' instead +of `exec-path'." (let ((new-path (copy-sequence (if (file-remote-p default-directory) python-shell-remote-exec-path - exec-path)))) + exec-path))) + + ;; Windows and POSIX systems use different venv directory structures + (virtualenv-bin-dir (if (eq system-type 'windows-nt) "Scripts" "bin"))) (python-shell--add-to-path-with-priority new-path python-shell-exec-path) (if (not python-shell-virtualenv-root) new-path (python-shell--add-to-path-with-priority new-path - (list (expand-file-name "bin" python-shell-virtualenv-root))) + (list (expand-file-name virtualenv-bin-dir python-shell-virtualenv-root))) new-path))) (defun python-shell-tramp-refresh-remote-path (vec paths) @@ -2212,6 +2225,11 @@ machine then modifies `tramp-remote-process-environment' and Do not set this variable directly, instead use `python-shell-prompt-set-calculated-regexps'.") +(defvar python-shell--block-prompt nil + "Input block prompt for inferior python shell. +Do not set this variable directly, instead use +`python-shell-prompt-set-calculated-regexps'.") + (defvar python-shell--prompt-calculated-output-regexp nil "Calculated output prompt regexp for inferior python shell. Do not set this variable directly, instead use @@ -2245,7 +2263,11 @@ detection and just returns nil." ;; `condition-case' and displaying the error message to ;; the user in the no-prompts warning. (ignore-errors - (let ((code-file (python-shell--save-temp-file code))) + (let ((code-file + ;; Python 2.x on Windows does not handle + ;; carriage returns in unbuffered mode. + (let ((inhibit-eol-conversion (getenv "PYTHONUNBUFFERED"))) + (python-shell--save-temp-file code)))) ;; Use `process-file' as it is remote-host friendly. (process-file interpreter @@ -2362,6 +2384,7 @@ and `python-shell-output-prompt-regexp' using the values from (dolist (prompt (butlast detected-prompts)) (setq prompt (regexp-quote prompt)) (cl-pushnew prompt input-prompts :test #'string=)) + (setq python-shell--block-prompt (nth 1 detected-prompts)) (cl-pushnew (regexp-quote (car (last detected-prompts))) output-prompts :test #'string=)) @@ -2722,6 +2745,7 @@ variable. (set (make-local-variable 'python-shell-interpreter-args) (or python-shell--interpreter-args python-shell-interpreter-args)) (set (make-local-variable 'python-shell--prompt-calculated-input-regexp) nil) + (set (make-local-variable 'python-shell--block-prompt) nil) (set (make-local-variable 'python-shell--prompt-calculated-output-regexp) nil) (python-shell-prompt-set-calculated-regexps) (setq comint-prompt-regexp python-shell--prompt-calculated-input-regexp) @@ -3289,8 +3313,9 @@ the full statement in the case of imports." (defcustom python-shell-completion-native-disabled-interpreters ;; PyPy's readline cannot handle some escape sequences yet. Native ;; completion was found to be non-functional for IPython (see - ;; Bug#25067). - (list "pypy" "ipython") + ;; Bug#25067). Native completion doesn't work on w32 (Bug#28580). + (if (eq system-type 'windows-nt) '("") + '("pypy" "ipython")) "List of disabled interpreters. When a match is found, native completion is disabled." :version "25.1" @@ -3431,6 +3456,8 @@ def __PYTHON_EL_native_completion_setup(): instance.rlcomplete = new_completer if readline.__doc__ and 'libedit' in readline.__doc__: + raise Exception('''libedit based readline is known not to work, + see etc/PROBLEMS under \"In Inferior Python mode, input is echoed\".''') readline.parse_and_bind('bind ^I rl_complete') else: readline.parse_and_bind('tab: complete') @@ -3439,7 +3466,9 @@ def __PYTHON_EL_native_completion_setup(): print ('python.el: native completion setup loaded') except: - print ('python.el: native completion setup failed') + import sys + print ('python.el: native completion setup failed, %s: %s' + % sys.exc_info()[:2]) __PYTHON_EL_native_completion_setup()" process) (when (and @@ -3628,7 +3657,14 @@ using that one instead of current buffer's process." ;; Also, since pdb interaction is single-line ;; based, this is enough. (string-match-p python-shell-prompt-pdb-regexp prompt)) - #'python-shell-completion-get-completions) + (if (or (equal python-shell--block-prompt prompt) + (string-match-p + python-shell-prompt-block-regexp prompt)) + ;; The non-native completion mechanism sends + ;; newlines to the interpreter, so we can't use + ;; it during a multiline statement (Bug#28051). + #'ignore + #'python-shell-completion-get-completions)) (t #'python-shell-completion-native-get-completions))))) (list start end (completion-table-dynamic @@ -4253,8 +4289,10 @@ See `python-check-command' for the default." import inspect try: str_type = basestring + argspec_function = inspect.getargspec except NameError: str_type = str + argspec_function = inspect.getfullargspec if isinstance(obj, str_type): obj = eval(obj, globals()) doc = inspect.getdoc(obj) @@ -4267,9 +4305,7 @@ See `python-check-command' for the default." target = obj objtype = 'def' if target: - args = inspect.formatargspec( - *inspect.getargspec(target) - ) + args = inspect.formatargspec(*argspec_function(target)) name = obj.__name__ doc = '{objtype} {name}{args}'.format( objtype=objtype, name=name, args=args @@ -5115,6 +5151,138 @@ returned as is." (ignore-errors (string-match regexp "") t)) +;;; Flymake integration + +(defgroup python-flymake nil + "Integration between Python and Flymake." + :group 'python + :link '(custom-group-link :tag "Flymake" flymake) + :version "26.1") + +(defcustom python-flymake-command '("pyflakes") + "The external tool that will be used to perform the syntax check. +This is a non empty list of strings, the checker tool possibly followed by +required arguments. Once launched it will receive the Python source to be +checked as its standard input. +To use `flake8' you would set this to (\"flake8\" \"-\")." + :group 'python-flymake + :type '(repeat string)) + +;; The default regexp accomodates for older pyflakes, which did not +;; report the column number, and at the same time it's compatible with +;; flake8 output, although it may be redefined to explicitly match the +;; TYPE +(defcustom python-flymake-command-output-pattern + (list + "^\\(?:<?stdin>?\\):\\(?1:[0-9]+\\):\\(?:\\(?2:[0-9]+\\):\\)? \\(?3:.*\\)$" + 1 2 nil 3) + "Specify how to parse the output of `python-flymake-command'. +The value has the form (REGEXP LINE COLUMN TYPE MESSAGE): if +REGEXP matches, the LINE'th subexpression gives the line number, +the COLUMN'th subexpression gives the column number on that line, +the TYPE'th subexpression gives the type of the message and the +MESSAGE'th gives the message text itself. + +If COLUMN or TYPE are nil or that index didn't match, that +information is not present on the matched line and a default will +be used." + :group 'python-flymake + :type '(list regexp + (integer :tag "Line's index") + (choice + (const :tag "No column" nil) + (integer :tag "Column's index")) + (choice + (const :tag "No type" nil) + (integer :tag "Type's index")) + (integer :tag "Message's index"))) + +(defcustom python-flymake-msg-alist + '(("\\(^redefinition\\|.*unused.*\\|used$\\)" . :warning)) + "Alist used to associate messages to their types. +Each element should be a cons-cell (REGEXP . TYPE), where TYPE must be +one defined in the variable `flymake-diagnostic-types-alist'. +For example, when using `flake8' a possible configuration could be: + + ((\"\\(^redefinition\\|.*unused.*\\|used$\\)\" . :warning) + (\"^E999\" . :error) + (\"^[EW][0-9]+\" . :note)) + +By default messages are considered errors." + :group 'python-flymake + :type `(alist :key-type (regexp) + :value-type (symbol))) + +(defvar-local python--flymake-proc nil) + +(defun python--flymake-parse-output (source proc report-fn) + "Collect diagnostics parsing checker tool's output line by line." + (let ((rx (nth 0 python-flymake-command-output-pattern)) + (lineidx (nth 1 python-flymake-command-output-pattern)) + (colidx (nth 2 python-flymake-command-output-pattern)) + (typeidx (nth 3 python-flymake-command-output-pattern)) + (msgidx (nth 4 python-flymake-command-output-pattern))) + (with-current-buffer (process-buffer proc) + (goto-char (point-min)) + (cl-loop + while (search-forward-regexp rx nil t) + for msg = (match-string msgidx) + for (beg . end) = (flymake-diag-region + source + (string-to-number + (match-string lineidx)) + (and colidx + (match-string colidx) + (string-to-number + (match-string colidx)))) + for type = (or (and typeidx + (match-string typeidx) + (assoc-default + (match-string typeidx) + python-flymake-msg-alist + #'string-match)) + (assoc-default msg + python-flymake-msg-alist + #'string-match) + :error) + collect (flymake-make-diagnostic + source beg end type msg) + into diags + finally (funcall report-fn diags))))) + +(defun python-flymake (report-fn &rest _args) + "Flymake backend for Python. +This backend uses `python-flymake-command' (which see) to launch a process +that is passed the current buffer's content via stdin. +REPORT-FN is Flymake's callback function." + (unless (executable-find (car python-flymake-command)) + (error "Cannot find a suitable checker")) + + (when (process-live-p python--flymake-proc) + (kill-process python--flymake-proc)) + + (let ((source (current-buffer))) + (save-restriction + (widen) + (setq python--flymake-proc + (make-process + :name "python-flymake" + :noquery t + :connection-type 'pipe + :buffer (generate-new-buffer " *python-flymake*") + :command python-flymake-command + :sentinel + (lambda (proc _event) + (when (eq 'exit (process-status proc)) + (unwind-protect + (when (with-current-buffer source + (eq proc python--flymake-proc)) + (python--flymake-parse-output source proc report-fn)) + (kill-buffer (process-buffer proc))))))) + (process-send-region python--flymake-proc (point-min) (point-max)) + (process-send-eof python--flymake-proc)))) + + (defun python-electric-pair-string-delimiter () (when (and electric-pair-mode (memq last-command-event '(?\" ?\')) @@ -5228,7 +5396,9 @@ returned as is." (make-local-variable 'python-shell-internal-buffer) (when python-indent-guess-indent-offset - (python-indent-guess-indent-offset))) + (python-indent-guess-indent-offset)) + + (add-hook 'flymake-diagnostic-functions #'python-flymake nil t)) (provide 'python) diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 6f431ecd302..dc1b0f8e2da 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -22,7 +22,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -2253,6 +2253,139 @@ See `font-lock-syntax-table'.") (progn (set-match-data value) t)) (ruby-match-expression-expansion limit))))) +;;; Flymake support +(defvar-local ruby--flymake-proc nil) + +(defun ruby-flymake-simple (report-fn &rest _args) + "`ruby -wc' backend for Flymake." + (unless (executable-find "ruby") + (error "Cannot find the ruby executable")) + + (ruby-flymake--helper + "ruby-flymake" + '("ruby" "-w" "-c") + (lambda (_proc source) + (goto-char (point-min)) + (cl-loop + while (search-forward-regexp + "^\\(?:.*.rb\\|-\\):\\([0-9]+\\): \\(.*\\)$" + nil t) + for msg = (match-string 2) + for (beg . end) = (flymake-diag-region + source + (string-to-number (match-string 1))) + for type = (if (string-match "^warning" msg) + :warning + :error) + collect (flymake-make-diagnostic source + beg + end + type + msg) + into diags + finally (funcall report-fn diags))))) + +(defun ruby-flymake--helper (process-name command parser-fn) + (when (process-live-p ruby--flymake-proc) + (kill-process ruby--flymake-proc)) + + (let ((source (current-buffer))) + (save-restriction + (widen) + (setq + ruby--flymake-proc + (make-process + :name process-name :noquery t :connection-type 'pipe + :buffer (generate-new-buffer (format " *%s*" process-name)) + :command command + :sentinel + (lambda (proc _event) + (when (eq 'exit (process-status proc)) + (unwind-protect + (if (with-current-buffer source (eq proc ruby--flymake-proc)) + (with-current-buffer (process-buffer proc) + (funcall parser-fn proc source)) + (flymake-log :debug "Canceling obsolete check %s" + proc)) + (kill-buffer (process-buffer proc))))))) + (process-send-region ruby--flymake-proc (point-min) (point-max)) + (process-send-eof ruby--flymake-proc)))) + +(defcustom ruby-flymake-use-rubocop-if-available t + "Non-nil to use the Rubocop Flymake backend. +Only takes effect if Rubocop is installed." + :type 'boolean + :group 'ruby + :safe 'booleanp) + +(defcustom ruby-rubocop-config ".rubocop.yml" + "Configuration file for `ruby-flymake-rubocop'." + :type 'string + :group 'ruby + :safe 'stringp) + +(defun ruby-flymake-rubocop (report-fn &rest _args) + "Rubocop backend for Flymake." + (unless (executable-find "rubocop") + (error "Cannot find the rubocop executable")) + + (let ((command (list "rubocop" "--stdin" buffer-file-name "--format" "emacs" + "--cache" "false" ; Work around a bug in old version. + "--display-cop-names")) + config-dir) + (when buffer-file-name + (setq config-dir (locate-dominating-file buffer-file-name + ruby-rubocop-config)) + (when config-dir + (setq command (append command (list "--config" + (expand-file-name ruby-rubocop-config + config-dir))))) + + (ruby-flymake--helper + "rubocop-flymake" + command + (lambda (proc source) + ;; Finding the executable is no guarantee of + ;; rubocop working, especially in the presence + ;; of rbenv shims (which cross ruby versions). + (when (eq (process-exit-status proc) 127) + ;; Not sure what to do in this case. Maybe ideally we'd + ;; switch back to ruby-flymake-simple. + (flymake-log :warning "Rubocop returned status 127: %s" + (buffer-string))) + (goto-char (point-min)) + (cl-loop + while (search-forward-regexp + "^\\(?:.*.rb\\|-\\):\\([0-9]+\\):\\([0-9]+\\): \\(.*\\)$" + nil t) + for msg = (match-string 3) + for (beg . end) = (flymake-diag-region + source + (string-to-number (match-string 1)) + (string-to-number (match-string 2))) + for type = (cond + ((string-match "^[EF]: " msg) + :error) + ((string-match "^W: " msg) + :warning) + (t :note)) + collect (flymake-make-diagnostic source + beg + end + type + (substring msg 3)) + into diags + finally (funcall report-fn diags))))))) + +(defun ruby-flymake-auto (report-fn &rest args) + (apply + (if (and ruby-flymake-use-rubocop-if-available + (executable-find "rubocop")) + #'ruby-flymake-rubocop + #'ruby-flymake-simple) + report-fn + args)) + ;;;###autoload (define-derived-mode ruby-mode prog-mode "Ruby" "Major mode for editing Ruby code." @@ -2265,6 +2398,7 @@ See `font-lock-syntax-table'.") (add-hook 'after-save-hook 'ruby-mode-set-encoding nil 'local) (add-hook 'electric-indent-functions 'ruby--electric-indent-p nil 'local) + (add-hook 'flymake-diagnostic-functions 'ruby-flymake-auto nil 'local) (setq-local font-lock-defaults '((ruby-font-lock-keywords) nil nil)) (setq-local font-lock-keywords ruby-font-lock-keywords) diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index 0dcf9b47b84..bb75595cb4d 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -20,7 +20,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 35b555e6879..2a867bb3655 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -21,7 +21,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -419,44 +419,6 @@ name symbol." (define-abbrev-table 'sh-mode-abbrev-table ()) -;; I turned off this feature because it doesn't permit typing commands -;; in the usual way without help. -;;(defvar sh-abbrevs -;; '((csh sh-abbrevs shell -;; "switch" 'sh-case -;; "getopts" 'sh-while-getopts) - -;; (es sh-abbrevs shell -;; "function" 'sh-function) - -;; (ksh88 sh-abbrevs sh -;; "select" 'sh-select) - -;; (rc sh-abbrevs shell -;; "case" 'sh-case -;; "function" 'sh-function) - -;; (sh sh-abbrevs shell -;; "case" 'sh-case -;; "function" 'sh-function -;; "until" 'sh-until -;; "getopts" 'sh-while-getopts) - -;; ;; The next entry is only used for defining the others -;; (shell "for" sh-for -;; "loop" sh-indexed-loop -;; "if" sh-if -;; "tmpfile" sh-tmp-file -;; "while" sh-while) - -;; (zsh sh-abbrevs ksh88 -;; "repeat" 'sh-repeat)) -;; "Abbrev-table used in Shell-Script mode. See `sh-feature'. -;;;Due to the internal workings of abbrev tables, the shell name symbol is -;;;actually defined as the table for the like of \\[edit-abbrevs].") - - - (defun sh-mode-syntax-table (table &rest list) "Copy TABLE and set syntax for successive CHARs according to strings S." (setq table (copy-syntax-table table)) @@ -631,11 +593,7 @@ sign. See `sh-feature'." (sexp :format "Evaluate: %v")))) :group 'sh-script) - -(defcustom sh-indentation 4 - "The width for further indentation in Shell-Script mode." - :type 'integer - :group 'sh-script) +(define-obsolete-variable-alias 'sh-indentation 'sh-basic-offset "26.1") (put 'sh-indentation 'safe-local-variable 'integerp) (defcustom sh-remember-variable-min 3 @@ -747,9 +705,7 @@ removed when closing the here document." ;; The next entry is only used for defining the others (shell "cd" "echo" "eval" "set" "shift" "umask" "unset" "wait") - (wksh sh-append ksh88 - ;; FIXME: This looks too much like a regexp. --Stef - "Xt[A-Z][A-Za-z]*") + (wksh sh-append ksh88) (zsh sh-append ksh88 "autoload" "bindkey" "builtin" "chdir" "compctl" "declare" "dirs" @@ -1178,7 +1134,7 @@ subshells can nest." (syntax-propertize-rules (sh-here-doc-open-re (2 (sh-font-lock-open-heredoc - (match-beginning 0) (match-string 1) (match-beginning 2)))) + (1+ (match-beginning 0)) (match-string 1) (match-beginning 2)))) ("\\s|" (0 (prog1 nil (sh-syntax-propertize-here-doc end)))) ;; A `#' begins a comment when it is unquoted and at the ;; beginning of a word. In the shell, words are separated by @@ -1657,7 +1613,7 @@ with your script for an edit-interpret-debug cycle." (setq-local skeleton-pair-alist '((?` _ ?`))) (setq-local skeleton-pair-filter-function 'sh-quoted-p) (setq-local skeleton-further-elements - '((< '(- (min sh-indentation (current-column)))))) + '((< '(- (min sh-basic-offset (current-column)))))) (setq-local skeleton-filter-function 'sh-feature) (setq-local skeleton-newline-indent-rigidly t) (setq-local defun-prompt-regexp @@ -1683,6 +1639,7 @@ with your script for an edit-interpret-debug cycle." ((string-match "[.]sh\\>" buffer-file-name) "sh") ((string-match "[.]bash\\>" buffer-file-name) "bash") ((string-match "[.]ksh\\>" buffer-file-name) "ksh") + ((string-match "[.]mkshrc\\>" buffer-file-name) "mksh") ((string-match "[.]t?csh\\(rc\\)?\\>" buffer-file-name) "csh") ((string-match "[.]zsh\\(rc\\|env\\)?\\>" buffer-file-name) "zsh") ((equal (file-name-nondirectory buffer-file-name) ".profile") "sh") @@ -2051,7 +2008,7 @@ May return nil if the line should not be treated as continued." (forward-line -1) (if (sh-smie--looking-back-at-continuation-p) (current-indentation) - (+ (current-indentation) sh-indentation)))) + (+ (current-indentation) sh-basic-offset)))) (t ;; Just make sure a line-continuation is indented deeper. (save-excursion @@ -2072,13 +2029,13 @@ May return nil if the line should not be treated as continued." ;; check the line before that one. (> ci indent)) (t ;Previous line is the beginning of the continued line. - (setq indent (min (+ ci sh-indentation) max)) + (setq indent (min (+ ci sh-basic-offset) max)) nil))))) indent)))))) (defun sh-smie-sh-rules (kind token) (pcase (cons kind token) - (`(:elem . basic) sh-indentation) + (`(:elem . basic) sh-basic-offset) (`(:after . "case-)") (- (sh-var-value 'sh-indent-for-case-alt) (sh-var-value 'sh-indent-for-case-label))) (`(:before . ,(or `"(" `"{" `"[" "while" "if" "for" "case")) @@ -2287,8 +2244,8 @@ Point should be before the newline." (defun sh-smie-rc-rules (kind token) (pcase (cons kind token) - (`(:elem . basic) sh-indentation) - ;; (`(:after . "case") (or sh-indentation smie-indent-basic)) + (`(:elem . basic) sh-basic-offset) + ;; (`(:after . "case") (or sh-basic-offset smie-indent-basic)) (`(:after . ";") (if (smie-rule-parent-p "case") (smie-rule-parent (sh-var-value 'sh-indent-after-case)))) @@ -2511,39 +2468,6 @@ the value thus obtained, and the result is used instead." -;; I commented this out because nobody calls it -- rms. -;;(defun sh-abbrevs (ancestor &rest list) -;; "If it isn't, define the current shell as abbrev table and fill that. -;;Abbrev table will inherit all abbrevs from ANCESTOR, which is either an abbrev -;;table or a list of (NAME1 EXPANSION1 ...). In addition it will define abbrevs -;;according to the remaining arguments NAMEi EXPANSIONi ... -;;EXPANSION may be either a string or a skeleton command." -;; (or (if (boundp sh-shell) -;; (symbol-value sh-shell)) -;; (progn -;; (if (listp ancestor) -;; (nconc list ancestor)) -;; (define-abbrev-table sh-shell ()) -;; (if (vectorp ancestor) -;; (mapatoms (lambda (atom) -;; (or (eq atom 0) -;; (define-abbrev (symbol-value sh-shell) -;; (symbol-name atom) -;; (symbol-value atom) -;; (symbol-function atom)))) -;; ancestor)) -;; (while list -;; (define-abbrev (symbol-value sh-shell) -;; (car list) -;; (if (stringp (car (cdr list))) -;; (car (cdr list)) -;; "") -;; (if (symbolp (car (cdr list))) -;; (car (cdr list)))) -;; (setq list (cdr (cdr list))))) -;; (symbol-value sh-shell))) - - (defun sh-append (ancestor &rest list) "Return list composed of first argument (a list) physically appended to rest." (nconc list ancestor)) @@ -2562,7 +2486,7 @@ the value thus obtained, and the result is used instead." (defun sh-basic-indent-line () "Indent a line for Sh mode (shell script mode). -Indent as far as preceding non-empty line, then by steps of `sh-indentation'. +Indent as far as preceding non-empty line, then by steps of `sh-basic-offset'. Lines containing only comments are considered empty." (interactive) (let ((previous (save-excursion @@ -2586,9 +2510,9 @@ Lines containing only comments are considered empty." (delete-region (point) (progn (beginning-of-line) (point))) (if (eolp) - (max previous (* (1+ (/ current sh-indentation)) - sh-indentation)) - (* (1+ (/ current sh-indentation)) sh-indentation)))))) + (max previous (* (1+ (/ current sh-basic-offset)) + sh-basic-offset)) + (* (1+ (/ current sh-basic-offset)) sh-basic-offset)))))) (if (< (current-column) (current-indentation)) (skip-chars-forward " \t")))) @@ -3452,7 +3376,7 @@ If INFO is supplied it is used, else it is calculated from current line." (if msg (message "%s" msg) (message nil)))) (defun sh-show-indent (arg) - "Show the how the current line would be indented. + "Show how the current line would be indented. This tells you which variable, if any, controls the indentation of this line. If optional arg ARG is non-null (called interactively with a prefix), @@ -3666,6 +3590,10 @@ so that `occur-next' and `occur-prev' will work." (defun sh-learn-buffer-indent (&optional arg) "Learn how to indent the buffer the way it currently is. +If `sh-use-smie' is non-nil, call `smie-config-guess'. +Otherwise, run the sh-script specific indent learning command, as +described below. + Output in buffer \"*indent*\" shows any lines which have conflicting values of a variable, and the final value of all variables learned. When called interactively, pop to this buffer automatically if @@ -3682,8 +3610,7 @@ to the value of variable `sh-learn-basic-offset'. Abnormal hook `sh-learned-buffer-hook' if non-nil is called when the function completes. The function is abnormal because it is called -with an alist of variables learned. This feature may be changed or -removed in the future. +with an alist of variables learned. This command can often take a long time to run." (interactive "P") @@ -3881,7 +3808,6 @@ This command can often take a long time to run." " has" "s have") (if (zerop num-diffs) "." ":")))))) - ;; Are abnormal hooks considered bad form? (run-hook-with-args 'sh-learned-buffer-hook learned-var-list) (and (called-interactively-p 'any) (or sh-popup-occur-buffer (> num-diffs 0)) diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el index 505a2ea43c0..6f98d68d047 100644 --- a/lisp/progmodes/simula.el +++ b/lisp/progmodes/simula.el @@ -22,7 +22,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 68ca37207ef..db88563a3e7 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -4,9 +4,9 @@ ;; Author: Alex Schroeder <alex@gnu.org> ;; Maintainer: Michael Mauger <michael@mauger.com> -;; Version: 3.5 +;; Version: 3.6 ;; Keywords: comm languages processes -;; URL: http://savannah.gnu.org/projects/emacs/ +;; URL: https://savannah.gnu.org/projects/emacs/ ;; This file is part of GNU Emacs. @@ -21,14 +21,14 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: ;; Please send bug reports and bug fixes to the mailing list at ;; help-gnu-emacs@gnu.org. If you want to subscribe to the mailing ;; list, see the web page at -;; http://lists.gnu.org/mailman/listinfo/help-gnu-emacs for +;; https://lists.gnu.org/mailman/listinfo/help-gnu-emacs for ;; instructions. I monitor this list actively. If you send an e-mail ;; to Alex Schroeder it usually makes it to me when Alex has a chance ;; to forward them along (Thanks, Alex). @@ -156,7 +156,7 @@ ;; (sql-set-product-feature 'xyz ;; :sqli-options 'my-sql-xyz-options)) -;; (defun my-sql-comint-xyz (product options) +;; (defun my-sql-comint-xyz (product options &optional buf-name) ;; "Connect ti XyzDB in a comint buffer." ;; ;; ;; Do something with `sql-user', `sql-password', @@ -172,7 +172,7 @@ ;; (if (not (string= "" sql-server)) ;; (list "-S" sql-server)) ;; options))) -;; (sql-comint product params))) +;; (sql-comint product params buf-name))) ;; ;; (sql-set-product-feature 'xyz ;; :sqli-comint-func 'my-sql-comint-xyz) @@ -220,6 +220,7 @@ ;; incorrectly enabled by default ;; Roman Scherer <roman.scherer@nugg.ad> -- Connection documentation ;; Mark Wilkinson <wilkinsonmr@gmail.com> -- file-local variables ignored +;; Simen Heggestøyl <simenheg@gmail.com> -- Postgres database completion ;; @@ -317,6 +318,7 @@ file. Since that is a plaintext file, this could be dangerous." (list :tag "completion" (const :format "" server) (const :format "" :completion) + (const :format "" :must-match) (restricted-sexp :match-alternatives (listp stringp)))) (choice :tag "database" @@ -332,9 +334,10 @@ file. Since that is a plaintext file, this could be dangerous." regexp) (list :tag "completion" (const :format "" database) - (const :format "" :completion) - (restricted-sexp - :match-alternatives (listp stringp)))) + (const :format "" :completion) + (const :format "" :must-match) + (restricted-sexp + :match-alternatives (listp stringp)))) (const port))) ;; SQL Product support @@ -936,7 +939,8 @@ Starts `sql-interactive-mode' after doing some setup." :version "20.8" :group 'SQL) -(defcustom sql-sqlite-login-params '((database :file nil)) +(defcustom sql-sqlite-login-params '((database :file nil + :must-match confirm)) "List of login parameters needed to connect to SQLite." :type 'sql-login-params :version "26.1" @@ -1079,7 +1083,8 @@ add your name with a \"-U\" prefix (such as \"-Umark\") to the list." `((user :default ,(user-login-name)) (database :default ,(user-login-name) :completion ,(completion-table-dynamic - (lambda (_) (sql-postgres-list-databases)))) + (lambda (_) (sql-postgres-list-databases))) + :must-match confirm) server) "List of login parameters needed to connect to Postgres." :type 'sql-login-params @@ -1090,9 +1095,10 @@ add your name with a \"-U\" prefix (such as \"-Umark\") to the list." "Return a list of available PostgreSQL databases." (when (executable-find sql-postgres-program) (let ((res '())) - (dolist (row (process-lines sql-postgres-program "-ltX")) - (when (string-match "^ \\([[:alnum:]-_]+\\) +|.*" row) - (push (match-string 1 row) res))) + (ignore-errors + (dolist (row (process-lines sql-postgres-program "-ltX")) + (when (string-match "^ \\([[:alnum:]-_]+\\) +|.*" row) + (push (match-string 1 row) res)))) (nreverse res)))) ;; Customization for Interbase @@ -2957,7 +2963,9 @@ value. (The property value is used as the PREDICATE argument to ((plist-member plist :file) (let ((file-name (read-file-name prompt - (file-name-directory last-value) default 'confirm + (file-name-directory last-value) + default + (plist-get plist :must-match) (file-name-nondirectory last-value) (when (plist-get plist :file) `(lambda (f) @@ -2971,8 +2979,13 @@ value. (The property value is used as the PREDICATE argument to (expand-file-name file-name)))) ((plist-member plist :completion) - (completing-read prompt-def (plist-get plist :completion) nil t - last-value history-var default)) + (completing-read prompt-def + (plist-get plist :completion) + nil + (plist-get plist :must-match) + last-value + history-var + default)) ((plist-get plist :number) (read-number prompt (or default last-value 0))) @@ -4034,7 +4047,7 @@ Sentinels will always get the two parameters PROCESS and EVENT." nil t initial 'sql-connection-history default))) ;;;###autoload -(defun sql-connect (connection &optional new-name) +(defun sql-connect (connection &optional buf-name) "Connect to an interactive session using CONNECTION settings. See `sql-connection-alist' to see how to define connections and @@ -4046,7 +4059,7 @@ is specified in the connection settings." ;; Prompt for the connection from those defined in the alist (interactive (if sql-connection-alist - (list (sql-read-connection "Connection: " nil '(nil)) + (list (sql-read-connection "Connection: ") current-prefix-arg) (user-error "No SQL Connections defined"))) @@ -4055,16 +4068,16 @@ is specified in the connection settings." ;; Was one selected (when connection ;; Get connection settings - (let ((connect-set (assoc-string connection sql-connection-alist t))) + (let ((connect-set (cdr (assoc-string connection sql-connection-alist t)))) ;; Settings are defined (if connect-set ;; Set the desired parameters - (let (param-var login-params set-params rem-params) + (let (param-var login-params set-vars rem-vars) ;; Set the parameters and start the interactive session - (mapc - (lambda (vv) - (set-default (car vv) (eval (cadr vv)))) - (cdr connect-set)) + (dolist (vv connect-set) + (let ((var (car vv)) + (val (cadr vv))) + (set-default var (eval val)))) (setq-default sql-connection connection) ;; :sqli-login params variable @@ -4072,32 +4085,33 @@ is specified in the connection settings." (sql-get-product-feature sql-product :sqli-login nil t)) ;; :sqli-login params value - (setq login-params - (sql-get-product-feature sql-product :sqli-login)) + (setq login-params (symbol-value param-var)) - ;; Params in the connection - (setq set-params + ;; Params set in the connection + (setq set-vars (mapcar (lambda (v) - (pcase (car v) - (`sql-user 'user) - (`sql-password 'password) - (`sql-server 'server) - (`sql-database 'database) - (`sql-port 'port) - (s s))) - (cdr connect-set))) + (pcase (car v) + (`sql-user 'user) + (`sql-password 'password) + (`sql-server 'server) + (`sql-database 'database) + (`sql-port 'port) + (s s))) + connect-set)) ;; the remaining params (w/o the connection params) - (setq rem-params + (setq rem-vars (sql-for-each-login login-params - (lambda (token plist) - (unless (member token set-params) - (if plist (cons token plist) token))))) + (lambda (var vals) + (unless (member var set-vars) + (if vals (cons var vals) var))))) ;; Start the SQLi session with revised list of login parameters - (eval `(let ((,param-var ',rem-params)) - (sql-product-interactive ',sql-product ',new-name)))) + (eval `(let ((,param-var ',rem-vars)) + (sql-product-interactive + ',sql-product + ',(or buf-name (format "<%s>" connection)))))) (user-error "SQL Connection <%s> does not exist" connection) nil))) @@ -4241,7 +4255,10 @@ the call to \\[sql-product-interactive] with default-directory))) (funcall (sql-get-product-feature product :sqli-comint-func) product - (sql-get-product-feature product :sqli-options))) + (sql-get-product-feature product :sqli-options) + (if (and new-name (string-prefix-p "SQL" new-name t)) + new-name + (concat "SQL: " new-name)))) ;; Set SQLi mode. (let ((sql-interactive-product product)) @@ -4249,8 +4266,6 @@ the call to \\[sql-product-interactive] with ;; Set the new buffer name (setq new-sqli-buffer (current-buffer)) - (when new-name - (sql-rename-buffer new-name)) (set (make-local-variable 'sql-buffer) (buffer-name new-sqli-buffer)) @@ -4284,29 +4299,41 @@ the call to \\[sql-product-interactive] with (current-buffer))))) (user-error "No default SQL product defined. Set `sql-product'."))) -(defun sql-comint (product params) +(defun sql-comint (product params &optional buf-name) "Set up a comint buffer to run the SQL processor. PRODUCT is the SQL product. PARAMS is a list of strings which are -passed as command line arguments." - (let ((program (sql-get-product-feature product :sqli-program)) - (buf-name "SQL")) +passed as command line arguments. BUF-NAME is the name of the new +buffer. If nil, a name is chosen for it." + + (let ((program (sql-get-product-feature product :sqli-program))) ;; Make sure we can find the program. `executable-find' does not ;; work for remote hosts; we suppress the check there. (unless (or (file-remote-p default-directory) (executable-find program)) (error "Unable to locate SQL program `%s'" program)) + ;; Make sure buffer name is unique. - (when (sql-buffer-live-p (format "*%s*" buf-name)) - (setq buf-name (format "SQL-%s" product)) - (when (sql-buffer-live-p (format "*%s*" buf-name)) - (let ((i 1)) - (while (sql-buffer-live-p - (format "*%s*" - (setq buf-name (format "SQL-%s%d" product i)))) - (setq i (1+ i)))))) - (set-buffer - (apply #'make-comint buf-name program nil params)))) + ;; if not specified, try *SQL* then *SQL-product*, then *SQL-product1*, ... + ;; otherwise, use *buf-name* + (if buf-name + (unless (string-match-p "\\`[*].*[*]\\'" buf-name) + (setq buf-name (concat "*" buf-name "*"))) + (setq buf-name "*SQL*") + (when (sql-buffer-live-p buf-name) + (setq buf-name (format "*SQL-%s*" product))) + (let ((i 1)) + (while (sql-buffer-live-p buf-name) + (setq buf-name (format "*SQL-%s%d*" product i) + i (1+ i))))) + (set-text-properties 0 (length buf-name) nil buf-name) + + ;; Start the command interpreter in the buffer + ;; PROC-NAME is BUF-NAME without enclosing asterisks + (let ((proc-name (replace-regexp-in-string "\\`[*]\\(.*\\)[*]\\'" "\\1" buf-name))) + (set-buffer + (apply #'make-comint-in-buffer + proc-name buf-name program nil params))))) ;;;###autoload (defun sql-oracle (&optional buffer) @@ -4340,7 +4367,7 @@ The default comes from `process-coding-system-alist' and (interactive "P") (sql-product-interactive 'oracle buffer)) -(defun sql-comint-oracle (product options) +(defun sql-comint-oracle (product options &optional buf-name) "Create comint buffer and connect to Oracle." ;; Produce user/password@database construct. Password without user ;; is meaningless; database without user/password is meaningless, @@ -4357,7 +4384,7 @@ The default comes from `process-coding-system-alist' and (if parameter (setq parameter (append options (list parameter))) (setq parameter options)) - (sql-comint product parameter) + (sql-comint product parameter buf-name) ;; Set process coding system to agree with the interpreter (setq nlslang (or (getenv "NLS_LANG") "") coding (dolist (cs @@ -4454,20 +4481,25 @@ The default comes from `process-coding-system-alist' and ;; Restore the changed settings (sql-redirect sqlbuf saved-settings)) +(defun sql-oracle--list-object-name (obj-name) + (format "CASE WHEN REGEXP_LIKE (%s, q'/^[A-Z0-9_#$]+$/','c') THEN %s ELSE '\"'|| %s ||'\"' END " + obj-name obj-name obj-name)) + (defun sql-oracle-list-all (sqlbuf outbuf enhanced _table-name) ;; Query from USER_OBJECTS or ALL_OBJECTS (let ((settings (sql-oracle-save-settings sqlbuf)) (simple-sql (concat "SELECT INITCAP(x.object_type) AS SQL_EL_TYPE " - ", x.object_name AS SQL_EL_NAME " + ", " (sql-oracle--list-object-name "x.object_name") " AS SQL_EL_NAME " "FROM user_objects x " "WHERE x.object_type NOT LIKE '%% BODY' " "ORDER BY 2, 1;")) (enhanced-sql (concat "SELECT INITCAP(x.object_type) AS SQL_EL_TYPE " - ", x.owner ||'.'|| x.object_name AS SQL_EL_NAME " + ", " (sql-oracle--list-object-name "x.owner") + " ||'.'|| " (sql-oracle--list-object-name "x.object_name") " AS SQL_EL_NAME " "FROM all_objects x " "WHERE x.object_type NOT LIKE '%% BODY' " "AND x.owner <> 'SYS' " @@ -4524,9 +4556,15 @@ See the distinct values in ALL_OBJECTS.OBJECT_TYPE for possible values." (concat "SELECT CHR(1)||" (if schema - (format "owner||'.'||object_name AS o FROM all_objects WHERE owner = %s AND " - (sql-str-literal (upcase schema))) - "object_name AS o FROM user_objects WHERE ") + (concat "CASE WHEN REGEXP_LIKE (owner, q'/^[A-Z0-9_#$]+$/','c') THEN owner ELSE '\"'|| owner ||'\"' END " + "||'.'||" + "CASE WHEN REGEXP_LIKE (object_name, q'/^[A-Z0-9_#$]+$/','c') THEN object_name ELSE '\"'|| object_name ||'\"' END " + " AS o FROM all_objects " + (format "WHERE owner = %s AND " + (sql-str-literal (if (string-match "^[\"]\\(.+\\)[\"]$" schema) + (match-string 1 schema) (upcase schema))))) + (concat "CASE WHEN REGEXP_LIKE (object_name, q'/^[A-Z0-9_#$]+$/','c') THEN object_name ELSE '\"'|| object_name ||'\"' END " + " AS o FROM user_objects WHERE ")) "temporary = 'N' AND generated = 'N' AND secondary = 'N' AND " "object_type IN (" (mapconcat (function sql-str-literal) sql-oracle-completion-types ",") @@ -4566,7 +4604,7 @@ The default comes from `process-coding-system-alist' and (interactive "P") (sql-product-interactive 'sybase buffer)) -(defun sql-comint-sybase (product options) +(defun sql-comint-sybase (product options &optional buf-name) "Create comint buffer and connect to Sybase." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. @@ -4581,7 +4619,7 @@ The default comes from `process-coding-system-alist' and (if (not (string= "" sql-server)) (list "-S" sql-server)) options))) - (sql-comint product params))) + (sql-comint product params buf-name))) @@ -4615,7 +4653,7 @@ The default comes from `process-coding-system-alist' and (interactive "P") (sql-product-interactive 'informix buffer)) -(defun sql-comint-informix (product options) +(defun sql-comint-informix (product options &optional buf-name) "Create comint buffer and connect to Informix." ;; username and password are ignored. (let ((db (if (string= "" sql-database) @@ -4623,7 +4661,7 @@ The default comes from `process-coding-system-alist' and (if (string= "" sql-server) sql-database (concat sql-database "@" sql-server))))) - (sql-comint product (append `(,db "-") options)))) + (sql-comint product (append `(,db "-") options) buf-name))) @@ -4661,7 +4699,7 @@ The default comes from `process-coding-system-alist' and (interactive "P") (sql-product-interactive 'sqlite buffer)) -(defun sql-comint-sqlite (product options) +(defun sql-comint-sqlite (product options &optional buf-name) "Create comint buffer and connect to SQLite." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. @@ -4669,7 +4707,7 @@ The default comes from `process-coding-system-alist' and (append options (if (not (string= "" sql-database)) `(,(expand-file-name sql-database)))))) - (sql-comint product params))) + (sql-comint product params buf-name))) (defun sql-sqlite-completion-object (sqlbuf _schema) (sql-redirect-value sqlbuf ".tables" "\\sw\\(?:\\sw\\|\\s_\\)*" 0)) @@ -4710,7 +4748,7 @@ The default comes from `process-coding-system-alist' and (interactive "P") (sql-product-interactive 'mysql buffer)) -(defun sql-comint-mysql (product options) +(defun sql-comint-mysql (product options &optional buf-name) "Create comint buffer and connect to MySQL." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. @@ -4727,7 +4765,7 @@ The default comes from `process-coding-system-alist' and (list (concat "--host=" sql-server))) (if (not (string= "" sql-database)) (list sql-database))))) - (sql-comint product params))) + (sql-comint product params buf-name))) @@ -4762,7 +4800,7 @@ The default comes from `process-coding-system-alist' and (interactive "P") (sql-product-interactive 'solid buffer)) -(defun sql-comint-solid (product options) +(defun sql-comint-solid (product options &optional buf-name) "Create comint buffer and connect to Solid." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. @@ -4775,7 +4813,7 @@ The default comes from `process-coding-system-alist' and (string= "" sql-password))) (list sql-user sql-password)) options))) - (sql-comint product params))) + (sql-comint product params buf-name))) @@ -4809,14 +4847,15 @@ The default comes from `process-coding-system-alist' and (interactive "P") (sql-product-interactive 'ingres buffer)) -(defun sql-comint-ingres (product options) +(defun sql-comint-ingres (product options &optional buf-name) "Create comint buffer and connect to Ingres." ;; username and password are ignored. (sql-comint product - (append (if (string= "" sql-database) - nil - (list sql-database)) - options))) + (append (if (string= "" sql-database) + nil + (list sql-database)) + options) + buf-name)) @@ -4852,7 +4891,7 @@ The default comes from `process-coding-system-alist' and (interactive "P") (sql-product-interactive 'ms buffer)) -(defun sql-comint-ms (product options) +(defun sql-comint-ms (product options &optional buf-name) "Create comint buffer and connect to Microsoft SQL Server." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. @@ -4875,7 +4914,7 @@ The default comes from `process-coding-system-alist' and ;; If -P is passed to ISQL as the last argument without a ;; password, it's considered null. `(,@params "-P")))) - (sql-comint product params))) + (sql-comint product params buf-name))) @@ -4916,7 +4955,7 @@ Try to set `comint-output-filter-functions' like this: (interactive "P") (sql-product-interactive 'postgres buffer)) -(defun sql-comint-postgres (product options) +(defun sql-comint-postgres (product options &optional buf-name) "Create comint buffer and connect to Postgres." ;; username and password are ignored. Mark Stosberg suggests to add ;; the database at the end. Jason Beegan suggests using --pset and @@ -4934,7 +4973,7 @@ Try to set `comint-output-filter-functions' like this: options (if (not (string= "" sql-database)) (list sql-database))))) - (sql-comint product params))) + (sql-comint product params buf-name))) (defun sql-postgres-completion-object (sqlbuf schema) (sql-redirect sqlbuf "\\t on") @@ -5004,7 +5043,7 @@ The default comes from `process-coding-system-alist' and (interactive "P") (sql-product-interactive 'interbase buffer)) -(defun sql-comint-interbase (product options) +(defun sql-comint-interbase (product options &optional buf-name) "Create comint buffer and connect to Interbase." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. @@ -5017,7 +5056,7 @@ The default comes from `process-coding-system-alist' and (if (not (string= "" sql-user)) (list "-u" sql-user)) options))) - (sql-comint product params))) + (sql-comint product params buf-name))) @@ -5056,11 +5095,11 @@ The default comes from `process-coding-system-alist' and (interactive "P") (sql-product-interactive 'db2 buffer)) -(defun sql-comint-db2 (product options) +(defun sql-comint-db2 (product options &optional buf-name) "Create comint buffer and connect to DB2." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. - (sql-comint product options)) + (sql-comint product options buf-name)) ;;;###autoload (defun sql-linter (&optional buffer) @@ -5094,7 +5133,7 @@ buffer. (interactive "P") (sql-product-interactive 'linter buffer)) -(defun sql-comint-linter (product options) +(defun sql-comint-linter (product options &optional buf-name) "Create comint buffer and connect to Linter." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. @@ -5109,7 +5148,7 @@ buffer. options))) (cl-letf (((getenv "LINTER_MBX") (unless (string= "" sql-database) sql-database))) - (sql-comint product params)))) + (sql-comint product params buf-name)))) @@ -5132,7 +5171,7 @@ The default value disables the internal pager." :type 'sql-login-params :group 'SQL) -(defun sql-comint-vertica (product options) +(defun sql-comint-vertica (product options &optional buf-name) "Create comint buffer and connect to Vertica." (sql-comint product (nconc @@ -5144,7 +5183,8 @@ The default value disables the internal pager." (list "-w" sql-password)) (and (not (string= "" sql-user)) (list "-U" sql-user)) - options))) + options) + buf-name)) ;;;###autoload (defun sql-vertica (&optional buffer) diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el index ede2f420735..6428b56f9dc 100644 --- a/lisp/progmodes/subword.el +++ b/lisp/progmodes/subword.el @@ -17,7 +17,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index 902a5aace08..dbb71efdfb4 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -20,7 +20,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;; BEFORE USE: ;; @@ -353,8 +353,6 @@ information): Quotes all \"#\" characters that don't correspond to actual Tcl comments. (Useful when editing code not originally created with this mode). - `tcl-auto-fill-mode' - Auto-filling of Tcl comments. Add functions to the hook with `add-hook': @@ -1413,6 +1411,9 @@ Prefix argument means switch to the Tcl buffer afterwards." (defun tcl-auto-fill-mode (&optional arg) "Like `auto-fill-mode', but sets `comment-auto-fill-only-comments'." + (declare + (obsolete + "Use `auto-fill-mode' with `comment-auto-fill-only-comments'." "26.1")) (interactive "P") (auto-fill-mode arg) (if auto-fill-function diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el index 066360023d7..05d1a5f5f31 100644 --- a/lisp/progmodes/vera-mode.el +++ b/lisp/progmodes/vera-mode.el @@ -32,7 +32,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Commentary: diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 2760c4d276e..e2bd89ec46c 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -4,7 +4,6 @@ ;; Author: Michael McNamara <mac@verilog.com> ;; Wilson Snyder <wsnyder@wsnyder.org> -;; X-URL: http://www.verilog.com ;; X-URL: http://www.veripool.org ;; Created: 3 Jan 1996 ;; Keywords: languages @@ -33,7 +32,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -70,7 +69,7 @@ ;; default. ;; You can get step by step help in installing this file by going to -;; <http://www.verilog.com/emacs_install.html> +;; <http://www.veripool.com/verilog-mode> ;; The short list of installation instructions are: To set up ;; automatic Verilog mode, put this file in your load path, and put @@ -123,7 +122,7 @@ ;; ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "2017-05-08-b240c8f-vpo-GNU" +(defconst verilog-mode-version "2017-08-07-c085e50-vpo-GNU" "Version of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -285,7 +284,7 @@ STRING should be given if the last search was by `string-match' on STRING." ;; This function is lifted directly from emacs's subr.el ;; so that it can be used by xemacs. ;; The idea for this was borrowed from org-mode via this link: -;; https://lists.gnu.org/archive/html/emacs-orgmode/2009-12/msg00032.html +;; https://lists.gnu.org/r/emacs-orgmode/2009-12/msg00032.html (eval-and-compile (cond ((fboundp 'looking-back) @@ -345,6 +344,12 @@ wherever possible, since it is slow." (unless (fboundp 'buffer-chars-modified-tick) ; Emacs 22 added (defmacro buffer-chars-modified-tick () (buffer-modified-tick))) (error nil)) + ;; Added in Emacs 23.1 + (condition-case nil + (unless (fboundp 'ignore-errors) + (defmacro ignore-errors (&rest body) + (declare (debug t) (indent 0)) + `(condition-case nil (progn ,@body) (error nil))))) ;; Added in Emacs 24.1 (condition-case nil (unless (fboundp 'prog-mode) @@ -961,7 +966,8 @@ Only used in XEmacs; GNU Emacs uses `verilog-error-regexp-emacs-alist'.") These arguments are used to find files for `verilog-auto', and match the flags accepted by a standard Verilog-XL simulator. - -f filename Reads more `verilog-library-flags' from the filename. + -f filename Reads absolute `verilog-library-flags' from the filename. + -F filename Reads relative `verilog-library-flags' from the filename. +incdir+dir Adds the directory to `verilog-library-directories'. -Idir Adds the directory to `verilog-library-directories'. -y dir Adds the directory to `verilog-library-directories'. @@ -4034,7 +4040,7 @@ With optional ARG, remove existing end of line comments." (progn (if (or (eq 'all verilog-auto-lineup) (eq 'assignments verilog-auto-lineup)) - (verilog-pretty-expr t "\\(<\\|:\\)?=" )) + (verilog-pretty-expr :quiet)) (newline)) (forward-line 1)) ;; Indent next line @@ -5790,11 +5796,9 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (goto-char here) ; or is clocking, starts a new block (throw 'nesting 'block))))) - ;; need to consider typedef struct here... ((looking-at "\\<class\\|struct\\|function\\|task\\>") ;; *sigh* These words have an optional prefix: ;; extern {virtual|protected}? function a(); - ;; typedef class foo; ;; and we don't want to confuse this with ;; function a(); ;; property @@ -5804,7 +5808,11 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (cond ((looking-at verilog-dpi-import-export-re) (throw 'continue 'foo)) - ((looking-at "\\<pure\\>\\s-+\\<virtual\\>\\s-+\\(?:\\<\\(local\\|protected\\|static\\)\\>\\s-+\\)?\\<\\(function\\|task\\)\\>\\s-+") + ((or + (looking-at "\\<pure\\>\\s-+\\<virtual\\>\\s-+\\(?:\\<\\(local\\|protected\\|static\\)\\>\\s-+\\)?\\<\\(function\\|task\\)\\>\\s-+") + ;; Do not throw 'defun for class typedefs like + ;; typedef class foo; + (looking-at "\\<typedef\\>\\s-+\\(?:\\<virtual\\>\\s-+\\)?\\<class\\>\\s-+")) (throw 'nesting 'statement)) ((looking-at verilog-beg-block-re-ordered) (throw 'nesting 'block)) @@ -6660,7 +6668,7 @@ Only look at a few lines to determine indent level." (let ((val)) (verilog-beg-of-statement-1) (if (and (< (point) here) - (verilog-re-search-forward "=[ \\t]*" here 'move) + (verilog-re-search-forward "=[ \t]*" here 'move) ;; not at a |=>, #=#, or [=n] operator (not (string-match "\\[=.\\|#=#\\||=>" (or (buffer-substring (- (point) 2) (1+ (point))) @@ -6974,106 +6982,97 @@ Be verbose about progress unless optional QUIET set." (forward-line 1)) (unless quiet (message ""))))))) -(defun verilog-pretty-expr (&optional quiet _myre) - "Line up expressions around point, optionally QUIET with regexp _MYRE ignored." +(defun verilog-pretty-expr (&optional quiet) + "Line up expressions around point. +If QUIET is non-nil, do not print messages showing the progress of line-up." (interactive) - (if (not (verilog-in-comment-or-string-p)) - (save-excursion - (let ( (rexp (concat "^\\s-*" verilog-complete-reg)) - (rexp1 (concat "^\\s-*" verilog-basic-complete-re))) - (beginning-of-line) - (if (and (not (looking-at rexp )) + (unless (verilog-in-comment-or-string-p) + (save-excursion + (let ((regexp (concat "^\\s-*" verilog-complete-reg)) + (regexp1 (concat "^\\s-*" verilog-basic-complete-re))) + (beginning-of-line) + (when (and (not (looking-at regexp)) (looking-at verilog-assignment-operation-re) (save-excursion (goto-char (match-end 2)) (and (not (verilog-in-attribute-p)) (not (verilog-in-parameter-p)) (not (verilog-in-comment-or-string-p))))) - (let* ((here (point)) - (e) (r) - (start - (progn - (beginning-of-line) - (setq e (point)) - (verilog-backward-syntactic-ws) - (beginning-of-line) - (while (and (not (looking-at rexp1)) - (looking-at verilog-assignment-operation-re) - (not (bobp)) - ) - (setq e (point)) - (verilog-backward-syntactic-ws) + (let* ((start (save-excursion ; BOL of the first line of the assignment block (beginning-of-line) - ) ;Ack, need to grok `define - e)) - (end - (progn - (goto-char here) + (let ((pt (point))) + (verilog-backward-syntactic-ws) + (beginning-of-line) + (while (and (not (looking-at regexp1)) + (looking-at verilog-assignment-operation-re) + (not (bobp))) + (setq pt (point)) + (verilog-backward-syntactic-ws) + (beginning-of-line)) ; Ack, need to grok `define + pt))) + (end (save-excursion ; EOL of the last line of the assignment block (end-of-line) - (setq e (point)) ;Might be on last line - (verilog-forward-syntactic-ws) - (beginning-of-line) - (while (and - (not (looking-at rexp1 )) - (looking-at verilog-assignment-operation-re) - (progn - (end-of-line) - (not (eq e (point))))) - (setq e (point)) + (let ((pt (point))) ; Might be on last line (verilog-forward-syntactic-ws) (beginning-of-line) - ) - e)) - (endpos (set-marker (make-marker) end)) - (ind) - ) - (goto-char start) - (verilog-do-indent (verilog-calculate-indent)) - (if (and (not quiet) - (> (- end start) 100)) - (message "Lining up expressions..(please stand by)")) - - ;; Set indent to minimum throughout region - (while (< (point) (marker-position endpos)) - (beginning-of-line) - (verilog-just-one-space verilog-assignment-operation-re) - (beginning-of-line) - (verilog-do-indent (verilog-calculate-indent)) - (end-of-line) - (verilog-forward-syntactic-ws) - ) - - ;; Now find biggest prefix - (setq ind (verilog-get-lineup-indent-2 verilog-assignment-operation-re start endpos)) - - ;; Now indent each line. - (goto-char start) - (while (progn (setq e (marker-position endpos)) - (setq r (- e (point))) - (> r 0)) - (setq e (point)) - (if (not quiet) (message "%d" r)) - (cond - ((looking-at verilog-assignment-operation-re) - (goto-char (match-beginning 2)) - (if (not (or (verilog-in-parenthesis-p) ; leave attributes and comparisons alone - (verilog-in-coverage-p))) - (if (eq (char-after) ?=) - (indent-to (1+ ind)) ; line up the = of the <= with surrounding = - (indent-to ind) - )) - ) - ((verilog-continued-line-1 start) - (goto-char e) - (indent-line-to ind)) - (t ; Must be comment or white space - (goto-char e) - (verilog-forward-ws&directives) - (forward-line -1)) - ) - (forward-line 1)) - (unless quiet (message "")) - )))))) + (while (and + (not (looking-at regexp1)) + (looking-at verilog-assignment-operation-re) + (progn + (end-of-line) + (not (eq pt (point))))) + (setq pt (point)) + (verilog-forward-syntactic-ws) + (beginning-of-line)) + pt))) + (contains-2-char-operator (string-match "<=" (buffer-substring-no-properties start end))) + (endmark (set-marker (make-marker) end))) + (goto-char start) + (verilog-do-indent (verilog-calculate-indent)) + (when (and (not quiet) + (> (- end start) 100)) + (message "Lining up expressions.. (please stand by)")) + + ;; Set indent to minimum throughout region + ;; Rely on mark rather than on point as the indentation changes can + ;; make the older point reference obsolete + (while (< (point) (marker-position endmark)) + (beginning-of-line) + (save-excursion + (verilog-just-one-space verilog-assignment-operation-re)) + (verilog-do-indent (verilog-calculate-indent)) + (end-of-line) + (verilog-forward-syntactic-ws)) + + (let ((ind (verilog-get-lineup-indent-2 verilog-assignment-operation-re start (marker-position endmark))) ; Find the biggest prefix + e) + ;; Now indent each line. + (goto-char start) + (while (progn + (setq e (marker-position endmark)) + (> e (point))) + (unless quiet + (message " verilog-pretty-expr: %d" (- e (point)))) + (setq e (point)) + (cond + ((looking-at verilog-assignment-operation-re) + (goto-char (match-beginning 2)) + (unless (or (verilog-in-parenthesis-p) ; Leave attributes and comparisons alone + (verilog-in-coverage-p)) + (if (and contains-2-char-operator + (eq (char-after) ?=)) + (indent-to (1+ ind)) ; Line up the = of the <= with surrounding = + (indent-to ind)))) + ((verilog-continued-line-1 start) + (goto-char e) + (indent-line-to ind)) + (t ; Must be comment or white space + (goto-char e) + (verilog-forward-ws&directives) + (forward-line -1))) + (forward-line 1)) + (unless quiet + (message ""))))))))) (defun verilog-just-one-space (myre) "Remove extra spaces around regular expression MYRE." @@ -7180,30 +7179,30 @@ Region is defined by B and EDPOS." ;;(skip-chars-backward " \t") (1+ (current-column)))))) -(defun verilog-get-lineup-indent-2 (myre b edpos) - "Return the indent level that will line up several lines within the region." +(defun verilog-get-lineup-indent-2 (regexp beg end) + "Return the indent level that will line up several lines. +The lineup string is searched using REGEXP within the region between points +BEG and END." (save-excursion - (let ((ind 0) e) - (goto-char b) + (let ((ind 0)) + (goto-char beg) ;; Get rightmost position - (while (progn (setq e (marker-position edpos)) - (< (point) e)) - (if (and (verilog-re-search-forward myre e 'move) - (not (verilog-in-attribute-p))) ; skip attribute exprs - (progn - (goto-char (match-beginning 2)) - (verilog-backward-syntactic-ws) - (if (> (current-column) ind) - (setq ind (current-column))) - (goto-char (match-end 0))) - )) - (if (> ind 0) - (1+ ind) - ;; No lineup-string found - (goto-char b) - (end-of-line) - (skip-chars-backward " \t") - (1+ (current-column)))))) + (while (< (point) end) + (when (and (verilog-re-search-forward regexp end 'move) + (not (verilog-in-attribute-p))) ; skip attribute exprs + (goto-char (match-beginning 2)) + (verilog-backward-syntactic-ws) + (if (> (current-column) ind) + (setq ind (current-column))) + (goto-char (match-end 0)))) + (setq ind (if (> ind 0) + (1+ ind) + ;; No lineup-string found + (goto-char beg) + (end-of-line) + (skip-chars-backward " \t") + (1+ (current-column)))) + ind))) (defun verilog-comment-depth (type val) "A useful mode debugging aide. TYPE and VAL are comments for insertion." @@ -9344,7 +9343,7 @@ Returns REGEXP and list of ( (signal_name connection_name)... )." ;; Regexp form?? ((looking-at ;; Regexp bug in XEmacs disallows ][ inside [], and wants + last - "\\s-*\\.\\(\\([a-zA-Z0-9`_$+@^.*?|---]+\\|[][]\\|\\\\[()|]\\)+\\)\\s-*(\\(.*\\))\\s-*\\(,\\|)\\s-*;\\)") + "\\s-*\\.\\(\\([a-zA-Z0-9`_$+@^.*?|---]\\|[][]\\|\\\\[()|]\\)+\\)\\s-*(\\(.*\\))\\s-*\\(,\\|)\\s-*;\\)") (setq rep (match-string-no-properties 3)) (goto-char (match-end 0)) (setq tpl-wild-list @@ -9619,8 +9618,9 @@ Some macros and such are also found and included. For dinotrace.el." ;; Argument file parsing ;; -(defun verilog-getopt (arglist) - "Parse -f, -v etc arguments in ARGLIST list or string." +(defun verilog-getopt (arglist &optional default-dir) + "Parse -f, -v etc arguments in ARGLIST list or string. +Use DEFAULT-DIR to anchor paths if non-nil." (unless (listp arglist) (setq arglist (list arglist))) (let ((space-args '()) arg next-param) @@ -9638,6 +9638,8 @@ Some macros and such are also found and included. For dinotrace.el." space-args (cdr space-args)) (cond ;; Need another arg + ((equal arg "-F") + (setq next-param arg)) ((equal arg "-f") (setq next-param arg)) ((equal arg "-v") @@ -9661,32 +9663,37 @@ Some macros and such are also found and included. For dinotrace.el." ((or (string-match "^\\+incdir\\+\\(.*\\)" arg) ; +incdir+dir (string-match "^-I\\(.*\\)" arg)) ; -Idir (verilog-add-list-unique `verilog-library-directories - (match-string 1 (substitute-in-file-name arg)))) + (substitute-in-file-name (match-string 1 arg)))) ;; Ignore ((equal "+librescan" arg)) ((string-match "^-U\\(.*\\)" arg)) ; -Udefine ;; Second parameters + ((equal next-param "-F") + (setq next-param nil) + (verilog-getopt-file (verilog-substitute-file-name-path arg default-dir) + (file-name-directory (verilog-substitute-file-name-path arg default-dir)))) ((equal next-param "-f") (setq next-param nil) - (verilog-getopt-file (substitute-in-file-name arg))) + (verilog-getopt-file (verilog-substitute-file-name-path arg default-dir) nil)) ((equal next-param "-v") (setq next-param nil) (verilog-add-list-unique `verilog-library-files - (substitute-in-file-name arg))) + (verilog-substitute-file-name-path arg default-dir))) ((equal next-param "-y") (setq next-param nil) (verilog-add-list-unique `verilog-library-directories - (substitute-in-file-name arg))) + (verilog-substitute-file-name-path arg default-dir))) ;; Filename ((string-match "^[^-+]" arg) (verilog-add-list-unique `verilog-library-files - (substitute-in-file-name arg))) + (verilog-substitute-file-name-path arg default-dir))) ;; Default - ignore; no warning )))) ;;(verilog-getopt (list "+libext+.a+.b" "+incdir+foodir" "+define+a+aval" "-f" "otherf" "-v" "library" "-y" "dir")) -(defun verilog-getopt-file (filename) - "Read Verilog options from the specified FILENAME." +(defun verilog-getopt-file (filename &optional default-dir) + "Read Verilog options from the specified FILENAME. +Use DEFAULT-DIR to anchor paths if non-nil." (save-excursion (let ((fns (verilog-library-filenames filename (buffer-file-name))) (orig-buffer (current-buffer)) @@ -9702,7 +9709,7 @@ Some macros and such are also found and included. For dinotrace.el." (when (string-match "//" line) (setq line (substring line 0 (match-beginning 0)))) (with-current-buffer orig-buffer ; Variables are buffer-local, so need right context. - (verilog-getopt line)))))) + (verilog-getopt line default-dir)))))) (defun verilog-getopt-flags () "Convert `verilog-library-flags' into standard library variables." @@ -9719,6 +9726,13 @@ Some macros and such are also found and included. For dinotrace.el." ;; Allow user to customize (verilog-run-hooks 'verilog-getopt-flags-hook)) +(defun verilog-substitute-file-name-path (filename default-dir) + "Return FILENAME with environment variables substituted. +Use DEFAULT-DIR to anchor paths if non-nil." + (if default-dir + (expand-file-name (substitute-in-file-name filename) default-dir) + (substitute-in-file-name filename))) + (defun verilog-add-list-unique (varref object) "Append to VARREF list the given OBJECT, unless it is already a member of the variable's list." @@ -9898,42 +9912,44 @@ Or, just the existing dirnames themselves if there are no wildcards." (interactive) (unless dirnames (error "`verilog-library-directories' should include at least `.'")) - (setq dirnames (reverse dirnames)) ; not nreverse - (let ((dirlist nil) - pattern dirfile dirfiles dirname root filename rest basefile) - (while dirnames - (setq dirname (substitute-in-file-name (car dirnames)) - dirnames (cdr dirnames)) - (cond ((string-match (concat "^\\(\\|[/\\]*[^*?]*[/\\]\\)" ; root - "\\([^/\\]*[*?][^/\\]*\\)" ; filename with *? - "\\(.*\\)") ; rest - dirname) - (setq root (match-string 1 dirname) - filename (match-string 2 dirname) - rest (match-string 3 dirname) - pattern filename) - ;; now replace those * and ? with .+ and . - ;; use ^ and /> to get only whole file names - (setq pattern (verilog-string-replace-matches "[*]" ".+" nil nil pattern) - pattern (verilog-string-replace-matches "[?]" "." nil nil pattern) - pattern (concat "^" pattern "$") - dirfiles (verilog-dir-files root)) - (while dirfiles - (setq basefile (car dirfiles) - dirfile (expand-file-name (concat root basefile rest)) - dirfiles (cdr dirfiles)) - (if (and (string-match pattern basefile) - ;; Don't allow abc/*/rtl to match abc/rtl via .. - (not (equal basefile ".")) - (not (equal basefile "..")) - (file-directory-p dirfile)) - (setq dirlist (cons dirfile dirlist))))) - ;; Defaults - (t - (if (file-directory-p dirname) - (setq dirlist (cons dirname dirlist)))))) - dirlist)) -;;(verilog-expand-dirnames (list "." ".." "nonexist" "../*" "/home/wsnyder/*/v")) + (save-match-data + (setq dirnames (reverse dirnames)) ; not nreverse + (let ((dirlist nil) + pattern dirfile dirfiles dirname root filename rest basefile) + (setq dirnames (mapcar 'substitute-in-file-name dirnames)) + (while dirnames + (setq dirname (car dirnames) + dirnames (cdr dirnames)) + (cond ((string-match (concat "^\\(\\|[/\\]*[^*?]*[/\\]\\)" ; root + "\\([^/\\]*[*?][^/\\]*\\)" ; filename with *? + "\\(.*\\)") ; rest + dirname) + (setq root (match-string 1 dirname) + filename (match-string 2 dirname) + rest (match-string 3 dirname) + pattern filename) + ;; now replace those * and ? with .+ and . + ;; use ^ and /> to get only whole file names + (setq pattern (verilog-string-replace-matches "[*]" ".+" nil nil pattern) + pattern (verilog-string-replace-matches "[?]" "." nil nil pattern) + pattern (concat "^" pattern "$") + dirfiles (verilog-dir-files root)) + (while dirfiles + (setq basefile (car dirfiles) + dirfile (expand-file-name (concat root basefile rest)) + dirfiles (cdr dirfiles)) + (when (and (string-match pattern basefile) + ;; Don't allow abc/*/rtl to match abc/rtl via .. + (not (equal basefile ".")) + (not (equal basefile ".."))) + ;; Might have more wildcards, so process again + (setq dirnames (cons dirfile dirnames))))) + ;; Defaults + (t + (if (file-directory-p dirname) + (setq dirlist (cons dirname dirlist)))))) + dirlist))) +;;(verilog-expand-dirnames (list "." ".." "nonexist" "../*" "/home/wsnyder/*/v" "../*/*")) (defun verilog-library-filenames (filename &optional current check-ext) "Return a search path to find the given FILENAME or module name. @@ -12074,7 +12090,7 @@ This is currently equivalent to: with the below at the bottom of the file // Local Variables: - // verilog-auto-logic-type:\"logic\" + // verilog-auto-wire-type:\"logic\" // End: In the future AUTOLOGIC may declare additional identifiers, @@ -13223,10 +13239,12 @@ Typing \\[verilog-auto] will make this into: Replace the /*AUTOTIEOFF*/ comment with code to wire-tie all unused output signals to deasserted. -/*AUTOTIEOFF*/ is used to make stub modules; modules that have the same -input/output list as another module, but no internals. Specifically, it -finds all outputs in the module, and if that input is not otherwise declared -as a register or wire, creates a tieoff. +/*AUTOTIEOFF*/ is used to make stub modules; modules that have +the same input/output list as another module, but no internals. +Specifically, it finds all outputs in the module, and if that +input is not otherwise declared as a register or wire, nor comes +from a AUTOINST submodule's output, creates a tieoff. AUTOTIEOFF +does not examine assignments to determine what is already driven. AUTORESET ties signals to deasserted, which is presumed to be zero. Signals that match `verilog-active-low-regexp' will be deasserted by tying @@ -14420,7 +14438,7 @@ Files are checked based on `verilog-library-flags'." (with-output-to-temp-buffer "*verilog-mode help*" (princ (format "You are using verilog-mode %s\n" verilog-mode-version)) (princ "\n") - (princ "For new releases, see http://www.verilog.com\n") + (princ "For new releases, see http://www.veripool.com/verilog-mode\n") (princ "\n") (princ "For frequently asked questions, see http://www.veripool.org/verilog-mode-faq.html\n") (princ "\n") diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 06ffd54d2df..3f2d7e11ec9 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -32,7 +32,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Commentary: @@ -17897,7 +17897,7 @@ references: [3] European Space Agency. \"VHDL Modelling Guidelines\". - ftp://ftp.estec.esa.nl/pub/vhdl/doc/ModelGuide.{pdf,ps} + https://amstel.estec.esa.int/tecedm/website/docs_generic/ModelGuide.pdf Use user options `vhdl-highlight-special-words' and `vhdl-special-syntax-alist' to visually support naming conventions.") diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 41513340e12..adfe7b3bf1c 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -20,7 +20,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index b8ec50f14ae..db025d40aa3 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -15,7 +15,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -102,7 +102,7 @@ This is typically the filename.") ;;;; Commonly needed location classes are defined here: ;; FIXME: might be useful to have an optional "hint" i.e. a string to -;; search for in case the line number is sightly out of date. +;; search for in case the line number is slightly out of date. (defclass xref-file-location (xref-location) ((file :type string :initarg :file) (line :type fixnum :initarg :line :reader xref-location-line) @@ -254,8 +254,7 @@ find a search tool; by default, this uses \"find | grep\" in the (project-external-roots pr))))) (cl-defgeneric xref-backend-apropos (backend pattern) - "Find all symbols that match PATTERN. -PATTERN is a regexp") + "Find all symbols that match regexp PATTERN.") (cl-defgeneric xref-backend-identifier-at-point (_backend) "Return the relevant identifier at point. @@ -449,43 +448,74 @@ If SELECT is non-nil, select the target window." (when xref-w (set-window-dedicated-p xref-w xref-w-dedicated))))) -(defun xref--show-pos-in-buf (pos buf select) - (let ((xref-buf (current-buffer)) - win) +(defvar-local xref--original-window-intent nil + "Original window-switching intent before xref buffer creation.") + +(defvar-local xref--original-window nil + "The original window this xref buffer was created from.") + +(defun xref--show-pos-in-buf (pos buf) + "Goto and display position POS of buffer BUF in a window. +Honor `xref--original-window-intent', run `xref-after-jump-hook' +and finally return the window." + (let* ((xref-buf (current-buffer)) + (pop-up-frames + (or (eq xref--original-window-intent 'frame) + pop-up-frames)) + (action + (cond ((memq + xref--original-window-intent + '(window frame)) + t) + ((and + (window-live-p xref--original-window) + (or (not (window-dedicated-p xref--original-window)) + (eq (window-buffer xref--original-window) buf))) + `(,(lambda (buf _alist) + (set-window-buffer xref--original-window buf) + xref--original-window)))))) (with-selected-window - (xref--with-dedicated-window - (display-buffer buf)) + (with-selected-window + ;; Just before `display-buffer', place ourselves in the + ;; original window to suggest preserving it. Of course, if + ;; user has deleted the original window, all bets are off, + ;; just use the selected one. + (or (and (window-live-p xref--original-window) + xref--original-window) + (selected-window)) + (display-buffer buf action)) (xref--goto-char pos) (run-hooks 'xref-after-jump-hook) (let ((buf (current-buffer))) - (setq win (selected-window)) (with-current-buffer xref-buf - (setq-local other-window-scroll-buffer buf)))) - (when select - (select-window win)))) + (setq-local other-window-scroll-buffer buf))) + (selected-window)))) (defun xref--show-location (location &optional select) + "Help `xref-show-xref' and `xref-goto-xref' do their job. +Go to LOCATION and if SELECT is non-nil select its window. If +SELECT is `quit', also quit the *xref* window." (condition-case err (let* ((marker (xref-location-marker location)) - (buf (marker-buffer marker))) - (xref--show-pos-in-buf marker buf select)) + (buf (marker-buffer marker)) + (xref-buffer (current-buffer))) + (cond (select + (if (eq select 'quit) (quit-window nil nil)) + (with-current-buffer xref-buffer + (select-window (xref--show-pos-in-buf marker buf)))) + (t + (save-selected-window + (xref--with-dedicated-window + (xref--show-pos-in-buf marker buf)))))) (user-error (message (error-message-string err))))) -(defvar-local xref--window nil - "The original window this xref buffer was created from.") - (defun xref-show-location-at-point () "Display the source of xref at point in the appropriate window, if any." (interactive) (let* ((xref (xref--item-at-point)) (xref--current-item xref)) (when xref - ;; Try to avoid the window the current xref buffer was - ;; originally created from. - (if (window-live-p xref--window) - (with-selected-window xref--window - (xref--show-location (xref-item-location xref))) - (xref--show-location (xref-item-location xref)))))) + (xref--show-location (xref-item-location xref))))) (defun xref-next-line () "Move to the next xref and display its source in the appropriate window." @@ -504,12 +534,19 @@ If SELECT is non-nil, select the target window." (back-to-indentation) (get-text-property (point) 'xref-item))) -(defun xref-goto-xref () - "Jump to the xref on the current line and select its window." +(defun xref-goto-xref (&optional quit) + "Jump to the xref on the current line and select its window. +Non-interactively, non-nil QUIT means to first quit the *xref* +buffer." (interactive) (let ((xref (or (xref--item-at-point) (user-error "No reference at point")))) - (xref--show-location (xref-item-location xref) t))) + (xref--show-location (xref-item-location xref) (if quit 'quit t)))) + +(defun xref-quit-and-goto-xref () + "Quit *xref* buffer, then jump to xref on current line." + (interactive) + (xref-goto-xref t)) (defun xref-query-replace-in-results (from to) "Perform interactive replacement of FROM with TO in all displayed xrefs. @@ -633,6 +670,7 @@ references displayed in the current *xref* buffer." (define-key map (kbd "p") #'xref-prev-line) (define-key map (kbd "r") #'xref-query-replace-in-results) (define-key map (kbd "RET") #'xref-goto-xref) + (define-key map (kbd "TAB") #'xref-quit-and-goto-xref) (define-key map (kbd "C-o") #'xref-show-location-at-point) ;; suggested by Johan Claesson "to further reduce finger movement": (define-key map (kbd ".") #'xref-next-line) @@ -727,7 +765,8 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." (xref--xref-buffer-mode) (pop-to-buffer (current-buffer)) (goto-char (point-min)) - (setq xref--window (assoc-default 'window alist)) + (setq xref--original-window (assoc-default 'window alist) + xref--original-window-intent (assoc-default 'display-action alist)) (current-buffer))))) @@ -754,7 +793,8 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." (t (xref-push-marker-stack) (funcall xref-show-xrefs-function xrefs - `((window . ,(selected-window))))))) + `((window . ,(selected-window)) + (display-action . ,display-action)))))) (defun xref--prompt-p (command) (or (eq xref-prompt-for-identifier t) @@ -917,22 +957,25 @@ IGNORES is a list of glob patterns." (grep-compute-defaults) (defvar grep-find-template) (defvar grep-highlight-matches) - (let* ((grep-find-template (replace-regexp-in-string "<C>" "<C> -E" - grep-find-template t t)) - (grep-highlight-matches nil) - ;; TODO: Sanitize the regexp to remove Emacs-specific terms, - ;; so that Grep can search for the "relaxed" version. Can we - ;; do that reliably enough, without creating false negatives? - (command (xref--rgrep-command (xref--regexp-to-extended regexp) - files - (expand-file-name dir) - ignores)) - (buf (get-buffer-create " *xref-grep*")) - (grep-re (caar grep-regexp-alist)) - status - hits) + (pcase-let* + ((grep-find-template (replace-regexp-in-string "<C>" "<C> -E" + grep-find-template t t)) + (grep-highlight-matches nil) + ;; TODO: Sanitize the regexp to remove Emacs-specific terms, + ;; so that Grep can search for the "relaxed" version. Can we + ;; do that reliably enough, without creating false negatives? + (command (xref--rgrep-command (xref--regexp-to-extended regexp) + files + (expand-file-name dir) + ignores)) + (def default-directory) + (buf (get-buffer-create " *xref-grep*")) + (`(,grep-re ,file-group ,line-group . ,_) (car grep-regexp-alist)) + (status nil) + (hits nil)) (with-current-buffer buf (erase-buffer) + (setq default-directory def) (setq status (call-process-shell-command command nil t)) (goto-char (point-min)) @@ -944,8 +987,8 @@ IGNORES is a list of glob patterns." (not (looking-at grep-re))) (user-error "Search failed with status %d: %s" status (buffer-string))) (while (re-search-forward grep-re nil t) - (push (list (string-to-number (match-string 2)) - (match-string 1) + (push (list (string-to-number (match-string line-group)) + (match-string file-group) (buffer-substring-no-properties (point) (line-end-position))) hits))) (xref--convert-hits (nreverse hits) regexp))) diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el index bdfe30af505..16bf01eeaa8 100644 --- a/lisp/progmodes/xscheme.el +++ b/lisp/progmodes/xscheme.el @@ -19,7 +19,7 @@ ;; 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 <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -85,8 +85,7 @@ reading-type received an altmode but nothing else reading-string reading prompt string") (defvar-local xscheme-allow-output-p t - "This variable, if nil, prevents output from the scheme process -from being inserted into the process-buffer.") + "Non-nil stops scheme process output being inserted in the process buffer.") (defvar-local xscheme-prompt "" "The current scheme prompt string.") @@ -300,7 +299,7 @@ With argument, asks for a command line." (defun scheme-interaction-mode (&optional preserve) "Major mode for interacting with an inferior MIT Scheme process. -Like scheme-mode except that: +Like `scheme-mode' except that: \\[xscheme-send-previous-expression] sends the expression before point to the Scheme process as input \\[xscheme-yank-pop] yanks an expression previously sent to Scheme @@ -315,7 +314,7 @@ in the minibuffer. If an error occurs, the process buffer will automatically pop up to show you the error message. While the Scheme process is running, the mode lines of all buffers in -scheme-mode are modified to show the state of the process. The +`scheme-mode' are modified to show the state of the process. The possible states and their meanings are: input waiting for input @@ -353,13 +352,13 @@ Some possible command interpreter types and their meanings are: Starting with release 6.2 of Scheme, the latter two types of command interpreters will change the major mode of the Scheme process buffer -to scheme-debugger-mode , in which the evaluation commands are +to `scheme-debugger-mode', in which the evaluation commands are disabled, and the keys which normally self insert instead send themselves to the Scheme process. The command character ? will list the available commands. -For older releases of Scheme, the major mode will be be -scheme-interaction-mode , and the command characters must be sent as +For older releases of Scheme, the major mode will be +`scheme-interaction-mode', and the command characters must be sent as if they were expressions. Commands: @@ -367,10 +366,8 @@ Delete converts tabs to spaces as it moves back. Blank lines separate paragraphs. Semicolons start comments. \\{scheme-interaction-mode-map} -Entry to this mode calls the value of scheme-interaction-mode-hook -with no args, if that value is non-nil. - Likewise with the value of scheme-mode-hook. - scheme-interaction-mode-hook is called after scheme-mode-hook." +Entry to this mode runs `scheme-mode-hook' and then +`scheme-interaction-mode-hook'." ;; FIXME: Use define-derived-mode. (interactive "P") (if (not preserve) @@ -456,7 +453,7 @@ with no args, if that value is non-nil. (defun scheme-debugger-mode () "Major mode for executing the Scheme debugger. -Like scheme-mode except that the evaluation commands +Like `scheme-mode' except that the evaluation commands are disabled, and characters that would normally be self inserting are sent to the Scheme process instead. Typing ? will show you which characters perform useful functions. @@ -593,7 +590,7 @@ See also the commands \\[xscheme-yank-pop] and \\[xscheme-yank-push]." "Insert or replace a just-yanked expression with an older expression. If the previous command was not a yank, it yanks. Otherwise, the region contains a stretch of reinserted -expression. yank-pop deletes that text and inserts in its +expression. `yank-pop' deletes that text and inserts in its place a different expression. With no argument, the next older expression is inserted. @@ -620,7 +617,7 @@ comes the newest one." "Insert or replace a just-yanked expression with a more recent expression. If the previous command was not a yank, it yanks. Otherwise, the region contains a stretch of reinserted -expression. yank-pop deletes that text and inserts in its +expression. `yank-pop' deletes that text and inserts in its place a different expression. With no argument, the next more recent expression is inserted. |