Merge from origin/emacs-30

f910514721 Fix treesit range rule for jsdoc
de3fa00a61 Fix documentation of 'balance-windows'
c986387c79 nnatom: Ensure some parsed values are one line
2fb6a98ecf nnfeed: (Mostly) fix group descriptions
74b82e6802 Eglot: support deprecated MarkedString (bug#71353)
a6a588ccf1 ; * doc/lispref/strings.texi (Creating Strings): Followup...
a3e57a29be ; Fix doc string of 'string-fill'
1b5cf29431 Fix returning to original TTY frame after 'rmail-reply'
814710067f Improve warnings from native compiler
cefec59df7 Document adding package dependency on Emacs version
d190cb0e88 Fix file-name detection in Dired under -F
This commit is contained in:
Eli Zaretskii 2024-07-06 07:42:51 -04:00
commit 38ce85c547
15 changed files with 122 additions and 83 deletions

View file

@ -300,7 +300,8 @@ Make selected window narrower (@code{shrink-window-horizontally}).
Shrink this window if its buffer doesn't need so many lines
(@code{shrink-window-if-larger-than-buffer}).
@item C-x +
Make all windows the same height (@code{balance-windows}).
Balance the sizes of all the windows of the selected frame
(@code{balance-windows}).
@end table
@kindex C-x 0
@ -373,8 +374,11 @@ lines to other windows in the frame.
@kindex C-x +
@findex balance-windows
You can also use @kbd{C-x +} (@code{balance-windows}) to even out the
heights of all the windows in the selected frame.
You can also use @kbd{C-x +} (@code{balance-windows}) to balance the
sizes of all the windows of the selected frame (with the exception of
the minibuffer window, @pxref{Minibuffer}). This command makes each
horizontal pair of adjacent windows the same height, and each vertical
pair of adjacent windows the same width.
@node Displaying Buffers
@section Displaying a Buffer in a Window

View file

@ -192,10 +192,11 @@ used as the long description. (When displaying the description, Emacs
omits the @samp{;;; Commentary:} line, as well as the leading comment
characters in the commentary itself.)
If the file has a @samp{Package-Requires} header, that is used as
the package dependencies. In the above example, the package depends
on the @samp{flange} package, version 1.0 or higher. @xref{Library
Headers}, for a description of the @samp{Package-Requires} header. If
If the file has a @samp{Package-Requires} header, that is used as the
package dependencies. In the above example, the package depends on the
@samp{flange} package, version 1.0 or higher. @xref{Library Headers},
for a description of the @samp{Package-Requires} header. To depend on a
specific version of Emacs, specify @samp{emacs} as the package name. If
the header is omitted, the package has no dependencies.
The @samp{Keywords} and @samp{URL} headers are optional, but recommended.
@ -247,9 +248,10 @@ is the brief description.
@var{requirements} is a list of required packages and their versions.
Each element in this list should have the form @code{(@var{dep-name}
@var{dep-version})}, where @var{dep-name} is a symbol whose name is
the dependency's package name, and @var{dep-version} is the
dependency's version (a string).
@var{dep-version})}, where @var{dep-name} is a symbol whose name is the
dependency's package name, and @var{dep-version} is the dependency's
version (a string). The spacial value @samp{emacs} means that the
package depends on the given version of Emacs.
@end defun
If the content directory contains a file named @file{README}, this

View file

@ -406,11 +406,12 @@ that matches @var{trim-right} from @var{string}. Both regexps
default to @samp{[ \t\n\r]+}.
@end defun
@defun string-fill string length
Attempt to Word-wrap @var{string} so that no lines are longer than
@var{length}. Filling is done on whitespace boundaries only. If
there are individual words that are longer than @var{length}, these
will not be shortened.
@defun string-fill string width
Attempt to Word-wrap @var{string} so that it displays with lines no
wider than @var{width}. Filling is done on whitespace boundaries only.
If there are individual words that are longer than @var{width}, these
will not be shortened, and therefore @var{string} might be shown with
lines wider than @var{width} in that case.
@end defun
@defun string-limit string length &optional end coding-system

