procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge from origin/emacs-29

Browse source 
96af584af6 Fix comment-start-skip in tree-sitter modes (bug#59690)
520a4e12f8 ; * lisp/treesit.el (treesit-end-of-defun): Guard against...
2c4d92d30f ; * lisp/subr.el (posn-col-row): Revert inadvertent change.
6fb9a03cbd ; Remove debugging leftover message
c5ba47c889 Speed up Unicode normalisation tests by a factor of 5
afa4fcb95b Fix "C-h k" when clicking on another frame
f6e2f30f39 ; Fix typos
bd58dcedfb Fix and expand tests broken by commit 2772ebe366 of 2022-...
a0dd9fdebe ; Add cross-reference to string-equal docstring
11c3c54d8a Fix handling of relative directories in "--init-directory...
401f76cc3d Make sure 'user-emacs-directory' ends in a slash
This commit is contained in:
Stefan Kangas 2022-12-04 06:31:24 +01:00
commit be67cc276a
23 changed files with 129 additions and 92 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
lisp/cedet/semantic/bovine/c.el
View file

@ -1578,7 +1578,7 @@ Optional PARENT and COLOR as specified with
c-mode (token &optional parent color)
"Return an UML string describing TOKEN for C and C++.
Optional PARENT and COLOR as specified with
`semantic-abbreviate-tag-default'."
`semantic-format-tag-abbreviate-default'."
;; If we have special template things, append.
(concat (semantic-format-tag-uml-prototype-default token parent color)
(semantic-c-template-string token parent color)))

2
lisp/cedet/semantic/db.el
View file

