[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 95f89c736fd 1/3: Merge from origin/emacs-30
|
From: |
Sean Whitton |
|
Subject: |
master 95f89c736fd 1/3: Merge from origin/emacs-30 |
|
Date: |
Thu, 24 Oct 2024 00:14:46 -0400 (EDT) |
branch: master
commit 95f89c736fd80f27e586127009880f89a77adb3b
Merge: 3bb1b85b78b f5451b6a066
Author: Sean Whitton <spwhitton@spwhitton.name>
Commit: Sean Whitton <spwhitton@spwhitton.name>
Merge from origin/emacs-30
f5451b6a066 ; Improve comment from last change
09e05f7ee4d Document and-let* vs. when-let* usage convention
b7a375f5c49 Fix error when splicing Eshell globs and a glob expands t...
2289e162268 * etc/package-keyring.gpg: Update expiration and add new key
48024096fea Avoid crashes when scrolling images under winner-mode
c35d6ba9f07 ; * doc/lispref/display.texi (Fontsets): Clarify wording.
88a1a32fc57 ; * doc/lispref/display.texi (Fontsets): Fix typo.
6be47058cd7 ; Add indexing for 'use-default-font-for-symbols'
681f70ea04a * src/lread.c (READ_AND_BUFFER): Reject negative chars (b...
ac4151e0023 * test/Makefile.in: Do not show emacs-module-tests.log by...
4e0cb960dbd Fix 'php-ts-mode': better indentation and font locking
---
doc/emacs/mule.texi | 1 +
doc/lispref/display.texi | 4 +-
etc/package-keyring.gpg | Bin 2043 -> 2343 bytes
lisp/eshell/em-glob.el | 2 +-
lisp/progmodes/php-ts-mode.el | 170 +++++++++++++++++++++++++-------------
lisp/subr.el | 13 ++-
src/lread.c | 2 +
src/window.c | 2 +-
test/Makefile.in | 2 +-
test/lisp/eshell/em-glob-tests.el | 16 +++-
10 files changed, 146 insertions(+), 66 deletions(-)
diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi
index 8b16c661a7e..84edc0d086a 100644
--- a/doc/emacs/mule.texi
+++ b/doc/emacs/mule.texi
@@ -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.
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index d5de08a5c6e..91f6f3b0d97 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -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
diff --git a/etc/package-keyring.gpg b/etc/package-keyring.gpg
index 563acbb16b6..f88d60b2457 100644
Binary files a/etc/package-keyring.gpg and b/etc/package-keyring.gpg differ
diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el
index b95204c7e1e..42373b8b8c0 100644
--- a/lisp/eshell/em-glob.el
+++ b/lisp/eshell/em-glob.el
@@ -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
diff --git a/lisp/progmodes/php-ts-mode.el b/lisp/progmodes/php-ts-mode.el
index 2a8f3455402..6e6d421110c 100644
--- a/lisp/progmodes/php-ts-mode.el
+++ b/lisp/progmodes/php-ts-mode.el
@@ -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)))))
-
-(defun php-ts-mode--parent-html-heuristic (node parent _bol &rest _)
+ (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 _)
"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))
diff --git a/lisp/subr.el b/lisp/subr.el
index 4771ac1fba2..9113235ca5d 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -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
diff --git a/src/lread.c b/src/lread.c
index 95c6891c205..ea0398196e3 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -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 \
diff --git a/src/window.c b/src/window.c
index 34968ac824f..7f157911685 100644
--- a/src/window.c
+++ b/src/window.c
@@ -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
diff --git a/test/Makefile.in b/test/Makefile.in
index 3cbdbec4414..7a3178546a1 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -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
diff --git a/test/lisp/eshell/em-glob-tests.el
b/test/lisp/eshell/em-glob-tests.el
index 2efb3a9df69..88e9cc73bbd 100644
--- a/test/lisp/eshell/em-glob-tests.el
+++ b/test/lisp/eshell/em-glob-tests.el
@@ -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