1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-21 06:55:39 +00:00

Merge from origin/emacs-30

f5451b6a06 ; Improve comment from last change
09e05f7ee4 Document and-let* vs. when-let* usage convention
b7a375f5c4 Fix error when splicing Eshell globs and a glob expands t...
2289e16226 * etc/package-keyring.gpg: Update expiration and add new key
48024096fe Avoid crashes when scrolling images under winner-mode
c35d6ba9f0 ; * doc/lispref/display.texi (Fontsets): Clarify wording.
88a1a32fc5 ; * doc/lispref/display.texi (Fontsets): Fix typo.
6be47058cd ; Add indexing for 'use-default-font-for-symbols'
681f70ea04 * src/lread.c (READ_AND_BUFFER): Reject negative chars (b...
ac4151e002 * test/Makefile.in: Do not show emacs-module-tests.log by...
4e0cb960db Fix 'php-ts-mode': better indentation and font locking
This commit is contained in:
Sean Whitton 2024-10-24 12:13:20 +08:00
commit 95f89c736f
10 changed files with 145 additions and 65 deletions

View File

@ -1681,6 +1681,7 @@ used. Some examples are:
nil 'append)
@end example
@vindex use-default-font-for-symbols
When modifying the fontset for the @code{symbol} script, the value of
@code{use-default-font-for-symbols} will affect whether the fontset is
actually used.

View File

@ -4027,11 +4027,13 @@ in the range @var{from} and @var{to} (inclusive).
@var{characters} may be a charset symbol (@pxref{Character Sets}). In
that case, use @var{font-spec} for all the characters in the charset.
@vindex use-default-font-for-symbols
@var{characters} may be a script symbol (@pxref{Character Properties,
char-script-table}). In that case, use @var{font-spec} for all the
characters belonging to the script. See also
@code{use-default-font-for-symbols}, which affects font selection
when @var{fontset} is @code{symbol}.
when @var{characters} specify or belong to the @code{symbol} script
(which includes symbol and punctuation characters).
@var{characters} may be @code{nil}, which means to use @var{font-spec}
for any character in @var{fontset} for which no font-spec is

Binary file not shown.

View File

@ -348,7 +348,7 @@ regular expressions, and these cannot support the above constructs."
;; always be sure if the "~" is a home directory reference or
;; part of a glob (e.g. if the argument was assembled from
;; variables).
glob
(if eshell-glob-splice-results (list glob) glob)
(unwind-protect
(apply #'eshell-glob-entries globs)
(if message-shown

View File

@ -84,7 +84,7 @@
;;; Install treesitter language parsers
(defvar php-ts-mode--language-source-alist
'((php . ("https://github.com/tree-sitter/tree-sitter-php" "v0.23.0" "php/src"))
'((php . ("https://github.com/tree-sitter/tree-sitter-php" "v0.23.4" "php/src"))
(phpdoc . ("https://github.com/claytonrcarter/tree-sitter-phpdoc"))
(html . ("https://github.com/tree-sitter/tree-sitter-html" "v0.23.0"))
(javascript . ("https://github.com/tree-sitter/tree-sitter-javascript" "v0.23.0"))
@ -428,6 +428,27 @@ Useful for debugging."
;;; Indent
(defconst php-ts-mode--possibly-braceless-keyword-re
(regexp-opt '("if" "for" "foreach" "while" "do") 'symbols)
"Regexp matching keywords optionally followed by an opening brace.")
(defun php-ts-mode--open-statement-group-heuristic (node _parent bol &rest _)
"Heuristic matcher for statement-group without closing bracket.
Return `php-ts-mode-indent-offset' plus 1 when BOL is after
`php-ts-mode--possibly-braceless-keyword-re', otherwise return 0. It's
usefull for matching incomplete compound_statement or colon_block.
PARENT is NODE's parent, BOL is the beginning of non-whitespace
characters of the current line."
(and (null node)
(save-excursion
(forward-line -1)
(if (re-search-forward
php-ts-mode--possibly-braceless-keyword-re
bol t)
(+ 1 php-ts-mode-indent-offset)
0))))
;; taken from c-ts-mode
(defun php-ts-mode--else-heuristic (node parent bol &rest _)
"Heuristic matcher for when \"else\" is followed by a closing bracket.
@ -475,43 +496,50 @@ NODE is the node to match and PARENT is its parent."
(goto-char (treesit-node-start parent))
(line-end-position)))
(defun php-ts-mode--parent-html-bol (node parent _bol &rest _)
(defun php-ts-mode--parent-html-bol (node parent bol &rest _)
"Find the first non-space characters of the HTML tags before NODE.
When NODE is nil call `php-ts-mode--open-statement-group-heuristic'.
PARENT is NODE's parent, BOL is the beginning of non-whitespace
characters of the current line."
(save-excursion
(let ((html-node (treesit-search-forward node "text" t)))
(if html-node
(let ((end-html (treesit-node-end html-node)))
(goto-char end-html)
(backward-word)
(back-to-indentation)
(point))
(treesit-node-start parent)))))
(if (null node)
;; If NODE is nil it could be an open statement-group.
(php-ts-mode--open-statement-group-heuristic node parent bol)
(save-excursion
(let ((html-node (treesit-search-forward node "text" t)))
(if html-node
(let ((end-html (treesit-node-end html-node)))
(goto-char end-html)
(backward-word)
(back-to-indentation)
(point))
(treesit-node-start parent))))))
(defun php-ts-mode--parent-html-heuristic (node parent _bol &rest _)
(defun php-ts-mode--parent-html-heuristic (node parent bol &rest _)
"Return position based on html indentation.
Returns 0 if the NODE is after the </html>, otherwise returns the
indentation point of the last word before the NODE, plus the
indentation offset. If there is no HTML tag, it returns the beginning
of the parent.
indentation point of the last word before the NODE, plus the indentation
offset. If there is no HTML tag, it returns the beginning of the
parent. When NODE is nil call `php-ts-mode--open-statement-group-heuristic'.
It can be used when you want to indent PHP code relative to the HTML.
PARENT is NODE's parent, BOL is the beginning of non-whitespace
characters of the current line."
(let ((html-node (treesit-search-forward node "text" t)))
(if html-node
(let ((end-html (treesit-node-end html-node)))
(save-excursion
(goto-char end-html)
(backward-word)
(back-to-indentation)
(if (search-forward "</html>" end-html t 1)
0
(+ (point) php-ts-mode-indent-offset))))
;; Maybe it's better to use bol?
(treesit-node-start parent))))
(if (null node)
;; If NODE is nil it could be an open statement-group.
(php-ts-mode--open-statement-group-heuristic node parent bol)
(let ((html-node (treesit-search-forward node "text" t)))
(if html-node
(let ((end-html (treesit-node-end html-node)))
(save-excursion
(goto-char end-html)
(backward-word)
(back-to-indentation)
(if (search-forward "</html>" end-html t 1)
0
(+ (point) php-ts-mode-indent-offset))))
;; Maybe it's better to use bol?
(treesit-node-start parent)))))
(defun php-ts-mode--array-element-heuristic (_node parent _bol &rest _)
"Return of the position of the first element of the array.
@ -648,16 +676,22 @@ characters of the current line."
((parent-is "initializer_list") parent-bol php-ts-mode-indent-offset)
;; Statement in {} blocks.
((or (and (parent-is "compound_statement")
((or (and (or (parent-is "compound_statement")
(parent-is "colon_block"))
;; If the previous sibling(s) are not on their
;; own line, indent as if this node is the first
;; sibling
php-ts-mode--first-sibling)
(match null "compound_statement"))
(or (match null "compound_statement")
(match null "colon_block")))
standalone-parent php-ts-mode-indent-offset)
((parent-is "compound_statement") parent-bol php-ts-mode-indent-offset)
((or (parent-is "compound_statement")
(parent-is "colon_block"))
parent-bol php-ts-mode-indent-offset)
;; Opening bracket.
((node-is "compound_statement") standalone-parent php-ts-mode-indent-offset)
((or (node-is "compound_statement")
(node-is "colon_block"))
standalone-parent php-ts-mode-indent-offset)
((parent-is "match_block") parent-bol php-ts-mode-indent-offset)
((parent-is "switch_block") parent-bol 0)
@ -667,6 +701,7 @@ characters of the current line."
;; rule for PHP alternative syntax
((or (node-is "else_if_clause")
(node-is "endif")
(node-is "endfor")
(node-is "endforeach")
(node-is "endwhile"))
parent-bol 0)
@ -679,9 +714,13 @@ characters of the current line."
(parent-is "switch_statement")
(parent-is "case_statement")
(parent-is "empty_statement"))
parent-bol php-ts-mode-indent-offset))))
parent-bol php-ts-mode-indent-offset)
;; Workaround: handle "for" open statement group. Currently
;; the grammar handles it differently than other control structures.
(no-node php-ts-mode--open-statement-group-heuristic 0))))
`((psr2
((parent-is "program") parent-bol 0)
((parent-is "program") php-ts-mode--open-statement-group-heuristic 0)
((parent-is "text_interpolation") column-0 0)
((parent-is "function_call_expression") parent-bol php-ts-mode-indent-offset)
,@common)
@ -774,21 +813,32 @@ characters of the current line."
"__FUNCTION__" "__LINE__" "__METHOD__" "__NAMESPACE__" "__TRAIT__")
"PHP predefined constant.")
(defun php-ts-mode--test-namespace-name-as-prefix-p ()
"Return t if namespace_name_as_prefix keyword is a named node, nil otherwise."
(defconst php-ts-mode--class-magic-methods
'("__construct" "__destruct" "__call" "__callStatic" "__get" "__set"
"__isset" "__unset" "__sleep" "__wakeup" "__serialize" "__unserialize"
"__toString" "__invoke" "__set_state" "__clone" "__debugInfo")
"PHP predefined magic methods.")
(defun php-ts-mode--test-namespace-name-as-prefix-p ()
"Return t if namespace_name_as_prefix is a named node, nil otherwise."
(ignore-errors
(progn (treesit-query-compile 'php "(namespace_name_as_prefix)" t) t)))
(defun php-ts-mode--test-namespace-aliasing-clause-p ()
"Return t if namespace_name_as_prefix keyword is named node, nil otherwise."
(defun php-ts-mode--test-namespace-aliasing-clause-p ()
"Return t if namespace_aliasing_clause is a named node, nil otherwise."
(ignore-errors
(progn (treesit-query-compile 'php "(namespace_name_as_prefix)" t) t)))
(progn (treesit-query-compile 'php "(namespace_aliasing_clause)" t) t)))
(defun php-ts-mode--test-namespace-use-group-clause-p ()
"Return t if namespace_use_group_clause keyword is named node, nil otherwise."
"Return t if namespace_use_group_clause is a named node, nil otherwise."
(ignore-errors
(progn (treesit-query-compile 'php "(namespace_use_group_clause)" t) t)))
(defun php-ts-mode--test-visibility-modifier-operation-clause-p ()
"Return t if (visibility_modifier (operation)) is defined, nil otherwise."
(ignore-errors
(progn (treesit-query-compile 'php "(visibility_modifier (operation))" t) t)))
(defun php-ts-mode--font-lock-settings ()
"Tree-sitter font-lock settings."
(treesit-font-lock-rules
@ -796,7 +846,10 @@ characters of the current line."
:language 'php
:feature 'keyword
:override t
`([,@php-ts-mode--keywords] @font-lock-keyword-face)
`([,@php-ts-mode--keywords] @font-lock-keyword-face
,@(when (php-ts-mode--test-visibility-modifier-operation-clause-p)
'((visibility_modifier (operation) @font-lock-builtin-face)))
(var_modifier) @font-lock-builtin-face)
:language 'php
:feature 'comment
@ -826,7 +879,6 @@ characters of the current line."
(named_label_statement (name) @font-lock-constant-face))
:language 'php
;;:override t
:feature 'delimiter
`((["," ":" ";" "\\"]) @font-lock-delimiter-face)
@ -850,7 +902,6 @@ characters of the current line."
:language 'php
:feature 'string
;;:override t
`(("\"") @font-lock-string-face
(encapsed_string) @font-lock-string-face
(string_content) @font-lock-string-face
@ -892,32 +943,37 @@ characters of the current line."
name: (_) @font-lock-type-face)
(trait_declaration
name: (_) @font-lock-type-face)
(property_declaration
(visibility_modifier) @font-lock-keyword-face)
(property_declaration
(var_modifier) @font-lock-keyword-face)
(enum_declaration
name: (_) @font-lock-type-face)
(function_definition
name: (_) @font-lock-function-name-face)
(method_declaration
name: (_) @font-lock-function-name-face)
(method_declaration
name: (name) @font-lock-builtin-face
(:match ,(rx-to-string
`(: bos (or ,@php-ts-mode--class-magic-methods) eos))
@font-lock-builtin-face))
("=>") @font-lock-keyword-face
(object_creation_expression
(name) @font-lock-type-face)
,@(when (php-ts-mode--test-namespace-name-as-prefix-p)
'((namespace_name_as_prefix "\\" @font-lock-delimiter-face)
(namespace_name_as_prefix
(namespace_name (name)) @font-lock-type-face)))
'((namespace_name_as_prefix "\\" @font-lock-delimiter-face)
(namespace_name_as_prefix
(namespace_name (name)) @font-lock-type-face)))
,@(if (php-ts-mode--test-namespace-aliasing-clause-p)
'((namespace_aliasing_clause (name) @font-lock-type-face))
'((namespace_use_clause alias: (name) @font-lock-type-face)))
'((namespace_aliasing_clause (name) @font-lock-type-face))
'((namespace_use_clause alias: (name) @font-lock-type-face)))
,@(when (not (php-ts-mode--test-namespace-use-group-clause-p))
'((namespace_use_group
(namespace_use_clause (name) @font-lock-type-face))))
'((namespace_use_group
(namespace_use_clause (name) @font-lock-type-face))))
(namespace_name "\\" @font-lock-delimiter-face)
(namespace_name (name) @font-lock-type-face)
(use_declaration (name) @font-lock-property-use-face))
(use_declaration (name) @font-lock-property-use-face)
(use_instead_of_clause (name) @font-lock-type-face)
(binary_expression
operator: "instanceof"
right: (name) @font-lock-type-face))
:language 'php
:feature 'function-scope
@ -932,9 +988,9 @@ characters of the current line."
'((function_call_expression
function: (name) @font-lock-function-call-face)
(scoped_call_expression
name: (_) @font-lock-function-name-face)
name: (_) @font-lock-function-call-face)
(member_call_expression
name: (_) @font-lock-function-name-face)
name: (_) @font-lock-function-call-face)
(nullsafe_member_call_expression
name: (_) @font-lock-constant-face))

