Commit 2dbaa080 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

* lisp/comint.el: Use lexical-binding. Use std completion UI. Require CL.

(comint-dynamic-complete-functions): Use comint-filename-completion.
(comint-completion-addsuffix): Tweak custom type.
(comint-filename-completion, comint--common-suffix)
(comint--common-quoted-suffix, comint--table-subvert)
(comint--complete-file-name-data): New functions.
(comint-dynamic-complete-as-filename, comint-dynamic-complete-filename)
(comint-dynamic-list-filename-completions): Use them.
(comint-dynamic-simple-complete): Make obsolete.
* lisp/minibuffer.el (completion-in-region-mode):
Keep completion-in-region-mode--predicate global.
(completion-in-region--postch):
Assume completion-in-region-mode--predicate is not null.
parent c79a6f38
2011-04-20 Stefan Monnier <monnier@iro.umontreal.ca>
* comint.el: Use lexical-binding. Require CL.
(comint-dynamic-complete-functions): Use comint-filename-completion.
(comint-completion-addsuffix): Tweak custom type.
(comint-filename-completion, comint--common-suffix)
(comint--common-quoted-suffix, comint--table-subvert)
(comint--complete-file-name-data): New functions.
(comint-dynamic-complete-as-filename, comint-dynamic-complete-filename)
(comint-dynamic-list-filename-completions): Use them.
(comint-dynamic-simple-complete): Make obsolete.
* minibuffer.el (completion-in-region-mode):
Keep completion-in-region-mode--predicate global.
(completion-in-region--postch):
Assume completion-in-region-mode--predicate is not null.
* progmodes/flymake.el (flymake-start-syntax-check-process):
Obey `dir'. Simplify.
......
;;; comint.el --- general command interpreter in a window stuff
;;; comint.el --- general command interpreter in a window stuff -*- lexical-binding: t -*-
;; Copyright (C) 1988, 1990, 1992-2011 Free Software Foundation, Inc.
......@@ -101,6 +101,7 @@
;;; Code:
(eval-when-compile (require 'cl))
(require 'ring)
;; Buffer Local Variables:
......@@ -366,7 +367,7 @@ text matching `comint-prompt-regexp', depending on the value of
`comint-use-prompt-regexp'.")
(defvar comint-dynamic-complete-functions
'(comint-replace-by-expanded-history comint-dynamic-complete-filename)
'(comint-replace-by-expanded-history comint-filename-completion)
"List of functions called to perform completion.
Works like `completion-at-point-functions'.
See also `comint-dynamic-complete'.
......@@ -2831,7 +2832,6 @@ its response can be seen."
;; comint-dynamic-list-filename-completions List completions in help buffer.
;; comint-replace-by-expanded-filename Expand and complete filename at point;
;; replace with expanded/completed name.
;; comint-dynamic-simple-complete Complete stub given candidates.
;; These are not installed in the comint-mode keymap. But they are
;; available for people who want them. Shell-mode installs them:
......@@ -2849,14 +2849,16 @@ This mirrors the optional behavior of tcsh."
:group 'comint-completion)
(defcustom comint-completion-addsuffix t
"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.
"If non-nil, add ` ' to file names.
It can either be a string FILESUFFIX or a cons (DIRSUFFIX . FILESUFFIX)
where DIRSUFFIX is ignored and FILESUFFIX is a string added on unambiguous
or exact completion.
This mirrors the optional behavior of tcsh."
:type '(choice (const :tag "None" nil)
(const :tag "Add /" t)
(cons :tag "Suffix pair"
(string :tag "Directory suffix")
(const :tag "Add SPC" t)
(string :tag "File suffix")
(cons :tag "Obsolete suffix pair"
(string :tag "Ignored")
(string :tag "File suffix")))
:group 'comint-completion)
......@@ -3016,73 +3018,125 @@ Returns t if successful."
(when (comint--match-partial-filename)
(unless (window-minibuffer-p (selected-window))
(message "Completing file name..."))
(comint-dynamic-complete-as-filename)))
(apply #'completion-in-region (comint--complete-file-name-data))))
(defun comint-dynamic-complete-as-filename ()
"Dynamically complete at point as a filename.
See `comint-dynamic-complete-filename'. Returns t if successful."
(let* ((completion-ignore-case read-file-name-completion-ignore-case)
(completion-ignored-extensions comint-completion-fignore)
;; If we bind this, it breaks remote directory tracking in rlogin.el.
;; I think it was originally bound to solve file completion problems,
;; but subsequent changes may have made this unnecessary. sm.
;;(file-name-handler-alist nil)
(minibuffer-p (window-minibuffer-p (selected-window)))
(success t)
(dirsuffix (cond ((not comint-completion-addsuffix) "")
((not (consp comint-completion-addsuffix)) "/")
(t (car comint-completion-addsuffix))))
(filesuffix (cond ((not comint-completion-addsuffix) "")
(defun comint-filename-completion ()
"Return completion data for filename at point, if any."
(when (comint--match-partial-filename)
(comint--complete-file-name-data)))
;; FIXME: comint--common-suffix, comint--common-quoted-suffix, and
;; comint--table-subvert copied from pcomplete. And they don't fully solve
;; the problem, since selecting a file from *Completions* won't quote it.
(defun comint--common-suffix (s1 s2)
(assert (not (or (string-match "\n" s1) (string-match "\n" s2))))
;; Since S2 is expected to be the "unquoted/expanded" version of S1,
;; there shouldn't be any case difference, even if the completion is
;; case-insensitive.
(let ((case-fold-search nil))
(string-match ".*?\\(.*\\)\n.*\\1\\'" (concat s1 "\n" s2))
(- (match-end 1) (match-beginning 1))))
(defun comint--common-quoted-suffix (s1 s2)
"Find the common suffix between S1 and S2 where S1 is the expanded S2.
S1 is expected to be the unquoted and expanded version of S1.
Returns (PS1 . PS2), i.e. the shortest prefixes of S1 and S2, such that
S1 = (concat PS1 SS1) and S2 = (concat PS2 SS2) and
SS1 = (unquote SS2)."
(let* ((cs (comint--common-suffix s1 s2))
(ss1 (substring s1 (- (length s1) cs)))
(qss1 (comint-quote-filename ss1))
qc)
(if (and (not (equal ss1 qss1))
(setq qc (comint-quote-filename (substring ss1 0 1)))
(eq t (compare-strings s2 (- (length s2) cs (length qc) -1)
(- (length s2) cs -1)
qc nil nil)))
;; The difference found is just that one char is quoted in S2
;; but not in S1, keep looking before this difference.
(comint--common-quoted-suffix
(substring s1 0 (- (length s1) cs))
(substring s2 0 (- (length s2) cs (length qc) -1)))
(cons (substring s1 0 (- (length s1) cs))
(substring s2 0 (- (length s2) cs))))))
(defun comint--table-subvert (table s1 s2 string pred action)
"Completion table that replaces the prefix S1 with S2 in STRING.
When TABLE, S1 and S2 are provided by `apply-partially', the result
is a completion table which completes strings of the form (concat S1 S)
in the same way as TABLE completes strings of the form (concat S2 S)."
(let* ((str (if (eq t (compare-strings string 0 (length s1) s1 nil nil
completion-ignore-case))
(concat s2 (comint-unquote-filename
(substring string (length s1))))))
(res (if str (complete-with-action action table str pred))))
(when res
(cond
((and (eq (car-safe action) 'boundaries))
(let ((beg (or (and (eq (car-safe res) 'boundaries) (cadr res)) 0)))
(list* 'boundaries
(max (length s1)
;; FIXME: Adjust because of quoting/unquoting.
(+ beg (- (length s1) (length s2))))
(and (eq (car-safe res) 'boundaries) (cddr res)))))
((stringp res)
(if (eq t (compare-strings res 0 (length s2) s2 nil nil
completion-ignore-case))
(concat s1 (comint-quote-filename
(substring res (length s2))))))
((eq action t)
(let ((bounds (completion-boundaries str table pred "")))
(if (>= (car bounds) (length s2))
res
(let ((re (concat "\\`"
(regexp-quote (substring s2 (car bounds))))))
(delq nil
(mapcar (lambda (c)
(if (string-match re c)
(substring c (match-end 0))))
res))))))
;; E.g. action=nil and it's the only completion.
(res)))))
(defun comint--complete-file-name-data ()
"Return the completion data for file name at point."
(let* ((filesuffix (cond ((not comint-completion-addsuffix) "")
((stringp comint-completion-addsuffix)
comint-completion-addsuffix)
((not (consp comint-completion-addsuffix)) " ")
(t (cdr comint-completion-addsuffix))))
(filename (comint-match-partial-filename))
(filename (comint--match-partial-filename))
(filename-beg (if filename (match-beginning 0) (point)))
(filename-end (if filename (match-end 0) (point)))
(filename (or filename ""))
(filedir (file-name-directory filename))
(filenondir (file-name-nondirectory filename))
(directory (if filedir (comint-directory filedir) default-directory))
(completion (file-name-completion filenondir directory)))
(cond ((null completion)
(if minibuffer-p
(minibuffer-message "No completions of %s" filename)
(message "No completions of %s" filename))
(setq success nil))
((eq completion t) ; Means already completed "file".
(insert filesuffix)
(unless minibuffer-p
(message "Sole completion")))
((string-equal completion "") ; Means completion on "directory/".
(comint-dynamic-list-filename-completions))
(t ; Completion string returned.
(let ((file (concat (file-name-as-directory directory) completion)))
;; Insert completion. Note that the completion string
;; may have a different case than what's in the prompt,
;; if read-file-name-completion-ignore-case is non-nil,
(delete-region filename-beg filename-end)
(if filedir (insert (comint-quote-filename filedir)))
(insert (comint-quote-filename (directory-file-name completion)))
(cond ((symbolp (file-name-completion completion directory))
;; We inserted a unique completion.
(insert (if (file-directory-p file) dirsuffix filesuffix))
(unless minibuffer-p
(message "Completed")))
((and comint-completion-recexact comint-completion-addsuffix
(string-equal filenondir completion)
(file-exists-p file))
;; It's not unique, but user wants shortest match.
(insert (if (file-directory-p file) dirsuffix filesuffix))
(unless minibuffer-p
(message "Completed shortest")))
((or comint-completion-autolist
(string-equal filenondir completion))
;; It's not unique, list possible completions.
(comint-dynamic-list-filename-completions))
(t
(unless minibuffer-p
(message "Partially completed")))))))
success))
(unquoted (if filename (comint--unquote&expand-filename filename) ""))
(table
(let ((prefixes (comint--common-quoted-suffix
unquoted filename)))
(apply-partially
#'comint--table-subvert
#'completion-file-name-table
(cdr prefixes) (car prefixes)))))
(list
filename-beg filename-end
(lambda (string pred action)
(let ((completion-ignore-case read-file-name-completion-ignore-case)
(completion-ignored-extensions comint-completion-fignore))
(if (zerop (length filesuffix))
(complete-with-action action table string pred)
;; Add a space at the end of completion. Use a terminator-regexp
;; that never matches since the terminator cannot appear
;; within the completion field anyway.
(completion-table-with-terminator
(cons filesuffix "\\`a\\`")
table string pred action)))))))
(defun comint-dynamic-complete-as-filename ()
"Dynamically complete at point as a filename.
See `comint-dynamic-complete-filename'. Returns t if successful."
(apply #'completion-in-region (comint--complete-file-name-data)))
(make-obsolete 'comint-dynamic-complete-as-filename
'comint-filename-completion "24.1")
(defun comint-replace-by-expanded-filename ()
"Dynamically expand and complete the filename at point.
......@@ -3155,28 +3209,20 @@ See also `comint-dynamic-complete-filename'."
(unless minibuffer-p
(message "Partially completed"))
'partial)))))))
(make-obsolete 'comint-dynamic-simple-complete 'completion-in-region "24.1")
(defun comint-dynamic-list-filename-completions ()
"Display a list of possible completions for the filename at point."
(interactive)
(let* ((completion-ignore-case read-file-name-completion-ignore-case)
;; If we bind this, it breaks remote directory tracking in rlogin.el.
;; I think it was originally bound to solve file completion problems,
;; but subsequent changes may have made this unnecessary. sm.
;;(file-name-handler-alist nil)
(filename (or (comint-match-partial-filename) ""))
(filedir (file-name-directory filename))
(filenondir (file-name-nondirectory filename))
(directory (if filedir (comint-directory filedir) default-directory))
(completions (file-name-all-completions filenondir directory)))
(if (not completions)
(if (window-minibuffer-p (selected-window))
(minibuffer-message "No completions of %s" filename)
(message "No completions of %s" filename))
(comint-dynamic-list-completions
(mapcar 'comint-quote-filename completions)
(comint-quote-filename filenondir)))))
(let* ((data (comint--complete-file-name-data))
(minibuffer-completion-table (nth 2 data))
(minibuffer-completion-predicate nil)
(ol (make-overlay (nth 0 data) (nth 1 data) nil nil t)))
(overlay-put ol 'field 'completion)
(unwind-protect
(call-interactively 'minibuffer-completion-help)
(delete-overlay ol))))
;; This is bound locally in a *Completions* buffer to the list of
......@@ -3244,7 +3290,6 @@ Typing SPC flushes the completions buffer."
(if (eq first ?\s)
(set-window-configuration comint-dynamic-list-completions-config)
(setq unread-command-events (listify-key-sequence key)))))))
(defun comint-get-next-from-history ()
"After fetching a line from input history, this fetches the following line.
......@@ -3742,9 +3787,8 @@ REGEXP-GROUP is the regular expression group in REGEXP to use."
;;
;; For modes that use comint-mode, comint-dynamic-complete-functions is the
;; hook to add completion functions to. Functions on this list should return
;; non-nil if completion occurs (i.e., further completion should not occur).
;; You could use comint-dynamic-simple-complete to do the bulk of the
;; completion job.
;; the completion data according to the documentation of
;; `completion-at-point-functions'
(provide 'comint)
......
......@@ -58,6 +58,8 @@
;;; Todo:
;; - Make things like icomplete-mode or lightning-completion work with
;; completion-in-region-mode.
;; - completion-insert-complete-hook (called after inserting a complete
;; completion), typically used for "complete-abbrev" where it would expand
;; the abbrev. Tho we'd probably want to provide it from the
......@@ -1314,8 +1316,7 @@ Point needs to be somewhere between START and END."
(save-excursion
(goto-char (nth 2 completion-in-region--data))
(line-end-position)))
(when completion-in-region-mode--predicate
(funcall completion-in-region-mode--predicate))))
(funcall completion-in-region-mode--predicate)))
(completion-in-region-mode -1)))
;; (defalias 'completion-in-region--prech 'completion-in-region--postch)
......@@ -1330,11 +1331,11 @@ Point needs to be somewhere between START and END."
(delq (assq 'completion-in-region-mode minor-mode-overriding-map-alist)
minor-mode-overriding-map-alist))
(if (null completion-in-region-mode)
(unless (or (equal "*Completions*" (buffer-name (window-buffer)))
(null completion-in-region-mode--predicate))
(unless (equal "*Completions*" (buffer-name (window-buffer)))
(minibuffer-hide-completions))
;; (add-hook 'pre-command-hook #'completion-in-region--prech)
(set (make-local-variable 'completion-in-region-mode--predicate)
(assert completion-in-region-mode-predicate)
(setq completion-in-region-mode--predicate
completion-in-region-mode-predicate)
(add-hook 'post-command-hook #'completion-in-region--postch)
(push `(completion-in-region-mode . ,completion-in-region-mode-map)
......
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