[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master a92a027: Quote filenames containing '~' in prompts
From: |
Noam Postavsky |
Subject: |
[Emacs-diffs] master a92a027: Quote filenames containing '~' in prompts |
Date: |
Mon, 12 Dec 2016 02:55:46 +0000 (UTC) |
branch: master
commit a92a027d58cb4df5bb6c7e3c546a72183a192f45
Author: Noam Postavsky <address@hidden>
Commit: Noam Postavsky <address@hidden>
Quote filenames containing '~' in prompts
When in a directory named '~', the default value given by
`read-file-name' should be quoted by prepending '/:', in order to
prevent it from being interpreted as referring to the $HOME
directory (Bug#16984).
* lisp/minibuffer.el (minibuffer-maybe-quote-filename): New function.
(completion--sifn-requote, read-file-name-default): Use it instead of
`minibuffer--double-dollars'.
* test/lisp/files-tests.el (files-test-read-file-in-~): Test it.
---
lisp/minibuffer.el | 25 ++++++++++++++++++-------
test/lisp/files-tests.el | 23 +++++++++++++++++++++++
2 files changed, 41 insertions(+), 7 deletions(-)
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 175189c..576b804 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -2251,6 +2251,17 @@ This is only used when the minibuffer area has no active
minibuffer.")
(replace-regexp-in-string "\\$" (lambda (dollar) (concat dollar dollar))
str))
+(defun minibuffer-maybe-quote-filename (filename)
+ "Protect FILENAME from `substitute-in-file-name', as needed.
+Useful to give the user default values that won't be substituted."
+ (if (and (not (file-name-quoted-p filename))
+ (file-name-absolute-p filename)
+ (string-match-p (if (memq system-type '(windows-nt ms-dos))
+ "[/\\\\]~" "/~")
+ (file-local-name filename)))
+ (file-name-quote filename)
+ (minibuffer--double-dollars filename)))
+
(defun completion--make-envvar-table ()
(mapcar (lambda (enventry)
(substring enventry 0 (string-match-p "=" enventry)))
@@ -2420,7 +2431,7 @@ same as `substitute-in-file-name'."
(substitute-in-file-name
(substring qstr 0 (1- qpos)))))
(setq qpos (1- qpos)))
- (cons qpos #'minibuffer--double-dollars))))
+ (cons qpos #'minibuffer-maybe-quote-filename))))
(defalias 'completion--file-name-table
(completion-table-with-quoting #'completion-file-name-table
@@ -2596,10 +2607,10 @@ See `read-file-name' for the meaning of the arguments."
(let ((insdef (cond
((and insert-default-directory (stringp dir))
(if initial
- (cons (minibuffer--double-dollars (concat dir initial))
- (length (minibuffer--double-dollars dir)))
- (minibuffer--double-dollars dir)))
- (initial (cons (minibuffer--double-dollars initial) 0)))))
+ (cons (minibuffer-maybe-quote-filename (concat dir
initial))
+ (length (minibuffer-maybe-quote-filename dir)))
+ (minibuffer-maybe-quote-filename dir)))
+ (initial (cons (minibuffer-maybe-quote-filename initial)
0)))))
(let ((completion-ignore-case read-file-name-completion-ignore-case)
(minibuffer-completing-file-name t)
@@ -2693,7 +2704,7 @@ See `read-file-name' for the meaning of the arguments."
;; with what we will actually return. As an exception,
;; if that's the same as the second item in
;; file-name-history, it's really a repeat (Bug#4657).
- (let ((val1 (minibuffer--double-dollars val)))
+ (let ((val1 (minibuffer-maybe-quote-filename val)))
(if history-delete-duplicates
(setcdr file-name-history
(delete val1 (cdr file-name-history))))
@@ -2703,7 +2714,7 @@ See `read-file-name' for the meaning of the arguments."
(if add-to-history
;; Add the value to the history--but not if it matches
;; the last value already there.
- (let ((val1 (minibuffer--double-dollars val)))
+ (let ((val1 (minibuffer-maybe-quote-filename val)))
(unless (and (consp file-name-history)
(equal (car file-name-history) val1))
(setq file-name-history
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 80d5e5b..f4ccd5c 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -220,5 +220,28 @@ form.")
(should-not yes-or-no-p-prompts)
(should (equal kill-emacs-args '(nil)))))
+(ert-deftest files-test-read-file-in-~ ()
+ "Test file prompting in directory named '~'.
+If we are in a directory named '~', the default value should not
+be $HOME."
+ (cl-letf (((symbol-function 'completing-read)
+ (lambda (_prompt _coll &optional _pred _req init _hist def _)
+ (or def init)))
+ (dir (make-temp-file "read-file-name-test" t)))
+ (unwind-protect
+ (let ((subdir (expand-file-name "./~/")))
+ (make-directory subdir t)
+ (with-temp-buffer
+ (setq default-directory subdir)
+ (should-not (equal
+ (expand-file-name (read-file-name "File: "))
+ (expand-file-name "~/")))
+ ;; Don't overquote either!
+ (setq default-directory (concat "/:" subdir))
+ (should-not (equal
+ (expand-file-name (read-file-name "File: "))
+ (concat "/:/:" subdir)))))
+ (delete-directory dir 'recursive))))
+
(provide 'files-tests)
;;; files-tests.el ends here
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master a92a027: Quote filenames containing '~' in prompts,
Noam Postavsky <=