@ -351,7 +351,7 @@ Note: This index will not be saved in a persistent file.")
;; the tables without using the accessor.
:accessor semanticdb-get-database-tables
:protection :protected
:documentation "List of `semantic-db-table' objects."))
:documentation "List of `semanticdb-table' objects."))
"Database of file tables.")
(cl-defmethod semanticdb-full-filename ((obj semanticdb-table))

2
lisp/cedet/semantic/format.el
View file

@ -123,7 +123,7 @@ See that variable for details on adding new types."
(defun semantic--format-colorize-merge-text (precoloredtext face-class)
"Apply onto PRECOLOREDTEXT a color associated with FACE-CLASS.
FACE-CLASS is a tag type found in `semantic-formatface-alist'.
FACE-CLASS is a tag type found in `semantic-format-face-alist'.
See that variable for details on adding new types."
(let ((face (cdr-safe (assoc face-class semantic-format-face-alist)))
(newtext (concat precoloredtext)))

2
lisp/cedet/semantic/ia.el
View file

@ -457,7 +457,7 @@ parts of the parent classes are displayed."
;; it. The simple `semanticdb-find-tag-by-...' are simple, and
;; you need to pass it the exact name you want.
;;
;; The analyzer function `semantic-analyze-tag-name' will take
;; The analyzer function `semantic-analyze-find-tag' will take
;; more complex names, such as the cpp symbol foo::bar::baz,
;; and break it up, and dive through the namespaces.
(let ((class (semantic-analyze-find-tag typename)))

2
lisp/cedet/semantic/idle.el
View file

@ -347,7 +347,7 @@ Returns t if all processing succeeded."
"Core handler for idle work processing of long running tasks.
Visits Semantic controlled buffers, and makes sure all needed
include files have been parsed, and that the typecache is up to date.
Uses `semantic-idle-work-for-on-buffer' to do the work."
Uses `semantic-idle-work-for-one-buffer' to do the work."
(let*
((errbuf nil)
(interrupted

2
lisp/cedet/semantic/lex-spp.el
View file

@ -1256,7 +1256,7 @@ DOC is the documentation for the analyzer.
REGEXP is a regular expression for the analyzer to match.
See `define-lex-regex-analyzer' for more on regexp.
TOKIDX is an index into REGEXP for which a new lexical token
of type `spp-macro-include' is to be created.
of type `spp-system-include' is to be created.
VALFORM are forms that return the name of the thing being included, and the
type of include. The return value should be of the form:
(NAME . TYPE)

6
lisp/cedet/semantic/lex.el
View file

@ -1436,9 +1436,9 @@ Return either a paren token or a semantic list token depending on
(define-lex semantic-comment-lexer
"A simple lexical analyzer that handles comments.
This lexer will only return comment tokens. It is the default lexer
used by `semantic-find-doc-snarf-comment' to snarf up the comment at
point."
This lexer will only return comment tokens. It is the default
lexer used by `semantic-doc-snarf-comment-for-tag' to snarf up
the comment at point."
semantic-lex-ignore-whitespace
semantic-lex-ignore-newline
semantic-lex-comments

2
lisp/cedet/semantic/sort.el
View file

@ -474,7 +474,7 @@ The default behavior, if not overridden with
the name of TAG.
If this function is overridden, use
`semantic-tag-external-member-children-p-default' to also
`semantic-tag-external-member-children-default' to also
include the default behavior, and merely extend your own."
)

3
lisp/cedet/semantic/symref.el
View file

@ -388,7 +388,8 @@ Each element is a cons cell of the form (LINE . FILENAME).")
:type list
:documentation
"The list of tags with hits in them.
Use the `semantic-symref-hit-tags' method to get this list.")
Use the `semantic-symref-hit-to-tag-via-buffer' method to get
this list.")
)
"The results from a symbol reference search.")

1
lisp/emacs-lisp/comp.el
View file

@ -4115,7 +4115,6 @@ the deferred compilation mechanism."
comp-ctxt
(comp-ctxt-output comp-ctxt)
(file-exists-p (comp-ctxt-output comp-ctxt)))
(message "Deleting %s" (comp-ctxt-output comp-ctxt))
(delete-file (comp-ctxt-output comp-ctxt))))))))
(defun native-compile-async-skip-p (file load selector)

6
lisp/help.el
View file

@ -861,11 +861,13 @@ in the selected window."
(mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers)
(memq 'drag modifiers))
" at that spot" ""))
(click-pos (event-end event))
;; Use `posn-set-point' to handle the case when a menu item
;; is selected from the context menu that should describe KEY
;; at the position of mouse click that opened the context menu.
;; When no mouse was involved, don't use `posn-set-point'.
(defn (if buffer
;; When no mouse was involved, or the event doesn't provide a
;; valid position, don't use `posn-set-point'.
(defn (if (or buffer (not (consp click-pos)))
(key-binding key t)
(save-excursion (posn-set-point (event-end event))
(key-binding key t)))))

6
lisp/progmodes/c-ts-mode.el
View file

@ -566,7 +566,8 @@ the subtrees."
;; Comments.
(setq-local comment-start "/* ")
(setq-local comment-end " */")
(setq-local comment-start-skip (rx (group "/" (or (+ "/") (+ "*")))
(setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
(seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))
@ -596,7 +597,8 @@ the subtrees."
;; Comments.
(setq-local comment-start "// ")
(setq-local comment-end "")
(setq-local comment-start-skip (rx (group "/" (or (+ "/") (+ "*")))
(setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
(seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))

3
lisp/progmodes/csharp-mode.el
View file

@ -900,7 +900,8 @@ Key bindings:
;; Comments.
(setq-local comment-start "// ")
(setq-local comment-end "")
(setq-local comment-start-skip (rx (group "/" (or (+ "/") (+ "*")))
(setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
(seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))

3
lisp/progmodes/java-ts-mode.el
View file

@ -301,7 +301,8 @@ the subtrees."
;; Comments.
(setq-local comment-start "// ")
(setq-local comment-end "")
(setq-local comment-start-skip (rx (group "/" (or (+ "/") (+ "*")))
(setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
(seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))

3
lisp/progmodes/js.el
View file

@ -3849,7 +3849,8 @@ Currently there are `js-mode' and `js-ts-mode'."
;; Comment.
(setq-local comment-start "// ")
(setq-local comment-end "")
(setq-local comment-start-skip (rx (group "/" (or (+ "/") (+ "*")))
(setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
(seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))

4
lisp/progmodes/typescript-ts-mode.el
View file

@ -362,7 +362,9 @@ Argument LANGUAGE is either `typescript' or `tsx'."
;; Comments.
(setq-local comment-start "// ")
(setq-local comment-end "")
(setq-local comment-start-skip "\\(?://+\\|/\\*+\\)\\s *")
(setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
(seq "/" (+ "*")))
(* (syntax whitespace))))
(setq-local comment-end-skip
(rx (* (syntax whitespace))
(group (or (syntax comment-end)

2
lisp/speedbar.el
View file

@ -349,7 +349,7 @@ determined automatically."
(defcustom speedbar-sort-tags nil
"If non-nil, sort tags in the speedbar display. *Obsolete*.
Use `semantic-tag-hierarchy-method' instead."
Use `speedbar-tag-hierarchy-method' instead."
:group 'speedbar
:type 'boolean)

6
lisp/startup.el
View file

@ -1259,6 +1259,12 @@ please check its value")
(setq init-file-user nil))
((member argi '("-init-directory"))
(setq user-emacs-directory (or argval (pop args))
user-emacs-directory (if (stringp user-emacs-directory)
(file-name-as-directory
(expand-file-name
user-emacs-directory
command-line-default-directory))
user-emacs-directory)
argval nil))
((member argi '("-u" "-user"))
(setq init-file-user (or argval (pop args))

4
lisp/subr.el
View file

@ -5437,7 +5437,9 @@ and replace a sub-expression, e.g.
(defsubst string-equal-ignore-case (string1 string2)
"Compare STRING1 and STRING2 case-insensitively.
Upper-case and lower-case letters are treated as equal.
Unibyte strings are converted to multibyte for comparison."
Unibyte strings are converted to multibyte for comparison.
See also `string-equal'."
(declare (pure t) (side-effect-free t))
(eq t (compare-strings string1 0 nil string2 0 nil t)))

7
lisp/treesit.el
View file

@ -1614,7 +1614,12 @@ ARG is the same as in `beginning-of-defun'."
(let* ((node (treesit-search-forward
(treesit-node-at (point)) treesit-defun-type-regexp t t))
(top (treesit--defun-maybe-top-level node)))
(goto-char (treesit-node-end top))))
;; Technically `end-of-defun' should only call this function when
;; point is at the beginning of a defun, so TOP should always be
;; non-nil, but things happen, and we want to be safe, so check
;; for TOP anyway.
(when top
(goto-char (treesit-node-end top)))))
;;; Activating tree-sitter

4
src/fns.c
View file

@ -334,7 +334,9 @@ Letter-case is significant, but text properties are ignored. */)
DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
doc: /* Return t if two strings have identical contents.
Case is significant, but text properties are ignored.
Symbols are also allowed; their print names are used instead. */)
Symbols are also allowed; their print names are used instead.
See also `string-equal-ignore-case'. */)
(register Lisp_Object s1, Lisp_Object s2)
{
if (SYMBOLP (s1))

55
test/lisp/emacs-lisp/comp-tests.el
View file

@ -31,25 +31,30 @@
(defmacro with-test-native-compile-prune-cache (&rest body)
(declare (indent 0) (debug t))
`(ert-with-temp-directory testdir
(setq testdir (expand-file-name "eln-cache" testdir))
(make-directory testdir)
(let* ((c1 (expand-file-name "29.0.50-cur" testdir))
(c2 (expand-file-name "29.0.50-old" testdir))
(native-comp-eln-load-path (list testdir))
(comp-native-version-dir "29.0.50-cur"))
(dolist (d (list c1 c2))
(make-directory d)
(with-temp-file (expand-file-name "some.eln" d) (insert "foo"))
(with-temp-file (expand-file-name "some.eln.tmp" d) (insert "foo")))
,@body)))
(let ((usr-cache (expand-file-name "eln-usr-cache" testdir))
(sys-cache (expand-file-name "eln-sys-cache" testdir)))
(make-directory usr-cache)
(make-directory sys-cache)
(let* ((c1 (expand-file-name "29.0.50-cur" usr-cache))
(c2 (expand-file-name "29.0.50-old" usr-cache))
(s1 (expand-file-name "29.0.50-cur" sys-cache))
(s2 (expand-file-name "preloaded" s1))
(native-comp-eln-load-path (list usr-cache sys-cache))
(comp-native-version-dir "29.0.50-cur"))
(dolist (d (list c1 c2 s1 s2))
(make-directory d)
(with-temp-file (expand-file-name "some.eln" d) (insert "foo"))
(with-temp-file (expand-file-name "some.eln.tmp" d) (insert "foo")))
,@body))))
(ert-deftest test-native-compile-prune-cache ()
(skip-unless (featurep 'native-compile))
(with-test-native-compile-prune-cache
(native-compile-prune-cache)
(should (file-directory-p c1))
(should (file-regular-p (expand-file-name "some.eln" c1)))
(should (file-regular-p (expand-file-name "some.eln.tmp" c1)))
(dolist (d (list c1 s1 s2))
(should (file-directory-p d))
(should (file-regular-p (expand-file-name "some.eln" d)))
(should (file-regular-p (expand-file-name "some.eln.tmp" d))))
(should-not (file-directory-p c2))
(should-not (file-regular-p (expand-file-name "some.eln" c2)))
(should-not (file-regular-p (expand-file-name "some.eln.tmp" c2)))))
@ -57,21 +62,23 @@
(ert-deftest test-native-compile-prune-cache/delete-only-eln ()
(skip-unless (featurep 'native-compile))
(with-test-native-compile-prune-cache
(with-temp-file (expand-file-name "keep1.txt" c1) (insert "foo"))
(with-temp-file (expand-file-name "keep2.txt" c2) (insert "foo"))
(dolist (d (list c1 c2 s1 s2))
(with-temp-file (expand-file-name "keep.txt" d) (insert "foo")))
(native-compile-prune-cache)
(should (file-regular-p (expand-file-name "keep1.txt" c1)))
(should (file-regular-p (expand-file-name "keep2.txt" c2)))))
(dolist (d (list c1 c2 s1 s2))
(should (file-regular-p (expand-file-name "keep.txt" d))))))
(ert-deftest test-native-compile-prune-cache/dont-delete-in-parent-of-cache ()
(skip-unless (featurep 'native-compile))
(with-test-native-compile-prune-cache
(let ((f1 (expand-file-name "../some.eln" testdir))
(f2 (expand-file-name "some.eln" testdir)))
(with-temp-file f1 (insert "foo"))
(with-temp-file f2 (insert "foo"))
(let ((f1 (expand-file-name "../some.eln" usr-cache))
(f2 (expand-file-name "some.eln" usr-cache))
(f3 (expand-file-name "../some.eln" sys-cache))
(f4 (expand-file-name "some.eln" sys-cache)))
(dolist (f (list f1 f2 f3 f4))
(with-temp-file f (insert "foo")))
(native-compile-prune-cache)
(should (file-regular-p f1))
(should (file-regular-p f2)))))
(dolist (f (list f1 f2 f3 f4))
(should (file-regular-p f))))))
;;; comp-tests.el ends here

94
test/lisp/international/ucs-normalize-tests.el
View file

@ -59,7 +59,7 @@ And NORM is one of the symbols `NFC', `NFD', `NFKC', `NFKD' for brevity."
(NFD . ucs-normalize-NFD-region)
(NFKC . ucs-normalize-NFKC-region)
(NFKD . ucs-normalize-NFKD-region))))
`(with-current-buffer ucs-normalize-tests--norm-buf
`(progn
(erase-buffer)
(insert ,str)
(,(cdr (assq norm norm-alist)) (point-min) (point-max))
@ -74,7 +74,7 @@ And NORM is one of the symbols `NFC', `NFD', `NFKC', `NFKD' for brevity."
(NFD . ucs-normalize-NFD-region)
(NFKC . ucs-normalize-NFKC-region)
(NFKD . ucs-normalize-NFKD-region))))
`(with-current-buffer ucs-normalize-tests--norm-buf
`(progn
(erase-buffer)
(insert ,char)
(,(cdr (assq norm norm-alist)) (point-min) (point-max))
@ -90,36 +90,37 @@ The following invariants must be true for all conformant implementations..."
;; See `ucs-normalize-tests--rule2-holds-p'.
(aset ucs-normalize-tests--chars-part1
(aref source 0) 1))
(and
;; c2 == toNFC(c1) == toNFC(c2) == toNFC(c3)
(ucs-normalize-tests--normalization-equal-p NFC source nfc)
(ucs-normalize-tests--normalization-equal-p NFC nfc nfc)
(ucs-normalize-tests--normalization-equal-p NFC nfd nfc)
;; c4 == toNFC(c4) == toNFC(c5)
(ucs-normalize-tests--normalization-equal-p NFC nfkc nfkc)
(ucs-normalize-tests--normalization-equal-p NFC nfkd nfkc)
(with-current-buffer ucs-normalize-tests--norm-buf
(and
;; c2 == toNFC(c1) == toNFC(c2) == toNFC(c3)
(ucs-normalize-tests--normalization-equal-p NFC source nfc)
(ucs-normalize-tests--normalization-equal-p NFC nfc nfc)
(ucs-normalize-tests--normalization-equal-p NFC nfd nfc)
;; c4 == toNFC(c4) == toNFC(c5)
(ucs-normalize-tests--normalization-equal-p NFC nfkc nfkc)
(ucs-normalize-tests--normalization-equal-p NFC nfkd nfkc)
;; c3 == toNFD(c1) == toNFD(c2) == toNFD(c3)
(ucs-normalize-tests--normalization-equal-p NFD source nfd)
(ucs-normalize-tests--normalization-equal-p NFD nfc nfd)
(ucs-normalize-tests--normalization-equal-p NFD nfd nfd)
;; c5 == toNFD(c4) == toNFD(c5)
(ucs-normalize-tests--normalization-equal-p NFD nfkc nfkd)
(ucs-normalize-tests--normalization-equal-p NFD nfkd nfkd)
;; c3 == toNFD(c1) == toNFD(c2) == toNFD(c3)
(ucs-normalize-tests--normalization-equal-p NFD source nfd)
(ucs-normalize-tests--normalization-equal-p NFD nfc nfd)
(ucs-normalize-tests--normalization-equal-p NFD nfd nfd)
;; c5 == toNFD(c4) == toNFD(c5)
(ucs-normalize-tests--normalization-equal-p NFD nfkc nfkd)
(ucs-normalize-tests--normalization-equal-p NFD nfkd nfkd)
;; c4 == toNFKC(c1) == toNFKC(c2) == toNFKC(c3) == toNFKC(c4) == toNFKC(c5)
(ucs-normalize-tests--normalization-equal-p NFKC source nfkc)
(ucs-normalize-tests--normalization-equal-p NFKC nfc nfkc)
(ucs-normalize-tests--normalization-equal-p NFKC nfd nfkc)
(ucs-normalize-tests--normalization-equal-p NFKC nfkc nfkc)
(ucs-normalize-tests--normalization-equal-p NFKC nfkd nfkc)
;; c4 == toNFKC(c1) == toNFKC(c2) == toNFKC(c3) == toNFKC(c4) == toNFKC(c5)
(ucs-normalize-tests--normalization-equal-p NFKC source nfkc)
(ucs-normalize-tests--normalization-equal-p NFKC nfc nfkc)
(ucs-normalize-tests--normalization-equal-p NFKC nfd nfkc)
(ucs-normalize-tests--normalization-equal-p NFKC nfkc nfkc)
(ucs-normalize-tests--normalization-equal-p NFKC nfkd nfkc)
;; c5 == toNFKD(c1) == toNFKD(c2) == toNFKD(c3) == toNFKD(c4) == toNFKD(c5)
(ucs-normalize-tests--normalization-equal-p NFKD source nfkd)
(ucs-normalize-tests--normalization-equal-p NFKD nfc nfkd)
(ucs-normalize-tests--normalization-equal-p NFKD nfd nfkd)
(ucs-normalize-tests--normalization-equal-p NFKD nfkc nfkd)
(ucs-normalize-tests--normalization-equal-p NFKD nfkd nfkd)))
;; c5 == toNFKD(c1) == toNFKD(c2) == toNFKD(c3) == toNFKD(c4) == toNFKD(c5)
(ucs-normalize-tests--normalization-equal-p NFKD source nfkd)
(ucs-normalize-tests--normalization-equal-p NFKD nfc nfkd)
(ucs-normalize-tests--normalization-equal-p NFKD nfd nfkd)
(ucs-normalize-tests--normalization-equal-p NFKD nfkc nfkd)
(ucs-normalize-tests--normalization-equal-p NFKD nfkd nfkd))))
(defsubst ucs-normalize-tests--rule2-holds-p (X)
"Check 2nd conformance rule.
@ -127,7 +128,9 @@ For every code point X assigned in this version of Unicode that
is not specifically listed in Part 1, the following invariants
must be true for all conformant implementations:
X == toNFC(X) == toNFD(X) == toNFKC(X) == toNFKD(X)"
X == toNFC(X) == toNFD(X) == toNFKC(X) == toNFKD(X)
Must be called with `ucs-normalize-tests--norm-buf' as current buffer."
(and (ucs-normalize-tests--normalization-chareq-p NFC X X)
(ucs-normalize-tests--normalization-chareq-p NFD X X)
(ucs-normalize-tests--normalization-chareq-p NFKC X X)
@ -230,20 +233,23 @@ must be true for all conformant implementations:
(defun ucs-normalize-tests--part1-rule2 (chars-part1)
(let ((reporter (make-progress-reporter "UCS Normalize Test Part1, rule 2"
0 (max-char)))
(failed-chars nil))
(map-char-table
(lambda (char-range listed-in-part)
(unless (eq listed-in-part 1)
(if (characterp char-range)
(progn (unless (ucs-normalize-tests--rule2-holds-p char-range)
(push char-range failed-chars))
(progress-reporter-update reporter char-range))
(cl-loop for char from (car char-range) to (cdr char-range)
unless (ucs-normalize-tests--rule2-holds-p char)
do (push char failed-chars)
do (progress-reporter-update reporter char)))))
chars-part1)
0 (max-char t)))
(failed-chars nil)
(unicode-max (max-char t)))
(with-current-buffer ucs-normalize-tests--norm-buf
(map-char-table
(lambda (char-range listed-in-part)
(unless (eq listed-in-part 1)
(if (characterp char-range)
(progn (unless (ucs-normalize-tests--rule2-holds-p char-range)
(push char-range failed-chars))
(progress-reporter-update reporter char-range))
(cl-loop for char from (car char-range) to (min (cdr char-range)
unicode-max)
unless (ucs-normalize-tests--rule2-holds-p char)
do (push char failed-chars)
do (progress-reporter-update reporter char)))))
chars-part1))
(progress-reporter-done reporter)
failed-chars))