commit 44b306d3510e54432b76724583ea9405f1c90686 (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Tue Apr 9 11:09:56 2019 +0300 ; * etc/NEWS: Fix recently added entries. diff --git a/etc/NEWS b/etc/NEWS index 42e7a4f995..620d88c32a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1261,20 +1261,28 @@ in a terminal frame. ** JS mode +--- *** JSX syntax is now automatically detected and enabled. If a file imports Facebook's 'React' library, or if the file uses the extension '.jsx', then various features supporting XML-like syntax will be supported in 'js-mode' and derivative modes. ('js-jsx-mode' no longer needs to be enabled.) +--- *** New defcustom 'js-jsx-detect-syntax' disables automatic detection. +This is turned on by default. +--- *** New defcustom 'js-jsx-syntax' enables JSX syntax unconditionally. +This is off by default. +--- *** New variable 'js-jsx-regexps' controls JSX detection. +--- *** JSX syntax is now highlighted like SGML. +--- *** JSX code is properly indented in many more scenarios. Previously, JSX indentation usually only worked when an element was wrapped in parenthesis (e.g. in a 'return' statement or a function @@ -1284,6 +1292,7 @@ supported; and, indentation conventions align more closely with those of the React developer community, otherwise still adhering to SGML conventions. +--- *** Indentation uses 'js-indent-level' instead of 'sgml-basic-offset'. It was never really intuitive that JSX indentation would be controlled by an SGML variable. JSX is a syntax extension of JavaScript, so it @@ -1292,13 +1301,16 @@ is technically a breaking change, but it will probably align with how you would normally expect for this indentation to be controlled, and you probably won't need to change your config. +--- *** New defcustom 'js-jsx-attribute-offset' for JSX attribute indents. +--- *** New variable 'js-syntactic-mode-name' controls mode name display. Previously, the mode name was simply 'JavaScript'. Now, when a syntax extension like JSX is enabled, the mode name is 'JavaScript[JSX]'. -Setting this variable to nil can disable the new formatting. +Set this variable to nil to disable the new behavior. +--- *** New function 'js-use-syntactic-mode-name' for deriving modes. Packages deriving from 'js-mode' with 'define-derived-mode' should call this function to add enabled syntax extensions to their mode commit 1e58dc9e11caa78e458e35ef4c7f32269e052d89 Author: Eli Zaretskii Date: Tue Apr 9 11:01:24 2019 +0300 Fix "M-x eshell" * lisp/eshell/em-dirs.el (eshell-variable-aliases-list) (eshell-directory-name, eshell-mode): Defvar them. (eshell-dirs-initialize): Require esh-var. (Bug#35203) (eshell-apply-indices): Declare. diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index 937bc981c5..93b10b5994 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -46,6 +46,11 @@ (require 'ring) (require 'esh-opt) +(declare-function eshell-apply-indices "esh-var") +(defvar eshell-variable-aliases-list) +(defvar eshell-directory-name) +(defvar eshell-mode) + ;;;###autoload (progn (defgroup eshell-dirs nil @@ -171,6 +176,7 @@ Thus, this does not include the current directory.") (defun eshell-dirs-initialize () "Initialize the builtin functions for Eshell." + (require 'esh-var) (make-local-variable 'eshell-variable-aliases-list) (setq eshell-variable-aliases-list (append commit 062369e3aebdbcf25538e71686208a2126d83619 Author: Jackson Ray Hamilton Date: Tue Apr 9 00:52:43 2019 -0700 * etc/NEWS: Document new and improved JSX support in js-mode diff --git a/etc/NEWS b/etc/NEWS index c7456c681a..42e7a4f995 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1259,6 +1259,51 @@ near the current column in Tabulated Lists (see variables This defcustom allows for the customization of the modifier key used in a terminal frame. +** JS mode + +*** JSX syntax is now automatically detected and enabled. +If a file imports Facebook's 'React' library, or if the file uses the +extension '.jsx', then various features supporting XML-like syntax +will be supported in 'js-mode' and derivative modes. ('js-jsx-mode' +no longer needs to be enabled.) + +*** New defcustom 'js-jsx-detect-syntax' disables automatic detection. + +*** New defcustom 'js-jsx-syntax' enables JSX syntax unconditionally. + +*** New variable 'js-jsx-regexps' controls JSX detection. + +*** JSX syntax is now highlighted like SGML. + +*** JSX code is properly indented in many more scenarios. +Previously, JSX indentation usually only worked when an element was +wrapped in parenthesis (e.g. in a 'return' statement or a function +call). It would also fail in many intricate cases. Now, indentation +should work anywhere without parenthesis; many more intricacies are +supported; and, indentation conventions align more closely with those +of the React developer community, otherwise still adhering to SGML +conventions. + +*** Indentation uses 'js-indent-level' instead of 'sgml-basic-offset'. +It was never really intuitive that JSX indentation would be controlled +by an SGML variable. JSX is a syntax extension of JavaScript, so it +should be indented just like any other expression in JavaScript. This +is technically a breaking change, but it will probably align with how +you would normally expect for this indentation to be controlled, and +you probably won't need to change your config. + +*** New defcustom 'js-jsx-attribute-offset' for JSX attribute indents. + +*** New variable 'js-syntactic-mode-name' controls mode name display. +Previously, the mode name was simply 'JavaScript'. Now, when a syntax +extension like JSX is enabled, the mode name is 'JavaScript[JSX]'. +Setting this variable to nil can disable the new formatting. + +*** New function 'js-use-syntactic-mode-name' for deriving modes. +Packages deriving from 'js-mode' with 'define-derived-mode' should +call this function to add enabled syntax extensions to their mode +name, too. + * New Modes and Packages in Emacs 27.1 commit cf416d96c2d5db2079ed37927f0926fe0386e68a Author: Jackson Ray Hamilton Date: Mon Apr 8 22:40:51 2019 -0700 Explain reasonings for JSX syntax support design decisions * lisp/progmodes/js.el: Throughout the code, provide explanations for why JSX support was implemented in the way that it was; in particular, address the overlap between syntax-propertize-function, font-lock, and indentation (as requested by Stefan). diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index a1f5e694ed..535b70317a 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -1536,6 +1536,25 @@ point of view of font-lock. It applies highlighting directly with ;; Matcher always "fails" nil) +;; It wouldn’t be sufficient to font-lock JSX with mere regexps, since +;; a JSXElement may be nested inside a JS expression within the +;; boundaries of a parent JSXOpeningElement, and such a hierarchy +;; ought to be fontified like JSX, JS, and JSX respectively: +;; +;;
) && void(0)}> +;; +;;
← JSX +;; ) && void(0) ← JS +;; }> ← JSX +;; +;; `js-syntax-propertize' unambiguously identifies JSX syntax, +;; including when it’s nested. +;; +;; Using a matcher function for each relevant part, retrieve match +;; data recorded as syntax properties for fontification. + (defconst js-jsx--font-lock-keywords `((js-jsx--match-tag-name 0 font-lock-function-name-face t) (js-jsx--match-attribute-name 0 font-lock-variable-name-face t) @@ -1861,6 +1880,27 @@ This performs fontification according to `js--class-styles'." "Check if STRING is a unary operator keyword in JavaScript." (string-match-p js--unary-keyword-re string)) +;; Adding `syntax-multiline' text properties to JSX isn’t sufficient +;; to identify multiline JSX when first typing it. For instance, if +;; the user is typing a JSXOpeningElement for the first time… +;; +;;
← Despite completing the JSX, the next +;; ^ `syntax-propertize' region wouldn’t magically +;; extend back a few lines. +;; +;; Therefore, to try and recover from this scenario, parse backward +;; from “>” to try and find the start of JSXBoundaryElements, and +;; extend the `syntax-propertize' region there. + (defun js--syntax-propertize-extend-region (start end) "Extend the START-END region for propertization, if necessary. For use by `syntax-propertize-extend-region-functions'." @@ -1903,6 +1943,23 @@ For use by `syntax-propertize-extend-region-functions'." (throw 'stop nil))))))) (if new-start (cons new-start end)))) +;; When applying syntax properties, since `js-syntax-propertize' uses +;; `syntax-propertize-rules' to parse JSXBoundaryElements iteratively +;; and statelessly, whenever we exit such an element, we need to +;; determine the JSX depth. If >0, then we know we to apply syntax +;; properties to JSXText up until the next JSXBoundaryElement occurs. +;; But if the JSX depth is 0, then—importantly—we know to NOT parse +;; the following code as JSXText, rather propertize it as regular JS +;; as long as warranted. +;; +;; Also, when indenting code, we need to know if the code we’re trying +;; to indent is on the 2nd or later line of multiline JSX, in which +;; case the code is indented according to XML-like JSX conventions. +;; +;; For the aforementioned reasons, we find ourselves needing to +;; determine whether point is enclosed in JSX or not; and, if so, +;; where the JSX is. The following functions provide that knowledge. + (defconst js-jsx--tag-start-re (concat "\\(" js--dotted-name-re "\\)\\(?:" ;; Whitespace is only necessary if an attribute implies JSX. @@ -2004,6 +2061,24 @@ JSXElement or a JSXOpeningElement/JSXClosingElement pair." (let ((pos (save-excursion (js-jsx--enclosing-tag-pos)))) (and pos (>= (point) (nth 1 pos))))) +;; We implement `syntax-propertize-function' logic fully parsing JSX +;; in order to provide very accurate JSX indentation, even in the most +;; complex cases (e.g. to indent JSX within a JS expression within a +;; JSXAttribute…), as over the years users have requested this. Since +;; we find so much information during this parse, we later use some of +;; the useful bits for font-locking, too. +;; +;; Some extra effort is devoted to ensuring that no code which could +;; possibly be valid JS is ever misinterpreted as partial JSX, since +;; that would be regressive. +;; +;; We first parse trying to find the minimum number of components +;; necessary to unambiguously identify a JSXBoundaryElement, even if +;; it is a partial one. If a complete one is parsed, we move on to +;; parse any JSXText. When that’s terminated, we unwind back to the +;; `syntax-propertize-rules' loop so the next JSXBoundaryElement can +;; be parsed, if any, be it an opening or closing one. + (defun js-jsx--text-range (beg end) "Identify JSXText within a “>/{/}/<” pair." (when (> (- end beg) 0) @@ -2023,6 +2098,10 @@ JSXElement or a JSXOpeningElement/JSXClosingElement pair." ;; JSXText determines JSXText context from earlier lines. (put-text-property beg end 'syntax-multiline t))) +;; In order to respect the end boundary `syntax-propertize-function' +;; sets, care is taken in the following functions to abort parsing +;; whenever that boundary is reached. + (defun js-jsx--syntax-propertize-tag-text (end) "Determine if JSXText is before END and propertize it. Text within an open/close tag pair may be JSXText. Temporarily @@ -2562,6 +2641,21 @@ current line is the \"=>\" token (of an arrow function)." (end-of-line) (re-search-backward js--line-terminating-arrow-re from t))) +;; When indenting, we want to know if the line is… +;; +;; - within a multiline JSXElement, or +;; - within a string in a JSXBoundaryElement, or +;; - within JSXText, or +;; - within a JSXAttribute’s multiline JSXExpressionContainer. +;; +;; In these cases, special XML-like indentation rules for JSX apply. +;; If JS is nested within JSX, then indentation calculations may be +;; combined, such that JS indentation is “relative” to the JSX’s. +;; +;; Therefore, functions below provide such contextual information, and +;; `js--proper-indentation' may call itself once recursively in order +;; to finish calculating that “relative” JS+JSX indentation. + (defun js-jsx--context () "Determine JSX context and move to enclosing JSX." (let ((pos (point)) @@ -4319,6 +4413,10 @@ their `mode-name' updates to show enabled syntax extensions." (interactive) (setq-local js-jsx-syntax t)) +;; To make discovering and using syntax extensions features easier for +;; users (who might not read the docs), try to safely and +;; automatically enable syntax extensions based on heuristics. + (defvar js-jsx-regexps (list "\\_<\\(?:var\\|let\\|const\\|import\\)\\_>.*?React") "Regexps for detecting JSX in JavaScript buffers. @@ -4444,6 +4542,17 @@ This function is intended for use in `after-change-functions'." ;;(syntax-propertize (point-max)) ) +;; Since we made JSX support available and automatically-enabled in +;; the base `js-mode' (for ease of use), now `js-jsx-mode' simply +;; serves as one other interface to unconditionally enable JSX in +;; buffers, mostly for backwards-compatibility. +;; +;; Since it is probably more common for packages to integrate with +;; `js-mode' than with `js-jsx-mode', it is therefore probably +;; slightly better for users to use one of the many other methods for +;; enabling JSX syntax. But using `js-jsx-mode' can’t be that bad +;; either, so we won’t bother users with an obsoletion warning. + ;;;###autoload (define-derived-mode js-jsx-mode js-mode "JavaScript" "Major mode for editing JavaScript+JSX. commit 7c3ffdaf4b17e9f93aa929fc9a5c154e8e68e5fb Author: Jackson Ray Hamilton Date: Mon Apr 8 22:27:41 2019 -0700 Move curly functions closer to where they’re used * lisp/progmodes/js.el (js-jsx--enclosing-curly-pos) (js-jsx--goto-outermost-enclosing-curly): As the code evolved, these functions’ definitions ended up being far away from the only places where they were used. Move them there. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 1cec41d927..a1f5e694ed 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -1956,26 +1956,6 @@ the match. Return nil if a match can’t be found." (setq tag-stack (1+ tag-stack)))) (setq last-pos (point))))))) -(defun js-jsx--enclosing-curly-pos () - "Return position of enclosing “{” in a “{/}” pair about point." - (let ((parens (reverse (nth 9 (syntax-ppss)))) paren-pos curly-pos) - (while - (and - (setq paren-pos (car parens)) - (not (when (= (char-after paren-pos) ?{) - (setq curly-pos paren-pos))) - (setq parens (cdr parens)))) - curly-pos)) - -(defun js-jsx--goto-outermost-enclosing-curly (limit) - "Set point to enclosing “{” at or closest after LIMIT." - (let (pos) - (while - (and - (setq pos (js-jsx--enclosing-curly-pos)) - (if (>= pos limit) (goto-char pos)) - (> pos limit))))) - (defun js-jsx--enclosing-tag-pos () "Return beginning and end of a JSXElement about point. Look backward for a JSXElement that both starts before point and @@ -2646,6 +2626,26 @@ The column calculation is based off of `sgml-calculate-indent'." )) +(defun js-jsx--enclosing-curly-pos () + "Return position of enclosing “{” in a “{/}” pair about point." + (let ((parens (reverse (nth 9 (syntax-ppss)))) paren-pos curly-pos) + (while + (and + (setq paren-pos (car parens)) + (not (when (= (char-after paren-pos) ?{) + (setq curly-pos paren-pos))) + (setq parens (cdr parens)))) + curly-pos)) + +(defun js-jsx--goto-outermost-enclosing-curly (limit) + "Set point to enclosing “{” at or closest after LIMIT." + (let (pos) + (while + (and + (setq pos (js-jsx--enclosing-curly-pos)) + (if (>= pos limit) (goto-char pos)) + (> pos limit))))) + (defun js-jsx--expr-attribute-pos (start limit) "Look back from START to LIMIT for a JSXAttribute." (save-excursion commit 9545519572d47b4712f27e53e7b64bf88d473877 Author: Jackson Ray Hamilton Date: Mon Apr 8 20:01:13 2019 -0700 Add open/close parenthesis syntax to “<” and “>” in JSX * lisp/progmodes/js.el (js-jsx--syntax-propertize-tag): Like in sgml-mode, treat “<” and “>” like open/close parenthesis, making the text more navigable via forward-sexp, etc. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 9185371b52..1cec41d927 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -2099,6 +2099,8 @@ testing for syntax only valid as JSX." (< (point) end))) (cond ((= (char-after) ?>) + ;; Make the closing “>” a close parenthesis. + (put-text-property (point) (1+ (point)) 'syntax-table '(5)) (forward-char) (setq unambiguous t) (throw 'stop nil)) @@ -2183,6 +2185,8 @@ testing for syntax only valid as JSX." (when unambiguous ;; Save JSXBoundaryElement’s name’s match data for font-locking. (if name-beg (put-text-property name-beg (1+ name-beg) 'js-jsx-tag-name name-match-data)) + ;; Make the opening “<” an open parenthesis. + (put-text-property tag-beg (1+ tag-beg) 'syntax-table '(4)) ;; Prevent “out of range” errors when typing at the end of a buffer. (setq tag-end (if (eobp) (1- (point)) (point))) ;; Mark beginning and end of tag for font-locking. commit 18bbfc4c754ea653ee0a7e2e47d1d61304f5c42a Author: Jackson Ray Hamilton Date: Mon Apr 8 08:36:38 2019 -0700 Permit non-ASCII identifiers in JS * lisp/progmodes/js.el (js--name-start-re): Generally allow identifiers to begin with non-ASCII letters. This is of particular importance to JSX parsing. * test/manual/indent/jsx-unclosed-2.jsx: Add test to ensure non-ASCII characters are parsed properly. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index b1068bfc7b..9185371b52 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -65,7 +65,7 @@ ;;; Constants -(defconst js--name-start-re (concat "[a-zA-Z_$]") +(defconst js--name-start-re (concat "[[:alpha:]_$]") "Regexp matching the start of a JavaScript identifier, without grouping.") (defconst js--stmt-delim-chars "^;{}?:") diff --git a/test/manual/indent/jsx-unclosed-2.jsx b/test/manual/indent/jsx-unclosed-2.jsx index be0a605503..fb665b96a4 100644 --- a/test/manual/indent/jsx-unclosed-2.jsx +++ b/test/manual/indent/jsx-unclosed-2.jsx @@ -56,3 +56,10 @@ while (await foo > bar) void 0 / > < / div> < / div > + +// Non-ASCII identifiers are acceptable. +<Über> + + Guten Tag! + + commit 3eadf1eff43c84a1095094334549a1e0d1e75d80 Author: Jackson Ray Hamilton Date: Mon Apr 8 07:47:37 2019 -0700 Identify JSX strings (for js2-mode) * lisp/progmodes/js.el (js-jsx--syntax-propertize-tag): Derived modes like js2-mode may use font-lock-syntactic-face-function to apply faces to JSX strings (and only JSX strings). Apply the js-jsx-string text property to such strings so they can be distinctly identified. (js-jsx--text-properties): Ensure the js-jsx-string text property gets cleaned up, too. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index a1de3ef795..b1068bfc7b 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -2165,9 +2165,14 @@ testing for syntax only valid as JSX." ;; JSXExpressionContainer here will be parsed in the ;; next iteration of the loop. (if (memq (char-after) '(?\" ?\' ?\`)) - (condition-case nil - (forward-sexp) - (scan-error (throw 'stop nil))) + (progn + ;; Record the string’s position so derived modes + ;; applying syntactic fontification atypically + ;; (e.g. js2-mode) can recognize it as part of JSX. + (put-text-property (point) (1+ (point)) 'js-jsx-string t) + (condition-case nil + (forward-sexp) + (scan-error (throw 'stop nil)))) ;; Save JSXAttribute’s beginning in case we find a ;; JSXExpressionContainer as the JSXAttribute’s value which ;; we should associate with the JSXAttribute. @@ -2195,7 +2200,7 @@ testing for syntax only valid as JSX." (defconst js-jsx--text-properties (list 'js-jsx-tag-beg nil 'js-jsx-tag-end nil 'js-jsx-close-tag-pos nil - 'js-jsx-tag-name nil 'js-jsx-attribute-name nil + 'js-jsx-tag-name nil 'js-jsx-attribute-name nil 'js-jsx-string nil 'js-jsx-text nil 'js-jsx-expr nil 'js-jsx-expr-attribute nil) "Plist of text properties added by `js-syntax-propertize'.") commit e48306f84f1aeb4409cc02ae864f33e7af657288 Author: Jackson Ray Hamilton Date: Sun Apr 7 18:12:26 2019 -0700 Properly set a dynamic, syntactic mode name Use mode-line-format constructs to properly set mode-name, rather than use the very hacky solution that was filling-in for my lack of knowledge of this feature. * lisp/progmodes/js.el (js--update-mode-name) (js--idly-update-mode-name): Remove. (js--syntactic-mode-name-part): New helper function for mode-name. (js-use-syntactic-mode-name): Helper to set up the dynamic mode-name. (js-jsx-enable): Don’t need to call any extra functions now. (js-mode): Use the new setup function rather than the old ones. (js-jsx-mode): Use the same initial mode name as js-mode so the final one is identical for both modes. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index e42c455c84..a1de3ef795 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -4288,33 +4288,27 @@ If one hasn't been set, or if it's stale, prompt for a new one." (defvar js-syntactic-mode-name t "If non-nil, print enabled syntaxes in the mode name.") -(defun js--update-mode-name () - "Print enabled syntaxes if `js-syntactic-mode-name' is t." - (when js-syntactic-mode-name - (setq mode-name (concat "JavaScript" - (if js-jsx-syntax "+JSX" ""))))) - -(defun js--idly-update-mode-name () - "Update `mode-name' whenever Emacs goes idle. -In case `js-jsx-syntax' is updated, especially by features of -Emacs like .dir-locals.el or file variables, this ensures the -modeline eventually reflects which syntaxes are enabled." - (let (timer) - (setq timer - (run-with-idle-timer - 0 t - (lambda (buffer) - (if (buffer-live-p buffer) - (with-current-buffer buffer - (js--update-mode-name)) - (cancel-timer timer))) - (current-buffer))))) +(defun js--syntactic-mode-name-part () + "Return a string like “[JSX]” when `js-jsx-syntax' is enabled." + (if js-syntactic-mode-name + (let (syntaxes) + (if js-jsx-syntax (push "JSX" syntaxes)) + (if syntaxes + (concat "[" (mapconcat #'identity syntaxes ",") "]") + "")) + "")) + +(defun js-use-syntactic-mode-name () + "Print enabled syntaxes if `js-syntactic-mode-name' is t. +Modes deriving from `js-mode' should call this to ensure that +their `mode-name' updates to show enabled syntax extensions." + (when (stringp mode-name) + (setq mode-name `(,mode-name (:eval (js--syntactic-mode-name-part)))))) (defun js-jsx-enable () "Enable JSX in the current buffer." (interactive) - (setq-local js-jsx-syntax t) - (js--update-mode-name)) + (setq-local js-jsx-syntax t)) (defvar js-jsx-regexps (list "\\_<\\(?:var\\|let\\|const\\|import\\)\\_>.*?React") @@ -4395,8 +4389,7 @@ This function is intended for use in `after-change-functions'." ;; Syntax extensions (unless (js-jsx--detect-and-enable) (add-hook 'after-change-functions #'js-jsx--detect-after-change nil t)) - (js--update-mode-name) ; If `js-jsx-syntax' was set from outside. - (js--idly-update-mode-name) + (js-use-syntactic-mode-name) ;; Imenu (setq imenu-case-fold-search nil) @@ -4443,7 +4436,7 @@ This function is intended for use in `after-change-functions'." ) ;;;###autoload -(define-derived-mode js-jsx-mode js-mode "JavaScript+JSX" +(define-derived-mode js-jsx-mode js-mode "JavaScript" "Major mode for editing JavaScript+JSX. Simply makes `js-jsx-syntax' buffer-local and sets it to t. @@ -4456,7 +4449,8 @@ could set `js-jsx-syntax' to t in your init file, or in a `js-jsx-enable' in `js-mode-hook'. You may be better served by one of the aforementioned options instead of using this mode." :group 'js - (js-jsx-enable)) + (js-jsx-enable) + (js-use-syntactic-mode-name)) ;;;###autoload (defalias 'javascript-mode 'js-mode) commit 7a9dac5c944432cc2329473bb1dd9db9c0bfdd99 Author: Jackson Ray Hamilton Date: Sun Apr 7 14:36:47 2019 -0700 Improve whitespace and unary keyword parsing * lisp/progmodes/js.el (js--name-start-chars): Remove, adding these chars back to js--name-start-re. (js--name-start-re): Add chars back from js--name-start-chars. (js-jsx--tag-start-re): Improve regexp to capture the tag name (so it can be disambiguated from a unary keyword), to match newlines (which are common in this spot), and to require at least one whitespace character before the attribute name. (js-jsx--matched-tag-type): Ensure the “tag name” isn’t possibly a unary keyword. (js-jsx--self-closing-re, js-jsx--matching-close-tag-pos): Allow whitespace around “<” and “>”. * test/manual/indent/jsx-unclosed-2.jsx: Add tests for unary keyword and whitespace parsing. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 21e6b683b7..e42c455c84 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -65,10 +65,7 @@ ;;; Constants -(defconst js--name-start-chars "a-zA-Z_$" - "Character class chars matching the start of a JavaScript identifier.") - -(defconst js--name-start-re (concat "[" js--name-start-chars "]") +(defconst js--name-start-re (concat "[a-zA-Z_$]") "Regexp matching the start of a JavaScript identifier, without grouping.") (defconst js--stmt-delim-chars "^;{}?:") @@ -1907,7 +1904,12 @@ For use by `syntax-propertize-extend-region-functions'." (if new-start (cons new-start end)))) (defconst js-jsx--tag-start-re - (concat js--dotted-name-re "\\s-*[" js--name-start-chars "{/>]") + (concat "\\(" js--dotted-name-re "\\)\\(?:" + ;; Whitespace is only necessary if an attribute implies JSX. + "\\(?:\\s-\\|\n\\)*[{/>]" + "\\|" + "\\(?:\\s-\\|\n\\)+" js--name-start-re + "\\)") "Regexp unambiguously matching a JSXOpeningElement.") (defun js-jsx--matched-tag-type () @@ -1918,11 +1920,12 @@ else return `other'." (cond ((= (char-after) ?/) (forward-char) 'close) ; JSXClosingElement/JSXClosingFragment ((= (char-after) ?>) (forward-char) 'other) ; JSXOpeningFragment - ((looking-at js-jsx--tag-start-re) ; JSXOpeningElement + ((and (looking-at js-jsx--tag-start-re) ; JSXOpeningElement + (not (js--unary-keyword-p (match-string 1)))) (goto-char (match-end 0)) (if (= (char-before) ?/) 'self-closing 'other)))) -(defconst js-jsx--self-closing-re "/>" +(defconst js-jsx--self-closing-re "/\\s-*>" "Regexp matching the end of a self-closing JSXOpeningElement.") (defun js-jsx--matching-close-tag-pos () @@ -1933,7 +1936,7 @@ JSXClosingFragment, skipping over any nested JSXElements to find the match. Return nil if a match can’t be found." (let ((tag-stack 1) tag-pos type last-pos pos) (catch 'stop - (while (and (re-search-forward "<" nil t) (not (eobp))) + (while (and (re-search-forward "<\\s-*" nil t) (not (eobp))) (when (setq tag-pos (match-beginning 0) type (js-jsx--matched-tag-type)) (when last-pos diff --git a/test/manual/indent/jsx-unclosed-2.jsx b/test/manual/indent/jsx-unclosed-2.jsx index 9d80a2e9ae..be0a605503 100644 --- a/test/manual/indent/jsx-unclosed-2.jsx +++ b/test/manual/indent/jsx-unclosed-2.jsx @@ -19,6 +19,10 @@ if (foo > bar) void 0 if (foo < await bar) void 0 while (await foo > bar) void 0 +
+ {foo < await bar} +
+ // Allow unary keyword names as null-valued JSX attributes. // (As if this will EVER happen…) @@ -40,3 +44,15 @@ while (await foo > bar) void 0 // “-” may be used in a JSXAttribute’s name. + +// Weird spaces should be tolerated. +< div > + < div > + < div + attr="" + / > + < div + attr="" + / > + < / div> +< / div > commit 98e36a3e31da10bf230743d285544305f730b60d Author: Jackson Ray Hamilton Date: Sun Apr 7 13:25:57 2019 -0700 Optimize js-jsx--enclosing-tag-pos * lisp/progmodes/js.el (js-jsx--enclosing-tag-pos): Update docstring to be more precise. Also, remember close tag positions after they’ve been calculated once to avoid many redundant calls to js-jsx--matching-close-tag-pos. (js-jsx--text-properties): Ensure js-jsx-close-tag-pos text properties get cleaned up, too. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 694a79f0d9..21e6b683b7 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -1976,7 +1976,7 @@ the match. Return nil if a match can’t be found." (defun js-jsx--enclosing-tag-pos () "Return beginning and end of a JSXElement about point. Look backward for a JSXElement that both starts before point and -also ends after point. That may be either a self-closing +also ends at/after point. That may be either a self-closing JSXElement or a JSXOpeningElement/JSXClosingElement pair." (let ((start (point)) tag-beg tag-beg-pos tag-end-pos close-tag-pos) (while @@ -1991,9 +1991,21 @@ JSXElement or a JSXOpeningElement/JSXClosingElement pair." (< start tag-end-pos)) (and (eq (car tag-beg) 'open) (or (< start tag-end-pos) - (save-excursion - (goto-char tag-end-pos) - (setq close-tag-pos (js-jsx--matching-close-tag-pos)) + (progn + (unless + ;; Try to read a cached close position, + ;; but it might not be available yet. + (setq close-tag-pos + (get-text-property (point) 'js-jsx-close-tag-pos)) + (save-excursion + (goto-char tag-end-pos) + (setq close-tag-pos (js-jsx--matching-close-tag-pos))) + (when close-tag-pos + ;; Cache the close position to make future + ;; searches faster. + (put-text-property + (point) (1+ (point)) + 'js-jsx-close-tag-pos close-tag-pos))) ;; The JSXOpeningElement may be unclosed, else ;; the closure must occur at/after the start ;; point (otherwise, a miscellaneous previous @@ -2179,7 +2191,7 @@ testing for syntax only valid as JSX." (defconst js-jsx--text-properties (list - 'js-jsx-tag-beg nil 'js-jsx-tag-end nil + 'js-jsx-tag-beg nil 'js-jsx-tag-end nil 'js-jsx-close-tag-pos nil 'js-jsx-tag-name nil 'js-jsx-attribute-name nil 'js-jsx-text nil 'js-jsx-expr nil 'js-jsx-expr-attribute nil) "Plist of text properties added by `js-syntax-propertize'.") commit 7b2e3c60d081597adb7feaaabfee8cb8de62289b Author: Jackson Ray Hamilton Date: Sun Apr 7 00:25:35 2019 -0700 Optimize js-jsx--matching-close-tag-pos This function’s performance was having a noticeable impact when editing large JSX structures. Improve its performance slightly (elapsed time will be cut in half according to ELP). * lisp/progmodes/js.el (js-jsx--tag-re): Remove. (js-jsx--matched-tag-type): Simplify implementation with respect to the new implementation of js-jsx--matching-close-tag-pos. (js-jsx--self-closing-re): Simplify regexp slightly in sync with a generally simpler matching algorithm. (js-jsx--matching-close-tag-pos): Optimize matching algorithm by using multiple simple regexp searches, rather than one big complex search. * test/manual/indent/jsx-unclosed-2.jsx: Use the term “inequality” and add a test for a possible parsing foible. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 2d29d4e443..694a79f0d9 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -1906,26 +1906,23 @@ For use by `syntax-propertize-extend-region-functions'." (throw 'stop nil))))))) (if new-start (cons new-start end)))) -(defconst js-jsx--tag-re - (concat "<\\s-*\\(" - "[/>]" ; JSXClosingElement, or JSXOpeningFragment, or JSXClosingFragment - "\\|" - js--dotted-name-re "\\s-*[" js--name-start-chars "{/>]" ; JSXOpeningElement - "\\)") - "Regexp unambiguously matching a JSXBoundaryElement.") +(defconst js-jsx--tag-start-re + (concat js--dotted-name-re "\\s-*[" js--name-start-chars "{/>]") + "Regexp unambiguously matching a JSXOpeningElement.") (defun js-jsx--matched-tag-type () - "Determine the tag type of the last match to `js-jsx--tag-re'. + "Determine if the last “<” was a JSXBoundaryElement and its type. Return `close' for a JSXClosingElement/JSXClosingFragment match, return `self-closing' for some self-closing JSXOpeningElements, else return `other'." - (let ((chars (vconcat (match-string 1)))) - (cond - ((= (aref chars 0) ?/) 'close) - ((= (aref chars (1- (length chars))) ?/) 'self-closing) - (t 'other)))) + (cond + ((= (char-after) ?/) (forward-char) 'close) ; JSXClosingElement/JSXClosingFragment + ((= (char-after) ?>) (forward-char) 'other) ; JSXOpeningFragment + ((looking-at js-jsx--tag-start-re) ; JSXOpeningElement + (goto-char (match-end 0)) + (if (= (char-before) ?/) 'self-closing 'other)))) -(defconst js-jsx--self-closing-re "/\\s-*>" +(defconst js-jsx--self-closing-re "/>" "Regexp matching the end of a self-closing JSXOpeningElement.") (defun js-jsx--matching-close-tag-pos () @@ -1934,29 +1931,27 @@ Assuming a JSXOpeningElement or a JSXOpeningFragment is immediately before point, find a matching JSXClosingElement or JSXClosingFragment, skipping over any nested JSXElements to find the match. Return nil if a match can’t be found." - (let ((tag-stack 1) type tag-pos last-pos pos) + (let ((tag-stack 1) tag-pos type last-pos pos) (catch 'stop - (while (re-search-forward js-jsx--tag-re nil t) - (setq type (js-jsx--matched-tag-type) - tag-pos (match-beginning 0)) - ;; Clear the stack of any JSXOpeningElements which turned out - ;; to be self-closing. - (when last-pos - (setq pos (point)) - (goto-char last-pos) - (while (re-search-forward js-jsx--self-closing-re pos 'move) - (setq tag-stack (1- tag-stack)))) - (if (eq type 'close) - (progn - (setq tag-stack (1- tag-stack)) - (when (= tag-stack 0) - (throw 'stop tag-pos))) - ;; JSXOpeningElements that we know are self-closing aren’t - ;; added to the stack at all (since re-search-forward moves - ;; point after their self-closing syntax). - (unless (eq type 'self-closing) - (setq tag-stack (1+ tag-stack)))) - (setq last-pos (point)))))) + (while (and (re-search-forward "<" nil t) (not (eobp))) + (when (setq tag-pos (match-beginning 0) + type (js-jsx--matched-tag-type)) + (when last-pos + (setq pos (point)) + (goto-char last-pos) + (while (re-search-forward js-jsx--self-closing-re pos 'move) + (setq tag-stack (1- tag-stack)))) + (if (eq type 'close) + (progn + (setq tag-stack (1- tag-stack)) + (when (= tag-stack 0) + (throw 'stop tag-pos))) + ;; JSXOpeningElements that we know are self-closing aren’t + ;; added to the stack at all (because point is already + ;; past that syntax). + (unless (eq type 'self-closing) + (setq tag-stack (1+ tag-stack)))) + (setq last-pos (point))))))) (defun js-jsx--enclosing-curly-pos () "Return position of enclosing “{” in a “{/}” pair about point." diff --git a/test/manual/indent/jsx-unclosed-2.jsx b/test/manual/indent/jsx-unclosed-2.jsx index 8db25aa67f..9d80a2e9ae 100644 --- a/test/manual/indent/jsx-unclosed-2.jsx +++ b/test/manual/indent/jsx-unclosed-2.jsx @@ -6,10 +6,15 @@ // The following tests go below any comments to avoid including // misindented comments among the erroring lines. -// Don’t misinterpret equality operators as JSX. +// Don’t misinterpret inequality operators as JSX. for (; i < length;) void 0 if (foo > bar) void 0 +// Don’t misintrepet inequalities within JSX, either. +
+ {foo < bar} +
+ // Don’t even misinterpret unary operators as JSX. if (foo < await bar) void 0 while (await foo > bar) void 0 commit 462baabed93228a00e5ccadbe5704fb317957cb7 Author: Jackson Ray Hamilton Date: Tue Mar 26 21:47:34 2019 -0700 Add tests for miscellaneous JSX parsing feats * test/manual/indent/jsx.jsx: Add tests for JSXMemberExpression names and JSXOpeningFragment/JSXClosingFragment support (already supported). diff --git a/test/manual/indent/jsx.jsx b/test/manual/indent/jsx.jsx index 5004d57a0b..c200979df8 100644 --- a/test/manual/indent/jsx.jsx +++ b/test/manual/indent/jsx.jsx @@ -93,6 +93,32 @@ return ( } /> ) +// JSXMemberExpression names are parsed/indented: + +
+ + Hello World! + + +
+
+ +
+ + +// JSXOpeningFragment and JSXClosingFragment are parsed/indented: +<> +
+ <> + Hello World! + + <> +
+
+ +
+ + // Indent void expressions (no need for contextual parens / commas) // (https://github.com/mooz/js2-mode/issues/140#issuecomment-166250016).
commit afec4511cf5c336eaf9f8bb1425bf2dd1fc12740 Author: Jackson Ray Hamilton Date: Tue Mar 26 20:14:46 2019 -0700 Split JSX indentation calculation into several functions * lisp/progmodes/js.el (js-jsx--contextual-indentation) (js-jsx--expr-attribute-pos, js-jsx--expr-indentation): Extract logic from js-jsx--indentation, and improve the logic’s documentation. (js-jsx--indentation): Simplify by splitting into several functions (see above) and improve the logic’s documentation. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 679633fc83..2d29d4e443 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -2575,12 +2575,86 @@ current line is the \"=>\" token (of an arrow function)." (list 'tag (nth 0 enclosing-tag-pos) (nth 1 enclosing-tag-pos))) (list 'text (nth 0 enclosing-tag-pos) (nth 2 enclosing-tag-pos)))))) +(defun js-jsx--contextual-indentation (line context) + "Calculate indentation column for LINE from CONTEXT. +The column calculation is based off of `sgml-calculate-indent'." + (pcase (nth 0 context) + + ('string + ;; Go back to previous non-empty line. + (while (and (> (point) (nth 1 context)) + (zerop (forward-line -1)) + (looking-at "[ \t]*$"))) + (if (> (point) (nth 1 context)) + ;; Previous line is inside the string. + (current-indentation) + (goto-char (nth 1 context)) + (1+ (current-column)))) + + ('tag + ;; Special JSX indentation rule: a “dangling” closing angle + ;; bracket on its own line is indented at the same level as the + ;; opening angle bracket of the JSXElement. Otherwise, indent + ;; JSXAttribute space like SGML. + (if (progn + (goto-char (nth 2 context)) + (and (= line (line-number-at-pos)) + (looking-back "^\\s-*/?>" (line-beginning-position)))) + (progn + (goto-char (nth 1 context)) + (current-column)) + ;; Indent JSXAttribute space like SGML. + (goto-char (nth 1 context)) + ;; Skip tag name: + (skip-chars-forward " \t") + (skip-chars-forward "^ \t\n") + (skip-chars-forward " \t") + (if (not (eolp)) + (current-column) + ;; This is the first attribute: indent. + (goto-char (+ (nth 1 context) js-jsx-attribute-offset)) + (+ (current-column) js-indent-level)))) + + ('text + ;; Indent to reflect nesting. + (goto-char (nth 1 context)) + (+ (current-column) + ;; The last line isn’t nested, but the rest are. + (if (or (not (nth 2 context)) ; Unclosed. + (< line (line-number-at-pos (nth 2 context)))) + js-indent-level + 0))) + + )) + +(defun js-jsx--expr-attribute-pos (start limit) + "Look back from START to LIMIT for a JSXAttribute." + (save-excursion + (goto-char start) ; Skip the first curly. + ;; Skip any remaining enclosing curlies until the JSXElement’s + ;; beginning position; the last curly ought to be one of a + ;; JSXExpressionContainer, which may refer to its JSXAttribute’s + ;; beginning position (if it has one). + (js-jsx--goto-outermost-enclosing-curly limit) + (get-text-property (point) 'js-jsx-expr-attribute))) + (defvar js-jsx--indent-col nil "Baseline column for JS indentation within JSX.") (defvar js-jsx--indent-attribute-line nil "Line relative to which indentation uses JSX as a baseline.") +(defun js-jsx--expr-indentation (parse-status pos col) + "Indent using PARSE-STATUS; relative to POS, use base COL. +To indent a JSXExpressionContainer’s expression, calculate the JS +indentation, using JSX indentation as the base column when +indenting relative to the beginning line of the +JSXExpressionContainer’s JSXAttribute (if any)." + (let* ((js-jsx--indent-col col) + (js-jsx--indent-attribute-line + (if pos (line-number-at-pos pos)))) + (js--proper-indentation parse-status))) + (defun js-jsx--indentation (parse-status) "Helper function for `js--proper-indentation'. Return the proper indentation of the current line if it is part @@ -2605,74 +2679,16 @@ return nil." (and (= beg-line current-line) (or (not curly-pos) (> (point) curly-pos))))))) + ;; When on the second or later line of JSX, indent as JSX, + ;; possibly switching back to JS indentation within + ;; JSXExpressionContainers, possibly using the JSX as a base + ;; column while switching back to JS indentation. (when (and context (> current-line beg-line)) (save-excursion - ;; The column calculation is based on `sgml-calculate-indent'. - (setq col (pcase (nth 0 context) - - ('string - ;; Go back to previous non-empty line. - (while (and (> (point) (nth 1 context)) - (zerop (forward-line -1)) - (looking-at "[ \t]*$"))) - (if (> (point) (nth 1 context)) - ;; Previous line is inside the string. - (current-indentation) - (goto-char (nth 1 context)) - (1+ (current-column)))) - - ('tag - ;; Special JSX indentation rule: a “dangling” - ;; closing angle bracket on its own line is - ;; indented at the same level as the opening - ;; angle bracket of the JSXElement. Otherwise, - ;; indent JSXAttribute space like SGML. - (if (progn - (goto-char (nth 2 context)) - (and (= current-line (line-number-at-pos)) - (looking-back "^\\s-*/?>" (line-beginning-position)))) - (progn - (goto-char (nth 1 context)) - (current-column)) - ;; Indent JSXAttribute space like SGML. - (goto-char (nth 1 context)) - ;; Skip tag name: - (skip-chars-forward " \t") - (skip-chars-forward "^ \t\n") - (skip-chars-forward " \t") - (if (not (eolp)) - (current-column) - ;; This is the first attribute: indent. - (goto-char (+ (nth 1 context) js-jsx-attribute-offset)) - (+ (current-column) js-indent-level)))) - - ('text - ;; Indent to reflect nesting. - (goto-char (nth 1 context)) - (+ (current-column) - ;; The last line isn’t nested, but the rest are. - (if (or (not (nth 2 context)) ; Unclosed. - (< current-line (line-number-at-pos (nth 2 context)))) - js-indent-level - 0))) - - ))) - ;; To indent a JSXExpressionContainer’s expression, calculate - ;; the JS indentation, possibly using JSX indentation as the - ;; base column. + (setq col (js-jsx--contextual-indentation current-line context))) (if expr-p - (let* ((js-jsx--indent-col col) - (expr-attribute-pos - (save-excursion - (goto-char curly-pos) ; Skip first curly. - ;; Skip any remaining enclosing curlies up until - ;; the contextual JSXElement’s beginning position. - (js-jsx--goto-outermost-enclosing-curly (nth 1 context)) - (get-text-property (point) 'js-jsx-expr-attribute))) - (js-jsx--indent-attribute-line - (when expr-attribute-pos - (line-number-at-pos expr-attribute-pos)))) - (js--proper-indentation parse-status)) + (js-jsx--expr-indentation + parse-status (js-jsx--expr-attribute-pos curly-pos (nth 1 context)) col) col)))) (defun js--proper-indentation (parse-status) commit 55c80d43a972d3e126c173745c57a0a383bd3ad4 Author: Jackson Ray Hamilton Date: Tue Mar 26 18:18:39 2019 -0700 Indent expressions in JSXAttributes relative to the attribute’s name * lisp/progmodes/js.el (js-jsx--syntax-propertize-tag): Refer to the beginning of a JSXExpressionContainer’s associated JSXAttribute (so line numbers can be calculated later). (js-jsx--text-properties): Also clear the new text property js-jsx-expr-attribute. (js-jsx--indenting): Remove. (js-jsx--indent-col, js-jsx--indent-attribute-line): New variables. (js-jsx--indentation): Instead of alternating between two separate column calculations, neither necessarily correct, bind the JSX column such that the second call to js--proper-indentation can use it as a base column. (js--proper-indentation): Use JSX as the base column for some indents while indenting JSX. * test/manual/indent/jsx.jsx: Add more tests for expression indents. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index f22c68cff9..679633fc83 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -2081,7 +2081,7 @@ been propertized." Disambiguate JSX from inequality operators and arrow functions by testing for syntax only valid as JSX." (let ((tag-beg (1- (point))) tag-end (type 'open) - name-beg name-match-data unambiguous + name-beg name-match-data expr-attribute-beg unambiguous forward-sexp-function) ; Use Lisp version. (catch 'stop (while (and (< (point) end) @@ -2096,8 +2096,16 @@ testing for syntax only valid as JSX." ;; JSXExpressionContainer as a JSXAttribute value ;; (“\" token (of an arrow function)." (list 'tag (nth 0 enclosing-tag-pos) (nth 1 enclosing-tag-pos))) (list 'text (nth 0 enclosing-tag-pos) (nth 2 enclosing-tag-pos)))))) -(defvar js-jsx--indenting nil - "Flag to prevent infinite recursion while indenting JSX.") +(defvar js-jsx--indent-col nil + "Baseline column for JS indentation within JSX.") + +(defvar js-jsx--indent-attribute-line nil + "Line relative to which indentation uses JSX as a baseline.") (defun js-jsx--indentation (parse-status) "Helper function for `js--proper-indentation'. @@ -2642,25 +2657,22 @@ return nil." 0))) ))) - ;; When indenting a JSXExpressionContainer expression, use JSX - ;; indentation as a minimum, and use regular JS indentation if - ;; it’s deeper. + ;; To indent a JSXExpressionContainer’s expression, calculate + ;; the JS indentation, possibly using JSX indentation as the + ;; base column. (if expr-p - (max (+ col - ;; An expression in a JSXExpressionContainer in a - ;; JSXAttribute should be indented more, except on - ;; the ending line of the JSXExpressionContainer. - (if (and (eq (nth 0 context) 'tag) - (< current-line - (save-excursion - (js-jsx--goto-outermost-enclosing-curly - (nth 1 context)) - (forward-sexp) - (line-number-at-pos)))) - js-indent-level - 0)) - (let ((js-jsx--indenting t)) ; Prevent recursion. - (js--proper-indentation parse-status))) + (let* ((js-jsx--indent-col col) + (expr-attribute-pos + (save-excursion + (goto-char curly-pos) ; Skip first curly. + ;; Skip any remaining enclosing curlies up until + ;; the contextual JSXElement’s beginning position. + (js-jsx--goto-outermost-enclosing-curly (nth 1 context)) + (get-text-property (point) 'js-jsx-expr-attribute))) + (js-jsx--indent-attribute-line + (when expr-attribute-pos + (line-number-at-pos expr-attribute-pos)))) + (js--proper-indentation parse-status)) col)))) (defun js--proper-indentation (parse-status) @@ -2670,7 +2682,7 @@ return nil." (cond ((nth 4 parse-status) ; inside comment (js--get-c-offset 'c (nth 8 parse-status))) ((nth 3 parse-status) 0) ; inside string - ((when (and js-jsx-syntax (not js-jsx--indenting)) + ((when (and js-jsx-syntax (not js-jsx--indent-col)) (save-excursion (js-jsx--indentation parse-status)))) ((eq (char-after) ?#) 0) ((save-excursion (js--beginning-of-macro)) 4) @@ -2708,17 +2720,24 @@ return nil." (and switch-keyword-p in-switch-p))) (indent - (cond (same-indent-p - (current-column)) - (continued-expr-p - (+ (current-column) (* 2 js-indent-level) - js-expr-indent-offset)) - (t - (+ (current-column) js-indent-level - (pcase (char-after (nth 1 parse-status)) - (?\( js-paren-indent-offset) - (?\[ js-square-indent-offset) - (?\{ js-curly-indent-offset))))))) + (+ + (cond + ((and js-jsx--indent-attribute-line + (eq js-jsx--indent-attribute-line + (line-number-at-pos))) + js-jsx--indent-col) + (t + (current-column))) + (cond (same-indent-p 0) + (continued-expr-p + (+ (* 2 js-indent-level) + js-expr-indent-offset)) + (t + (+ js-indent-level + (pcase (char-after (nth 1 parse-status)) + (?\( js-paren-indent-offset) + (?\[ js-square-indent-offset) + (?\{ js-curly-indent-offset)))))))) (if in-switch-p (+ indent js-switch-indent-offset) indent))) diff --git a/test/manual/indent/jsx.jsx b/test/manual/indent/jsx.jsx index c2351a8cf1..5004d57a0b 100644 --- a/test/manual/indent/jsx.jsx +++ b/test/manual/indent/jsx.jsx @@ -68,6 +68,31 @@ return (
); +return ( +
// Also dedent. +); + +return ( +
+) + // Indent void expressions (no need for contextual parens / commas) // (https://github.com/mooz/js2-mode/issues/140#issuecomment-166250016).
commit 16669d7c5d5a0dfadf672f8359e431ef81044a23 Author: Jackson Ray Hamilton Date: Mon Mar 25 20:39:48 2019 -0700 Fix counting of nested self-closing JSXOpeningElements * lisp/progmodes/js.el (js-jsx--matching-close-tag-pos): Fix bug where self-closing JSXOpeningElements might be missed if one was nested within another. * test/manual/indent/jsx-self-closing.jsx: Add test for bug concerning self-closing JSXOpeningElement counting. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index f8dd72c22b..f22c68cff9 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -1934,40 +1934,29 @@ Assuming a JSXOpeningElement or a JSXOpeningFragment is immediately before point, find a matching JSXClosingElement or JSXClosingFragment, skipping over any nested JSXElements to find the match. Return nil if a match can’t be found." - (let ((tag-stack 1) self-closing-pos type) + (let ((tag-stack 1) type tag-pos last-pos pos) (catch 'stop (while (re-search-forward js-jsx--tag-re nil t) - (setq type (js-jsx--matched-tag-type)) - ;; Balance the total of self-closing tags that we subtract - ;; from the stack, ignoring those tags which are never added - ;; to the stack (see below). - (unless (eq type 'self-closing) - (when (and self-closing-pos (> (point) self-closing-pos)) + (setq type (js-jsx--matched-tag-type) + tag-pos (match-beginning 0)) + ;; Clear the stack of any JSXOpeningElements which turned out + ;; to be self-closing. + (when last-pos + (setq pos (point)) + (goto-char last-pos) + (while (re-search-forward js-jsx--self-closing-re pos 'move) (setq tag-stack (1- tag-stack)))) (if (eq type 'close) (progn (setq tag-stack (1- tag-stack)) (when (= tag-stack 0) - (throw 'stop (match-beginning 0)))) - ;; Tags that we know are self-closing aren’t added to the - ;; stack at all, because we only close the ones that we have - ;; anticipated after moving past those anticipated tags’ - ;; ends, and if a self-closing tag is the first tag we - ;; encounter in this loop, then it will never be anticipated - ;; (due to an optimization where we sometimes can avoid - ;; looking for self-closing tags). + (throw 'stop tag-pos))) + ;; JSXOpeningElements that we know are self-closing aren’t + ;; added to the stack at all (since re-search-forward moves + ;; point after their self-closing syntax). (unless (eq type 'self-closing) (setq tag-stack (1+ tag-stack)))) - ;; Don’t needlessly recalculate. - (unless (and self-closing-pos (<= (point) self-closing-pos)) - (setq self-closing-pos nil) ; Reset if recalculating. - (save-excursion - ;; Anticipate a self-closing tag that we should make sure - ;; to subtract from the tag stack once we move past its - ;; end; we might might miss the end otherwise, due to the - ;; regexp-matching method we use to detect tags. - (when (re-search-forward js-jsx--self-closing-re nil t) - (setq self-closing-pos (match-beginning 0))))))))) + (setq last-pos (point)))))) (defun js-jsx--enclosing-curly-pos () "Return position of enclosing “{” in a “{/}” pair about point." diff --git a/test/manual/indent/jsx-self-closing.jsx b/test/manual/indent/jsx-self-closing.jsx new file mode 100644 index 0000000000..f8ea7a138a --- /dev/null +++ b/test/manual/indent/jsx-self-closing.jsx @@ -0,0 +1,13 @@ +// Local Variables: +// indent-tabs-mode: nil +// js-indent-level: 2 +// End: + +// The following test goes below any comments to avoid including +// misindented comments among the erroring lines. + +// Properly parse/indent code with a self-closing tag inside the +// attribute of another self-closing tag. +
+
} /> +
commit 84b1cfbc2d6b9236913a18ed192798fd530911db Author: Jackson Ray Hamilton Date: Sun Mar 24 13:17:12 2019 -0700 Indent broken arrow function bodies as an N+1th arg * lisp/progmodes/js.el (js--line-terminating-arrow-re): Revise regexp for use with re-search-backward. (js--looking-at-broken-arrow-function-p): Remove. (js--broken-arrow-terminates-line-p): Replacement for js--looking-at-broken-arrow-function-p. Don’t consider whether an arrow appears at point (in an arglist); instead, just look for an arrow that terminates the line. (js--proper-indentation): Use js--broken-arrow-terminates-line-p. * test/manual/indent/js.js: Add test for a broken arrow as an N+1th arg. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 5d87489b52..f8dd72c22b 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -2550,23 +2550,17 @@ indentation is aligned to that column." (when comma-p (goto-char (1+ declaration-keyword-end)))))))) -(defconst js--line-terminating-arrow-re "\\s-*=>\\s-*\\(/[/*]\\|$\\)" +(defconst js--line-terminating-arrow-re "=>\\s-*\\(/[/*]\\|$\\)" "Regexp matching the last \"=>\" (arrow) token on a line. Whitespace and comments around the arrow are ignored.") -(defun js--looking-at-broken-arrow-function-p () +(defun js--broken-arrow-terminates-line-p () "Helper function for `js--proper-indentation'. -Return t if point is at the start of a (possibly async) arrow -function and the last non-comment, non-whitespace token of the -current line is the \"=>\" token." - (when (looking-at "\\s-*async\\s-*") - (goto-char (match-end 0))) - (cond - ((eq (char-after) ?\() - (forward-list) - (looking-at-p js--line-terminating-arrow-re)) - (t (looking-at-p - (concat js--name-re js--line-terminating-arrow-re))))) +Return t if the last non-comment, non-whitespace token of the +current line is the \"=>\" token (of an arrow function)." + (let ((from (point))) + (end-of-line) + (re-search-backward js--line-terminating-arrow-re from t))) (defun js-jsx--context () "Determine JSX context and move to enclosing JSX." @@ -2713,7 +2707,7 @@ return nil." (goto-char (nth 1 parse-status)) ; go to the opening char (if (or (not js-indent-align-list-continuation) (looking-at "[({[]\\s-*\\(/[/*]\\|$\\)") - (save-excursion (forward-char) (js--looking-at-broken-arrow-function-p))) + (save-excursion (forward-char) (js--broken-arrow-terminates-line-p))) (progn ; nothing following the opening paren/bracket (skip-syntax-backward " ") (when (eq (char-before) ?\)) (backward-list)) diff --git a/test/manual/indent/js.js b/test/manual/indent/js.js index 647d7438f4..9658c95701 100644 --- a/test/manual/indent/js.js +++ b/test/manual/indent/js.js @@ -160,6 +160,11 @@ foo.bar.baz(very => // A comment snorf ); +// Continuation of bug#25904; support broken arrow as N+1th arg +map(arr, (val) => + val +) + // Local Variables: // indent-tabs-mode: nil // js-indent-level: 2 commit d9d1bb2b07750f3b2f2a9f8fa3d7aa1a5ec5038e Author: Jackson Ray Hamilton Date: Sun Mar 24 10:05:28 2019 -0700 Rename tests to use the “.jsx” file extension * test/manual/indent/js-jsx-quote.js: Renamed to “jsx-quote.jsx”. * test/manual/indent/js-jsx-unclosed-1.js: Renamed to “jsx-unclosed-1.jsx”. * test/manual/indent/js-jsx-unclosed-2.js: Renamed to “jsx-unclosed-2.jsx”. * test/manual/indent/js-jsx.js: Renamed to “jsx.jsx”. * test/manual/indent/jsx-quote.jsx: Renamed from “js-jsx-quote.js”. * test/manual/indent/jsx-unclosed-1.jsx: Renamed from “js-jsx-unclosed-1.js”. * test/manual/indent/jsx-unclosed-2.jsx: Renamed from “js-jsx-unclosed-2.js”. * test/manual/indent/jsx.jsx: Renamed from “js-jsx.js”. diff --git a/test/manual/indent/js-jsx-quote.js b/test/manual/indent/jsx-quote.jsx similarity index 95% rename from test/manual/indent/js-jsx-quote.js rename to test/manual/indent/jsx-quote.jsx index 4b71a65674..1b2c652873 100644 --- a/test/manual/indent/js-jsx-quote.js +++ b/test/manual/indent/jsx-quote.jsx @@ -1,5 +1,3 @@ -// -*- mode: js-jsx; -*- - // JSX text node values should be strings, but only JS string syntax // is considered, so quote marks delimit strings like normal, with // disastrous results (https://github.com/mooz/js2-mode/issues/409). diff --git a/test/manual/indent/js-jsx-unclosed-1.js b/test/manual/indent/jsx-unclosed-1.jsx similarity index 91% rename from test/manual/indent/js-jsx-unclosed-1.js rename to test/manual/indent/jsx-unclosed-1.jsx index 9418aed7a1..1f5c3fba8d 100644 --- a/test/manual/indent/js-jsx-unclosed-1.js +++ b/test/manual/indent/jsx-unclosed-1.jsx @@ -1,5 +1,3 @@ -// -*- mode: js-jsx; -*- - // Local Variables: // indent-tabs-mode: nil // js-indent-level: 2 diff --git a/test/manual/indent/js-jsx-unclosed-2.js b/test/manual/indent/jsx-unclosed-2.jsx similarity index 97% rename from test/manual/indent/js-jsx-unclosed-2.js rename to test/manual/indent/jsx-unclosed-2.jsx index 843ef9b6a8..8db25aa67f 100644 --- a/test/manual/indent/js-jsx-unclosed-2.js +++ b/test/manual/indent/jsx-unclosed-2.jsx @@ -1,5 +1,3 @@ -// -*- mode: js-jsx; -*- - // Local Variables: // indent-tabs-mode: nil // js-indent-level: 2 diff --git a/test/manual/indent/js-jsx.js b/test/manual/indent/jsx.jsx similarity index 99% rename from test/manual/indent/js-jsx.js rename to test/manual/indent/jsx.jsx index 2ec00c63bb..c2351a8cf1 100644 --- a/test/manual/indent/js-jsx.js +++ b/test/manual/indent/jsx.jsx @@ -1,5 +1,3 @@ -// -*- mode: js-jsx; -*- - var foo =
; return ( commit 8b92719b6b31d26299b5feae0ea92bb80f835e3d Author: Jackson Ray Hamilton Date: Sun Mar 24 09:55:14 2019 -0700 Improve JSX syntax propertization * lisp/progmodes/js.el (js-jsx--attribute-name-re): New variable. (js-jsx--syntax-propertize-tag): Allow “-” in JSXAttribute names. Fix “out of range” error when typing at the end of a buffer. Fix/improve future propertization of unfinished JSXBoundaryElements. * test/manual/indent/js-jsx-unclosed-2.js: Add tests for allowed characters in JSX. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 0bba8159c1..5d87489b52 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -2083,11 +2083,15 @@ been propertized." (throw 'stop nil))) (setq text-beg (point)))))) +(defconst js-jsx--attribute-name-re (concat js--name-start-re + "\\(?:\\s_\\|\\sw\\|-\\)*") + "Like `js--name-re', but matches “-” as well.") + (defun js-jsx--syntax-propertize-tag (end) "Determine if a JSXBoundaryElement is before END and propertize it. Disambiguate JSX from inequality operators and arrow functions by testing for syntax only valid as JSX." - (let ((tag-beg (1- (point))) (type 'open) + (let ((tag-beg (1- (point))) tag-end (type 'open) name-beg name-match-data unambiguous forward-sexp-function) ; Use Lisp version. (catch 'stop @@ -2127,46 +2131,54 @@ testing for syntax only valid as JSX." ;; figure out what type it actually is. (if (eq type 'open) (setq type (if name-beg 'self-closing 'close))) (forward-char)) - ((looking-at js--dotted-name-re) - (if (not name-beg) - (progn - ;; Don’t match code like “if (i < await foo)” - (if (js--unary-keyword-p (match-string 0)) (throw 'stop nil)) - ;; Save boundaries for later fontification after - ;; unambiguously determining the code is JSX. - (setq name-beg (match-beginning 0) - name-match-data (match-data)) - (goto-char (match-end 0))) - (setq unambiguous t) ; Non-unary name followed by 2nd name ⇒ JSX - ;; Save JSXAttribute’s name’s match data for font-locking later. - (put-text-property (match-beginning 0) (1+ (match-beginning 0)) - 'js-jsx-attribute-name (match-data)) - (goto-char (match-end 0)) + ((and (not name-beg) (looking-at js--dotted-name-re)) + ;; Don’t match code like “if (i < await foo)” + (if (js--unary-keyword-p (match-string 0)) (throw 'stop nil)) + ;; Save boundaries for later fontification after + ;; unambiguously determining the code is JSX. + (setq name-beg (match-beginning 0) + name-match-data (match-data)) + (goto-char (match-end 0))) + ((and name-beg (looking-at js-jsx--attribute-name-re)) + (setq unambiguous t) ; Non-unary name followed by 2nd name ⇒ JSX + ;; Save JSXAttribute’s name’s match data for font-locking later. + (put-text-property (match-beginning 0) (1+ (match-beginning 0)) + 'js-jsx-attribute-name (match-data)) + (goto-char (match-end 0)) + (if (>= (point) end) (throw 'stop nil)) + (skip-chars-forward " \t\n" end) + (if (>= (point) end) (throw 'stop nil)) + ;; “=” is optional for null-valued JSXAttributes. + (when (= (char-after) ?=) + (forward-char) (if (>= (point) end) (throw 'stop nil)) (skip-chars-forward " \t\n" end) (if (>= (point) end) (throw 'stop nil)) - ;; “=” is optional for null-valued JSXAttributes. - (when (= (char-after) ?=) - (forward-char) - (if (>= (point) end) (throw 'stop nil)) - (skip-chars-forward " \t\n" end) - (if (>= (point) end) (throw 'stop nil)) - ;; Skip over strings (if possible). Any - ;; JSXExpressionContainer here will be parsed in the - ;; next iteration of the loop. - (when (memq (char-after) '(?\" ?\' ?\`)) - (condition-case nil - (forward-sexp) - (scan-error (throw 'stop nil))))))) + ;; Skip over strings (if possible). Any + ;; JSXExpressionContainer here will be parsed in the + ;; next iteration of the loop. + (when (memq (char-after) '(?\" ?\' ?\`)) + (condition-case nil + (forward-sexp) + (scan-error (throw 'stop nil)))))) ;; There is nothing more to check; this either isn’t JSX, or ;; the tag is incomplete. (t (throw 'stop nil))))) (when unambiguous ;; Save JSXBoundaryElement’s name’s match data for font-locking. (if name-beg (put-text-property name-beg (1+ name-beg) 'js-jsx-tag-name name-match-data)) + ;; Prevent “out of range” errors when typing at the end of a buffer. + (setq tag-end (if (eobp) (1- (point)) (point))) ;; Mark beginning and end of tag for font-locking. - (put-text-property tag-beg (1+ tag-beg) 'js-jsx-tag-beg (cons type (point))) - (put-text-property (point) (1+ (point)) 'js-jsx-tag-end tag-beg)) + (put-text-property tag-beg (1+ tag-beg) 'js-jsx-tag-beg (cons type tag-end)) + (put-text-property tag-end (1+ tag-end) 'js-jsx-tag-end tag-beg) + ;; Use text properties to extend the syntax-propertize region + ;; backward to the beginning of the JSXBoundaryElement in the + ;; future. Typically the closing angle bracket could suggest + ;; extending backward, but that would also involve more rigorous + ;; parsing, and the closing angle bracket may not even exist yet + ;; if the JSXBoundaryElement is still being typed. + (put-text-property tag-beg (1+ tag-end) 'syntax-multiline t)) (if (js-jsx--at-enclosing-tag-child-p) (js-jsx--syntax-propertize-tag-text end)))) (defconst js-jsx--text-properties diff --git a/test/manual/indent/js-jsx-unclosed-2.js b/test/manual/indent/js-jsx-unclosed-2.js index 8b6f33325d..843ef9b6a8 100644 --- a/test/manual/indent/js-jsx-unclosed-2.js +++ b/test/manual/indent/js-jsx-unclosed-2.js @@ -29,3 +29,11 @@ while (await foo > bar) void 0 + +// “-” is not allowed in a JSXBoundaryElement’s name. + + // Weirdly-indented “continued expression.” + +// “-” may be used in a JSXAttribute’s name. + commit bf37078df2cbea3a44a641ddbe40f11339c135a2 Author: Jackson Ray Hamilton Date: Sat Mar 23 20:14:29 2019 -0700 Automatically detect JSX in JavaScript files * lisp/files.el (auto-mode-alist): Simply enable javascript-mode (js-mode) when opening “.jsx” files, since the “.jsx” file extension will be used as an indicator of JSX syntax by js-mode, and more code is likely to work in js-mode than js-jsx-mode, and we probably want to guide users to use js-mode (with js-jsx-syntax) instead. Code that used to work exclusively in js-jsx-mode (if anyone ever wrote any) ought to be updated to work in js-mode too when js-jsx-syntax is set to t. * lisp/progmodes/js.el (js-jsx-detect-syntax, js-jsx-regexps) (js-jsx--detect-and-enable, js-jsx--detect-after-change): New variables and functions for detecting and enabling JSX. (js-jsx-syntax): Update docstring with respect to the widened scope of the effects and use of this variable. (js-syntactic-mode-name, js--update-mode-name) (js--idly-update-mode-name, js-jsx-enable): New variable and functions for indicating when JSX is enabled. (js-mode): Detect and enable JSX. Print all enabled syntaxes after the mode name whenever Emacs goes idle; this ensures lately-enabled syntaxes are evident. (js-jsx-mode): Update mode name for consistency with the state in which JSX is enabled in js-mode. Update docstring to suggest alternative means of using JSX without this mode. Going forward, it may be best to gently guide users away from js-jsx-mode, since a “one mode per syntax extension” model would not scale well if more syntax extensions were to be simultaneously supported (e.g. Facebook’s “Flow”). diff --git a/lisp/files.el b/lisp/files.el index 1dae57593a..b81550e297 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2705,9 +2705,8 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\)\\'" . archive-mo ("\\.dbk\\'" . xml-mode) ("\\.dtd\\'" . sgml-mode) ("\\.ds\\(ss\\)?l\\'" . dsssl-mode) - ("\\.jsm?\\'" . javascript-mode) + ("\\.js[mx]?\\'" . javascript-mode) ("\\.json\\'" . javascript-mode) - ("\\.jsx\\'" . js-jsx-mode) ("\\.[ds]?vh?\\'" . verilog-mode) ("\\.by\\'" . bovine-grammar-mode) ("\\.wy\\'" . wisent-grammar-mode) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index df2c41332e..0bba8159c1 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -574,10 +574,30 @@ then the \".\"s will be lined up: :safe 'booleanp :group 'js) +(defcustom js-jsx-detect-syntax t + "When non-nil, automatically detect whether JavaScript uses JSX. +`js-jsx-syntax' (which see) may be made buffer-local and set to +t. The detection strategy can be customized by adding elements +to `js-jsx-regexps', which see." + :version "27.1" + :type 'boolean + :safe 'booleanp + :group 'js) + (defcustom js-jsx-syntax nil "When non-nil, parse JavaScript with consideration for JSX syntax. -This fixes indentation of JSX code in some cases. It is set to -be buffer-local when in `js-jsx-mode'." + +This enables proper font-locking and indentation of code using +Facebook’s “JSX” syntax extension for JavaScript, for use with +Facebook’s “React” library. Font-locking is like sgml-mode. +Indentation is also like sgml-mode, although some indentation +behavior may differ slightly to align more closely with the +conventions of the React developer community. + +When `js-mode' is already enabled, you should call +`js-jsx-enable' to set this variable. + +It is set to be buffer-local (and t) when in `js-jsx-mode'." :version "27.1" :type 'boolean :safe 'booleanp @@ -4223,6 +4243,79 @@ If one hasn't been set, or if it's stale, prompt for a new one." (when temp-name (delete-file temp-name)))))) +;;; Syntax extensions + +(defvar js-syntactic-mode-name t + "If non-nil, print enabled syntaxes in the mode name.") + +(defun js--update-mode-name () + "Print enabled syntaxes if `js-syntactic-mode-name' is t." + (when js-syntactic-mode-name + (setq mode-name (concat "JavaScript" + (if js-jsx-syntax "+JSX" ""))))) + +(defun js--idly-update-mode-name () + "Update `mode-name' whenever Emacs goes idle. +In case `js-jsx-syntax' is updated, especially by features of +Emacs like .dir-locals.el or file variables, this ensures the +modeline eventually reflects which syntaxes are enabled." + (let (timer) + (setq timer + (run-with-idle-timer + 0 t + (lambda (buffer) + (if (buffer-live-p buffer) + (with-current-buffer buffer + (js--update-mode-name)) + (cancel-timer timer))) + (current-buffer))))) + +(defun js-jsx-enable () + "Enable JSX in the current buffer." + (interactive) + (setq-local js-jsx-syntax t) + (js--update-mode-name)) + +(defvar js-jsx-regexps + (list "\\_<\\(?:var\\|let\\|const\\|import\\)\\_>.*?React") + "Regexps for detecting JSX in JavaScript buffers. +When `js-jsx-detect-syntax' is non-nil and any of these regexps +match text near the beginning of a JavaScript buffer, +`js-jsx-syntax' (which see) will be made buffer-local and set to +t.") + +(defun js-jsx--detect-and-enable (&optional arbitrarily) + "Detect if JSX is likely to be used, and enable it if so. +Might make `js-jsx-syntax' buffer-local and set it to t. Matches +from the beginning of the buffer, unless optional arg ARBITRARILY +is non-nil. Return t after enabling, nil otherwise." + (when (or (and (buffer-file-name) + (string-match-p "\\.jsx\\'" (buffer-file-name))) + (and js-jsx-detect-syntax + (save-excursion + (unless arbitrarily + (goto-char (point-min))) + (catch 'match + (mapc + (lambda (regexp) + (if (re-search-forward regexp 4000 t) (throw 'match t))) + js-jsx-regexps) + nil)))) + (js-jsx-enable) + t)) + +(defun js-jsx--detect-after-change (beg end _len) + "Detect if JSX is likely to be used after a change. +This function is intended for use in `after-change-functions'." + (when (<= end 4000) + (save-excursion + (goto-char beg) + (beginning-of-line) + (save-restriction + (narrow-to-region (point) end) + (when (js-jsx--detect-and-enable 'arbitrarily) + (remove-hook 'after-change-functions #'js-jsx--detect-after-change t)))))) + ;;; Main Function ;;;###autoload @@ -4259,6 +4352,12 @@ If one hasn't been set, or if it's stale, prompt for a new one." ;; Frameworks (js--update-quick-match-re) + ;; Syntax extensions + (unless (js-jsx--detect-and-enable) + (add-hook 'after-change-functions #'js-jsx--detect-after-change nil t)) + (js--update-mode-name) ; If `js-jsx-syntax' was set from outside. + (js--idly-update-mode-name) + ;; Imenu (setq imenu-case-fold-search nil) (setq imenu-create-index-function #'js--imenu-create-index) @@ -4304,10 +4403,20 @@ If one hasn't been set, or if it's stale, prompt for a new one." ) ;;;###autoload -(define-derived-mode js-jsx-mode js-mode "JSX" - "Major mode for editing JSX." +(define-derived-mode js-jsx-mode js-mode "JavaScript+JSX" + "Major mode for editing JavaScript+JSX. + +Simply makes `js-jsx-syntax' buffer-local and sets it to t. + +`js-mode' may detect and enable support for JSX automatically if +it appears to be used in a JavaScript file. You could also +customize `js-jsx-regexps' to improve that detection; or, you +could set `js-jsx-syntax' to t in your init file, or in a +.dir-locals.el file, or using file variables; or, you could call +`js-jsx-enable' in `js-mode-hook'. You may be better served by +one of the aforementioned options instead of using this mode." :group 'js - (setq-local js-jsx-syntax t)) + (js-jsx-enable)) ;;;###autoload (defalias 'javascript-mode 'js-mode) commit 339be7c00790fb407cc8449fa8f59baa792cbe69 Author: Jackson Ray Hamilton Date: Sat Mar 23 15:01:55 2019 -0700 Finish replacing SGML-based JSX detection with js-mode’s parsing This removes the last dependency on sgml-mode for JSX-related logic. * lisp/progmodes/js.el (js-jsx--start-tag-re) (js-jsx--end-tag-re): Remove. (js-jsx--looking-at-start-tag-p) (js-jsx--looking-back-at-end-tag-p): Reimplement using text properties, using syntax information which ought to be slightly more accurate than regexps since it was found by complete parsing. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index af83e04df4..df2c41332e 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -50,7 +50,6 @@ (require 'imenu) (require 'moz nil t) (require 'json) -(require 'sgml-mode) (require 'prog-mode) (eval-when-compile @@ -2211,13 +2210,10 @@ testing for syntax only valid as JSX." (js--regexp-opt-symbol '("in" "instanceof"))) "Regexp matching operators that affect indentation of continued expressions.") -(defconst js-jsx--start-tag-re - (concat "<" sgml-name-re) - "Regexp matching code that looks like a JSXOpeningElement.") - (defun js-jsx--looking-at-start-tag-p () "Non-nil if a JSXOpeningElement immediately follows point." - (looking-at js-jsx--start-tag-re)) + (let ((tag-beg (get-text-property (point) 'js-jsx-tag-beg))) + (and tag-beg (memq (car tag-beg) '(open self-closing))))) (defun js--looking-at-operator-p () "Return non-nil if point is on a JavaScript operator, other than a comma." @@ -2263,13 +2259,9 @@ testing for syntax only valid as JSX." (setq result nil))) result)) -(defconst js-jsx--end-tag-re - (concat "\\|/>") - "Regexp matching a JSXClosingElement.") - (defun js-jsx--looking-back-at-end-tag-p () "Non-nil if a JSXClosingElement immediately precedes point." - (looking-back js-jsx--end-tag-re (point-at-bol))) + (get-text-property (point) 'js-jsx-tag-end)) (defun js--continued-expression-p () "Return non-nil if the current line continues an expression." commit 1a1ef2851844a9ae2edcfe0346fc457e90c24bc7 Author: Jackson Ray Hamilton Date: Sat Mar 23 14:22:35 2019 -0700 Indent JSX as parsed in a JS context Fixes the following issues (and re-fixes indentation issues initially fixed but later re-broken by previous commits in the process of adding comprehensive JSX support): - https://github.com/mooz/js2-mode/issues/389#issuecomment-390766873 - https://github.com/mooz/js2-mode/issues/482 - Bug#32158 - https://github.com/mooz/js2-mode/issues/462 Previously, we delegated to sgml-mode functions for JSX indentation. However, there were some problems with this approach: - sgml-mode does not anticipate tags inside attributes when indenting, which compromises JSX indentation inside JSXExpressionContainers inside JSXAttributes. - In previous iterations to provide comprehensive JSX support, it proved tedious to disambiguate “<” and “>” as JS inequality operators and arrow functions from opening and closing angle brackets as part of SGML tags. That code evolved into a more complete JSX parsing implementation for syntax-propertize rules for font-locking, discarding the superfluous “<”/“>” disambiguation in anticipation of using the improved JSX analysis for indentation. - Using sgml-mode functions, we controlled JSX indentation using SGML variables. However, JSX is a different thing than SGML; referencing SGML in JS was a leaky abstraction. To resolve these issues, use the text properties added by the JSX syntax-propertize code to determine the boundaries of various aspects of JSX syntax, and reimplement the sgml-mode indentation code in js-mode with better respect to JSX indentation conventions. * lisp/progmodes/js.el (js-jsx-attribute-offset): New variable to provide a way for users to still control JSX attribute offsets as they could with sgml-attribute-offset before. The value of this feature is dubious IMO, but it’s trivial to keep it, so let’s do it just in case. (js-jsx--goto-outermost-enclosing-curly): New function. (js-jsx--enclosing-tag-pos): Refactor to be unbounded by curlies, so this function can be used to find JSXExpressionContainers within JSX. Fix bug where an enclosing JSXElement couldn’t be found when point was at the start of its JSXClosingElement. Return the JSXClosingElement’s position as well, so the JSXClosingElement can be indentified when indenting and be indented like the matching JSXOpeningElement. (js-jsx--at-enclosing-tag-child-p): js-jsx--enclosing-tag-pos now returns a list rather than a cons, so retrieve the JSXOpeningElement’s end position from a list. (js-jsx--context, js-jsx--indenting): New function and variable. (js-jsx--indentation): New function replacing the prior js-jsx--indent* functions and js-jsx-indent-line’s implementation. Use the JSX parsing performed in a JS context to more accurately calculate JSX indentation than by delegating to sgml-mode functions. (js--proper-indentation): Use js-jsx--indentation as yet another type of indentation. (js-jsx--as-sgml, js-jsx--outermost-enclosing-tag-pos) (js-jsx--indentation-type, js-jsx--indent-line-in-expression) (js-jsx--indent-n+1th-line): Remove obsolete functions. (js-jsx-indent-line): Refactor nearly-obsolete function to behave the same as it usually would before these changes, without respect to the binding of js-jsx-syntax. (js-jsx-mode): Remove obsolete documentation about the use of SGML variables to control indentation, and don’t bind indent-line-function any more, because it is no longer necessary given the new implementation of js-jsx-indent-line. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 220cf97fdc..af83e04df4 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -584,6 +584,29 @@ be buffer-local when in `js-jsx-mode'." :safe 'booleanp :group 'js) +(defcustom js-jsx-attribute-offset 0 + "Specifies a delta for JSXAttribute indentation. + +Let `js-indent-level' be 2. When this variable is also set to 0, +JSXAttribute indentation looks like this: + + + + +Alternatively, when this variable is also set to 2, JSXAttribute +indentation looks like this: + + + + +This variable is like `sgml-attribute-offset'." + :version "27.1" + :type 'integer + :safe 'integerp + :group 'js) + ;;; KeyMap (defvar js-mode-map @@ -1938,14 +1961,21 @@ the match. Return nil if a match can’t be found." (setq parens (cdr parens)))) curly-pos)) +(defun js-jsx--goto-outermost-enclosing-curly (limit) + "Set point to enclosing “{” at or closest after LIMIT." + (let (pos) + (while + (and + (setq pos (js-jsx--enclosing-curly-pos)) + (if (>= pos limit) (goto-char pos)) + (> pos limit))))) + (defun js-jsx--enclosing-tag-pos () "Return beginning and end of a JSXElement about point. Look backward for a JSXElement that both starts before point and also ends after point. That may be either a self-closing JSXElement or a JSXOpeningElement/JSXClosingElement pair." - (let ((start (point)) - (curly-pos (save-excursion (js-jsx--enclosing-curly-pos))) - tag-beg tag-beg-pos tag-end-pos close-tag-pos) + (let ((start (point)) tag-beg tag-beg-pos tag-end-pos close-tag-pos) (while (and (setq tag-beg (js--backward-text-property 'js-jsx-tag-beg)) @@ -1957,25 +1987,24 @@ JSXElement or a JSXOpeningElement/JSXClosingElement pair." (and (eq (car tag-beg) 'self-closing) (< start tag-end-pos)) (and (eq (car tag-beg) 'open) - (save-excursion - (goto-char tag-end-pos) - (setq close-tag-pos (js-jsx--matching-close-tag-pos)) - ;; The JSXOpeningElement may either be unclosed, - ;; else the closure must occur after the start - ;; point (otherwise, a miscellaneous previous - ;; JSXOpeningElement has been found, and we should - ;; keep looking back for an enclosing one). - (or (not close-tag-pos) (< start close-tag-pos)))))))) - ;; Don’t return the last tag pos (if any; it wasn’t enclosing). - (setq tag-beg nil)) - (and tag-beg - (or (not curly-pos) (> tag-beg-pos curly-pos)) - (cons tag-beg-pos tag-end-pos)))) + (or (< start tag-end-pos) + (save-excursion + (goto-char tag-end-pos) + (setq close-tag-pos (js-jsx--matching-close-tag-pos)) + ;; The JSXOpeningElement may be unclosed, else + ;; the closure must occur at/after the start + ;; point (otherwise, a miscellaneous previous + ;; JSXOpeningElement has been found, so keep + ;; looking backwards for an enclosing one). + (or (not close-tag-pos) (<= start close-tag-pos))))))))) + ;; Don’t return the last tag pos, as it wasn’t enclosing. + (setq tag-beg nil close-tag-pos nil)) + (and tag-beg (list tag-beg-pos tag-end-pos close-tag-pos)))) (defun js-jsx--at-enclosing-tag-child-p () "Return t if point is at an enclosing tag’s child." (let ((pos (save-excursion (js-jsx--enclosing-tag-pos)))) - (and pos (>= (point) (cdr pos))))) + (and pos (>= (point) (nth 1 pos))))) (defun js-jsx--text-range (beg end) "Identify JSXText within a “>/{/}/<” pair." @@ -2515,6 +2544,118 @@ current line is the \"=>\" token." (t (looking-at-p (concat js--name-re js--line-terminating-arrow-re))))) +(defun js-jsx--context () + "Determine JSX context and move to enclosing JSX." + (let ((pos (point)) + (parse-status (syntax-ppss)) + (enclosing-tag-pos (js-jsx--enclosing-tag-pos))) + (when enclosing-tag-pos + (if (< pos (nth 1 enclosing-tag-pos)) + (if (nth 3 parse-status) + (list 'string (nth 8 parse-status)) + (list 'tag (nth 0 enclosing-tag-pos) (nth 1 enclosing-tag-pos))) + (list 'text (nth 0 enclosing-tag-pos) (nth 2 enclosing-tag-pos)))))) + +(defvar js-jsx--indenting nil + "Flag to prevent infinite recursion while indenting JSX.") + +(defun js-jsx--indentation (parse-status) + "Helper function for `js--proper-indentation'. +Return the proper indentation of the current line if it is part +of a JSXElement expression spanning multiple lines; otherwise, +return nil." + (let ((current-line (line-number-at-pos)) + (curly-pos (js-jsx--enclosing-curly-pos)) + nth-context context expr-p beg-line col + forward-sexp-function) ; Use the Lisp version. + ;; Find the immediate context for indentation information, but + ;; keep going to determine that point is at the N+1th line of + ;; multiline JSX. + (save-excursion + (while + (and + (setq nth-context (js-jsx--context)) + (progn + (unless context + (setq context nth-context) + (setq expr-p (and curly-pos (< (point) curly-pos)))) + (setq beg-line (line-number-at-pos)) + (and + (= beg-line current-line) + (or (not curly-pos) (> (point) curly-pos))))))) + (when (and context (> current-line beg-line)) + (save-excursion + ;; The column calculation is based on `sgml-calculate-indent'. + (setq col (pcase (nth 0 context) + + ('string + ;; Go back to previous non-empty line. + (while (and (> (point) (nth 1 context)) + (zerop (forward-line -1)) + (looking-at "[ \t]*$"))) + (if (> (point) (nth 1 context)) + ;; Previous line is inside the string. + (current-indentation) + (goto-char (nth 1 context)) + (1+ (current-column)))) + + ('tag + ;; Special JSX indentation rule: a “dangling” + ;; closing angle bracket on its own line is + ;; indented at the same level as the opening + ;; angle bracket of the JSXElement. Otherwise, + ;; indent JSXAttribute space like SGML. + (if (progn + (goto-char (nth 2 context)) + (and (= current-line (line-number-at-pos)) + (looking-back "^\\s-*/?>" (line-beginning-position)))) + (progn + (goto-char (nth 1 context)) + (current-column)) + ;; Indent JSXAttribute space like SGML. + (goto-char (nth 1 context)) + ;; Skip tag name: + (skip-chars-forward " \t") + (skip-chars-forward "^ \t\n") + (skip-chars-forward " \t") + (if (not (eolp)) + (current-column) + ;; This is the first attribute: indent. + (goto-char (+ (nth 1 context) js-jsx-attribute-offset)) + (+ (current-column) js-indent-level)))) + + ('text + ;; Indent to reflect nesting. + (goto-char (nth 1 context)) + (+ (current-column) + ;; The last line isn’t nested, but the rest are. + (if (or (not (nth 2 context)) ; Unclosed. + (< current-line (line-number-at-pos (nth 2 context)))) + js-indent-level + 0))) + + ))) + ;; When indenting a JSXExpressionContainer expression, use JSX + ;; indentation as a minimum, and use regular JS indentation if + ;; it’s deeper. + (if expr-p + (max (+ col + ;; An expression in a JSXExpressionContainer in a + ;; JSXAttribute should be indented more, except on + ;; the ending line of the JSXExpressionContainer. + (if (and (eq (nth 0 context) 'tag) + (< current-line + (save-excursion + (js-jsx--goto-outermost-enclosing-curly + (nth 1 context)) + (forward-sexp) + (line-number-at-pos)))) + js-indent-level + 0)) + (let ((js-jsx--indenting t)) ; Prevent recursion. + (js--proper-indentation parse-status))) + col)))) + (defun js--proper-indentation (parse-status) "Return the proper indentation for the current line." (save-excursion @@ -2522,6 +2663,8 @@ current line is the \"=>\" token." (cond ((nth 4 parse-status) ; inside comment (js--get-c-offset 'c (nth 8 parse-status))) ((nth 3 parse-status) 0) ; inside string + ((when (and js-jsx-syntax (not js-jsx--indenting)) + (save-excursion (js-jsx--indentation parse-status)))) ((eq (char-after) ?#) 0) ((save-excursion (js--beginning-of-macro)) 4) ;; Indent array comprehension continuation lines specially. @@ -2584,111 +2727,6 @@ current line is the \"=>\" token." (+ js-indent-level js-expr-indent-offset)) (t (prog-first-column))))) -;;; JSX Indentation - -(defmacro js-jsx--as-sgml (&rest body) - "Execute BODY as if in sgml-mode." - `(with-syntax-table sgml-mode-syntax-table - ,@body)) - -(defun js-jsx--outermost-enclosing-tag-pos () - (let (context tag-pos last-tag-pos parse-status parens paren-pos curly-pos) - (js-jsx--as-sgml - ;; Search until we reach the top or encounter the start of a - ;; JSXExpressionContainer (implying nested JSX). - (while (and (setq context (sgml-get-context)) - (progn - (setq tag-pos (sgml-tag-start (car (last context)))) - (or (not curly-pos) - ;; Stop before curly brackets (start of a - ;; JSXExpressionContainer). - (> tag-pos curly-pos)))) - ;; Record this position so it can potentially be returned. - (setq last-tag-pos tag-pos) - ;; Always parse sexps / search for the next context from the - ;; immediately enclosing tag (sgml-get-context may not leave - ;; point there). - (goto-char tag-pos) - (unless parse-status ; Don’t needlessly reparse. - ;; Search upward for an enclosing starting curly bracket. - (setq parse-status (syntax-ppss)) - (setq parens (reverse (nth 9 parse-status))) - (while (and (setq paren-pos (car parens)) - (not (when (= (char-after paren-pos) ?{) - (setq curly-pos paren-pos)))) - (setq parens (cdr parens))) - ;; Always search for the next context from the immediately - ;; enclosing tag (calling syntax-ppss in the above loop - ;; may move point from there). - (goto-char tag-pos)))) - last-tag-pos)) - -(defun js-jsx--indentation-type () - "Determine if/how the current line should be indented as JSX. - -Return nil for first JSXElement line (indent like JS). -Return `n+1th' for second+ JSXElement lines (indent like SGML). -Return `expression' for lines within embedded JS expressions - (indent like JS inside SGML). -Return nil for non-JSX lines." - (let ((current-pos (point)) - (current-line (line-number-at-pos)) - tag-start-pos parens paren type) - (save-excursion - ;; Determine if inside a JSXElement. - (beginning-of-line) ; For exclusivity - (when (setq tag-start-pos (js-jsx--outermost-enclosing-tag-pos)) - ;; Check if inside an embedded multi-line JS expression. - (goto-char current-pos) - (end-of-line) ; For exclusivity - (setq parens (nth 9 (syntax-ppss))) - (while - (and - (setq paren (car parens)) - (if (and - (>= paren tag-start-pos) - ;; A curly bracket indicates the start of an - ;; embedded expression. - (= (char-after paren) ?{) - ;; The first line of the expression is indented - ;; like SGML. - (> current-line (line-number-at-pos paren)) - ;; Check if within a closing curly bracket (if any) - ;; (exclusive, as the closing bracket is indented - ;; like SGML). - (if (progn - (goto-char paren) - (ignore-errors (let (forward-sexp-function) - (forward-sexp)))) - (< current-line (line-number-at-pos)) - ;; No matching bracket implies we’re inside! - t)) - ;; Indicate this will be indented specially. Return - ;; nil to stop iterating too. - (progn (setq type 'expression) nil) - ;; Stop iterating when parens = nil. - (setq parens (cdr parens))))) - (or type 'n+1th))))) - -(defun js-jsx--indent-line-in-expression () - "Indent the current line as JavaScript within JSX." - (let ((parse-status (save-excursion (syntax-ppss (point-at-bol)))) - offset indent-col) - (unless (nth 3 parse-status) - (save-excursion - (setq offset (- (point) (progn (back-to-indentation) (point))) - indent-col (js-jsx--as-sgml (sgml-calculate-indent)))) - (if (null indent-col) 'noindent ; Like in sgml-mode - ;; Use whichever indentation column is greater, such that the - ;; SGML column is effectively a minimum. - (indent-line-to (max (js--proper-indentation parse-status) - (+ indent-col js-indent-level))) - (when (> offset 0) (forward-char offset)))))) - -(defun js-jsx--indent-n+1th-line () - "Indent the current line as JSX within JavaScript." - (js-jsx--as-sgml (sgml-indent-line))) - (defun js-indent-line () "Indent the current line as JavaScript." (interactive) @@ -2700,15 +2738,9 @@ Return nil for non-JSX lines." (when (> offset 0) (forward-char offset))))) (defun js-jsx-indent-line () - "Indent the current line as JSX (with SGML offsets). -i.e., customize JSX element indentation with `sgml-basic-offset', -`sgml-attribute-offset' et al." + "Indent the current line as JavaScript+JSX." (interactive) - (let ((type (js-jsx--indentation-type))) - (if type - (if (eq type 'n+1th) (js-jsx--indent-n+1th-line) - (js-jsx--indent-line-in-expression)) - (js-indent-line)))) + (let ((js-jsx-syntax t)) (js-indent-line))) ;;; Filling @@ -4281,18 +4313,9 @@ If one hasn't been set, or if it's stale, prompt for a new one." ;;;###autoload (define-derived-mode js-jsx-mode js-mode "JSX" - "Major mode for editing JSX. - -To customize the indentation for this mode, set the SGML offset -variables (`sgml-basic-offset', `sgml-attribute-offset' et al.) -locally, like so: - - (defun set-jsx-indentation () - (setq-local sgml-basic-offset js-indent-level)) - (add-hook \\='js-jsx-mode-hook #\\='set-jsx-indentation)" + "Major mode for editing JSX." :group 'js - (setq-local js-jsx-syntax t) - (setq-local indent-line-function #'js-jsx-indent-line)) + (setq-local js-jsx-syntax t)) ;;;###autoload (defalias 'javascript-mode 'js-mode) commit 2bedd23358d2d7378eec78d526ba1435d3b4d122 Author: Jackson Ray Hamilton Date: Sat Mar 23 12:33:20 2019 -0700 Update expectations for JSX indentation in JSXAttribute space * test/manual/indent/js-jsx.js: Align expectations for dangling closing constructs with other places in the tests. diff --git a/test/manual/indent/js-jsx.js b/test/manual/indent/js-jsx.js index af3c340559..2ec00c63bb 100644 --- a/test/manual/indent/js-jsx.js +++ b/test/manual/indent/js-jsx.js @@ -37,7 +37,7 @@ return ( React.render( , + />, { a: 1 } @@ -242,12 +242,18 @@ export default ({ stars }) => ( // JS expressions should not break indentation // (https://github.com/mooz/js2-mode/issues/462). +// +// In the referenced issue, the user actually wanted indentation which +// was simply different than Emacs’ SGML attribute indentation. +// Nevertheless, his issue highlighted our inability to properly +// indent code with JSX inside JSXExpressionContainers inside JSX. return ( - ( -
nothing
- )} /> + ( +
nothing
+ )} /> commit 8dae74236df2059b3df571f71733e2916ef55a58 Author: Jackson Ray Hamilton Date: Fri Mar 8 16:29:02 2019 -0800 Propertize and font-lock JSXText and JSXExpressionContainers This completes highlighting support for JSX, as requested in: - https://github.com/mooz/js2-mode/issues/140 - https://github.com/mooz/js2-mode/issues/330 - https://github.com/mooz/js2-mode/issues/409 * lisp/progmodes/js.el (js--name-start-chars): Extract part of js--name-start-re so it can be reused in another regexp. (js--name-start-re): Use js--name-start-chars. (js-jsx--font-lock-keywords): Use new matchers. (js-jsx--match-text, js-jsx--match-expr): New matchers to remove typical JS font-locking and extend the font-locked region, respectively. (js-jsx--tag-re, js-jsx--self-closing-re): New regexps matching JSX. (js-jsx--matched-tag-type, js-jsx--matching-close-tag-pos) (js-jsx--enclosing-curly-pos, js-jsx--enclosing-tag-pos) (js-jsx--at-enclosing-tag-child-p): New functions for parsing and analyzing JSX. (js-jsx--text-range, js-jsx--syntax-propertize-tag-text): New functions for propertizing JSXText. (js-jsx--syntax-propertize-tag): Propertize JSXText children of tags. (js-jsx--text-properties): Remove JSXText-related text properties when repropertizing. (js-mode): Extend the syntax-propertize region with syntax-propertize-multiline; we are now adding the syntax-multiline text property to buffer ranges that are JSXText to ensure the whole multiline JSX construct is reidentified. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 7fb4bcc808..220cf97fdc 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -66,7 +66,10 @@ ;;; Constants -(defconst js--name-start-re "[a-zA-Z_$]" +(defconst js--name-start-chars "a-zA-Z_$" + "Character class chars matching the start of a JavaScript identifier.") + +(defconst js--name-start-re (concat "[" js--name-start-chars "]") "Regexp matching the start of a JavaScript identifier, without grouping.") (defconst js--stmt-delim-chars "^;{}?:") @@ -1497,8 +1500,10 @@ point of view of font-lock. It applies highlighting directly with (defconst js-jsx--font-lock-keywords `((js-jsx--match-tag-name 0 font-lock-function-name-face t) (js-jsx--match-attribute-name 0 font-lock-variable-name-face t) + (js-jsx--match-text 0 'default t) ; “Undo” keyword fontification. (js-jsx--match-tag-beg) - (js-jsx--match-tag-end)) + (js-jsx--match-tag-end) + (js-jsx--match-expr)) "JSX font lock faces and multiline text properties.") (defun js-jsx--match-tag-name (limit) @@ -1523,6 +1528,19 @@ point of view of font-lock. It applies highlighting directly with (progn (set-match-data value) t)) (js-jsx--match-attribute-name limit)))))) +(defun js-jsx--match-text (limit) + "Match JSXText, until LIMIT." + (when js-jsx-syntax + (let ((pos (next-single-char-property-change (point) 'js-jsx-text nil limit)) + value) + (when (and pos (> pos (point))) + (goto-char pos) + (or (and (setq value (get-text-property pos 'js-jsx-text)) + (progn (set-match-data value) + (put-text-property (car value) (cadr value) 'font-lock-multiline t) + t)) + (js-jsx--match-text limit)))))) + (defun js-jsx--match-tag-beg (limit) "Match JSXBoundaryElements from start, until LIMIT." (when js-jsx-syntax @@ -1545,6 +1563,17 @@ point of view of font-lock. It applies highlighting directly with (progn (put-text-property value pos 'font-lock-multiline t) t)) (js-jsx--match-tag-end limit)))))) +(defun js-jsx--match-expr (limit) + "Match JSXExpressionContainers, until LIMIT." + (when js-jsx-syntax + (let ((pos (next-single-char-property-change (point) 'js-jsx-expr nil limit)) + value) + (when (and pos (> pos (point))) + (goto-char pos) + (or (and (setq value (get-text-property pos 'js-jsx-expr)) + (progn (put-text-property pos value 'font-lock-multiline t) t)) + (js-jsx--match-expr limit)))))) + (defconst js--font-lock-keywords-3 `( ;; This goes before keywords-2 so it gets used preferentially @@ -1835,6 +1864,177 @@ For use by `syntax-propertize-extend-region-functions'." (throw 'stop nil))))))) (if new-start (cons new-start end)))) +(defconst js-jsx--tag-re + (concat "<\\s-*\\(" + "[/>]" ; JSXClosingElement, or JSXOpeningFragment, or JSXClosingFragment + "\\|" + js--dotted-name-re "\\s-*[" js--name-start-chars "{/>]" ; JSXOpeningElement + "\\)") + "Regexp unambiguously matching a JSXBoundaryElement.") + +(defun js-jsx--matched-tag-type () + "Determine the tag type of the last match to `js-jsx--tag-re'. +Return `close' for a JSXClosingElement/JSXClosingFragment match, +return `self-closing' for some self-closing JSXOpeningElements, +else return `other'." + (let ((chars (vconcat (match-string 1)))) + (cond + ((= (aref chars 0) ?/) 'close) + ((= (aref chars (1- (length chars))) ?/) 'self-closing) + (t 'other)))) + +(defconst js-jsx--self-closing-re "/\\s-*>" + "Regexp matching the end of a self-closing JSXOpeningElement.") + +(defun js-jsx--matching-close-tag-pos () + "Return position of the closer of the opener before point. +Assuming a JSXOpeningElement or a JSXOpeningFragment is +immediately before point, find a matching JSXClosingElement or +JSXClosingFragment, skipping over any nested JSXElements to find +the match. Return nil if a match can’t be found." + (let ((tag-stack 1) self-closing-pos type) + (catch 'stop + (while (re-search-forward js-jsx--tag-re nil t) + (setq type (js-jsx--matched-tag-type)) + ;; Balance the total of self-closing tags that we subtract + ;; from the stack, ignoring those tags which are never added + ;; to the stack (see below). + (unless (eq type 'self-closing) + (when (and self-closing-pos (> (point) self-closing-pos)) + (setq tag-stack (1- tag-stack)))) + (if (eq type 'close) + (progn + (setq tag-stack (1- tag-stack)) + (when (= tag-stack 0) + (throw 'stop (match-beginning 0)))) + ;; Tags that we know are self-closing aren’t added to the + ;; stack at all, because we only close the ones that we have + ;; anticipated after moving past those anticipated tags’ + ;; ends, and if a self-closing tag is the first tag we + ;; encounter in this loop, then it will never be anticipated + ;; (due to an optimization where we sometimes can avoid + ;; looking for self-closing tags). + (unless (eq type 'self-closing) + (setq tag-stack (1+ tag-stack)))) + ;; Don’t needlessly recalculate. + (unless (and self-closing-pos (<= (point) self-closing-pos)) + (setq self-closing-pos nil) ; Reset if recalculating. + (save-excursion + ;; Anticipate a self-closing tag that we should make sure + ;; to subtract from the tag stack once we move past its + ;; end; we might might miss the end otherwise, due to the + ;; regexp-matching method we use to detect tags. + (when (re-search-forward js-jsx--self-closing-re nil t) + (setq self-closing-pos (match-beginning 0))))))))) + +(defun js-jsx--enclosing-curly-pos () + "Return position of enclosing “{” in a “{/}” pair about point." + (let ((parens (reverse (nth 9 (syntax-ppss)))) paren-pos curly-pos) + (while + (and + (setq paren-pos (car parens)) + (not (when (= (char-after paren-pos) ?{) + (setq curly-pos paren-pos))) + (setq parens (cdr parens)))) + curly-pos)) + +(defun js-jsx--enclosing-tag-pos () + "Return beginning and end of a JSXElement about point. +Look backward for a JSXElement that both starts before point and +also ends after point. That may be either a self-closing +JSXElement or a JSXOpeningElement/JSXClosingElement pair." + (let ((start (point)) + (curly-pos (save-excursion (js-jsx--enclosing-curly-pos))) + tag-beg tag-beg-pos tag-end-pos close-tag-pos) + (while + (and + (setq tag-beg (js--backward-text-property 'js-jsx-tag-beg)) + (progn + (setq tag-beg-pos (point) + tag-end-pos (cdr tag-beg)) + (not + (or + (and (eq (car tag-beg) 'self-closing) + (< start tag-end-pos)) + (and (eq (car tag-beg) 'open) + (save-excursion + (goto-char tag-end-pos) + (setq close-tag-pos (js-jsx--matching-close-tag-pos)) + ;; The JSXOpeningElement may either be unclosed, + ;; else the closure must occur after the start + ;; point (otherwise, a miscellaneous previous + ;; JSXOpeningElement has been found, and we should + ;; keep looking back for an enclosing one). + (or (not close-tag-pos) (< start close-tag-pos)))))))) + ;; Don’t return the last tag pos (if any; it wasn’t enclosing). + (setq tag-beg nil)) + (and tag-beg + (or (not curly-pos) (> tag-beg-pos curly-pos)) + (cons tag-beg-pos tag-end-pos)))) + +(defun js-jsx--at-enclosing-tag-child-p () + "Return t if point is at an enclosing tag’s child." + (let ((pos (save-excursion (js-jsx--enclosing-tag-pos)))) + (and pos (>= (point) (cdr pos))))) + +(defun js-jsx--text-range (beg end) + "Identify JSXText within a “>/{/}/<” pair." + (when (> (- end beg) 0) + (save-excursion + (goto-char beg) + (while (and (skip-chars-forward " \t\n" end) (< (point) end)) + ;; Comments and string quotes don’t serve their usual + ;; syntactic roles in JSXText; make them plain punctuation to + ;; negate those roles. + (when (or (= (char-after) ?/) ; comment + (= (syntax-class (syntax-after (point))) 7)) ; string quote + (put-text-property (point) (1+ (point)) 'syntax-table '(1))) + (forward-char))) + ;; Mark JSXText so it can be font-locked as non-keywords. + (put-text-property beg (1+ beg) 'js-jsx-text (list beg end (current-buffer))) + ;; Ensure future propertization beginning from within the + ;; JSXText determines JSXText context from earlier lines. + (put-text-property beg end 'syntax-multiline t))) + +(defun js-jsx--syntax-propertize-tag-text (end) + "Determine if JSXText is before END and propertize it. +Text within an open/close tag pair may be JSXText. Temporarily +interrupt JSXText by JSXExpressionContainers, and terminate +JSXText when another JSXBoundaryElement is encountered. Despite +terminations, all JSXText will be identified once all the +JSXBoundaryElements within an outermost JSXElement’s tree have +been propertized." + (let ((text-beg (point)) + forward-sexp-function) ; Use Lisp version. + (catch 'stop + (while (re-search-forward "[{<]" end t) + (js-jsx--text-range text-beg (1- (point))) + (cond + ((= (char-before) ?{) + (let (expr-beg expr-end) + (condition-case nil + (save-excursion + (backward-char) + (setq expr-beg (point)) + (forward-sexp) + (setq expr-end (point))) + (scan-error nil)) + ;; Recursively propertize the JSXExpressionContainer’s + ;; (possibly-incomplete) expression. + (js-syntax-propertize (1+ expr-beg) (if expr-end (min (1- expr-end) end) end)) + ;; Ensure future propertization beginning from within the + ;; (possibly-incomplete) expression can determine JSXText + ;; context from earlier lines. + (put-text-property expr-beg (1+ expr-beg) 'js-jsx-expr (or expr-end end)) ; font-lock + (put-text-property expr-beg (if expr-end (min expr-end end) end) 'syntax-multiline t) ; syntax-propertize + ;; Exit the JSXExpressionContainer if that’s possible, + ;; else move to the end of the propertized area. + (goto-char (if expr-end (min expr-end end) end)))) + ((= (char-before) ?<) + (backward-char) ; Ensure the next tag can be propertized. + (throw 'stop nil))) + (setq text-beg (point)))))) + (defun js-jsx--syntax-propertize-tag (end) "Determine if a JSXBoundaryElement is before END and propertize it. Disambiguate JSX from inequality operators and arrow functions by @@ -1916,12 +2116,16 @@ testing for syntax only valid as JSX." (when unambiguous ;; Save JSXBoundaryElement’s name’s match data for font-locking. (if name-beg (put-text-property name-beg (1+ name-beg) 'js-jsx-tag-name name-match-data)) - ;; Mark beginning and end of tag for features like indentation. + ;; Mark beginning and end of tag for font-locking. (put-text-property tag-beg (1+ tag-beg) 'js-jsx-tag-beg (cons type (point))) - (put-text-property (point) (1+ (point)) 'js-jsx-tag-end tag-beg)))) + (put-text-property (point) (1+ (point)) 'js-jsx-tag-end tag-beg)) + (if (js-jsx--at-enclosing-tag-child-p) (js-jsx--syntax-propertize-tag-text end)))) (defconst js-jsx--text-properties - '(js-jsx-tag-beg nil js-jsx-tag-end nil js-jsx-tag-name nil js-jsx-attribute-name nil) + (list + 'js-jsx-tag-beg nil 'js-jsx-tag-end nil + 'js-jsx-tag-name nil 'js-jsx-attribute-name nil + 'js-jsx-text nil 'js-jsx-expr nil) "Plist of text properties added by `js-syntax-propertize'.") (defun js-syntax-propertize (start end) @@ -4010,6 +4214,8 @@ If one hasn't been set, or if it's stale, prompt for a new one." '(font-lock-syntactic-face-function . js-font-lock-syntactic-face-function))) (setq-local syntax-propertize-function #'js-syntax-propertize) + (add-hook 'syntax-propertize-extend-region-functions + #'syntax-propertize-multiline 'append 'local) (add-hook 'syntax-propertize-extend-region-functions #'js--syntax-propertize-extend-region 'append 'local) (setq-local prettify-symbols-alist js--prettify-symbols-alist) commit 4d2b5bbfebc040ca477f1156b44989b4e19bbc3e Author: Jackson Ray Hamilton Date: Sun Feb 17 21:16:13 2019 -0800 Font-lock JSX while editing it by extending regions * lisp/progmodes/js.el (js-jsx--font-lock-keywords): Call tag beginning and end matchers. (js-jsx--match-tag-beg, js-jsx--match-tag-end): New functions. (js-jsx--syntax-propertize-tag): Record buffer positions of JSXElement beginning and end for font-locking. (js--syntax-propertize-extend-region) (js-jsx--syntax-propertize-extend-region): New functions for extending the syntax-propertize region backwards to the start of a JSXElement so its JSXAttribute children on its n+1th lines can be parsed as such while editing those lines. (js-mode): Add js--syntax-propertize-extend-region to syntax-propertize-extend-region-functions. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 1319fa1939..7fb4bcc808 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -1496,8 +1496,10 @@ point of view of font-lock. It applies highlighting directly with (defconst js-jsx--font-lock-keywords `((js-jsx--match-tag-name 0 font-lock-function-name-face t) - (js-jsx--match-attribute-name 0 font-lock-variable-name-face t)) - "JSX font lock faces.") + (js-jsx--match-attribute-name 0 font-lock-variable-name-face t) + (js-jsx--match-tag-beg) + (js-jsx--match-tag-end)) + "JSX font lock faces and multiline text properties.") (defun js-jsx--match-tag-name (limit) "Match JSXBoundaryElement names, until LIMIT." @@ -1521,6 +1523,28 @@ point of view of font-lock. It applies highlighting directly with (progn (set-match-data value) t)) (js-jsx--match-attribute-name limit)))))) +(defun js-jsx--match-tag-beg (limit) + "Match JSXBoundaryElements from start, until LIMIT." + (when js-jsx-syntax + (let ((pos (next-single-char-property-change (point) 'js-jsx-tag-beg nil limit)) + value) + (when (and pos (> pos (point))) + (goto-char pos) + (or (and (setq value (get-text-property pos 'js-jsx-tag-beg)) + (progn (put-text-property pos (cdr value) 'font-lock-multiline t) t)) + (js-jsx--match-tag-beg limit)))))) + +(defun js-jsx--match-tag-end (limit) + "Match JSXBoundaryElements from end, until LIMIT." + (when js-jsx-syntax + (let ((pos (next-single-char-property-change (point) 'js-jsx-tag-end nil limit)) + value) + (when (and pos (> pos (point))) + (goto-char pos) + (or (and (setq value (get-text-property pos 'js-jsx-tag-end)) + (progn (put-text-property value pos 'font-lock-multiline t) t)) + (js-jsx--match-tag-end limit)))))) + (defconst js--font-lock-keywords-3 `( ;; This goes before keywords-2 so it gets used preferentially @@ -1769,11 +1793,53 @@ This performs fontification according to `js--class-styles'." "Check if STRING is a unary operator keyword in JavaScript." (string-match-p js--unary-keyword-re string)) +(defun js--syntax-propertize-extend-region (start end) + "Extend the START-END region for propertization, if necessary. +For use by `syntax-propertize-extend-region-functions'." + (if js-jsx-syntax (js-jsx--syntax-propertize-extend-region start end))) + +(defun js-jsx--syntax-propertize-extend-region (start end) + "Extend the START-END region for propertization, if necessary. +If any “>” in the region appears to be the end of a tag starting +before the start of the region, extend region backwards to the +start of that tag so parsing may proceed from that point. +For use by `syntax-propertize-extend-region-functions'." + (let (new-start + forward-sexp-function ; Use the Lisp version. + parse-sexp-lookup-properties) ; Fix backward-sexp error here. + (catch 'stop + (goto-char start) + (while (re-search-forward ">" end t) + (catch 'continue + ;; Check if this is really a right shift bitwise operator + ;; (“>>” or “>>>”). + (unless (or (eq (char-before (1- (point))) ?>) + (eq (char-after) ?>)) + (save-excursion + (backward-char) + (while (progn (if (= (point) (point-min)) (throw 'continue nil)) + (/= (char-before) ?<)) + (skip-chars-backward " \t\n") + (if (= (point) (point-min)) (throw 'continue nil)) + (cond + ((memq (char-before) '(?\" ?\' ?\` ?\})) + (condition-case nil + (backward-sexp) + (scan-error (throw 'continue nil)))) + ((memq (char-before) '(?\/ ?\=)) (backward-char)) + ((looking-back js--dotted-name-re (line-beginning-position) t) + (goto-char (match-beginning 0))) + (t (throw 'continue nil)))) + (when (< (point) start) + (setq new-start (1- (point))) + (throw 'stop nil))))))) + (if new-start (cons new-start end)))) + (defun js-jsx--syntax-propertize-tag (end) "Determine if a JSXBoundaryElement is before END and propertize it. Disambiguate JSX from inequality operators and arrow functions by testing for syntax only valid as JSX." - (let ((tag-beg (1- (point))) tag-end (type 'open) + (let ((tag-beg (1- (point))) (type 'open) name-beg name-match-data unambiguous forward-sexp-function) ; Use Lisp version. (catch 'stop @@ -1783,8 +1849,7 @@ testing for syntax only valid as JSX." (cond ((= (char-after) ?>) (forward-char) - (setq unambiguous t - tag-end (point)) + (setq unambiguous t) (throw 'stop nil)) ;; Handle a JSXSpreadChild (“ Date: Sun Feb 17 00:38:01 2019 -0800 Add basic JSX font-locking Font-lock JSX from the beginning of the buffer to the end. Tends to break temporarily when editing lines, because the parser doesn’t yet look backwards to determine if the end of a tag in the current range starts before the range. This also re-breaks some tests fixed by previous commits, as we begin to take a different direction in our parsing code, looking for JSX, rather than for non-JSX. The parsing code will eventually provide information for indentation again. * lisp/progmodes/js.el (js--dotted-captured-name-re) (js-jsx--disambiguate-beginning-of-tag) (js-jsx--disambiguate-end-of-tag, js-jsx--disambiguate-syntax): Remove. (js-jsx--font-lock-keywords): New variable. (js--font-lock-keywords-3): Add JSX matchers. (js-jsx--match-tag-name, js-jsx--match-attribute-name): New functions. (js-jsx--syntax-propertize-tag): New function to aid in JSX font-locking and eventually indentation. (js-jsx--text-properties): New variable. (js-syntax-propertize): Propertize JSX properly using syntax-propertize-rules. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 4404ea04a0..1319fa1939 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -82,10 +82,6 @@ (concat js--name-re "\\(?:\\." js--name-re "\\)*") "Regexp matching a dot-separated sequence of JavaScript names.") -(defconst js--dotted-captured-name-re - (concat "\\(" js--name-re "\\)\\(?:\\." js--name-re "\\)*") - "Like `js--dotted-name-re', but capture the first name.") - (defconst js--cpp-name-re js--name-re "Regexp matching a C preprocessor name.") @@ -1498,6 +1494,33 @@ point of view of font-lock. It applies highlighting directly with ;; Matcher always "fails" nil) +(defconst js-jsx--font-lock-keywords + `((js-jsx--match-tag-name 0 font-lock-function-name-face t) + (js-jsx--match-attribute-name 0 font-lock-variable-name-face t)) + "JSX font lock faces.") + +(defun js-jsx--match-tag-name (limit) + "Match JSXBoundaryElement names, until LIMIT." + (when js-jsx-syntax + (let ((pos (next-single-char-property-change (point) 'js-jsx-tag-name nil limit)) + value) + (when (and pos (> pos (point))) + (goto-char pos) + (or (and (setq value (get-text-property pos 'js-jsx-tag-name)) + (progn (set-match-data value) t)) + (js-jsx--match-tag-name limit)))))) + +(defun js-jsx--match-attribute-name (limit) + "Match JSXAttribute names, until LIMIT." + (when js-jsx-syntax + (let ((pos (next-single-char-property-change (point) 'js-jsx-attribute-name nil limit)) + value) + (when (and pos (> pos (point))) + (goto-char pos) + (or (and (setq value (get-text-property pos 'js-jsx-attribute-name)) + (progn (set-match-data value) t)) + (js-jsx--match-attribute-name limit)))))) + (defconst js--font-lock-keywords-3 `( ;; This goes before keywords-2 so it gets used preferentially @@ -1609,7 +1632,10 @@ point of view of font-lock. It applies highlighting directly with (forward-symbol -1) (end-of-line)) '(end-of-line) - '(0 font-lock-variable-name-face)))) + '(0 font-lock-variable-name-face))) + + ;; jsx (when enabled) + ,@js-jsx--font-lock-keywords) "Level three font lock for `js-mode'.") (defun js--inside-pitem-p (pitem) @@ -1743,94 +1769,100 @@ This performs fontification according to `js--class-styles'." "Check if STRING is a unary operator keyword in JavaScript." (string-match-p js--unary-keyword-re string)) -(defun js-jsx--disambiguate-beginning-of-tag () - "Parse enough to determine if a JSX tag starts here. -Disambiguate JSX from equality operators by testing for syntax -only valid as JSX." - ;; “” - a JSXOpeningFragment. - (if (memq (char-after) '(?\/ ?\>)) t - (save-excursion - (skip-chars-forward " \t\n") - (and - (looking-at js--dotted-captured-name-re) - ;; Don’t match code like “if (i < await foo)” - (not (js--unary-keyword-p (match-string 1))) - (progn - (goto-char (match-end 0)) - (skip-chars-forward " \t\n") - (or - ;; “>”, “/>” - tag enders. - ;; “{” - a JSXExpressionContainer. - (memq (char-after) '(?\> ?\/ ?\{)) - ;; Check if a JSXAttribute follows. - (looking-at js--name-start-re))))))) - -(defun js-jsx--disambiguate-end-of-tag () - "Parse enough to determine if a JSX tag ends here. -Disambiguate JSX from equality operators by testing for syntax -only valid as JSX, or extremely unlikely except as JSX." - (save-excursion - (backward-char) - ;; “…/>” - a self-closing JSXOpeningElement. - ;; “” - a JSXClosingFragment. - (if (= (char-before) ?/) t - (let (last-tag-or-attr-name last-non-unary-p) - (catch 'match - (while t - (skip-chars-backward " \t\n") - ;; Check if the end of a JSXAttribute value or - ;; JSXExpressionContainer almost certainly precedes. - ;; The only valid JS this misses is - ;; - {} > foo - ;; - "bar" > foo - ;; which is no great loss, IMHO… - (if (memq (char-before) '(?\} ?\" ?\' ?\`)) (throw 'match t) - (if (and last-tag-or-attr-name last-non-unary-p - ;; “<”, “’ chars (from START to END) aren’t JSX. - -Later, this info prevents ‘sgml-’ functions from treating some -‘<’ and ‘>’ chars as parts of tokens of SGML tags — a good thing, -since they are serving their usual function as some JS equality -operator or arrow function, instead." - (goto-char start) - (while (re-search-forward "[<>]" end t) - (unless (if (eq (char-before) ?<) (js-jsx--disambiguate-beginning-of-tag) - (js-jsx--disambiguate-end-of-tag)) - ;; Inform sgml- functions that this >, >=, >>>, <, <=, <<<, or - ;; => token is punctuation (and not an open or close parenthesis - ;; as per usual in sgml-mode). - (put-text-property (1- (point)) (point) 'syntax-table '(1))))) +(defun js-jsx--syntax-propertize-tag (end) + "Determine if a JSXBoundaryElement is before END and propertize it. +Disambiguate JSX from inequality operators and arrow functions by +testing for syntax only valid as JSX." + (let ((tag-beg (1- (point))) tag-end (type 'open) + name-beg name-match-data unambiguous + forward-sexp-function) ; Use Lisp version. + (catch 'stop + (while (and (< (point) end) + (progn (skip-chars-forward " \t\n" end) + (< (point) end))) + (cond + ((= (char-after) ?>) + (forward-char) + (setq unambiguous t + tag-end (point)) + (throw 'stop nil)) + ;; Handle a JSXSpreadChild (“= (point) end) (throw 'stop nil)) + (skip-chars-forward " \t\n" end) + (if (>= (point) end) (throw 'stop nil)) + (if (= (char-after) ?}) (forward-char) ; Shortcut to bail. + ;; Recursively propertize the JSXExpressionContainer’s + ;; expression. + (js-syntax-propertize (point) (if expr-end (min (1- expr-end) end) end)) + ;; Exit the JSXExpressionContainer if that’s possible, + ;; else move to the end of the propertized area. + (goto-char (if expr-end (min expr-end end) end))))) + ((= (char-after) ?/) + ;; Assume a tag is an open tag until a slash is found, then + ;; figure out what type it actually is. + (if (eq type 'open) (setq type (if name-beg 'self-closing 'close))) + (forward-char)) + ((looking-at js--dotted-name-re) + (if (not name-beg) + (progn + ;; Don’t match code like “if (i < await foo)” + (if (js--unary-keyword-p (match-string 0)) (throw 'stop nil)) + ;; Save boundaries for later fontification after + ;; unambiguously determining the code is JSX. + (setq name-beg (match-beginning 0) + name-match-data (match-data)) + (goto-char (match-end 0))) + (setq unambiguous t) ; Non-unary name followed by 2nd name ⇒ JSX + ;; Save JSXAttribute’s name’s match data for font-locking later. + (put-text-property (match-beginning 0) (1+ (match-beginning 0)) + 'js-jsx-attribute-name (match-data)) + (goto-char (match-end 0)) + (if (>= (point) end) (throw 'stop nil)) + (skip-chars-forward " \t\n" end) + (if (>= (point) end) (throw 'stop nil)) + ;; “=” is optional for null-valued JSXAttributes. + (when (= (char-after) ?=) + (forward-char) + (if (>= (point) end) (throw 'stop nil)) + (skip-chars-forward " \t\n" end) + (if (>= (point) end) (throw 'stop nil)) + ;; Skip over strings (if possible). Any + ;; JSXExpressionContainer here will be parsed in the + ;; next iteration of the loop. + (when (memq (char-after) '(?\" ?\' ?\`)) + (condition-case nil + (forward-sexp) + (scan-error (throw 'stop nil))))))) + ;; There is nothing more to check; this either isn’t JSX, or + ;; the tag is incomplete. + (t (throw 'stop nil))))) + (when unambiguous + ;; Save JSXBoundaryElement’s name’s match data for font-locking. + (if name-beg (put-text-property name-beg (1+ name-beg) 'js-jsx-tag-name name-match-data)) + ;; Mark beginning and end of tag for features like indentation. + (put-text-property tag-beg (1+ tag-beg) 'js-jsx-tag-beg type) + (if tag-end (put-text-property (1- tag-end) tag-end 'js-jsx-tag-end tag-beg))))) + +(defconst js-jsx--text-properties + '(js-jsx-tag-beg nil js-jsx-tag-end nil js-jsx-tag-name nil js-jsx-attribute-name nil) + "Plist of text properties added by `js-syntax-propertize'.") (defun js-syntax-propertize (start end) ;; JavaScript allows immediate regular expression objects, written /.../. (goto-char start) + (if js-jsx-syntax (remove-text-properties start end js-jsx--text-properties)) (js-syntax-propertize-regexp end) (funcall (syntax-propertize-rules @@ -1854,9 +1886,9 @@ operator or arrow function, instead." (put-text-property (match-beginning 1) (match-end 1) 'syntax-table (string-to-syntax "\"/")) (js-syntax-propertize-regexp end))))) - ("\\`\\(#\\)!" (1 "< b"))) - (point) end) - (if js-jsx-syntax (js-jsx--disambiguate-syntax start end))) + ("\\`\\(#\\)!" (1 "< b")) + ("<" (0 (ignore (if js-jsx-syntax (js-jsx--syntax-propertize-tag end)))))) + (point) end)) (defconst js--prettify-symbols-alist '(("=>" . ?⇒) commit 6f535762df1f8f55faa36878d4a2a0a8b112f666 Author: Jackson Ray Hamilton Date: Fri Feb 15 22:15:11 2019 -0800 Use js-jsx- prefix for functions and variables * lisp/progmodes/js.el (js--disambiguate-beginning-of-jsx-tag): Rename to js-jsx--disambiguate-beginning-of-tag. (js--disambiguate-end-of-jsx-tag): Rename to js-jsx--disambiguate-end-of-tag. (js--disambiguate-js-from-jsx): Rename to js-jsx--disambiguate-syntax. (js--jsx-start-tag-re): Rename to js-jsx--start-tag-re. (js--looking-at-jsx-start-tag-p): Rename to js-jsx--looking-at-start-tag-p. (js--jsx-end-tag-re): Rename to js-jsx--end-tag-re. (js--looking-back-at-jsx-end-tag-p): Rename to js-jsx--looking-back-at-end-tag-p. (js--as-sgml): Rename to js-jsx--as-sgml. (js--outermost-enclosing-jsx-tag-pos): Rename to js-jsx--outermost-enclosing-tag-pos. (js--jsx-indentation): Rename to js-jsx--indentation-type. (js--indent-line-in-jsx-expression): Rename to js-jsx--indent-line-in-expression. (js--indent-n+1th-jsx-line): Rename to js-jsx--indent-n+1th-line. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index d0556f3538..4404ea04a0 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -1743,7 +1743,7 @@ This performs fontification according to `js--class-styles'." "Check if STRING is a unary operator keyword in JavaScript." (string-match-p js--unary-keyword-re string)) -(defun js--disambiguate-beginning-of-jsx-tag () +(defun js-jsx--disambiguate-beginning-of-tag () "Parse enough to determine if a JSX tag starts here. Disambiguate JSX from equality operators by testing for syntax only valid as JSX." @@ -1766,7 +1766,7 @@ only valid as JSX." ;; Check if a JSXAttribute follows. (looking-at js--name-start-re))))))) -(defun js--disambiguate-end-of-jsx-tag () +(defun js-jsx--disambiguate-end-of-tag () "Parse enough to determine if a JSX tag ends here. Disambiguate JSX from equality operators by testing for syntax only valid as JSX, or extremely unlikely except as JSX." @@ -1812,7 +1812,7 @@ only valid as JSX, or extremely unlikely except as JSX." ;; Nothing else to look for; give up parsing. (throw 'match nil))))))))) -(defun js--disambiguate-js-from-jsx (start end) +(defun js-jsx--disambiguate-syntax (start end) "Figure out which ‘<’ and ‘>’ chars (from START to END) aren’t JSX. Later, this info prevents ‘sgml-’ functions from treating some @@ -1821,8 +1821,8 @@ since they are serving their usual function as some JS equality operator or arrow function, instead." (goto-char start) (while (re-search-forward "[<>]" end t) - (unless (if (eq (char-before) ?<) (js--disambiguate-beginning-of-jsx-tag) - (js--disambiguate-end-of-jsx-tag)) + (unless (if (eq (char-before) ?<) (js-jsx--disambiguate-beginning-of-tag) + (js-jsx--disambiguate-end-of-tag)) ;; Inform sgml- functions that this >, >=, >>>, <, <=, <<<, or ;; => token is punctuation (and not an open or close parenthesis ;; as per usual in sgml-mode). @@ -1856,7 +1856,7 @@ operator or arrow function, instead." (js-syntax-propertize-regexp end))))) ("\\`\\(#\\)!" (1 "< b"))) (point) end) - (if js-jsx-syntax (js--disambiguate-js-from-jsx start end))) + (if js-jsx-syntax (js-jsx--disambiguate-syntax start end))) (defconst js--prettify-symbols-alist '(("=>" . ?⇒) @@ -1881,13 +1881,13 @@ operator or arrow function, instead." (js--regexp-opt-symbol '("in" "instanceof"))) "Regexp matching operators that affect indentation of continued expressions.") -(defconst js--jsx-start-tag-re +(defconst js-jsx--start-tag-re (concat "<" sgml-name-re) "Regexp matching code that looks like a JSXOpeningElement.") -(defun js--looking-at-jsx-start-tag-p () +(defun js-jsx--looking-at-start-tag-p () "Non-nil if a JSXOpeningElement immediately follows point." - (looking-at js--jsx-start-tag-re)) + (looking-at js-jsx--start-tag-re)) (defun js--looking-at-operator-p () "Return non-nil if point is on a JavaScript operator, other than a comma." @@ -1913,7 +1913,7 @@ operator or arrow function, instead." ;; return NaN anyway. Shouldn't be a problem. (memq (char-before) '(?, ?} ?{))))) ;; “<” isn’t necessarily an operator in JSX. - (not (and js-jsx-syntax (js--looking-at-jsx-start-tag-p)))))) + (not (and js-jsx-syntax (js-jsx--looking-at-start-tag-p)))))) (defun js--find-newline-backward () "Move backward to the nearest newline that is not in a block comment." @@ -1933,13 +1933,13 @@ operator or arrow function, instead." (setq result nil))) result)) -(defconst js--jsx-end-tag-re +(defconst js-jsx--end-tag-re (concat "\\|/>") "Regexp matching a JSXClosingElement.") -(defun js--looking-back-at-jsx-end-tag-p () +(defun js-jsx--looking-back-at-end-tag-p () "Non-nil if a JSXClosingElement immediately precedes point." - (looking-back js--jsx-end-tag-re (point-at-bol))) + (looking-back js-jsx--end-tag-re (point-at-bol))) (defun js--continued-expression-p () "Return non-nil if the current line continues an expression." @@ -1961,7 +1961,7 @@ operator or arrow function, instead." (and ;; The “>” at the end of any JSXBoundaryElement isn’t ;; part of a continued expression. - (not (and js-jsx-syntax (js--looking-back-at-jsx-end-tag-p))) + (not (and js-jsx-syntax (js-jsx--looking-back-at-end-tag-p))) (progn (or (bobp) (backward-char)) (and (> (point) (point-min)) @@ -2285,14 +2285,14 @@ current line is the \"=>\" token." ;;; JSX Indentation -(defmacro js--as-sgml (&rest body) +(defmacro js-jsx--as-sgml (&rest body) "Execute BODY as if in sgml-mode." `(with-syntax-table sgml-mode-syntax-table ,@body)) -(defun js--outermost-enclosing-jsx-tag-pos () +(defun js-jsx--outermost-enclosing-tag-pos () (let (context tag-pos last-tag-pos parse-status parens paren-pos curly-pos) - (js--as-sgml + (js-jsx--as-sgml ;; Search until we reach the top or encounter the start of a ;; JSXExpressionContainer (implying nested JSX). (while (and (setq context (sgml-get-context)) @@ -2322,7 +2322,7 @@ current line is the \"=>\" token." (goto-char tag-pos)))) last-tag-pos)) -(defun js--jsx-indentation () +(defun js-jsx--indentation-type () "Determine if/how the current line should be indented as JSX. Return nil for first JSXElement line (indent like JS). @@ -2336,7 +2336,7 @@ Return nil for non-JSX lines." (save-excursion ;; Determine if inside a JSXElement. (beginning-of-line) ; For exclusivity - (when (setq tag-start-pos (js--outermost-enclosing-jsx-tag-pos)) + (when (setq tag-start-pos (js-jsx--outermost-enclosing-tag-pos)) ;; Check if inside an embedded multi-line JS expression. (goto-char current-pos) (end-of-line) ; For exclusivity @@ -2369,14 +2369,14 @@ Return nil for non-JSX lines." (setq parens (cdr parens))))) (or type 'n+1th))))) -(defun js--indent-line-in-jsx-expression () +(defun js-jsx--indent-line-in-expression () "Indent the current line as JavaScript within JSX." (let ((parse-status (save-excursion (syntax-ppss (point-at-bol)))) offset indent-col) (unless (nth 3 parse-status) (save-excursion (setq offset (- (point) (progn (back-to-indentation) (point))) - indent-col (js--as-sgml (sgml-calculate-indent)))) + indent-col (js-jsx--as-sgml (sgml-calculate-indent)))) (if (null indent-col) 'noindent ; Like in sgml-mode ;; Use whichever indentation column is greater, such that the ;; SGML column is effectively a minimum. @@ -2384,9 +2384,9 @@ Return nil for non-JSX lines." (+ indent-col js-indent-level))) (when (> offset 0) (forward-char offset)))))) -(defun js--indent-n+1th-jsx-line () +(defun js-jsx--indent-n+1th-line () "Indent the current line as JSX within JavaScript." - (js--as-sgml (sgml-indent-line))) + (js-jsx--as-sgml (sgml-indent-line))) (defun js-indent-line () "Indent the current line as JavaScript." @@ -2403,10 +2403,10 @@ Return nil for non-JSX lines." i.e., customize JSX element indentation with `sgml-basic-offset', `sgml-attribute-offset' et al." (interactive) - (let ((type (js--jsx-indentation))) + (let ((type (js-jsx--indentation-type))) (if type - (if (eq type 'n+1th) (js--indent-n+1th-jsx-line) - (js--indent-line-in-jsx-expression)) + (if (eq type 'n+1th) (js-jsx--indent-n+1th-line) + (js-jsx--indent-line-in-expression)) (js-indent-line)))) ;;; Filling commit be86ece42cbb6204480c794d018b02fbda74689b Author: Jackson Ray Hamilton Date: Mon Feb 11 03:00:34 2019 -0800 js-syntax-propertize: Disambiguate JS from JSX, fixing some indents Fix some JSX indentation bugs: - Bug#24896 / https://github.com/mooz/js2-mode/issues/389 - Bug#30225 - https://github.com/mooz/js2-mode/issues/459 * lisp/progmodes/js.el (js--dotted-captured-name-re) (js--unary-keyword-re, js--unary-keyword-p) (js--disambiguate-beginning-of-jsx-tag) (js--disambiguate-end-of-jsx-tag) (js--disambiguate-js-from-jsx): New variables and functions. (js-syntax-propertize): Additionally clarify when syntax is JS so that ‘(with-syntax-table sgml-mode-syntax-table …)’ does not mistake some JS punctuation syntax for SGML parenthesis syntax, namely ‘<’ and ‘>’. * test/manual/indent/js-jsx-unclosed-2.js: Add additional test for unary operator parsing. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 5b992535a8..d0556f3538 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -82,6 +82,10 @@ (concat js--name-re "\\(?:\\." js--name-re "\\)*") "Regexp matching a dot-separated sequence of JavaScript names.") +(defconst js--dotted-captured-name-re + (concat "\\(" js--name-re "\\)\\(?:\\." js--name-re "\\)*") + "Like `js--dotted-name-re', but capture the first name.") + (defconst js--cpp-name-re js--name-re "Regexp matching a C preprocessor name.") @@ -1731,6 +1735,99 @@ This performs fontification according to `js--class-styles'." 'syntax-table (string-to-syntax "\"/")) (goto-char end))))) +(defconst js--unary-keyword-re + (js--regexp-opt-symbol '("await" "delete" "typeof" "void" "yield")) + "Regexp matching unary operator keywords.") + +(defun js--unary-keyword-p (string) + "Check if STRING is a unary operator keyword in JavaScript." + (string-match-p js--unary-keyword-re string)) + +(defun js--disambiguate-beginning-of-jsx-tag () + "Parse enough to determine if a JSX tag starts here. +Disambiguate JSX from equality operators by testing for syntax +only valid as JSX." + ;; “” - a JSXOpeningFragment. + (if (memq (char-after) '(?\/ ?\>)) t + (save-excursion + (skip-chars-forward " \t\n") + (and + (looking-at js--dotted-captured-name-re) + ;; Don’t match code like “if (i < await foo)” + (not (js--unary-keyword-p (match-string 1))) + (progn + (goto-char (match-end 0)) + (skip-chars-forward " \t\n") + (or + ;; “>”, “/>” - tag enders. + ;; “{” - a JSXExpressionContainer. + (memq (char-after) '(?\> ?\/ ?\{)) + ;; Check if a JSXAttribute follows. + (looking-at js--name-start-re))))))) + +(defun js--disambiguate-end-of-jsx-tag () + "Parse enough to determine if a JSX tag ends here. +Disambiguate JSX from equality operators by testing for syntax +only valid as JSX, or extremely unlikely except as JSX." + (save-excursion + (backward-char) + ;; “…/>” - a self-closing JSXOpeningElement. + ;; “” - a JSXClosingFragment. + (if (= (char-before) ?/) t + (let (last-tag-or-attr-name last-non-unary-p) + (catch 'match + (while t + (skip-chars-backward " \t\n") + ;; Check if the end of a JSXAttribute value or + ;; JSXExpressionContainer almost certainly precedes. + ;; The only valid JS this misses is + ;; - {} > foo + ;; - "bar" > foo + ;; which is no great loss, IMHO… + (if (memq (char-before) '(?\} ?\" ?\' ?\`)) (throw 'match t) + (if (and last-tag-or-attr-name last-non-unary-p + ;; “<”, “’ chars (from START to END) aren’t JSX. + +Later, this info prevents ‘sgml-’ functions from treating some +‘<’ and ‘>’ chars as parts of tokens of SGML tags — a good thing, +since they are serving their usual function as some JS equality +operator or arrow function, instead." + (goto-char start) + (while (re-search-forward "[<>]" end t) + (unless (if (eq (char-before) ?<) (js--disambiguate-beginning-of-jsx-tag) + (js--disambiguate-end-of-jsx-tag)) + ;; Inform sgml- functions that this >, >=, >>>, <, <=, <<<, or + ;; => token is punctuation (and not an open or close parenthesis + ;; as per usual in sgml-mode). + (put-text-property (1- (point)) (point) 'syntax-table '(1))))) + (defun js-syntax-propertize (start end) ;; JavaScript allows immediate regular expression objects, written /.../. (goto-char start) @@ -1758,7 +1855,8 @@ This performs fontification according to `js--class-styles'." 'syntax-table (string-to-syntax "\"/")) (js-syntax-propertize-regexp end))))) ("\\`\\(#\\)!" (1 "< b"))) - (point) end)) + (point) end) + (if js-jsx-syntax (js--disambiguate-js-from-jsx start end))) (defconst js--prettify-symbols-alist '(("=>" . ?⇒) diff --git a/test/manual/indent/js-jsx-unclosed-2.js b/test/manual/indent/js-jsx-unclosed-2.js index 2d42cf70f8..8b6f33325d 100644 --- a/test/manual/indent/js-jsx-unclosed-2.js +++ b/test/manual/indent/js-jsx-unclosed-2.js @@ -15,3 +15,17 @@ if (foo > bar) void 0 // Don’t even misinterpret unary operators as JSX. if (foo < await bar) void 0 while (await foo > bar) void 0 + +// Allow unary keyword names as null-valued JSX attributes. +// (As if this will EVER happen…) + + + + + How would we ever live without unary support + + + + commit 27e9bce77db54464737aa5be1ce7142b55f25952 Author: Jackson Ray Hamilton Date: Sun Feb 10 21:11:17 2019 -0800 Add new (failing) unclosed JSX test and separate such tests * test/manual/indent/js-jsx.js: Move test with intentional scan error to its own file, js-jsx-unclosed-1.js. * test/manual/indent/js-jsx-unclosed-1.js: New file. * test/manual/indent/js-jsx-unclosed-2.js: New file with test for regression caused by new ambiguous parsing of JS/JSX. diff --git a/test/manual/indent/js-jsx-unclosed-1.js b/test/manual/indent/js-jsx-unclosed-1.js new file mode 100644 index 0000000000..9418aed7a1 --- /dev/null +++ b/test/manual/indent/js-jsx-unclosed-1.js @@ -0,0 +1,15 @@ +// -*- mode: js-jsx; -*- + +// Local Variables: +// indent-tabs-mode: nil +// js-indent-level: 2 +// End: + +// The following test goes below any comments to avoid including +// misindented comments among the erroring lines. + +return ( +
+ {array.map(function () { + return { + a: 1 diff --git a/test/manual/indent/js-jsx-unclosed-2.js b/test/manual/indent/js-jsx-unclosed-2.js new file mode 100644 index 0000000000..2d42cf70f8 --- /dev/null +++ b/test/manual/indent/js-jsx-unclosed-2.js @@ -0,0 +1,17 @@ +// -*- mode: js-jsx; -*- + +// Local Variables: +// indent-tabs-mode: nil +// js-indent-level: 2 +// End: + +// The following tests go below any comments to avoid including +// misindented comments among the erroring lines. + +// Don’t misinterpret equality operators as JSX. +for (; i < length;) void 0 +if (foo > bar) void 0 + +// Don’t even misinterpret unary operators as JSX. +if (foo < await bar) void 0 +while (await foo > bar) void 0 diff --git a/test/manual/indent/js-jsx.js b/test/manual/indent/js-jsx.js index 35ca4b275a..af3c340559 100644 --- a/test/manual/indent/js-jsx.js +++ b/test/manual/indent/js-jsx.js @@ -257,12 +257,3 @@ return ( // indent-tabs-mode: nil // js-indent-level: 2 // End: - -// The following test has intentionally unclosed elements and should -// be placed below all other tests to prevent awkward indentation. - -return ( -
- {array.map(function () { - return { - a: 1 commit 4b305bb185596dff5d02cf54da7a41c3e082b7d4 Author: Jackson Ray Hamilton Date: Sat Feb 9 20:06:29 2019 -0800 Refactor JSX indentation code to improve enclosing JSX discovery Fix a number of bugs reported for JSX indentation (caused by poor JSX detection): - https://github.com/mooz/js2-mode/issues/140#issuecomment-166250016 - https://github.com/mooz/js2-mode/issues/490 - Bug#24896 / https://github.com/mooz/js2-mode/issues/389 (with respect to comments) - Bug#26001 / https://github.com/mooz/js2-mode/issues/389#issuecomment-271869380 - https://github.com/mooz/js2-mode/issues/411 / Bug#27000 / https://github.com/mooz/js2-mode/issues/451 Potentially manifest some new bugs (due to false positives with ‘<’ and ‘>’ and SGML detection). Slow down indentation a fair bit. * list/progmodes/js.el (js-jsx-syntax, js--jsx-start-tag-re) (js--looking-at-jsx-start-tag-p, js--looking-back-at-jsx-end-tag-p): New variables and functions. (js--jsx-find-before-tag, js--jsx-after-tag-re): Deleted. (js--looking-at-operator-p): Don’t mistake a JSXOpeningElement for the ‘<’ operator. (js--continued-expression-p): Don’t mistake a JSXClosingElement as a fragment of a continued expression including the ‘>’ operator. (js--as-sgml): Simplify. Probably needn’t bind forward-sexp-function to nil (sgml-mode already does) and probably shouldn’t bind parse-sexp-lookup-properties to nil either (see Bug#24896). (js--outermost-enclosing-jsx-tag-pos): Find enclosing JSX more accurately than js--jsx-find-before-tag. Use sgml-mode’s parsing logic, rather than unreliable heuristics like paren-wrapping. This implementation is much slower; the previous implementation was fast, but at the expense of accuracy. To make up for all the grief we’ve caused users, we will prefer accuracy over speed from now on. That said, this can still probably be optimized a lot. (js--jsx-indented-element-p): Rename to js--jsx-indentation, since it doesn’t just return a boolean. (js--jsx-indentation): Refactor js--jsx-indented-element-p to simplify the implementation as the improved accuracy of other code allows (and to repent for some awful stylistic choices I made earlier). (js--expression-in-sgml-indent-line): Rename to js--indent-line-in-jsx-expression, since it’s a private function and we can give it a name that reads more like English. (js--indent-line-in-jsx-expression): Restructure point adjustment logic more like js-indent-line. (js--indent-n+1th-jsx-line): New function to complement js--indent-line-in-jsx-expression. (js-jsx-indent-line): Refactor. Don’t bind js--continued-expression-p to ignore any more; instead, rely on the improved accuracy of js--continued-expression-p. (js-jsx-mode): Set js-jsx-syntax to t. For now, this will be the flag we use to determine whether ‘JSX is enabled.’ (Maybe later, we will refactor the code to use this variable instead of requiring js-jsx-mode to be enabled, thus rendering the mode obsolete.) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 4d91da7334..5b992535a8 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -572,6 +572,15 @@ then the \".\"s will be lined up: :safe 'booleanp :group 'js) +(defcustom js-jsx-syntax nil + "When non-nil, parse JavaScript with consideration for JSX syntax. +This fixes indentation of JSX code in some cases. It is set to +be buffer-local when in `js-jsx-mode'." + :version "27.1" + :type 'boolean + :safe 'booleanp + :group 'js) + ;;; KeyMap (defvar js-mode-map @@ -1774,6 +1783,14 @@ This performs fontification according to `js--class-styles'." (js--regexp-opt-symbol '("in" "instanceof"))) "Regexp matching operators that affect indentation of continued expressions.") +(defconst js--jsx-start-tag-re + (concat "<" sgml-name-re) + "Regexp matching code that looks like a JSXOpeningElement.") + +(defun js--looking-at-jsx-start-tag-p () + "Non-nil if a JSXOpeningElement immediately follows point." + (looking-at js--jsx-start-tag-re)) + (defun js--looking-at-operator-p () "Return non-nil if point is on a JavaScript operator, other than a comma." (save-match-data @@ -1796,7 +1813,9 @@ This performs fontification according to `js--class-styles'." (js--backward-syntactic-ws) ;; We might misindent some expressions that would ;; return NaN anyway. Shouldn't be a problem. - (memq (char-before) '(?, ?} ?{)))))))) + (memq (char-before) '(?, ?} ?{))))) + ;; “<” isn’t necessarily an operator in JSX. + (not (and js-jsx-syntax (js--looking-at-jsx-start-tag-p)))))) (defun js--find-newline-backward () "Move backward to the nearest newline that is not in a block comment." @@ -1816,6 +1835,14 @@ This performs fontification according to `js--class-styles'." (setq result nil))) result)) +(defconst js--jsx-end-tag-re + (concat "\\|/>") + "Regexp matching a JSXClosingElement.") + +(defun js--looking-back-at-jsx-end-tag-p () + "Non-nil if a JSXClosingElement immediately precedes point." + (looking-back js--jsx-end-tag-re (point-at-bol))) + (defun js--continued-expression-p () "Return non-nil if the current line continues an expression." (save-excursion @@ -1833,12 +1860,19 @@ This performs fontification according to `js--class-styles'." (and (js--find-newline-backward) (progn (skip-chars-backward " \t") - (or (bobp) (backward-char)) - (and (> (point) (point-min)) - (save-excursion (backward-char) (not (looking-at "[/*]/\\|=>"))) - (js--looking-at-operator-p) - (and (progn (backward-char) - (not (looking-at "\\+\\+\\|--\\|/[/*]")))))))))) + (and + ;; The “>” at the end of any JSXBoundaryElement isn’t + ;; part of a continued expression. + (not (and js-jsx-syntax (js--looking-back-at-jsx-end-tag-p))) + (progn + (or (bobp) (backward-char)) + (and (> (point) (point-min)) + (save-excursion + (backward-char) + (not (looking-at "[/*]/\\|=>"))) + (js--looking-at-operator-p) + (and (progn (backward-char) + (not (looking-at "\\+\\+\\|--\\|/[/*]")))))))))))) (defun js--skip-term-backward () "Skip a term before point; return t if a term was skipped." @@ -2153,190 +2187,108 @@ current line is the \"=>\" token." ;;; JSX Indentation -(defsubst js--jsx-find-before-tag () - "Find where JSX starts. - -Assume JSX appears in the following instances: -- Inside parentheses, when returned or as the first argument - to a function, and after a newline -- When assigned to variables or object properties, but only - on a single line -- As the N+1th argument to a function - -This is an optimized version of (re-search-backward \"[(,]\n\" -nil t), except set point to the end of the match. This logic -executes up to the number of lines in the file, so it should be -really fast to reduce that impact." - (let (pos) - (while (and (> (point) (point-min)) - (not (progn - (end-of-line 0) - (when (or (eq (char-before) 40) ; ( - (eq (char-before) 44)) ; , - (setq pos (1- (point)))))))) - pos)) - -(defconst js--jsx-end-tag-re - (concat "\\|/>") - "Find the end of a JSX element.") - -(defconst js--jsx-after-tag-re "[),]" - "Find where JSX ends. -This complements the assumption of where JSX appears from -`js--jsx-before-tag-re', which see.") - -(defun js--jsx-indented-element-p () +(defmacro js--as-sgml (&rest body) + "Execute BODY as if in sgml-mode." + `(with-syntax-table sgml-mode-syntax-table + ,@body)) + +(defun js--outermost-enclosing-jsx-tag-pos () + (let (context tag-pos last-tag-pos parse-status parens paren-pos curly-pos) + (js--as-sgml + ;; Search until we reach the top or encounter the start of a + ;; JSXExpressionContainer (implying nested JSX). + (while (and (setq context (sgml-get-context)) + (progn + (setq tag-pos (sgml-tag-start (car (last context)))) + (or (not curly-pos) + ;; Stop before curly brackets (start of a + ;; JSXExpressionContainer). + (> tag-pos curly-pos)))) + ;; Record this position so it can potentially be returned. + (setq last-tag-pos tag-pos) + ;; Always parse sexps / search for the next context from the + ;; immediately enclosing tag (sgml-get-context may not leave + ;; point there). + (goto-char tag-pos) + (unless parse-status ; Don’t needlessly reparse. + ;; Search upward for an enclosing starting curly bracket. + (setq parse-status (syntax-ppss)) + (setq parens (reverse (nth 9 parse-status))) + (while (and (setq paren-pos (car parens)) + (not (when (= (char-after paren-pos) ?{) + (setq curly-pos paren-pos)))) + (setq parens (cdr parens))) + ;; Always search for the next context from the immediately + ;; enclosing tag (calling syntax-ppss in the above loop + ;; may move point from there). + (goto-char tag-pos)))) + last-tag-pos)) + +(defun js--jsx-indentation () "Determine if/how the current line should be indented as JSX. -Return `first' for the first JSXElement on its own line. -Return `nth' for subsequent lines of the first JSXElement. -Return `expression' for an embedded JS expression. -Return `after' for anything after the last JSXElement. -Return nil for non-JSX lines. - -Currently, JSX indentation supports the following styles: - -- Single-line elements (indented like normal JS): - - var element =
; - -- Multi-line elements (enclosed in parentheses): - - function () { - return ( -
-
-
- ); - } - -- Function arguments: - - React.render( -
, - document.querySelector('.root') - );" +Return nil for first JSXElement line (indent like JS). +Return `n+1th' for second+ JSXElement lines (indent like SGML). +Return `expression' for lines within embedded JS expressions + (indent like JS inside SGML). +Return nil for non-JSX lines." (let ((current-pos (point)) (current-line (line-number-at-pos)) - last-pos - before-tag-pos before-tag-line - tag-start-pos tag-start-line - tag-end-pos tag-end-line - after-tag-line - parens paren type) + tag-start-pos parens paren type) (save-excursion - (and - ;; Determine if we're inside a jsx element - (progn - (end-of-line) - (while (and (not tag-start-pos) - (setq last-pos (js--jsx-find-before-tag))) - (while (forward-comment 1)) - (when (= (char-after) 60) ; < - (setq before-tag-pos last-pos - tag-start-pos (point))) - (goto-char last-pos)) - tag-start-pos) - (progn - (setq before-tag-line (line-number-at-pos before-tag-pos) - tag-start-line (line-number-at-pos tag-start-pos)) - (and - ;; A "before" line which also starts an element begins with js, so - ;; indent it like js - (> current-line before-tag-line) - ;; Only indent the jsx lines like jsx - (>= current-line tag-start-line))) - (cond - ;; Analyze bounds if there are any - ((progn - (while (and (not tag-end-pos) - (setq last-pos (re-search-forward js--jsx-end-tag-re nil t))) - (while (forward-comment 1)) - (when (looking-at js--jsx-after-tag-re) - (setq tag-end-pos last-pos))) - tag-end-pos) - (setq tag-end-line (line-number-at-pos tag-end-pos) - after-tag-line (line-number-at-pos after-tag-line)) - (or (and - ;; Ensure we're actually within the bounds of the jsx - (<= current-line tag-end-line) - ;; An "after" line which does not end an element begins with - ;; js, so indent it like js - (<= current-line after-tag-line)) - (and - ;; Handle another case where there could be e.g. comments after - ;; the element - (> current-line tag-end-line) - (< current-line after-tag-line) - (setq type 'after)))) - ;; They may not be any bounds (yet) - (t)) - ;; Check if we're inside an embedded multi-line js expression - (cond - ((not type) - (goto-char current-pos) - (end-of-line) - (setq parens (nth 9 (syntax-ppss))) - (while (and parens (not type)) - (setq paren (car parens)) - (cond - ((and (>= paren tag-start-pos) - ;; Curly bracket indicates the start of an embedded expression - (= (char-after paren) 123) ; { - ;; The first line of the expression is indented like sgml + ;; Determine if inside a JSXElement. + (beginning-of-line) ; For exclusivity + (when (setq tag-start-pos (js--outermost-enclosing-jsx-tag-pos)) + ;; Check if inside an embedded multi-line JS expression. + (goto-char current-pos) + (end-of-line) ; For exclusivity + (setq parens (nth 9 (syntax-ppss))) + (while + (and + (setq paren (car parens)) + (if (and + (>= paren tag-start-pos) + ;; A curly bracket indicates the start of an + ;; embedded expression. + (= (char-after paren) ?{) + ;; The first line of the expression is indented + ;; like SGML. (> current-line (line-number-at-pos paren)) ;; Check if within a closing curly bracket (if any) - ;; (exclusive, as the closing bracket is indented like sgml) - (cond - ((progn - (goto-char paren) - (ignore-errors (let (forward-sexp-function) - (forward-sexp)))) - (< current-line (line-number-at-pos))) - (t))) - ;; Indicate this guy will be indented specially - (setq type 'expression)) - (t (setq parens (cdr parens))))) - t) - (t)) - (cond - (type) - ;; Indent the first jsx thing like js so we can indent future jsx things - ;; like sgml relative to the first thing - ((= current-line tag-start-line) 'first) - ('nth)))))) - -(defmacro js--as-sgml (&rest body) - "Execute BODY as if in sgml-mode." - `(with-syntax-table sgml-mode-syntax-table - (let (forward-sexp-function - parse-sexp-lookup-properties) - ,@body))) - -(defun js--expression-in-sgml-indent-line () - "Indent the current line as JavaScript or SGML (whichever is farther)." - (let* (indent-col - (savep (point)) - ;; Don't whine about errors/warnings when we're indenting. - ;; This has to be set before calling parse-partial-sexp below. - (inhibit-point-motion-hooks t) - (parse-status (save-excursion - (syntax-ppss (point-at-bol))))) - ;; Don't touch multiline strings. + ;; (exclusive, as the closing bracket is indented + ;; like SGML). + (if (progn + (goto-char paren) + (ignore-errors (let (forward-sexp-function) + (forward-sexp)))) + (< current-line (line-number-at-pos)) + ;; No matching bracket implies we’re inside! + t)) + ;; Indicate this will be indented specially. Return + ;; nil to stop iterating too. + (progn (setq type 'expression) nil) + ;; Stop iterating when parens = nil. + (setq parens (cdr parens))))) + (or type 'n+1th))))) + +(defun js--indent-line-in-jsx-expression () + "Indent the current line as JavaScript within JSX." + (let ((parse-status (save-excursion (syntax-ppss (point-at-bol)))) + offset indent-col) (unless (nth 3 parse-status) - (setq indent-col (save-excursion - (back-to-indentation) - (if (>= (point) savep) (setq savep nil)) - (js--as-sgml (sgml-calculate-indent)))) - (if (null indent-col) - 'noindent - ;; Use whichever indentation column is greater, such that the sgml - ;; column is effectively a minimum - (setq indent-col (max (js--proper-indentation parse-status) - (+ indent-col js-indent-level))) - (if savep - (save-excursion (indent-line-to indent-col)) - (indent-line-to indent-col)))))) + (save-excursion + (setq offset (- (point) (progn (back-to-indentation) (point))) + indent-col (js--as-sgml (sgml-calculate-indent)))) + (if (null indent-col) 'noindent ; Like in sgml-mode + ;; Use whichever indentation column is greater, such that the + ;; SGML column is effectively a minimum. + (indent-line-to (max (js--proper-indentation parse-status) + (+ indent-col js-indent-level))) + (when (> offset 0) (forward-char offset)))))) + +(defun js--indent-n+1th-jsx-line () + "Indent the current line as JSX within JavaScript." + (js--as-sgml (sgml-indent-line))) (defun js-indent-line () "Indent the current line as JavaScript." @@ -2353,19 +2305,11 @@ Currently, JSX indentation supports the following styles: i.e., customize JSX element indentation with `sgml-basic-offset', `sgml-attribute-offset' et al." (interactive) - (let ((indentation-type (js--jsx-indented-element-p))) - (cond - ((eq indentation-type 'expression) - (js--expression-in-sgml-indent-line)) - ((or (eq indentation-type 'first) - (eq indentation-type 'after)) - ;; Don't treat this first thing as a continued expression (often a "<" or - ;; ">" causes this misinterpretation) - (cl-letf (((symbol-function #'js--continued-expression-p) 'ignore)) - (js-indent-line))) - ((eq indentation-type 'nth) - (js--as-sgml (sgml-indent-line))) - (t (js-indent-line))))) + (let ((type (js--jsx-indentation))) + (if type + (if (eq type 'n+1th) (js--indent-n+1th-jsx-line) + (js--indent-line-in-jsx-expression)) + (js-indent-line)))) ;;; Filling @@ -3944,6 +3888,7 @@ locally, like so: (setq-local sgml-basic-offset js-indent-level)) (add-hook \\='js-jsx-mode-hook #\\='set-jsx-indentation)" :group 'js + (setq-local js-jsx-syntax t) (setq-local indent-line-function #'js-jsx-indent-line)) ;;;###autoload (defalias 'javascript-mode 'js-mode) commit 58c77f1f3e041be320a05efb818a0e2bb1583e84 Author: Jackson Ray Hamilton Date: Sat Feb 9 15:42:42 2019 -0800 Add failing tests for JSX indentation bugs * test/manual/indent/js-jsx.js: Add failing tests for all the js-mode and js2-mode JSX indentation bugs reported over the years that I could find. Some may be duplicates, so I have grouped similar reports together, for now; we’ll see for certain which distinct cases we need once we start actually implementing fixes. * test/manual/indent/js-jsx-quote.js: New file with a nasty test. diff --git a/test/manual/indent/js-jsx-quote.js b/test/manual/indent/js-jsx-quote.js new file mode 100644 index 0000000000..4b71a65674 --- /dev/null +++ b/test/manual/indent/js-jsx-quote.js @@ -0,0 +1,18 @@ +// -*- mode: js-jsx; -*- + +// JSX text node values should be strings, but only JS string syntax +// is considered, so quote marks delimit strings like normal, with +// disastrous results (https://github.com/mooz/js2-mode/issues/409). +function Bug() { + return
C'est Montréal
; +} +function Test(foo = /'/, + bar = 123) {} + +// This test is in a separate file because it can break other tests +// when indenting the whole buffer (not sure why). + +// Local Variables: +// indent-tabs-mode: nil +// js-indent-level: 2 +// End: diff --git a/test/manual/indent/js-jsx.js b/test/manual/indent/js-jsx.js index 7401939d28..35ca4b275a 100644 --- a/test/manual/indent/js-jsx.js +++ b/test/manual/indent/js-jsx.js @@ -70,6 +70,189 @@ return (
); +// Indent void expressions (no need for contextual parens / commas) +// (https://github.com/mooz/js2-mode/issues/140#issuecomment-166250016). +
+

Title

+ {array.map(() => { + return ; + })} + {message} +
+// Another example of above issue +// (https://github.com/mooz/js2-mode/issues/490). + +
+ {variable1} + +
+ + +// Comments and arrows can break indentation (Bug#24896 / +// https://github.com/mooz/js2-mode/issues/389). +const Component = props => ( + c} + b={123}> + +); +const Component = props => ( + + +); +const Component = props => ( // Parse this comment, please. + c} + b={123}> + +); +const Component = props => ( // Parse this comment, please. + + +); +// Another example of above issue (Bug#30225). +class { + render() { + return ( + + ); + } +} + +// JSX attributes of an arrow function’s expression body’s JSX +// expression should be indented with respect to the JSX opening +// element (Bug#26001 / +// https://github.com/mooz/js2-mode/issues/389#issuecomment-271869380). +class { + render() { + const messages = this.state.messages.map( + message => + ); return messages; + } + render() { + const messages = this.state.messages.map(message => + + ); return messages; + } +} + +// Users expect tag closers to align with the tag’s start; this is the +// style used in the React docs, so it should be the default. +// - https://github.com/mooz/js2-mode/issues/389#issuecomment-390766873 +// - https://github.com/mooz/js2-mode/issues/482 +// - Bug#32158 +const foo = (props) => ( +
+ i} + /> + +
+); + +// Embedded JSX in parens breaks indentation +// (https://github.com/mooz/js2-mode/issues/411). +let a = ( +
+ {condition && } + {condition && } +
+
+) +let b = ( +
+ {condition && ()} +
+
+) +let c = ( +
+ {condition && ()} + {condition && "something"} +
+) +let d = ( +
+ {()} + {condition && "something"} +
+) +// Another example of the above issue (Bug#27000). +function testA() { + return ( +
+
{ (
) }
+
+ ); +} +function testB() { + return ( +
+
{
}
+
+ ); +} +// Another example of the above issue +// (https://github.com/mooz/js2-mode/issues/451). +class Classy extends React.Component { + render () { + return ( +
+
    + { this.state.list.map((item) => { + return (
    ) + })} +
+
+ ) + } +} + +// Self-closing tags should be indented properly +// (https://github.com/mooz/js2-mode/issues/459). +export default ({ stars }) => ( +
+
+ Congratulations! +
+
+ 0)} size='large' /> +
+ 1)} size='small' /> + 2)} size='small' /> +
+
+
+ You have created 1 reminder +
+
+) + +// JS expressions should not break indentation +// (https://github.com/mooz/js2-mode/issues/462). +return ( + + + ( +
nothing
+ )} /> + + + +) + // Local Variables: // indent-tabs-mode: nil // js-indent-level: 2 commit e1872f80f24ab650f416ff8705898f12c7ad2800 Author: Katsumi Yamaoka Date: Tue Apr 9 04:38:31 2019 +0000 Restore .dir-locals.el accidentally deleted But this way -- git add/commit/push -- is probably wrong, sorry. diff --git a/.dir-locals.el b/.dir-locals.el new file mode 100644 index 0000000000..9cd39920c2 --- /dev/null +++ b/.dir-locals.el @@ -0,0 +1,22 @@ +((nil . ((tab-width . 8) + (sentence-end-double-space . t) + (fill-column . 70))) + (c-mode . ((c-file-style . "GNU") + (c-noise-macro-names . ("INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" "UNINIT" "CALLBACK" "ALIGN_STACK")) + (electric-quote-comment . nil) + (electric-quote-string . nil))) + (objc-mode . ((c-file-style . "GNU") + (electric-quote-comment . nil) + (electric-quote-string . nil))) + (log-edit-mode . ((log-edit-font-lock-gnu-style . t) + (log-edit-setup-add-author . t))) + (change-log-mode . ((add-log-time-zone-rule . t) + (fill-column . 74) + (bug-reference-url-format . "https://debbugs.gnu.org/%s") + (mode . bug-reference))) + (diff-mode . ((mode . whitespace))) + (emacs-lisp-mode . ((indent-tabs-mode . nil) + (electric-quote-comment . nil) + (electric-quote-string . nil))) + (texinfo-mode . ((electric-quote-comment . nil) + (electric-quote-string . nil)))) commit e24cdf5c041d30b14b45da817655e36c70e825c2 Author: Katsumi Yamaoka Date: Tue Apr 9 04:28:03 2019 +0000 Fix last commit message diff --git a/.dir-locals.el b/.dir-locals.el deleted file mode 100644 index 9cd39920c2..0000000000 --- a/.dir-locals.el +++ /dev/null @@ -1,22 +0,0 @@ -((nil . ((tab-width . 8) - (sentence-end-double-space . t) - (fill-column . 70))) - (c-mode . ((c-file-style . "GNU") - (c-noise-macro-names . ("INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" "UNINIT" "CALLBACK" "ALIGN_STACK")) - (electric-quote-comment . nil) - (electric-quote-string . nil))) - (objc-mode . ((c-file-style . "GNU") - (electric-quote-comment . nil) - (electric-quote-string . nil))) - (log-edit-mode . ((log-edit-font-lock-gnu-style . t) - (log-edit-setup-add-author . t))) - (change-log-mode . ((add-log-time-zone-rule . t) - (fill-column . 74) - (bug-reference-url-format . "https://debbugs.gnu.org/%s") - (mode . bug-reference))) - (diff-mode . ((mode . whitespace))) - (emacs-lisp-mode . ((indent-tabs-mode . nil) - (electric-quote-comment . nil) - (electric-quote-string . nil))) - (texinfo-mode . ((electric-quote-comment . nil) - (electric-quote-string . nil)))) commit 4f92cfdc3c7ed22527c22cddb8add9fb8aeaef74 Merge: 12cbe2e9fb 24d75c6667 Author: Katsumi Yamaoka Date: Tue Apr 9 04:27:08 2019 +0000 Merge remote-tracking branch 'origin/master' commit 12cbe2e9fb440379ae13559c786fbeba91873157 Author: Katsumi Yamaoka Date: Tue Apr 9 04:15:57 2019 +0000 Make `jump to group' work even if it is not activated (bug#33653) * lisp/gnus/gnus-group.el (gnus-group-goto-group): Use gnus-newsrc-hashtb instead of gnus-active-hashtb to check if a group exists even if its server is not activated (bug#33653). diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 0be3854174..58f3dc3a6e 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -2560,7 +2560,7 @@ If FAR, it is likely that the group is not on the current line. If TEST-MARKED, the line must be marked." (when group (let ((start (point)) - (active (and (gethash group gnus-active-hashtb) + (active (and (gethash group gnus-newsrc-hashtb) group))) (beginning-of-line) (cond commit 24d75c6667434a29a0c9db61ada8b29683fb3173 Author: Katsumi Yamaoka Date: Tue Apr 9 04:15:57 2019 +0000 Make `jump to group' work even if it is not activated (bug#33653) * lisp/gnus/gnus-group.el (gnus-group-goto-group): Use gnus-newsrc-hashtb instead of gnus-newsrc-hashtb to check if a group exists even if its server is not activated (bug#33653). diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 0be3854174..58f3dc3a6e 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -2560,7 +2560,7 @@ If FAR, it is likely that the group is not on the current line. If TEST-MARKED, the line must be marked." (when group (let ((start (point)) - (active (and (gethash group gnus-active-hashtb) + (active (and (gethash group gnus-newsrc-hashtb) group))) (beginning-of-line) (cond commit 8b2dad2891fe2d0ed4d163b4e63263f1068b8b3e Author: Eric Abrahamsen Date: Sun Mar 31 09:09:18 2019 -0700 Fix encoding and access of Gnus group names * lisp/gnus/gnus-start.el (gnus-active-to-gnus-format): Encode group names as 'latin-1. * lisp/gnus/nnmail.el (nnmail-parse-active): Ditto. * lisp/gnus/nnml.el (nnml-request-group, nnml-request-create-group, nnml-request-expire-articles, nnml-request-delete-group, nnml-request-rename-group, nnml-deletable-article-p, nnml-active-number, nnml-open-incremental-nov): Use assoc-string with nnml-group-alist. * lisp/gnus/nnrss.el (nnrss-request-delete-group, nnrss-retrieve-groups, nnrss-read-group-data, nnrss-check-group, nnrss-generate-download-script): Use assoc-string with nnrss-group-alist. diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 9b1be65067..2beb685822 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -2145,12 +2145,15 @@ The info element is shared with the same element of (condition-case () (if (and (stringp (progn (setq group (read cur) - group (cond ((numberp group) - (number-to-string group)) - ((symbolp group) - (symbol-name group)) - ((stringp group) - group))))) + group + (encode-coding-string + (cond ((numberp group) + (number-to-string group)) + ((symbolp group) + (symbol-name group)) + ((stringp group) + group)) + 'latin-1)))) (numberp (setq max (read cur))) (numberp (setq min (read cur))) (null (progn diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index a95cdb4a4f..b6dbbea74c 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -663,7 +663,7 @@ nn*-request-list should have been called before calling this function." (narrow-to-region (point) (point-at-eol)) (setq group (read buffer)) (unless (stringp group) - (setq group (symbol-name group))) + (setq group (encode-coding-string (symbol-name group) 'latin-1))) (if (and (numberp (setq max (read buffer))) (numberp (setq min (read buffer)))) (push (list group (cons min max)) diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el index 5770777ad4..205e9e4803 100644 --- a/lisp/gnus/nnml.el +++ b/lisp/gnus/nnml.el @@ -259,7 +259,7 @@ non-nil.") (t (nnheader-re-read-dir nnml-current-directory) (nnmail-activate 'nnml) - (let ((active (nth 1 (assoc group nnml-group-alist)))) + (let ((active (nth 1 (assoc-string group nnml-group-alist)))) (if (not active) (nnheader-report 'nnml "No such group: %s" decoded) (nnheader-report 'nnml "Selected group %s" decoded) @@ -295,7 +295,7 @@ non-nil.") (nnheader-report 'nnml "%s is a file" (directory-file-name (nnml-group-pathname group nil server)))) - ((assoc group nnml-group-alist) + ((assoc-string group nnml-group-alist) t) (t (let (active) @@ -379,7 +379,7 @@ non-nil.") (nnml-nov-delete-article group number)) (push number rest))) (push number rest))) - (let ((active (nth 1 (assoc group nnml-group-alist)))) + (let ((active (nth 1 (assoc-string group nnml-group-alist)))) (when active (setcar active (or (and active-articles (apply 'min active-articles)) @@ -520,7 +520,7 @@ non-nil.") (nnheader-report 'nnml "No such directory: %s/" file)) ;; Remove the group from all structures. (setq nnml-group-alist - (delq (assoc group nnml-group-alist) nnml-group-alist) + (delq (assoc-string group nnml-group-alist) nnml-group-alist) nnml-current-group nil nnml-current-directory nil) ;; Save the active file. @@ -549,7 +549,7 @@ non-nil.") (when (<= (length (directory-files old-dir)) 2) (ignore-errors (delete-directory old-dir))) ;; That went ok, so we change the internal structures. - (let ((entry (assoc group nnml-group-alist))) + (let ((entry (assoc-string group nnml-group-alist))) (when entry (setcar entry new-name)) (setq nnml-current-directory nil @@ -597,7 +597,7 @@ non-nil.") (when (setq path (nnml-article-to-file article)) (when (file-writable-p path) (or (not nnmail-keep-last-article) - (not (eq (cdr (nth 1 (assoc group nnml-group-alist))) + (not (eq (cdr (nth 1 (assoc-string group nnml-group-alist))) article))))))) ;; Find an article number in the current group given the Message-ID. @@ -742,7 +742,7 @@ article number. This function is called narrowed to an article." "Compute the next article number in GROUP on SERVER." (let* ((encoded (if nnmail-group-names-not-encoded-p (nnml-encoded-group-name group server))) - (active (cadr (assoc (or encoded group) nnml-group-alist)))) + (active (cadr (assoc-string (or encoded group) nnml-group-alist)))) ;; The group wasn't known to nnml, so we just create an active ;; entry for it. (unless active @@ -783,7 +783,7 @@ article number. This function is called narrowed to an article." (cdr nnml-incremental-nov-buffer-alist))))) (defun nnml-open-incremental-nov (group) - (or (cdr (assoc group nnml-incremental-nov-buffer-alist)) + (or (cdr (assoc-string group nnml-incremental-nov-buffer-alist)) (let ((buffer (nnml-get-nov-buffer group t))) (push (cons group buffer) nnml-incremental-nov-buffer-alist) buffer))) diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index 7f2accc2b6..0bfecb28e0 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -340,10 +340,10 @@ for decoding when the cdr that the data specify is not available.") (let (elem) ;; There may be two or more entries in `nnrss-group-alist' since ;; this function didn't delete them formerly. - (while (setq elem (assoc group nnrss-group-alist)) + (while (setq elem (assoc-string group nnrss-group-alist)) (setq nnrss-group-alist (delq elem nnrss-group-alist)))) (setq nnrss-server-data - (delq (assoc group nnrss-server-data) nnrss-server-data)) + (delq (assoc-string group nnrss-server-data) nnrss-server-data)) (nnrss-save-server-data server) (ignore-errors (let ((file-name-coding-system nnmail-pathname-coding-system)) @@ -367,7 +367,7 @@ for decoding when the cdr that the data specify is not available.") (with-current-buffer nntp-server-buffer (erase-buffer) (dolist (group groups) - (let ((elem (assoc (gnus-group-decoded-name group) nnrss-server-data))) + (let ((elem (assoc-string (gnus-group-decoded-name group) nnrss-server-data))) (insert (format "%S %s 1 y\n" group (or (cadr elem) 0))))) 'active)) @@ -539,7 +539,7 @@ which RSS 2.0 allows." (if (hash-table-p nnrss-group-hashtb) (clrhash nnrss-group-hashtb) (setq nnrss-group-hashtb (make-hash-table :test 'equal))) - (let ((pair (assoc group nnrss-server-data))) + (let ((pair (assoc-string group nnrss-server-data))) (setq nnrss-group-max (or (cadr pair) 0)) (setq nnrss-group-min (+ nnrss-group-max 1))) (let ((file (nnrss-make-filename group server)) @@ -644,8 +644,8 @@ which RSS 2.0 allows." (concat group ".xml")) nnrss-directory)))) (setq xml (nnrss-fetch file t)) - (setq url (or (nth 2 (assoc group nnrss-server-data)) - (cadr (assoc group nnrss-group-alist)))) + (setq url (or (nth 2 (assoc-string group nnrss-server-data)) + (cadr (assoc-string group nnrss-group-alist)))) (unless url (setq url (cdr @@ -653,7 +653,7 @@ which RSS 2.0 allows." (nnrss-discover-feed (read-string (format "URL to search for %s: " group) "http://"))))) - (let ((pair (assoc group nnrss-server-data))) + (let ((pair (assoc-string group nnrss-server-data))) (if pair (setcdr (cdr pair) (list url)) (push (list group nnrss-group-max url) nnrss-server-data))) @@ -721,7 +721,7 @@ which RSS 2.0 allows." (setq extra nil)) (when changed (nnrss-save-group-data group server) - (let ((pair (assoc group nnrss-server-data))) + (let ((pair (assoc-string group nnrss-server-data))) (if pair (setcar (cdr pair) nnrss-group-max) (push (list group nnrss-group-max) nnrss-server-data))) @@ -792,7 +792,7 @@ It is useful when `(setq nnrss-use-local t)'." (insert "RSSDIR='" (expand-file-name nnrss-directory) "'\n") (dolist (elem nnrss-server-data) (let ((url (or (nth 2 elem) - (cadr (assoc (car elem) nnrss-group-alist))))) + (cadr (assoc-string (car elem) nnrss-group-alist))))) (insert "$WGET -q -O \"$RSSDIR\"/'" (nnrss-translate-file-chars (concat (car elem) ".xml")) "' '" url "'\n")))) commit 3e5e097fdf056f4b3440993dd25ebdbad436abc3 Author: Katsumi Yamaoka Date: Fri Apr 5 04:25:06 2019 +0000 Make `move article' work again (bug#33653) * lisp/gnus/gnus-sum.el (gnus-summary-move-article): Back to while loop m dolist that blocks nov and active from saving (bug#33653). diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index fd72e1d3ab..8959a2b3d0 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -10038,7 +10038,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (crosspost "Crosspost" "Crossposting"))) (copy-buf (save-excursion (nnheader-set-temp-buffer " *copy article*"))) - art-group to-method new-xref to-groups + art-group to-method new-xref article to-groups articles-to-update-marks encoded) (unless (assq action names) (error "Unknown action %s" action)) @@ -10088,7 +10088,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (or (car select-method) (gnus-group-decoded-name to-newsgroup)) articles) - (dolist (article articles) + (while articles + (setq article (pop articles)) ;; Set any marks that may have changed in the summary buffer. (when gnus-preserve-marks (gnus-summary-push-marks-to-backend article)) commit 36dc39bfbf1a307769bd62dbe1311a1935737b51 Author: Stefan Monnier Date: Mon Apr 8 16:49:11 2019 -0400 * lisp/gnus/gnus-sum.el: Prepare for lexical-binding Add defvars for all the gnus-tmp-*. (gnus-summary-make-local-variables): Move let binding to avoid setq. (gnus-set-global-variables): Use dolist. (gnus-summary-from-or-to-or-newsgroups, gnus-summary-insert-line) (gnus-summary-insert-dummy-line): Avoid dynbind args. (gnus-build-old-threads): Remove unused var 'id'. (gnus-nov-parse-line): Remove unused var 'buffer'. (gnus-thread-header): Prepare it for a lexbind world. (gnus-adjust-marked-articles): Remove unused var 'marks'. (gnus-mark-xrefs-as-read): Remove unused var 'idlist'. (gnus-summary-display-article): Erase&widen before mm-enable-multibyte. (gnus-summary-better-unread-subject): Remove unused var 'score'. (gnus-summary-find-matching): Remove unused var 'd'. (ps-right-header, ps-left-header, shr-ignore-cache): Declare vars. (gnus-summary-idna-message, gnus-summary-morse-message) (gnus-summary-sort-by-original): Fix interactive spec since we don't actually use any prefix arg. (gnus-summary-move-article, gnus-read-move-group-name): Use user-error. (gnus-summary-move-article): Use dolist. (gnus-summary-edit-article): Fix unquoting. (gnus-summary-highlight-line-0, gnus-summary-highlight-line): Declare dynbind vars documented in gnus-summary-highlight. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 21f0e5951c..fd72e1d3ab 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -27,7 +27,34 @@ (require 'cl-lib) (defvar tool-bar-mode) +(defvar gnus-category-predicate-alist) +(defvar gnus-category-predicate-cache) +(defvar gnus-inhibit-article-treatments) +(defvar gnus-inhibit-demon) +(defvar gnus-tmp-article-number) +(defvar gnus-tmp-closing-bracket) +(defvar gnus-tmp-current) +(defvar gnus-tmp-dummy) +(defvar gnus-tmp-expirable) +(defvar gnus-tmp-from) +(defvar gnus-tmp-group-name) (defvar gnus-tmp-header) +(defvar gnus-tmp-indentation) +(defvar gnus-tmp-level) +(defvar gnus-tmp-lines) +(defvar gnus-tmp-number) +(defvar gnus-tmp-opening-bracket) +(defvar gnus-tmp-process) +(defvar gnus-tmp-replied) +(defvar gnus-tmp-score) +(defvar gnus-tmp-score-char) +(defvar gnus-tmp-subject) +(defvar gnus-tmp-subject-or-nil) +(defvar gnus-tmp-unread) +(defvar gnus-tmp-unread-and-unselected) +(defvar gnus-tmp-unread-and-unticked) +(defvar gnus-tmp-user-defined) +(defvar gnus-use-article-prefetch) (require 'gnus) (require 'gnus-group) @@ -784,7 +811,7 @@ score file." :group 'gnus-score-default :type 'integer) -(defun gnus-widget-reversible-match (widget value) +(defun gnus-widget-reversible-match (_widget value) "Ignoring WIDGET, convert VALUE to internal form. VALUE should have the form `FOO' or `(not FOO)', where FOO is an symbol." ;; (debug value) @@ -794,7 +821,7 @@ VALUE should have the form `FOO' or `(not FOO)', where FOO is an symbol." (eq (nth 0 value) 'not) (symbolp (nth 1 value))))) -(defun gnus-widget-reversible-to-internal (widget value) +(defun gnus-widget-reversible-to-internal (_widget value) "Ignoring WIDGET, convert VALUE to internal form. VALUE should have the form `FOO' or `(not FOO)', where FOO is an atom. FOO is converted to (FOO nil) and (not FOO) is converted to (FOO t)." @@ -803,7 +830,7 @@ FOO is converted to (FOO nil) and (not FOO) is converted to (FOO t)." (list value nil) (list (nth 1 value) t))) -(defun gnus-widget-reversible-to-external (widget value) +(defun gnus-widget-reversible-to-external (_widget value) "Ignoring WIDGET, convert VALUE to external form. VALUE should have the form `(FOO nil)' or `(FOO t)', where FOO is an atom. \(FOO nil) is converted to FOO and (FOO t) is converted to (not FOO)." @@ -1385,7 +1412,8 @@ the normal Gnus MIME machinery." (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from))) ?s) (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from)) - gnus-tmp-from) ?s) + gnus-tmp-from) + ?s) (?F gnus-tmp-from ?s) (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s) (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s) @@ -1397,12 +1425,15 @@ the normal Gnus MIME machinery." (?k (gnus-summary-line-message-size gnus-tmp-header) ?s) (?L gnus-tmp-lines ?s) (?Z (or (nnir-article-rsv (mail-header-number gnus-tmp-header)) - 0) ?d) + 0) + ?d) (?G (or (nnir-article-group (mail-header-number gnus-tmp-header)) - "") ?s) + "") + ?s) (?g (or (gnus-group-short-name (nnir-article-group (mail-header-number gnus-tmp-header))) - "") ?s) + "") + ?s) (?O gnus-tmp-downloaded ?c) (?I gnus-tmp-indentation ?s) (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s) @@ -1427,7 +1458,8 @@ the normal Gnus MIME machinery." (?P (gnus-pick-line-number) ?d) (?B gnus-tmp-thread-tree-header-string ?s) (user-date (gnus-user-date - ,(macroexpand '(mail-header-date gnus-tmp-header))) ?s)) + ,(macroexpand '(mail-header-date gnus-tmp-header))) + ?s)) "An alist of format specifications that can appear in summary lines. These are paired with what variables they correspond with, along with the type of the variable (string, integer, character, etc).") @@ -1672,6 +1704,7 @@ For example: (eval-when-compile ;; Bind features so that require will believe that gnus-sum has ;; already been loaded (avoids infinite recursion) + (with-no-warnings (defvar features)) ;Not just a local variable. (let ((features (cons 'gnus-sum features))) (require 'gnus-art))) @@ -3107,18 +3140,16 @@ The following commands are available: (defun gnus-summary-make-local-variables () "Make all the local summary buffer variables." - (let (global) - (dolist (local gnus-summary-local-variables) - (if (consp local) - (progn - (if (eq (cdr local) 'global) - ;; Copy the global value of the variable. - (setq global (symbol-value (car local))) - ;; Use the value from the list. - (setq global (eval (cdr local)))) - (set (make-local-variable (car local)) global)) - ;; Simple nil-valued local variable. - (set (make-local-variable local) nil))))) + (dolist (local gnus-summary-local-variables) + (if (consp local) + (let ((global (if (eq (cdr local) 'global) + ;; Copy the global value of the variable. + (symbol-value (car local)) + ;; Use the value from the list. + (eval (cdr local))))) + (set (make-local-variable (car local)) global)) + ;; Simple nil-valued local variable. + (set (make-local-variable local) nil)))) ;; Summary data functions. @@ -3525,13 +3556,12 @@ buffer that was in action when the last article was fetched." (score-file gnus-current-score-file) (default-charset gnus-newsgroup-charset) vlist) - (let ((locals gnus-newsgroup-variables)) - (while locals - (if (consp (car locals)) - (push (eval (caar locals)) vlist) - (push (eval (car locals)) vlist)) - (setq locals (cdr locals))) - (setq vlist (nreverse vlist))) + (dolist (local gnus-newsgroup-variables) + (push (eval (if (consp local) (car local) + local) + t) + vlist)) + (setq vlist (nreverse vlist)) (with-temp-buffer (setq gnus-newsgroup-name name gnus-newsgroup-marked marked @@ -3546,12 +3576,11 @@ buffer that was in action when the last article was fetched." gnus-reffed-article-number reffed gnus-current-score-file score-file gnus-newsgroup-charset default-charset) - (let ((locals gnus-newsgroup-variables)) - (while locals - (if (consp (car locals)) - (set (caar locals) (pop vlist)) - (set (car locals) (pop vlist))) - (setq locals (cdr locals)))))))) + (dolist (local gnus-newsgroup-variables) + (set (if (consp local) + (car local) + local) + (pop vlist))))))) (defun gnus-summary-article-unread-p (article) "Say whether ARTICLE is unread or not." @@ -3639,19 +3668,23 @@ buffer that was in action when the last article was fetched." pos))) (setq gnus-summary-mark-positions pos)))) -(defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number) +(defun gnus-summary-insert-dummy-line (subject number) "Insert a dummy root in the summary buffer." (beginning-of-line) (add-text-properties - (point) (progn (eval gnus-summary-dummy-line-format-spec) (point)) - (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number))) + (point) (let ((gnus-tmp-subject subject) + (gnus-tmp-number number)) + (eval gnus-summary-dummy-line-format-spec t) + (point)) + (list 'gnus-number number 'gnus-intangible number))) (defun gnus-summary-extract-address-component (from) (or (car (funcall gnus-extract-address-components from)) from)) -(defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from) - (let ((mail-parse-charset gnus-newsgroup-charset) +(defun gnus-summary-from-or-to-or-newsgroups (header from) + (let ((gnus-tmp-from from) + (mail-parse-charset gnus-newsgroup-charset) ;; Is it really necessary to do this next part for each summary line? ;; Luckily, doesn't seem to slow things down much. (mail-parse-ignored-charsets @@ -3678,25 +3711,31 @@ buffer that was in action when the last article was fetched." (and (memq 'Newsgroups gnus-extra-headers) (eq (car (gnus-find-method-for-group - gnus-newsgroup-name)) 'nntp) + gnus-newsgroup-name)) + 'nntp) (gnus-group-real-name gnus-newsgroup-name)))) (concat gnus-summary-newsgroup-prefix newsgroups))))) (bidi-string-mark-left-to-right (inline (gnus-summary-extract-address-component gnus-tmp-from)))))) -(defun gnus-summary-insert-line (gnus-tmp-header - gnus-tmp-level gnus-tmp-current - undownloaded gnus-tmp-unread gnus-tmp-replied - gnus-tmp-expirable gnus-tmp-subject-or-nil - &optional gnus-tmp-dummy gnus-tmp-score - gnus-tmp-process) - (if (>= gnus-tmp-level (length gnus-thread-indent-array)) +(defun gnus-summary-insert-line (header level current undownloaded + unread replied expirable subject-or-nil + &optional dummy score process) + (if (>= level (length gnus-thread-indent-array)) (gnus-make-thread-indent-array (max (* 2 (length gnus-thread-indent-array)) - gnus-tmp-level))) - (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level)) + level))) + (let* ((gnus-tmp-header header) + (gnus-tmp-level level) + (gnus-tmp-current current) + (gnus-tmp-unread unread) + (gnus-tmp-expirable expirable) + (gnus-tmp-subject-or-nil subject-or-nil) + (gnus-tmp-dummy dummy) + (gnus-tmp-process process) + (gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level)) (gnus-tmp-lines (mail-header-lines gnus-tmp-header)) - (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0)) + (gnus-tmp-score (or score gnus-summary-default-score 0)) (gnus-tmp-score-char (if (or (null gnus-summary-default-score) (<= (abs (- gnus-tmp-score gnus-summary-default-score)) @@ -3709,7 +3748,7 @@ buffer that was in action when the last article was fetched." (cond (gnus-tmp-process gnus-process-mark) ((memq gnus-tmp-current gnus-newsgroup-cached) gnus-cached-mark) - (gnus-tmp-replied gnus-replied-mark) + (replied gnus-replied-mark) ((memq gnus-tmp-current gnus-newsgroup-forwarded) gnus-forwarded-mark) ((memq gnus-tmp-current gnus-newsgroup-saved) @@ -4461,7 +4500,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." ;; build complete threads - if the roots haven't been expired by the ;; server, that is. (let ((mail-parse-charset gnus-newsgroup-charset) - id heads) + heads) (maphash (lambda (id refs) (when (not (car refs)) @@ -4485,7 +4524,6 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." ;; on the beginning of the line. (defsubst gnus-nov-parse-line (number dependencies &optional force-new) (let ((eol (point-at-eol)) - (buffer (current-buffer)) header references in-reply-to) ;; overview: [num subject from date id refs chars lines misc] @@ -4940,8 +4978,16 @@ Note that THREAD must never, ever be anything else than a variable - using some other form will lead to serious barfage." (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread))) ;; (8% speedup to gnus-summary-prepare, just for fun :-) - (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" - (vector thread) 2)) + (cond + ((and (boundp 'lexical-binding) lexical-binding) + ;; FIXME: This version could be a "defsubst" rather than a macro. + `(#[257 "\211:\203\16\0\211@;\203\15\0A@@\207" + [] 2] + ,thread)) + (t + ;; Not sure how XEmacs handles these things, so let's keep the old code. + (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" + (vector thread) 2)))) (defsubst gnus-article-sort-by-number (h1 h2) "Sort articles by article number." @@ -5972,7 +6018,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (min (car active)) (max (cdr active)) (types gnus-article-mark-lists) - marks var articles article mark mark-type + var articles article mark mark-type bgn end) ;; Hack to avoid adjusting marks for imap. (when (eq (car (gnus-find-method-for-group (gnus-info-group info))) @@ -6234,7 +6280,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads) "Look through all the headers and mark the Xrefs as read." (let ((virtual (gnus-virtual-group-p from-newsgroup)) - name info xref-hashtb idlist method nth4) + name info xref-hashtb method nth4) (with-current-buffer gnus-group-buffer (when (setq xref-hashtb (gnus-create-xref-hashtb from-newsgroup headers unreads)) @@ -7488,7 +7534,7 @@ The state which existed when entering the ephemeral is reset." (with-current-buffer buffer (gnus-deaden-summary)))))) -(defun gnus-summary-wake-up-the-dead (&rest args) +(defun gnus-summary-wake-up-the-dead (&rest _) "Wake up the dead summary buffer." (interactive) (gnus-dead-summary-mode -1) @@ -7714,6 +7760,12 @@ Given a prefix, will force an `article' buffer configuration." (gnus-article-setup-buffer)) (gnus-set-global-variables) (with-current-buffer gnus-article-buffer + ;; The buffer may be non-empty and even narrowed, so go back to + ;; a sane state. + (widen) + ;; We're going to erase the buffer anyway so do it now: it can save us from + ;; uselessly performing multibyte-conversion of the current content. + (let ((inhibit-read-only t)) (erase-buffer)) (setq gnus-article-charset gnus-newsgroup-charset) (setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets) (mm-enable-multibyte)) @@ -7857,7 +7909,7 @@ If BACKWARD, the previous article is selected instead of the next." (gnus-summary-walk-group-buffer gnus-newsgroup-name cmd unread backward point)))))))) -(defun gnus-summary-walk-group-buffer (from-group cmd unread backward start) +(defun gnus-summary-walk-group-buffer (_from-group cmd unread backward start) (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1)) (?\C-p (gnus-group-prev-unread-group 1)))) (cursor-in-echo-area t) @@ -8151,7 +8203,7 @@ score higher than the default score." "Select the first unread subject that has a score over the default score." (interactive) (let ((data gnus-newsgroup-data) - article score) + article) (while (and (setq article (gnus-data-number (car data))) (or (gnus-data-read-p (car data)) (not (> (gnus-summary-article-score article) @@ -8564,7 +8616,7 @@ If UNREPLIED (the prefix), limit to unreplied articles." (gnus-summary-limit gnus-newsgroup-replied)) (gnus-summary-position-point)) -(defun gnus-summary-limit-exclude-marks (marks &optional reverse) +(defun gnus-summary-limit-exclude-marks (marks &optional _reverse) "Exclude articles that are marked with MARKS (e.g. \"DK\"). If REVERSE, limit the summary buffer to articles that are marked with MARKS. MARKS can either be a string of marks or a list of marks. @@ -8866,7 +8918,7 @@ fetch-old-headers verbiage, and so on." (push gnus-newsgroup-limit gnus-newsgroup-limits) (setq gnus-newsgroup-limit nil) (maphash - (lambda (id deps) + (lambda (_id deps) (unless (car deps) ;; These threads have no parents -- they are roots. (let ((nodes (cdr deps)) @@ -9524,6 +9576,9 @@ fetched headers for, whether they are displayed or not." (func `(lambda (h) (,(intern (concat "mail-header-" header)) h))) (case-fold-search t)) (dolist (header gnus-newsgroup-headers) + ;; FIXME: when called from gnus-summary-limit-include-thread via + ;; gnus-summary-limit-include-matching-articles, `regexp' is a decoded + ;; string whereas the header isn't decoded. (when (string-match regexp (funcall func header)) (push (mail-header-number header) articles))) (nreverse articles))) @@ -9538,7 +9593,7 @@ be taken into consideration. If NOT-CASE-FOLD, case won't be folded in the comparisons. If NOT-MATCHING, return a list of all articles that not match REGEXP on HEADER." (let ((case-fold-search (not not-case-fold)) - articles d func) + articles func) (if (consp header) (if (eq (car header) 'extra) (setq func @@ -9658,6 +9713,10 @@ to save in." (gnus-summary-remove-process-mark article)) (ps-despool filename)) +(defvar ps-right-header) +(defvar ps-left-header) +(defvar shr-ignore-cache) + (defun gnus-print-buffer () (let ((ps-left-header (list @@ -9883,7 +9942,7 @@ prefix specifies how many places to rotate each letter forward." ;; Create buttons and stuff... (gnus-treat-article nil)) -(defun gnus-summary-idna-message (&optional arg) +(defun gnus-summary-idna-message (&optional _arg) "Decode IDNA encoded domain names in the current articles. IDNA encoded domain names looks like `xn--bar'. If a string remain unencoded after running this function, it is likely an @@ -9891,7 +9950,7 @@ invalid IDNA string (`xn--bar' is invalid). You must have GNU Libidn (URL `https://www.gnu.org/software/libidn/') installed for this command to work." - (interactive "P") + (interactive) (gnus-summary-select-article) (let ((mail-header-separator "")) (gnus-eval-in-buffer-window gnus-article-buffer @@ -9903,9 +9962,9 @@ installed for this command to work." (replace-match (puny-decode-domain (match-string 1)))) (set-window-start (get-buffer-window (current-buffer)) start)))))) -(defun gnus-summary-morse-message (&optional arg) +(defun gnus-summary-morse-message (&optional _arg) "Morse decode the current article." - (interactive "P") + (interactive) (gnus-summary-select-article) (let ((mail-header-separator "")) (gnus-eval-in-buffer-window gnus-article-buffer @@ -9963,11 +10022,11 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (cond ((and (eq action 'move) (not (gnus-check-backend-function 'request-move-article gnus-newsgroup-name))) - (error "The current group does not support article moving")) + (user-error "The current group does not support article moving")) ((and (eq action 'crosspost) (not (gnus-check-backend-function 'request-replace-article gnus-newsgroup-name))) - (error "The current group does not support article editing"))) + (user-error "The current group does not support article editing"))) (let ((articles (gnus-summary-work-articles n)) (prefix (if (gnus-check-backend-function 'request-move-article gnus-newsgroup-name) @@ -9979,7 +10038,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (crosspost "Crosspost" "Crossposting"))) (copy-buf (save-excursion (nnheader-set-temp-buffer " *copy article*"))) - art-group to-method new-xref article to-groups + art-group to-method new-xref to-groups articles-to-update-marks encoded) (unless (assq action names) (error "Unknown action %s" action)) @@ -10029,8 +10088,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (or (car select-method) (gnus-group-decoded-name to-newsgroup)) articles) - (while articles - (setq article (pop articles)) + (dolist (article articles) ;; Set any marks that may have changed in the summary buffer. (when gnus-preserve-marks (gnus-summary-push-marks-to-backend article)) @@ -10232,7 +10290,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." to-newsgroup select-method)) - ;;;!!!Why is this necessary? + ;;!!!Why is this necessary? (set-buffer gnus-summary-buffer) (when (eq action 'move) @@ -10598,7 +10656,7 @@ groups." (let ((mbl mml-buffer-list)) (setq mml-buffer-list nil) (let ((rfc2047-quote-decoded-words-containing-tspecials t)) - (mime-to-mml ,'current-handles)) + (mime-to-mml ',current-handles)) (let ((mbl1 mml-buffer-list)) (setq mml-buffer-list mbl) (set (make-local-variable 'mml-buffer-list) mbl1)) @@ -10886,8 +10944,8 @@ the actual number of articles unmarked is returned." (set var (cons article (symbol-value var))) (if (memq type '(processable cached replied forwarded recent saved)) (gnus-summary-update-secondary-mark article) - ;;; !!! This is bogus. We should find out what primary - ;;; !!! mark we want to set. + ;; !!! This is bogus. We should find out what primary + ;; !!! mark we want to set. (gnus-summary-update-mark gnus-del-mark 'unread))))) (defun gnus-summary-mark-as-expirable (n) @@ -12016,10 +12074,10 @@ Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort 'marks reverse)) -(defun gnus-summary-sort-by-original (&optional reverse) +(defun gnus-summary-sort-by-original (&optional _reverse) "Sort the summary buffer using the default sorting method. Argument REVERSE means reverse order." - (interactive "P") + (interactive) (let* ((inhibit-read-only t) (gnus-summary-prepare-hook nil)) ;; We do the sorting by regenerating the threads. @@ -12345,7 +12403,7 @@ save those articles instead." (string= to-newsgroup prefix)) (setq to-newsgroup default)) (unless to-newsgroup - (error "No group name entered")) + (user-error "No group name entered")) (setq encoded (encode-coding-string to-newsgroup (gnus-group-name-charset to-method to-newsgroup))) @@ -12357,7 +12415,7 @@ save those articles instead." (gnus-activate-group encoded nil nil to-method) (gnus-subscribe-group encoded)) (error "Couldn't create group %s" to-newsgroup))) - (error "No such group: %s" to-newsgroup)) + (user-error "No such group: %s" to-newsgroup)) encoded))) (defvar gnus-summary-save-parts-counter) @@ -12655,14 +12713,21 @@ If REVERSE, save parts that do not match TYPE." (c cond) (list gnus-summary-highlight)) (while list - (setcdr c (cons (list (caar list) (list 'quote (cdar list))) - nil)) + (setcdr c `((,(caar list) ',(cdar list)))) (setq c (cdr c) list (cdr list))) - (gnus-byte-compile (list 'lambda nil cond)))))) + (gnus-byte-compile + `(lambda () + (with-no-warnings ;See docstring of gnus-summary-highlight. + (defvar score) (defvar default) (defvar default-high) + (defvar default-low) (defvar mark) (defvar uncached)) + ,cond)))))) (defun gnus-summary-highlight-line () "Highlight current line according to `gnus-summary-highlight'." + (with-no-warnings ;See docstring of gnus-summary-highlight. + (defvar score) (defvar default) (defvar default-high) (defvar default-low) + (defvar mark) (defvar uncached)) (let* ((beg (point-at-bol)) (article (or (gnus-summary-article-number) gnus-current-article)) (score (or (cdr (assq article commit 0667c73708e3c8ed886a4ab0c220fd13908059e5 Author: Juri Linkov Date: Mon Apr 8 23:34:20 2019 +0300 * lisp/vc/diff-mode.el (diff-syntax-fontify-props): Check both buffer-local and default value of find-file-hook. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index dbde284da8..840f2c67d2 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2529,7 +2529,8 @@ hunk text is not found in the source file." (let ((enable-local-variables :safe) ;; to find `mode:' (buffer-file-name file)) (set-auto-mode) - (when (and (memq 'generic-mode-find-file-hook find-file-hook) + (when (and (memq 'generic-mode-find-file-hook + (append find-file-hook (default-value 'find-file-hook))) (fboundp 'generic-mode-find-file-hook)) (generic-mode-find-file-hook)))) commit a038df77de7b1aa2d73a6478493b8838b59e4982 Author: Paul Eggert Date: Mon Apr 8 12:59:22 2019 -0700 Allow gap before first non-Lisp pseudovec member Problem reported by Keith David Bershatsky in: https://lists.gnu.org/r/emacs-devel/2019-04/msg00259.html Solution suggested by Stefan Monnier in: https://lists.gnu.org/r/emacs-devel/2019-04/msg00282.html * src/buffer.h (BUFFER_LISP_SIZE): Simplify by using PSEUDOVECSIZE. (BUFFER_REST_SIZE): Simplify by using VECSIZE and BUFFER_LISP_SIZE. * src/lisp.h (PSEUDOVECSIZE): Base it on the last Lisp field, not the first non-Lisp field. All callers changed. Callers without Lisp fields changed to use ALLOCATE_PLAIN_PSEUDOVECTOR. (ALLOCATE_PLAIN_PSEUDOVECTOR): New macro. diff --git a/src/alloc.c b/src/alloc.c index e48807c49a..dd783863be 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3718,8 +3718,8 @@ Its value is void, and its function definition and property list are nil. */) Lisp_Object make_misc_ptr (void *a) { - struct Lisp_Misc_Ptr *p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Misc_Ptr, pointer, - PVEC_MISC_PTR); + struct Lisp_Misc_Ptr *p = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Misc_Ptr, + PVEC_MISC_PTR); p->pointer = a; return make_lisp_ptr (p, Lisp_Vectorlike); } @@ -3729,7 +3729,7 @@ make_misc_ptr (void *a) Lisp_Object build_overlay (Lisp_Object start, Lisp_Object end, Lisp_Object plist) { - struct Lisp_Overlay *p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Overlay, next, + struct Lisp_Overlay *p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Overlay, plist, PVEC_OVERLAY); Lisp_Object overlay = make_lisp_ptr (p, Lisp_Vectorlike); OVERLAY_START (overlay) = start; @@ -3743,8 +3743,8 @@ DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0, doc: /* Return a newly allocated marker which does not point at any place. */) (void) { - struct Lisp_Marker *p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Marker, buffer, - PVEC_MARKER); + struct Lisp_Marker *p = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Marker, + PVEC_MARKER); p->buffer = 0; p->bytepos = 0; p->charpos = 0; @@ -3766,8 +3766,8 @@ build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos) /* Every character is at least one byte. */ eassert (charpos <= bytepos); - struct Lisp_Marker *m = ALLOCATE_PSEUDOVECTOR (struct Lisp_Marker, buffer, - PVEC_MARKER); + struct Lisp_Marker *m = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Marker, + PVEC_MARKER); m->buffer = buf; m->charpos = charpos; m->bytepos = bytepos; @@ -3821,8 +3821,8 @@ make_event_array (ptrdiff_t nargs, Lisp_Object *args) Lisp_Object make_user_ptr (void (*finalizer) (void *), void *p) { - struct Lisp_User_Ptr *uptr = ALLOCATE_PSEUDOVECTOR (struct Lisp_User_Ptr, - finalizer, PVEC_USER_PTR); + struct Lisp_User_Ptr *uptr + = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_User_Ptr, PVEC_USER_PTR); uptr->finalizer = finalizer; uptr->p = p; return make_lisp_ptr (uptr, Lisp_Vectorlike); @@ -3945,7 +3945,7 @@ FUNCTION. FUNCTION will be run once per finalizer object. */) (Lisp_Object function) { struct Lisp_Finalizer *finalizer - = ALLOCATE_PSEUDOVECTOR (struct Lisp_Finalizer, prev, PVEC_FINALIZER); + = ALLOCATE_PSEUDOVECTOR (struct Lisp_Finalizer, function, PVEC_FINALIZER); finalizer->function = function; finalizer->prev = finalizer->next = NULL; finalizer_insert (&finalizers, finalizer); diff --git a/src/bignum.c b/src/bignum.c index 4118601e10..009d73118c 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -86,8 +86,8 @@ make_bignum_bits (size_t bits) if (integer_width < bits) overflow_error (); - struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, - PVEC_BIGNUM); + struct Lisp_Bignum *b = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Bignum, + PVEC_BIGNUM); mpz_init (b->value); mpz_swap (b->value, mpz[0]); return make_lisp_ptr (b, Lisp_Vectorlike); @@ -342,8 +342,8 @@ bignum_to_string (Lisp_Object num, int base) Lisp_Object make_bignum_str (char const *num, int base) { - struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value, - PVEC_BIGNUM); + struct Lisp_Bignum *b = ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Bignum, + PVEC_BIGNUM); mpz_init (b->value); int check = mpz_set_str (b->value, num, base); eassert (check == 0); diff --git a/src/buffer.h b/src/buffer.h index 63b162161c..f42c3e97b9 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -741,8 +741,8 @@ struct buffer See `cursor-type' for other values. */ Lisp_Object cursor_in_non_selected_windows_; - /* No more Lisp_Object beyond this point. Except undo_list, - which is handled specially in Fgarbage_collect. */ + /* No more Lisp_Object beyond cursor_in_non_selected_windows_. + Except undo_list, which is handled specially in Fgarbage_collect. */ /* This structure holds the coordinates of the buffer contents in ordinary buffers. In indirect buffers, this is not used. */ @@ -1019,14 +1019,12 @@ bset_width_table (struct buffer *b, Lisp_Object val) structure, make sure that this is still correct. */ #define BUFFER_LISP_SIZE \ - ((offsetof (struct buffer, own_text) - header_size) / word_size) + PSEUDOVECSIZE (struct buffer, cursor_in_non_selected_windows_) -/* Size of the struct buffer part beyond leading Lisp_Objects, in word_size - units. Rounding is needed for --with-wide-int configuration. */ +/* Allocated size of the struct buffer part beyond leading + Lisp_Objects, in word_size units. */ -#define BUFFER_REST_SIZE \ - ((((sizeof (struct buffer) - offsetof (struct buffer, own_text)) \ - + (word_size - 1)) & ~(word_size - 1)) / word_size) +#define BUFFER_REST_SIZE (VECSIZE (struct buffer) - BUFFER_LISP_SIZE) /* Initialize the pseudovector header of buffer object. BUFFER_LISP_SIZE is required for GC, but BUFFER_REST_SIZE is set up just to be consistent diff --git a/src/emacs-module.c b/src/emacs-module.c index 2bb1062574..47ca3368c0 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -427,7 +427,7 @@ static struct Lisp_Module_Function * allocate_module_function (void) { return ALLOCATE_PSEUDOVECTOR (struct Lisp_Module_Function, - min_arity, PVEC_MODULE_FUNCTION); + documentation, PVEC_MODULE_FUNCTION); } #define XSET_MODULE_FUNCTION(var, ptr) \ diff --git a/src/fns.c b/src/fns.c index b97b132b0f..c3202495da 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3904,7 +3904,7 @@ static struct Lisp_Hash_Table * allocate_hash_table (void) { return ALLOCATE_PSEUDOVECTOR (struct Lisp_Hash_Table, - count, PVEC_HASH_TABLE); + index, PVEC_HASH_TABLE); } /* An upper bound on the size of a hash table index. It must fit in diff --git a/src/frame.c b/src/frame.c index 6fdb7d0cbb..192ef4244f 100644 --- a/src/frame.c +++ b/src/frame.c @@ -798,7 +798,8 @@ adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit, static struct frame * allocate_frame (void) { - return ALLOCATE_ZEROED_PSEUDOVECTOR (struct frame, face_cache, PVEC_FRAME); + return ALLOCATE_ZEROED_PSEUDOVECTOR (struct frame, tool_bar_items, + PVEC_FRAME); } struct frame * diff --git a/src/frame.h b/src/frame.h index ed62e7ace0..ec8f61465f 100644 --- a/src/frame.h +++ b/src/frame.h @@ -190,9 +190,6 @@ struct frame Lisp_Object current_tool_bar_string; #endif - /* Desired and current tool-bar items. */ - Lisp_Object tool_bar_items; - #ifdef USE_GTK /* Where tool bar is, can be left, right, top or bottom. Except with GTK, the only supported position is `top'. */ @@ -204,7 +201,9 @@ struct frame Lisp_Object font_data; #endif - /* Beyond here, there should be no more Lisp_Object components. */ + /* Desired and current tool-bar items. */ + Lisp_Object tool_bar_items; + /* tool_bar_items should be the last Lisp_Object member. */ /* Cache of realized faces. */ struct face_cache *face_cache; diff --git a/src/lisp.h b/src/lisp.h index a0a7cbdf51..681efc3b52 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1904,9 +1904,9 @@ memclear (void *p, ptrdiff_t nbytes) at the end and we need to compute the number of Lisp_Object fields (the ones that the GC needs to trace). */ -#define PSEUDOVECSIZE(type, nonlispfield) \ - (offsetof (type, nonlispfield) < header_size \ - ? 0 : (offsetof (type, nonlispfield) - header_size) / word_size) +#define PSEUDOVECSIZE(type, lastlispfield) \ + (offsetof (type, lastlispfield) + word_size < header_size \ + ? 0 : (offsetof (type, lastlispfield) + word_size - header_size) / word_size) /* Compute A OP B, using the unsigned comparison operator OP. A and B should be integer expressions. This is not the same as @@ -2109,11 +2109,14 @@ enum char_table_specials /* This is the number of slots that every char table must have. This counts the ordinary slots and the top, defalt, parent, and purpose slots. */ - CHAR_TABLE_STANDARD_SLOTS = PSEUDOVECSIZE (struct Lisp_Char_Table, extras), + CHAR_TABLE_STANDARD_SLOTS + = (PSEUDOVECSIZE (struct Lisp_Char_Table, contents) - 1 + + (1 << CHARTAB_SIZE_BITS_0)), - /* This is an index of first Lisp_Object field in Lisp_Sub_Char_Table + /* This is the index of the first Lisp_Object field in Lisp_Sub_Char_Table when the latter is treated as an ordinary Lisp_Vector. */ - SUB_CHAR_TABLE_OFFSET = PSEUDOVECSIZE (struct Lisp_Sub_Char_Table, contents) + SUB_CHAR_TABLE_OFFSET + = PSEUDOVECSIZE (struct Lisp_Sub_Char_Table, contents) - 1 }; /* Sanity-check pseudovector layout. */ @@ -2313,8 +2316,8 @@ struct Lisp_Hash_Table hash table size to reduce collisions. */ Lisp_Object index; - /* Only the fields above are traced normally by the GC. The ones below - `count' are special and are either ignored by the GC or traced in + /* Only the fields above are traced normally by the GC. The ones after + 'index' are special and are either ignored by the GC or traced in a special way (e.g. because of weakness). */ /* Number of key/value entries in the table. */ @@ -3940,6 +3943,11 @@ make_nil_vector (ptrdiff_t size) extern struct Lisp_Vector *allocate_pseudovector (int, int, int, enum pvec_type); +/* Allocate uninitialized pseudovector with no Lisp_Object slots. */ + +#define ALLOCATE_PLAIN_PSEUDOVECTOR(type, tag) \ + ((type *) allocate_pseudovector (VECSIZE (type), 0, 0, tag)) + /* Allocate partially initialized pseudovector where all Lisp_Object slots are set to Qnil but the rest (if any) is left uninitialized. */ diff --git a/src/pdumper.c b/src/pdumper.c index b19f206d1b..cb2915cb20 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2702,7 +2702,7 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object object, dump_off offset) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Hash_Table_73C9BFB7D1) +#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_EF95ED06FF # error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment." #endif const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object); @@ -2770,7 +2770,7 @@ dump_hash_table (struct dump_context *ctx, static dump_off dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) { -#if CHECK_STRUCTS && !defined HASH_buffer_2CEE653E74 +#if CHECK_STRUCTS && !defined HASH_buffer_E34A11C6B9 # error "buffer changed. See CHECK_STRUCTS comment." #endif struct buffer munged_buffer = *in_buffer; diff --git a/src/process.c b/src/process.c index 802ac02624..6770a5ed88 100644 --- a/src/process.c +++ b/src/process.c @@ -858,7 +858,8 @@ allocate_pty (char pty_name[PTY_NAME_SIZE]) static struct Lisp_Process * allocate_process (void) { - return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Process, pid, PVEC_PROCESS); + return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Process, thread, + PVEC_PROCESS); } static Lisp_Object diff --git a/src/process.h b/src/process.h index d66aa062a5..5e957c4298 100644 --- a/src/process.h +++ b/src/process.h @@ -117,9 +117,7 @@ struct Lisp_Process /* The thread a process is linked to, or nil for any thread. */ Lisp_Object thread; - - /* After this point, there are no Lisp_Objects any more. */ - /* alloc.c assumes that `pid' is the first such non-Lisp slot. */ + /* After this point, there are no Lisp_Objects. */ /* Process ID. A positive value is a child process ID. Zero is for pseudo-processes such as network or serial connections, diff --git a/src/termhooks.h b/src/termhooks.h index ca6782f461..a92b981110 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -408,7 +408,7 @@ struct terminal whether the mapping is available. */ Lisp_Object glyph_code_table; - /* All fields before `next_terminal' should be Lisp_Object and are traced + /* All earlier fields should be Lisp_Objects and are traced by the GC. All fields afterwards are ignored by the GC. */ /* Chain of all terminal devices. */ diff --git a/src/terminal.c b/src/terminal.c index 1d7a965dd2..0ee0121e35 100644 --- a/src/terminal.c +++ b/src/terminal.c @@ -264,8 +264,8 @@ get_named_terminal (const char *name) static struct terminal * allocate_terminal (void) { - return ALLOCATE_ZEROED_PSEUDOVECTOR - (struct terminal, next_terminal, PVEC_TERMINAL); + return ALLOCATE_ZEROED_PSEUDOVECTOR (struct terminal, glyph_code_table, + PVEC_TERMINAL); } /* Create a new terminal object of TYPE and add it to the terminal list. RIF diff --git a/src/thread.c b/src/thread.c index e51d614434..670680f2b0 100644 --- a/src/thread.c +++ b/src/thread.c @@ -267,7 +267,7 @@ informational only. */) if (!NILP (name)) CHECK_STRING (name); - mutex = ALLOCATE_PSEUDOVECTOR (struct Lisp_Mutex, mutex, PVEC_MUTEX); + mutex = ALLOCATE_PSEUDOVECTOR (struct Lisp_Mutex, name, PVEC_MUTEX); memset ((char *) mutex + offsetof (struct Lisp_Mutex, mutex), 0, sizeof (struct Lisp_Mutex) - offsetof (struct Lisp_Mutex, mutex)); @@ -386,7 +386,7 @@ informational only. */) if (!NILP (name)) CHECK_STRING (name); - condvar = ALLOCATE_PSEUDOVECTOR (struct Lisp_CondVar, cond, PVEC_CONDVAR); + condvar = ALLOCATE_PSEUDOVECTOR (struct Lisp_CondVar, name, PVEC_CONDVAR); memset ((char *) condvar + offsetof (struct Lisp_CondVar, cond), 0, sizeof (struct Lisp_CondVar) - offsetof (struct Lisp_CondVar, cond)); @@ -805,7 +805,7 @@ If NAME is given, it must be a string; it names the new thread. */) if (!NILP (name)) CHECK_STRING (name); - new_thread = ALLOCATE_PSEUDOVECTOR (struct thread_state, m_stack_bottom, + new_thread = ALLOCATE_PSEUDOVECTOR (struct thread_state, event_object, PVEC_THREAD); memset ((char *) new_thread + offset, 0, sizeof (struct thread_state) - offset); @@ -1064,7 +1064,7 @@ static void init_main_thread (void) { main_thread.s.header.size - = PSEUDOVECSIZE (struct thread_state, m_stack_bottom); + = PSEUDOVECSIZE (struct thread_state, event_object); XSETPVECTYPE (&main_thread.s, PVEC_THREAD); main_thread.s.m_last_thing_searched = Qnil; main_thread.s.m_saved_last_thing_searched = Qnil; diff --git a/src/thread.h b/src/thread.h index 50f8f5cbe0..0514669a87 100644 --- a/src/thread.h +++ b/src/thread.h @@ -61,8 +61,8 @@ struct thread_state /* If we are waiting for some event, this holds the object we are waiting on. */ Lisp_Object event_object; + /* event_object must be the last Lisp field. */ - /* m_stack_bottom must be the first non-Lisp field. */ /* An address near the bottom of the stack. Tells GC how to save a copy of the stack. */ char const *m_stack_bottom; diff --git a/src/w32term.c b/src/w32term.c index 7dbeda7a71..bb1f0bad01 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -3896,7 +3896,7 @@ x_scroll_bar_create (struct window *w, int left, int top, int width, int height, HWND hwnd; SCROLLINFO si; struct scroll_bar *bar - = ALLOCATE_PSEUDOVECTOR (struct scroll_bar, top, PVEC_OTHER); + = ALLOCATE_PSEUDOVECTOR (struct scroll_bar, w32_widget_high, PVEC_OTHER); Lisp_Object barobj; block_input (); diff --git a/src/window.c b/src/window.c index be338c2af6..f911c0c7d4 100644 --- a/src/window.c +++ b/src/window.c @@ -4170,8 +4170,8 @@ temp_output_buffer_show (register Lisp_Object buf) static struct window * allocate_window (void) { - return ALLOCATE_ZEROED_PSEUDOVECTOR - (struct window, current_matrix, PVEC_WINDOW); + return ALLOCATE_ZEROED_PSEUDOVECTOR (struct window, mode_line_help_echo, + PVEC_WINDOW); } /* Make new window, have it replace WINDOW in window-tree, and make @@ -6710,7 +6710,8 @@ struct save_window_data Lisp_Object saved_windows; /* All fields above are traced by the GC. - From `frame-cols' down, the fields are ignored by the GC. */ + After saved_windows, the fields are ignored by the GC. */ + /* We should be able to do without the following two. */ int frame_cols, frame_lines; /* These two should get eventually replaced by their pixel @@ -7383,15 +7384,11 @@ redirection (see `redirect-frame-focus'). The variable saved by this function. */) (Lisp_Object frame) { - Lisp_Object tem; - ptrdiff_t i, n_windows; - struct save_window_data *data; struct frame *f = decode_live_frame (frame); - - n_windows = count_windows (XWINDOW (FRAME_ROOT_WINDOW (f))); - data = ALLOCATE_PSEUDOVECTOR (struct save_window_data, frame_cols, - PVEC_WINDOW_CONFIGURATION); - + ptrdiff_t n_windows = count_windows (XWINDOW (FRAME_ROOT_WINDOW (f))); + struct save_window_data *data + = ALLOCATE_PSEUDOVECTOR (struct save_window_data, saved_windows, + PVEC_WINDOW_CONFIGURATION); data->frame_cols = FRAME_COLS (f); data->frame_lines = FRAME_LINES (f); data->frame_menu_bar_lines = FRAME_MENU_BAR_LINES (f); @@ -7407,9 +7404,9 @@ saved by this function. */) data->minibuf_selected_window = minibuf_level > 0 ? minibuf_selected_window : Qnil; data->root_window = FRAME_ROOT_WINDOW (f); data->focus_frame = FRAME_FOCUS_FRAME (f); - tem = make_uninit_vector (n_windows); + Lisp_Object tem = make_uninit_vector (n_windows); data->saved_windows = tem; - for (i = 0; i < n_windows; i++) + for (ptrdiff_t i = 0; i < n_windows; i++) ASET (tem, i, make_nil_vector (VECSIZE (struct saved_window))); save_window_save (FRAME_ROOT_WINDOW (f), XVECTOR (tem), 0); XSETWINDOW_CONFIGURATION (tem, data); diff --git a/src/window.h b/src/window.h index 4235a6eade..fdef407041 100644 --- a/src/window.h +++ b/src/window.h @@ -212,9 +212,8 @@ struct window /* The help echo text for this window. Qnil if there's none. */ Lisp_Object mode_line_help_echo; - /* No Lisp data may follow below this point without changing - mark_object in alloc.c. The member current_matrix must be the - first non-Lisp member. */ + /* No Lisp data may follow this point; mode_line_help_echo must be + the last Lisp member. */ /* Glyph matrices. */ struct glyph_matrix *current_matrix; diff --git a/src/xterm.c b/src/xterm.c index 2f830afe61..5aa3e3ff25 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -6611,8 +6611,8 @@ x_scroll_bar_create (struct window *w, int top, int left, int width, int height, bool horizontal) { struct frame *f = XFRAME (w->frame); - struct scroll_bar *bar - = ALLOCATE_PSEUDOVECTOR (struct scroll_bar, x_window, PVEC_OTHER); + struct scroll_bar *bar = ALLOCATE_PSEUDOVECTOR (struct scroll_bar, prev, + PVEC_OTHER); Lisp_Object barobj; block_input (); diff --git a/src/xterm.h b/src/xterm.h index 972a10f4d4..c5ad38650c 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -897,7 +897,7 @@ struct scroll_bar /* The next and previous in the chain of scroll bars in this frame. */ Lisp_Object next, prev; - /* Fields from `x_window' down will not be traced by the GC. */ + /* Fields after 'prev' are not traced by the GC. */ /* The X window representing this scroll bar. */ Window x_window; diff --git a/src/xwidget.c b/src/xwidget.c index c56284928e..2486a2d4da 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -41,14 +41,13 @@ along with GNU Emacs. If not, see . */ static struct xwidget * allocate_xwidget (void) { - return ALLOCATE_PSEUDOVECTOR (struct xwidget, height, PVEC_XWIDGET); + return ALLOCATE_PSEUDOVECTOR (struct xwidget, script_callbacks, PVEC_XWIDGET); } static struct xwidget_view * allocate_xwidget_view (void) { - return ALLOCATE_PSEUDOVECTOR (struct xwidget_view, redisplayed, - PVEC_XWIDGET_VIEW); + return ALLOCATE_PSEUDOVECTOR (struct xwidget_view, w, PVEC_XWIDGET_VIEW); } #define XSETXWIDGET(a, b) XSETPSEUDOVECTOR (a, b, PVEC_XWIDGET) diff --git a/src/xwidget.h b/src/xwidget.h index 8c598efb2e..1b6368daab 100644 --- a/src/xwidget.h +++ b/src/xwidget.h @@ -49,8 +49,7 @@ struct xwidget /* Vector of currently executing scripts with callbacks. */ Lisp_Object script_callbacks; - - /* Here ends the Lisp part. "height" is the marker field. */ + /* Here ends the Lisp part. script_callbacks is the marker field. */ int height; int width; @@ -68,8 +67,7 @@ struct xwidget_view union vectorlike_header header; Lisp_Object model; Lisp_Object w; - - /* Here ends the lisp part. "redisplayed" is the marker field. */ + /* Here ends the lisp part. "w" is the marker field. */ /* If touched by redisplay. */ bool redisplayed; commit 31e9087cdcd0b78b2247c3d8532290881abfbb08 Author: Stefan Monnier Date: Mon Apr 8 15:43:26 2019 -0400 * lisp/gnus/gnus-agent.el (gnus-agent-fetch-articles): Use match-string (gnus-agent-expire-group-1): Dial down on the 'setq'. diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 879e1fe205..9f7d2c9df7 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -276,7 +276,7 @@ Actually a hash table holding subjects mapped to t.") (defmacro gnus-agent-with-refreshed-group (group &rest body) "Performs the body then updates the group's line in the group buffer. Automatically blocks multiple updates due to recursion." -`(prog1 (let ((gnus-agent-inhibit-update-total-fetched-for t)) ,@body) + `(prog1 (let ((gnus-agent-inhibit-update-total-fetched-for t)) ,@body) (when (and gnus-agent-need-update-total-fetched-for (not gnus-agent-inhibit-update-total-fetched-for)) (with-current-buffer gnus-group-buffer @@ -311,9 +311,10 @@ buffer. Automatically blocks multiple updates due to recursion." (defun gnus-agent-cat-set-property (category property value) (if value (setcdr (or (assq property category) - (let ((cell (cons property nil))) + (let ((cell (cons property nil))) (setcdr category (cons cell (cdr category))) - cell)) value) + cell)) + value) (let ((category category)) (while (cond ((eq property (caadr category)) (setcdr category (cddr category)) @@ -378,7 +379,8 @@ manipulated as follows: (setcdr (or (assq 'agent-groups category) (let ((cell (cons 'agent-groups nil))) (setcdr category (cons cell (cdr category))) - cell)) new-g)) + cell)) + new-g)) (t (let ((groups groups)) (while groups @@ -395,7 +397,8 @@ manipulated as follows: (setcdr (or (assq 'agent-groups category) (let ((cell (cons 'agent-groups nil))) (setcdr category (cons cell (cdr category))) - cell)) groups)))))) + cell)) + groups)))))) (defsubst gnus-agent-cat-make (name &optional default-agent-predicate) (list name `(agent-predicate . ,(or default-agent-predicate 'false)))) @@ -1557,11 +1560,8 @@ downloaded into the agent." (skip-chars-forward " ") (setq crosses nil) (while (looking-at "\\([^: \n]+\\):\\([0-9]+\\) *") - (push (cons (buffer-substring (match-beginning 1) - (match-end 1)) - (string-to-number - (buffer-substring (match-beginning 2) - (match-end 2)))) + (push (cons (match-string 1) + (string-to-number (match-string 2))) crosses) (goto-char (match-end 0))) (gnus-agent-crosspost crosses (caar pos) date))) @@ -2939,7 +2939,7 @@ The following commands are available: 'or) ((memq (car predicate) gnus-category-not) 'not)) - ,@(mapcar 'gnus-category-make-function-1 (cdr predicate)))) + ,@(mapcar #'gnus-category-make-function-1 (cdr predicate)))) (t (error "Unknown predicate type: %s" predicate)))) @@ -2965,7 +2965,7 @@ return read articles, nil when it is known to always return read articles, and t_nil when the function may return both read and unread articles." (let ((func (car function)) - (args (mapcar 'gnus-function-implies-unread-1 (cdr function)))) + (args (mapcar #'gnus-function-implies-unread-1 (cdr function)))) (cond ((eq func 'and) (cond ((memq t args) ; if any argument returns only unread articles ;; then that argument constrains the result to only unread articles. @@ -3151,38 +3151,37 @@ FORCE is equivalent to setting the expiration predicates to true." (nov-file (concat dir ".overview")) (cnt 0) (completed -1) - dlist - type) - - ;; The normal article alist contains elements that look like - ;; (article# . fetch_date) I need to combine other - ;; information with this list. For example, a flag indicating - ;; that a particular article MUST BE KEPT. To do this, I'm - ;; going to transform the elements to look like (article# - ;; fetch_date keep_flag NOV_entry_position) Later, I'll reverse - ;; the process to generate the expired article alist. - - ;; Convert the alist elements to (article# fetch_date nil - ;; nil). - (setq dlist (mapcar (lambda (e) - (list (car e) (cdr e) nil nil)) alist)) - - ;; Convert the keep lists to elements that look like (article# - ;; nil keep_flag nil) then append it to the expanded dlist - ;; These statements are sorted by ascending precedence of the - ;; keep_flag. - (setq dlist (nconc dlist - (mapcar (lambda (e) - (list e nil 'unread nil)) - unreads))) - (setq dlist (nconc dlist - (mapcar (lambda (e) - (list e nil 'marked nil)) - marked))) - (setq dlist (nconc dlist - (mapcar (lambda (e) - (list e nil 'special nil)) - specials))) + type + + ;; The normal article alist contains elements that look like + ;; (article# . fetch_date) I need to combine other + ;; information with this list. For example, a flag indicating + ;; that a particular article MUST BE KEPT. To do this, I'm + ;; going to transform the elements to look like (article# + ;; fetch_date keep_flag NOV_entry_position) Later, I'll reverse + ;; the process to generate the expired article alist. + (dlist + (nconc + ;; Convert the alist elements to (article# fetch_date nil nil). + (mapcar (lambda (e) + (list (car e) (cdr e) nil nil)) + alist) + + ;; Convert the keep lists to elements that look like (article# + ;; nil keep_flag nil) then append it to the expanded dlist + ;; These statements are sorted by ascending precedence of the + ;; keep_flag. + (mapcar (lambda (e) + (list e nil 'unread nil)) + unreads) + + (mapcar (lambda (e) + (list e nil 'marked nil)) + marked) + + (mapcar (lambda (e) + (list e nil 'special nil)) + specials)))) (set-buffer overview) (erase-buffer) @@ -3391,7 +3390,7 @@ article alist" type) actions)) (when actions (gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s" decoded article-number - (mapconcat 'identity actions ", "))))) + (mapconcat #'identity actions ", "))))) (t (gnus-agent-message 10 "gnus-agent-expire: %s:%d: Article kept as \ @@ -3624,7 +3623,7 @@ If CACHED-HEADER is nil, articles are only excluded if the article itself has been fetched." ;; Logically equivalent to: (gnus-sorted-difference articles (mapcar - ;; 'car gnus-agent-article-alist)) + ;; #'car gnus-agent-article-alist)) ;; Functionally, I don't need to construct a temp list using mapcar. commit baaacd92fff4e6a49bbb1fea3caed25004490559 Author: Stefan Monnier Date: Mon Apr 8 15:36:18 2019 -0400 * nadvice.el: Add ourselves to package--builtin-versions diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index bb647b012e..2278e389ce 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -36,6 +36,11 @@ ;;; Code: +;; The autoloads.el mechanism which adds package--builtin-versions +;; maintenance to loaddefs.el doesn't work for preloaded packages (such +;; as this one), so we have to do it by hand! +(push (purecopy '(nadvice 1 0)) package--builtin-versions) + ;;;; Lightweight advice/hook (defvar advice--where-alist '((:around "\300\301\302\003#\207" 5) @@ -241,6 +246,8 @@ different, but `function-equal' will hopefully ignore those differences.") (if (local-variable-p var) (symbol-value var) (setq advice--buffer-local-function-sample ;; This function acts like the t special value in buffer-local hooks. + ;; FIXME: Provide an `advice-bottom' function that's like + ;; `advice-cd*r' but also follows through this proxy. (lambda (&rest args) (apply (default-value var) args))))) (eval-and-compile commit 0d5e83611e5157800fd855fe8e3f60c8eff0af7c Author: Stefan Monnier Date: Mon Apr 8 14:28:34 2019 -0400 Eshell: Try to untangle the dependencies; move 'provide's to the end * lisp/eshell/esh-arg.el: Move defsubst and vars before first use. Don't require `esh-mode but esh-util instead. * lisp/eshell/esh-cmd.el: Require esh-module and esh-io. * lisp/eshell/esh-ext.el: Don't require esh-proc nor esh-cmd. (eshell-external-command): Require esh-proc for eshell-gather-process-output. * lisp/eshell/esh-mode.el: Don't require esh-io nor esh-var, but require esh-arg. (eshell-directory-name): Move from eshell.el. * lisp/eshell/esh-module.el: Don't require eshell. * lisp/eshell/esh-opt.el: Don't require esh-ext at top-level. (eshell--do-opts, eshell-show-usage): Require it here instead. * lisp/eshell/esh-proc.el: Don't require esh-cmd, but require esh-io. (eshell-reset-after-proc, eshell-record-process-object) (eshell-gather-process-output, eshell-send-eof-to-process): Require esh-mode and esh-var here. * lisp/eshell/esh-var.el: Require esh-module, esh-arg, and esh-io. * lisp/eshell/eshell.el: Require esh-module, esh-proc, esh-io, and esh-cmd. But don't require esh-mode. (eshell-directory-name): Move to esh-mode. (eshell-return-exits-minibuffer): Don't bind 'return' and 'M-return' since we already bind RET and M-RET. diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index 05579eed32..bc0da96c58 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -59,6 +59,7 @@ (require 'ring) (require 'esh-opt) +(require 'esh-mode) (require 'em-pred) (require 'eshell) @@ -192,7 +193,6 @@ element, regardless of any text on the command line. In that case, (defvar eshell-isearch-map (let ((map (copy-keymap isearch-mode-map))) (define-key map [(control ?m)] 'eshell-isearch-return) - (define-key map [return] 'eshell-isearch-return) (define-key map [(control ?r)] 'eshell-isearch-repeat-backward) (define-key map [(control ?s)] 'eshell-isearch-repeat-forward) (define-key map [(control ?g)] 'eshell-isearch-abort) @@ -220,7 +220,7 @@ Returns nil if INPUT is prepended by blank space, otherwise non-nil." "Initialize the history management code for one Eshell buffer." (when (eshell-using-module 'eshell-cmpl) (add-hook 'pcomplete-try-first-hook - 'eshell-complete-history-reference nil t)) + #'eshell-complete-history-reference nil t)) (if (and (eshell-using-module 'eshell-rebind) (not eshell-non-interactive-p)) @@ -235,11 +235,13 @@ Returns nil if INPUT is prepended by blank space, otherwise non-nil." (lambda () (if (>= (point) eshell-last-output-end) (setq overriding-terminal-local-map - eshell-isearch-map)))) nil t) + eshell-isearch-map)))) + nil t) (add-hook 'isearch-mode-end-hook (function (lambda () - (setq overriding-terminal-local-map nil))) nil t)) + (setq overriding-terminal-local-map nil))) + nil t)) (define-key eshell-mode-map [up] 'eshell-previous-matching-input-from-input) (define-key eshell-mode-map [down] 'eshell-next-matching-input-from-input) (define-key eshell-mode-map [(control up)] 'eshell-previous-input) @@ -288,17 +290,17 @@ Returns nil if INPUT is prepended by blank space, otherwise non-nil." (if eshell-history-file-name (eshell-read-history nil t)) - (add-hook 'eshell-exit-hook 'eshell-write-history nil t)) + (add-hook 'eshell-exit-hook #'eshell-write-history nil t)) (unless eshell-history-ring (setq eshell-history-ring (make-ring eshell-history-size))) - (add-hook 'eshell-exit-hook 'eshell-write-history nil t) + (add-hook 'eshell-exit-hook #'eshell-write-history nil t) - (add-hook 'kill-emacs-hook 'eshell-save-some-history) + (add-hook 'kill-emacs-hook #'eshell-save-some-history) (make-local-variable 'eshell-input-filter-functions) - (add-hook 'eshell-input-filter-functions 'eshell-add-to-history nil t) + (add-hook 'eshell-input-filter-functions #'eshell-add-to-history nil t) (define-key eshell-command-map [(control ?l)] 'eshell-list-history) (define-key eshell-command-map [(control ?x)] 'eshell-get-next-from-history)) @@ -754,7 +756,7 @@ matched." (setq nth (eshell-hist-word-reference nth))) (unless (numberp mth) (setq mth (eshell-hist-word-reference mth))) - (cons (mapconcat 'identity (eshell-sublist textargs nth mth) " ") + (cons (mapconcat #'identity (eshell-sublist textargs nth mth) " ") end)))) (defun eshell-hist-parse-modifier (hist reference) diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el index 8af783eaf8..9a9f23cddd 100644 --- a/lisp/eshell/em-term.el +++ b/lisp/eshell/em-term.el @@ -191,7 +191,7 @@ allowed." (term-exec term-buf program program nil args) (let ((proc (get-buffer-process term-buf))) (if (and proc (eq 'run (process-status proc))) - (set-process-sentinel proc 'eshell-term-sentinel) + (set-process-sentinel proc #'eshell-term-sentinel) (error "Failed to invoke visual command"))) (term-char-mode) (if eshell-escape-control-x diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index 360202b653..3ba4c935a7 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -25,9 +25,9 @@ ;; hook `eshell-parse-argument-hook'. For a good example of this, see ;; `eshell-parse-drive-letter', defined in eshell-dirs.el. -(provide 'esh-arg) +;;; Code: -(require 'esh-mode) +(require 'esh-util) (defgroup eshell-arg nil "Argument parsing involves transforming the arguments passed on the @@ -36,6 +36,48 @@ yield the values intended." :tag "Argument parsing" :group 'eshell) +;;; Internal Variables: + +(defvar eshell-current-argument nil) +(defvar eshell-current-modifiers nil) +(defvar eshell-arg-listified nil) +(defvar eshell-nested-argument nil) +(defvar eshell-current-quoted nil) +(defvar eshell-inside-quote-regexp nil) +(defvar eshell-outside-quote-regexp nil) + +;;; User Variables: + +(defcustom eshell-arg-load-hook nil + "A hook that gets run when `eshell-arg' is loaded." + :version "24.1" ; removed eshell-arg-initialize + :type 'hook + :group 'eshell-arg) + +(defcustom eshell-delimiter-argument-list '(?\; ?& ?\| ?\> ?\s ?\t ?\n) + "List of characters to recognize as argument separators." + :type '(repeat character) + :group 'eshell-arg) + +(defcustom eshell-special-chars-inside-quoting '(?\\ ?\") + "Characters which are still special inside double quotes." + :type '(repeat character) + :group 'eshell-arg) + +(defcustom eshell-special-chars-outside-quoting + (append eshell-delimiter-argument-list '(?# ?! ?\\ ?\" ?\')) + "Characters that require escaping outside of double quotes. +Without escaping them, they will introduce a change in the argument." + :type '(repeat character) + :group 'eshell-arg) + +(defsubst eshell-arg-delimiter (&optional pos) + "Return non-nil if POS is an argument delimiter. +If POS is nil, the location of point is checked." + (let ((pos (or pos (point)))) + (or (= pos (point-max)) + (memq (char-after pos) eshell-delimiter-argument-list)))) + (defcustom eshell-parse-argument-hook (list ;; a term such as #, or # is a buffer @@ -113,47 +155,13 @@ treated as a literal character." :type 'hook :group 'eshell-arg) -;;; Code: - -;;; User Variables: - -(defcustom eshell-arg-load-hook nil - "A hook that gets run when `eshell-arg' is loaded." - :version "24.1" ; removed eshell-arg-initialize - :type 'hook - :group 'eshell-arg) - -(defcustom eshell-delimiter-argument-list '(?\; ?& ?\| ?\> ?\s ?\t ?\n) - "List of characters to recognize as argument separators." - :type '(repeat character) - :group 'eshell-arg) - -(defcustom eshell-special-chars-inside-quoting '(?\\ ?\") - "Characters which are still special inside double quotes." - :type '(repeat character) - :group 'eshell-arg) - -(defcustom eshell-special-chars-outside-quoting - (append eshell-delimiter-argument-list '(?# ?! ?\\ ?\" ?\')) - "Characters that require escaping outside of double quotes. -Without escaping them, they will introduce a change in the argument." - :type '(repeat character) - :group 'eshell-arg) - -;;; Internal Variables: - -(defvar eshell-current-argument nil) -(defvar eshell-current-modifiers nil) -(defvar eshell-arg-listified nil) -(defvar eshell-nested-argument nil) -(defvar eshell-current-quoted nil) -(defvar eshell-inside-quote-regexp nil) -(defvar eshell-outside-quote-regexp nil) - ;;; Functions: (defun eshell-arg-initialize () "Initialize the argument parsing code." + ;; This is supposedly run after enabling esh-mode, when eshell-mode-map + ;; already exists. + (defvar eshell-command-map) (define-key eshell-command-map [(meta ?b)] 'eshell-insert-buffer-name) (set (make-local-variable 'eshell-inside-quote-regexp) nil) (set (make-local-variable 'eshell-outside-quote-regexp) nil)) @@ -195,13 +203,6 @@ Without escaping them, they will introduce a change in the argument." (setq eshell-current-argument argument)) (throw 'eshell-arg-done t)) -(defsubst eshell-arg-delimiter (&optional pos) - "Return non-nil if POS is an argument delimiter. -If POS is nil, the location of point is checked." - (let ((pos (or pos (point)))) - (or (= pos (point-max)) - (memq (char-after pos) eshell-delimiter-argument-list)))) - (defun eshell-quote-argument (string) "Return STRING with magic characters quoted. Magic characters are those in `eshell-special-chars-outside-quoting'." @@ -405,4 +406,5 @@ If the form has no `type', the syntax is parsed as if `type' were (char-to-string (char-after))))) (goto-char end))))))) +(provide 'esh-arg) ;;; esh-arg.el ends here diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 1ed5d5d701..7b05cfbc34 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -105,6 +105,8 @@ (require 'eldoc)) (require 'esh-arg) (require 'esh-proc) +(require 'esh-module) +(require 'esh-io) (require 'esh-ext) (eval-when-compile @@ -1337,7 +1339,7 @@ messages, and errors." (eshell-print "\n")) (eshell-close-handles 0 (list 'quote result))))) -(defalias 'eshell-lisp-command* 'eshell-lisp-command) +(defalias 'eshell-lisp-command* #'eshell-lisp-command) (provide 'esh-cmd) diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el index 35ebd36b29..ae8bf84624 100644 --- a/lisp/eshell/esh-ext.el +++ b/lisp/eshell/esh-ext.el @@ -31,17 +31,12 @@ ;;; Code: -(provide 'esh-ext) - (require 'esh-util) -(eval-when-compile - (require 'cl-lib) - (require 'esh-cmd)) +(eval-when-compile (require 'cl-lib)) (require 'esh-io) (require 'esh-arg) (require 'esh-opt) -(require 'esh-proc) (defgroup eshell-ext nil "External commands are invoked when operating system executables are @@ -179,7 +174,7 @@ external version." (defun eshell-ext-initialize () "Initialize the external command handling code." - (add-hook 'eshell-named-command-hook 'eshell-explicit-command nil t)) + (add-hook 'eshell-named-command-hook #'eshell-explicit-command nil t)) (defun eshell-explicit-command (command args) "If a command name begins with `*', call it externally always. @@ -193,8 +188,6 @@ This bypasses all Lisp functions and aliases." (error "%s: external command not found" (substring command 1)))))) -(autoload 'eshell-close-handles "esh-io") - (defun eshell-remote-command (command args) "Insert output from a remote COMMAND, using ARGS. A remote command is something that executes on a different machine. @@ -211,7 +204,7 @@ causing the user to wonder if anything's really going on..." (progn (setq exitcode (shell-command - (mapconcat 'shell-quote-argument + (mapconcat #'shell-quote-argument (append (list command) args) " ") outbuf errbuf)) (eshell-print (with-current-buffer outbuf (buffer-string))) @@ -235,6 +228,8 @@ causing the user to wonder if anything's really going on..." (cl-assert interp) (if (functionp (car interp)) (apply (car interp) (append (cdr interp) args)) + (require 'esh-proc) + (declare-function eshell-gather-process-output "esh-proc" (command args)) (eshell-gather-process-output (car interp) (append (cdr interp) args))))) @@ -249,7 +244,7 @@ Adds the given PATH to $PATH.") (if args (progn (setq eshell-path-env (getenv "PATH") - args (mapconcat 'identity args path-separator) + args (mapconcat #'identity args path-separator) eshell-path-env (if prepend (concat args path-separator eshell-path-env) @@ -336,4 +331,5 @@ line of the form #!." (cdr interp))))) (or interp (list fullname))))))) +(provide 'esh-ext) ;;; esh-ext.el ends here diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index c33e7325a8..1a6c71eda0 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -68,8 +68,6 @@ ;;; Code: -(provide 'esh-io) - (require 'esh-arg) (require 'esh-util) @@ -511,4 +509,5 @@ Returns what was actually sent, or nil if nothing was sent." (eshell-output-object-to-target object (car target)) (setq target (cdr target)))))) +(provide 'esh-io) ;;; esh-io.el ends here diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 0a160b9ab3..1f86dacd96 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -58,13 +58,10 @@ ;;; Code: -(provide 'esh-mode) - (require 'esh-util) (require 'esh-module) (require 'esh-cmd) -(require 'esh-io) -(require 'esh-var) +(require 'esh-arg) ;For eshell-parse-arguments (defgroup eshell-mode nil "This module contains code for handling input from the user." @@ -202,6 +199,12 @@ This is used by `eshell-watch-for-password-prompt'." :type 'boolean :group 'eshell-mode) +(defcustom eshell-directory-name + (locate-user-emacs-file "eshell/" ".eshell/") + "The directory where Eshell control files should be kept." + :type 'directory + :group 'eshell) + (defvar eshell-first-time-p t "A variable which is non-nil the first time Eshell is loaded.") @@ -292,7 +295,7 @@ and the hook `eshell-exit-hook'." ;; It's fine to run this unconditionally since it can be customized ;; via the `eshell-kill-processes-on-exit' variable. (and (fboundp 'eshell-query-kill-processes) - (not (memq 'eshell-query-kill-processes eshell-exit-hook)) + (not (memq #'eshell-query-kill-processes eshell-exit-hook)) (eshell-query-kill-processes)) (run-hooks 'eshell-exit-hook)) @@ -334,7 +337,6 @@ and the hook `eshell-exit-hook'." (define-key eshell-command-map [(control ?b)] 'eshell-backward-argument) (define-key eshell-command-map [(control ?e)] 'eshell-show-maximum-output) (define-key eshell-command-map [(control ?f)] 'eshell-forward-argument) - (define-key eshell-command-map [return] 'eshell-copy-old-input) (define-key eshell-command-map [(control ?m)] 'eshell-copy-old-input) (define-key eshell-command-map [(control ?o)] 'eshell-kill-output) (define-key eshell-command-map [(control ?r)] 'eshell-show-output) @@ -414,19 +416,19 @@ and the hook `eshell-exit-hook'." (and initfunc (fboundp initfunc) (funcall initfunc)))) (if eshell-send-direct-to-subprocesses - (add-hook 'pre-command-hook 'eshell-intercept-commands t t)) + (add-hook 'pre-command-hook #'eshell-intercept-commands t t)) (if eshell-scroll-to-bottom-on-input - (add-hook 'pre-command-hook 'eshell-preinput-scroll-to-bottom t t)) + (add-hook 'pre-command-hook #'eshell-preinput-scroll-to-bottom t t)) (when eshell-scroll-show-maximum-output (set (make-local-variable 'scroll-conservatively) 1000)) (when eshell-status-in-mode-line - (add-hook 'eshell-pre-command-hook 'eshell-command-started nil t) - (add-hook 'eshell-post-command-hook 'eshell-command-finished nil t)) + (add-hook 'eshell-pre-command-hook #'eshell-command-started nil t) + (add-hook 'eshell-post-command-hook #'eshell-command-finished nil t)) - (add-hook 'kill-buffer-hook 'eshell-kill-buffer-function t t) + (add-hook 'kill-buffer-hook #'eshell-kill-buffer-function t t) (if eshell-first-time-p (run-hooks 'eshell-first-time-mode-hook)) @@ -451,10 +453,10 @@ and the hook `eshell-exit-hook'." (if eshell-send-direct-to-subprocesses (progn (setq eshell-send-direct-to-subprocesses nil) - (remove-hook 'pre-command-hook 'eshell-intercept-commands t) + (remove-hook 'pre-command-hook #'eshell-intercept-commands t) (message "Sending subprocess input on RET")) (setq eshell-send-direct-to-subprocesses t) - (add-hook 'pre-command-hook 'eshell-intercept-commands t t) + (add-hook 'pre-command-hook #'eshell-intercept-commands t t) (message "Sending subprocess input directly"))) (defun eshell-self-insert-command () @@ -543,7 +545,7 @@ and the hook `eshell-exit-hook'." "Push a mark at the end of the last input text." (push-mark (1- eshell-last-input-end) t)) -(custom-add-option 'eshell-pre-command-hook 'eshell-push-command-mark) +(custom-add-option 'eshell-pre-command-hook #'eshell-push-command-mark) (defsubst eshell-goto-input-start () "Goto the start of the last command input. @@ -551,7 +553,7 @@ Putting this function on `eshell-pre-command-hook' will mimic Plan 9's 9term behavior." (goto-char eshell-last-input-start)) -(custom-add-option 'eshell-pre-command-hook 'eshell-goto-input-start) +(custom-add-option 'eshell-pre-command-hook #'eshell-goto-input-start) (defsubst eshell-interactive-print (string) "Print STRING to the eshell display buffer." @@ -1021,4 +1023,5 @@ This function could be in the list `eshell-output-filter-functions'." (custom-add-option 'eshell-output-filter-functions 'eshell-handle-ansi-color) +(provide 'esh-mode) ;;; esh-mode.el ends here diff --git a/lisp/eshell/esh-module.el b/lisp/eshell/esh-module.el index 2583044a44..1911a49a3a 100644 --- a/lisp/eshell/esh-module.el +++ b/lisp/eshell/esh-module.el @@ -22,9 +22,6 @@ ;;; Code: -(provide 'esh-module) - -(require 'eshell) (require 'esh-util) (defgroup eshell-module nil @@ -101,4 +98,5 @@ customization group. Example: `eshell-cmpl' for that module." (unload-feature module) (message "Unloading %s...done" (symbol-name module)))))) +(provide 'esh-module) ;;; esh-module.el ends here diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el index a023a3c5d2..5b2693283a 100644 --- a/lisp/eshell/esh-opt.el +++ b/lisp/eshell/esh-opt.el @@ -23,9 +23,6 @@ ;;; Code: -(provide 'esh-opt) - -(require 'esh-ext) ;; Unused. ;; (defgroup eshell-opt nil @@ -127,6 +124,8 @@ let-bound variable `args'." (defun eshell--do-opts (name options args) "Helper function for `eshell-eval-using-options'. This code doesn't really need to be macro expanded everywhere." + (require 'esh-ext) + (declare-function eshell-external-command "esh-ext" (command args)) (let ((ext-command (catch 'eshell-ext-command (let ((usage-msg @@ -145,6 +144,8 @@ This code doesn't really need to be macro expanded everywhere." (defun eshell-show-usage (name options) "Display the usage message for NAME, using OPTIONS." + (require 'esh-ext) + (declare-function eshell-search-path "esh-ext" (name)) (let ((usage (format "usage: %s %s\n\n" name (cadr (memq ':usage options)))) (extcmd (memq ':external options)) @@ -273,4 +274,5 @@ switch is unrecognized." (setq index (1+ index)))))))) (nconc (mapcar #'cdr opt-vals) eshell--args))) +(provide 'esh-opt) ;;; esh-opt.el ends here diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index 3432582cf4..d9a6eef716 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -23,9 +23,7 @@ ;;; Code: -(provide 'esh-proc) - -(require 'esh-cmd) +(require 'esh-io) (defgroup eshell-proc nil "When Eshell invokes external commands, it always does so @@ -118,14 +116,17 @@ information, for example." Runs `eshell-reset-after-proc' and `eshell-kill-hook', passing arguments PROC and STATUS to functions on the latter." ;; Was there till 24.1, but it is not optional. - (if (memq 'eshell-reset-after-proc eshell-kill-hook) - (setq eshell-kill-hook (delq 'eshell-reset-after-proc eshell-kill-hook))) + (if (memq #'eshell-reset-after-proc eshell-kill-hook) + (setq eshell-kill-hook (delq #'eshell-reset-after-proc eshell-kill-hook))) (eshell-reset-after-proc status) (run-hook-with-args 'eshell-kill-hook proc status)) (defun eshell-proc-initialize () "Initialize the process handling code." (make-local-variable 'eshell-process-list) + ;; This is supposedly run after enabling esh-mode, when eshell-command-map + ;; already exists. + (defvar eshell-command-map) (define-key eshell-command-map [(meta ?i)] 'eshell-insert-process) (define-key eshell-command-map [(control ?c)] 'eshell-interrupt-process) (define-key eshell-command-map [(control ?k)] 'eshell-kill-process) @@ -139,9 +140,11 @@ PROC and STATUS to functions on the latter." "Reset the command input location after a process terminates. The signals which will cause this to happen are matched by `eshell-reset-signals'." - (if (and (stringp status) - (string-match eshell-reset-signals status)) - (eshell-reset))) + (when (and (stringp status) + (string-match eshell-reset-signals status)) + (require 'esh-mode) + (declare-function eshell-reset "esh-mode" (&optional no-hooks)) + (eshell-reset))) (defun eshell-wait-for-process (&rest procs) "Wait until PROC has successfully completed." @@ -209,7 +212,8 @@ The prompt will be set to PROMPT." (function (lambda (proc) (cons (process-name proc) t))) - (process-list)) nil t)) + (process-list)) + nil t)) (defun eshell-insert-process (process) "Insert the name of PROCESS into the current buffer at point." @@ -220,10 +224,12 @@ The prompt will be set to PROMPT." (defsubst eshell-record-process-object (object) "Record OBJECT as now running." - (if (and (eshell-processp object) - eshell-current-subjob-p) - (eshell-interactive-print - (format "[%s] %d\n" (process-name object) (process-id object)))) + (when (and (eshell-processp object) + eshell-current-subjob-p) + (require 'esh-mode) + (declare-function eshell-interactive-print "esh-mode" (string)) + (eshell-interactive-print + (format "[%s] %d\n" (process-name object) (process-id object)))) (setq eshell-process-list (cons (list object eshell-current-handles eshell-current-subjob-p nil nil) @@ -254,7 +260,7 @@ the full name of a command, otherwise just the nondirectory part must match.") (defun eshell-needs-pipe-p (command) "Return non-nil if COMMAND needs `process-connection-type' to be nil. See `eshell-needs-pipe'." - (and eshell-in-pipeline-p + (and (bound-and-true-p eshell-in-pipeline-p) (not (eq eshell-in-pipeline-p 'first)) ;; FIXME should this return non-nil for anything that is ;; neither 'first nor 'last? See bug#1388 discussion. @@ -267,6 +273,8 @@ See `eshell-needs-pipe'." (defun eshell-gather-process-output (command args) "Gather the output from COMMAND + ARGS." + (require 'esh-var) + (declare-function eshell-environment-variables "esh-var" ()) (unless (and (file-executable-p command) (file-regular-p (file-truename command))) (error "%s: not an executable file" command)) @@ -283,14 +291,14 @@ See `eshell-needs-pipe'." (unless (eshell-needs-pipe-p command) process-connection-type)) (command (file-local-name (expand-file-name command)))) - (apply 'start-file-process + (apply #'start-file-process (file-name-nondirectory command) nil command args))) (eshell-record-process-object proc) (set-process-buffer proc (current-buffer)) - (if (eshell-interactive-output-p) - (set-process-filter proc 'eshell-output-filter) - (set-process-filter proc 'eshell-insertion-filter)) - (set-process-sentinel proc 'eshell-sentinel) + (set-process-filter proc (if (eshell-interactive-output-p) + #'eshell-output-filter + #'eshell-insertion-filter)) + (set-process-sentinel proc #'eshell-sentinel) (run-hook-with-args 'eshell-exec-hook proc) (when (fboundp 'process-coding-system) (let ((coding-systems (process-coding-system proc))) @@ -325,14 +333,14 @@ See `eshell-needs-pipe'." (set-buffer oldbuf) (run-hook-with-args 'eshell-exec-hook command) (setq exit-status - (apply 'call-process-region + (apply #'call-process-region (append (list eshell-last-sync-output-start (point) command t eshell-scratch-buffer nil) args))) ;; When in a pipeline, record the place where the output of ;; this process will begin. - (and eshell-in-pipeline-p + (and (bound-and-true-p eshell-in-pipeline-p) (set-marker eshell-last-sync-output-start (point))) ;; Simulate the effect of the process filter. (when (numberp exit-status) @@ -349,11 +357,14 @@ See `eshell-needs-pipe'." (setq lbeg lend) (set-buffer proc-buf)) (set-buffer oldbuf)) + (require 'esh-mode) + (declare-function eshell-update-markers "esh-mode" (pmark)) + (defvar eshell-last-output-end) ;Defined in esh-mode.el. (eshell-update-markers eshell-last-output-end) ;; Simulate the effect of eshell-sentinel. (eshell-close-handles (if (numberp exit-status) exit-status -1)) (eshell-kill-process-function command exit-status) - (or eshell-in-pipeline-p + (or (bound-and-true-p eshell-in-pipeline-p) (setq eshell-last-sync-output-start nil)) (if (not (numberp exit-status)) (error "%s: external command failed: %s" command exit-status)) @@ -540,7 +551,11 @@ See the variable `eshell-kill-processes-on-exit'." (defun eshell-send-eof-to-process () "Send EOF to process." (interactive) + (require 'esh-mode) + (declare-function eshell-send-input "esh-mode" + (&optional use-region queue-p no-newline)) (eshell-send-input nil nil t) (eshell-process-interact 'process-send-eof)) +(provide 'esh-proc) ;;; esh-proc.el ends here diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index d8be72e359..82e0f7135b 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -105,11 +105,12 @@ ;;; Code: -(provide 'esh-var) - (require 'esh-util) (require 'esh-cmd) (require 'esh-opt) +(require 'esh-module) +(require 'esh-arg) +(require 'esh-io) (require 'pcomplete) (require 'env) @@ -206,6 +207,9 @@ function), and the arguments passed to this function would be the list (set (make-local-variable 'process-environment) (eshell-copy-environment))) + ;; This is supposedly run after enabling esh-mode, when eshell-command-map + ;; already exists. + (defvar eshell-command-map) (define-key eshell-command-map [(meta ?v)] 'eshell-insert-envvar) (set (make-local-variable 'eshell-special-chars-inside-quoting) @@ -213,16 +217,16 @@ function), and the arguments passed to this function would be the list (set (make-local-variable 'eshell-special-chars-outside-quoting) (append eshell-special-chars-outside-quoting '(?$))) - (add-hook 'eshell-parse-argument-hook 'eshell-interpolate-variable t t) + (add-hook 'eshell-parse-argument-hook #'eshell-interpolate-variable t t) (add-hook 'eshell-prepare-command-hook - 'eshell-handle-local-variables nil t) + #'eshell-handle-local-variables nil t) (when (eshell-using-module 'eshell-cmpl) (add-hook 'pcomplete-try-first-hook - 'eshell-complete-variable-reference nil t) + #'eshell-complete-variable-reference nil t) (add-hook 'pcomplete-try-first-hook - 'eshell-complete-variable-assignment nil t))) + #'eshell-complete-variable-assignment nil t))) (defun eshell-handle-local-variables () "Allow for the syntax `VAR=val '." @@ -532,7 +536,7 @@ For example, to retrieve the second element of a user's record in (setq separator (caar indices) refs (cdr refs))) (setq value - (mapcar 'eshell-convert + (mapcar #'eshell-convert (split-string value separator))))) (cond ((< (length refs) 0) @@ -618,4 +622,5 @@ For example, to retrieve the second element of a user's record in (setq pcomplete-stub (substring arg pos)) (throw 'pcomplete-completions (pcomplete-entries))))) +(provide 'esh-var) ;;; esh-var.el ends here diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el index c7ed7103e4..db20f7d9ec 100644 --- a/lisp/eshell/eshell.el +++ b/lisp/eshell/eshell.el @@ -175,10 +175,10 @@ (eval-when-compile (require 'cl-lib)) (require 'esh-util) -;; Provide eshell before requiring esh-mode, to avoid a recursive load. -;; (Bug #34954) -(provide 'eshell) -(require 'esh-mode) +(require 'esh-module) ;For eshell-using-module +(require 'esh-proc) ;For eshell-wait-for-process +(require 'esh-io) ;For eshell-last-command-status +(require 'esh-cmd) (defgroup eshell nil "Command shell implemented entirely in Emacs Lisp. @@ -220,12 +220,6 @@ shells such as bash, zsh, rc, 4dos." :type 'string :group 'eshell) -(defcustom eshell-directory-name - (locate-user-emacs-file "eshell/" ".eshell/") - "The directory where Eshell control files should be kept." - :type 'directory - :group 'eshell) - ;;;_* Running Eshell ;; ;; There are only three commands used to invoke Eshell. The first two @@ -259,11 +253,12 @@ buffer selected (or created)." buf)) (defun eshell-return-exits-minibuffer () + ;; This is supposedly run after enabling esh-mode, when eshell-mode-map + ;; already exists. + (defvar eshell-mode-map) (define-key eshell-mode-map [(control ?g)] 'abort-recursive-edit) - (define-key eshell-mode-map [return] 'exit-minibuffer) (define-key eshell-mode-map [(control ?m)] 'exit-minibuffer) (define-key eshell-mode-map [(control ?j)] 'exit-minibuffer) - (define-key eshell-mode-map [(meta return)] 'exit-minibuffer) (define-key eshell-mode-map [(meta control ?m)] 'exit-minibuffer)) (defvar eshell-non-interactive-p nil @@ -278,7 +273,6 @@ non-interactive sessions, such as when using `eshell-command'.") "Execute the Eshell command string COMMAND. With prefix ARG, insert output into the current buffer at point." (interactive) - (require 'esh-cmd) (unless arg (setq arg current-prefix-arg)) (let ((eshell-non-interactive-p t)) @@ -366,7 +360,8 @@ corresponding to a successful execution." (let ((result (eshell-do-eval (list 'eshell-commands (list 'eshell-command-to-value - (eshell-parse-command command))) t))) + (eshell-parse-command command))) + t))) (cl-assert (eq (car result) 'quote)) (if (and status-var (symbolp status-var)) (set status-var eshell-last-command-status)) @@ -406,4 +401,5 @@ Emacs." (run-hooks 'eshell-load-hook) +(provide 'eshell) ;;; eshell.el ends here commit a20845c160de2ba9f42b3af714d770df502d0577 Author: Michael Albinus Date: Mon Apr 8 13:34:54 2019 +0200 Fix file-readable-p and file-executable-p in some Tramp backends * lisp/net/tramp-archive.el (tramp-archive-handle-file-readable-p): Use tramp-gvfs. * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-executable-p): Check that FILENAME exists. (tramp-gvfs-handle-file-readable-p): Check that FILENAME exists. Use heuristic in case it cannot be determined correctly. diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 9e131b1a47..ba4c26cdf2 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -584,9 +584,7 @@ offered." (defun tramp-archive-handle-file-readable-p (filename) "Like `file-readable-p' for file archives." - (with-parsed-tramp-file-name - (tramp-archive-gvfs-file-name filename) nil - (tramp-check-cached-permissions v ?r))) + (file-readable-p (tramp-archive-gvfs-file-name filename))) (defun tramp-archive-handle-file-system-info (filename) "Like `file-system-info' for file archives." diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 2d8f42004a..8fea82d97c 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1136,7 +1136,8 @@ If FILE-SYSTEM is non-nil, return file system attributes." "Like `file-executable-p' for Tramp files." (with-parsed-tramp-file-name filename nil (with-tramp-file-property v localname "file-executable-p" - (tramp-check-cached-permissions v ?x)))) + (and (file-exists-p filename) + (tramp-check-cached-permissions v ?x))))) (defun tramp-gvfs-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." @@ -1258,7 +1259,20 @@ file-notify events." "Like `file-readable-p' for Tramp files." (with-parsed-tramp-file-name filename nil (with-tramp-file-property v localname "file-readable-p" - (tramp-check-cached-permissions v ?r)))) + (and (file-exists-p filename) + (or (tramp-check-cached-permissions v ?r) + ;; If the user is different from what we guess to be + ;; the user, we don't know. Let's check, whether + ;; access is restricted explicitly. + (and (/= (tramp-gvfs-get-remote-uid v 'integer) + (tramp-compat-file-attribute-user-id + (file-attributes filename 'integer))) + (not + (string-equal + "FALSE" + (cdr (assoc + "access::can-read" + (tramp-gvfs-get-file-attributes filename))))))))))) (defun tramp-gvfs-handle-file-system-info (filename) "Like `file-system-info' for Tramp files."