View file

@ -195,7 +195,7 @@ processes from `comp-async-compilations'"
(if native-comp-async-report-warnings-errors
(let ((warning-suppress-types
(if (eq native-comp-async-report-warnings-errors 'silent)
(cons '(comp) warning-suppress-types)
(cons '(native-compiler) warning-suppress-types)
warning-suppress-types))
(regexp (if (eq native-comp-async-warnings-errors-kind 'all)
"^.*?\\(?:Error\\|Warning\\): .*$"
@ -211,7 +211,7 @@ processes from `comp-async-compilations'"
(accept-process-output process)
(goto-char (or comp-last-scanned-async-output (point-min)))
(while (re-search-forward regexp nil t)
(display-warning 'comp (match-string 0)))
(display-warning 'native-compiler (match-string 0)))
(setq comp-last-scanned-async-output (point-max)))))
(accept-process-output process)))
@ -446,7 +446,7 @@ bytecode definition was not changed in the meantime)."
(setf comp-files-queue
(append comp-files-queue `((,file . ,load)))
added-something t)
(display-warning 'comp
(display-warning 'native-compiler
(format "No write access for %s skipping."
out-filename)))))))
;; Perhaps nothing passed `native--compile-async-skip-p'?

View file

@ -2792,7 +2792,7 @@ Return t if something was changed."
finally
(when (= i 100)
(display-warning
'comp
'native-compiler
(format "fwprop pass jammed into %s?" (comp-func-name f))))
(comp-log (format "Propagation run %d times\n" i) 2))
(comp--rewrite-non-locals)

View file

@ -159,16 +159,16 @@ removed."
blank blank)))
;;;###autoload
(defun string-fill (string length)
"Try to word-wrap STRING so that no lines are longer than LENGTH.
Wrapping is done where there is whitespace. If there are
individual words in STRING that are longer than LENGTH, the
result will have lines that are longer than LENGTH."
(defun string-fill (string width)
"Try to word-wrap STRING so that it displays with lines no wider than WIDTH.
STRING is wrapped where there is whitespace in it. If there are
individual words in STRING that are wider than WIDTH, the result
will have lines that are wider than WIDTH."
(declare (important-return-value t))
(with-temp-buffer
(insert string)
(goto-char (point-min))
(let ((fill-column length)
(let ((fill-column width)
(adaptive-fill-mode nil))
(fill-region (point-min) (point-max)))
(buffer-string)))

View file

@ -8087,8 +8087,8 @@ Valid wildcards are `*', `?', `[abc]' and `[a-z]'."
(end (insert-directory-adj-pos
(+ beg (read (current-buffer)))
error-lines)))
(if (memq (char-after end) '(?\n ?\s))
;; End is followed by \n or by " -> ".
(if (memq (char-after end) '(?\n ?\s ?/ ?* ?@ ?% ?= ?|))
;; End is followed by \n or by output of -F.
(put-text-property start end 'dired-filename t)
;; It seems that we can't trust ls's output as to
;; byte positions of filenames.

View file

@ -108,15 +108,19 @@
(defvoo nnatom-read-article-function #'nnatom--read-article
nil nnfeed-read-article-function)
(defun nnatom--dom-line (node)
"Return NODE's text as a single, whitespace-trimmed line."
(string-trim (replace-regexp-in-string "[\r\n]+" " " (dom-text node) t)))
(defun nnatom--read-title (group)
"Return the title of GROUP, or nil."
(dom-text (dom-child-by-tag group 'title)))
(nnatom--dom-line (dom-child-by-tag group 'title)))
(defvoo nnatom-read-title-function #'nnatom--read-title
nil nnfeed-read-title-function)
(defun nnatom--read-description (group)
"Return the description of GROUP, or nil."
(dom-text (dom-child-by-tag group 'subtitle)))
(nnatom--dom-line (dom-child-by-tag group 'subtitle)))
(defvoo nnatom-read-description-function #'nnatom--read-description
nil nnfeed-read-description-function)
@ -125,9 +129,9 @@
(when-let
((a (mapconcat
(lambda (author)
(let* ((name (dom-text (dom-child-by-tag author 'name)))
(let* ((name (nnatom--dom-line (dom-child-by-tag author 'name)))
(name (unless (string-blank-p name) name))
(email (dom-text (dom-child-by-tag author 'email)))
(email (nnatom--dom-line (dom-child-by-tag author 'email)))
(email (unless (string-blank-p email) email)))
(or (and name email (format "%s <%s>" name email)) name email)))
(dom-children (dom-child-by-tag article-or-group 'authors))
@ -142,7 +146,7 @@
(defun nnatom--read-subject (article)
"Return the subject of ARTICLE, or nil."
(dom-text (dom-child-by-tag article 'title)))
(nnatom--dom-line (dom-child-by-tag article 'title)))
(defvoo nnatom-read-subject-function #'nnatom--read-subject
nil nnfeed-read-subject-function)
@ -150,7 +154,7 @@
"Return the ID of ARTICLE.
If the ARTICLE doesn't contain an ID but it does contain a subject,
return the subject. Otherwise, return nil."
(or (dom-text (dom-child-by-tag article 'id))
(or (nnatom--dom-line (dom-child-by-tag article 'id))
(nnatom--read-subject article)))
(defvoo nnatom-read-id-function #'nnatom--read-id
nil nnfeed-read-id-function)
@ -158,14 +162,14 @@ return the subject. Otherwise, return nil."
(defun nnatom--read-publish (article)
"Return the date and time ARTICLE was published, or nil."
(when-let (d (dom-child-by-tag article 'published))
(date-to-time (dom-text d))))
(date-to-time (nnatom--dom-line d))))
(defvoo nnatom-read-publish-date-function #'nnatom--read-publish
nil nnfeed-read-publish-date-function)
(defun nnatom--read-update (article)
"Return the date and time of the last update to ARTICLE, or nil."
(when-let (d (dom-child-by-tag article 'updated))
(date-to-time (dom-text d))))
(date-to-time (nnatom--dom-line d))))
(defvoo nnatom-read-update-date-function #'nnatom--read-update
nil nnfeed-read-update-date-function)
@ -185,13 +189,13 @@ return the subject. Otherwise, return nil."
(("text/html") . ,(format "<a href=\"%s\">[%s]</a> "
src label)))))
(when-let (((or (eq l 'author) (eq l 'contributor)))
(name (dom-text (dom-child-by-tag link 'name)))
(name (nnatom--dom-line (dom-child-by-tag link 'name)))
(name (if (string-blank-p name)
(concat "Author"
(and (< 1 (cl-incf aut))
(format " %s" aut)))
name))
(uri (dom-text (dom-child-by-tag link 'uri)))
(uri (nnatom--dom-line (dom-child-by-tag link 'uri)))
((not (string-blank-p uri))))
`(((("text/plain") . ,(format "%s: %s\n" name uri))
(("text/html") . ,(format "<a href=\"%s\">[%s]</a> "

View file

@ -630,12 +630,21 @@ Only HEADERS of a type included in MIME are considered."
(deffoo nnfeed-request-type (_group &optional _article)
'unknown)
;; FIXME: Works incorrectly when a group name contains spaces as Gnus actually
;; separates the group name from the description with either a tab or a space.
(defun nnfeed--group-description (name group)
"Return a description line for a GROUP called NAME."
(when-let ((desc (aref group 5))
((not (string-blank-p desc))))
(insert name "\t" desc "\n")))
(deffoo nnfeed-request-group-description (group &optional server)
(when-let ((server (or server (nnfeed--current-server-no-prefix)))
(g (nnfeed--group-data group server)))
(with-current-buffer nntp-server-buffer
(erase-buffer)
(insert group " " (aref g 5) "\n"))))
(nnfeed--group-description group g)
t)))
(deffoo nnfeed-request-list-newsgroups (&optional server)
(when-let ((server (or server (nnfeed--current-server-no-prefix)))
@ -643,9 +652,8 @@ Only HEADERS of a type included in MIME are considered."
((hash-table-p s)))
(with-current-buffer nntp-server-buffer
(erase-buffer)
(maphash (lambda (group g)
(insert group " " (aref g 5) "\n"))
s))))
(maphash #'nnfeed--group-description s)
t)))
(deffoo nnfeed-request-rename-group (group new-name &optional server)
(when-let ((server (or server (nnfeed--current-server-no-prefix)))

View file

@ -3686,7 +3686,12 @@ If BUFFER is not swapped, yank out of its message viewer buffer."
other-headers)
(let ((switch-function
(cond (same-window nil)
(rmail-mail-new-frame 'switch-to-buffer-other-frame)
(rmail-mail-new-frame
(progn
;; Record the frame from which we invoked this command.
(modify-frame-parameters (selected-frame)
'((rmail-orig-frame . t)))
'switch-to-buffer-other-frame))
(t 'switch-to-buffer-other-window)))
yank-action)
(if replybuffer
@ -3716,6 +3721,11 @@ If BUFFER is not swapped, yank out of its message viewer buffer."
(modify-frame-parameters (selected-frame)
'((mail-dedicated-frame . t)))))))
(defun rmail--find-orig-rmail-frame ()
(car (filtered-frame-list
(lambda (frame)
(eq (frame-parameter frame 'rmail-orig-frame) t)))))
(defun rmail-mail-return (&optional newbuf)
"Try to return to Rmail from the mail window.
If optional argument NEWBUF is specified, it is the Rmail buffer
@ -3757,9 +3767,19 @@ to switch to."
;; probably wants to delete it now.
((display-multi-frame-p)
(delete-frame))
;; The previous frame is where normally they have the Rmail buffer
;; displayed.
(t (other-frame -1))))
(t
;; Try to find the original Rmail frame and make it the top frame.
(let ((fr (selected-frame))
(orig-fr (rmail--find-orig-rmail-frame)))
(if orig-fr
(progn
(modify-frame-parameters orig-fr '((rmail-orig-frame . nil)))
(select-frame-set-input-focus orig-fr))
;; If we cannot find the frame from which we started, punt, and
;; display the previous frame, which is where they normally have
;; the Rmail buffer displayed.
(other-frame -1))
(delete-frame fr)))))
(defun rmail-mail ()
"Send mail in another window.

View file

@ -1871,15 +1871,25 @@ Doubles as an indicator of snippet support."
(unless (bound-and-true-p yas-minor-mode) (yas-minor-mode 1))
(apply #'yas-expand-snippet args)))))
(defun eglot--format-markup (markup)
"Format MARKUP according to LSP's spec."
(pcase-let ((`(,string ,mode)
(if (stringp markup) (list markup 'gfm-view-mode)
(list (plist-get markup :value)
(pcase (plist-get markup :kind)
("markdown" 'gfm-view-mode)
("plaintext" 'text-mode)
(_ major-mode))))))
(defun eglot--format-markup (markup)
"Format MARKUP according to LSP's spec.
MARKUP is either an LSP MarkedString or MarkupContent object."
(let (string mode language)
(cond ((stringp markup)
(setq string markup
mode 'gfm-view-mode))
((setq language (plist-get markup :language))
;; Deprecated MarkedString
(setq string (concat "```" language "\n"
(plist-get markup :value) "\n```")
mode 'gfm-view-mode))
(t
;; MarkupContent
(setq string (plist-get markup :value)
mode (pcase (plist-get markup :kind)
("markdown" 'gfm-view-mode)
("plaintext" 'text-mode)
(_ major-mode)))))
(with-temp-buffer
(setq-local markdown-fontify-code-blocks-natively t)
(insert string)

View file

@ -3636,10 +3636,16 @@ Check if a node type is available, then return the right indent rules."
:override t
'((escape_sequence) @font-lock-escape-face)
;; "document" should be first, to avoid overlap.
:language 'jsdoc
:override t
:feature 'document
'((document) @font-lock-doc-face)
:language 'jsdoc
:override t
:feature 'keyword
'((tag_name) @font-lock-keyword-face)
'((tag_name) @font-lock-constant-face)
:language 'jsdoc
:override t
@ -3649,17 +3655,12 @@ Check if a node type is available, then return the right indent rules."
:language 'jsdoc
:override t
:feature 'property
'((type) @font-lock-variable-use-face)
'((type) @font-lock-type-face)
:language 'jsdoc
:override t
:feature 'definition
'((identifier) @font-lock-variable-name-face)
:language 'jsdoc
:override t
:feature 'comment
'((description) @font-lock-comment-face))
'((identifier) @font-lock-variable-name-face))
"Tree-sitter font-lock settings.")
(defun js--fontify-template-string (node override start end &rest _)
@ -3933,7 +3934,7 @@ See `treesit-thing-settings' for more information.")
;; Fontification.
(setq-local treesit-font-lock-settings js--treesit-font-lock-settings)
(setq-local treesit-font-lock-feature-list
'(( comment definition)
'(( comment document definition)
( keyword string)
( assignment constant escape-sequence jsx number
pattern string-interpolation)
@ -3944,10 +3945,9 @@ See `treesit-thing-settings' for more information.")
(treesit-range-rules
:embed 'jsdoc
:host 'javascript
:local t
`(((comment) @capture (:match ,js--treesit-jsdoc-beginning-regexp @capture))))))
(setq-local treesit-language-at-point-function #'js-ts-language-at-point)
;; Imenu
(setq-local treesit-simple-imenu-settings
`(("Function" "\\`function_declaration\\'" nil nil)
@ -3989,17 +3989,6 @@ See `treesit-thing-settings' for more information.")
(put-text-property ns (1+ ns) 'syntax-table syntax)
(put-text-property (1- ne) ne 'syntax-table syntax)))))
(defun js-ts-language-at-point (point)
"Return the language at POINT."
(let ((node (treesit-node-at point 'javascript)))
(if (and (treesit-ready-p 'jsdoc)
(equal (treesit-node-type node) "comment")
(string-match-p
js--treesit-jsdoc-beginning-regexp
(treesit-node-text node)))
'jsdoc
'javascript)))
;;;###autoload
(define-derived-mode js-json-mode prog-mode "JSON"
:syntax-table js-mode-syntax-table

View file

@ -5888,12 +5888,13 @@ is non-nil)."
(setq sub (window-right sub))))))))
(defun balance-windows (&optional window-or-frame)
"Balance the sizes of windows of WINDOW-OR-FRAME.
WINDOW-OR-FRAME is optional and defaults to the selected frame.
"Balance the sizes of windows shown on the selected frame.
When called from Lisp, WINDOW-OR-FRAME is optional and defaults to the
selected frame.
If WINDOW-OR-FRAME denotes a frame, balance the sizes of all
windows of that frame. If WINDOW-OR-FRAME denotes a window,
recursively balance the sizes of all child windows of that
window."
windows of that frame's root window (which excludes the mini-window).
If WINDOW-OR-FRAME denotes a window, recursively balance the sizes
of all child windows of that window."
(interactive)
(let* ((window
(cond

View file

@ -5756,7 +5756,7 @@ natively-compiled one. */);
DEFSYM (Qd_ephemeral, "d-ephemeral");
/* Others. */
DEFSYM (Qcomp, "comp");
DEFSYM (Qnative_compiler, "native-compiler");
DEFSYM (Qfixnum, "fixnum");
DEFSYM (Qscratch, "scratch");
DEFSYM (Qlate, "late");

View file

@ -1883,7 +1883,7 @@ maybe_swap_for_eln (bool no_native, Lisp_Object *filename, int *fd,
return;
Vdelayed_warnings_list
= Fcons (list2
(Qcomp,
(Qnative_compiler,
CALLN (Fformat,
build_string ("Cannot look up .eln file "
"for %s because no source "