[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/android 933b5b51ab1: Merge remote-tracking branch 'origin/master
From: |
Po Lu |
Subject: |
feature/android 933b5b51ab1: Merge remote-tracking branch 'origin/master' into feature/android |
Date: |
Mon, 10 Apr 2023 19:59:09 -0400 (EDT) |
branch: feature/android
commit 933b5b51ab1be789aeef0b25e12e2f033d90ee3a
Merge: 857e2bcb664 9efa6d2cf28
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Merge remote-tracking branch 'origin/master' into feature/android
---
doc/lispref/sequences.texi | 52 ++++++++++++++++++--------------------
lisp/dired.el | 6 ++---
lisp/erc/erc-stamp.el | 17 ++++++++-----
lisp/progmodes/ebnf-otz.el | 3 +--
lisp/progmodes/make-mode.el | 10 +++-----
lisp/progmodes/project.el | 43 ++++++++++++++++++++++++++++---
lisp/textmodes/html-ts-mode.el | 2 +-
lisp/url/url-mailto.el | 4 +--
test/lisp/progmodes/eglot-tests.el | 51 ++++++++++++++++++-------------------
9 files changed, 111 insertions(+), 77 deletions(-)
diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi
index 7011b5c72af..dd5b723b479 100644
--- a/doc/lispref/sequences.texi
+++ b/doc/lispref/sequences.texi
@@ -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
result of @code{sort} is unpredictable.
-The destructive aspect of @code{sort} for lists is that it rearranges the
-cons cells forming @var{sequence} by changing @sc{cdr}s. A nondestructive
-sort function would create new cons cells to store the elements in their
-sorted order. If you wish to make a sorted copy without destroying the
-original, copy it first with @code{copy-sequence} and then sort.
-
-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:
+The destructive aspect of @code{sort} for lists is that it reuses the
+cons cells forming @var{sequence} by changing their contents, possibly
+rearranging them in a different order. This means that the value of
+the input list is undefined after sorting; only the list returned by
+@code{sort} has a well-defined value. Example:
@example
@group
-(setq nums (list 1 3 2 6 5 4 0))
- @result{} (1 3 2 6 5 4 0)
-@end group
-@group
+(setq nums (list 2 1 4 3 0))
(sort nums #'<)
- @result{} (0 1 2 3 4 5 6)
-@end group
-@group
-nums
- @result{} (1 2 3 4 5 6)
+ @result{} (0 1 2 3 4)
+ ; nums is unpredictable at this point
@end group
@end example
-@noindent
-@strong{Warning}: Note that the list in @code{nums} no longer contains
-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:
+Most often we store the result back into the variable that held the
+original list:
@example
(setq nums (sort nums #'<))
@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
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.
diff --git a/lisp/dired.el b/lisp/dired.el
index 8e3244356fe..d1471e993a1 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -927,9 +927,9 @@ marked file, return (t FILENAME) instead of (FILENAME)."
(lambda ()
(if ,show-progress (sit-for 0))
(setq results (cons ,body results))))
- (if (< ,arg 0)
- (nreverse results)
- results))
+ (when (< ,arg 0)
+ (setq results (nreverse results)))
+ results)
;; non-nil, non-integer, non-marked ARG means use current file:
(list ,body))
(let ((regexp (dired-marker-regexp)) next-position)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 8bca9bdb56b..61f289a8753 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -302,10 +302,9 @@ or one col more than the `string-width' of
(current-time)
erc-timestamp-format)))))
(+ right-margin-width cols))))
- (setq right-margin-width width
- right-fringe-width 0)
- (set-window-margins nil left-margin-width width)
- (set-window-fringes nil left-fringe-width 0)))
+ (setq right-margin-width width)
+ (when (eq (current-buffer) (window-buffer))
+ (set-window-margins nil left-margin-width width))))
;;;###autoload
(defun erc-stamp-prefix-log-filter (text)
@@ -344,6 +343,9 @@ message text so that stamps will be visible when yanked."
:interactive nil
(if erc-stamp--display-margin-mode
(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)
(add-function :filter-return (local 'filter-buffer-substring-function)
#'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)
#'erc-stamp--display-margin-force)
(kill-local-variable 'right-margin-width)
- (kill-local-variable 'right-fringe-width)
- (set-window-margins nil left-margin-width nil)
- (set-window-fringes nil left-fringe-width nil)))
+ (kill-local-variable 'fringes-outside-margins)
+ (when (eq (current-buffer) (window-buffer))
+ (set-window-margins nil left-margin-width nil)
+ (set-window-buffer (selected-window) (current-buffer)))))
(defun erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
diff --git a/lisp/progmodes/ebnf-otz.el b/lisp/progmodes/ebnf-otz.el
index 9ac37b676f9..4155dc0d2cd 100644
--- a/lisp/progmodes/ebnf-otz.el
+++ b/lisp/progmodes/ebnf-otz.el
@@ -566,7 +566,7 @@
;; determine suffix length
(while (and (> isuf 0) (setq tail (cdr tail)))
(let* ((cur head)
- (tlis (nreverse
+ (tlis (reverse
(if (eq (ebnf-node-kind (car tail)) 'ebnf-generate-sequence)
(ebnf-node-list (car tail))
(list (car tail)))))
@@ -577,7 +577,6 @@
(setq cur (cdr cur)
this (cdr this)
i (1+ i)))
- (nreverse tlis)
(setq isuf (min isuf i))))
(setq head (nreverse head))
(if (or (zerop isuf) (> isuf len))
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index 087974bd1f0..5ea03b9e852 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -1326,14 +1326,12 @@ Fill comments, backslashed lines, and variable
definitions specially."
(let ((inhibit-read-only t))
(goto-char (point-min))
(erase-buffer)
- (mapconcat
+ (mapc
(lambda (item) (insert (makefile-browser-format-target-line (car item)
nil) "\n"))
- targets
- "")
- (mapconcat
+ targets)
+ (mapc
(lambda (item) (insert (makefile-browser-format-macro-line (car item)
nil) "\n"))
- macros
- "")
+ macros)
(sort-lines nil (point-min) (point-max))
(goto-char (1- (point-max)))
(delete-char 1) ; remove unnecessary newline at eob
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 877d79353aa..e7c0bd2069b 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -202,6 +202,17 @@ CL struct.")
"Value to use instead of `default-directory' when detecting the project.
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
(defun project-current (&optional maybe-prompt directory)
"Return the project instance in DIRECTORY, defaulting to `default-directory'.
@@ -226,7 +237,7 @@ of the project instance object."
(pr)
((unless project-current-directory-override
maybe-prompt)
- (setq directory (project-prompt-project-dir)
+ (setq directory (funcall project-prompter)
pr (project--find-in-directory directory))))
(when maybe-prompt
(if pr
@@ -1615,7 +1626,7 @@ passed to `message' as its first argument."
"Remove directory PROJECT-ROOT from the project list.
PROJECT-ROOT is the root directory of a known project listed in
the project list."
- (interactive (list (project-prompt-project-dir)))
+ (interactive (list (funcall project-prompter)))
(project--remove-from-project-list
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)
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
(defun project-known-project-roots ()
"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
to directory DIR."
- (interactive (list (project-prompt-project-dir)))
+ (interactive (list (funcall project-prompter)))
(let ((command (if (symbolp project-switch-commands)
project-switch-commands
(project--switch-project-command))))
diff --git a/lisp/textmodes/html-ts-mode.el b/lisp/textmodes/html-ts-mode.el
index 58dcc7d8cad..4c1f410a7ef 100644
--- a/lisp/textmodes/html-ts-mode.el
+++ b/lisp/textmodes/html-ts-mode.el
@@ -42,7 +42,7 @@
(defvar html-ts-mode--indent-rules
`((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 "end_tag") parent-bol 0)
diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el
index 24e64e99c9f..04d6d9681ff 100644
--- a/lisp/url/url-mailto.el
+++ b/lisp/url/url-mailto.el
@@ -120,11 +120,11 @@
(url-mail-goto-field nil)
(url-mail-goto-field "subject")))
(if url-request-extra-headers
- (mapconcat
+ (mapc
(lambda (x)
(url-mail-goto-field (car x))
(insert (cdr x)))
- url-request-extra-headers ""))
+ url-request-extra-headers))
(goto-char (point-max))
(insert url-request-data)
;; It seems Microsoft-ish to send without warning.
diff --git a/test/lisp/progmodes/eglot-tests.el
b/test/lisp/progmodes/eglot-tests.el
index 86e7b21def0..efb0f4d8844 100644
--- a/test/lisp/progmodes/eglot-tests.el
+++ b/test/lisp/progmodes/eglot-tests.el
@@ -70,47 +70,46 @@ directory hierarchy."
`(eglot--call-with-fixture ,fixture (lambda () ,@body)))
(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)))
(cond ((listp content)
(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)))
((stringp content)
- (with-temp-buffer
- (insert content)
- (write-region nil nil file-or-dir-name nil 'nomessage))
- (list (expand-file-name file-or-dir-name)))
+ (with-temp-file file-or-dir-name
+ (insert content))
+ (list file-or-dir-name))
(t
(eglot--error "Expected a string or a directory spec")))))
(defun eglot--call-with-fixture (fixture fn)
"Helper for `eglot--with-fixture'. Run FN under FIXTURE."
- (let* ((fixture-directory (make-nearby-temp-file "eglot--fixture" t))
- (default-directory fixture-directory)
+ (let* ((fixture-directory (make-nearby-temp-file "eglot--fixture-" t))
+ (default-directory (file-name-as-directory fixture-directory))
created-files
new-servers
test-body-successful-p)
(eglot--test-message "[%s]: test start" (ert-test-name (ert-running-test)))
(unwind-protect
- (let* ((process-environment
- (append
- `(;; Set XDF_CONFIG_HOME to /dev/null to prevent
- ;; user-configuration to have an influence on
- ;; language servers. (See github#441)
- "XDG_CONFIG_HOME=/dev/null"
- ;; ... on the flip-side, a similar technique by
- ;; Emacs's test makefiles means that HOME is
- ;; spoofed to /nonexistent, or sometimes /tmp.
- ;; This breaks some common installations for LSP
- ;; servers like pylsp, rust-analyzer making these
- ;; tests mostly useless, so we hack around it here
- ;; with a great big hack.
- ,(format "HOME=%s"
- (expand-file-name (format "~%s"
(user-login-name)))))
- process-environment))
- (eglot-server-initialized-hook
- (lambda (server) (push server new-servers))))
+ (let ((process-environment
+ `(;; Set XDG_CONFIG_HOME to /dev/null to prevent
+ ;; user-configuration influencing language servers
+ ;; (see github#441).
+ ,(format "XDG_CONFIG_HOME=%s" null-device)
+ ;; ... on the flip-side, a similar technique in
+ ;; Emacs's `test/Makefile' spoofs HOME as
+ ;; /nonexistent (and as `temporary-file-directory' in
+ ;; `ert-remote-temporary-file-directory').
+ ;; This breaks some common installations for LSP
+ ;; servers like rust-analyzer, making these tests
+ ;; mostly useless, so we hack around it here with a
+ ;; great big hack.
+ ,(format "HOME=%s"
+ (expand-file-name (format "~%s" (user-login-name))))
+ ,@process-environment))
+ (eglot-server-initialized-hook
+ (lambda (server) (push server new-servers))))
(setq created-files (mapcan #'eglot--make-file-or-dir fixture))
(prog1 (funcall fn)
(setq test-body-successful-p t)))