diff options
Diffstat (limited to 'lisp/progmodes')
46 files changed, 1711 insertions, 810 deletions
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 29ff521253b..977a3d72cb7 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -493,7 +493,7 @@ and set it if applicable." ;; the values of the From, To, and Cc headers. (let (header-values) (with-current-buffer - (get-buffer gnus-original-article-buffer) + gnus-original-article-buffer (save-excursion (goto-char (point-min)) ;; The Newsgroup is omitted because we already matched diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el index 07161025d5d..e48bcc64f14 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -37,9 +37,8 @@ ;; ;; For indenting statements: ;; -;; - Set `c-ts-common-indent-offset', -;; `c-ts-common-indent-block-type-regexp', and -;; `c-ts-common-indent-bracketless-type-regexp', then use simple-indent +;; - Set `c-ts-common-indent-offset', and +;; `c-ts-common-indent-type-regexp-alist', then use simple-indent ;; offset `c-ts-common-statement-offset' in ;; `treesit-simple-indent-rules'. @@ -331,9 +330,9 @@ If NODE is nil, return nil." Assumes the anchor is (point-min), i.e., the 0th column. This function basically counts the number of block nodes (i.e., -brackets) (defined by `c-ts-common-indent-block-type-regexp') +brackets) (see `c-ts-common-indent-type-regexp-alist') between NODE and the root node (not counting NODE itself), and -multiply that by `c-ts-common-indent-offset'. +multiplies that by `c-ts-common-indent-offset'. To support GNU style, on each block level, this function also checks whether the opening bracket { is on its own line, if so, diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index e5835bdb62d..3a89f0f494b 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -97,7 +97,7 @@ "Toggle the comment style between block and line comments. Optional numeric ARG, if supplied, switches to block comment style when positive, to line comment style when negative, and -just toggles it when zero or left out." +just toggles it when zero or omitted." (interactive "P") (let ((prevstate-line (string= comment-start "// "))) (when (or (not arg) @@ -147,9 +147,9 @@ symbol." "Style used for indentation. The selected style could be one of GNU, K&R, LINUX or BSD. If -one of the supplied styles doesn't suffice, a function could be -set instead. This function is expected to return a list that -follows the form of `treesit-simple-indent-rules'." +one of the supplied styles doesn't suffice, the value could be +a function instead. This function is expected to return a list +that follows the form of `treesit-simple-indent-rules'." :version "29.1" :type '(choice (symbol :tag "Gnu" gnu) (symbol :tag "K&R" k&r) @@ -202,8 +202,8 @@ To set the default indent style globally, use (if (derived-mode-p 'c-ts-mode) 'c 'cpp)))))) (defcustom c-ts-mode-emacs-sources-support t - "Whether to enable Emacs source-specific features. -This enables detection of definitions of Lisp function using + "Whether to enable Emacs source-specific C features. +This enables detection of definitions of Lisp functions via the DEFUN macro. This needs to be set before enabling `c-ts-mode'; if you change the value after enabling `c-ts-mode', toggle the mode off and on @@ -243,7 +243,7 @@ again." < and > are usually punctuation, e.g., in ->. But when used for templates, they should be considered pairs. -This function checks for < and > in the changed RANGES and apply +This function checks for < and > in the changed RANGES and applies appropriate text property to alter the syntax of template delimiters < and >'s." (goto-char beg) @@ -284,9 +284,9 @@ is actually the parent of point at the moment of indentation." "Return the start of the previous named sibling of NODE. This anchor handles the special case where the previous sibling -is a labeled_statement, in that case, return the child of the +is a labeled_statement; in that case, return the child of the labeled statement instead. (Actually, recursively go down until -the node isn't a labeled_statement.) Eg, +the node isn't a labeled_statement.) E.g., label: int x = 1; @@ -295,10 +295,11 @@ label: The anchor of \"int y = 2;\" should be \"int x = 1;\" rather than the labeled_statement. -Return nil if a) there is no prev-sibling, or 2) prev-sibling +Return nil if a) there is no prev-sibling, or b) prev-sibling doesn't have a child. -PARENT and BOL are like other anchor functions." +PARENT is NODE's parent, BOL is the beginning of non-whitespace +characters of the current line." (when-let ((prev-sibling (or (treesit-node-prev-sibling node t) (treesit-node-prev-sibling @@ -336,7 +337,7 @@ PARENT and BOL are like other anchor functions." (defun c-ts-mode--standalone-parent-skip-preproc (_n parent &rest _) "Like the standalone-parent anchor but skips preproc nodes. -PARENT is the same as other anchor functions." +PARENT is the parent of the current node." (save-excursion (treesit-node-start (treesit-parent-until @@ -353,13 +354,15 @@ PARENT is the same as other anchor functions." (defun c-ts-mode--standalone-grandparent (_node parent bol &rest args) "Like the standalone-parent anchor but pass it the grandparent. -PARENT, BOL, ARGS are the same as other anchor functions." +PARENT is NODE's parent, BOL is the beginning of non-whitespace +characters of the current line." (apply (alist-get 'standalone-parent treesit-simple-indent-presets) parent (treesit-node-parent parent) bol args)) (defun c-ts-mode--else-heuristic (node parent bol &rest _) "Heuristic matcher for when \"else\" is followed by a closing bracket. -NODE, PARENT, and BOL are the same as in other matchers." +PARENT is NODE's parent, BOL is the beginning of non-whitespace +characters of the current line." (and (null node) (save-excursion (forward-line -1) @@ -757,7 +760,7 @@ MODE is either `c' or `cpp'." (defun c-ts-mode--declarator-identifier (node &optional qualified) "Return the identifier of the declarator node NODE. -If QUALIFIED is non-nil, include the names space part of the +If QUALIFIED is non-nil, include the namespace part of the identifier and return a qualified_identifier." (pcase (treesit-node-type node) ;; Recurse. @@ -782,7 +785,7 @@ identifier and return a qualified_identifier." node))) (defun c-ts-mode--fontify-declarator (node override start end &rest _args) - "Fontify a declarator (whatever under the \"declarator\" field). + "Fontify a declarator (whatever is under the \"declarator\" field). For NODE, OVERRIDE, START, END, and ARGS, see `treesit-font-lock-rules'." (let* ((identifier (c-ts-mode--declarator-identifier node)) @@ -817,7 +820,7 @@ For NODE, OVERRIDE, START, END, and ARGS, see (defun c-ts-mode--fontify-variable (node override start end &rest _) "Fontify an identifier node if it is a variable. -Don't fontify if it is a function identifier. For NODE, +Don't fontify it if it is a function identifier. For NODE, OVERRIDE, START, END, and ARGS, see `treesit-font-lock-rules'." (when (not (equal (treesit-node-type (treesit-node-parent node)) @@ -911,7 +914,8 @@ Return nil if NODE is not a defun node or doesn't have a name." t)) ((or "struct_specifier" "enum_specifier" "union_specifier" "class_specifier" - "namespace_definition") + "namespace_definition" + "preproc_def" "preproc_function_def") (treesit-node-child-by-field-name node "name")) ;; DEFUNs in Emacs sources. ("expression_statement" @@ -922,11 +926,22 @@ Return nil if NODE is not a defun node or doesn't have a name." name))) t)) +;;; Outline minor mode + +(defun c-ts-mode--outline-predicate (node) + "Match outlines on lines with function names." + (or (and (equal (treesit-node-type node) "function_declarator") + (equal (treesit-node-type (treesit-node-parent node)) + "function_definition")) + ;; DEFUNs in Emacs sources. + (and c-ts-mode-emacs-sources-support + (c-ts-mode--emacs-defun-p node)))) + ;;; Defun navigation (defun c-ts-mode--defun-valid-p (node) "Return non-nil if NODE is a valid defun node. -Ie, NODE is not nested." +That is, NODE is not nested." (let ((top-level-p (lambda (node) (not (treesit-node-top-level node (rx (or "function_definition" @@ -965,8 +980,7 @@ Basically, if NODE is a class, return non-nil; if NODE is a function but is under a class, return non-nil; if NODE is a top-level function, return nil. -This is for the Class subindex in -`treesit-simple-imenu-settings'." +This is for the Class subindex in `treesit-simple-imenu-settings'." (pcase (treesit-node-type node) ;; The Class subindex only has class_specifier and ;; function_definition. @@ -977,7 +991,7 @@ This is for the Class subindex in (defun c-ts-mode--defun-skipper () "Custom defun skipper for `c-ts-mode' and friends. -Structs in C ends with a semicolon, but the semicolon is not +Structs in C end with a semicolon, but the semicolon is not considered part of the struct node, so point would stop before the semicolon. This function skips the semicolon." (when (looking-at (rx (* (or " " "\t")) ";")) @@ -997,7 +1011,7 @@ the semicolon. This function skips the semicolon." (list node parent bol))) (defun c-ts-mode--emacs-defun-p (node) - "Return non-nil if NODE is a Lisp function defined using DEFUN. + "Return non-nil if NODE is a Lisp function defined via DEFUN. This function detects Lisp primitives defined in Emacs source files using the DEFUN macro." (and (equal (treesit-node-type node) "expression_statement") @@ -1018,15 +1032,15 @@ files using the DEFUN macro." "Return the defun node at point. In addition to regular C functions, this function recognizes -definitions of Lisp primitrives in Emacs source files using DEFUN, -if `c-ts-mode-emacs-sources-support' is non-nil. +definitions of Lisp primitrives in Emacs source files defined +via DEFUN, if `c-ts-mode-emacs-sources-support' is non-nil. Note that DEFUN is parsed by tree-sitter as two separate nodes, one for the declaration and one for the body; this function returns the declaration node. If RANGE is non-nil, return (BEG . END) where BEG end END -encloses the whole defun. This is for when the entire defun +enclose the whole defun. This is for when the entire defun is required, not just the declaration part for DEFUN." (when-let* ((node (treesit-defun-at-point)) (defun-range (cons (treesit-node-start node) @@ -1055,7 +1069,7 @@ is required, not just the declaration part for DEFUN." "Return the name of the current defun. This is used for `add-log-current-defun-function'. In addition to regular C functions, this function also recognizes -Emacs primitives defined using DEFUN in Emacs sources, +Emacs primitives defined via DEFUN in Emacs sources, if `c-ts-mode-emacs-sources-support' is non-nil." (or (treesit-add-log-current-defun) (c-ts-mode--defun-name (c-ts-mode--emacs-defun-at-point)))) @@ -1133,7 +1147,7 @@ For BOL see `treesit-simple-indent-rules'." (defun c-ts-mode--reverse-ranges (ranges beg end) "Reverse RANGES and return the new ranges between BEG and END. -Positions that were included RANGES are not in the returned +Positions that were included in RANGES are not in the returned ranges, and vice versa. Return nil if RANGES is nil. This way, passing the returned @@ -1179,7 +1193,6 @@ BEG and END are described in `treesit-range-rules'." "C-c C-c" #'comment-region "C-c C-k" #'c-ts-mode-toggle-comment-style) -;;;###autoload (define-derived-mode c-ts-base-mode prog-mode "C" "Major mode for editing C, powered by tree-sitter. @@ -1195,7 +1208,9 @@ BEG and END are described in `treesit-range-rules'." "enum_specifier" "union_specifier" "class_specifier" - "namespace_definition") + "namespace_definition" + "preproc_def" + "preproc_function_def") (and c-ts-mode-emacs-sources-support '(;; DEFUN. "expression_statement" @@ -1259,6 +1274,10 @@ BEG and END are described in `treesit-range-rules'." eos) c-ts-mode--defun-for-class-in-imenu-p nil)))) + ;; Outline minor mode + (setq-local treesit-outline-predicate + #'c-ts-mode--outline-predicate) + (setq-local treesit-font-lock-feature-list c-ts-mode--feature-list)) @@ -1270,7 +1289,7 @@ BEG and END are described in `treesit-range-rules'." This mode is independent from the classic cc-mode.el based `c-mode', so configuration variables of that mode, like -`c-basic-offset', doesn't affect this mode. +`c-basic-offset', don't affect this mode. To use tree-sitter C/C++ modes by default, evaluate @@ -1279,7 +1298,7 @@ To use tree-sitter C/C++ modes by default, evaluate (add-to-list \\='major-mode-remap-alist \\='(c-or-c++-mode . c-or-c++-ts-mode)) -in your configuration." +in your init files." :group 'c :after-hook (c-ts-mode-set-modeline) @@ -1314,6 +1333,8 @@ in your configuration." (lambda (_pos) 'c)) (treesit-font-lock-recompute-features '(emacs-devel))))) +(derived-mode-add-parents 'c-ts-mode '(c-mode)) + ;;;###autoload (define-derived-mode c++-ts-mode c-ts-base-mode "C++" "Major mode for editing C++, powered by tree-sitter. @@ -1329,7 +1350,7 @@ To use tree-sitter C/C++ modes by default, evaluate (add-to-list \\='major-mode-remap-alist \\='(c-or-c++-mode . c-or-c++-ts-mode)) -in your configuration. +in your init files. Since this mode uses a parser, unbalanced brackets might cause some breakage in indentation/fontification. Therefore, it's @@ -1357,6 +1378,8 @@ recommended to enable `electric-pair-mode' with this mode." (setq-local add-log-current-defun-function #'c-ts-mode--emacs-current-defun-name)))) +(derived-mode-add-parents 'c++-ts-mode '(c++-mode)) + (easy-menu-define c-ts-mode-menu (list c-ts-mode-map c++-ts-mode-map) "Menu for `c-ts-mode' and `c++-ts-mode'." '("C/C++" @@ -1422,38 +1445,35 @@ matching on file name insufficient for detecting major mode that should be used. This function attempts to use file contents to determine whether -the code is C or C++ and based on that chooses whether to enable +the code is C or C++, and based on that chooses whether to enable `c-ts-mode' or `c++-ts-mode'." + (declare (obsolete c-or-c++-mode "30.1")) (interactive) - (if (save-excursion - (save-restriction - (save-match-data ; Why `save-match-data'? - (widen) - (goto-char (point-min)) - (re-search-forward c-ts-mode--c-or-c++-regexp nil t)))) - (c++-ts-mode) - (c-ts-mode))) + (let ((mode + (if (save-excursion + (save-restriction + (save-match-data ; Why `save-match-data'? + (widen) + (goto-char (point-min)) + (re-search-forward c-ts-mode--c-or-c++-regexp nil t)))) + 'c++-ts-mode + 'c-ts-mode))) + (funcall (major-mode-remap mode)))) + ;; The entries for C++ must come first to prevent *.c files be taken ;; as C++ on case-insensitive filesystems, since *.C files are C++, ;; not C. (if (treesit-ready-p 'cpp) - (add-to-list 'auto-mode-alist - '("\\(\\.ii\\|\\.\\(CC?\\|HH?\\)\\|\\.[ch]\\(pp\\|xx\\|\\+\\+\\)\\|\\.\\(cc\\|hh\\)\\)\\'" - . c++-ts-mode))) + (add-to-list 'major-mode-remap-defaults + '(c++-mode . c++-ts-mode))) (when (treesit-ready-p 'c) - (add-to-list 'auto-mode-alist - '("\\(\\.[chi]\\|\\.lex\\|\\.y\\(acc\\)?\\)\\'" . c-ts-mode)) - (add-to-list 'auto-mode-alist '("\\.x[pb]m\\'" . c-ts-mode)) - ;; image-mode's association must be before the C mode, otherwise XPM - ;; images will be initially visited as C files. Also note that the - ;; regexp must be different from what files.el does, or else - ;; add-to-list will not add the association where we want it. - (add-to-list 'auto-mode-alist '("\\.x[pb]m\\'" . image-mode))) - -(if (and (treesit-ready-p 'cpp) - (treesit-ready-p 'c)) - (add-to-list 'auto-mode-alist '("\\.h\\'" . c-or-c++-ts-mode))) + (add-to-list 'major-mode-remap-defaults '(c++-mode . c++-ts-mode)) + (add-to-list 'major-mode-remap-defaults '(c-mode . c-ts-mode))) + +(when (and (treesit-ready-p 'cpp) + (treesit-ready-p 'c)) + (add-to-list 'major-mode-remap-defaults '(c-or-c++-mode . c-or-c++-ts-mode))) (provide 'c-ts-mode) (provide 'c++-ts-mode) diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index f84d95dbc94..e45ab76ec07 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -2425,7 +2425,7 @@ system." (error "Unknown base mode `%s'" base-mode)) (put mode 'c-fallback-mode base-mode)) -(defvar c-lang-constants (make-vector 151 0)) +(defvar c-lang-constants (obarray-make 151)) ;; Obarray used as a cache to keep track of the language constants. ;; The constants stored are those defined by `c-lang-defconst' and the values ;; computed by `c-lang-const'. It's mostly used at compile time but it's not @@ -2630,7 +2630,7 @@ constant. A file is identified by its base name." ;; Clear the evaluated values that depend on this source. (let ((agenda (get sym 'dependents)) - (visited (make-vector 101 0)) + (visited (obarray-make 101)) ptr) (while agenda (setq sym (car agenda) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 4c591fbba36..8c505e9556a 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -11476,7 +11476,7 @@ This function might do hidden buffer changes." ;; an arglist it would be a meaningless expression because ;; the result isn't used. We therefore choose to recognize ;; it as a declaration when there's "symmetrical WS" around - ;; the "*" or the flag `c-assymetry-fontification-flag' is + ;; the "*" or the flag `c-asymmetry-fontification-flag' is ;; not set. We only allow a suffix (which makes the ;; construct look like a function call) when `at-decl-start' ;; provides additional evidence that we do have a @@ -12346,13 +12346,21 @@ comment at the start of cc-engine.el for more info." (zerop (c-backward-token-2 1 t lim)) t) (or (looking-at c-block-stmt-1-key) - (and (eq (char-after) ?\() - (zerop (c-backward-token-2 1 t lim)) - (if (looking-at c-block-stmt-hangon-key) - (zerop (c-backward-token-2 1 t lim)) - t) - (or (looking-at c-block-stmt-2-key) - (looking-at c-block-stmt-1-2-key)))) + (or + (and + (eq (char-after) ?\() + (zerop (c-backward-token-2 1 t lim)) + (if (looking-at c-block-stmt-hangon-key) + (zerop (c-backward-token-2 1 t lim)) + t) + (or (looking-at c-block-stmt-2-key) + (looking-at c-block-stmt-1-2-key))) + (and (looking-at c-paren-clause-key) + (zerop (c-backward-token-2 1 t lim)) + (if (looking-at c-negation-op-re) + (zerop (c-backward-token-2 1 t lim)) + t) + (looking-at c-block-stmt-with-key)))) (point)))) (defun c-after-special-operator-id (&optional lim) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 89f197b98e6..6419d6cf05a 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1112,7 +1112,7 @@ casts and declarations are fontified. Used on level 2 and higher." ;; 'c-decl-type-start (according to TYPES). Stop at LIMIT. ;; ;; If TYPES is t, fontify all identifiers as types; if it is a number, a - ;; buffer position, additionally set the `c-deftype' text property on the + ;; buffer position, additionally set the `c-typedef' text property on the ;; keyword at that position; if it is nil fontify as either variables or ;; functions, otherwise TYPES is a face to use. If NOT-TOP is non-nil, we ;; are not at the top-level ("top-level" includes being directly inside a diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index ad21bd1d5ef..06b919f26fd 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -817,7 +817,7 @@ there be copies of the opener contained in the multi-line string." (c-lang-defconst c-cpp-or-ml-match-offset ;; The offset to be added onto match numbers for a multi-line string in - ;; matches for `c-cpp-or-ml-string-opener-re'. + ;; matches for `c-ml-string-cpp-or-opener-re'. t (if (c-lang-const c-anchored-cpp-prefix) (+ 2 (regexp-opt-depth (c-lang-const c-anchored-cpp-prefix))) 2)) @@ -1599,6 +1599,12 @@ operators." (c-lang-defvar c-assignment-op-regexp (c-lang-const c-assignment-op-regexp)) +(c-lang-defconst c-negation-op-re + ;; Regexp matching the negation operator. + t "!\\([^=]\\|$\\)") + +(c-lang-defvar c-negation-op-re (c-lang-const c-negation-op-re)) + (c-lang-defconst c-arithmetic-operators "List of all arithmetic operators, including \"+=\", etc." ;; Note: in the following, there are too many operators for AWK and IDL. @@ -3163,6 +3169,30 @@ Keywords here should also be in `c-block-stmt-1-kwds'." (c-lang-const c-block-stmt-2-kwds))))) (c-lang-defvar c-opt-block-stmt-key (c-lang-const c-opt-block-stmt-key)) +(c-lang-defconst c-paren-clause-kwds + "Keywords which can stand in the place of paren sexps in conditionals. +This applies only to conditionals in `c-block-stmt-with-kwds'." + t nil + c++ '("consteval")) + +(c-lang-defconst c-paren-clause-key + ;; Regexp matching a keyword in `c-paren-clause-kwds'. + t (c-make-keywords-re t + (c-lang-const c-paren-clause-kwds))) +(c-lang-defvar c-paren-clause-key (c-lang-const c-paren-clause-key)) + +(c-lang-defconst c-block-stmt-with-kwds + "Statement keywords which can be followed by a keyword instead of a parens. +Such a keyword is a member of `c-paren-clause-kwds." + t nil + c++ '("if")) + +(c-lang-defconst c-block-stmt-with-key + ;; Regexp matching a keyword in `c-block-stmt-with-kwds'. + t (c-make-keywords-re t + (c-lang-const c-block-stmt-with-kwds))) +(c-lang-defvar c-block-stmt-with-key (c-lang-const c-block-stmt-with-key)) + (c-lang-defconst c-simple-stmt-kwds "Statement keywords followed by an expression or nothing." t '("break" "continue" "goto" "return") @@ -3511,7 +3541,7 @@ Note that Java specific rules are currently applied to tell this from (let* ((alist (c-lang-const c-keyword-member-alist)) kwd lang-const-list - (obarray (make-vector (* (length alist) 2) 0))) + (obarray (obarray-make (* (length alist) 2)))) (while alist (setq kwd (caar alist) lang-const-list (cdar alist) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 64a679eacc7..1a9d0907bd0 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -2902,15 +2902,19 @@ This function attempts to use file contents to determine whether the code is C or C++ and based on that chooses whether to enable `c-mode' or `c++-mode'." (interactive) - (if (save-excursion - (save-restriction - (save-match-data - (widen) - (goto-char (point-min)) - (re-search-forward c-or-c++-mode--regexp - (+ (point) c-guess-region-max) t)))) - (c++-mode) - (c-mode))) + (let ((mode + (if (save-excursion + (save-restriction + (save-match-data + (widen) + (goto-char (point-min)) + (re-search-forward c-or-c++-mode--regexp + (+ (point) c-guess-region-max) t)))) + 'c++-mode + 'c-mode))) + (funcall (if (fboundp 'major-mode-remap) + (major-mode-remap mode) + mode)))) ;; Support for C++ diff --git a/lisp/progmodes/cmake-ts-mode.el b/lisp/progmodes/cmake-ts-mode.el index d933e4ebb81..b70806f4c30 100644 --- a/lisp/progmodes/cmake-ts-mode.el +++ b/lisp/progmodes/cmake-ts-mode.el @@ -32,10 +32,8 @@ (declare-function treesit-parser-create "treesit.c") (declare-function treesit-query-capture "treesit.c") -(declare-function treesit-induce-sparse-tree "treesit.c") -(declare-function treesit-node-child "treesit.c") -(declare-function treesit-node-start "treesit.c") (declare-function treesit-node-type "treesit.c") +(declare-function treesit-search-subtree "treesit.c") (defcustom cmake-ts-mode-indent-offset 2 "Number of spaces for each indentation step in `cmake-ts-mode'." @@ -195,37 +193,14 @@ Check if a node type is available, then return the right font lock rules." '((ERROR) @font-lock-warning-face)) "Tree-sitter font-lock settings for `cmake-ts-mode'.") -(defun cmake-ts-mode--imenu () - "Return Imenu alist for the current buffer." - (let* ((node (treesit-buffer-root-node)) - (func-tree (treesit-induce-sparse-tree - node "function_def" nil 1000)) - (func-index (cmake-ts-mode--imenu-1 func-tree))) - (append - (when func-index `(("Function" . ,func-index)))))) - -(defun cmake-ts-mode--imenu-1 (node) - "Helper for `cmake-ts-mode--imenu'. -Find string representation for NODE and set marker, then recurse -the subtrees." - (let* ((ts-node (car node)) - (children (cdr node)) - (subtrees (mapcan #'cmake-ts-mode--imenu-1 - children)) - (name (when ts-node - (pcase (treesit-node-type ts-node) - ("function_def" - (treesit-node-text - (treesit-node-child (treesit-node-child ts-node 0) 2) t))))) - (marker (when ts-node - (set-marker (make-marker) - (treesit-node-start ts-node))))) - (cond - ((or (null ts-node) (null name)) subtrees) - (subtrees - `((,name ,(cons name marker) ,@subtrees))) - (t - `((,name . ,marker)))))) +(defun cmake-ts-mode--defun-name (node) + "Return the defun name of NODE. +Return nil if there is no name or if NODE is not a defun node." + (pcase (treesit-node-type node) + ((or "function_def" "macro_def") + (treesit-node-text + (treesit-search-subtree node "^argument$" nil nil 3) + t)))) ;;;###autoload (define-derived-mode cmake-ts-mode prog-mode "CMake" @@ -241,8 +216,15 @@ the subtrees." (setq-local comment-end "") (setq-local comment-start-skip (rx "#" (* (syntax whitespace)))) + ;; Defuns. + (setq-local treesit-defun-type-regexp (rx (or "function" "macro") + "_def")) + (setq-local treesit-defun-name-function #'cmake-ts-mode--defun-name) + ;; Imenu. - (setq-local imenu-create-index-function #'cmake-ts-mode--imenu) + (setq-local treesit-simple-imenu-settings + `(("Function" "^function_def$") + ("Macro" "^macro_def$"))) (setq-local which-func-functions nil) ;; Indent. @@ -261,6 +243,8 @@ the subtrees." (treesit-major-mode-setup))) +(derived-mode-add-parents 'cmake-ts-mode '(cmake-mode)) + (if (treesit-ready-p 'cmake) (add-to-list 'auto-mode-alist '("\\(?:CMakeLists\\.txt\\|\\.cmake\\)\\'" . cmake-ts-mode))) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 4af6a96900a..11d400e145a 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -362,6 +362,28 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) (ruby-Test::Unit "^ [[ ]?\\([^ (].*\\):\\([1-9][0-9]*\\)\\(\\]\\)?:in " 1 2) + ;; Tested with Lua 5.1, 5.2, 5.3, 5.4, and LuaJIT 2.1. + (lua + ,(rx bol + (+? (not (in "\t\n"))) + ": " + (group (+? (not (in "\t\n")))) + ":" + (group (+ (in "0-9"))) + ": " + (+ nonl) + "\nstack traceback:\n\t") + 1 2 nil 2 1) + (lua-stack + ,(rx bol "\t" + (| "[C]:" + (: (group (+? (not (in "\t\n")))) + ":" + (? (group (+ (in "0-9"))) + ":"))) + " in ") + 1 2 nil 0 1) + (gmake ;; Set GNU make error messages as INFO level. ;; It starts with the name of the make program which is variable, @@ -1868,6 +1890,12 @@ process from additional information inserted by Emacs." (defvar-local compilation--start-time nil "The time when the compilation started as returned by `float-time'.") +(defun compilation--downcase-mode-name (mode) + "Downcase the name of major MODE, even if MODE is not a string. +The function `downcase' will barf if passed the name of a `major-mode' +which is not a string, but instead a symbol or a list." + (downcase (format-mode-line mode))) + ;;;###autoload (defun compilation-start (command &optional mode name-function highlight-regexp continue) @@ -2059,11 +2087,12 @@ Returns the compilation buffer created." (get-buffer-process (with-no-warnings (comint-exec - outbuf (downcase mode-name) + outbuf (compilation--downcase-mode-name mode-name) shell-file-name nil `(,shell-command-switch ,command))))) - (start-file-process-shell-command (downcase mode-name) - outbuf command)))) + (start-file-process-shell-command + (compilation--downcase-mode-name mode-name) + outbuf command)))) ;; Make the buffer's mode line show process state. (setq mode-line-process '((:propertize ":%s" face compilation-mode-line-run) @@ -2768,7 +2797,8 @@ Prefix arg N says how many files to move backwards (or forwards, if negative)." (let ((buffer (compilation-find-buffer))) (if (get-buffer-process buffer) (interrupt-process (get-buffer-process buffer)) - (error "The %s process is not running" (downcase mode-name))))) + (error "The %s process is not running" + (compilation--downcase-mode-name mode-name))))) (defalias 'compile-mouse-goto-error 'compile-goto-error) @@ -3122,7 +3152,16 @@ and overlay is highlighted between MK and END-MK." (cancel-timer next-error-highlight-timer)) (remove-hook 'pre-command-hook #'compilation-goto-locus-delete-o)) - + +(defun compilation--expand-fn (directory filename) + "Expand FILENAME or resolve its true name. +Unlike `expand-file-name', `file-truename' follows symlinks, which +we try to avoid if possible." + (let* ((expandedname (expand-file-name filename directory))) + (if (file-exists-p expandedname) + expandedname + (file-truename (file-name-concat directory filename))))) + (defun compilation-find-file-1 (marker filename directory &optional formats) (or formats (setq formats '("%s"))) (let ((dirs compilation-search-path) @@ -3143,8 +3182,8 @@ and overlay is highlighted between MK and END-MK." fmts formats) ;; For each directory, try each format string. (while (and fmts (null buffer)) - (setq name (file-truename - (file-name-concat thisdir (format (car fmts) filename))) + (setq name (compilation--expand-fn thisdir + (format (car fmts) filename)) buffer (and (file-exists-p name) (find-file-noselect name)) fmts (cdr fmts))) @@ -3166,8 +3205,8 @@ and overlay is highlighted between MK and END-MK." (setq thisdir (car dirs) fmts formats) (while (and fmts (null buffer)) - (setq name (file-truename - (file-name-concat thisdir (format (car fmts) filename))) + (setq name (compilation--expand-fn thisdir + (format (car fmts) filename)) buffer (and (file-exists-p name) (find-file-noselect name)) fmts (cdr fmts))) @@ -3227,8 +3266,7 @@ attempts to find a file whose name is produced by (format FMT FILENAME)." (ding) (sit-for 2)) ((and (file-directory-p name) (not (file-exists-p - (setq name (file-truename - (file-name-concat name filename)))))) + (setq name (compilation--expand-fn name filename))))) (message "No `%s' in directory %s" filename origname) (ding) (sit-for 2)) (t diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 9f7f29b8182..11709bfe00b 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -162,6 +162,9 @@ for constructs with multiline if/unless/while/until/for/foreach condition." (defcustom cperl-file-style nil "Indentation style to use in cperl-mode. +Setting this option will override options as given in +`cperl-style-alist' for the keyword provided here. If nil, then +the individual options as customized are used. \"PBP\" is the style recommended in the Book \"Perl Best Practices\" by Damian Conway. \"CPerl\" is the traditional style of cperl-mode, and \"PerlStyle\" follows the Perl documentation @@ -1130,7 +1133,7 @@ Unless KEEP, removes the old indentation." ["Fix whitespace on indent" cperl-toggle-construct-fix t] ["Auto-help on Perl constructs" cperl-toggle-autohelp t] ["Auto fill" auto-fill-mode t]) - ("Indent styles..." + ("Default indent styles..." ["CPerl" (cperl-set-style "CPerl") t] ["PBP" (cperl-set-style "PBP") t] ["PerlStyle" (cperl-set-style "PerlStyle") t] @@ -1141,6 +1144,15 @@ Unless KEEP, removes the old indentation." ["Whitesmith" (cperl-set-style "Whitesmith") t] ["Memorize Current" (cperl-set-style "Current") t] ["Memorized" (cperl-set-style-back) cperl-old-style]) + ("Indent styles for current buffer..." + ["CPerl" (cperl-set-style "CPerl") t] + ["PBP" (cperl-file-style "PBP") t] + ["PerlStyle" (cperl-file-style "PerlStyle") t] + ["GNU" (cperl-file-style "GNU") t] + ["C++" (cperl-file-style "C++") t] + ["K&R" (cperl-file-style "K&R") t] + ["BSD" (cperl-file-style "BSD") t] + ["Whitesmith" (cperl-file-style "Whitesmith") t]) ("Micro-docs" ["Tips" (describe-variable 'cperl-tips) t] ["Problems" (describe-variable 'cperl-problems) t] @@ -1922,9 +1934,12 @@ or as help on variables `cperl-tips', `cperl-problems', ;; Setup Flymake (add-hook 'flymake-diagnostic-functions #'perl-flymake nil t)) +(derived-mode-add-parents 'cperl-mode '(perl-mode)) + (defun cperl--set-file-style () (when cperl-file-style - (cperl-set-style cperl-file-style))) + (cperl-file-style cperl-file-style))) + ;; Fix for perldb - make default reasonable (defun cperl-db () @@ -4001,7 +4016,10 @@ recursive calls in starting lines of here-documents." ;; 1+6+2+1+1+6+1+1+1=20 extra () before this: "\\|" ;; -------- backslash-escaped stuff, don't interpret it - "\\\\\\(['`\"($]\\)") ; BACKWACKED something-hairy + "\\\\\\(['`\"($]\\)" ; BACKWACKED something-hairy + "\\|" + ;; -------- $\ is a variable in code, but not in a string + "\\(\\$\\\\\\)") ""))) warning-message) (unwind-protect @@ -4055,7 +4073,12 @@ recursive calls in starting lines of here-documents." (cperl-modify-syntax-type bb cperl-st-punct))) ;; No processing in strings/comments beyond this point: ((or (nth 3 state) (nth 4 state)) - t) ; Do nothing in comment/string + ;; Edge case: In a double-quoted string, $\ is not the + ;; punctuation variable, $ must not quote \ here. We + ;; generally make $ a punctuation character in strings + ;; and comments (Bug#69604). + (when (match-beginning 22) + (cperl-modify-syntax-type (match-beginning 22) cperl-st-punct))) ((match-beginning 1) ; POD section ;; "\\(\\`\n?\\|^\n\\)=" (setq b (match-beginning 0) @@ -6496,6 +6519,10 @@ See examples in `cperl-style-examples'.") (defun cperl-set-style (style) "Set CPerl mode variables to use one of several different indentation styles. +This command sets the default values for the variables. It does +not affect buffers visiting files where the style has been set as +a file or directory variable. To change the indentation style of +a buffer, use the command `cperl-file-style' instead. The arguments are a string representing the desired style. The list of styles is in `cperl-style-alist', available styles are \"CPerl\", \"PBP\", \"PerlStyle\", \"GNU\", \"K&R\", \"BSD\", \"C++\" @@ -6516,7 +6543,8 @@ side-effect of memorizing only. Examples in `cperl-style-examples'." (let ((style (cdr (assoc style cperl-style-alist))) setting) (while style (setq setting (car style) style (cdr style)) - (set (car setting) (cdr setting))))) + (set-default-toplevel-value (car setting) (cdr setting)))) + (set-default-toplevel-value 'cperl-file-style style)) (defun cperl-set-style-back () "Restore a style memorized by `cperl-set-style'." @@ -6526,7 +6554,20 @@ side-effect of memorizing only. Examples in `cperl-style-examples'." (while cperl-old-style (setq setting (car cperl-old-style) cperl-old-style (cdr cperl-old-style)) - (set (car setting) (cdr setting))))) + (set-default-toplevel-value (car setting) (cdr setting))))) + +(defun cperl-file-style (style) + "Set the indentation style for the current buffer to STYLE. +The list of styles is in `cperl-style-alist', available styles +are \"CPerl\", \"PBP\", \"PerlStyle\", \"GNU\", \"K&R\", \"BSD\", \"C++\" +and \"Whitesmith\"." + (interactive + (list (completing-read "Enter style: " cperl-style-alist nil 'insist))) + (dolist (setting (cdr (assoc style cperl-style-alist)) style) + (let ((option (car setting)) + (value (cdr setting))) + (set (make-local-variable option) value))) + (setq-local cperl-file-style style)) (declare-function Info-find-node "info" (filename nodename &optional no-going-back strict-case @@ -6581,14 +6622,13 @@ side-effect of memorizing only. Examples in `cperl-style-examples'." read)))) (let ((cmd-desc (concat "^" (regexp-quote command) "[^a-zA-Z_0-9]")) ; "tr///" - pos isvar height iniheight frheight buf win fr1 fr2 iniwin not-loner + pos isvar height iniheight frheight buf win iniwin not-loner max-height char-height buf-list) (if (string-match "^-[a-zA-Z]$" command) (setq cmd-desc "^-X[ \t\n]")) (setq isvar (string-match "^[$@%]" command) buf (cperl-info-buffer isvar) - iniwin (selected-window) - fr1 (window-frame iniwin)) + iniwin (selected-window)) (set-buffer buf) (goto-char (point-min)) (or isvar @@ -6609,11 +6649,7 @@ side-effect of memorizing only. Examples in `cperl-style-examples'." (or (not win) (eq (window-buffer win) buf) (set-window-buffer win buf)) - (and win (setq fr2 (window-frame win))) - (if (or (not fr2) (eq fr1 fr2)) - (pop-to-buffer buf) - (special-display-popup-frame buf) ; Make it visible - (select-window win)) + (pop-to-buffer buf) (goto-char pos) ; Needed (?!). ;; Resize (setq iniheight (window-height) diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index 7bf57bcbe21..9782eb443f2 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -495,9 +495,12 @@ compilation and evaluation time conflicts." (unless (eq (char-after) ?{) (ignore-errors (backward-up-list 1 t t))) (save-excursion - ;; 'new' should be part of the line + ;; 'new' should be part of the line, but should not trigger if + ;; statement has already ended, like for 'var x = new X();'. + ;; Also, deal with the possible end of line obscured by a + ;; trailing comment. (goto-char (c-point 'iopl)) - (looking-at ".*new.*"))) + (looking-at "^[^//]*new[^//]*;$"))) ;; Line should not already be terminated (save-excursion (goto-char (c-point 'eopl)) @@ -998,6 +1001,8 @@ Key bindings: (add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-ts-mode))) +(derived-mode-add-parents 'csharp-ts-mode '(csharp-mode)) + (provide 'csharp-mode) ;;; csharp-mode.el ends here diff --git a/lisp/progmodes/dockerfile-ts-mode.el b/lisp/progmodes/dockerfile-ts-mode.el index 334f3064d98..e31fd86bbdf 100644 --- a/lisp/progmodes/dockerfile-ts-mode.el +++ b/lisp/progmodes/dockerfile-ts-mode.el @@ -31,10 +31,8 @@ (eval-when-compile (require 'rx)) (declare-function treesit-parser-create "treesit.c") -(declare-function treesit-induce-sparse-tree "treesit.c") (declare-function treesit-node-child "treesit.c") (declare-function treesit-node-child-by-field-name "treesit.c") -(declare-function treesit-node-start "treesit.c") (declare-function treesit-node-type "treesit.c") (defvar dockerfile-ts-mode--syntax-table @@ -118,38 +116,15 @@ continuation to the previous entry." '((ERROR) @font-lock-warning-face)) "Tree-sitter font-lock settings.") -(defun dockerfile-ts-mode--imenu () - "Return Imenu alist for the current buffer." - (let* ((node (treesit-buffer-root-node)) - (stage-tree (treesit-induce-sparse-tree - node "from_instruction" - nil 1000)) - (stage-index (dockerfile-ts-mode--imenu-1 stage-tree))) - (when stage-index `(("Stage" . ,stage-index))))) - -(defun dockerfile-ts-mode--imenu-1 (node) - "Helper for `dockerfile-ts-mode--imenu'. -Find string representation for NODE and set marker, then recurse -the subtrees." - (let* ((ts-node (car node)) - (children (cdr node)) - (subtrees (mapcan #'dockerfile-ts-mode--imenu-1 - children)) - (name (when ts-node - (pcase (treesit-node-type ts-node) - ("from_instruction" - (treesit-node-text - (or (treesit-node-child-by-field-name ts-node "as") - (treesit-node-child ts-node 1)) t))))) - (marker (when ts-node - (set-marker (make-marker) - (treesit-node-start ts-node))))) - (cond - ((or (null ts-node) (null name)) subtrees) - (subtrees - `((,name ,(cons name marker) ,@subtrees))) - (t - `((,name . ,marker)))))) +(defun dockerfile-ts-mode--stage-name (node) + "Return the stage name of NODE. +Return nil if there is no name or if NODE is not a stage node." + (pcase (treesit-node-type node) + ("from_instruction" + (treesit-node-text + (or (treesit-node-child-by-field-name node "as") + (treesit-node-child node 1)) + t)))) ;;;###autoload (define-derived-mode dockerfile-ts-mode prog-mode "Dockerfile" @@ -166,8 +141,8 @@ the subtrees." (setq-local comment-start-skip (rx "#" (* (syntax whitespace)))) ;; Imenu. - (setq-local imenu-create-index-function - #'dockerfile-ts-mode--imenu) + (setq-local treesit-simple-imenu-settings + `(("Stage" "\\`from_instruction\\'" nil dockerfile-ts-mode--stage-name))) (setq-local which-func-functions nil) ;; Indent. @@ -190,6 +165,8 @@ the subtrees." (treesit-major-mode-setup))) +(derived-mode-add-parents 'dockerfile-ts-mode '(dockerfile-mode)) + (if (treesit-ready-p 'dockerfile) (add-to-list 'auto-mode-alist ;; NOTE: We can't use `rx' here, as it breaks bootstrap. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index d330e6e23cb..7d2f1a55165 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2,12 +2,12 @@ ;; Copyright (C) 2018-2024 Free Software Foundation, Inc. -;; Version: 1.16 +;; Version: 1.17 ;; Author: João Távora <joaotavora@gmail.com> ;; Maintainer: João Távora <joaotavora@gmail.com> ;; URL: https://github.com/joaotavora/eglot ;; Keywords: convenience, languages -;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.23") (flymake "1.2.1") (project "0.9.8") (xref "1.6.2") (eldoc "1.14.0") (seq "2.23") (external-completion "0.1")) +;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.24") (flymake "1.2.1") (project "0.9.8") (xref "1.6.2") (eldoc "1.14.0") (seq "2.23") (external-completion "0.1")) ;; This is a GNU ELPA :core package. Avoid adding functionality ;; that is not available in the version of Emacs recorded above or any @@ -226,90 +226,108 @@ automatically)." when probe return (cons probe args) finally (funcall err))))))) -(defvar eglot-server-programs `(((rust-ts-mode rust-mode) . ("rust-analyzer")) - ((cmake-mode cmake-ts-mode) . ("cmake-language-server")) - (vimrc-mode . ("vim-language-server" "--stdio")) - ((python-mode python-ts-mode) - . ,(eglot-alternatives - '("pylsp" "pyls" ("pyright-langserver" "--stdio") "jedi-language-server" "ruff-lsp"))) - ((js-json-mode json-mode json-ts-mode) - . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") - ("vscode-json-languageserver" "--stdio") - ("json-languageserver" "--stdio")))) - (((js-mode :language-id "javascript") - (js-ts-mode :language-id "javascript") - (tsx-ts-mode :language-id "typescriptreact") - (typescript-ts-mode :language-id "typescript") - (typescript-mode :language-id "typescript")) - . ("typescript-language-server" "--stdio")) - ((bash-ts-mode sh-mode) . ("bash-language-server" "start")) - ((php-mode phps-mode) - . ,(eglot-alternatives - '(("phpactor" "language-server") - ("php" "vendor/felixfbecker/language-server/bin/php-language-server.php")))) - ((c-mode c-ts-mode c++-mode c++-ts-mode objc-mode) - . ,(eglot-alternatives - '("clangd" "ccls"))) - (((caml-mode :language-id "ocaml") - (tuareg-mode :language-id "ocaml") reason-mode) - . ("ocamllsp")) - ((ruby-mode ruby-ts-mode) - . ("solargraph" "socket" "--port" :autoport)) - (haskell-mode - . ("haskell-language-server-wrapper" "--lsp")) - (elm-mode . ("elm-language-server")) - (mint-mode . ("mint" "ls")) - (kotlin-mode . ("kotlin-language-server")) - ((go-mode go-dot-mod-mode go-dot-work-mode go-ts-mode go-mod-ts-mode) - . ("gopls")) - ((R-mode ess-r-mode) . ("R" "--slave" "-e" - "languageserver::run()")) - ((java-mode java-ts-mode) . ("jdtls")) - ((dart-mode dart-ts-mode) - . ("dart" "language-server" - "--client-id" "emacs.eglot-dart")) - ((elixir-mode elixir-ts-mode heex-ts-mode) - . ,(if (and (fboundp 'w32-shell-dos-semantics) - (w32-shell-dos-semantics)) - '("language_server.bat") - (eglot-alternatives - '("language_server.sh" "start_lexical.sh")))) - (ada-mode . ("ada_language_server")) - (scala-mode . ,(eglot-alternatives - '("metals" "metals-emacs"))) - (racket-mode . ("racket" "-l" "racket-langserver")) - ((tex-mode context-mode texinfo-mode bibtex-mode) - . ,(eglot-alternatives '("digestif" "texlab"))) - (erlang-mode . ("erlang_ls" "--transport" "stdio")) - ((yaml-ts-mode yaml-mode) . ("yaml-language-server" "--stdio")) - (nix-mode . ,(eglot-alternatives '("nil" "rnix-lsp" "nixd"))) - (nickel-mode . ("nls")) - (gdscript-mode . ("localhost" 6008)) - ((fortran-mode f90-mode) . ("fortls")) - (futhark-mode . ("futhark" "lsp")) - ((lua-mode lua-ts-mode) . ,(eglot-alternatives - '("lua-language-server" "lua-lsp"))) - (zig-mode . ("zls")) - ((css-mode css-ts-mode) - . ,(eglot-alternatives '(("vscode-css-language-server" "--stdio") - ("css-languageserver" "--stdio")))) - (html-mode . ,(eglot-alternatives '(("vscode-html-language-server" "--stdio") ("html-languageserver" "--stdio")))) - ((dockerfile-mode dockerfile-ts-mode) . ("docker-langserver" "--stdio")) - ((clojure-mode clojurescript-mode clojurec-mode clojure-ts-mode) - . ("clojure-lsp")) - ((csharp-mode csharp-ts-mode) - . ,(eglot-alternatives - '(("omnisharp" "-lsp") - ("csharp-ls")))) - (purescript-mode . ("purescript-language-server" "--stdio")) - ((perl-mode cperl-mode) . ("perl" "-MPerl::LanguageServer" "-e" "Perl::LanguageServer::run")) - (markdown-mode - . ,(eglot-alternatives - '(("marksman" "server") - ("vscode-markdown-language-server" "--stdio")))) - (graphviz-dot-mode . ("dot-language-server" "--stdio")) - (terraform-mode . ("terraform-ls" "serve")) - ((uiua-ts-mode uiua-mode) . ("uiua" "lsp"))) +(defvar eglot-server-programs + ;; FIXME: Maybe this info should be distributed into the major modes + ;; themselves where they could set a buffer-local `eglot-server-program' + ;; instead of keeping this database centralized. + ;; FIXME: With `derived-mode-add-parents' in Emacs≥30, some of + ;; those entries can be simplified, but we keep them for when + ;; `eglot.el' is installed via GNU ELPA in an older Emacs. + `(((rust-ts-mode rust-mode) . ("rust-analyzer")) + ((cmake-mode cmake-ts-mode) . ("cmake-language-server")) + (vimrc-mode . ("vim-language-server" "--stdio")) + ((python-mode python-ts-mode) + . ,(eglot-alternatives + '("pylsp" "pyls" ("basedpyright-langserver" "--stdio") + ("pyright-langserver" "--stdio") + "jedi-language-server" "ruff-lsp"))) + ((js-json-mode json-mode json-ts-mode) + . ,(eglot-alternatives '(("vscode-json-language-server" "--stdio") + ("vscode-json-languageserver" "--stdio") + ("json-languageserver" "--stdio")))) + (((js-mode :language-id "javascript") + (js-ts-mode :language-id "javascript") + (tsx-ts-mode :language-id "typescriptreact") + (typescript-ts-mode :language-id "typescript") + (typescript-mode :language-id "typescript")) + . ("typescript-language-server" "--stdio")) + ((bash-ts-mode sh-mode) . ("bash-language-server" "start")) + ((php-mode phps-mode php-ts-mode) + . ,(eglot-alternatives + '(("phpactor" "language-server") + ("php" "vendor/felixfbecker/language-server/bin/php-language-server.php")))) + ((c-mode c-ts-mode c++-mode c++-ts-mode objc-mode) + . ,(eglot-alternatives + '("clangd" "ccls"))) + (((caml-mode :language-id "ocaml") + (tuareg-mode :language-id "ocaml") reason-mode) + . ("ocamllsp")) + ((ruby-mode ruby-ts-mode) + . ("solargraph" "socket" "--port" :autoport)) + (haskell-mode + . ("haskell-language-server-wrapper" "--lsp")) + (elm-mode . ("elm-language-server")) + (mint-mode . ("mint" "ls")) + ((kotlin-mode kotlin-ts-mode) . ("kotlin-language-server")) + ((go-mode go-dot-mod-mode go-dot-work-mode go-ts-mode go-mod-ts-mode) + . ("gopls")) + ((R-mode ess-r-mode) . ("R" "--slave" "-e" + "languageserver::run()")) + ((java-mode java-ts-mode) . ("jdtls")) + ((dart-mode dart-ts-mode) + . ("dart" "language-server" + "--client-id" "emacs.eglot-dart")) + ((elixir-mode elixir-ts-mode heex-ts-mode) + . ,(if (and (fboundp 'w32-shell-dos-semantics) + (w32-shell-dos-semantics)) + '("language_server.bat") + (eglot-alternatives + '("language_server.sh" "start_lexical.sh")))) + (ada-mode . ("ada_language_server")) + (scala-mode . ,(eglot-alternatives + '("metals" "metals-emacs"))) + (racket-mode . ("racket" "-l" "racket-langserver")) + ((tex-mode context-mode texinfo-mode bibtex-mode) + . ,(eglot-alternatives '("digestif" "texlab"))) + (erlang-mode . ("erlang_ls" "--transport" "stdio")) + ((yaml-ts-mode yaml-mode) . ("yaml-language-server" "--stdio")) + (nix-mode . ,(eglot-alternatives '("nil" "rnix-lsp" "nixd"))) + (nickel-mode . ("nls")) + ((nushell-mode nushell-ts-mode) . ("nu" "--lsp")) + (gdscript-mode . ("localhost" 6008)) + (fennel-mode . ("fennel-ls")) + (move-mode . ("move-analyzer")) + ((fortran-mode f90-mode) . ("fortls")) + (futhark-mode . ("futhark" "lsp")) + ((lua-mode lua-ts-mode) . ,(eglot-alternatives + '("lua-language-server" "lua-lsp"))) + (zig-mode . ("zls")) + ((css-mode css-ts-mode) + . ,(eglot-alternatives '(("vscode-css-language-server" "--stdio") + ("css-languageserver" "--stdio")))) + (html-mode . ,(eglot-alternatives + '(("vscode-html-language-server" "--stdio") + ("html-languageserver" "--stdio")))) + ((dockerfile-mode dockerfile-ts-mode) . ("docker-langserver" "--stdio")) + ((clojure-mode clojurescript-mode clojurec-mode clojure-ts-mode) + . ("clojure-lsp")) + ((csharp-mode csharp-ts-mode) + . ,(eglot-alternatives + '(("omnisharp" "-lsp") + ("csharp-ls")))) + (purescript-mode . ("purescript-language-server" "--stdio")) + ((perl-mode cperl-mode) + . ("perl" "-MPerl::LanguageServer" "-e" "Perl::LanguageServer::run")) + (markdown-mode + . ,(eglot-alternatives + '(("marksman" "server") + ("vscode-markdown-language-server" "--stdio")))) + (graphviz-dot-mode . ("dot-language-server" "--stdio")) + (terraform-mode . ("terraform-ls" "serve")) + ((uiua-ts-mode uiua-mode) . ("uiua" "lsp")) + (sml-mode + . ,(lambda (_interactive project) + (list "millet-ls" (project-root project))))) "How the command `eglot' guesses the server to start. An association list of (MAJOR-MODE . CONTACT) pairs. MAJOR-MODE identifies the buffers that are to be managed by a specific @@ -575,7 +593,7 @@ It is nil if Eglot is not byte-complied.") (defvaralias 'eglot-{} 'eglot--{}) -(defconst eglot--{} (make-hash-table :size 1) "The empty JSON object.") +(defconst eglot--{} (make-hash-table :size 0) "The empty JSON object.") (defun eglot--executable-find (command &optional remote) "Like Emacs 27's `executable-find', ignore REMOTE on Emacs 26." @@ -590,7 +608,7 @@ It is nil if Eglot is not byte-complied.") (let ((vec (copy-sequence url-path-allowed-chars))) (aset vec ?: nil) ;; see github#639 vec) - "Like `url-path-allows-chars' but more restrictive.") + "Like `url-path-allowed-chars' but more restrictive.") ;;; Message verification helpers @@ -1797,6 +1815,12 @@ If optional MARKER, return a marker instead" ;;; More helpers +(defconst eglot--uri-path-allowed-chars + (let ((vec (copy-sequence url-path-allowed-chars))) + (aset vec ?: nil) ;; see github#639 + vec) + "Like `url-path-allowed-chars' but more restrictive.") + (defun eglot--snippet-expansion-fn () "Compute a function to expand snippets. Doubles as an indicator of snippet support." @@ -3054,9 +3078,14 @@ for which LSP on-type-formatting should be requested." finally (cl-return comp))) (defun eglot--dumb-allc (pat table pred _point) (funcall table pat pred t)) +(defun eglot--dumb-tryc (pat table pred point) + (let ((probe (funcall table pat pred nil))) + (cond ((eq probe t) t) + (probe (cons probe (length probe))) + (t (cons pat point))))) (add-to-list 'completion-category-defaults '(eglot-capf (styles eglot--dumb-flex))) -(add-to-list 'completion-styles-alist '(eglot--dumb-flex ignore eglot--dumb-allc)) +(add-to-list 'completion-styles-alist '(eglot--dumb-flex eglot--dumb-tryc eglot--dumb-allc)) (defun eglot-completion-at-point () "Eglot's `completion-at-point' function." @@ -3115,7 +3144,8 @@ for which LSP on-type-formatting should be requested." items))) ;; (trace-values "Requested" (length proxies) cachep bounds) (setq eglot--capf-session - (if cachep (list bounds retval resolved orig-pos) :none)) + (if cachep (list bounds retval resolved orig-pos + bounds-string) :none)) (setq local-cache retval))))) (resolve-maybe ;; Maybe completion/resolve JSON object `lsp-comp' into @@ -3135,7 +3165,8 @@ for which LSP on-type-formatting should be requested." (>= (cdr bounds) (cdr (nth 0 eglot--capf-session)))) (setq local-cache (nth 1 eglot--capf-session) resolved (nth 2 eglot--capf-session) - orig-pos (nth 3 eglot--capf-session)) + orig-pos (nth 3 eglot--capf-session) + bounds-string (nth 4 eglot--capf-session)) ;; (trace-values "Recalling cache" (length local-cache) bounds orig-pos) ) (list @@ -3605,16 +3636,17 @@ edit proposed by the server." (defun eglot--code-action-bounds () "Calculate appropriate bounds depending on region and point." - (let (diags) + (let (diags boftap) (cond ((use-region-p) `(,(region-beginning) ,(region-end))) ((setq diags (flymake-diagnostics (point))) (cl-loop for d in diags minimizing (flymake-diagnostic-beg d) into beg maximizing (flymake-diagnostic-end d) into end finally (cl-return (list beg end)))) + ((setq boftap (bounds-of-thing-at-point 'sexp)) + (list (car boftap) (cdr boftap))) (t - (let ((boftap (bounds-of-thing-at-point 'sexp))) - (list (car boftap) (cdr boftap))))))) + (list (point) (point)))))) (defun eglot-code-actions (beg &optional end action-kind interactive) "Find LSP code actions of type ACTION-KIND between BEG and END. diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 00910fb67c7..8a713bd19a2 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -221,7 +221,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map." (load (byte-compile-dest-file buffer-file-name))) (declare-function native-compile "comp") -(declare-function comp-write-bytecode-file "comp") +(declare-function comp--write-bytecode-file "comp") (defun emacs-lisp-native-compile () "Native-compile the current buffer's file (if it has changed). @@ -233,7 +233,7 @@ visited by the current buffer." (byte-to-native-output-buffer-file nil) (eln (native-compile buffer-file-name))) (when eln - (comp-write-bytecode-file eln)))) + (comp--write-bytecode-file eln)))) (defun emacs-lisp-native-compile-and-load () "Native-compile the current buffer's file (if it has changed), then load it. @@ -309,7 +309,7 @@ Comments in the form will be lost." INTERACTIVE non-nil means ask the user for confirmation; this happens in interactive invocations." (interactive "p") - (if lexical-binding + (if (and (local-variable-p 'lexical-binding) lexical-binding) (when interactive (message "lexical-binding already enabled!") (ding)) @@ -371,6 +371,12 @@ be used instead. ;; Font-locking support. +(defun elisp--font-lock-shorthand (_limit) + ;; Add faces on shorthands between point and LIMIT. + ;; ... + ;; Return nil to tell font-lock, that there's nothing left to do. + nil) + (defun elisp--font-lock-flush-elisp-buffers (&optional file) ;; We're only ever called from after-load-functions, load-in-progress can ;; still be t in case of nested loads. @@ -657,12 +663,13 @@ functions are annotated with \"<f>\" via the (save-excursion (backward-sexp 1) (skip-chars-forward "`',‘#") - (point)) + (min (point) pos)) (scan-error pos))) (end - (unless (or (eq beg (point-max)) - (member (char-syntax (char-after beg)) - '(?\" ?\())) + (cond + ((and (< beg (point-max)) + (memq (char-syntax (char-after beg)) + '(?w ?\\ ?_))) (condition-case nil (save-excursion (goto-char beg) @@ -670,7 +677,11 @@ functions are annotated with \"<f>\" via the (skip-chars-backward "'’") (when (>= (point) pos) (point))) - (scan-error pos)))) + (scan-error pos))) + ((or (>= beg (point-max)) + (memq (char-syntax (char-after beg)) + '(?\) ?\s))) + beg))) ;; t if in function position. (funpos (eq (char-before beg) ?\()) (quoted (elisp--form-quoted-p beg)) @@ -1577,9 +1588,6 @@ character)." (buffer-substring-no-properties beg end)) )))) - -(defvar elisp--eval-last-sexp-fake-value (make-symbol "t")) - (defun eval-sexp-add-defvars (exp &optional pos) "Prepend EXP with all the `defvar's that precede it in the buffer. POS specifies the starting position where EXP was found and defaults to point." @@ -1621,16 +1629,10 @@ integer value is also printed as a character of that codepoint. If `eval-expression-debug-on-error' is non-nil, which is the default, this command arranges for all errors to enter the debugger." (interactive "P") - (if (null eval-expression-debug-on-error) - (values--store-value - (elisp--eval-last-sexp eval-last-sexp-arg-internal)) - (let ((value - (let ((debug-on-error elisp--eval-last-sexp-fake-value)) - (cons (elisp--eval-last-sexp eval-last-sexp-arg-internal) - debug-on-error)))) - (unless (eq (cdr value) elisp--eval-last-sexp-fake-value) - (setq debug-on-error (cdr value))) - (car value)))) + (values--store-value + (handler-bind ((error (if eval-expression-debug-on-error + #'eval-expression--debug #'ignore))) + (elisp--eval-last-sexp eval-last-sexp-arg-internal)))) (defun elisp--eval-defun-1 (form) "Treat some expressions in FORM specially. @@ -1689,8 +1691,7 @@ Return the result of evaluation." ;; FIXME: the print-length/level bindings should only be applied while ;; printing, not while evaluating. (defvar elisp--eval-defun-result) - (let ((debug-on-error eval-expression-debug-on-error) - (edebugging edebug-all-defs) + (let ((edebugging edebug-all-defs) elisp--eval-defun-result) (save-excursion ;; Arrange for eval-region to "read" the (possibly) altered form. @@ -1769,15 +1770,9 @@ which see." (defvar edebug-all-defs) (eval-defun (not edebug-all-defs))) (t - (if (null eval-expression-debug-on-error) - (elisp--eval-defun) - (let (new-value value) - (let ((debug-on-error elisp--eval-last-sexp-fake-value)) - (setq value (elisp--eval-defun)) - (setq new-value debug-on-error)) - (unless (eq elisp--eval-last-sexp-fake-value new-value) - (setq debug-on-error new-value)) - value))))) + (handler-bind ((error (if eval-expression-debug-on-error + #'eval-expression--debug #'ignore))) + (elisp--eval-defun))))) ;;; ElDoc Support diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el index b493195eedd..9804152d9ab 100644 --- a/lisp/progmodes/elixir-ts-mode.el +++ b/lisp/progmodes/elixir-ts-mode.el @@ -360,13 +360,19 @@ (defvar elixir-ts--font-lock-settings (treesit-font-lock-rules :language 'elixir - :feature 'elixir-function-name + :feature 'elixir-definition `((call target: (identifier) @target-identifier + (arguments + (call target: (identifier) @font-lock-function-name-face + (arguments))) + (:match ,elixir-ts--definition-keywords-re @target-identifier)) + (call target: (identifier) @target-identifier (arguments (identifier) @font-lock-function-name-face) (:match ,elixir-ts--definition-keywords-re @target-identifier)) (call target: (identifier) @target-identifier (arguments - (call target: (identifier) @font-lock-function-name-face)) + (call target: (identifier) @font-lock-function-name-face + (arguments ((identifier)) @font-lock-variable-name-face))) (:match ,elixir-ts--definition-keywords-re @target-identifier)) (call target: (identifier) @target-identifier (arguments @@ -379,13 +385,15 @@ (:match ,elixir-ts--definition-keywords-re @target-identifier)) (call target: (identifier) @target-identifier (arguments - (call target: (identifier) @font-lock-function-name-face)) + (call target: (identifier) @font-lock-function-name-face + (arguments ((identifier)) @font-lock-variable-name-face))) (do_block) (:match ,elixir-ts--definition-keywords-re @target-identifier)) (call target: (identifier) @target-identifier (arguments (binary_operator - left: (call target: (identifier) @font-lock-function-name-face))) + left: (call target: (identifier) @font-lock-function-name-face + (arguments ((identifier)) @font-lock-variable-name-face)))) (do_block) (:match ,elixir-ts--definition-keywords-re @target-identifier)) (unary_operator @@ -521,8 +529,8 @@ operator: "/" right: (integer))) (call target: (dot right: (identifier) @font-lock-function-call-face)) - (unary_operator operator: "&" @font-lock-variable-name-face - operand: (integer) @font-lock-variable-name-face) + (unary_operator operator: "&" @font-lock-variable-use-face + operand: (integer) @font-lock-variable-use-face) (unary_operator operator: "&" @font-lock-operator-face operand: (list))) @@ -537,16 +545,18 @@ :language 'elixir :feature 'elixir-variable - '((binary_operator left: (identifier) @font-lock-variable-name-face) - (binary_operator right: (identifier) @font-lock-variable-name-face) - (arguments ( (identifier) @font-lock-variable-name-face)) - (tuple (identifier) @font-lock-variable-name-face) - (list (identifier) @font-lock-variable-name-face) - (pair value: (identifier) @font-lock-variable-name-face) - (body (identifier) @font-lock-variable-name-face) - (unary_operator operand: (identifier) @font-lock-variable-name-face) - (interpolation (identifier) @font-lock-variable-name-face) - (do_block (identifier) @font-lock-variable-name-face)) + '((binary_operator left: (identifier) @font-lock-variable-use-face) + (binary_operator right: (identifier) @font-lock-variable-use-face) + (arguments ( (identifier) @font-lock-variable-use-face)) + (tuple (identifier) @font-lock-variable-use-face) + (list (identifier) @font-lock-variable-use-face) + (pair value: (identifier) @font-lock-variable-use-face) + (body (identifier) @font-lock-variable-use-face) + (unary_operator operand: (identifier) @font-lock-variable-use-face) + (interpolation (identifier) @font-lock-variable-use-face) + (do_block (identifier) @font-lock-variable-use-face) + (access_call target: (identifier) @font-lock-variable-use-face) + (access_call "[" key: (identifier) @font-lock-variable-use-face "]")) :language 'elixir :feature 'elixir-builtin @@ -697,11 +707,10 @@ Return nil if NODE is not a defun node or doesn't have a name." ;; Font-lock. (setq-local treesit-font-lock-settings elixir-ts--font-lock-settings) (setq-local treesit-font-lock-feature-list - '(( elixir-comment elixir-doc elixir-function-name) + '(( elixir-comment elixir-doc elixir-definition) ( elixir-string elixir-keyword elixir-data-type) - ( elixir-sigil elixir-variable elixir-builtin - elixir-string-escape) - ( elixir-function-call elixir-operator elixir-number ))) + ( elixir-sigil elixir-builtin elixir-string-escape) + ( elixir-function-call elixir-variable elixir-operator elixir-number ))) ;; Imenu. @@ -734,17 +743,18 @@ Return nil if NODE is not a defun node or doesn't have a name." heex-ts--indent-rules)) (setq-local treesit-font-lock-feature-list - '(( elixir-comment elixir-doc elixir-function-name + '(( elixir-comment elixir-doc elixir-definition heex-comment heex-keyword heex-doctype ) ( elixir-string elixir-keyword elixir-data-type heex-component heex-tag heex-attribute heex-string ) - ( elixir-sigil elixir-variable elixir-builtin - elixir-string-escape) - ( elixir-function-call elixir-operator elixir-number )))) + ( elixir-sigil elixir-builtin elixir-string-escape) + ( elixir-function-call elixir-variable elixir-operator elixir-number )))) (treesit-major-mode-setup) (setq-local syntax-propertize-function #'elixir-ts--syntax-propertize))) +(derived-mode-add-parents 'elixir-ts-mode '(elixir-mode)) + (if (treesit-ready-p 'elixir) (progn (add-to-list 'auto-mode-alist '("\\.elixir\\'" . elixir-ts-mode)) diff --git a/lisp/progmodes/etags-regen.el b/lisp/progmodes/etags-regen.el new file mode 100644 index 00000000000..6cd78d3577a --- /dev/null +++ b/lisp/progmodes/etags-regen.el @@ -0,0 +1,431 @@ +;;; etags-regen.el --- Auto-(re)regenerating tags -*- lexical-binding: t -*- + +;; Copyright (C) 2021-2023 Free Software Foundation, Inc. + +;; Author: Dmitry Gutov <dmitry@gutov.dev> +;; Keywords: 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: + +;; Simple automatic tags generation with updates on save. +;; +;; This mode provides automatic indexing for Emacs "go to definition" +;; feature, the `xref-go-forward' command (bound to `M-.' by default). +;; +;; At the moment reindexing works off before/after-save-hook, but to +;; handle more complex changes (for example, the user switching to +;; another branch from the terminal) we can look into plugging into +;; something like `filenotify'. +;; +;; Note that this feature disables itself if the user has some tags +;; table already visited (with `M-x visit-tags-table', or through an +;; explicit prompt triggered by some feature that requires tags). + +;;; Code: + +(require 'cl-lib) + +(defgroup etags-regen nil + "Auto-(re)generating tags." + :group 'tools) + +(defvar etags-regen--tags-file nil) +(defvar etags-regen--tags-root nil) +(defvar etags-regen--new-file nil) + +(declare-function project-root "project") +(declare-function project-files "project") +(declare-function dired-glob-regexp "dired") + +(defcustom etags-regen-program (executable-find "etags") + "Name of the etags program used by `etags-regen-mode'. + +If you only have `ctags' installed, you can also set this to +\"ctags -e\". Some features might not be supported this way." + ;; Always having our 'etags' here would be easier, but we can't + ;; always rely on it being installed. So it might be ctags's etags. + :type 'file + :version "30.1") + +(defcustom etags-regen-tags-file "TAGS" + "Name of the tags file to create inside the project by `etags-regen-mode'. + +The value should either be a simple file name (no directory +specified), or a function that accepts the project root directory +and returns a distinct absolute file name for its tags file. The +latter possibility is useful when you prefer to store the tag +files somewhere else, for example in `temporary-file-directory'." + :type '(choice (string :tag "File name") + (function :tag "Function that returns file name")) + :version "30.1") + +(defcustom etags-regen-program-options nil + "List of additional options for etags program invoked by `etags-regen-mode'." + :type '(repeat string) + :version "30.1") + +(defcustom etags-regen-regexp-alist nil + "Mapping of languages to etags regexps for `etags-regen-mode'. + +These regexps are used in addition to the tags made with the +standard parsing based on the language. + +The value must be a list where each element has the +form (LANGUAGES . TAG-REGEXPS) where both LANGUAGES and +TAG-REGEXPS are lists of strings. + +Each language should be one of the recognized by etags, see +`etags --help'. Each tag regexp should be a string in the format +documented for the `--regex' arguments (without `{language}'). + +We currently support only Emacs's etags program with this option." + :type '(repeat + (cons + :tag "Languages group" + (repeat (string :tag "Language name")) + (repeat (string :tag "Tag Regexp")))) + :version "30.1") + +;;;###autoload +(put 'etags-regen-regexp-alist 'safe-local-variable + (lambda (value) + (and (listp value) + (seq-every-p + (lambda (group) + (and (consp group) + (listp (car group)) + (listp (cdr group)) + (seq-every-p #'stringp (car group)) + (seq-every-p #'stringp (cdr group)))) + value)))) + +;; We have to list all extensions: etags falls back to Fortran +;; when it cannot determine the type of the file. +;; http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00323.html +(defcustom etags-regen-file-extensions + '("rb" "js" "py" "pl" "el" "c" "cpp" "cc" "h" "hh" "hpp" + "java" "go" "cl" "lisp" "prolog" "php" "erl" "hrl" + "F" "f" "f90" "for" "cs" "a" "asm" "ads" "adb" "ada") + "Code file extensions for `etags-regen-mode'. + +File extensions to generate the tags for." + :type '(repeat (string :tag "File extension")) + :version "30.1") + +;;;###autoload +(put 'etags-regen-file-extensions 'safe-local-variable + (lambda (value) (and (listp value) (seq-every-p #'stringp value)))) + +;; FIXME: We don't support root anchoring yet. +(defcustom etags-regen-ignores nil + "Additional ignore rules, in the format of `project-ignores'." + :type '(repeat + (string :tag "Glob to ignore")) + :version "30.1") + +;;;###autoload +(put 'etags-regen-ignores 'safe-local-variable + (lambda (value) (and (listp value) (seq-every-p #'stringp value)))) + +(defvar etags-regen--errors-buffer-name "*etags-regen-tags-errors*") + +(defvar etags-regen--rescan-files-limit 100) + +(defun etags-regen--all-mtimes (proj) + (let ((files (etags-regen--all-files proj)) + (mtimes (make-hash-table :test 'equal)) + file-name-handler-alist) + (dolist (f files) + (condition-case nil + (puthash f + (file-attribute-modification-time + (file-attributes f)) + mtimes) + (file-missing nil))) + mtimes)) + +(defun etags-regen--choose-tags-file (proj) + (if (functionp etags-regen-tags-file) + (funcall etags-regen-tags-file (project-root proj)) + (expand-file-name etags-regen-tags-file (project-root proj)))) + +(defun etags-regen--refresh (proj) + (save-excursion + (let* ((tags-file (etags-regen--choose-tags-file proj)) + (tags-mtime (file-attribute-modification-time + (file-attributes tags-file))) + (all-mtimes (etags-regen--all-mtimes proj)) + added-files + changed-files + removed-files) + (etags-regen--visit-table tags-file (project-root proj)) + (set-buffer (get-file-buffer tags-file)) + (dolist (file (tags-table-files)) + (let ((mtime (gethash file all-mtimes))) + (cond + ((null mtime) + (push file removed-files)) + ((time-less-p tags-mtime mtime) + (push file changed-files) + (remhash file all-mtimes)) + (t + (remhash file all-mtimes))))) + (maphash + (lambda (key _value) + (push key added-files)) + all-mtimes) + (if (> (+ (length added-files) + (length changed-files) + (length removed-files)) + etags-regen--rescan-files-limit) + (progn + (message "etags-regen: Too many changes, falling back to full rescan") + (etags-regen--tags-cleanup)) + (dolist (file (nconc removed-files changed-files)) + (etags-regen--remove-tag file)) + (when (or changed-files added-files) + (apply #'etags-regen--append-tags + (nconc changed-files added-files))) + (when (or changed-files added-files removed-files) + (let ((save-silently t) + (message-log-max nil)) + (save-buffer 0))))))) + +(defun etags-regen--maybe-generate () + (let (proj) + (when (and etags-regen--tags-root + (not (file-in-directory-p default-directory + etags-regen--tags-root))) + (etags-regen--tags-cleanup)) + (when (and (not etags-regen--tags-root) + ;; If existing table is visited that's not generated by + ;; this mode, skip all functionality. + (not (or tags-file-name + tags-table-list)) + (file-exists-p (etags-regen--choose-tags-file + (setq proj (project-current))))) + (message "Found existing tags table, refreshing...") + (etags-regen--refresh proj)) + (when (and (not (or tags-file-name + tags-table-list)) + (setq proj (or proj (project-current)))) + (message "Generating new tags table...") + (let ((start (time-to-seconds))) + (etags-regen--tags-generate proj) + (message "...done (%.2f s)" (- (time-to-seconds) start)))))) + +(defun etags-regen--all-files (proj) + (let* ((root (project-root proj)) + (default-directory root) + ;; TODO: Make the scanning more efficient, e.g. move the + ;; filtering by glob to project (project-files-filtered...). + (files (project-files proj)) + (match-re (concat + "\\." + (regexp-opt etags-regen-file-extensions) + "\\'")) + (ir-start (1- (length root))) + (ignores-regexps + (mapcar #'etags-regen--ignore-regexp + etags-regen-ignores))) + (cl-delete-if + (lambda (f) (or (not (string-match-p match-re f)) + (string-match-p "/\\.#" f) ;Backup files. + (cl-some (lambda (ignore) (string-match ignore f ir-start)) + ignores-regexps))) + files))) + +(defun etags-regen--ignore-regexp (ignore) + (require 'dired) + ;; It's somewhat brittle to rely on Dired. + (let ((re (dired-glob-regexp ignore))) + ;; We could implement root anchoring here, but \\= doesn't work in + ;; string-match :-(. + (concat (unless (eq ?/ (aref re 3)) "/") + ;; Cutting off the anchors added by `dired-glob-regexp'. + (substring re 2 (- (length re) 2)) + ;; This way we allow a glob to match against a directory + ;; name, or a file name. And when it ends with / already, + ;; no need to add the anchoring. + (unless (eq ?/ (aref re (- (length re) 3))) + ;; Either match a full name segment, or eos. + "\\(?:/\\|\\'\\)")))) + +(defun etags-regen--tags-generate (proj) + (let* ((root (project-root proj)) + (default-directory root) + (files (etags-regen--all-files proj)) + (tags-file (etags-regen--choose-tags-file proj)) + (ctags-p (etags-regen--ctags-p)) + (command (format "%s %s %s - -o %s" + etags-regen-program + (mapconcat #'identity + (etags-regen--build-program-options ctags-p) + " ") + ;; ctags's etags requires '-L' for stdin input. + (if ctags-p "-L" "") + tags-file))) + (with-temp-buffer + (mapc (lambda (f) + (insert f "\n")) + files) + (shell-command-on-region (point-min) (point-max) command + nil nil etags-regen--errors-buffer-name t)) + (etags-regen--visit-table tags-file root))) + +(defun etags-regen--visit-table (tags-file root) + ;; Invalidate the scanned tags after any change is written to disk. + (add-hook 'after-save-hook #'etags-regen--update-file) + (add-hook 'before-save-hook #'etags-regen--mark-as-new) + (setq etags-regen--tags-file tags-file + etags-regen--tags-root root) + (visit-tags-table etags-regen--tags-file)) + +(defun etags-regen--ctags-p () + (string-search "Ctags" + (shell-command-to-string + (format "%s --version" etags-regen-program)))) + +(defun etags-regen--build-program-options (ctags-p) + (when (and etags-regen-regexp-alist ctags-p) + (user-error "etags-regen-regexp-alist is not supported with Ctags")) + (nconc + (mapcan + (lambda (group) + (mapcan + (lambda (lang) + (mapcar (lambda (regexp) + (concat "--regex=" + (shell-quote-argument + (format "{%s}%s" lang regexp)))) + (cdr group))) + (car group))) + etags-regen-regexp-alist) + (mapcar #'shell-quote-argument + etags-regen-program-options))) + +(defun etags-regen--update-file () + ;; TODO: Maybe only do this when Emacs is idle for a bit. Or defer + ;; the updates and do them later in bursts when the table is used. + (let* ((file-name buffer-file-name) + (tags-file-buf (and etags-regen--tags-root + (get-file-buffer etags-regen--tags-file))) + (relname (concat "/" (file-relative-name file-name + etags-regen--tags-root))) + (ignores etags-regen-ignores) + pr should-scan) + (save-excursion + (when tags-file-buf + (cond + ((and etags-regen--new-file + (kill-local-variable 'etags-regen--new-file) + (setq pr (project-current)) + (equal (project-root pr) etags-regen--tags-root) + (member file-name (project-files pr))) + (set-buffer tags-file-buf) + (setq should-scan t)) + ((progn (set-buffer tags-file-buf) + (etags-regen--remove-tag file-name)) + (setq should-scan t)))) + (when (and should-scan + (not (cl-some + (lambda (ignore) + (string-match-p + (etags-regen--ignore-regexp ignore) + relname)) + ignores))) + (etags-regen--append-tags file-name) + (let ((save-silently t) + (message-log-max nil)) + (save-buffer 0)))))) + +(defun etags-regen--remove-tag (file-name) + (goto-char (point-min)) + (when (search-forward (format "\f\n%s," file-name) nil t) + (let ((start (match-beginning 0))) + (search-forward "\f\n" nil 'move) + (let ((inhibit-read-only t)) + (delete-region start + (if (eobp) + (point) + (- (point) 2))))) + t)) + +(defun etags-regen--append-tags (&rest file-names) + (goto-char (point-max)) + (let ((options (etags-regen--build-program-options (etags-regen--ctags-p))) + (inhibit-read-only t)) + ;; XXX: call-process is significantly faster, though. + ;; Like 10ms vs 20ms here. But `shell-command' makes it easy to + ;; direct stderr to a separate buffer. + (shell-command + (format "%s %s %s -o -" + etags-regen-program (mapconcat #'identity options " ") + (mapconcat #'identity file-names " ")) + t etags-regen--errors-buffer-name)) + ;; FIXME: Is there a better way to do this? + ;; Completion table is the only remaining place where the + ;; update is not incremental. + (setq-default tags-completion-table nil)) + +(defun etags-regen--mark-as-new () + (when (and etags-regen--tags-root + (not buffer-file-number)) + (setq-local etags-regen--new-file t))) + +(defun etags-regen--tags-cleanup () + (when etags-regen--tags-file + (let ((buffer (get-file-buffer etags-regen--tags-file))) + (and buffer + (kill-buffer buffer))) + (tags-reset-tags-tables) + (setq tags-file-name nil + tags-table-list nil + etags-regen--tags-file nil + etags-regen--tags-root nil)) + (remove-hook 'after-save-hook #'etags-regen--update-file) + (remove-hook 'before-save-hook #'etags-regen--mark-as-new)) + +(defvar etags-regen-mode-map (make-sparse-keymap)) + +;;;###autoload +(define-minor-mode etags-regen-mode + "Minor mode to automatically generate and update tags tables. + +This minor mode generates the tags table automatically based on +the current project configuration, and later updates it as you +edit the files and save the changes. + +If you select a tags table manually (for example, using +\\[visit-tags-table]), then this mode will be effectively +disabled for the entire session. Use \\[tags-reset-tags-tables] +to countermand the effect of a previous \\[visit-tags-table]." + :global t + (if etags-regen-mode + (progn + (advice-add 'etags--xref-backend :before + #'etags-regen--maybe-generate) + (advice-add 'tags-completion-at-point-function :before + #'etags-regen--maybe-generate)) + (advice-remove 'etags--xref-backend #'etags-regen--maybe-generate) + (advice-remove 'tags-completion-at-point-function #'etags-regen--maybe-generate) + (etags-regen--tags-cleanup))) + +(provide 'etags-regen) + +;;; etags-regen.el ends here diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index b9bd772ddfc..597612196fd 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -1488,7 +1488,7 @@ hits the start of file." (setq symbs (symbol-value symbs)) (insert (format-message "symbol `%s' has no value\n" symbs)) (setq symbs nil))) - (if (vectorp symbs) + (if (obarrayp symbs) (mapatoms ins-symb symbs) (dolist (sy symbs) (funcall ins-symb (car sy)))) @@ -2065,7 +2065,8 @@ for \\[find-tag] (which see)." (user-error "%s" (substitute-command-keys "No tags table loaded; try \\[visit-tags-table]"))) - (let ((comp-data (tags-completion-at-point-function))) + (let ((comp-data (tags-completion-at-point-function)) + (completion-ignore-case (find-tag--completion-ignore-case))) (if (null comp-data) (user-error "Nothing to complete") (completion-in-region (car comp-data) (cadr comp-data) @@ -2183,7 +2184,7 @@ file name, add `tag-partial-file-name-match-p' to the list value.") (setq symbs (symbol-value symbs)) (warn "symbol `%s' has no value" symbs) (setq symbs nil)) - (if (vectorp symbs) + (if (obarrayp symbs) (mapatoms add-xref symbs) (dolist (sy symbs) (funcall add-xref (car sy)))) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 3f8aec27833..779c612f479 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -715,7 +715,7 @@ associated `flymake-category' return DEFAULT." (delete-overlay ov))) (defun flymake--eol-overlay-summary (src-ovs) - "Helper function for `flymake--eol-overlay-update'." + "Helper function for `flymake--update-eol-overlays'." (cl-flet ((summarize (d) (propertize (flymake-diagnostic-oneliner d t) 'face (flymake--lookup-type-property (flymake--diag-type d) @@ -744,7 +744,7 @@ associated `flymake-category' return DEFAULT." (defun flymake--update-eol-overlays () "Update the `before-string' property of end-of-line overlays." - (save-excursion + (save-restriction (widen) (dolist (o (overlays-in (point-min) (point-max))) (when (overlay-get o 'flymake--eol-overlay) @@ -1569,13 +1569,19 @@ correctly.") ,flymake-mode-line-lighter mouse-face mode-line-highlight help-echo - ,(lambda (&rest _) - (concat - (format "%s known backends\n" (hash-table-count flymake--state)) - (format "%s running\n" (length (flymake-running-backends))) - (format "%s disabled\n" (length (flymake-disabled-backends))) - "mouse-1: Display minor mode menu\n" - "mouse-2: Show help for minor mode")) + ,(lambda (w &rest _) + (with-current-buffer (window-buffer w) + ;; Mouse can activate tool-tip without window being active. + ;; `flymake--state' is buffer local and is null when line + ;; lighter appears in *Help* `describe-mode'. + (concat + (unless (null flymake--state) + (concat + (format "%s known backends\n" (hash-table-count flymake--state)) + (format "%s running\n" (length (flymake-running-backends))) + (format "%s disabled\n" (length (flymake-disabled-backends))))) + "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] @@ -1637,14 +1643,16 @@ correctly.") (defvar flymake--mode-line-counter-map (let ((map (make-sparse-keymap))) + ;; BEWARE: `mouse-wheel-UP-event' corresponds to `wheel-DOWN' events + ;; and vice versa!! (define-key map (vector 'mode-line mouse-wheel-down-event) #'flymake--mode-line-counter-scroll-prev) (define-key map [mode-line wheel-down] - #'flymake--mode-line-counter-scroll-prev) + #'flymake--mode-line-counter-scroll-next) (define-key map (vector 'mode-line mouse-wheel-up-event) #'flymake--mode-line-counter-scroll-next) (define-key map [mode-line wheel-up] - #'flymake--mode-line-counter-scroll-next) + #'flymake--mode-line-counter-scroll-prev) map)) (defun flymake--mode-line-counter-1 (type) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index e08653f7f9e..c8b086cfad2 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -1880,7 +1880,8 @@ this trigger is subscribed to `gdb-buf-publisher' and called with (defun gdb-clear-inferior-io () (with-current-buffer (gdb-get-buffer-create 'gdb-inferior-io) - (erase-buffer))) + (let ((inhibit-read-only t)) + (erase-buffer)))) (defconst breakpoint-xpm-data @@ -2866,7 +2867,8 @@ current thread and update GDB buffers." (defun gdb-clear-partial-output () (with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer) - (erase-buffer))) + (let ((inhibit-read-only t)) + (erase-buffer)))) ;; Parse GDB/MI result records: this process converts ;; list [...] -> list diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el index 65adc1c55ea..cc330688dc3 100644 --- a/lisp/progmodes/go-ts-mode.el +++ b/lisp/progmodes/go-ts-mode.el @@ -261,7 +261,11 @@ (treesit-major-mode-setup))) +(derived-mode-add-parents 'go-ts-mode '(go-mode)) + (if (treesit-ready-p 'go) + ;; FIXME: Should we instead put `go-mode' in `auto-mode-alist' + ;; and then use `major-mode-remap-defaults' to map it to `go-ts-mode'? (add-to-list 'auto-mode-alist '("\\.go\\'" . go-ts-mode))) (defun go-ts-mode--defun-name (node &optional skip-prefix) @@ -437,6 +441,8 @@ what the parent of the node would be if it were a node." (treesit-major-mode-setup))) +(derived-mode-add-parents 'go-mod-ts-mode '(go-mod-mode)) + (if (treesit-ready-p 'gomod) (add-to-list 'auto-mode-alist '("/go\\.mod\\'" . go-mod-ts-mode))) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index be6357f4139..f10b047cc74 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -243,7 +243,7 @@ Check it when `gud-running' is t") :visible (eq gud-minor-mode 'gdbmi)] ["Print Expression" gud-print :enable (not gud-running)] - ["Dump object-Derefenrece" gud-pstar + ["Dump object-Dereference" gud-pstar :label (if (eq gud-minor-mode 'jdb) "Dump object" "Print Dereference") @@ -3671,8 +3671,7 @@ Treats actions as defuns." (remove-hook 'after-save-hook #'gdb-create-define-alist t)))) (defcustom gud-tooltip-modes '( gud-mode c-mode c++-mode fortran-mode - python-mode c-ts-mode c++-ts-mode - python-ts-mode) + python-mode) "List of modes for which to enable GUD tooltips." :type '(repeat (symbol :tag "Major mode")) :group 'tooltip) @@ -3708,10 +3707,9 @@ only tooltips in the buffer containing the overlay arrow." #'gud-tooltip-activate-mouse-motions-if-enabled) (dolist (buffer (buffer-list)) (with-current-buffer buffer - (if (and gud-tooltip-mode - (memq major-mode gud-tooltip-modes)) - (gud-tooltip-activate-mouse-motions t) - (gud-tooltip-activate-mouse-motions nil))))) + (gud-tooltip-activate-mouse-motions + (and gud-tooltip-mode + (derived-mode-p gud-tooltip-modes)))))) (defvar gud-tooltip-mouse-motions-active nil "Locally t in a buffer if tooltip processing of mouse motion is enabled.") diff --git a/lisp/progmodes/heex-ts-mode.el b/lisp/progmodes/heex-ts-mode.el index 7b53a44deb2..07b8bfdc74f 100644 --- a/lisp/progmodes/heex-ts-mode.el +++ b/lisp/progmodes/heex-ts-mode.el @@ -166,6 +166,16 @@ With ARG, do it many times. Negative ARG means move backward." ("Slot" "\\`slot\\'" nil nil) ("Tag" "\\`tag\\'" nil nil))) + ;; Outline minor mode + ;; `heex-ts-mode' inherits from `html-mode' that sets + ;; regexp-based outline variables. So need to restore + ;; the default values of outline variables to be able + ;; to use `treesit-outline-predicate' derived + ;; from `treesit-simple-imenu-settings' above. + (kill-local-variable 'outline-heading-end-regexp) + (kill-local-variable 'outline-regexp) + (kill-local-variable 'outline-level) + (setq-local treesit-font-lock-settings heex-ts--font-lock-settings) (setq-local treesit-simple-indent-rules heex-ts--indent-rules) @@ -177,6 +187,8 @@ With ARG, do it many times. Negative ARG means move backward." (treesit-major-mode-setup))) +(derived-mode-add-parents 'heex-ts-mode '(heex-mode)) + (if (treesit-ready-p 'heex) ;; Both .heex and the deprecated .leex files should work ;; with the tree-sitter-heex grammar. diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 3b7eb393561..98e567299a1 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -390,7 +390,7 @@ If there is a marked region from START to END it only shows the symbols within." (defun hif-after-revert-function () (and hide-ifdef-mode hide-ifdef-hiding (hide-ifdefs nil nil t))) -(add-hook 'after-revert-hook 'hif-after-revert-function) +(add-hook 'after-revert-hook #'hif-after-revert-function) (defun hif-end-of-line () "Find the end-point of line concatenation." @@ -474,7 +474,7 @@ Everything including these lines is made invisible." (defun hif-eval (form) "Evaluate hideif internal representation." - (let ((val (eval form))) + (let ((val (eval form t))) (if (stringp val) (or (get-text-property 0 'hif-value val) val) @@ -542,7 +542,7 @@ that form should be displayed.") (defconst hif-cpp-prefix "\\(^\\|\r\\)?[ \t]*#[ \t]*") (defconst hif-ifxdef-regexp (concat hif-cpp-prefix "if\\(n\\)?def")) (defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef")) -(defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\((\\|\\(n?def\\)?[ \t]+\\)")) +(defvar hif-ifx-regexp (concat hif-cpp-prefix "if\\((\\|\\(n?def\\)?[ \t]+\\)")) (defconst hif-elif-regexp (concat hif-cpp-prefix "elif")) (defconst hif-else-regexp (concat hif-cpp-prefix "else")) (defconst hif-endif-regexp (concat hif-cpp-prefix "endif")) @@ -679,7 +679,7 @@ that form should be displayed.") ("..." . hif-etc) ("defined" . hif-defined))) -(defconst hif-valid-token-list (mapcar 'cdr hif-token-alist)) +(defconst hif-valid-token-list (mapcar #'cdr hif-token-alist)) (defconst hif-token-regexp ;; The ordering of regexp grouping is crucial to `hif-strtok' @@ -690,7 +690,7 @@ that form should be displayed.") ;; decimal/octal: "\\|\\(\\([+-]?[0-9']+\\(\\.[0-9']*\\)?\\)\\([eE][+-]?[0-9]+\\)?" hif-numtype-suffix-regexp "?\\)" - "\\|" (regexp-opt (mapcar 'car hif-token-alist) t) + "\\|" (regexp-opt (mapcar #'car hif-token-alist) t) "\\|\\(\\w+\\)")) ;; C++11 Unicode string literals (L"" u8"" u"" U"" R"" LR"" u8R"" uR"") @@ -867,7 +867,7 @@ Assuming we've just performed a `hif-token-regexp' lookup." (t (setq hif-simple-token-only nil) - (intern-safe string))))) + (hif--intern-safe string))))) (defun hif-backward-comment (&optional start end) "If we're currently within a C(++) comment, skip them backwards." @@ -1448,7 +1448,7 @@ This macro cannot be evaluated alone without parameters input." (t (error "Invalid token to stringify")))) -(defun intern-safe (str) +(defun hif--intern-safe (str) (if (stringp str) (intern str))) @@ -1750,7 +1750,7 @@ and `+='...)." ;; Split REM-BODY @ __VA_ARGS__ into LEFT and right (setq part nil) (if (zerop va) - (setq left nil ; __VA_ARGS__ trimed + (setq left nil ; __VA_ARGS__ trimmed rem-body (cdr rem-body)) (setq left rem-body rem-body (cdr (nthcdr va rem-body))) ; _V_ removed diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index b181b21118f..07616960565 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -254,6 +254,9 @@ This has effect only if `search-invisible' is set to `open'." ;;;###autoload (defvar hs-special-modes-alist + ;; FIXME: Currently the check is made via + ;; (assoc major-mode hs-special-modes-alist) so it doesn't pay attention + ;; to the mode hierarchy. (mapcar #'purecopy '((c-mode "{" "}" "/[*/]" nil nil) (c-ts-mode "{" "}" "/[*/]" nil nil) diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index 217b2ab6691..7bed69a738b 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el @@ -631,7 +631,7 @@ Needs additional info stored in global `idlwave-completion-help-info'." Those words in `idlwave-completion-help-links' have links. The `idlwave-help-link' face is used for this." (if idlwave-highlight-help-links-in-completion - (with-current-buffer (get-buffer "*Completions*") + (with-current-buffer "*Completions*" (save-excursion (let* ((case-fold-search t) (props (list 'face 'idlwave-help-link)) diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index b5470b5490d..b5d91f46b17 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -96,8 +96,8 @@ (defcustom idlwave-shell-prompt-pattern "^\r? ?IDL> " "Regexp to match IDL prompt at beginning of a line. -For example, \"^\r?IDL> \" or \"^\r?WAVE> \". -The \"^\r?\" is needed, to indicate the beginning of the line, with +For example, \"^\\r?IDL> \" or \"^\\r?WAVE> \". +The \"^\\r?\" is needed, to indicate the beginning of the line, with optional return character (which IDL seems to output randomly). This variable is used to initialize `comint-prompt-regexp' in the process buffer." @@ -829,7 +829,7 @@ IDL has currently stepped.") 3. Routine Info ------------ - `\\[idlwave-routine-info]' displays information about an IDL routine near point, + \\[idlwave-routine-info] displays information about an IDL routine near point, just like in `idlwave-mode'. The module used is the one at point or the one whose argument list is being edited. To update IDLWAVE's knowledge about compiled or edited modules, use diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 4b96461d773..30442fa0d34 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -657,7 +657,7 @@ When you specify a class, this information can be stored as a text property on the `->' arrow in the source code, so that during the same editing session, IDLWAVE will not have to ask again. When this variable is non-nil, IDLWAVE will store and reuse the class information. -The class stored can be checked and removed with `\\[idlwave-routine-info]' +The class stored can be checked and removed with \\[idlwave-routine-info] on the arrow. The default of this variable is nil, since the result of commands then diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el index 0b1ac49b99f..bb4a7df3340 100644 --- a/lisp/progmodes/java-ts-mode.el +++ b/lisp/progmodes/java-ts-mode.el @@ -74,7 +74,12 @@ ((parent-is "program") column-0 0) ((match "}" "element_value_array_initializer") parent-bol 0) - ((node-is "}") column-0 c-ts-common-statement-offset) + ((node-is + ,(format "\\`%s\\'" + (regexp-opt '("constructor_body" "class_body" "interface_body" + "block" "switch_block" "array_initializer")))) + parent-bol 0) + ((node-is "}") standalone-parent 0) ((node-is ")") parent-bol 0) ((node-is "else") parent-bol 0) ((node-is "]") parent-bol 0) @@ -86,10 +91,10 @@ ((parent-is "array_initializer") parent-bol java-ts-mode-indent-offset) ((parent-is "annotation_type_body") column-0 c-ts-common-statement-offset) ((parent-is "interface_body") column-0 c-ts-common-statement-offset) - ((parent-is "constructor_body") column-0 c-ts-common-statement-offset) + ((parent-is "constructor_body") standalone-parent java-ts-mode-indent-offset) ((parent-is "enum_body_declarations") parent-bol 0) ((parent-is "enum_body") column-0 c-ts-common-statement-offset) - ((parent-is "switch_block") column-0 c-ts-common-statement-offset) + ((parent-is "switch_block") standalone-parent java-ts-mode-indent-offset) ((parent-is "record_declaration_body") column-0 c-ts-common-statement-offset) ((query "(method_declaration (block _ @indent))") parent-bol java-ts-mode-indent-offset) ((query "(method_declaration (block (_) @indent))") parent-bol java-ts-mode-indent-offset) @@ -125,7 +130,7 @@ ((parent-is "case_statement") parent-bol java-ts-mode-indent-offset) ((parent-is "labeled_statement") parent-bol java-ts-mode-indent-offset) ((parent-is "do_statement") parent-bol java-ts-mode-indent-offset) - ((parent-is "block") column-0 c-ts-common-statement-offset))) + ((parent-is "block") standalone-parent java-ts-mode-indent-offset))) "Tree-sitter indent rules.") (defvar java-ts-mode--keywords @@ -401,6 +406,8 @@ Return nil if there is no name or if NODE is not a defun node." ("Method" "\\`method_declaration\\'" nil nil))) (treesit-major-mode-setup)) +(derived-mode-add-parents 'java-ts-mode '(java-mode)) + (if (treesit-ready-p 'java) (add-to-list 'auto-mode-alist '("\\.java\\'" . java-ts-mode))) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 0115feb0e97..6cb84592896 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -3418,6 +3418,26 @@ This function is intended for use in `after-change-functions'." ;;; Tree sitter integration +(defun js--treesit-font-lock-compatibility-definition-feature () + "Font lock helper, to handle different releases of tree-sitter-javascript. +Check if a node type is available, then return the right font lock rules +for \"definition\" feature." + (condition-case nil + (progn (treesit-query-capture 'javascript '((function_expression) @cap)) + ;; Starting from version 0.20.2 of the grammar. + '((function_expression + name: (identifier) @font-lock-function-name-face) + (variable_declarator + name: (identifier) @font-lock-function-name-face + value: [(function_expression) (arrow_function)]))) + (error + ;; An older version of the grammar. + '((function + name: (identifier) @font-lock-function-name-face) + (variable_declarator + name: (identifier) @font-lock-function-name-face + value: [(function) (arrow_function)]))))) + (defun js-jsx--treesit-indent-compatibility-bb1f97b () "Indent rules helper, to handle different releases of tree-sitter-javascript. Check if a node type is available, then return the right indent rules." @@ -3529,8 +3549,7 @@ Check if a node type is available, then return the right indent rules." :language 'javascript :feature 'definition - '((function - name: (identifier) @font-lock-function-name-face) + `(,@(js--treesit-font-lock-compatibility-definition-feature) (class_declaration name: (identifier) @font-lock-type-face) @@ -3550,10 +3569,6 @@ Check if a node type is available, then return the right indent rules." name: (identifier) @font-lock-variable-name-face) (variable_declarator - name: (identifier) @font-lock-function-name-face - value: [(function) (arrow_function)]) - - (variable_declarator name: [(array_pattern (identifier) @font-lock-variable-name-face) (object_pattern (shorthand_property_identifier_pattern) @font-lock-variable-name-face)]) @@ -3702,6 +3717,9 @@ Currently there are `js-mode' and `js-ts-mode'." (define-derived-mode js-mode js-base-mode "JavaScript" "Major mode for editing JavaScript." :group 'js + (js--mode-setup)) + +(defun js--mode-setup () ;; Ensure all CC Mode "lang variables" are set to valid values. (c-init-language-vars js-mode) (setq-local indent-line-function #'js-indent-line) @@ -3898,6 +3916,8 @@ See `treesit-thing-settings' for more information.") (add-to-list 'auto-mode-alist '("\\(\\.js[mx]\\|\\.har\\)\\'" . js-ts-mode)))) +(derived-mode-add-parents 'js-ts-mode '(js-mode)) + (defvar js-ts--s-p-query (when (treesit-available-p) (treesit-query-compile 'javascript @@ -3924,7 +3944,9 @@ See `treesit-thing-settings' for more information.") (put-text-property (1- ne) ne 'syntax-table syntax))))) ;;;###autoload -(define-derived-mode js-json-mode js-mode "JSON" +(define-derived-mode js-json-mode prog-mode "JSON" + :syntax-table js-mode-syntax-table + (js--mode-setup) ;Reuse most of `js-mode', but not as parent (bug#67463). (setq-local js-enabled-frameworks nil) ;; Speed up `syntax-ppss': JSON files can be big but can't hold ;; regexp matchers nor #! thingies (and `js-enabled-frameworks' is nil). diff --git a/lisp/progmodes/json-ts-mode.el b/lisp/progmodes/json-ts-mode.el index 32bc10bbda9..1fb96555010 100644 --- a/lisp/progmodes/json-ts-mode.el +++ b/lisp/progmodes/json-ts-mode.el @@ -164,6 +164,8 @@ Return nil if there is no name or if NODE is not a defun node." (treesit-major-mode-setup)) +(derived-mode-add-parents 'json-ts-mode '(json-mode)) + (if (treesit-ready-p 'json) (add-to-list 'auto-mode-alist '("\\.json\\'" . json-ts-mode))) diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el index 3b600f59521..407ef230c32 100644 --- a/lisp/progmodes/lua-ts-mode.el +++ b/lisp/progmodes/lua-ts-mode.el @@ -26,8 +26,8 @@ ;; This package provides `lua-ts-mode' which is a major mode for Lua ;; files that uses Tree Sitter to parse the language. ;; -;; This package is compatible with and tested against the grammar -;; for Lua found at https://github.com/MunifTanjim/tree-sitter-lua +;; This package is compatible with and tested against the grammar for +;; Lua found at https://github.com/tree-sitter-grammars/tree-sitter-lua ;;; Code: @@ -60,66 +60,77 @@ :options '(flymake-mode hs-minor-mode outline-minor-mode) - :group 'lua-ts :version "30.1") (defcustom lua-ts-indent-offset 4 "Number of spaces for each indentation step in `lua-ts-mode'." :type 'natnum :safe 'natnump - :group 'lua-ts :version "30.1") (defcustom lua-ts-luacheck-program "luacheck" "Location of the Luacheck program." :type '(choice (const :tag "None" nil) string) - :group 'lua-ts :version "30.1") (defcustom lua-ts-inferior-buffer "*Lua*" "Name of the inferior Lua buffer." :type 'string :safe 'stringp - :group 'lua-ts :version "30.1") (defcustom lua-ts-inferior-program "lua" "Program to run in the inferior Lua process." :type '(choice (const :tag "None" nil) string) - :group 'lua-ts :version "30.1") (defcustom lua-ts-inferior-options '("-i") "Command line options for the inferior Lua process." :type '(repeat string) - :group 'lua-ts :version "30.1") (defcustom lua-ts-inferior-startfile nil "File to load into the inferior Lua process at startup." :type '(choice (const :tag "None" nil) (file :must-match t)) - :group 'lua-ts :version "30.1") (defcustom lua-ts-inferior-prompt ">" "Prompt used by the inferior Lua process." :type 'string :safe 'stringp - :group 'lua-ts :version "30.1") (defcustom lua-ts-inferior-prompt-continue ">>" "Continuation prompt used by the inferior Lua process." :type 'string :safe 'stringp - :group 'lua-ts :version "30.1") (defcustom lua-ts-inferior-history nil "File used to save command history of the inferior Lua process." :type '(choice (const :tag "None" nil) file) :safe 'string-or-null-p - :group 'lua-ts + :version "30.1") + +(defcustom lua-ts-indent-continuation-lines t + "Controls how multi-line if/else statements are aligned. + +If t, then continuation lines are indented by `lua-ts-indent-offset': + + if a + and b then + print(1) + end + +If nil, then continuation lines are aligned with the beginning of +the statement: + + if a + and b then + print(1) + end" + :type 'boolean + :safe 'booleanp :version "30.1") (defvar lua-ts--builtins @@ -295,6 +306,8 @@ values of OVERRIDE." (node-is ")") (node-is "}")) standalone-parent 0) + ((match null "table_constructor") + standalone-parent lua-ts-indent-offset) ((or (and (parent-is "arguments") lua-ts--first-child-matcher) (and (parent-is "parameters") lua-ts--first-child-matcher) (and (parent-is "table_constructor") lua-ts--first-child-matcher)) @@ -329,6 +342,17 @@ values of OVERRIDE." ((or (match "end" "function_definition") (node-is "end")) standalone-parent 0) + ((n-p-gp "expression_list" "assignment_statement" "variable_declaration") + lua-ts--variable-declaration-continuation-anchor + lua-ts-indent-offset) + ((and (parent-is "binary_expression") + lua-ts--variable-declaration-continuation) + lua-ts--variable-declaration-continuation-anchor + lua-ts-indent-offset) + ((and (lambda (&rest _) lua-ts-indent-continuation-lines) + (parent-is "binary_expression")) + standalone-parent lua-ts-indent-offset) + ((parent-is "binary_expression") standalone-parent 0) ((or (parent-is "function_declaration") (parent-is "function_definition") (parent-is "do_statement") @@ -415,6 +439,22 @@ values of OVERRIDE." (treesit-induce-sparse-tree parent #'lua-ts--function-definition-p))) (= 1 (length (cadr sparse-tree))))) +(defun lua-ts--variable-declaration-continuation (node &rest _) + "Matches if NODE is part of a multi-line variable declaration." + (treesit-parent-until node + (lambda (p) + (equal "variable_declaration" + (treesit-node-type p))))) + +(defun lua-ts--variable-declaration-continuation-anchor (node &rest _) + "Return the start position of the variable declaration for NODE." + (save-excursion + (goto-char (treesit-node-start + (lua-ts--variable-declaration-continuation node))) + (when (looking-back (rx bol (* whitespace)) + (line-beginning-position)) + (point)))) + (defvar lua-ts--syntax-table (let ((table (make-syntax-table))) (modify-syntax-entry ?+ "." table) @@ -577,7 +617,7 @@ Calls REPORT-FN directly." nil t))) (select-window (display-buffer lua-ts-inferior-buffer '((display-buffer-reuse-window - display-buffer-pop-up-frame) + display-buffer-pop-up-window) (reusable-frames . t)))) (get-buffer-process (current-buffer))) @@ -725,7 +765,7 @@ Calls REPORT-FN directly." "vararg_expression")))) (text "comment")))) - ;; Imenu. + ;; Imenu/Outline. (setq-local treesit-simple-imenu-settings `(("Requires" "\\`function_call\\'" @@ -740,16 +780,6 @@ Calls REPORT-FN directly." ;; Which-function. (setq-local which-func-functions (treesit-defun-at-point)) - ;; Outline. - (setq-local outline-regexp - (rx (seq (0+ space) - (or (seq "--[[" (0+ space) eol) - (seq symbol-start - (or "do" "for" "if" "repeat" "while" - (seq (? (seq "local" (1+ space))) - "function")) - symbol-end))))) - ;; Align. (setq-local align-indent-before-aligning t) @@ -757,6 +787,8 @@ Calls REPORT-FN directly." (add-hook 'flymake-diagnostic-functions #'lua-ts-flymake-luacheck nil 'local)) +(derived-mode-add-parents 'lua-ts-mode '(lua-mode)) + (when (treesit-ready-p 'lua) (add-to-list 'auto-mode-alist '("\\.lua\\'" . lua-ts-mode))) diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el index 09cb848fd52..2bb31988290 100644 --- a/lisp/progmodes/modula2.el +++ b/lisp/progmodes/modula2.el @@ -325,20 +325,20 @@ followed by the first character of the construct. ;; ;; Module definitions. ("\\<\\(INTERFACE\\|MODULE\\|PROCEDURE\\)\\>[ \t]*\\(\\sw+\\)?" - (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) + (1 'font-lock-keyword-face) (2 'font-lock-function-name-face nil t)) ;; ;; Import directives. ("\\<\\(EXPORTS\\|FROM\\|IMPORT\\)\\>" - (1 font-lock-keyword-face) + (1 'font-lock-keyword-face) (font-lock-match-c-style-declaration-item-and-skip-to-next nil (goto-char (match-end 0)) - (1 font-lock-constant-face))) + (1 'font-lock-constant-face))) ;; ;; Pragmas as warnings. ;; Spencer Allain <sallain@teknowledge.com> says do them as comments... ;; ("<\\*.*\\*>" . font-lock-warning-face) ;; ... but instead we fontify the first word. - ("<\\*[ \t]*\\(\\sw+\\)" 1 font-lock-warning-face prepend) + ("<\\*[ \t]*\\(\\sw+\\)" 1 'font-lock-warning-face prepend) ) "Subdued level highlighting for Modula-3 modes.") @@ -366,26 +366,29 @@ followed by the first character of the construct. "LOOPHOLE" "MAX" "MIN" "NARROW" "NEW" "NUMBER" "ORD" "ROUND" "SUBARRAY" "TRUNC" "TYPECODE" "VAL"))) ) - (list - ;; - ;; Keywords except those fontified elsewhere. - (concat "\\<\\(" m3-keywords "\\)\\>") - ;; - ;; Builtins. - (cons (concat "\\<\\(" m3-builtins "\\)\\>") 'font-lock-builtin-face) - ;; - ;; Type names. - (cons (concat "\\<\\(" m3-types "\\)\\>") 'font-lock-type-face) - ;; - ;; Fontify tokens as function names. - '("\\<\\(END\\|EXCEPTION\\|RAISES?\\)\\>[ \t{]*" - (1 font-lock-keyword-face) + `( + ;; + ;; Keywords except those fontified elsewhere. + ,(concat "\\<\\(" m3-keywords "\\)\\>") + ;; + ;; Builtins. + (,(concat "\\<\\(" m3-builtins "\\)\\>") + (0 'font-lock-builtin-face)) + ;; + ;; Type names. + (,(concat "\\<\\(" m3-types "\\)\\>") + (0 'font-lock-type-face)) + ;; + ;; Fontify tokens as function names. + ("\\<\\(END\\|EXCEPTION\\|RAISES?\\)\\>[ \t{]*" + (1 'font-lock-keyword-face) (font-lock-match-c-style-declaration-item-and-skip-to-next nil (goto-char (match-end 0)) - (1 font-lock-function-name-face))) - ;; - ;; Fontify constants as references. - '("\\<\\(FALSE\\|NIL\\|NULL\\|TRUE\\)\\>" . font-lock-constant-face) + (1 'font-lock-function-name-face))) + ;; + ;; Fontify constants as references. + ("\\<\\(FALSE\\|NIL\\|NULL\\|TRUE\\)\\>" + (0 'font-lock-constant-face)) )))) "Gaudy level highlighting for Modula-3 modes.") diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el index 5e8263cb646..a80e12b8129 100644 --- a/lisp/progmodes/opascal.el +++ b/lisp/progmodes/opascal.el @@ -281,7 +281,7 @@ nested routine.") (eval-when-compile (pcase-defmacro opascal--in (set) - `(pred (pcase--flip memq ,set)))) + `(pred (memq _ ,set)))) (defun opascal-string-of (start end) ;; Returns the buffer string from start to end. diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index f74390841fe..f6c4dbed1e2 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -251,7 +251,16 @@ ;; correctly the \() construct (Bug#11996) as well as references ;; to string values. ("\\(\\\\\\)['`\"($]" (1 (unless (nth 3 (syntax-ppss)) - (string-to-syntax ".")))) + (string-to-syntax ".")))) + ;; A "$" in Perl code must escape the next char to protect against + ;; misinterpreting Perl's punctuation variables as unbalanced + ;; quotes or parens. This is not needed in strings and broken in + ;; the special case of "$\"" (Bug#69604). Make "$" a punctuation + ;; char in strings. + ("\\$" (0 (if (save-excursion + (nth 3 (syntax-ppss (match-beginning 0)))) + (string-to-syntax ".") + (string-to-syntax "/")))) ;; Handle funny names like $DB'stop. ("\\$ ?{?\\^?[_[:alpha:]][_[:alnum:]]*\\('\\)[_[:alpha:]]" (1 "_")) ;; format statements diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index a6f14a0865c..a10e24f3e28 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -229,7 +229,8 @@ See the doc string of `project-find-functions' for the general form of the project instance object." (unless directory (setq directory (or project-current-directory-override default-directory))) - (let ((pr (project--find-in-directory directory))) + (let ((pr (project--find-in-directory directory)) + (non-essential (not maybe-prompt))) (cond (pr) ((unless project-current-directory-override @@ -602,7 +603,7 @@ See `project-vc-extra-root-markers' for the marker value format.") (goto-char (point-min)) ;; Kind of a hack to distinguish a submodule from ;; other cases of .git files pointing elsewhere. - (looking-at "gitdir: [./]+/\\.git/modules/")) + (looking-at "gitdir: .+/\\.git/\\(worktrees/.*\\)?modules/")) t) (t nil)))) @@ -808,8 +809,10 @@ DIRS must contain directory names." (with-temp-buffer (setq default-directory dir) (let ((enable-local-variables :all)) - (hack-dir-local-variables-non-file-buffer)) - (symbol-value var))) + (hack-dir-local-variables)) + ;; Don't use `hack-local-variables-apply' to avoid setting modes. + (alist-get var file-local-variables-alist + (symbol-value var)))) (cl-defmethod project-buffers ((project (head vc))) (let* ((root (expand-file-name (file-name-as-directory (project-root project)))) @@ -992,9 +995,7 @@ requires quoting, e.g. `\\[quoted-insert]<space>'." ;;;###autoload (defun project-or-external-find-regexp (regexp) - "Find all matches for REGEXP in the project roots or external roots. -With \\[universal-argument] prefix, you can specify the file name -pattern to search for." + "Find all matches for REGEXP in the project roots or external roots." (interactive (list (project--read-regexp))) (require 'xref) (let* ((pr (project-current t)) @@ -1363,6 +1364,7 @@ If you exit the `query-replace', you can later continue the (defvar compilation-read-command) (declare-function compilation-read-command "compile") +(declare-function recompile "compile") (defun project-prefixed-buffer-name (mode) (concat "*" @@ -1396,6 +1398,18 @@ If non-nil, it overrides `compilation-buffer-name-function' for compilation-buffer-name-function))) (call-interactively #'compile))) +(defun project-recompile (&optional edit-command) + "Run `recompile' with appropriate buffer." + (declare (interactive-only recompile)) + (interactive "P") + (let ((compilation-buffer-name-function + (or project-compilation-buffer-name-function + ;; Should we error instead? When there's no + ;; project-specific naming, there is no point in using + ;; this command. + compilation-buffer-name-function))) + (recompile edit-command))) + (defcustom project-ignore-buffer-conditions nil "List of conditions to filter the buffers to be switched to. If any of these conditions are satisfied for a buffer in the @@ -1502,7 +1516,8 @@ ARG, show only buffers that are visiting files." (lambda (buffer) (let ((name (buffer-name buffer)) (file (buffer-file-name buffer))) - (and (or (not (string= (substring name 0 1) " ")) + (and (or Buffer-menu-show-internal + (not (string= (substring name 0 1) " ")) file) (not (eq buffer (current-buffer))) (or file (not Buffer-menu-files-only))))) @@ -1512,6 +1527,7 @@ ARG, show only buffers that are visiting files." (let ((buf (list-buffers-noselect arg (with-current-buffer (get-buffer-create "*Buffer List*") + (setq-local Buffer-menu-show-internal nil) (let ((Buffer-menu-files-only arg)) (funcall buffer-list-function)))))) (with-current-buffer buf @@ -1694,7 +1710,10 @@ With some possible metadata (to be decided).") (let ((name (car elem))) (list (if (file-remote-p name) name (abbreviate-file-name name))))) - (read (current-buffer)))))) + (condition-case nil + (read (current-buffer)) + (end-of-file + (warn "Failed to read the projects list file due to unexpected EOF"))))))) (unless (seq-every-p (lambda (elt) (stringp (car-safe elt))) project--list) @@ -1850,12 +1869,12 @@ Otherwise, `default-directory' is temporarily set to the current project's root. If OVERRIDING-MAP is non-nil, it will be used as -`overriding-local-map' to provide shorter bindings from that map -which will take priority over the global ones." +`overriding-terminal-local-map' to provide shorter bindings +from that map which will take priority over the global ones." (interactive) (let* ((pr (project-current t)) (prompt-format (or prompt-format "[execute in %s]:")) - (command (let ((overriding-local-map overriding-map)) + (command (let ((overriding-terminal-local-map overriding-map)) (key-binding (read-key-sequence (format prompt-format (project-root pr))) t))) @@ -2124,12 +2143,10 @@ is part of the default mode line beginning with Emacs 30." :group 'project :version "30.1") -(defvar project-menu-entry - `(menu-item "Project" ,(bound-and-true-p menu-bar-project-menu))) - (defvar project-mode-line-map (let ((map (make-sparse-keymap))) - (define-key map [mode-line down-mouse-1] project-menu-entry) + (define-key map [mode-line down-mouse-1] + (bound-and-true-p menu-bar-project-item)) map)) (defvar project-mode-line-face nil diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index a65943a48eb..97f08a79ccd 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -1148,7 +1148,7 @@ line and comments can also be enclosed in /* ... */. If an optional argument SYSTEM is non-nil, set up mode for the given system. To find out what version of Prolog mode you are running, enter -`\\[prolog-mode-version]'. +\\[prolog-mode-version]. Commands: \\{prolog-mode-map}" @@ -1268,7 +1268,7 @@ imitating normal Unix input editing. \\[comint-quit-subjob] sends quit signal, likewise. To find out what version of Prolog mode you are running, enter -`\\[prolog-mode-version]'." +\\[prolog-mode-version]." (require 'compile) (setq comint-input-filter 'prolog-input-filter) (setq mode-line-process '(": %s")) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 1148da11a06..8279617b6e7 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -5,7 +5,7 @@ ;; Author: Fabián E. Gallina <fgallina@gnu.org> ;; URL: https://github.com/fgallina/python.el ;; Version: 0.28 -;; Package-Requires: ((emacs "24.4") (compat "28.1.2.1") (seq "2.23")) +;; Package-Requires: ((emacs "24.4") (compat "29.1.1.0") (seq "2.23")) ;; Maintainer: emacs-devel@gnu.org ;; Created: Jul 2010 ;; Keywords: languages @@ -128,9 +128,9 @@ ;; receiving escape sequences (with some limitations, i.e. completion ;; in blocks does not work). The code executed for the "fallback" ;; completion can be found in `python-shell-completion-setup-code' and -;; `python-shell-completion-string-code' variables. Their default -;; values enable completion for both CPython and IPython, and probably -;; any readline based shell (it's known to work with PyPy). If your +;; `python-shell-completion-get-completions'. Their default values +;; enable completion for both CPython and IPython, and probably any +;; readline based shell (it's known to work with PyPy). If your ;; Python installation lacks readline (like CPython for Windows), ;; installing pyreadline (URL `https://ipython.org/pyreadline.html') ;; should suffice. To troubleshoot why you are not getting any @@ -141,6 +141,12 @@ ;; If you see an error, then you need to either install pyreadline or ;; setup custom code that avoids that dependency. +;; By default, the "native" completion uses the built-in rlcompleter. +;; To use other readline completer (e.g. Jedi) or a custom one, you just +;; need to set it in the PYTHONSTARTUP file. You can set an +;; Emacs-specific completer by testing the environment variable +;; INSIDE_EMACS. + ;; Shell virtualenv support: The shell also contains support for ;; virtualenvs and other special environment modifications thanks to ;; `python-shell-process-environment' and `python-shell-exec-path'. @@ -267,7 +273,7 @@ (eval-when-compile (require 'subr-x)) ;For `string-empty-p' and `string-join'. (require 'treesit) (require 'pcase) -(require 'compat nil 'noerror) +(require 'compat) (require 'project nil 'noerror) (require 'seq) @@ -909,6 +915,7 @@ is used to limit the scan." "Put `syntax-table' property correctly on single/triple quotes." (let* ((ppss (save-excursion (backward-char 3) (syntax-ppss))) (string-start (and (eq t (nth 3 ppss)) (nth 8 ppss))) + (string-literal-concat (numberp (nth 3 ppss))) (quote-starting-pos (- (point) 3)) (quote-ending-pos (point))) (cond ((or (nth 4 ppss) ;Inside a comment @@ -921,6 +928,8 @@ is used to limit the scan." ((nth 5 ppss) ;; The first quote is escaped, so it's not part of a triple quote! (goto-char (1+ quote-starting-pos))) + ;; Handle string literal concatenation (bug#45897) + (string-literal-concat nil) ((null string-start) ;; This set of quotes delimit the start of a string. Put ;; string fence syntax on last quote. (bug#49518) @@ -1117,7 +1126,7 @@ fontified." (defun python--treesit-fontify-union-types (node override start end &optional type-regex &rest _) "Fontify nested union types in the type hints. -For examlpe, Lvl1 | Lvl2[Lvl3[Lvl4[Lvl5 | None]], Lvl2]. This +For example, Lvl1 | Lvl2[Lvl3[Lvl4[Lvl5 | None]], Lvl2]. This structure is represented via nesting binary_operator and subscript nodes. This function iterates over all levels and highlight identifier nodes. If TYPE-REGEX is not nil fontify type @@ -1275,7 +1284,7 @@ fontified." (subscript (identifier) @font-lock-type-face) (subscript (attribute attribute: (identifier) @font-lock-type-face))])) - ;; Patern matching: case [str(), pack0.Type0()]. Take only the + ;; Pattern matching: case [str(), pack0.Type0()]. Take only the ;; last identifier. (class_pattern (dotted_name (identifier) @font-lock-type-face :anchor)) @@ -1359,15 +1368,15 @@ For NODE, OVERRIDE, START, END, and ARGS, see (save-excursion (goto-char start) (while (re-search-forward (rx (or "\"\"\"" "'''")) end t) - (let ((node (treesit-node-at (point)))) - ;; The triple quotes surround a non-empty string. - (when (equal (treesit-node-type node) "string_content") - (let ((start (treesit-node-start node)) - (end (treesit-node-end node))) - (put-text-property (1- start) start - 'syntax-table (string-to-syntax "|")) - (put-text-property end (min (1+ end) (point-max)) - 'syntax-table (string-to-syntax "|")))))))) + (let ((node (treesit-node-at (- (point) 3)))) + ;; Handle triple-quoted strings. + (pcase (treesit-node-type node) + ("string_start" + (put-text-property (1- (point)) (point) + 'syntax-table (string-to-syntax "|"))) + ("string_end" + (put-text-property (- (point) 3) (- (point) 2) + 'syntax-table (string-to-syntax "|")))))))) ;;; Indentation @@ -3512,6 +3521,16 @@ eventually provide a shell." :version "25.1" :type 'hook) +(defconst python-shell-setup-code + "\ +try: + import tty +except ImportError: + pass +else: + tty.setraw(0)" + "Code used to setup the inferior Python processes.") + (defconst python-shell-eval-setup-code "\ def __PYTHON_EL_eval(source, filename): @@ -3577,10 +3596,12 @@ The coding cookie regexp is specified in PEP 263.") (format "exec(%s)\n" (python-shell--encode-string string)))))) ;; Bootstrap: the normal definition of `python-shell-send-string' ;; depends on the Python code sent here. + (python-shell-send-string-no-output python-shell-setup-code) (python-shell-send-string-no-output python-shell-eval-setup-code) (python-shell-send-string-no-output python-shell-eval-file-setup-code)) (with-current-buffer (current-buffer) (let ((inhibit-quit nil)) + (python-shell-readline-detect) (run-hooks 'python-shell-first-prompt-hook)))))) output) @@ -3601,7 +3622,6 @@ interpreter is run. Variables `python-shell-prompt-block-regexp', `python-shell-font-lock-enable', `python-shell-completion-setup-code', -`python-shell-completion-string-code', `python-eldoc-setup-code', `python-ffap-setup-code' can customize this mode for different Python interpreters. @@ -4241,8 +4261,9 @@ def __PYTHON_EL_get_completions(text): completions = [] completer = None + import json try: - import readline + import readline, re try: import __builtin__ @@ -4253,16 +4274,29 @@ def __PYTHON_EL_get_completions(text): is_ipython = ('__IPYTHON__' in builtins or '__IPYTHON__active' in builtins) - splits = text.split() - is_module = splits and splits[0] in ('from', 'import') - - if is_ipython and is_module: - from IPython.core.completerlib import module_completion - completions = module_completion(text.strip()) - elif is_ipython and '__IP' in builtins: - completions = __IP.complete(text) - elif is_ipython and 'get_ipython' in builtins: - completions = get_ipython().Completer.all_completions(text) + + if is_ipython and 'get_ipython' in builtins: + def filter_c(prefix, c): + if re.match('_+(i?[0-9]+)?$', c): + return False + elif c[0] == '%' and not re.match('[%a-zA-Z]+$', prefix): + return False + return True + + import IPython + try: + if IPython.version_info[0] >= 6: + from IPython.core.completer import provisionalcompleter + with provisionalcompleter(): + completions = [ + [c.text, c.start, c.end, c.type or '?', c.signature or ''] + for c in get_ipython().Completer.completions(text, len(text)) + if filter_c(text, c.text)] + else: + part, matches = get_ipython().Completer.complete(line_buffer=text) + completions = [text + m[len(part):] for m in matches if filter_c(text, m)] + except: + pass else: # Try to reuse current completer. completer = readline.get_completer() @@ -4285,7 +4319,7 @@ def __PYTHON_EL_get_completions(text): finally: if getattr(completer, 'PYTHON_EL_WRAPPED', False): completer.print_mode = True - return completions" + return json.dumps(completions)" "Code used to setup completion in inferior Python processes." :type 'string) @@ -4326,6 +4360,26 @@ When a match is found, native completion is disabled." :version "25.1" :type 'float) +(defvar python-shell-readline-completer-delims nil + "Word delimiters used by the readline completer. +It is automatically set by Python shell. An empty string means no +characters are considered delimiters and the readline completion +considers the entire line of input. A value of nil means the Python +shell has no readline support.") + +(defun python-shell-readline-detect () + "Detect the readline support for Python shell completion." + (let* ((process (python-shell-get-process)) + (output (python-shell-send-string-no-output " +try: + import readline + print(readline.get_completer_delims()) +except: + print('No readline support')" process))) + (setq-local python-shell-readline-completer-delims + (unless (string-search "No readline support" output) + (string-trim-right output))))) + (defvar python-shell-completion-native-redirect-buffer " *Python completions redirect*" "Buffer to be used to redirect output of readline commands.") @@ -4492,21 +4546,15 @@ With argument MSG show activation/deactivation message." (cond ((python-shell-completion-native-interpreter-disabled-p) (python-shell-completion-native-turn-off msg)) - ((python-shell-completion-native-setup) + ((and python-shell-readline-completer-delims + (python-shell-completion-native-setup)) (when msg (message "Shell native completion is enabled."))) - (t (lwarn - '(python python-shell-completion-native-turn-on-maybe) - :warning - (concat - "Your `python-shell-interpreter' doesn't seem to " - "support readline, yet `python-shell-completion-native-enable' " - (format "was t and %S is not part of the " - (file-name-nondirectory python-shell-interpreter)) - "`python-shell-completion-native-disabled-interpreters' " - "list. Native completions have been disabled locally. " - "Consider installing the python package \"readline\". ")) - (python-shell-completion-native-turn-off msg)))))) + (t + (when msg + (message (concat "Python does not use GNU readline;" + " no completion in multi-line commands."))) + (python-shell-completion-native-turn-off nil)))))) (defun python-shell-completion-native-turn-on-maybe-with-msg () "Like `python-shell-completion-native-turn-on-maybe' but force messages." @@ -4531,6 +4579,8 @@ With argument MSG show activation/deactivation message." (let* ((original-filter-fn (process-filter process)) (redirect-buffer (get-buffer-create python-shell-completion-native-redirect-buffer)) + (sep (if (string= python-shell-readline-completer-delims "") + "[\n\r]+" "[ \f\t\n\r\v()]+")) (trigger "\t") (new-input (concat input trigger)) (input-length @@ -4573,28 +4623,80 @@ With argument MSG show activation/deactivation message." process python-shell-completion-native-output-timeout comint-redirect-finished-regexp) (re-search-backward "0__dummy_completion__" nil t) - (cl-remove-duplicates - (split-string - (buffer-substring-no-properties - (line-beginning-position) (point-min)) - "[ \f\t\n\r\v()]+" t) - :test #'string=)))) + (let ((str (buffer-substring-no-properties + (line-beginning-position) (point-min)))) + ;; The readline completer is allowed to return a list + ;; of (text start end type signature) as a JSON + ;; string. See the return value for IPython in + ;; `python-shell-completion-setup-code'. + (if (string= "[" (substring str 0 1)) + (condition-case nil + (python--parse-json-array str) + (t (cl-remove-duplicates (split-string str sep t) + :test #'string=))) + (cl-remove-duplicates (split-string str sep t) + :test #'string=)))))) (set-process-filter process original-filter-fn))))) (defun python-shell-completion-get-completions (process input) "Get completions of INPUT using PROCESS." (with-current-buffer (process-buffer process) - (let ((completions - (python-util-strip-string - (python-shell-send-string-no-output - (format - "%s\nprint(';'.join(__PYTHON_EL_get_completions(%s)))" + (python--parse-json-array + (python-shell-send-string-no-output + (format "%s\nprint(__PYTHON_EL_get_completions(%s))" python-shell-completion-setup-code (python-shell--encode-string input)) - process)))) - (when (> (length completions) 2) - (split-string completions - "^'\\|^\"\\|;\\|'$\\|\"$" t))))) + process)))) + +(defun python-shell--get-multiline-input () + "Return lines at a multi-line input in Python shell." + (save-excursion + (let ((p (point)) lines) + (when (progn + (beginning-of-line) + (looking-back python-shell-prompt-block-regexp (pos-bol))) + (push (buffer-substring-no-properties (point) p) lines) + (while (progn (comint-previous-prompt 1) + (looking-back python-shell-prompt-block-regexp (pos-bol))) + (push (buffer-substring-no-properties (point) (pos-eol)) lines)) + (push (buffer-substring-no-properties (point) (pos-eol)) lines)) + lines))) + +(defun python-shell--extra-completion-context () + "Get extra completion context of current input in Python shell." + (let ((lines (python-shell--get-multiline-input)) + (python-indent-guess-indent-offset nil)) + (when (not (zerop (length lines))) + (with-temp-buffer + (delay-mode-hooks + (insert (string-join lines "\n")) + (python-mode) + (python-shell-completion-extra-context)))))) + +(defun python-shell-completion-extra-context (&optional pos) + "Get extra completion context at position POS in Python buffer. +If optional argument POS is nil, use current position. + +Readline completers could use current line as the completion +context, which may be insufficient. In this function, extra +context (e.g. multi-line function call) is found and reformatted +as one line, which is required by native completion." + (let (bound p) + (save-excursion + (and pos (goto-char pos)) + (setq bound (pos-bol)) + (python-nav-up-list -1) + (when (and (< (point) bound) + (or + (looking-back + (python-rx (group (+ (or "." symbol-name)))) (pos-bol) t) + (progn + (forward-line 0) + (looking-at "^[ \t]*\\(from \\)")))) + (setq p (match-beginning 1)))) + (when p + (replace-regexp-in-string + "\n[ \t]*" "" (buffer-substring-no-properties p (1- bound)))))) (defvar-local python-shell--capf-cache nil "Variable to store cached completions and invalidation keys.") @@ -4609,21 +4711,27 @@ using that one instead of current buffer's process." ;; Working on a shell buffer: use prompt end. (cdr (python-util-comint-last-prompt)) (line-beginning-position))) - (import-statement - (when (string-match-p - (rx (* space) word-start (or "from" "import") word-end space) - (buffer-substring-no-properties line-start (point))) - (buffer-substring-no-properties line-start (point)))) + (no-delims + (and (not (if is-shell-buffer + (eq 'font-lock-comment-face + (get-text-property (1- (point)) 'face)) + (python-syntax-context 'comment))) + (with-current-buffer (process-buffer process) + (if python-shell-completion-native-enable + (string= python-shell-readline-completer-delims "") + (or (string-match-p "ipython[23]?\\'" python-shell-interpreter) + (equal python-shell-readline-completer-delims "")))))) (start (if (< (point) line-start) (point) (save-excursion - (if (not (re-search-backward - (python-rx - (or whitespace open-paren close-paren - string-delimiter simple-operator)) - line-start - t 1)) + (if (or no-delims + (not (re-search-backward + (python-rx + (or whitespace open-paren close-paren + string-delimiter simple-operator)) + line-start + t 1))) line-start (forward-char (length (match-string-no-properties 0))) (point))))) @@ -4663,18 +4771,56 @@ using that one instead of current buffer's process." (t #'python-shell-completion-native-get-completions)))) (prev-prompt (car python-shell--capf-cache)) (re (or (cadr python-shell--capf-cache) regexp-unmatchable)) - (prefix (buffer-substring-no-properties start end))) + (prefix (buffer-substring-no-properties start end)) + (prefix-offset 0) + (extra-context (when no-delims + (if is-shell-buffer + (python-shell--extra-completion-context) + (python-shell-completion-extra-context)))) + (extra-offset (length extra-context))) + (unless (zerop extra-offset) + (setq prefix (concat extra-context prefix))) ;; To invalidate the cache, we check if the prompt position or the ;; completion prefix changed. (unless (and (equal prev-prompt (car prompt-boundaries)) - (string-match re prefix)) + (string-match re prefix) + (setq prefix-offset (- (length prefix) (match-end 1)))) (setq python-shell--capf-cache `(,(car prompt-boundaries) ,(if (string-empty-p prefix) regexp-unmatchable - (concat "\\`" (regexp-quote prefix) "\\(?:\\sw\\|\\s_\\)*\\'")) - ,@(funcall completion-fn process (or import-statement prefix))))) - (list start end (cddr python-shell--capf-cache)))) + (concat "\\`\\(" (regexp-quote prefix) "\\)\\(?:\\sw\\|\\s_\\)*\\'")) + ,@(funcall completion-fn process prefix)))) + (let ((cands (cddr python-shell--capf-cache))) + (cond + ((stringp (car cands)) + (if no-delims + ;; Reduce completion candidates due to long prefix. + (if-let ((Lp (length prefix)) + ((string-match "\\(\\sw\\|\\s_\\)+\\'" prefix)) + (L (match-beginning 0))) + ;; If extra-offset is not zero: + ;; start end + ;; o------------------o---------o-------o + ;; |<- extra-offset ->| + ;; |<----------- L ------------>| + ;; new-start + (list (+ start L (- extra-offset)) end + (mapcar (lambda (s) (substring s L)) cands)) + (list end end (mapcar (lambda (s) (substring s Lp)) cands))) + (list start end cands))) + ;; python-shell-completion(-native)-get-completions may produce a + ;; list of (text start end type signature) for completion. + ((consp (car cands)) + (list (+ start (nth 1 (car cands)) (- extra-offset)) + ;; Candidates may be cached, so the end position should + ;; be adjusted according to current completion prefix. + (+ start (nth 2 (car cands)) (- extra-offset) prefix-offset) + cands + :annotation-function + (lambda (c) (concat " " (nth 3 (assoc c cands)))) + :company-docsig + (lambda (c) (nth 4 (assoc c cands))))))))) (define-obsolete-function-alias 'python-shell-completion-complete-at-point @@ -6260,7 +6406,9 @@ point's current `syntax-ppss'." counter))) (python-util-forward-comment -1) (python-nav-beginning-of-statement) - (cond ((bobp)) + (cond ((and (bobp) (save-excursion + (python-util-forward-comment) + (looking-at-p re)))) ((python-info-assignment-statement-p) t) ((python-info-looking-at-beginning-of-defun)) (t nil)))))) @@ -6995,6 +7143,8 @@ implementations: `python-mode' and `python-ts-mode'." (add-to-list 'auto-mode-alist '("\\.py[iw]?\\'" . python-ts-mode)) (add-to-list 'interpreter-mode-alist '("python[0-9.]*" . python-ts-mode)))) +(derived-mode-add-parents 'python-ts-mode '(python-mode)) + ;;; Completion predicates for M-x ;; Commands that only make sense when editing Python code. (dolist (sym '(python-add-import diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el index 598eaa461ff..7133cb0b5b0 100644 --- a/lisp/progmodes/ruby-ts-mode.el +++ b/lisp/progmodes/ruby-ts-mode.el @@ -1133,6 +1133,7 @@ leading double colon is not added." "singleton_class" "module" "method" + "singleton_method" "array" "hash" "parenthesized_statements" @@ -1178,6 +1179,19 @@ leading double colon is not added." ;; Imenu. (setq-local imenu-create-index-function #'ruby-ts--imenu) + ;; Outline minor mode. + (setq-local treesit-outline-predicate + (rx bos (or "singleton_method" + "method" + "alias" + "class" + "module") + eos)) + ;; Restore default values of outline variables + ;; to use `treesit-outline-predicate'. + (kill-local-variable 'outline-regexp) + (kill-local-variable 'outline-level) + (setq-local treesit-simple-indent-rules (ruby-ts--indent-rules)) ;; Font-lock. @@ -1196,19 +1210,11 @@ leading double colon is not added." (setq-local syntax-propertize-function #'ruby-ts--syntax-propertize)) +(derived-mode-add-parents 'ruby-ts-mode '(ruby-mode)) + (if (treesit-ready-p 'ruby) - ;; Copied from ruby-mode.el. - (add-to-list 'auto-mode-alist - (cons (concat "\\(?:\\.\\(?:" - "rbw?\\|ru\\|rake\\|thor" - "\\|jbuilder\\|rabl\\|gemspec\\|podspec" - "\\)" - "\\|/" - "\\(?:Gem\\|Rake\\|Cap\\|Thor" - "\\|Puppet\\|Berks\\|Brew" - "\\|Vagrant\\|Guard\\|Pod\\)file" - "\\)\\'") - 'ruby-ts-mode))) + (add-to-list 'major-mode-remap-defaults + '(ruby-mode . ruby-ts-mode))) (provide 'ruby-ts-mode) diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el index c5fc57cc374..c67ac43e4d0 100644 --- a/lisp/progmodes/rust-ts-mode.el +++ b/lisp/progmodes/rust-ts-mode.el @@ -474,6 +474,8 @@ See `prettify-symbols-compose-predicate'." (treesit-major-mode-setup))) +(derived-mode-add-parents 'rust-ts-mode '(rust-mode)) + (if (treesit-ready-p 'rust) (add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-ts-mode))) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 0562415b4e5..ab95dc9f924 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1054,7 +1054,8 @@ subshells can nest." ;; a normal command rather than the real `in' keyword. ;; I.e. we should look back to try and find the ;; corresponding `case'. - (and (looking-at ";\\(?:;&?\\|[&|]\\)\\|\\_<in") + ;; Also recognize OpenBSD's case X { ... } (bug#55764). + (and (looking-at ";\\(?:;&?\\|[&|]\\)\\|\\_<in\\|.{") ;; ";; esac )" is a case that looks ;; like a case-pattern but it's really just a close ;; paren after a case statement. I.e. if we skipped @@ -1638,6 +1639,8 @@ not written in Bash or sh." (setq-local treesit-defun-type-regexp "function_definition") (treesit-major-mode-setup))) +(derived-mode-add-parents 'bash-ts-mode '(sh-mode)) + (advice-add 'bash-ts-mode :around #'sh--redirect-bash-ts-mode ;; Give it lower precedence than normal advice, so other ;; advices take precedence over it. @@ -2057,9 +2060,9 @@ May return nil if the line should not be treated as continued." (sh-var-value 'sh-indent-for-case-label))) (`(:before . ,(or "(" "{" "[" "while" "if" "for" "case")) (cond - ((and (equal token "{") (smie-rule-parent-p "for")) + ((and (equal token "{") (smie-rule-parent-p "for" "case")) (let ((data (smie-backward-sexp "in"))) - (when (equal (nth 2 data) "for") + (when (member (nth 2 data) '("for" "case")) `(column . ,(smie-indent-virtual))))) ((not (smie-rule-prev-p "&&" "||" "|")) (when (smie-rule-hanging-p) @@ -2303,7 +2306,7 @@ Point should be before the newline." When used interactively, insert the proper starting #!-line, and make the visited file executable via `executable-set-magic', perhaps querying depending on the value of `executable-query'. -(If given a prefix (i.e., `\\[universal-argument]') don't insert any starting #! +(If given a prefix (i.e., \\[universal-argument]) don't insert any starting #! line.) When this function is called noninteractively, INSERT-FLAG (the third diff --git a/lisp/progmodes/typescript-ts-mode.el b/lisp/progmodes/typescript-ts-mode.el index e9c6afff440..ab1d76ab20e 100644 --- a/lisp/progmodes/typescript-ts-mode.el +++ b/lisp/progmodes/typescript-ts-mode.el @@ -124,6 +124,7 @@ Argument LANGUAGE is either `typescript' or `tsx'." ((parent-is "object_type") parent-bol typescript-ts-mode-indent-offset) ((parent-is "enum_body") parent-bol typescript-ts-mode-indent-offset) ((parent-is "class_body") parent-bol typescript-ts-mode-indent-offset) + ((parent-is "interface_body") parent-bol typescript-ts-mode-indent-offset) ((parent-is "arrow_function") parent-bol typescript-ts-mode-indent-offset) ((parent-is "parenthesized_expression") parent-bol typescript-ts-mode-indent-offset) ((parent-is "binary_expression") parent-bol typescript-ts-mode-indent-offset) @@ -199,183 +200,197 @@ Argument LANGUAGE is either `typescript' or `tsx'." [(nested_identifier (identifier)) (identifier)] @typescript-ts-jsx-tag-face))))) +(defun tsx-ts-mode--font-lock-compatibility-function-expression (language) + "Handle tree-sitter grammar breaking change for `function' expression. + +LANGUAGE can be `typescript' or `tsx'. Starting from version 0.20.4 of the +typescript/tsx grammar, `function' becomes `function_expression'." + (condition-case nil + (progn (treesit-query-capture language '((function_expression) @cap)) + ;; New version of the grammar + 'function_expression) + (treesit-query-error + ;; Old version of the grammar + 'function))) + (defun typescript-ts-mode--font-lock-settings (language) "Tree-sitter font-lock settings. Argument LANGUAGE is either `typescript' or `tsx'." - (treesit-font-lock-rules - :language language - :feature 'comment - `([(comment) (hash_bang_line)] @font-lock-comment-face) - - :language language - :feature 'constant - `(((identifier) @font-lock-constant-face - (:match "\\`[A-Z_][0-9A-Z_]*\\'" @font-lock-constant-face)) - [(true) (false) (null)] @font-lock-constant-face) - - :language language - :feature 'keyword - `([,@typescript-ts-mode--keywords] @font-lock-keyword-face - [(this) (super)] @font-lock-keyword-face) - - :language language - :feature 'string - `((regex pattern: (regex_pattern)) @font-lock-regexp-face - (string) @font-lock-string-face - (template_string) @js--fontify-template-string - (template_substitution ["${" "}"] @font-lock-misc-punctuation-face)) - - :language language - :override t ;; for functions assigned to variables - :feature 'declaration - `((function - name: (identifier) @font-lock-function-name-face) - (function_declaration - name: (identifier) @font-lock-function-name-face) - (function_signature - name: (identifier) @font-lock-function-name-face) - - (method_definition - name: (property_identifier) @font-lock-function-name-face) - (method_signature - name: (property_identifier) @font-lock-function-name-face) - (required_parameter (identifier) @font-lock-variable-name-face) - (optional_parameter (identifier) @font-lock-variable-name-face) - - (variable_declarator - name: (identifier) @font-lock-function-name-face - value: [(function) (arrow_function)]) - - (variable_declarator - name: (identifier) @font-lock-variable-name-face) - - (enum_declaration (identifier) @font-lock-type-face) - - (extends_clause value: (identifier) @font-lock-type-face) - ;; extends React.Component<T> - (extends_clause value: (member_expression - object: (identifier) @font-lock-type-face - property: (property_identifier) @font-lock-type-face)) - - (arrow_function - parameter: (identifier) @font-lock-variable-name-face) - - (variable_declarator - name: (array_pattern - (identifier) - (identifier) @font-lock-function-name-face) - value: (array (number) (function))) - - (catch_clause - parameter: (identifier) @font-lock-variable-name-face) - - ;; full module imports - (import_clause (identifier) @font-lock-variable-name-face) - ;; named imports with aliasing - (import_clause (named_imports (import_specifier - alias: (identifier) @font-lock-variable-name-face))) - ;; named imports without aliasing - (import_clause (named_imports (import_specifier - !alias - name: (identifier) @font-lock-variable-name-face))) - - ;; full namespace import (* as alias) - (import_clause (namespace_import (identifier) @font-lock-variable-name-face))) - - :language language - :feature 'identifier - `((nested_type_identifier - module: (identifier) @font-lock-type-face) - - (type_identifier) @font-lock-type-face - - (predefined_type) @font-lock-type-face - - (new_expression - constructor: (identifier) @font-lock-type-face) - - (enum_body (property_identifier) @font-lock-type-face) - - (enum_assignment name: (property_identifier) @font-lock-type-face) - - (variable_declarator - name: (identifier) @font-lock-variable-name-face) - - (for_in_statement - left: (identifier) @font-lock-variable-name-face) - - (arrow_function - parameters: - [(_ (identifier) @font-lock-variable-name-face) - (_ (_ (identifier) @font-lock-variable-name-face)) - (_ (_ (_ (identifier) @font-lock-variable-name-face)))])) - - :language language - :feature 'property - `((property_signature - name: (property_identifier) @font-lock-property-name-face) - (public_field_definition - name: (property_identifier) @font-lock-property-name-face) - - (pair key: (property_identifier) @font-lock-property-use-face) - - ((shorthand_property_identifier) @font-lock-property-use-face)) - - :language language - :feature 'expression - '((assignment_expression - left: [(identifier) @font-lock-function-name-face - (member_expression - property: (property_identifier) @font-lock-function-name-face)] - right: [(function) (arrow_function)])) - - :language language - :feature 'function - '((call_expression - function: - [(identifier) @font-lock-function-call-face - (member_expression - property: (property_identifier) @font-lock-function-call-face)])) - - :language language - :feature 'pattern - `((pair_pattern - key: (property_identifier) @font-lock-property-use-face - value: [(identifier) @font-lock-variable-name-face - (assignment_pattern left: (identifier) @font-lock-variable-name-face)]) - - (array_pattern (identifier) @font-lock-variable-name-face) - - ((shorthand_property_identifier_pattern) @font-lock-variable-name-face)) - - :language language - :feature 'jsx - (append (tsx-ts-mode--font-lock-compatibility-bb1f97b language) - `((jsx_attribute (property_identifier) @typescript-ts-jsx-attribute-face))) - - :language language - :feature 'number - `((number) @font-lock-number-face - ((identifier) @font-lock-number-face - (:match "\\`\\(?:NaN\\|Infinity\\)\\'" @font-lock-number-face))) - - :language language - :feature 'operator - `([,@typescript-ts-mode--operators] @font-lock-operator-face - (ternary_expression ["?" ":"] @font-lock-operator-face)) - - :language language - :feature 'bracket - '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face) - - :language language - :feature 'delimiter - '((["," "." ";" ":"]) @font-lock-delimiter-face) - - :language language - :feature 'escape-sequence - :override t - '((escape_sequence) @font-lock-escape-face))) + (let ((func-exp (tsx-ts-mode--font-lock-compatibility-function-expression language))) + (treesit-font-lock-rules + :language language + :feature 'comment + `([(comment) (hash_bang_line)] @font-lock-comment-face) + + :language language + :feature 'constant + `(((identifier) @font-lock-constant-face + (:match "\\`[A-Z_][0-9A-Z_]*\\'" @font-lock-constant-face)) + [(true) (false) (null)] @font-lock-constant-face) + + :language language + :feature 'keyword + `([,@typescript-ts-mode--keywords] @font-lock-keyword-face + [(this) (super)] @font-lock-keyword-face) + + :language language + :feature 'string + `((regex pattern: (regex_pattern)) @font-lock-regexp-face + (string) @font-lock-string-face + (template_string) @js--fontify-template-string + (template_substitution ["${" "}"] @font-lock-misc-punctuation-face)) + + :language language + :override t ;; for functions assigned to variables + :feature 'declaration + `((,func-exp + name: (identifier) @font-lock-function-name-face) + (function_declaration + name: (identifier) @font-lock-function-name-face) + (function_signature + name: (identifier) @font-lock-function-name-face) + + (method_definition + name: (property_identifier) @font-lock-function-name-face) + (method_signature + name: (property_identifier) @font-lock-function-name-face) + (required_parameter (identifier) @font-lock-variable-name-face) + (optional_parameter (identifier) @font-lock-variable-name-face) + + (variable_declarator + name: (identifier) @font-lock-function-name-face + value: [(,func-exp) (arrow_function)]) + + (variable_declarator + name: (identifier) @font-lock-variable-name-face) + + (enum_declaration (identifier) @font-lock-type-face) + + (extends_clause value: (identifier) @font-lock-type-face) + ;; extends React.Component<T> + (extends_clause value: (member_expression + object: (identifier) @font-lock-type-face + property: (property_identifier) @font-lock-type-face)) + + (arrow_function + parameter: (identifier) @font-lock-variable-name-face) + + (variable_declarator + name: (array_pattern + (identifier) + (identifier) @font-lock-function-name-face) + value: (array (number) (,func-exp))) + + (catch_clause + parameter: (identifier) @font-lock-variable-name-face) + + ;; full module imports + (import_clause (identifier) @font-lock-variable-name-face) + ;; named imports with aliasing + (import_clause (named_imports (import_specifier + alias: (identifier) @font-lock-variable-name-face))) + ;; named imports without aliasing + (import_clause (named_imports (import_specifier + !alias + name: (identifier) @font-lock-variable-name-face))) + + ;; full namespace import (* as alias) + (import_clause (namespace_import (identifier) @font-lock-variable-name-face))) + + :language language + :feature 'identifier + `((nested_type_identifier + module: (identifier) @font-lock-type-face) + + (type_identifier) @font-lock-type-face + + (predefined_type) @font-lock-type-face + + (new_expression + constructor: (identifier) @font-lock-type-face) + + (enum_body (property_identifier) @font-lock-type-face) + + (enum_assignment name: (property_identifier) @font-lock-type-face) + + (variable_declarator + name: (identifier) @font-lock-variable-name-face) + + (for_in_statement + left: (identifier) @font-lock-variable-name-face) + + (arrow_function + parameters: + [(_ (identifier) @font-lock-variable-name-face) + (_ (_ (identifier) @font-lock-variable-name-face)) + (_ (_ (_ (identifier) @font-lock-variable-name-face)))])) + + :language language + :feature 'property + `((property_signature + name: (property_identifier) @font-lock-property-name-face) + (public_field_definition + name: (property_identifier) @font-lock-property-name-face) + + (pair key: (property_identifier) @font-lock-property-use-face) + + ((shorthand_property_identifier) @font-lock-property-use-face)) + + :language language + :feature 'expression + `((assignment_expression + left: [(identifier) @font-lock-function-name-face + (member_expression + property: (property_identifier) @font-lock-function-name-face)] + right: [(,func-exp) (arrow_function)])) + + :language language + :feature 'function + '((call_expression + function: + [(identifier) @font-lock-function-call-face + (member_expression + property: (property_identifier) @font-lock-function-call-face)])) + + :language language + :feature 'pattern + `((pair_pattern + key: (property_identifier) @font-lock-property-use-face + value: [(identifier) @font-lock-variable-name-face + (assignment_pattern left: (identifier) @font-lock-variable-name-face)]) + + (array_pattern (identifier) @font-lock-variable-name-face) + + ((shorthand_property_identifier_pattern) @font-lock-variable-name-face)) + + :language language + :feature 'jsx + (append (tsx-ts-mode--font-lock-compatibility-bb1f97b language) + `((jsx_attribute (property_identifier) @typescript-ts-jsx-attribute-face))) + + :language language + :feature 'number + `((number) @font-lock-number-face + ((identifier) @font-lock-number-face + (:match "\\`\\(?:NaN\\|Infinity\\)\\'" @font-lock-number-face))) + + :language language + :feature 'operator + `([,@typescript-ts-mode--operators] @font-lock-operator-face + (ternary_expression ["?" ":"] @font-lock-operator-face)) + + :language language + :feature 'bracket + '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face) + + :language language + :feature 'delimiter + '((["," "." ";" ":"]) @font-lock-delimiter-face) + + :language language + :feature 'escape-sequence + :override t + '((escape_sequence) @font-lock-escape-face)))) (defvar typescript-ts-mode--sentence-nodes '("import_statement" @@ -491,6 +506,8 @@ This mode is intended to be inherited by concrete major modes." (treesit-major-mode-setup))) +(derived-mode-add-parents 'typescript-ts-mode '(typescript-mode)) + (if (treesit-ready-p 'typescript) (add-to-list 'auto-mode-alist '("\\.ts\\'" . typescript-ts-mode))) @@ -548,6 +565,8 @@ at least 3 (which is the default value)." (treesit-major-mode-setup))) +(derived-mode-add-parents 'tsx-ts-mode '(tsx-mode)) + (defvar typescript-ts--s-p-query (when (treesit-available-p) (treesit-query-compile 'typescript diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 6081372af33..a83bad0e8ed 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -9,7 +9,7 @@ ;; Keywords: languages ;; The "Version" is the date followed by the decimal rendition of the Git ;; commit hex. -;; Version: 2023.06.06.141322628 +;; Version: 2024.03.01.121933719 ;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this ;; file on 19/3/2008, and the maintainer agreed that when a bug is @@ -124,7 +124,7 @@ ;; ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "2023-06-06-86c6984-vpo-GNU" +(defconst verilog-mode-version "2024-03-01-7448f97-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.") @@ -2556,11 +2556,13 @@ find the errors." (defconst verilog-assignment-operation-re-2 (concat "\\(.*?\\)" verilog-assignment-operator-re)) +;; Loosely related to IEEE 1800's concurrent_assertion_statement +(defconst verilog-concurrent-assertion-statement-re + "\\(\\<\\(assert\\|assume\\|cover\\|restrict\\)\\>\\s-+\\<\\(property\\|sequence\\)\\>\\)\\|\\(\\<assert\\>\\)") + (defconst verilog-label-re (concat verilog-identifier-sym-re "\\s-*:\\s-*")) (defconst verilog-property-re - (concat "\\(" verilog-label-re "\\)?" - ;; "\\(assert\\|assume\\|cover\\)\\s-+property\\>" - "\\(\\(assert\\|assume\\|cover\\)\\>\\s-+\\<property\\>\\)\\|\\(assert\\)")) + (concat "\\(" verilog-label-re "\\)?" verilog-concurrent-assertion-statement-re)) (defconst verilog-no-indent-begin-re (eval-when-compile @@ -2715,7 +2717,6 @@ find the errors." "\\(\\<fork\\>\\)\\|" ; 7 "\\(\\<if\\>\\)\\|" verilog-property-re "\\|" - "\\(\\(" verilog-label-re "\\)?\\<assert\\>\\)\\|" "\\(\\<clocking\\>\\)\\|" "\\(\\<task\\>\\)\\|" "\\(\\<function\\>\\)\\|" @@ -4843,7 +4844,7 @@ Uses `verilog-scan' cache." (not (or (looking-at "\\<") (forward-word-strictly -1))) ;; stop if we see an assertion (perhaps labeled) (and - (looking-at "\\(\\w+\\W*:\\W*\\)?\\(\\<\\(assert\\|assume\\|cover\\)\\>\\s-+\\<property\\>\\)\\|\\(\\<assert\\>\\)") + (looking-at (concat "\\(\\w+\\W*:\\W*\\)?" verilog-concurrent-assertion-statement-re)) (progn (setq h (point)) (save-excursion @@ -4970,7 +4971,7 @@ More specifically, point @ in the line foo : @ begin" (while t (verilog-re-search-backward (concat "\\(\\<module\\>\\)\\|\\(\\<connectmodule\\>\\)\\|\\(\\<randcase\\>\\|\\<case[xz]?\\>[^:]\\)\\|" - "\\(\\<endcase\\>\\)\\>") + "\\(\\<endcase\\>\\)") nil 'move) (cond ((match-end 4) @@ -5010,7 +5011,7 @@ More specifically, after a generate and before an endgenerate." (while (and (/= nest 0) (verilog-re-search-backward - "\\<\\(module\\)\\|\\(connectmodule\\)\\|\\(endmodule\\)\\|\\(generate\\)\\|\\(endgenerate\\)\\|\\(if\\)\\|\\(case\\)\\|\\(for\\)\\>" nil 'move) + "\\<\\(?:\\(module\\)\\|\\(connectmodule\\)\\|\\(endmodule\\)\\|\\(generate\\)\\|\\(endgenerate\\)\\|\\(if\\)\\|\\(case\\)\\|\\(for\\)\\)\\>" nil 'move) (cond ((match-end 1) ; module - we have crawled out (throw 'done 1)) @@ -5038,7 +5039,7 @@ More specifically, after a generate and before an endgenerate." (save-excursion (while (and (/= nest 0) - (verilog-re-search-backward "\\<\\(fork\\)\\|\\(join\\(_any\\|_none\\)?\\)\\>" lim 'move) + (verilog-re-search-backward "\\<\\(?:\\(fork\\)\\|\\(join\\(_any\\|_none\\)?\\)\\)\\>" lim 'move) (cond ((match-end 1) ; fork (setq nest (1- nest))) @@ -5335,7 +5336,7 @@ primitive or interface named NAME." (match-end 3) (goto-char there) (let ((nest 0) - (reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)\\|\\(assert\\)")) + (reg "\\(\\<begin\\>\\)\\|\\(\\<end\\>\\)\\|\\(\\<if\\>\\)\\|\\(\\<assert\\>\\)")) (catch 'skip (while (verilog-re-search-backward reg nil 'move) (cond @@ -5802,7 +5803,7 @@ FILENAME to find directory to run in, or defaults to `buffer-file-name'." (dir (file-name-directory (or filename buffer-file-name))) (cmd (concat "cd " dir "; " command))) (with-output-to-temp-buffer "*Verilog-Preprocessed*" - (with-current-buffer (get-buffer "*Verilog-Preprocessed*") + (with-current-buffer "*Verilog-Preprocessed*" (insert (concat "// " cmd "\n")) (call-process shell-file-name nil t nil shell-command-switch cmd) (verilog-mode) @@ -6244,7 +6245,7 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (match-end 22)) (throw 'continue 'foo)) - ((looking-at "\\<class\\|struct\\|function\\|task\\>") + ((looking-at "\\<\\(?:class\\|struct\\|function\\|task\\)\\>") ;; *sigh* These words have an optional prefix: ;; extern {virtual|protected}? function a(); ;; and we don't want to confuse this with @@ -6268,12 +6269,16 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (throw 'nesting 'defun)))) ;; - ((looking-at "\\<property\\>") + ((looking-at "\\<\\(property\\|sequence\\)\\>") ;; *sigh* - ;; {assert|assume|cover} property (); are complete - ;; and could also be labeled: - foo: assert property - ;; but - ;; property ID () ... needs endproperty + ;; - {assert|assume|cover|restrict} property (); are complete + ;; - cover sequence (); is complete + ;; and could also be labeled: + ;; - foo: assert property + ;; - bar: cover sequence + ;; but: + ;; - property ID () ... needs endproperty + ;; - sequence ID () ... needs endsequence (verilog-beg-of-statement) (if (looking-at verilog-property-re) (throw 'continue 'statement) ; We don't need an endproperty for these @@ -6940,7 +6945,7 @@ Also move point to constraint." (let ( (pt (point)) (pass 0)) (verilog-backward-ws&directives) (verilog-backward-token) - (if (looking-at (concat "\\<constraint\\|coverpoint\\|cross\\|with\\>\\|" verilog-in-constraint-re)) + (if (looking-at (concat "\\<\\(?:constraint\\|coverpoint\\|cross\\|with\\)\\>\\|" verilog-in-constraint-re)) (progn (setq pass 1) (if (looking-at "\\<with\\>") (progn (verilog-backward-ws&directives) @@ -6981,7 +6986,7 @@ Also move point to constraint." (save-excursion (if (and (equal (char-after) ?\{) (verilog-backward-token)) - (looking-at "\\<struct\\|union\\|packed\\|\\(un\\)?signed\\>") + (looking-at "\\<\\(?:struct\\|union\\|packed\\|\\(un\\)?signed\\)\\>") nil))) (defun verilog-at-struct-mv-p () @@ -6989,7 +6994,7 @@ Also move point to constraint." (let ((pt (point))) (if (and (equal (char-after) ?\{) (verilog-backward-token)) - (if (looking-at "\\<struct\\|union\\|packed\\|\\(un\\)?signed\\>") + (if (looking-at "\\<\\(?:struct\\|union\\|packed\\|\\(un\\)?signed\\)\\>") (progn (verilog-beg-of-statement) (point)) (progn (goto-char pt) nil)) (progn (goto-char pt) nil)))) @@ -9675,7 +9680,7 @@ Return an array of [outputs inouts inputs wire reg assign const gparam intf]." (cond ;; {..., a, b} requires us to recurse on a,b ;; To support {#{},{#{a,b}} we'll just split everything on [{},] - ((string-match "^\\s-*{\\(.*\\)}\\s-*$" expr) + ((string-match "^\\s-*'?{\\(.*\\)}\\s-*$" expr) (let ((mlst (split-string (match-string 1 expr) "[{},]")) mstr) (while (setq mstr (pop mlst)) @@ -9755,7 +9760,10 @@ Inserts the list of signals found, using submodi to look up each port." ;; We intentionally ignore (non-escaped) signals with .s in them ;; this prevents AUTOWIRE etc from noticing hierarchical sigs. (when port - (cond ((looking-at "[^\n]*AUTONOHOOKUP")) + (cond ((and verilog-auto-ignore-concat + (looking-at "[({]")) + nil) ; {...} or (...) historically ignored with auto-ignore-concat + ((looking-at "[^\n]*AUTONOHOOKUP")) ((looking-at "\\([a-zA-Z_][a-zA-Z_0-9]*\\)\\s-*)") (verilog-read-sub-decls-sig submoddecls par-values comment port @@ -11436,7 +11444,7 @@ This repairs those mis-inserted by an AUTOARG." (while (string-match (concat "\\([[({:*/<>+-]\\)" ; - must be last "(\\<\\([0-9A-Za-z_]+\\))" - "\\([])}:*/<>+-]\\)") + "\\([])}:*/<>.+-]\\)") out) (setq out (replace-match "\\1\\2\\3" nil nil out))) (while (string-match @@ -11531,7 +11539,8 @@ This repairs those mis-inserted by an AUTOARG." ;;(verilog-simplify-range-expression "[(TEST[1])-1:0]") ;;(verilog-simplify-range-expression "[1<<2:8>>2]") ; [4:2] ;;(verilog-simplify-range-expression "[2*4/(4-2) +2+4 <<4 >>2]") -;;(verilog-simplify-range-expression "[WIDTH*2/8-1:0]") +;;(verilog-simplify-range-expression "[WIDTH*2/8-1:0]") ; "[WIDTH*2/8-1:0]" +;;(verilog-simplify-range-expression "[(FOO).size:0]") ; "[FOO.size:0]" (defun verilog-clog2 (value) "Compute $clog2 - ceiling log2 of VALUE." @@ -12247,18 +12256,12 @@ If PAR-VALUES replace final strings with these parameter values." (vl-memory (verilog-sig-memory port-st)) (vl-mbits (if (verilog-sig-multidim port-st) (verilog-sig-multidim-string port-st) "")) - (vl-bits (if (or (eq verilog-auto-inst-vector t) - (and (eq verilog-auto-inst-vector `unsigned) - (not (verilog-sig-signed port-st))) - (not (assoc port (verilog-decls-get-signals moddecls))) - (not (equal (verilog-sig-bits port-st) - (verilog-sig-bits - (assoc port (verilog-decls-get-signals moddecls)))))) - (or (verilog-sig-bits port-st) "") - "")) + (vl-bits (or (verilog-sig-bits port-st) "")) (case-fold-search nil) (check-values par-values) - tpl-net dflt-bits) + auto-inst-vector + auto-inst-vector-tpl + tpl-net dflt-bits) ;; Replace parameters in bit-width (when (and check-values (not (equal vl-bits ""))) @@ -12281,6 +12284,16 @@ If PAR-VALUES replace final strings with these parameter values." vl-mbits (verilog-simplify-range-expression vl-mbits) vl-memory (when vl-memory (verilog-simplify-range-expression vl-memory)) vl-width (verilog-make-width-expression vl-bits))) ; Not in the loop for speed + (setq auto-inst-vector + (if (or (eq verilog-auto-inst-vector t) + (and (eq verilog-auto-inst-vector `unsigned) + (not (verilog-sig-signed port-st))) + (not (assoc port (verilog-decls-get-signals moddecls))) + (not (equal (verilog-sig-bits port-st) + (verilog-sig-bits + (assoc port (verilog-decls-get-signals moddecls)))))) + vl-bits + "")) ;; Default net value if not found (setq dflt-bits (if (or (and (verilog-sig-bits port-st) (verilog-sig-multidim port-st)) @@ -12290,7 +12303,7 @@ If PAR-VALUES replace final strings with these parameter values." (if vl-memory "." "") (if vl-memory vl-memory "") "*/") - (concat vl-bits)) + (concat auto-inst-vector)) tpl-net (concat port (if (and vl-modport ;; .modport cannot be added if attachment is @@ -12329,10 +12342,21 @@ If PAR-VALUES replace final strings with these parameter values." (if (numberp value) (setq value (number-to-string value))) value)) (substring tpl-net (match-end 0)))))) + ;; Get range based off template net + (setq auto-inst-vector-tpl + (if (or (eq verilog-auto-inst-vector t) + (and (eq verilog-auto-inst-vector `unsigned) + (not (verilog-sig-signed port-st))) + (not (assoc tpl-net (verilog-decls-get-signals moddecls))) + (not (equal (verilog-sig-bits port-st) + (verilog-sig-bits + (assoc tpl-net (verilog-decls-get-signals moddecls)))))) + vl-bits + "")) ;; Replace @ and [] magic variables in final output (setq tpl-net (verilog-string-replace-matches "@" tpl-num nil nil tpl-net)) (setq tpl-net (verilog-string-replace-matches "\\[\\]\\[\\]" dflt-bits nil nil tpl-net)) - (setq tpl-net (verilog-string-replace-matches "\\[\\]" vl-bits nil nil tpl-net))) + (setq tpl-net (verilog-string-replace-matches "\\[\\]" auto-inst-vector-tpl nil nil tpl-net))) ;; Insert it (when (or tpl-ass (not verilog-auto-inst-template-required)) (verilog--auto-inst-first indent-pt section) @@ -12502,7 +12526,7 @@ Typing \\[verilog-auto] will make this into: endmodule Where the list of inputs and outputs came from the inst module. - + Exceptions: Unless you are instantiating a module multiple times, or the module is @@ -12527,7 +12551,7 @@ Exceptions: // Outputs .o (o[31:0])); - + Templates: For multiple instantiations based upon a single template, create a @@ -12598,7 +12622,7 @@ Templates: .ptl_bus (ptl_busnew[3:0]), .... - + Multiple Module Templates: The same template lines can be applied to multiple modules with @@ -12613,7 +12637,7 @@ Multiple Module Templates: */ Note there is only one AUTO_TEMPLATE opening parenthesis. - + @ Templates: It is common to instantiate a cell multiple times, so templates make it @@ -12678,7 +12702,7 @@ Multiple Module Templates: .ptl_mapvalidx (BAR_ptl_mapvalid), .ptl_mapvalidp1x (ptl_mapvalid_BAR)); - + Regexp Templates: A template entry of the form @@ -12702,7 +12726,7 @@ Regexp Templates: subscript: .\\(.*\\)_l (\\1_[]), - + Lisp Templates: First any regular expression template is expanded. @@ -12747,7 +12771,7 @@ Lisp Templates: After the evaluation is completed, @ substitution and [] substitution occur. - + Ignoring Hookup: AUTOWIRE and related AUTOs will read the signals created by a template. @@ -12756,7 +12780,7 @@ Ignoring Hookup: .pci_req_l (pci_req_not_to_wire), //AUTONOHOOKUP - + For more information see the \\[verilog-faq] and forums at URL `https://www.veripool.org'." (save-excursion @@ -12910,7 +12934,7 @@ Typing \\[verilog-auto] will make this into: endmodule Where the list of parameter connections come from the inst module. - + Templates: You can customize the parameter connections using AUTO_TEMPLATEs, diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 060880d7cf2..144bfa944d3 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -457,7 +457,7 @@ If no file name at all is printed out, set both \"File Message\" entries to 0 \(a default file name message will be printed out instead, does not work in XEmacs). -A compiler is selected for syntax analysis (`\\[vhdl-compile]') by +A compiler is selected for syntax analysis (\\[vhdl-compile]) by assigning its name to option `vhdl-compiler'. Please send any missing or erroneous compiler properties to the maintainer for @@ -1106,14 +1106,14 @@ For more information on format strings, see the documentation for the (defcustom vhdl-modify-date-prefix-string "-- Last update: " "Prefix string of modification date in VHDL file header. If actualization of the modification date is called (menu, -`\\[vhdl-template-modify]'), this string is searched and the rest +\\[vhdl-template-modify]), this string is searched and the rest of the line replaced by the current date." :type 'string :group 'vhdl-header) (defcustom vhdl-modify-date-on-saving t "Non-nil means update the modification date when the buffer is saved. -Calls function `\\[vhdl-template-modify]'). +Calls function \\[vhdl-template-modify]). NOTE: Activate the new setting in a VHDL buffer by using the menu entry \"Activate Options\"." @@ -4469,7 +4469,7 @@ Usage: according to option `vhdl-argument-list-indent'. If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of - tabs. `\\[tabify]' and `\\[untabify]' allow the conversion of spaces to + tabs. \\[tabify] and \\[untabify] allow the conversion of spaces to tabs and vice versa. Syntax-based indentation can be very slow in large files. Option @@ -4780,7 +4780,7 @@ Usage: `vhdl-highlight-translate-off' is non-nil. For documentation and customization of the used colors see - customization group `vhdl-highlight-faces' (`\\[customize-group]'). For + customization group `vhdl-highlight-faces' (\\[customize-group]). For highlighting of matching parenthesis, see customization group `paren-showing'. Automatic buffer highlighting is turned on/off by option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs). @@ -4840,14 +4840,14 @@ Usage: sessions using the \"Save Options\" menu entry. Options and their detailed descriptions can also be accessed by using - the \"Customize\" menu entry or the command `\\[customize-option]' - (`\\[customize-group]' for groups). Some customizations only take effect + the \"Customize\" menu entry or the command \\[customize-option] + (\\[customize-group] for groups). Some customizations only take effect after some action (read the NOTE in the option documentation). Customization can also be done globally (i.e. site-wide, read the INSTALL file). Not all options are described in this documentation, so go and see - what other useful user options there are (`\\[vhdl-customize]' or menu)! + what other useful user options there are (\\[vhdl-customize] or menu)! FILE EXTENSIONS: @@ -4876,7 +4876,7 @@ Usage: Maintenance: ------------ -To submit a bug report, enter `\\[vhdl-submit-bug-report]' within VHDL Mode. +To submit a bug report, enter \\[vhdl-submit-bug-report] within VHDL Mode. Add a description of the problem and include a reproducible test case. Questions and enhancement requests can be sent to <reto@gnu.org>. @@ -8398,6 +8398,44 @@ buffer." (message "Updating sensitivity lists...done"))) (when noninteractive (save-buffer))) +(defun vhdl--re2-region (beg-re end-re) + "Return a function searching for a region delimited by a pair of regexps. +BEG-RE and END-RE are the regexps delimiting the region to search for." + (lambda (proc-end) + (when (vhdl-re-search-forward beg-re proc-end t) + (save-excursion + (vhdl-re-search-forward end-re proc-end t))))) + +(defconst vhdl--signal-regions-functions + (list + ;; right-hand side of signal/variable assignment + ;; (special case: "<=" is relational operator in a condition) + (vhdl--re2-region "[<:]=" + ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>") + ;; if condition + (vhdl--re2-region "^\\s-*if\\>" "\\<then\\>") + ;; elsif condition + (vhdl--re2-region "\\<elsif\\>" "\\<then\\>") + ;; while loop condition + (vhdl--re2-region "^\\s-*while\\>" "\\<loop\\>") + ;; exit/next condition + (vhdl--re2-region "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" ";") + ;; assert condition + (vhdl--re2-region "\\<assert\\>" "\\(\\<report\\>\\|\\<severity\\>\\|;\\)") + ;; case expression + (vhdl--re2-region "^\\s-*case\\>" "\\<is\\>") + ;; parameter list of procedure call, array index + (lambda (proc-end) + (when (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" proc-end t) + (forward-char -1) + (save-excursion + (forward-sexp) + (while (looking-at "(") (forward-sexp)) (point))))) + "Define syntactic regions where signals are read. +Each function is called with one arg (a limit for the (forward) search) and +should return either nil or the end position of the region (in which case +point will be set to its beginning).") + (defun vhdl-update-sensitivity-list () "Update sensitivity list." (let ((proc-beg (point)) @@ -8418,35 +8456,6 @@ buffer." (let ;; scan for visible signals ((visible-list (vhdl-get-visible-signals)) - ;; define syntactic regions where signals are read - (scan-regions-list - `(;; right-hand side of signal/variable assignment - ;; (special case: "<=" is relational operator in a condition) - ((vhdl-re-search-forward "[<:]=" ,proc-end t) - (vhdl-re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" ,proc-end t)) - ;; if condition - ((vhdl-re-search-forward "^\\s-*if\\>" ,proc-end t) - (vhdl-re-search-forward "\\<then\\>" ,proc-end t)) - ;; elsif condition - ((vhdl-re-search-forward "\\<elsif\\>" ,proc-end t) - (vhdl-re-search-forward "\\<then\\>" ,proc-end t)) - ;; while loop condition - ((vhdl-re-search-forward "^\\s-*while\\>" ,proc-end t) - (vhdl-re-search-forward "\\<loop\\>" ,proc-end t)) - ;; exit/next condition - ((vhdl-re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" ,proc-end t) - (vhdl-re-search-forward ";" ,proc-end t)) - ;; assert condition - ((vhdl-re-search-forward "\\<assert\\>" ,proc-end t) - (vhdl-re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" ,proc-end t)) - ;; case expression - ((vhdl-re-search-forward "^\\s-*case\\>" ,proc-end t) - (vhdl-re-search-forward "\\<is\\>" ,proc-end t)) - ;; parameter list of procedure call, array index - ((and (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" ,proc-end t) - (1- (point))) - (progn (backward-char) (forward-sexp) - (while (looking-at "(") (forward-sexp)) (point))))) name field read-list sens-list signal-list tmp-list sens-beg sens-end beg end margin) ;; scan for signals in old sensitivity list @@ -8475,11 +8484,9 @@ buffer." (push (cons end (point)) seq-region-list) (beginning-of-line))) ;; scan for signals read in process - (while scan-regions-list + (dolist (scan-fun vhdl--signal-regions-functions) (goto-char proc-mid) - (while (and (setq beg (eval (nth 0 (car scan-regions-list)))) - (setq end (eval (nth 1 (car scan-regions-list))))) - (goto-char beg) + (while (setq end (funcall scan-fun proc-end)) (unless (or (vhdl-in-literal) (and seq-region-list (let ((tmp-list seq-region-list)) @@ -8518,8 +8525,7 @@ buffer." (car tmp-list)) (setq read-list (delete (car tmp-list) read-list))) (setq tmp-list (cdr tmp-list))))) - (goto-char (match-end 1))))) - (setq scan-regions-list (cdr scan-regions-list))) + (goto-char (match-end 1)))))) ;; update sensitivity list (goto-char sens-beg) (if sens-end @@ -14978,9 +14984,9 @@ otherwise use cached data." (vhdl-aput 'vhdl-directory-alist directory (list (list directory)))) (defun vhdl-speedbar-insert-hierarchy ( ent-alist-arg conf-alist-arg - package-alist ent-inst-list depth) - "Insert hierarchy of ENT-ALIST-ARG, CONF-ALIST-ARG, and PACKAGE-ALIST." - (if (not (or ent-alist-arg conf-alist-arg package-alist)) + pkg-alist ent-inst-list depth) + "Insert hierarchy of ENT-ALIST-ARG, CONF-ALIST-ARG, and PKG-ALIST." + (if (not (or ent-alist-arg conf-alist-arg pkg-alist)) (vhdl-speedbar-make-title-line "No VHDL design units!" depth) (let ((ent-alist ent-alist-arg) (conf-alist conf-alist-arg) @@ -15010,15 +15016,15 @@ otherwise use cached data." 'vhdl-speedbar-configuration-face depth) (setq conf-alist (cdr conf-alist))) ;; insert packages - (when package-alist (vhdl-speedbar-make-title-line "Packages:" depth)) - (while package-alist - (setq pack-entry (car package-alist)) + (when pkg-alist (vhdl-speedbar-make-title-line "Packages:" depth)) + (while pkg-alist + (setq pack-entry (car pkg-alist)) (vhdl-speedbar-make-pack-line (nth 0 pack-entry) (nth 1 pack-entry) (cons (nth 2 pack-entry) (nth 3 pack-entry)) (cons (nth 7 pack-entry) (nth 8 pack-entry)) depth) - (setq package-alist (cdr package-alist)))))) + (setq pkg-alist (cdr pkg-alist)))))) (declare-function speedbar-line-directory "speedbar" (&optional depth)) diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index bd68672f905..b36e13104e3 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -211,7 +211,7 @@ non-nil.") (when which-function-mode (unless (local-variable-p 'which-func-mode) (setq which-func-mode (or (eq which-func-modes t) - (member major-mode which-func-modes))) + (derived-mode-p which-func-modes))) (setq which-func--use-mode-line (member which-func-display '(mode mode-and-header))) (setq which-func--use-header-line @@ -239,7 +239,7 @@ It creates the Imenu index for the buffer, if necessary." (condition-case err (if (and which-func-mode - (not (member major-mode which-func-non-auto-modes)) + (not (derived-mode-p which-func-non-auto-modes)) (or (null which-func-maxout) (< buffer-saved-size which-func-maxout) (= which-func-maxout 0))) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 717b837a2e5..755c3db04fd 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -2176,7 +2176,7 @@ Such as the current syntax table and the applied syntax properties." (or (buffer-modified-p buf) (unless xref--hits-remote-id - (not (verify-visited-file-modtime (current-buffer)))))) + (not (verify-visited-file-modtime buf))))) ;; We can't use buffers whose contents diverge from disk (bug#54025). (setq buf nil)) (setq xref--last-file-buffer (cons file buf)))) |