aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorPo Lu2023-04-11 07:57:31 +0800
committerPo Lu2023-04-11 07:57:31 +0800
commit933b5b51ab1be789aeef0b25e12e2f033d90ee3a (patch)
tree7d5d32cb4cb03fc6c0446e51382af10fbc31b32a
parent857e2bcb664bbfa6df7101e8f314d7a44d5d7f56 (diff)
parent9efa6d2cf28f4e21f23bb0dbfedc59a4286dab12 (diff)
downloademacs-933b5b51ab1be789aeef0b25e12e2f033d90ee3a.tar.gz
emacs-933b5b51ab1be789aeef0b25e12e2f033d90ee3a.zip
Merge remote-tracking branch 'origin/master' into feature/android
-rw-r--r--doc/lispref/sequences.texi52
-rw-r--r--lisp/dired.el6
-rw-r--r--lisp/erc/erc-stamp.el17
-rw-r--r--lisp/progmodes/ebnf-otz.el3
-rw-r--r--lisp/progmodes/make-mode.el10
-rw-r--r--lisp/progmodes/project.el43
-rw-r--r--lisp/textmodes/html-ts-mode.el2
-rw-r--r--lisp/url/url-mailto.el4
-rw-r--r--test/lisp/progmodes/eglot-tests.el51
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
376use a comparison function which does not meet these requirements, the 376use a comparison function which does not meet these requirements, the
377result of @code{sort} is unpredictable. 377result of @code{sort} is unpredictable.
378 378
379The destructive aspect of @code{sort} for lists is that it rearranges the 379The destructive aspect of @code{sort} for lists is that it reuses the
380cons cells forming @var{sequence} by changing @sc{cdr}s. A nondestructive 380cons cells forming @var{sequence} by changing their contents, possibly
381sort function would create new cons cells to store the elements in their 381rearranging them in a different order. This means that the value of
382sorted order. If you wish to make a sorted copy without destroying the 382the input list is undefined after sorting; only the list returned by
383original, copy it first with @code{copy-sequence} and then sort. 383@code{sort} has a well-defined value. Example:
384
385Sorting does not change the @sc{car}s of the cons cells in @var{sequence};
386the cons cell that originally contained the element @code{a} in
387@var{sequence} still has @code{a} in its @sc{car} after sorting, but it now
388appears in a different position in the list due to the change of
389@sc{cdr}s. For example:
390 384
391@example 385@example
392@group 386@group
393(setq nums (list 1 3 2 6 5 4 0)) 387(setq nums (list 2 1 4 3 0))
394 @result{} (1 3 2 6 5 4 0)
395@end group
396@group
397(sort nums #'<) 388(sort nums #'<)
398 @result{} (0 1 2 3 4 5 6) 389 @result{} (0 1 2 3 4)
399@end group 390 ; nums is unpredictable at this point
400@group
401nums
402 @result{} (1 2 3 4 5 6)
403@end group 391@end group
404@end example 392@end example
405 393
406@noindent 394Most often we store the result back into the variable that held the
407@strong{Warning}: Note that the list in @code{nums} no longer contains 395original list:
4080; this is the same cons cell that it was before, but it is no longer
409the first one in the list. Don't assume a variable that formerly held
410the argument now holds the entire sorted list! Instead, save the result
411of @code{sort} and use that. Most often we store the result back into
412the variable that held the original list:
413 396
414@example 397@example
415(setq nums (sort nums #'<)) 398(setq nums (sort nums #'<))
416@end example 399@end example
417 400
401If you wish to make a sorted copy without destroying the original,
402copy it first and then sort:
403
404@example
405@group
406(setq nums (list 2 1 4 3 0))
407(sort (copy-sequence nums) #'<)
408 @result{} (0 1 2 3 4)
409@end group
410@group
411nums
412 @result{} (2 1 4 3 0)
413@end group
414@end example
415
418For the better understanding of what stable sort is, consider the following 416For the better understanding of what stable sort is, consider the following
419vector example. After sorting, all items whose @code{car} is 8 are grouped 417vector example. After sorting, all items whose @code{car} is 8 are grouped
420at the beginning of @code{vector}, but their relative order is preserved. 418at 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)."
927 (lambda () 927 (lambda ()
928 (if ,show-progress (sit-for 0)) 928 (if ,show-progress (sit-for 0))
929 (setq results (cons ,body results)))) 929 (setq results (cons ,body results))))
930 (if (< ,arg 0) 930 (when (< ,arg 0)
931 (nreverse results) 931 (setq results (nreverse results)))
932 results)) 932 results)
933 ;; non-nil, non-integer, non-marked ARG means use current file: 933 ;; non-nil, non-integer, non-marked ARG means use current file:
934 (list ,body)) 934 (list ,body))
935 (let ((regexp (dired-marker-regexp)) next-position) 935 (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
302 (current-time) 302 (current-time)
303 erc-timestamp-format))))) 303 erc-timestamp-format)))))
304 (+ right-margin-width cols)))) 304 (+ right-margin-width cols))))
305 (setq right-margin-width width 305 (setq right-margin-width width)
306 right-fringe-width 0) 306 (when (eq (current-buffer) (window-buffer))
307 (set-window-margins nil left-margin-width width) 307 (set-window-margins nil left-margin-width width))))
308 (set-window-fringes nil left-fringe-width 0)))
309 308
310;;;###autoload 309;;;###autoload
311(defun erc-stamp-prefix-log-filter (text) 310(defun erc-stamp-prefix-log-filter (text)
@@ -344,6 +343,9 @@ message text so that stamps will be visible when yanked."
344 :interactive nil 343 :interactive nil
345 (if erc-stamp--display-margin-mode 344 (if erc-stamp--display-margin-mode
346 (progn 345 (progn
346 (setq fringes-outside-margins t)
347 (when (eq (current-buffer) (window-buffer))
348 (set-window-buffer (selected-window) (current-buffer)))
347 (erc-stamp--adjust-right-margin 0) 349 (erc-stamp--adjust-right-margin 0)
348 (add-function :filter-return (local 'filter-buffer-substring-function) 350 (add-function :filter-return (local 'filter-buffer-substring-function)
349 #'erc--remove-text-properties) 351 #'erc--remove-text-properties)
@@ -354,9 +356,10 @@ message text so that stamps will be visible when yanked."
354 (remove-function (local 'erc-insert-timestamp-function) 356 (remove-function (local 'erc-insert-timestamp-function)
355 #'erc-stamp--display-margin-force) 357 #'erc-stamp--display-margin-force)
356 (kill-local-variable 'right-margin-width) 358 (kill-local-variable 'right-margin-width)
357 (kill-local-variable 'right-fringe-width) 359 (kill-local-variable 'fringes-outside-margins)
358 (set-window-margins nil left-margin-width nil) 360 (when (eq (current-buffer) (window-buffer))
359 (set-window-fringes nil left-fringe-width nil))) 361 (set-window-margins nil left-margin-width nil)
362 (set-window-buffer (selected-window) (current-buffer)))))
360 363
361(defun erc-insert-timestamp-left (string) 364(defun erc-insert-timestamp-left (string)
362 "Insert timestamps at the beginning of the line." 365 "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 @@
566 ;; determine suffix length 566 ;; determine suffix length
567 (while (and (> isuf 0) (setq tail (cdr tail))) 567 (while (and (> isuf 0) (setq tail (cdr tail)))
568 (let* ((cur head) 568 (let* ((cur head)
569 (tlis (nreverse 569 (tlis (reverse
570 (if (eq (ebnf-node-kind (car tail)) 'ebnf-generate-sequence) 570 (if (eq (ebnf-node-kind (car tail)) 'ebnf-generate-sequence)
571 (ebnf-node-list (car tail)) 571 (ebnf-node-list (car tail))
572 (list (car tail))))) 572 (list (car tail)))))
@@ -577,7 +577,6 @@
577 (setq cur (cdr cur) 577 (setq cur (cdr cur)
578 this (cdr this) 578 this (cdr this)
579 i (1+ i))) 579 i (1+ i)))
580 (nreverse tlis)
581 (setq isuf (min isuf i)))) 580 (setq isuf (min isuf i))))
582 (setq head (nreverse head)) 581 (setq head (nreverse head))
583 (if (or (zerop isuf) (> isuf len)) 582 (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."
1326 (let ((inhibit-read-only t)) 1326 (let ((inhibit-read-only t))
1327 (goto-char (point-min)) 1327 (goto-char (point-min))
1328 (erase-buffer) 1328 (erase-buffer)
1329 (mapconcat 1329 (mapc
1330 (lambda (item) (insert (makefile-browser-format-target-line (car item) nil) "\n")) 1330 (lambda (item) (insert (makefile-browser-format-target-line (car item) nil) "\n"))
1331 targets 1331 targets)
1332 "") 1332 (mapc
1333 (mapconcat
1334 (lambda (item) (insert (makefile-browser-format-macro-line (car item) nil) "\n")) 1333 (lambda (item) (insert (makefile-browser-format-macro-line (car item) nil) "\n"))
1335 macros 1334 macros)
1336 "")
1337 (sort-lines nil (point-min) (point-max)) 1335 (sort-lines nil (point-min) (point-max))
1338 (goto-char (1- (point-max))) 1336 (goto-char (1- (point-max)))
1339 (delete-char 1) ; remove unnecessary newline at eob 1337 (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.")
202 "Value to use instead of `default-directory' when detecting the project. 202 "Value to use instead of `default-directory' when detecting the project.
203When it is non-nil, `project-current' will always skip prompting too.") 203When it is non-nil, `project-current' will always skip prompting too.")
204 204
205(defcustom project-prompter #'project-prompt-project-dir
206 "Function to call to prompt for a project.
207Called with no arguments and should return a project root dir."
208 :type '(choice (const :tag "Prompt for a project directory"
209 project-prompt-project-dir)
210 (const :tag "Prompt for a project name"
211 project-prompt-project-name)
212 (function :tag "Custom function" nil))
213 :group 'project
214 :version "30.1")
215
205;;;###autoload 216;;;###autoload
206(defun project-current (&optional maybe-prompt directory) 217(defun project-current (&optional maybe-prompt directory)
207 "Return the project instance in DIRECTORY, defaulting to `default-directory'. 218 "Return the project instance in DIRECTORY, defaulting to `default-directory'.
@@ -226,7 +237,7 @@ of the project instance object."
226 (pr) 237 (pr)
227 ((unless project-current-directory-override 238 ((unless project-current-directory-override
228 maybe-prompt) 239 maybe-prompt)
229 (setq directory (project-prompt-project-dir) 240 (setq directory (funcall project-prompter)
230 pr (project--find-in-directory directory)))) 241 pr (project--find-in-directory directory))))
231 (when maybe-prompt 242 (when maybe-prompt
232 (if pr 243 (if pr
@@ -1615,7 +1626,7 @@ passed to `message' as its first argument."
1615 "Remove directory PROJECT-ROOT from the project list. 1626 "Remove directory PROJECT-ROOT from the project list.
1616PROJECT-ROOT is the root directory of a known project listed in 1627PROJECT-ROOT is the root directory of a known project listed in
1617the project list." 1628the project list."
1618 (interactive (list (project-prompt-project-dir))) 1629 (interactive (list (funcall project-prompter)))
1619 (project--remove-from-project-list 1630 (project--remove-from-project-list
1620 project-root "Project `%s' removed from known projects")) 1631 project-root "Project `%s' removed from known projects"))
1621 1632
@@ -1639,6 +1650,32 @@ It's also possible to enter an arbitrary directory not in the list."
1639 (read-directory-name "Select directory: " default-directory nil t) 1650 (read-directory-name "Select directory: " default-directory nil t)
1640 pr-dir))) 1651 pr-dir)))
1641 1652
1653(defun project-prompt-project-name ()
1654 "Prompt the user for a project, by name, that is one of the known project roots.
1655The project is chosen among projects known from the project list,
1656see `project-list-file'.
1657It's also possible to enter an arbitrary directory not in the list."
1658 (let* ((dir-choice "... (choose a dir)")
1659 (choices
1660 (let (ret)
1661 (dolist (dir (project-known-project-roots))
1662 ;; we filter out directories that no longer map to a project,
1663 ;; since they don't have a clean project-name.
1664 (if-let (proj (project--find-in-directory dir))
1665 (push (cons (project-name proj) proj) ret)))
1666 ret))
1667 ;; XXX: Just using this for the category (for the substring
1668 ;; completion style).
1669 (table (project--file-completion-table (cons dir-choice choices)))
1670 (pr-name ""))
1671 (while (equal pr-name "")
1672 ;; If the user simply pressed RET, do this again until they don't.
1673 (setq pr-name (completing-read "Select project: " table nil t)))
1674 (if (equal pr-name dir-choice)
1675 (read-directory-name "Select directory: " default-directory nil t)
1676 (let ((proj (assoc pr-name choices)))
1677 (if (stringp proj) proj (project-root (cdr proj)))))))
1678
1642;;;###autoload 1679;;;###autoload
1643(defun project-known-project-roots () 1680(defun project-known-project-roots ()
1644 "Return the list of root directories of all known projects." 1681 "Return the list of root directories of all known projects."
@@ -1826,7 +1863,7 @@ made from `project-switch-commands'.
1826 1863
1827When called in a program, it will use the project corresponding 1864When called in a program, it will use the project corresponding
1828to directory DIR." 1865to directory DIR."
1829 (interactive (list (project-prompt-project-dir))) 1866 (interactive (list (funcall project-prompter)))
1830 (let ((command (if (symbolp project-switch-commands) 1867 (let ((command (if (symbolp project-switch-commands)
1831 project-switch-commands 1868 project-switch-commands
1832 (project--switch-project-command)))) 1869 (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 @@
42 42
43(defvar html-ts-mode--indent-rules 43(defvar html-ts-mode--indent-rules
44 `((html 44 `((html
45 ((parent-is "fragment") point-min 0) 45 ((parent-is "fragment") column-0 0)
46 ((node-is "/>") parent-bol 0) 46 ((node-is "/>") parent-bol 0)
47 ((node-is ">") parent-bol 0) 47 ((node-is ">") parent-bol 0)
48 ((node-is "end_tag") parent-bol 0) 48 ((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 @@
120 (url-mail-goto-field nil) 120 (url-mail-goto-field nil)
121 (url-mail-goto-field "subject"))) 121 (url-mail-goto-field "subject")))
122 (if url-request-extra-headers 122 (if url-request-extra-headers
123 (mapconcat 123 (mapc
124 (lambda (x) 124 (lambda (x)
125 (url-mail-goto-field (car x)) 125 (url-mail-goto-field (car x))
126 (insert (cdr x))) 126 (insert (cdr x)))
127 url-request-extra-headers "")) 127 url-request-extra-headers))
128 (goto-char (point-max)) 128 (goto-char (point-max))
129 (insert url-request-data) 129 (insert url-request-data)
130 ;; It seems Microsoft-ish to send without warning. 130 ;; 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."
70 `(eglot--call-with-fixture ,fixture (lambda () ,@body))) 70 `(eglot--call-with-fixture ,fixture (lambda () ,@body)))
71 71
72(defun eglot--make-file-or-dir (ass) 72(defun eglot--make-file-or-dir (ass)
73 (let ((file-or-dir-name (car ass)) 73 (let ((file-or-dir-name (expand-file-name (car ass)))
74 (content (cdr ass))) 74 (content (cdr ass)))
75 (cond ((listp content) 75 (cond ((listp content)
76 (make-directory file-or-dir-name 'parents) 76 (make-directory file-or-dir-name 'parents)
77 (let ((default-directory (concat default-directory "/" file-or-dir-name))) 77 (let ((default-directory (file-name-as-directory file-or-dir-name)))
78 (mapcan #'eglot--make-file-or-dir content))) 78 (mapcan #'eglot--make-file-or-dir content)))
79 ((stringp content) 79 ((stringp content)
80 (with-temp-buffer 80 (with-temp-file file-or-dir-name
81 (insert content) 81 (insert content))
82 (write-region nil nil file-or-dir-name nil 'nomessage)) 82 (list file-or-dir-name))
83 (list (expand-file-name file-or-dir-name)))
84 (t 83 (t
85 (eglot--error "Expected a string or a directory spec"))))) 84 (eglot--error "Expected a string or a directory spec")))))
86 85
87(defun eglot--call-with-fixture (fixture fn) 86(defun eglot--call-with-fixture (fixture fn)
88 "Helper for `eglot--with-fixture'. Run FN under FIXTURE." 87 "Helper for `eglot--with-fixture'. Run FN under FIXTURE."
89 (let* ((fixture-directory (make-nearby-temp-file "eglot--fixture" t)) 88 (let* ((fixture-directory (make-nearby-temp-file "eglot--fixture-" t))
90 (default-directory fixture-directory) 89 (default-directory (file-name-as-directory fixture-directory))
91 created-files 90 created-files
92 new-servers 91 new-servers
93 test-body-successful-p) 92 test-body-successful-p)
94 (eglot--test-message "[%s]: test start" (ert-test-name (ert-running-test))) 93 (eglot--test-message "[%s]: test start" (ert-test-name (ert-running-test)))
95 (unwind-protect 94 (unwind-protect
96 (let* ((process-environment 95 (let ((process-environment
97 (append 96 `(;; Set XDG_CONFIG_HOME to /dev/null to prevent
98 `(;; Set XDF_CONFIG_HOME to /dev/null to prevent 97 ;; user-configuration influencing language servers
99 ;; user-configuration to have an influence on 98 ;; (see github#441).
100 ;; language servers. (See github#441) 99 ,(format "XDG_CONFIG_HOME=%s" null-device)
101 "XDG_CONFIG_HOME=/dev/null" 100 ;; ... on the flip-side, a similar technique in
102 ;; ... on the flip-side, a similar technique by 101 ;; Emacs's `test/Makefile' spoofs HOME as
103 ;; Emacs's test makefiles means that HOME is 102 ;; /nonexistent (and as `temporary-file-directory' in
104 ;; spoofed to /nonexistent, or sometimes /tmp. 103 ;; `ert-remote-temporary-file-directory').
105 ;; This breaks some common installations for LSP 104 ;; This breaks some common installations for LSP
106 ;; servers like pylsp, rust-analyzer making these 105 ;; servers like rust-analyzer, making these tests
107 ;; tests mostly useless, so we hack around it here 106 ;; mostly useless, so we hack around it here with a
108 ;; with a great big hack. 107 ;; great big hack.
109 ,(format "HOME=%s" 108 ,(format "HOME=%s"
110 (expand-file-name (format "~%s" (user-login-name))))) 109 (expand-file-name (format "~%s" (user-login-name))))
111 process-environment)) 110 ,@process-environment))
112 (eglot-server-initialized-hook 111 (eglot-server-initialized-hook
113 (lambda (server) (push server new-servers)))) 112 (lambda (server) (push server new-servers))))
114 (setq created-files (mapcan #'eglot--make-file-or-dir fixture)) 113 (setq created-files (mapcan #'eglot--make-file-or-dir fixture))
115 (prog1 (funcall fn) 114 (prog1 (funcall fn)
116 (setq test-body-successful-p t))) 115 (setq test-body-successful-p t)))