View File

@ -2638,14 +2638,23 @@ This is like `if-let' but doesn't handle a VARLIST of the form
(defmacro when-let* (varlist &rest body)
"Bind variables according to VARLIST and conditionally evaluate BODY.
This is like `when-let' but doesn't handle a VARLIST of the form
\(SYMBOL SOMETHING) specially."
\(SYMBOL SOMETHING) specially.
See also `and-let*'."
(declare (indent 1) (debug if-let*))
(list 'if-let* varlist (macroexp-progn body)))
(defmacro and-let* (varlist &rest body)
"Bind variables according to VARLIST and conditionally evaluate BODY.
Like `when-let*', except if BODY is empty and all the bindings
are non-nil, then the result is the value of the last binding."
are non-nil, then the result is the value of the last binding.
Some Lisp programmers follow the convention that `and' and `and-let*'
are for forms evaluated for return value, and `when' and `when-let*' are
for forms evaluated for side-effect with returned values ignored."
;; ^ Document this convention here because it explains why we have
;; both `when-let*' and `and-let*' (in addition to the additional
;; feature of `and-let*' when BODY is empty).
(declare (indent 1) (debug if-let*))
(let (res)
(if varlist

View File

@ -3911,6 +3911,8 @@ read_stack_reset (intmax_t sp)
#define READ_AND_BUFFER(c) \
c = READCHAR; \
if (c < 0) \
INVALID_SYNTAX_WITH_BUFFER (); \
if (multibyte) \
p += CHAR_STRING (c, (unsigned char *) p); \
else \

View File

@ -6140,7 +6140,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror)
/* The last line was only partially visible, make it fully
visible. */
w->vscroll = (it.last_visible_y
- it.current_y + it.max_ascent + it.max_descent);
- (it.current_y + it.max_ascent + it.max_descent));
adjust_frame_glyphs (it.f);
}
else

View File

@ -170,7 +170,7 @@ WRITE_LOG = > $@ 2>&1 || { STAT=$$?; cat $@; exit $$STAT; }
endif
## On Emba, always show logs for certain problematic tests.
ifdef EMACS_EMBA_CI
lisp/filenotify-tests.log lisp/net/tramp-tests.log src/emacs-module-tests.log \
lisp/filenotify-tests.log lisp/net/tramp-tests.log \
: WRITE_LOG = 2>&1 | tee $@
endif

View File

@ -74,7 +74,13 @@ component ending in \"symlink\" is treated as a symbolic link."
;; Ensure the default expansion splices the glob.
(eshell-command-result-equal "funcall list *.el" '("a.el" "b.el"))
(eshell-command-result-equal "funcall list *.txt" '("c.txt"))
(eshell-command-result-equal "funcall list *.no" '("*.no")))))
;; When spliting, no-matches cases also return a list containing
;; the original non-matching glob.
(eshell-command-result-equal "funcall list *.no" '("*.no"))
(when (eshell-tests-remote-accessible-p)
(let ((remote (file-remote-p ert-remote-temporary-file-directory)))
(eshell-command-result-equal (format "funcall list %s~/a.el" remote)
`(,(format "%s~/a.el" remote))))))))
(ert-deftest em-glob-test/expand/no-splice-results ()
"Test that globs are treated as lists when
@ -85,9 +91,13 @@ component ending in \"symlink\" is treated as a symbolic link."
;; Ensure the default expansion splices the glob.
(eshell-command-result-equal "funcall list *.el" '(("a.el" "b.el")))
(eshell-command-result-equal "funcall list *.txt" '(("c.txt")))
;; The no-matches case is special here: the glob is just the
;; The no-matches cases are special here: the glob is just the
;; string, not the list of results.
(eshell-command-result-equal "funcall list *.no" '("*.no")))))
(eshell-command-result-equal "funcall list *.no" '("*.no"))
(when (eshell-tests-remote-accessible-p)
(let ((remote (file-remote-p ert-remote-temporary-file-directory)))
(eshell-command-result-equal (format "funcall list %s~/a.el" remote)
`(,(format "%s~/a.el" remote))))))))
(ert-deftest em-glob-test/expand/explicitly-splice-results ()
"Test explicitly splicing globs works the same no matter the