Commit 59f36b08 authored by Simon Marshall's avatar Simon Marshall

Added support for special (quoted) characters in file names:

new functions comint-quote-filename and comint-unquote-filename, using
new variable comint-file-name-quote-list.
Changed comint-word,  comint-match-partial-filename and
comint-dynamic-list-filename-completions to support character quoting.

Made comint-dynamic-complete-as-filename and comint-dynamic-simple-complete use
strings of comint-completion-addsuffix for completion, if a cons pair.
parent 7b4c6503
...@@ -118,6 +118,7 @@ ...@@ -118,6 +118,7 @@
;;; comint-last-input-match - string ... ;;; comint-last-input-match - string ...
;;; comint-dynamic-complete-functions - hook For the completion mechanism ;;; comint-dynamic-complete-functions - hook For the completion mechanism
;;; comint-completion-fignore - list ... ;;; comint-completion-fignore - list ...
;;; comint-file-name-quote-list - list ...
;;; comint-get-old-input - function Hooks for specific ;;; comint-get-old-input - function Hooks for specific
;;; comint-input-filter-functions - hook process-in-a-buffer ;;; comint-input-filter-functions - hook process-in-a-buffer
;;; comint-output-filter-functions - hook function modes. ;;; comint-output-filter-functions - hook function modes.
...@@ -130,7 +131,7 @@ ...@@ -130,7 +131,7 @@
;;; comint-scroll-show-maximum-output - boolean... ;;; comint-scroll-show-maximum-output - boolean...
;;; ;;;
;;; Comint mode non-buffer local variables: ;;; Comint mode non-buffer local variables:
;;; comint-completion-addsuffix - boolean For file name completion ;;; comint-completion-addsuffix - boolean/cons For file name completion
;;; comint-completion-autolist - boolean behavior ;;; comint-completion-autolist - boolean behavior
;;; comint-completion-recexact - boolean ... ;;; comint-completion-recexact - boolean ...
...@@ -391,6 +392,7 @@ Entry to this mode runs the hooks on `comint-mode-hook'." ...@@ -391,6 +392,7 @@ Entry to this mode runs the hooks on `comint-mode-hook'."
(make-local-variable 'comint-ptyp) (make-local-variable 'comint-ptyp)
(make-local-variable 'comint-exec-hook) (make-local-variable 'comint-exec-hook)
(make-local-variable 'comint-process-echoes) (make-local-variable 'comint-process-echoes)
(make-local-variable 'comint-file-name-quote-list)
(run-hooks 'comint-mode-hook)) (run-hooks 'comint-mode-hook))
(if comint-mode-map (if comint-mode-map
...@@ -1406,23 +1408,23 @@ applications." ...@@ -1406,23 +1408,23 @@ applications."
;; Use this instead of `read-char' to avoid "Non-character input-event". ;; Use this instead of `read-char' to avoid "Non-character input-event".
(setq c (read-char-exclusive)) (setq c (read-char-exclusive))
(cond ((= c ?\C-g) (cond ((= c ?\C-g)
;; This function may get called from a process filter, where ;; This function may get called from a process filter, where
;; inhibit-quit is set. In later versions of emacs read-char ;; inhibit-quit is set. In later versions of emacs read-char
;; may clear quit-flag itself and return C-g. That would make ;; may clear quit-flag itself and return C-g. That would make
;; it impossible to quit this loop in a simple way, so ;; it impossible to quit this loop in a simple way, so
;; re-enable it here (for backward-compatibility the check for ;; re-enable it here (for backward-compatibility the check for
;; quit-flag below would still be necessary, so this seems ;; quit-flag below would still be necessary, so this seems
;; like the simplest way to do things). ;; like the simplest way to do things).
(setq quit-flag t (setq quit-flag t
done t)) done t))
((or (= c ?\r) (= c ?\n) (= c ?\e)) ((or (= c ?\r) (= c ?\n) (= c ?\e))
(setq done t)) (setq done t))
((= c ?\C-u) ((= c ?\C-u)
(setq ans "")) (setq ans ""))
((and (/= c ?\b) (/= c ?\177)) ((and (/= c ?\b) (/= c ?\177))
(setq ans (concat ans (char-to-string c)))) (setq ans (concat ans (char-to-string c))))
((> (length ans) 0) ((> (length ans) 0)
(setq ans (substring ans 0 -1))))) (setq ans (substring ans 0 -1)))))
(if quit-flag (if quit-flag
;; Emulate a true quit, except that we have to return a value. ;; Emulate a true quit, except that we have to return a value.
(prog1 (prog1
...@@ -1802,6 +1804,8 @@ This mirrors the optional behavior of tcsh.") ...@@ -1802,6 +1804,8 @@ This mirrors the optional behavior of tcsh.")
(defvar comint-completion-addsuffix t (defvar comint-completion-addsuffix t
"*If non-nil, add a `/' to completed directories, ` ' to file names. "*If non-nil, add a `/' to completed directories, ` ' to file names.
If a cons pair, it should be of the form (DIRSUFFIX . FILESUFFIX) where
DIRSUFFIX and FILESUFFIX are strings added on unambiguous or exact completion.
This mirrors the optional behavior of tcsh.") This mirrors the optional behavior of tcsh.")
(defvar comint-completion-recexact nil (defvar comint-completion-recexact nil
...@@ -1821,6 +1825,11 @@ Note that this applies to `comint-dynamic-complete-filename' only.") ...@@ -1821,6 +1825,11 @@ Note that this applies to `comint-dynamic-complete-filename' only.")
This is used by comint's and shell's completion functions, and by shell's This is used by comint's and shell's completion functions, and by shell's
directory tracking functions.") directory tracking functions.")
(defvar comint-file-name-quote-list nil
"List of characters to quote with `\' when in a file name.
This is a good thing to set in mode hooks.")
(defun comint-directory (directory) (defun comint-directory (directory)
;; Return expanded DIRECTORY, with `comint-file-name-prefix' if absolute. ;; Return expanded DIRECTORY, with `comint-file-name-prefix' if absolute.
...@@ -1834,23 +1843,43 @@ directory tracking functions.") ...@@ -1834,23 +1843,43 @@ directory tracking functions.")
Word constituents are considered to be those in WORD-CHARS, which is like the Word constituents are considered to be those in WORD-CHARS, which is like the
inside of a \"[...]\" (see `skip-chars-forward')." inside of a \"[...]\" (see `skip-chars-forward')."
(save-excursion (save-excursion
(let ((limit (point)) (let ((non-word-chars (concat "[^\\\\" word-chars "]")) (here (point)))
(word (concat "[" word-chars "]")) (while (and (re-search-backward non-word-chars nil 'move)
(non-word (concat "[^" word-chars "]"))) ;(memq (char-after (point)) shell-file-name-quote-list)
(if (re-search-backward non-word nil 'move) (not (bolp)) (eq (char-after (1- (point))) ?\\))
(forward-char 1)) (backward-char 1))
;; Anchor the search forwards. (forward-char 1)
(if (or (eolp) (looking-at non-word)) (and (< (point) here) (buffer-substring (point) here)))))
nil
(re-search-forward (concat word "+") limit)
(buffer-substring (match-beginning 0) (match-end 0))))))
(defun comint-match-partial-filename () (defun comint-match-partial-filename ()
"Return the filename at point, or nil if non is found. "Return the filename at point, or nil if non is found.
Environment variables are substituted. See `comint-word'." Environment variables are substituted. See `comint-word'."
(let ((filename (comint-word "~/A-Za-z0-9+@:_.$#%,={}-"))) (let ((filename (comint-word "~/A-Za-z0-9+@:_.$#%,={}-")))
(and filename (substitute-in-file-name filename)))) (and filename (substitute-in-file-name (comint-unquote-filename filename)))))
(defun comint-quote-filename (filename)
"Return FILENAME with magic characters quoted.
Magic characters are those in `comint-file-name-quote-list'."
(if (null comint-file-name-quote-list)
filename
(let ((regexp
(format "\\(^\\|[^\\]\\)\\([%s]\\)"
(mapconcat 'char-to-string comint-file-name-quote-list ""))))
(save-match-data
(while (string-match regexp filename)
(setq filename (replace-match "\\1\\\\\\2" nil nil filename)))
filename))))
(defun comint-unquote-filename (filename)
"Return FILENAME with quoted characters unquoted."
(if (null comint-file-name-quote-list)
filename
(save-match-data
(while (string-match "\\\\\\(.\\)" filename)
(setq filename (replace-match "\\1" nil nil filename)))
filename)))
(defun comint-dynamic-complete () (defun comint-dynamic-complete ()
...@@ -1893,6 +1922,12 @@ See `comint-dynamic-complete-filename'. Returns t if successful." ...@@ -1893,6 +1922,12 @@ See `comint-dynamic-complete-filename'. Returns t if successful."
(file-name-handler-alist nil) (file-name-handler-alist nil)
(minibuffer-p (window-minibuffer-p (selected-window))) (minibuffer-p (window-minibuffer-p (selected-window)))
(success t) (success t)
(dirsuffix (cond ((not comint-completion-addsuffix) "")
((not (consp comint-completion-addsuffix)) "/")
(t (car comint-completion-addsuffix))))
(filesuffix (cond ((not comint-completion-addsuffix) "")
((not (consp comint-completion-addsuffix)) " ")
(t (cdr comint-completion-addsuffix))))
(filename (or (comint-match-partial-filename) "")) (filename (or (comint-match-partial-filename) ""))
(pathdir (file-name-directory filename)) (pathdir (file-name-directory filename))
(pathnondir (file-name-nondirectory filename)) (pathnondir (file-name-nondirectory filename))
...@@ -1902,24 +1937,24 @@ See `comint-dynamic-complete-filename'. Returns t if successful." ...@@ -1902,24 +1937,24 @@ See `comint-dynamic-complete-filename'. Returns t if successful."
(message "No completions of %s" filename) (message "No completions of %s" filename)
(setq success nil)) (setq success nil))
((eq completion t) ; Means already completed "file". ((eq completion t) ; Means already completed "file".
(if comint-completion-addsuffix (insert " ")) (insert filesuffix)
(or minibuffer-p (message "Sole completion"))) (or minibuffer-p (message "Sole completion")))
((string-equal completion "") ; Means completion on "directory/". ((string-equal completion "") ; Means completion on "directory/".
(comint-dynamic-list-filename-completions)) (comint-dynamic-list-filename-completions))
(t ; Completion string returned. (t ; Completion string returned.
(let ((file (concat (file-name-as-directory directory) completion))) (let ((file (concat (file-name-as-directory directory) completion)))
(insert (substring (directory-file-name completion) (insert (comint-quote-filename
(length pathnondir))) (substring (directory-file-name completion)
(length pathnondir))))
(cond ((symbolp (file-name-completion completion directory)) (cond ((symbolp (file-name-completion completion directory))
;; We inserted a unique completion. ;; We inserted a unique completion.
(if comint-completion-addsuffix (insert (if (file-directory-p file) dirsuffix filesuffix))
(insert (if (file-directory-p file) "/" " ")))
(or minibuffer-p (message "Completed"))) (or minibuffer-p (message "Completed")))
((and comint-completion-recexact comint-completion-addsuffix ((and comint-completion-recexact comint-completion-addsuffix
(string-equal pathnondir completion) (string-equal pathnondir completion)
(file-exists-p file)) (file-exists-p file))
;; It's not unique, but user wants shortest match. ;; It's not unique, but user wants shortest match.
(insert (if (file-directory-p file) "/" " ")) (insert (if (file-directory-p file) dirsuffix filesuffix))
(or minibuffer-p (message "Completed shortest"))) (or minibuffer-p (message "Completed shortest")))
((or comint-completion-autolist ((or comint-completion-autolist
(string-equal pathnondir completion)) (string-equal pathnondir completion))
...@@ -1957,6 +1992,9 @@ Returns `listed' if a completion listing was shown. ...@@ -1957,6 +1992,9 @@ Returns `listed' if a completion listing was shown.
See also `comint-dynamic-complete-filename'." See also `comint-dynamic-complete-filename'."
(let* ((completion-ignore-case nil) (let* ((completion-ignore-case nil)
(suffix (cond ((not comint-completion-addsuffix) "")
((not (consp comint-completion-addsuffix)) " ")
(t (cdr comint-completion-addsuffix))))
(candidates (mapcar (function (lambda (x) (list x))) candidates)) (candidates (mapcar (function (lambda (x) (list x))) candidates))
(completions (all-completions stub candidates))) (completions (all-completions stub candidates)))
(cond ((null completions) (cond ((null completions)
...@@ -1968,7 +2006,7 @@ See also `comint-dynamic-complete-filename'." ...@@ -1968,7 +2006,7 @@ See also `comint-dynamic-complete-filename'."
(message "Sole completion") (message "Sole completion")
(insert (substring completion (length stub))) (insert (substring completion (length stub)))
(message "Completed")) (message "Completed"))
(if comint-completion-addsuffix (insert " ")) (insert suffix)
'sole)) 'sole))
(t ; There's no unique completion. (t ; There's no unique completion.
(let ((completion (try-completion stub candidates))) (let ((completion (try-completion stub candidates)))
...@@ -1978,7 +2016,7 @@ See also `comint-dynamic-complete-filename'." ...@@ -1978,7 +2016,7 @@ See also `comint-dynamic-complete-filename'."
(string-equal stub completion) (string-equal stub completion)
(member completion completions)) (member completion completions))
;; It's not unique, but user wants shortest match. ;; It's not unique, but user wants shortest match.
(insert " ") (insert suffix)
(message "Completed shortest") (message "Completed shortest")
'shortest) 'shortest)
((or comint-completion-autolist ((or comint-completion-autolist
...@@ -2001,9 +2039,10 @@ See also `comint-dynamic-complete-filename'." ...@@ -2001,9 +2039,10 @@ See also `comint-dynamic-complete-filename'."
(pathnondir (file-name-nondirectory filename)) (pathnondir (file-name-nondirectory filename))
(directory (if pathdir (comint-directory pathdir) default-directory)) (directory (if pathdir (comint-directory pathdir) default-directory))
(completions (file-name-all-completions pathnondir directory))) (completions (file-name-all-completions pathnondir directory)))
(if completions (if (not completions)
(comint-dynamic-list-completions completions) (message "No completions of %s" filename)
(message "No completions of %s" filename)))) (comint-dynamic-list-completions
(mapcar 'comint-quote-filename completions)))))
(defun comint-dynamic-list-completions (completions) (defun comint-dynamic-list-completions (completions)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment