Merge remote-tracking branch 'origin/master' into feature/android

This commit is contained in:
Po Lu 2023-04-11 07:57:31 +08:00
commit 933b5b51ab
9 changed files with 111 additions and 77 deletions

View file

@ -376,45 +376,43 @@ is less than @var{c}, then @var{a} must be less than @var{c}. If you
use a comparison function which does not meet these requirements, the use a comparison function which does not meet these requirements, the
result of @code{sort} is unpredictable. result of @code{sort} is unpredictable.
The destructive aspect of @code{sort} for lists is that it rearranges the The destructive aspect of @code{sort} for lists is that it reuses the
cons cells forming @var{sequence} by changing @sc{cdr}s. A nondestructive cons cells forming @var{sequence} by changing their contents, possibly
sort function would create new cons cells to store the elements in their rearranging them in a different order. This means that the value of
sorted order. If you wish to make a sorted copy without destroying the the input list is undefined after sorting; only the list returned by
original, copy it first with @code{copy-sequence} and then sort. @code{sort} has a well-defined value. Example:
Sorting does not change the @sc{car}s of the cons cells in @var{sequence};
the cons cell that originally contained the element @code{a} in
@var{sequence} still has @code{a} in its @sc{car} after sorting, but it now
appears in a different position in the list due to the change of
@sc{cdr}s. For example:
@example @example
@group @group
(setq nums (list 1 3 2 6 5 4 0)) (setq nums (list 2 1 4 3 0))
@result{} (1 3 2 6 5 4 0)
@end group
@group
(sort nums #'<) (sort nums #'<)
@result{} (0 1 2 3 4 5 6) @result{} (0 1 2 3 4)
@end group ; nums is unpredictable at this point
@group
nums
@result{} (1 2 3 4 5 6)
@end group @end group
@end example @end example
@noindent Most often we store the result back into the variable that held the
@strong{Warning}: Note that the list in @code{nums} no longer contains original list:
0; this is the same cons cell that it was before, but it is no longer
the first one in the list. Don't assume a variable that formerly held
the argument now holds the entire sorted list! Instead, save the result
of @code{sort} and use that. Most often we store the result back into
the variable that held the original list:
@example @example
(setq nums (sort nums #'<)) (setq nums (sort nums #'<))
@end example @end example
If you wish to make a sorted copy without destroying the original,
copy it first and then sort:
@example
@group
(setq nums (list 2 1 4 3 0))
(sort (copy-sequence nums) #'<)
@result{} (0 1 2 3 4)
@end group
@group
nums
@result{} (2 1 4 3 0)
@end group
@end example
For the better understanding of what stable sort is, consider the following For the better understanding of what stable sort is, consider the following
vector example. After sorting, all items whose @code{car} is 8 are grouped vector example. After sorting, all items whose @code{car} is 8 are grouped
at the beginning of @code{vector}, but their relative order is preserved. at the beginning of @code{vector}, but their relative order is preserved.

View file

@ -927,9 +927,9 @@ marked file, return (t FILENAME) instead of (FILENAME)."
(lambda () (lambda ()
(if ,show-progress (sit-for 0)) (if ,show-progress (sit-for 0))
(setq results (cons ,body results)))) (setq results (cons ,body results))))
(if (< ,arg 0) (when (< ,arg 0)
(nreverse results) (setq results (nreverse results)))
results)) results)
;; non-nil, non-integer, non-marked ARG means use current file: ;; non-nil, non-integer, non-marked ARG means use current file:
(list ,body)) (list ,body))
(let ((regexp (dired-marker-regexp)) next-position) (let ((regexp (dired-marker-regexp)) next-position)

View file

@ -302,10 +302,9 @@ or one col more than the `string-width' of
(current-time) (current-time)
erc-timestamp-format))))) erc-timestamp-format)))))
(+ right-margin-width cols)))) (+ right-margin-width cols))))
(setq right-margin-width width (setq right-margin-width width)
right-fringe-width 0) (when (eq (current-buffer) (window-buffer))
(set-window-margins nil left-margin-width width) (set-window-margins nil left-margin-width width))))
(set-window-fringes nil left-fringe-width 0)))
;;;###autoload ;;;###autoload
(defun erc-stamp-prefix-log-filter (text) (defun erc-stamp-prefix-log-filter (text)
@ -344,6 +343,9 @@ message text so that stamps will be visible when yanked."
:interactive nil :interactive nil
(if erc-stamp--display-margin-mode (if erc-stamp--display-margin-mode
(progn (progn
(setq fringes-outside-margins t)
(when (eq (current-buffer) (window-buffer))
(set-window-buffer (selected-window) (current-buffer)))
(erc-stamp--adjust-right-margin 0) (erc-stamp--adjust-right-margin 0)
(add-function :filter-return (local 'filter-buffer-substring-function) (add-function :filter-return (local 'filter-buffer-substring-function)
#'erc--remove-text-properties) #'erc--remove-text-properties)
@ -354,9 +356,10 @@ message text so that stamps will be visible when yanked."
(remove-function (local 'erc-insert-timestamp-function) (remove-function (local 'erc-insert-timestamp-function)
#'erc-stamp--display-margin-force) #'erc-stamp--display-margin-force)
(kill-local-variable 'right-margin-width) (kill-local-variable 'right-margin-width)
(kill-local-variable 'right-fringe-width) (kill-local-variable 'fringes-outside-margins)
(when (eq (current-buffer) (window-buffer))
(set-window-margins nil left-margin-width nil) (set-window-margins nil left-margin-width nil)
(set-window-fringes nil left-fringe-width nil))) (set-window-buffer (selected-window) (current-buffer)))))
(defun erc-insert-timestamp-left (string) (defun erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line." "Insert timestamps at the beginning of the line."

View file

@ -566,7 +566,7 @@
;; determine suffix length ;; determine suffix length
(while (and (> isuf 0) (setq tail (cdr tail))) (while (and (> isuf 0) (setq tail (cdr tail)))
(let* ((cur head) (let* ((cur head)
(tlis (nreverse (tlis (reverse
(if (eq (ebnf-node-kind (car tail)) 'ebnf-generate-sequence) (if (eq (ebnf-node-kind (car tail)) 'ebnf-generate-sequence)
(ebnf-node-list (car tail)) (ebnf-node-list (car tail))
(list (car tail))))) (list (car tail)))))
@ -577,7 +577,6 @@
(setq cur (cdr cur) (setq cur (cdr cur)
this (cdr this) this (cdr this)
i (1+ i))) i (1+ i)))
(nreverse tlis)
(setq isuf (min isuf i)))) (setq isuf (min isuf i))))
(setq head (nreverse head)) (setq head (nreverse head))
(if (or (zerop isuf) (> isuf len)) (if (or (zerop isuf) (> isuf len))

View file

@ -1326,14 +1326,12 @@ Fill comments, backslashed lines, and variable definitions specially."
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))
(goto-char (point-min)) (goto-char (point-min))
(erase-buffer) (erase-buffer)
(mapconcat (mapc
(lambda (item) (insert (makefile-browser-format-target-line (car item) nil) "\n")) (lambda (item) (insert (makefile-browser-format-target-line (car item) nil) "\n"))
targets targets)
"") (mapc
(mapconcat
(lambda (item) (insert (makefile-browser-format-macro-line (car item) nil) "\n")) (lambda (item) (insert (makefile-browser-format-macro-line (car item) nil) "\n"))
macros macros)
"")
(sort-lines nil (point-min) (point-max)) (sort-lines nil (point-min) (point-max))
(goto-char (1- (point-max))) (goto-char (1- (point-max)))
(delete-char 1) ; remove unnecessary newline at eob (delete-char 1) ; remove unnecessary newline at eob

View file

@ -202,6 +202,17 @@ CL struct.")
"Value to use instead of `default-directory' when detecting the project. "Value to use instead of `default-directory' when detecting the project.
When it is non-nil, `project-current' will always skip prompting too.") When it is non-nil, `project-current' will always skip prompting too.")
(defcustom project-prompter #'project-prompt-project-dir
"Function to call to prompt for a project.
Called with no arguments and should return a project root dir."
:type '(choice (const :tag "Prompt for a project directory"
project-prompt-project-dir)
(const :tag "Prompt for a project name"
project-prompt-project-name)
(function :tag "Custom function" nil))
:group 'project
:version "30.1")
;;;###autoload ;;;###autoload
(defun project-current (&optional maybe-prompt directory) (defun project-current (&optional maybe-prompt directory)
"Return the project instance in DIRECTORY, defaulting to `default-directory'. "Return the project instance in DIRECTORY, defaulting to `default-directory'.
@ -226,7 +237,7 @@ of the project instance object."
(pr) (pr)
((unless project-current-directory-override ((unless project-current-directory-override
maybe-prompt) maybe-prompt)
(setq directory (project-prompt-project-dir) (setq directory (funcall project-prompter)
pr (project--find-in-directory directory)))) pr (project--find-in-directory directory))))
(when maybe-prompt (when maybe-prompt
(if pr (if pr
@ -1615,7 +1626,7 @@ passed to `message' as its first argument."
"Remove directory PROJECT-ROOT from the project list. "Remove directory PROJECT-ROOT from the project list.
PROJECT-ROOT is the root directory of a known project listed in PROJECT-ROOT is the root directory of a known project listed in
the project list." the project list."
(interactive (list (project-prompt-project-dir))) (interactive (list (funcall project-prompter)))
(project--remove-from-project-list (project--remove-from-project-list
project-root "Project `%s' removed from known projects")) project-root "Project `%s' removed from known projects"))
@ -1639,6 +1650,32 @@ It's also possible to enter an arbitrary directory not in the list."
(read-directory-name "Select directory: " default-directory nil t) (read-directory-name "Select directory: " default-directory nil t)
pr-dir))) pr-dir)))
(defun project-prompt-project-name ()
"Prompt the user for a project, by name, that is one of the known project roots.
The project is chosen among projects known from the project list,
see `project-list-file'.
It's also possible to enter an arbitrary directory not in the list."
(let* ((dir-choice "... (choose a dir)")
(choices
(let (ret)
(dolist (dir (project-known-project-roots))
;; we filter out directories that no longer map to a project,
;; since they don't have a clean project-name.
(if-let (proj (project--find-in-directory dir))
(push (cons (project-name proj) proj) ret)))
ret))
;; XXX: Just using this for the category (for the substring
;; completion style).
(table (project--file-completion-table (cons dir-choice choices)))
(pr-name ""))
(while (equal pr-name "")
;; If the user simply pressed RET, do this again until they don't.
(setq pr-name (completing-read "Select project: " table nil t)))
(if (equal pr-name dir-choice)
(read-directory-name "Select directory: " default-directory nil t)
(let ((proj (assoc pr-name choices)))
(if (stringp proj) proj (project-root (cdr proj)))))))
;;;###autoload ;;;###autoload
(defun project-known-project-roots () (defun project-known-project-roots ()
"Return the list of root directories of all known projects." "Return the list of root directories of all known projects."
@ -1826,7 +1863,7 @@ made from `project-switch-commands'.
When called in a program, it will use the project corresponding When called in a program, it will use the project corresponding
to directory DIR." to directory DIR."
(interactive (list (project-prompt-project-dir))) (interactive (list (funcall project-prompter)))
(let ((command (if (symbolp project-switch-commands) (let ((command (if (symbolp project-switch-commands)
project-switch-commands project-switch-commands
(project--switch-project-command)))) (project--switch-project-command))))

View file

@ -42,7 +42,7 @@
(defvar html-ts-mode--indent-rules (defvar html-ts-mode--indent-rules
`((html `((html
((parent-is "fragment") point-min 0) ((parent-is "fragment") column-0 0)
((node-is "/>") parent-bol 0) ((node-is "/>") parent-bol 0)
((node-is ">") parent-bol 0) ((node-is ">") parent-bol 0)
((node-is "end_tag") parent-bol 0) ((node-is "end_tag") parent-bol 0)

View file

@ -120,11 +120,11 @@
(url-mail-goto-field nil) (url-mail-goto-field nil)
(url-mail-goto-field "subject"))) (url-mail-goto-field "subject")))
(if url-request-extra-headers (if url-request-extra-headers
(mapconcat (mapc
(lambda (x) (lambda (x)
(url-mail-goto-field (car x)) (url-mail-goto-field (car x))
(insert (cdr x))) (insert (cdr x)))
url-request-extra-headers "")) url-request-extra-headers))
(goto-char (point-max)) (goto-char (point-max))
(insert url-request-data) (insert url-request-data)
;; It seems Microsoft-ish to send without warning. ;; It seems Microsoft-ish to send without warning.

View file

@ -70,45 +70,44 @@ directory hierarchy."
`(eglot--call-with-fixture ,fixture (lambda () ,@body))) `(eglot--call-with-fixture ,fixture (lambda () ,@body)))
(defun eglot--make-file-or-dir (ass) (defun eglot--make-file-or-dir (ass)
(let ((file-or-dir-name (car ass)) (let ((file-or-dir-name (expand-file-name (car ass)))
(content (cdr ass))) (content (cdr ass)))
(cond ((listp content) (cond ((listp content)
(make-directory file-or-dir-name 'parents) (make-directory file-or-dir-name 'parents)
(let ((default-directory (concat default-directory "/" file-or-dir-name))) (let ((default-directory (file-name-as-directory file-or-dir-name)))
(mapcan #'eglot--make-file-or-dir content))) (mapcan #'eglot--make-file-or-dir content)))
((stringp content) ((stringp content)
(with-temp-buffer (with-temp-file file-or-dir-name
(insert content) (insert content))
(write-region nil nil file-or-dir-name nil 'nomessage)) (list file-or-dir-name))
(list (expand-file-name file-or-dir-name)))
(t (t
(eglot--error "Expected a string or a directory spec"))))) (eglot--error "Expected a string or a directory spec")))))
(defun eglot--call-with-fixture (fixture fn) (defun eglot--call-with-fixture (fixture fn)
"Helper for `eglot--with-fixture'. Run FN under FIXTURE." "Helper for `eglot--with-fixture'. Run FN under FIXTURE."
(let* ((fixture-directory (make-nearby-temp-file "eglot--fixture" t)) (let* ((fixture-directory (make-nearby-temp-file "eglot--fixture-" t))
(default-directory fixture-directory) (default-directory (file-name-as-directory fixture-directory))
created-files created-files
new-servers new-servers
test-body-successful-p) test-body-successful-p)
(eglot--test-message "[%s]: test start" (ert-test-name (ert-running-test))) (eglot--test-message "[%s]: test start" (ert-test-name (ert-running-test)))
(unwind-protect (unwind-protect
(let* ((process-environment (let ((process-environment
(append `(;; Set XDG_CONFIG_HOME to /dev/null to prevent
`(;; Set XDF_CONFIG_HOME to /dev/null to prevent ;; user-configuration influencing language servers
;; user-configuration to have an influence on ;; (see github#441).
;; language servers. (See github#441) ,(format "XDG_CONFIG_HOME=%s" null-device)
"XDG_CONFIG_HOME=/dev/null" ;; ... on the flip-side, a similar technique in
;; ... on the flip-side, a similar technique by ;; Emacs's `test/Makefile' spoofs HOME as
;; Emacs's test makefiles means that HOME is ;; /nonexistent (and as `temporary-file-directory' in
;; spoofed to /nonexistent, or sometimes /tmp. ;; `ert-remote-temporary-file-directory').
;; This breaks some common installations for LSP ;; This breaks some common installations for LSP
;; servers like pylsp, rust-analyzer making these ;; servers like rust-analyzer, making these tests
;; tests mostly useless, so we hack around it here ;; mostly useless, so we hack around it here with a
;; with a great big hack. ;; great big hack.
,(format "HOME=%s" ,(format "HOME=%s"
(expand-file-name (format "~%s" (user-login-name))))) (expand-file-name (format "~%s" (user-login-name))))
process-environment)) ,@process-environment))
(eglot-server-initialized-hook (eglot-server-initialized-hook
(lambda (server) (push server new-servers)))) (lambda (server) (push server new-servers))))
(setq created-files (mapcan #'eglot--make-file-or-dir fixture)) (setq created-files (mapcan #'eglot--make-file-or-dir fixture))