commit 9682d385c103a9ee1afdeaf3e1711fa3d2001eee (HEAD, refs/remotes/origin/master) Author: Jim Porter Date: Mon Oct 21 15:41:42 2024 -0700 Improve correctness of Eshell globs when using escape characters This new implementation opts *in* to treating characters as glob characters, rather than opting out. This reduces the need to coordinate with other parts of Eshell and should be harder to break (bug#74033). * lisp/eshell/em-glob.el (eshell-parse-glob-chars): Return the propertized globbing character directly. (eshell--propertize-glob, eshell--glob-char-p) (eshell--contains-glob-char-p, eshell--all-glob-chars-p): New functions. (eshell-glob-p): Make obsolete. (eshell-glob-regexp, eshell-glob-convert-1, eshell-glob-convert): Check for 'eshell-glob-char' property. (eshell-extended-glob): Remove text properties when returning no match. (eshell--glob-anything): New constant. (eshell-glob-entries): Propertize "*" to treat it as a glob. * lisp/eshell/em-ls.el (eshell-ls--expand-wildcards): New function... (eshell-ls--insert-directory): ... use it. * test/lisp/eshell/em-glob-tests.el: Use 'eshell--propertize-glob' in tests. (em-glob-test/convert/literal-characters) (em-glob-test/convert/mixed-literal-characters): New tests. * lisp/eshell/em-glob.el (eshell-expand-glob): Rename from 'eshell-extended-glob'. Update callers. (eshell-extended-glob): New function to expand a GLOB that hasn't been propertized yet, for use outside of Eshell command forms. (eshell-parse-glob-chars): Return the propertized globbing character directly. (eshell-parse-glob-string, eshell--glob-char-p) (eshell--contains-glob-char-p, eshell--all-glob-chars-p): New functions. (eshell-glob-regexp, eshell-glob-convert-1, eshell-glob-convert): Check for 'eshell-glob-char' property. (eshell-glob-p): Make obsolete. (eshell--glob-anything): New constant... (eshell-glob-entries): ... use it. * lisp/eshell/em-ls.el (eshell-ls--expand-wildcards): New function... (eshell-ls--insert-directory): ... use it. * test/lisp/eshell/em-glob-tests.el: Use 'eshell-parse-glob-string in tests. (em-glob-test/convert/literal-characters) (em-glob-test/convert/mixed-literal-characters): New tests. diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el index 57bb0c53b57..b94c4e3ed46 100644 --- a/lisp/eshell/em-glob.el +++ b/lisp/eshell/em-glob.el @@ -149,23 +149,48 @@ This mimics the behavior of zsh if non-nil, but bash if nil." "Don't glob the command argument. Reflect this by modifying TERMS." (ignore (pcase (car terms) - ((or `(eshell-extended-glob ,term) - `(eshell-splice-args (eshell-extended-glob ,term))) + ((or `(eshell-expand-glob ,term) + `(eshell-splice-args (eshell-expand-glob ,term))) (setcar terms term))))) (defun eshell-add-glob-modifier () - "Add `eshell-extended-glob' to the argument modifier list." + "Add `eshell-expand-glob' to the argument modifier list." (when eshell-glob-splice-results (add-hook 'eshell-current-modifiers #'eshell-splice-args 99)) - (add-hook 'eshell-current-modifiers #'eshell-extended-glob)) + (add-hook 'eshell-current-modifiers #'eshell-expand-glob)) (defun eshell-parse-glob-chars () - "Parse a globbing delimiter. -The character is not advanced for ordinary globbing characters, so -that other function may have a chance to override the globbing -interpretation." + "Parse a globbing character." (when (memq (char-after) eshell-glob-chars-list) - (ignore (eshell-add-glob-modifier)))) + (eshell-add-glob-modifier) + (prog1 + (propertize (char-to-string (char-after)) 'eshell-glob-char t) + (forward-char)))) + +(defvar eshell-glob-chars-regexp nil) +(defsubst eshell-glob-chars-regexp () + "Return the lazily-created value for `eshell-glob-chars-regexp'." + (or eshell-glob-chars-regexp + (setq-local eshell-glob-chars-regexp + (rx-to-string `(+ (any ,@eshell-glob-chars-list)) t)))) + +(defun eshell-parse-glob-string (glob) + "Add text properties to glob characters in GLOB and return the result." + (let ((regexp (rx-to-string + `(or (seq (group-n 1 "\\") anychar) + (group-n 2 (regexp ,(eshell-glob-chars-regexp)))) + t))) + (with-temp-buffer + (insert glob) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (cond + ((match-beginning 1) ; Remove backslash escape. + (delete-region (match-beginning 1) (match-end 1))) + ((match-beginning 2) ; Propertize globbing character. + (put-text-property (match-beginning 2) (match-end 2) + 'eshell-glob-char t)))) + (buffer-string)))) (defvar eshell-glob-matches) (defvar message-shown) @@ -174,12 +199,16 @@ interpretation." '(("**/" . recurse) ("***/" . recurse-symlink))) -(defvar eshell-glob-chars-regexp nil) -(defsubst eshell-glob-chars-regexp () - "Return the lazily-created value for `eshell-glob-chars-regexp'." - (or eshell-glob-chars-regexp - (setq-local eshell-glob-chars-regexp - (rx-to-string `(+ (any ,@eshell-glob-chars-list)) t)))) +(defsubst eshell--glob-char-p (string index) + (get-text-property index 'eshell-glob-char string)) + +(defsubst eshell--contains-glob-char-p (string) + (text-property-any 0 (length string) 'eshell-glob-char t string)) + +(defun eshell--all-glob-chars-p (string) + (and (length> string 0) + (not (text-property-not-all + 0 (length string) 'eshell-glob-char t string)))) (defun eshell-glob-regexp (pattern) "Convert glob-pattern PATTERN to a regular expression. @@ -196,9 +225,10 @@ The basic syntax is: [a-b] [a-b] matches a character or range [^a] [^a] excludes a character or range -If any characters in PATTERN have the text property `escaped' -set to true, then these characters will match themselves in the -resulting regular expression." +This function only considers in PATTERN that have the text property +`eshell-glob-char' set to t for conversion from glob to regexp syntax. +All other characters are treated as literals. See also +`eshell-parse-glob-chars' and `eshell-parse-glob-string'." (let ((matched-in-pattern 0) ; How much of PATTERN handled regexp) (while (string-match (eshell-glob-chars-regexp) @@ -209,7 +239,7 @@ resulting regular expression." (concat regexp (regexp-quote (substring pattern matched-in-pattern op-begin)))) - (if (get-text-property op-begin 'escaped pattern) + (if (not (eshell--glob-char-p pattern op-begin)) (setq regexp (concat regexp (regexp-quote (char-to-string op-char))) matched-in-pattern (1+ op-begin)) @@ -229,6 +259,7 @@ resulting regular expression." (defun eshell-glob-p (pattern) "Return non-nil if PATTERN has any special glob characters." + (declare (obsolete nil "31.1")) ;; "~" is an infix globbing character, so one at the start of a glob ;; must be a literal. (let ((start (if (string-prefix-p "~" pattern) 1 0))) @@ -249,8 +280,8 @@ include, and the second for ones to exclude." ;; Split the glob if it contains a negation like x~y. (while (and (eq incl glob) (setq index (string-search "~" glob index))) - (if (or (get-text-property index 'escaped glob) - (or (= (1+ index) len))) + (if (or (not (eshell--glob-char-p glob index)) + (= (1+ index) len)) (setq index (1+ index)) (setq incl (substring glob 0 index) excl (substring glob (1+ index))))) @@ -294,13 +325,18 @@ The result is a list of three elements: (setq start-dir (pop globs)) (setq start-dir (file-name-as-directory "."))) (while globs - (if-let* ((recurse (cdr (assoc (car globs) - eshell-glob-recursive-alist)))) + ;; "~" is an infix globbing character, so one at the start of a + ;; glob component must be a literal. + (when (eq (aref (car globs) 0) ?~) + (remove-text-properties 0 1 '(eshell-glob-char) (car globs))) + (if-let* ((recurse (cdr (assoc (car globs) eshell-glob-recursive-alist))) + ((eshell--all-glob-chars-p + (string-trim-right (car globs) "/")))) (if last-saw-recursion (setcar result recurse) (push recurse result) (setq last-saw-recursion t)) - (if (or result (eshell-glob-p (car globs))) + (if (or result (eshell--contains-glob-char-p (car globs))) (push (eshell-glob-convert-1 (car globs) (null (cdr globs))) result) ;; We haven't seen a glob yet, so instead append to the start @@ -312,6 +348,38 @@ The result is a list of three elements: (nreverse result) isdir))) +(defun eshell-expand-glob (glob) + "Return a list of files matched by GLOB. +Each globbing character in GLOB should have a non-nil value for the text +property `eshell-glob-char' (e.g. by `eshell-parse-glob-chars') in order +for it to have syntactic meaning; otherwise, this function treats the +character literally. + +This function is primarily intended for use within Eshell command +forms. If you want to use an ordinary string as a glob, use +`eshell-extended-glob' instead." + (let ((globs (eshell-glob-convert glob)) + eshell-glob-matches message-shown) + (unwind-protect + ;; After examining GLOB, make sure we actually got some globs + ;; before computing the results. We can get zero globs for + ;; remote file names using "~", like "/ssh:remote:~/file.txt". + ;; During Eshell argument parsing, we can't always be sure if + ;; the "~" is a home directory reference or part of a glob + ;; (e.g. if the argument was assembled from variables). + (when (cadr globs) + (apply #'eshell-glob-entries globs)) + (when message-shown + (message nil))) + (cond + (eshell-glob-matches + (sort eshell-glob-matches #'string<)) + ((and eshell-error-if-no-glob (cadr globs)) + (error "No matches found: %s" glob)) + (t + (let ((result (substring-no-properties glob))) + (if eshell-glob-splice-results (list result) result)))))) + (defun eshell-extended-glob (glob) "Return a list of files matched by GLOB. If no files match, signal an error (if `eshell-error-if-no-glob' @@ -327,26 +395,9 @@ syntax. Things that are not supported are: Mainly they are not supported because file matching is done with Emacs regular expressions, and these cannot support the above constructs." - (let ((globs (eshell-glob-convert glob)) - eshell-glob-matches message-shown) - (if (null (cadr globs)) - ;; If, after examining GLOB, there are no actual globs, just - ;; bail out. This can happen for remote file names using "~", - ;; like "/ssh:remote:~/file.txt". During parsing, we can't - ;; always be sure if the "~" is a home directory reference or - ;; part of a glob (e.g. if the argument was assembled from - ;; variables). - (if eshell-glob-splice-results (list glob) glob) - (unwind-protect - (apply #'eshell-glob-entries globs) - (if message-shown - (message nil))) - (or (and eshell-glob-matches (sort eshell-glob-matches #'string<)) - (if eshell-error-if-no-glob - (error "No matches found: %s" glob) - (if eshell-glob-splice-results - (list glob) - glob)))))) + (eshell-expand-glob (eshell-parse-glob-string glob))) + +(defconst eshell--glob-anything (eshell-parse-glob-string "*")) ;; FIXME does this really need to abuse eshell-glob-matches, message-shown? (defun eshell-glob-entries (path globs only-dirs) @@ -363,7 +414,7 @@ directories and files." (if (rassq (car globs) eshell-glob-recursive-alist) (setq recurse-p (car globs) glob (or (cadr globs) - (eshell-glob-convert-1 "*" t)) + (eshell-glob-convert-1 eshell--glob-anything t)) glob-remainder (cddr globs)) (setq glob (car globs) glob-remainder (cdr globs))) diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index 8bf2e20d320..e8cdb9c82c4 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -246,6 +246,17 @@ scope during the evaluation of TEST-SEXP." (declare-function eshell-extended-glob "em-glob" (glob)) (defvar eshell-error-if-no-glob) +(defvar eshell-glob-splice-results) + +(defun eshell-ls--expand-wildcards (file) + "Expand the shell wildcards in FILE if any." + (if (and (atom file) + (not (file-exists-p file))) + (let ((eshell-error-if-no-glob t) + ;; Ensure `eshell-extended-glob' returns a list. + (eshell-glob-splice-results t)) + (mapcar #'file-relative-name (eshell-extended-glob file))) + (list (file-relative-name file)))) (defun eshell-ls--insert-directory (orig-fun file switches &optional wildcard full-directory-p) @@ -277,13 +288,7 @@ instead." (require 'em-glob) (let* ((insert-func 'insert) (error-func 'insert) - (eshell-error-if-no-glob t) - (target ; Expand the shell wildcards if any. - (if (and (atom file) - (string-match "[[?*]" file) - (not (file-exists-p file))) - (mapcar #'file-relative-name (eshell-extended-glob file)) - (file-relative-name file))) + (target (eshell-ls--expand-wildcards file)) (switches (append eshell-ls-dired-initial-args (and (or (consp dired-directory) wildcard) (list "-d")) diff --git a/test/lisp/eshell/em-glob-tests.el b/test/lisp/eshell/em-glob-tests.el index 16ae9be1bce..57343eced6b 100644 --- a/test/lisp/eshell/em-glob-tests.el +++ b/test/lisp/eshell/em-glob-tests.el @@ -134,17 +134,19 @@ value of `eshell-glob-splice-results'." (ert-deftest em-glob-test/convert/current-start-directory () "Test converting a glob starting in the current directory." - (should (equal (eshell-glob-convert "*.el") + (should (equal (eshell-glob-convert (eshell-parse-glob-string "*.el")) '("./" (("\\`.*\\.el\\'" . "\\`\\.")) nil)))) (ert-deftest em-glob-test/convert/relative-start-directory () "Test converting a glob starting in a relative directory." - (should (equal (eshell-glob-convert "some/where/*.el") + (should (equal (eshell-glob-convert + (eshell-parse-glob-string "some/where/*.el")) '("./some/where/" (("\\`.*\\.el\\'" . "\\`\\.")) nil)))) (ert-deftest em-glob-test/convert/absolute-start-directory () "Test converting a glob starting in an absolute directory." - (should (equal (eshell-glob-convert "/some/where/*.el") + (should (equal (eshell-glob-convert + (eshell-parse-glob-string "/some/where/*.el")) '("/some/where/" (("\\`.*\\.el\\'" . "\\`\\.")) nil)))) (ert-deftest em-glob-test/convert/remote-start-directory () @@ -152,16 +154,30 @@ value of `eshell-glob-splice-results'." (skip-unless (eshell-tests-remote-accessible-p)) (let* ((default-directory ert-remote-temporary-file-directory) (remote (file-remote-p default-directory))) - (should (equal (eshell-glob-convert (format "%s/some/where/*.el" remote)) + (should (equal (eshell-glob-convert + (format (eshell-parse-glob-string "%s/some/where/*.el") + remote)) `(,(format "%s/some/where/" remote) (("\\`.*\\.el\\'" . "\\`\\.")) nil))))) -(ert-deftest em-glob-test/convert/quoted-start-directory () - "Test converting a glob starting in a quoted directory name." +(ert-deftest em-glob-test/convert/start-directory-with-spaces () + "Test converting a glob starting in a directory with spaces in its name." (should (equal (eshell-glob-convert - (concat (eshell-escape-arg "some where/") "*.el")) + (eshell-parse-glob-string "some where/*.el")) '("./some where/" (("\\`.*\\.el\\'" . "\\`\\.")) nil)))) +(ert-deftest em-glob-test/convert/literal-characters () + "Test converting a \"glob\" with only literal characters." + (should (equal (eshell-glob-convert "*.el") '("./*.el" nil nil))) + (should (equal (eshell-glob-convert "**/") '("./**/" nil t)))) + +(ert-deftest em-glob-test/convert/mixed-literal-characters () + "Test converting a glob with some literal characters." + (should (equal (eshell-glob-convert (eshell-parse-glob-string "\\*\\*/*.el")) + '("./**/" (("\\`.*\\.el\\'" . "\\`\\.")) nil))) + (should (equal (eshell-glob-convert (eshell-parse-glob-string "**/\\*.el")) + '("./" (recurse ("\\`\\*\\.el\\'" . "\\`\\.")) nil)))) + ;; Glob matching @@ -262,11 +278,11 @@ value of `eshell-glob-splice-results'." (ert-deftest em-glob-test/match-n-or-more-groups () "Test that \"(x)#\" and \"(x)#\" match zero or more instances of \"(x)\"." - (with-fake-files '("h.el" "ha.el" "hi.el" "hii.el" "dir/hi.el") - (should (equal (eshell-extended-glob "hi#.el") - '("h.el" "hi.el" "hii.el"))) - (should (equal (eshell-extended-glob "hi##.el") - '("hi.el" "hii.el"))))) + (with-fake-files '("h.el" "ha.el" "hi.el" "hah.el" "hahah.el" "dir/hah.el") + (should (equal (eshell-extended-glob "h(ah)#.el") + '("h.el" "hah.el" "hahah.el"))) + (should (equal (eshell-extended-glob "h(ah)##.el") + '("hah.el" "hahah.el"))))) (ert-deftest em-glob-test/match-n-or-more-character-sets () "Test that \"[x]#\" and \"[x]#\" match zero or more instances of \"[x]\"." @@ -300,11 +316,11 @@ value of `eshell-glob-splice-results'." (ert-deftest em-glob-test/no-matches () "Test behavior when a glob fails to match any files." (with-fake-files '("foo.el" "bar.el") - (should (equal (eshell-extended-glob "*.txt") - "*.txt")) + (should (equal-including-properties (eshell-extended-glob "*.txt") + "*.txt")) (let ((eshell-glob-splice-results t)) - (should (equal (eshell-extended-glob "*.txt") - '("*.txt")))) + (should (equal-including-properties (eshell-extended-glob "*.txt") + '("*.txt")))) (let ((eshell-error-if-no-glob t)) (should-error (eshell-extended-glob "*.txt"))))) commit 98e24e369a3f6bed95cdf0b32ee03999f5dfb98b Author: Jim Porter Date: Thu Oct 10 21:03:45 2024 -0700 Fix and improve behavior of 'eshell/clear' * lisp/eshell/esh-mode.el (eshell-clear): New function. (eshell/clear): Fix incorrect behavior, and do the right thing when 'eshell-scroll-show-maximum-output' is nil. (eshell/clear-scrollback): Call 'eshell/clear'. * test/lisp/eshell/esh-mode-tests.el (esh-mode-test/clear/eshell-command) (esh-mode-test/clear/eshell-command/erase) (esh-mode-test/clear/emacs-command) (esh-mode-test/clear/emacs-command/erase): New tests. * etc/NEWS: Mention the new 'eshell-command' (bug#73722). diff --git a/etc/NEWS b/etc/NEWS index d1c7303f976..dceece0a8c0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -241,6 +241,14 @@ It removes all the buttons in the specified region. ** Eshell +--- +*** New interactive command 'eshell-clear'. +This command scrolls the screen so that only the current prompt is +visible, optionally erasing all the previous input/output as well. +Previously, the Eshell built-in command 'eshell/clear' supported this +(e.g. to call it via 'M-x'), but this new command behaves more +consistently if you have a partially-typed command at the Eshell prompt. + --- *** New user option 'eshell-command-async-buffer'. This option lets you tell 'eshell-command' how to respond if its output diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 37a88fce790..c86e3cc002c 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -876,20 +876,61 @@ When run interactively, widen the buffer first." (goto-char (point-max)) (recenter -1)) -(defun eshell/clear (&optional scrollback) - "Scroll contents of eshell window out of sight, leaving a blank window. -If SCROLLBACK is non-nil, clear the scrollback contents." +(defun eshell-clear (&optional clear-scrollback) + "Scroll contents of the Eshell window out of sight, leaving a blank window. +If CLEAR-SCROLLBACK is non-nil (interactively, with the prefix +argument), clear the scrollback contents. + +Otherwise, the behavior depends on `eshell-scroll-show-maximum-output'. +If non-nil, fill newlines before the current prompt so that the prompt +is the last line in the window; if nil, just scroll the window so that +the prompt is the first line in the window." + (interactive "P") + (cond + (clear-scrollback + (let ((inhibit-read-only t)) + (widen) + (delete-region (point-min) (eshell-end-of-output)))) + (eshell-scroll-show-maximum-output + (save-excursion + (goto-char (eshell-end-of-output)) + (let ((inhibit-read-only t)) + (insert-and-inherit (make-string (window-size) ?\n)))) + (when (< (point) eshell-last-output-end) + (goto-char eshell-last-output-end))) + (t + (when (< (point) eshell-last-output-end) + (goto-char eshell-last-output-end)) + (set-window-start nil (eshell-end-of-output))))) + +(defun eshell/clear (&optional clear-scrollback) + "Scroll contents of the Eshell window out of sight, leaving a blank window. +If CLEAR-SCROLLBACK is non-nil, clear the scrollback contents. + +Otherwise, the behavior depends on `eshell-scroll-show-maximum-output'. +If non-nil, fill newlines before the current prompt so that the prompt +is the last line in the window; if nil, just scroll the window so that +the prompt is the first line in the window. + +This command is for use as an Eshell command (entered at the prompt); +for clearing the Eshell buffer from elsewhere (e.g. via +\\[execute-extended-command]), use `eshell-clear'." (interactive) - (if scrollback - (eshell/clear-scrollback) + (cond + ((null eshell-current-handles) + (eshell-clear clear-scrollback)) + (clear-scrollback + (let ((inhibit-read-only t)) + (erase-buffer))) + (eshell-scroll-show-maximum-output (let ((eshell-input-filter-functions nil)) - (insert (make-string (window-size) ?\n)) - (eshell-send-input)))) + (ignore (eshell-interactive-print (make-string (window-size) ?\n))))) + (t + (recenter 0)))) (defun eshell/clear-scrollback () - "Clear the scrollback content of the eshell window." - (let ((inhibit-read-only t)) - (erase-buffer))) + "Clear the scrollback content of the Eshell window." + (eshell/clear t)) (defun eshell-get-old-input (&optional use-current-region) "Return the command input on the current line. diff --git a/test/lisp/eshell/esh-mode-tests.el b/test/lisp/eshell/esh-mode-tests.el index 306e11ce445..28839eb65cf 100644 --- a/test/lisp/eshell/esh-mode-tests.el +++ b/test/lisp/eshell/esh-mode-tests.el @@ -26,6 +26,8 @@ (require 'ert) (require 'esh-mode) (require 'eshell) +(require 'em-banner) +(require 'em-prompt) (require 'eshell-tests-helpers (expand-file-name "eshell-tests-helpers" @@ -59,4 +61,44 @@ (eshell-match-command-output (format "(format \"hello%c%cp\")" ?\C-h ?\C-h) "\\`help\n"))) +(ert-deftest esh-mode-test/clear/eshell-command () + "Test that `eshell/clear' works as an Eshell command." + (let ((eshell-banner-message "") + (eshell-prompt-function (lambda () "$ "))) + (with-temp-eshell + (eshell-insert-command "echo hi") + (eshell-insert-command "clear") + (should (string-match "\\`\\$ echo hi\nhi\n\\$ clear\n+\\$ " + (buffer-string)))))) + +(ert-deftest esh-mode-test/clear/eshell-command/erase () + "Test that `eshell/clear' can erase the buffer." + (let ((eshell-banner-message "") + (eshell-prompt-function (lambda () "$ "))) + (with-temp-eshell + (eshell-insert-command "echo hi") + (eshell-insert-command "clear t") + (should (string-match "\\`\\$ " (buffer-string)))))) + +(ert-deftest esh-mode-test/clear/emacs-command () + "Test that `eshell-clear' works as an interactive Emacs command." + (let ((eshell-banner-message "") + (eshell-prompt-function (lambda () "$ "))) + (with-temp-eshell + (eshell-insert-command "echo hi") + (insert "echo b") + (eshell-clear) + (should (string-match "\\`\\$ echo hi\nhi\n\n+\\$ echo b" + (buffer-string)))))) + +(ert-deftest esh-mode-test/clear/emacs-command/erase () + "Test that `eshell-clear' can erase the buffer." + (let ((eshell-banner-message "") + (eshell-prompt-function (lambda () "$ "))) + (with-temp-eshell + (eshell-insert-command "echo hi") + (insert "echo b") + (eshell-clear t) + (should (string-match "\\`\\$ echo b" (buffer-string)))))) + ;; esh-mode-tests.el ends here commit 9ff155183ca560fc9005027a65c53544afb772a1 Author: Steven Allen Date: Thu Oct 31 16:19:37 2024 -0700 Remove undefined variable from c-ts-common.el This variable came from code copied from c-indent-new-comment-line. It's a parameter meant to be used by c-context-line-break, not a global variable. * lisp/progmodes/c-ts-common.el (c-ts-common-comment-indent-new-line): Remove reference to undefined variable. (Bug#74149) diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el index 5c7909ae858..cf55ddea8f7 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -336,7 +336,7 @@ and /* */ comments. SOFT works the same as in (delete-horizontal-space) (if soft (insert-and-inherit ?\n) - (newline (if allow-auto-fill nil 1)))))) + (newline 1))))) (cond ;; Line starts with //, or ///, or ////... ;; Or //! (used in rust). commit 94a9e40e82d4180563d7bddfa0cc6c8990824f8d Author: Dmitry Gutov Date: Fri Nov 1 02:32:10 2024 +0200 project-tests: Add test assertion for bug#73801 * test/lisp/progmodes/project-tests.el (project-vc-extra-root-markers-supports-wildcards): End with a check that we didn't cache a wrong value for parent (bug#73801). diff --git a/test/lisp/progmodes/project-tests.el b/test/lisp/progmodes/project-tests.el index 93943cef43b..1583732016b 100644 --- a/test/lisp/progmodes/project-tests.el +++ b/test/lisp/progmodes/project-tests.el @@ -138,7 +138,11 @@ When `project-ignores' includes a name matching project dir." (project (project-current nil dir))) (should-not (null project)) (should (nth 1 project)) - (should (string-match-p "/test/lisp/\\'" (project-root project))))) + (should (string-match-p "/test/lisp/\\'" (project-root project))) + ;; bug#73801 + (should (equal + project + (project-current nil (project-root project)))))) (ert-deftest project-vc-supports-project-in-different-dir () "Check that it picks up dir-locals settings from somewhere else." commit 33997047e891d5513c4f33ab78ad353746ed16e2 Author: Jim Porter Date: Thu Oct 31 10:37:24 2024 -0700 Don't remove trailing slash in Eshell "pwd" for remote root directories * lisp/eshell/em-dirs.el (eshell/pwd): Check if 'file-local-name' of the directory is the root dir. diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index 9cf0994fe78..ad0a5beac1e 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -319,14 +319,13 @@ Thus, this does not include the current directory.") (defun eshell/pwd () "Change output from `pwd' to be cleaner." - (let* ((path default-directory) - (len (length path))) - (if (and (> len 1) - (eq (aref path (1- len)) ?/) - (not (and (eshell-under-windows-p) - (string-match "\\`[A-Za-z]:[\\/]\\'" path)))) - (setq path (substring path 0 (1- (length path))))) - (funcall (or eshell-pwd-convert-function #'identity) path))) + (let ((dir default-directory)) + (when (and (eq (aref dir (1- (length dir))) ?/) + (not (and (eshell-under-windows-p) + (string-match "\\`[A-Za-z]:[\\/]\\'" dir))) + (length> (file-local-name dir) 1)) + (setq dir (substring dir 0 -1))) + (funcall (or eshell-pwd-convert-function #'identity) dir))) (defun eshell-expand-multiple-dots (filename) ;; FIXME: This advice recommendation is rather odd: it's somewhat commit 9fe7b8ca418002c6b253a8cb154edb1da24a8643 Author: Robert Pluim Date: Thu Oct 31 16:26:17 2024 +0100 ; * lisp/vc/smerge-mode.el: Fix typo in comment. diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index e6bfc5e64f3..09d9ebda21b 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -168,7 +168,7 @@ Used in `smerge-diff-base-upper' and related functions." (const :tag "none" "") string)) -;; Make it so `C-x ^ n' doesn't insert `n' but just signals an error +;; Make it so `C-c ^ n' doesn't insert `n' but just signals an error ;; when SMerge mode is not enabled (bug#73544). ;;;###autoload (global-set-key "\C-c^" (make-sparse-keymap)) commit bf395fd8bcc68499479cd6df31319eca93509359 Author: Cecilio Pardo Date: Sun Oct 27 14:39:34 2024 +0100 Fix 'yank-media' to allow yanking SVG data * lisp/net/mailcap.el (mailcap-mime-type-to-extension): Return "svg" for mime type 'image/svg+xml'. Org-mode uses this. * lisp/yank-media.el (yank-media--find-matching-media): If svg is supported, don't filter out 'image/svg+xml'. (Bug#74044) diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index 3e847c758c2..d3ca899216a 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -1084,10 +1084,17 @@ For instance, \"foo.png\" will result in \"image/png\"." (defun mailcap-mime-type-to-extension (mime-type) "Return a file name extension based on a MIME-TYPE. For instance, `image/png' will result in `png'." - (intern (cadr (split-string (if (symbolp mime-type) - (symbol-name mime-type) - mime-type) - "/")))) + (intern + (let ((e (cadr (split-string (if (symbolp mime-type) + (symbol-name mime-type) + mime-type) + "/")))) + ;; Usually, the normal extension is the same as the MIME subtype. + ;; But for SVG files, the extension is "svg" and the MIME type is + ;; "svg+xml". + (if (string= e "svg+xml") + "svg" + e)))) (defun mailcap-mime-types () "Return a list of MIME media types." diff --git a/lisp/yank-media.el b/lisp/yank-media.el index 6655bb705ef..17981c37c0e 100644 --- a/lisp/yank-media.el +++ b/lisp/yank-media.el @@ -67,7 +67,12 @@ all the different selection types." (lambda (type) (pcase-let ((`(,major ,minor) (split-string (symbol-name type) "/"))) (if (and (equal major "image") - (not (image-type-available-p (intern minor)))) + (not (image-type-available-p + ;; Usually, MIME subtype is the same as Emacs' + ;; identifier for an image type. But for SVG, the + ;; identifier is 'svg, while the MIME type is + ;; image/svg+xml. So we make the exception here. + (intern (if (string= minor "svg+xml") "svg" minor))))) ;; Just filter out all the image types that Emacs doesn't ;; support, because the clipboard is full of things like ;; `image/x-win-bitmap'. commit 9c5b6e88e7f851e239721a0fd855fbcd10b5b0a3 Author: Augusto Stoffel Date: Sat Oct 12 16:20:47 2024 +0200 shr.el: Define rendering rule for math tag * lisp/net/shr.el (shr-tag-math): New function, see bug#73641. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 4869969f463..6d8b235a2b8 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -2264,6 +2264,18 @@ BASE is the URL of the HTML being rendered." (shr-generic dom) (insert ?\N{POP DIRECTIONAL ISOLATE})) +(defun shr-tag-math (dom) + ;; Sometimes a math element contains a plain text annotation + ;; (typically TeX notation) in addition to MathML markup. If we pass + ;; that to `dom-generic', the formula is printed twice. So we select + ;; only the annotation if available. + (shr-generic + (thread-first + dom + (dom-child-by-tag 'semantics) + (dom-child-by-tag 'annotation) + (or dom)))) + ;;; Outline Support (defun shr-outline-search (&optional bound move backward looking-at) "A function that can be used as `outline-search-function' for rendered html. commit f6c359cb66a0e9b851e3467b1ba9cab7efa8f744 Author: Stephen Berman Date: Thu Oct 31 10:46:27 2024 +0100 Fix bugs in dabbrev-expand (bug#74090) * lisp/dabbrev.el (dabbrev-expand): Use the buffer where the expansion was found when setting the internal variables used to determine the next expansion or a replacement expansion. * test/lisp/dabbrev-tests.el (ert-x): Require for 'ert-with-temp-directory', 'ert-resource-directory' and 'ert-resource-file'. (with-dabbrev-test): New macro. (dabbrev-expand-test-same-buffer-{1,2,3,4}) (dabbrev-expand-test-other-buffer-{1,2,3,4}) (dabbrev-expand-test-minibuffer-{1,2,3,4}): New tests. * test/lisp/dabbrev-resources/dabbrev-expand.el: * test/lisp/dabbrev-resources/INSTALL_BEGIN: New test resources. diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index 7b6cbb78cef..bbe6a64b626 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -464,8 +464,21 @@ direction of search to backward if set non-nil. See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]." (interactive "*P") - (let (abbrev record-case-pattern - expansion old direction (orig-point (point))) + ;; There are three possible sources of the expansion, which we need to + ;; check in a specific order: + (let ((buf (cond ((window-minibuffer-p) + ;; If we invoked dabbrev-expand in the minibuffer, + ;; this is the buffer from which we entered the + ;; minibuffer. + (window-buffer (get-mru-window))) + ;; Otherwise, if we found the expansion in another + ;; buffer, use that buffer for further expansions. + (dabbrev--last-buffer-found dabbrev--last-buffer-found) + ;; Otherwise, use the buffer where we invoked + ;; dabbrev-expand. + (t (current-buffer)))) + abbrev record-case-pattern expansion old direction + (orig-point (point))) ;; abbrev -- the abbrev to expand ;; expansion -- the expansion found (eventually) or nil until then ;; old -- the text currently in the buffer @@ -480,6 +493,7 @@ See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]." (point))))) ;; Find a different expansion for the same abbrev as last time. (progn + (setq dabbrev--last-buffer-found nil) (setq abbrev dabbrev--last-abbreviation) (setq old dabbrev--last-expansion) (setq direction dabbrev--last-direction)) @@ -488,7 +502,14 @@ See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]." (if (and (eq (preceding-char) ?\s) (markerp dabbrev--last-abbrev-location) (marker-position dabbrev--last-abbrev-location) - (= (point) (1+ dabbrev--last-abbrev-location))) + ;; Comparing with point only makes sense in the buffer + ;; where we called dabbrev-expand, but if that differs + ;; from the buffer containing the expansion, we want to + ;; get the next word in the latter buffer, so we skip + ;; the comparison. + (if (eq buf (current-buffer)) + (= (point) (1+ dabbrev--last-abbrev-location)) + t)) (progn ;; The "abbrev" to expand is just the space. (setq abbrev " ") @@ -549,29 +570,43 @@ See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]." (if old " further" "") abbrev)) (t (if (not (or (eq dabbrev--last-buffer dabbrev--last-buffer-found) - (minibuffer-window-active-p (selected-window)))) + ;; If we are in the minibuffer and an expansion has + ;; been found but dabbrev--last-buffer-found is not + ;; yet set, we need to set it now. + (and dabbrev--last-buffer-found + (minibuffer-window-active-p (selected-window))))) (progn (when (buffer-name dabbrev--last-buffer) (message "Expansion found in `%s'" (buffer-name dabbrev--last-buffer))) (setq dabbrev--last-buffer-found dabbrev--last-buffer)) (message nil)) - (if (and (or (eq (current-buffer) dabbrev--last-buffer) - (null dabbrev--last-buffer) - (buffer-live-p dabbrev--last-buffer)) - (numberp dabbrev--last-expansion-location) - (and (> dabbrev--last-expansion-location (point)))) - (setq dabbrev--last-expansion-location - (copy-marker dabbrev--last-expansion-location))) + ;; To get correct further expansions we have to be sure to use the + ;; buffer containing the already found expansions. + (when dabbrev--last-buffer-found + (setq buf dabbrev--last-buffer-found)) + ;; If the buffer where we called dabbrev-expand differs from the + ;; buffer containing the expansion, make sure copy-marker is + ;; called in the latter buffer. + (with-current-buffer buf + (if (and (or (eq (current-buffer) dabbrev--last-buffer) + (null dabbrev--last-buffer) + (buffer-live-p dabbrev--last-buffer)) + (numberp dabbrev--last-expansion-location) + (and (> dabbrev--last-expansion-location (point)))) + (setq dabbrev--last-expansion-location + (copy-marker dabbrev--last-expansion-location)))) ;; Success: stick it in and return. (setq buffer-undo-list (cons orig-point buffer-undo-list)) (setq expansion (dabbrev--substitute-expansion old abbrev expansion record-case-pattern)) - ;; Save state for re-expand. - (setq dabbrev--last-expansion expansion) - (setq dabbrev--last-abbreviation abbrev) - (setq dabbrev--last-abbrev-location (point-marker)))))) + ;; Save state for re-expand (making sure it's the state of the + ;; buffer containing the already found expansions). + (with-current-buffer buf + (setq dabbrev--last-expansion expansion) + (setq dabbrev--last-abbreviation abbrev) + (setq dabbrev--last-abbrev-location (point-marker))))))) ;;---------------------------------------------------------------- ;; Local functions diff --git a/test/lisp/dabbrev-resources/INSTALL_BEGIN b/test/lisp/dabbrev-resources/INSTALL_BEGIN new file mode 100644 index 00000000000..6309419dccf --- /dev/null +++ b/test/lisp/dabbrev-resources/INSTALL_BEGIN @@ -0,0 +1,153 @@ +GNU Emacs Installation Guide +Copyright (C) 1992, 1994, 1996-1997, 2000-2024 Free Software Foundation, +Inc. +See the end of the file for license conditions. + + +This file contains general information on building GNU Emacs. If you +are building an Emacs release tarball on a Unix or a GNU system, the +instructions in this file should be sufficient. For other +configurations, we have additional specialized files: + + . INSTALL.REPO if you build from a Git checkout + . nt/INSTALL if you build for MS-Windows + . nextstep/INSTALL if you build for GNUstep/macOS + . java/INSTALL if you build for Android + . msdos/INSTALL if you build for MS-DOS + + +BASIC INSTALLATION + +On most Unix systems, you build Emacs by first running the 'configure' +shell script. This attempts to deduce the correct values for +various system-dependent variables and features, and find the +directories where certain system headers and libraries are kept. +In a few cases, you may need to explicitly tell configure where to +find some things, or what options to use. + +'configure' creates a 'Makefile' in several subdirectories, and a +'src/config.h' file containing system-dependent definitions. +Running the 'make' utility then builds the package for your system. + +Building Emacs requires GNU make, . +On most systems that Emacs supports, this is the default 'make' program. + +Here's the procedure to build Emacs using 'configure' on systems which +are supported by it. In some cases, if the simplified procedure fails, +you might need to use various non-default options, and maybe perform +some of the steps manually. The more detailed description in the other +sections of this guide will help you do that, so please refer to those +sections if you need to. + + 1. Obtain and unpack the Emacs release, with commands like this: + + wget https://ftp.gnu.org/gnu/emacs/emacs-VERSION.tar.xz + tar -xf emacs-VERSION.tar.xz + + where VERSION is the Emacs version number. + + 2a. 'cd' to the directory where you unpacked Emacs and invoke the + 'configure' script: + + ./configure + + 2b. Alternatively, create a separate directory, outside the source + directory, where you want to build Emacs, and invoke 'configure' + from there: + + SOURCE-DIR/configure + + where SOURCE-DIR is the top-level Emacs source directory. + + 2c. If you don't have write access to the default directory where + Emacs and its data files will be installed, specify an alternative + installation directory: + + ./configure --prefix=/SOME/OTHER/DIRECTORY + + where /SOME/OTHER/DIRECTORY is a directory writable by your user, + for example, a subdirectory of your home directory. + + 3. When 'configure' finishes, it prints several lines of details + about the system configuration. Read those details carefully + looking for anything suspicious, such as wrong CPU and operating + system names, wrong places for headers or libraries, missing + libraries that you know are installed on your system, etc. + + If you find anything wrong, you may have to pass to 'configure' + one or more options specifying the explicit machine configuration + name, where to find various headers and libraries, etc. + Refer to the section DETAILED BUILDING AND INSTALLATION below. + + If 'configure' didn't find some image support libraries, such as + Xpm and jpeg, refer to "Image support libraries" below. + + If the details printed by 'configure' don't make any sense to + you, but there are no obvious errors, assume that 'configure' did + its job and proceed. + + 4. Invoke the 'make' program: + + make + + 5. If 'make' succeeds, it will build an executable program 'emacs' + in the 'src' directory. You can try this program, to make sure + it works: + + src/emacs -Q + + To test Emacs further (intended mostly to help developers): + + make check + + 6. Assuming that the program 'src/emacs' starts and displays its + opening screen, you can install the program and its auxiliary + files into their installation directories: + + make install + + You are now ready to use Emacs. If you wish to conserve space, + you may remove the program binaries and object files from the + directory where you built Emacs: + + make clean + + You can delete the entire build directory if you do not plan to + build Emacs again, but it can be useful to keep for debugging. + If you want to build Emacs again with different configure options, + first clean the source directories: + + make distclean + + Note that the install automatically saves space by compressing + (provided you have the 'gzip' program) those installed Lisp source (.el) + files that have corresponding .elc versions, as well as the Info files. + + You can read a brief summary about common make targets: + + make help + + +ADDITIONAL DISTRIBUTION FILES + +* Complex Text Layout support libraries + +On GNU and Unix systems, Emacs needs optional libraries to correctly +display such complex scripts as Indic and Khmer, and also for scripts +that require Arabic shaping support (Arabic and Farsi). If the +HarfBuzz library is installed, Emacs will build with it and use it for +this purpose. HarfBuzz is the preferred shaping engine, both on Posix +hosts and on MS-Windows, so we recommend installing it before building +Emacs. The alternative for GNU/Linux and Posix systems is to use the +"m17n-db", "libm17n-flt", and "libotf" libraries. (On some systems, +particularly GNU/Linux, these libraries may be already present or +available as additional packages.) Note that if there is a separate +'dev' or 'devel' package, for use at compilation time rather than run +time, you will need that as well as the corresponding run time +package; typically the dev package will contain header files and a +library archive. On MS-Windows, if HarfBuzz is not available, Emacs +will use the Uniscribe shaping engine that is part of the OS. + +Note that Emacs cannot support complex scripts on a TTY, unless the +terminal includes such a support. However, most modern terminal +emulators, such as xterm, do support such scripts. diff --git a/test/lisp/dabbrev-resources/dabbrev-expand.el b/test/lisp/dabbrev-resources/dabbrev-expand.el new file mode 100644 index 00000000000..c986b0ed633 --- /dev/null +++ b/test/lisp/dabbrev-resources/dabbrev-expand.el @@ -0,0 +1,132 @@ +(defun dabbrev-expand (arg) + "Expand previous word \"dynamically\". + +Expands to the most recent, preceding word for which this is a prefix. +If no suitable preceding word is found, words following point are +considered. If still no suitable word is found, then look in the +buffers accepted by the function pointed out by variable +`dabbrev-friend-buffer-function', if `dabbrev-check-other-buffers' +says so. Then, if `dabbrev-check-all-buffers' is non-nil, look in +all the other buffers, subject to constraints specified +by `dabbrev-ignored-buffer-names' and `dabbrev-ignored-buffer-regexps'. + +A positive prefix argument, N, says to take the Nth backward *distinct* +possibility. A negative argument says search forward. + +If the cursor has not moved from the end of the previous expansion and +no argument is given, replace the previously-made expansion +with the next possible expansion not yet tried. + +The variable `dabbrev-backward-only' may be used to limit the +direction of search to backward if set non-nil. + +See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]." + (interactive "*P") + (let (abbrev record-case-pattern + expansion old direction (orig-point (point))) + ;; abbrev -- the abbrev to expand + ;; expansion -- the expansion found (eventually) or nil until then + ;; old -- the text currently in the buffer + ;; (the abbrev, or the previously-made expansion) + (save-excursion + (if (and (null arg) + (markerp dabbrev--last-abbrev-location) + (marker-position dabbrev--last-abbrev-location) + (or (eq last-command this-command) + (and (window-minibuffer-p) + (= dabbrev--last-abbrev-location + (point))))) + ;; Find a different expansion for the same abbrev as last time. + (progn + (setq abbrev dabbrev--last-abbreviation) + (setq old dabbrev--last-expansion) + (setq direction dabbrev--last-direction)) + ;; If the user inserts a space after expanding + ;; and then asks to expand again, always fetch the next word. + (if (and (eq (preceding-char) ?\s) + (markerp dabbrev--last-abbrev-location) + (marker-position dabbrev--last-abbrev-location) + (= (point) (1+ dabbrev--last-abbrev-location))) + (progn + ;; The "abbrev" to expand is just the space. + (setq abbrev " ") + (save-excursion + (save-restriction + (widen) + (if (buffer-live-p dabbrev--last-buffer) + (set-buffer dabbrev--last-buffer)) + ;; Find the end of the last "expansion" word. + (if (or (eq dabbrev--last-direction 1) + (and (eq dabbrev--last-direction 0) + (< dabbrev--last-expansion-location (point)))) + (setq dabbrev--last-expansion-location + (+ dabbrev--last-expansion-location + (length dabbrev--last-expansion)))) + (goto-char dabbrev--last-expansion-location) + ;; Take the following word, with intermediate separators, + ;; as our expansion this time. + (re-search-forward + (concat "\\(?:" dabbrev--abbrev-char-regexp "\\)+")) + (setq expansion (buffer-substring-no-properties + dabbrev--last-expansion-location (point))) + + ;; Record the end of this expansion, in case we repeat this. + (setq dabbrev--last-expansion-location (point)))) + ;; Indicate that dabbrev--last-expansion-location is + ;; at the end of the expansion. + (setq dabbrev--last-direction -1)) + + ;; We have a different abbrev to expand. + (dabbrev--reset-global-variables) + (setq direction (if (null arg) + (if dabbrev-backward-only 1 0) + (prefix-numeric-value arg))) + (setq abbrev (dabbrev--abbrev-at-point)) + (setq record-case-pattern t) + (setq old nil))) + + ;;-------------------------------- + ;; Find the expansion + ;;-------------------------------- + (or expansion + (setq expansion + (dabbrev--find-expansion + abbrev direction + (dabbrev--ignore-case-p abbrev))))) + (cond + ((not expansion) + (dabbrev--reset-global-variables) + (if old + (save-excursion + (setq buffer-undo-list (cons orig-point buffer-undo-list)) + ;; Put back the original abbrev with its original case pattern. + (search-backward old) + (insert abbrev) + (delete-region (point) (+ (point) (length old))))) + (user-error "No%s dynamic expansion for `%s' found" + (if old " further" "") abbrev)) + (t + (if (not (or (eq dabbrev--last-buffer dabbrev--last-buffer-found) + (minibuffer-window-active-p (selected-window)))) + (progn + (when (buffer-name dabbrev--last-buffer) + (message "Expansion found in `%s'" + (buffer-name dabbrev--last-buffer))) + (setq dabbrev--last-buffer-found dabbrev--last-buffer)) + (message nil)) + (if (and (or (eq (current-buffer) dabbrev--last-buffer) + (null dabbrev--last-buffer) + (buffer-live-p dabbrev--last-buffer)) + (numberp dabbrev--last-expansion-location) + (and (> dabbrev--last-expansion-location (point)))) + (setq dabbrev--last-expansion-location + (copy-marker dabbrev--last-expansion-location))) + ;; Success: stick it in and return. + (setq buffer-undo-list (cons orig-point buffer-undo-list)) + (setq expansion (dabbrev--substitute-expansion old abbrev expansion + record-case-pattern)) + + ;; Save state for re-expand. + (setq dabbrev--last-expansion expansion) + (setq dabbrev--last-abbreviation abbrev) + (setq dabbrev--last-abbrev-location (point-marker)))))) diff --git a/test/lisp/dabbrev-tests.el b/test/lisp/dabbrev-tests.el index c7574403949..987106aa5af 100644 --- a/test/lisp/dabbrev-tests.el +++ b/test/lisp/dabbrev-tests.el @@ -25,6 +25,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'dabbrev) (ert-deftest dabbrev-expand-test () @@ -68,4 +69,210 @@ multiple expansions." (execute-kbd-macro (kbd "C-u C-u C-M-/"))) (should (string= (buffer-string) "abc\na"))))) +(defmacro with-dabbrev-test (&rest body) + "Set up an isolated `dabbrev' test environment." + (declare (debug (body))) + `(ert-with-temp-directory dabbrev-test-home + (let* (;; Since we change HOME, clear this to avoid a conflict + ;; e.g. if Emacs runs within the user's home directory. + (abbreviated-home-dir nil) + (process-environment (cons (format "HOME=%s" dabbrev-test-home) + process-environment)) + (dabbrev-directory (ert-resource-directory))) + (unwind-protect + (progn ,@body) + ;; Restore pre-test-run state of test files. + (dolist (f (directory-files dabbrev-directory)) + (let ((buf (get-file-buffer f))) + (when buf + (with-current-buffer buf + (restore-buffer-modified-p nil) + (kill-buffer))))) + (dabbrev--reset-global-variables))))) + +(ert-deftest dabbrev-expand-test-same-buffer-1 () + "Test expanding a string twice within a single buffer. +The first expansion should expand the input (a prefix-string) to a +string in the buffer containing no whitespace character, the second +expansion, after adding a space to the first expansion, should extend +the string with the following string in the buffer up to the next +whitespace character." + (with-dabbrev-test + (find-file (ert-resource-file "INSTALL_BEGIN")) + (goto-char (point-max)) + (terpri) + (execute-kbd-macro (kbd "Ind M-/")) + (should (string= (buffer-substring (pos-bol) (pos-eol)) "Indic")) + (execute-kbd-macro (kbd "SPC M-/")) + (should (string= (buffer-substring (pos-bol) (pos-eol)) "Indic and")))) + +(ert-deftest dabbrev-expand-test-same-buffer-2 () + "Test expanding a string plus space twice within a single buffer. +Each expansion should extend the string with the following string in the +buffer up to the next whitespace character." + (with-dabbrev-test + (find-file (ert-resource-file "INSTALL_BEGIN")) + (goto-char (point-max)) + (terpri) + (execute-kbd-macro (kbd "Indic SPC M-/")) + (should (string= (buffer-substring (pos-bol) (pos-eol)) "Indic and")) + (execute-kbd-macro (kbd "SPC M-/")) + (should (string= (buffer-substring (pos-bol) (pos-eol)) "Indic and Khmer")))) + +(ert-deftest dabbrev-expand-test-same-buffer-3 () + "Test replacing an expansion within a single buffer." + (with-dabbrev-test + (find-file (ert-resource-file "INSTALL_BEGIN")) + (goto-char (point-max)) + (terpri) + (insert-file-contents (ert-resource-file "dabbrev-expand.el")) + (goto-char (point-max)) + (terpri) + (execute-kbd-macro (kbd "Ind M-/")) + (should (string= (buffer-substring (pos-bol) (pos-eol)) "Indicate")) + (kill-whole-line) + (execute-kbd-macro (kbd "Ind M-/ M-/")) + (should (string= (buffer-substring (pos-bol) (pos-eol)) "Indic")) + (execute-kbd-macro (kbd "SPC M-/")) + (should (string= (buffer-substring (pos-bol) (pos-eol)) "Indic and")))) + +(ert-deftest dabbrev-expand-test-same-buffer-4 () + "Test expanding a string in a narrowed-region." + (with-dabbrev-test + (let (disabled-command-function) ; Enable narrow-to-region. + (find-file (ert-resource-file "INSTALL_BEGIN")) + (goto-char (point-min)) + (execute-kbd-macro (kbd "C-s Ind M-a C-SPC M-} C-x n n")) + (goto-char (point-max)) + (terpri) + (execute-kbd-macro (kbd "Ind M-/")) + (should (string= (buffer-substring (pos-bol) (pos-eol)) "Indic")) + (execute-kbd-macro (kbd "SPC M-/")) + (should (string= (buffer-substring (pos-bol) (pos-eol)) "Indic and"))))) + +(ert-deftest dabbrev-expand-test-other-buffer-1 () + "Test expanding a prefix string to a string from another buffer." + (with-dabbrev-test + (find-file (ert-resource-file "INSTALL_BEGIN")) + (switch-to-buffer (get-buffer-create "a" t)) + (execute-kbd-macro (kbd "Ind M-/")) + (should (string= (buffer-string) "Indic")) + (execute-kbd-macro (kbd "SPC M-/")) + (should (string= (buffer-string) "Indic and")) + (kill-buffer "a"))) + +(ert-deftest dabbrev-expand-test-other-buffer-2 () + "Test expanding a string + space to a string from another buffer." + (with-dabbrev-test + (find-file (ert-resource-file "INSTALL_BEGIN")) + (switch-to-buffer (get-buffer-create "a" t)) + (execute-kbd-macro (kbd "Indic SPC M-/")) + (should (string= (buffer-string) "Indic and")) + (execute-kbd-macro (kbd "SPC M-/")) + (should (string= (buffer-string) "Indic and Khmer")) + (kill-buffer "a"))) + +(ert-deftest dabbrev-expand-test-other-buffer-3 () + "Test replacing an expansion with three different buffers. +A prefix string in a buffer should find the first expansion in a +different buffer and then find a replacement expansion is yet another +buffer." + (with-dabbrev-test + (find-file (ert-resource-file "INSTALL_BEGIN")) + (find-file (ert-resource-file "dabbrev-expand.el")) + (switch-to-buffer (get-buffer-create "a" t)) + (emacs-lisp-mode) + (execute-kbd-macro (kbd "Ind M-/")) + (should (string= (buffer-string) "Indicate")) + (erase-buffer) + (execute-kbd-macro (kbd "Ind M-/ M-/")) + (should (string= (buffer-string) "Indic")) + (execute-kbd-macro (kbd "SPC M-/")) + (should (string= (buffer-string) "Indic and")) + (kill-buffer "a"))) + +(ert-deftest dabbrev-expand-test-other-buffer-4 () + "Test expanding a string using another narrowed buffer." + (with-dabbrev-test + (let (disabled-command-function) ; Enable narrow-to-region. + (find-file (ert-resource-file "INSTALL_BEGIN")) + (goto-char (point-min)) + (execute-kbd-macro (kbd "C-s Ind M-a C-SPC M-} C-x n n")) + (switch-to-buffer (get-buffer-create "a" t)) + (execute-kbd-macro (kbd "Ind M-/")) + (should (string= (buffer-string) "Indic")) + (execute-kbd-macro (kbd "SPC M-/")) + (should (string= (buffer-string) "Indic and")) + (kill-buffer "a")))) + +(ert-deftest dabbrev-expand-test-minibuffer-1 () + "Test expanding a prefix string twice in the minibuffer. +Both expansions should come from the buffer from which the minibuffer +was entered." + (with-dabbrev-test + (find-file (ert-resource-file "INSTALL_BEGIN")) + (with-selected-window (minibuffer-window) + (insert "Ind") + (dabbrev-expand nil) + (should (string= (minibuffer-contents) "Indic")) + (insert " ") + (dabbrev-expand nil) + (should (string= (minibuffer-contents) "Indic and")) + (delete-minibuffer-contents)))) + +(ert-deftest dabbrev-expand-test-minibuffer-2 () + "Test expanding a string + space in the minibuffer. +The expansions should come from the buffer from which the minibuffer was +entered." + (with-dabbrev-test + (find-file (ert-resource-file "INSTALL_BEGIN")) + (with-selected-window (minibuffer-window) + (insert "Indic ") + (dabbrev-expand nil) + (should (string= (minibuffer-contents) "Indic and")) + (insert " ") + (dabbrev-expand nil) + (should (string= (buffer-string) "Indic and Khmer")) + (delete-minibuffer-contents)))) + +;; FIXME: Why is dabbrev--reset-global-variables needed here? +(ert-deftest dabbrev-expand-test-minibuffer-3 () + "Test replacing an expansion in the minibuffer using two buffers. +The first expansion should befound in the buffer from which the +minibuffer was entered, the replacement should found in another buffer." + (with-dabbrev-test + (find-file (ert-resource-file "INSTALL_BEGIN")) + (find-file (ert-resource-file "dabbrev-expand.el")) + (with-selected-window (minibuffer-window) + (insert "Ind") + (dabbrev-expand nil) + (should (string= (minibuffer-contents) "Indicate")) + (kill-whole-line) + (dabbrev--reset-global-variables) + (insert "Ind") + (dabbrev-expand nil) + (dabbrev-expand nil) + (should (string= (minibuffer-contents) "Indic")) + (dabbrev--reset-global-variables) + (insert " ") + (dabbrev-expand nil) + (should (string= (minibuffer-contents) "Indic and")) + (delete-minibuffer-contents)))) + +(ert-deftest dabbrev-expand-test-minibuffer-4 () + "Test expansion in the minibuffer using another narrowed buffer." + (with-dabbrev-test + (let (disabled-command-function) ; Enable narrow-to-region. + (find-file (ert-resource-file "INSTALL_BEGIN")) + (goto-char (point-min)) + (execute-kbd-macro (kbd "C-s Ind M-a C-SPC M-} C-x n n"))) + (with-selected-window (minibuffer-window) + (insert "Ind") + (dabbrev-expand nil) + (should (string= (minibuffer-contents) "Indic")) + (insert " ") + (dabbrev-expand nil) + (should (string= (minibuffer-contents) "Indic and")) + (delete-minibuffer-contents)))) + ;;; dabbrev-tests.el ends here