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> 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): * progmodes/flymake.el (flymake-start-syntax-check-process):
Obey `dir'. Simplify. 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. ;; Copyright (C) 1988, 1990, 1992-2011 Free Software Foundation, Inc.
...@@ -101,6 +101,7 @@ ...@@ -101,6 +101,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl))
(require 'ring) (require 'ring)
;; Buffer Local Variables: ;; Buffer Local Variables:
...@@ -366,7 +367,7 @@ text matching `comint-prompt-regexp', depending on the value of ...@@ -366,7 +367,7 @@ text matching `comint-prompt-regexp', depending on the value of
`comint-use-prompt-regexp'.") `comint-use-prompt-regexp'.")
(defvar comint-dynamic-complete-functions (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. "List of functions called to perform completion.
Works like `completion-at-point-functions'. Works like `completion-at-point-functions'.
See also `comint-dynamic-complete'. See also `comint-dynamic-complete'.
...@@ -2831,7 +2832,6 @@ its response can be seen." ...@@ -2831,7 +2832,6 @@ its response can be seen."
;; comint-dynamic-list-filename-completions List completions in help buffer. ;; comint-dynamic-list-filename-completions List completions in help buffer.
;; comint-replace-by-expanded-filename Expand and complete filename at point; ;; comint-replace-by-expanded-filename Expand and complete filename at point;
;; replace with expanded/completed name. ;; 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 ;; These are not installed in the comint-mode keymap. But they are
;; available for people who want them. Shell-mode installs them: ;; available for people who want them. Shell-mode installs them:
...@@ -2849,14 +2849,16 @@ This mirrors the optional behavior of tcsh." ...@@ -2849,14 +2849,16 @@ This mirrors the optional behavior of tcsh."
:group 'comint-completion) :group 'comint-completion)
(defcustom comint-completion-addsuffix t (defcustom comint-completion-addsuffix t
"If non-nil, add a `/' to completed directories, ` ' to file names. "If non-nil, add ` ' to file names.
If a cons pair, it should be of the form (DIRSUFFIX . FILESUFFIX) where It can either be a string FILESUFFIX or a cons (DIRSUFFIX . FILESUFFIX)
DIRSUFFIX and FILESUFFIX are strings added on unambiguous or exact completion. where DIRSUFFIX is ignored and FILESUFFIX is a string added on unambiguous
or exact completion.
This mirrors the optional behavior of tcsh." This mirrors the optional behavior of tcsh."
:type '(choice (const :tag "None" nil) :type '(choice (const :tag "None" nil)
(const :tag "Add /" t) (const :tag "Add SPC" t)
(cons :tag "Suffix pair" (string :tag "File suffix")
(string :tag "Directory suffix") (cons :tag "Obsolete suffix pair"
(string :tag "Ignored")
(string :tag "File suffix"))) (string :tag "File suffix")))
:group 'comint-completion) :group 'comint-completion)
...@@ -3016,73 +3018,125 @@ Returns t if successful." ...@@ -3016,73 +3018,125 @@ Returns t if successful."
(when (comint--match-partial-filename) (when (comint--match-partial-filename)
(unless (window-minibuffer-p (selected-window)) (unless (window-minibuffer-p (selected-window))
(message "Completing file name...")) (message "Completing file name..."))
(comint-dynamic-complete-as-filename))) (apply #'completion-in-region (comint--complete-file-name-data))))
(defun comint-dynamic-complete-as-filename () (defun comint-filename-completion ()
"Dynamically complete at point as a filename. "Return completion data for filename at point, if any."
See `comint-dynamic-complete-filename'. Returns t if successful." (when (comint--match-partial-filename)
(let* ((completion-ignore-case read-file-name-completion-ignore-case) (comint--complete-file-name-data)))
(completion-ignored-extensions comint-completion-fignore)
;; If we bind this, it breaks remote directory tracking in rlogin.el. ;; FIXME: comint--common-suffix, comint--common-quoted-suffix, and
;; I think it was originally bound to solve file completion problems, ;; comint--table-subvert copied from pcomplete. And they don't fully solve
;; but subsequent changes may have made this unnecessary. sm. ;; the problem, since selecting a file from *Completions* won't quote it.
;;(file-name-handler-alist nil)
(minibuffer-p (window-minibuffer-p (selected-window))) (defun comint--common-suffix (s1 s2)
(success t) (assert (not (or (string-match "\n" s1) (string-match "\n" s2))))
(dirsuffix (cond ((not comint-completion-addsuffix) "") ;; Since S2 is expected to be the "unquoted/expanded" version of S1,
((not (consp comint-completion-addsuffix)) "/") ;; there shouldn't be any case difference, even if the completion is
(t (car comint-completion-addsuffix)))) ;; case-insensitive.
(filesuffix (cond ((not comint-completion-addsuffix) "") (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)) " ") ((not (consp comint-completion-addsuffix)) " ")
(t (cdr 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-beg (if filename (match-beginning 0) (point)))
(filename-end (if filename (match-end 0) (point))) (filename-end (if filename (match-end 0) (point)))
(filename (or filename "")) (unquoted (if filename (comint--unquote&expand-filename filename) ""))
(filedir (file-name-directory filename)) (table
(filenondir (file-name-nondirectory filename)) (let ((prefixes (comint--common-quoted-suffix
(directory (if filedir (comint-directory filedir) default-directory)) unquoted filename)))
(completion (file-name-completion filenondir directory))) (apply-partially
(cond ((null completion) #'comint--table-subvert
(if minibuffer-p #'completion-file-name-table
(minibuffer-message "No completions of %s" filename) (cdr prefixes) (car prefixes)))))
(message "No completions of %s" filename)) (list
(setq success nil)) filename-beg filename-end
((eq completion t) ; Means already completed "file". (lambda (string pred action)
(insert filesuffix) (let ((completion-ignore-case read-file-name-completion-ignore-case)
(unless minibuffer-p (completion-ignored-extensions comint-completion-fignore))
(message "Sole completion"))) (if (zerop (length filesuffix))
((string-equal completion "") ; Means completion on "directory/". (complete-with-action action table string pred)
(comint-dynamic-list-filename-completions)) ;; Add a space at the end of completion. Use a terminator-regexp
(t ; Completion string returned. ;; that never matches since the terminator cannot appear
(let ((file (concat (file-name-as-directory directory) completion))) ;; within the completion field anyway.
;; Insert completion. Note that the completion string (completion-table-with-terminator
;; may have a different case than what's in the prompt, (cons filesuffix "\\`a\\`")
;; if read-file-name-completion-ignore-case is non-nil, table string pred action)))))))
(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))
(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 () (defun comint-replace-by-expanded-filename ()
"Dynamically expand and complete the filename at point. "Dynamically expand and complete the filename at point.
...@@ -3155,28 +3209,20 @@ See also `comint-dynamic-complete-filename'." ...@@ -3155,28 +3209,20 @@ See also `comint-dynamic-complete-filename'."
(unless minibuffer-p (unless minibuffer-p
(message "Partially completed")) (message "Partially completed"))
'partial))))))) 'partial)))))))
(make-obsolete 'comint-dynamic-simple-complete 'completion-in-region "24.1")
(defun comint-dynamic-list-filename-completions () (defun comint-dynamic-list-filename-completions ()
"Display a list of possible completions for the filename at point." "Display a list of possible completions for the filename at point."
(interactive) (interactive)
(let* ((completion-ignore-case read-file-name-completion-ignore-case) (let* ((data (comint--complete-file-name-data))
;; If we bind this, it breaks remote directory tracking in rlogin.el. (minibuffer-completion-table (nth 2 data))
;; I think it was originally bound to solve file completion problems, (minibuffer-completion-predicate nil)
;; but subsequent changes may have made this unnecessary. sm. (ol (make-overlay (nth 0 data) (nth 1 data) nil nil t)))
;;(file-name-handler-alist nil) (overlay-put ol 'field 'completion)
(filename (or (comint-match-partial-filename) "")) (unwind-protect
(filedir (file-name-directory filename)) (call-interactively 'minibuffer-completion-help)
(filenondir (file-name-nondirectory filename)) (delete-overlay ol))))
(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)))))
;; This is bound locally in a *Completions* buffer to the list of ;; This is bound locally in a *Completions* buffer to the list of
...@@ -3244,7 +3290,6 @@ Typing SPC flushes the completions buffer." ...@@ -3244,7 +3290,6 @@ Typing SPC flushes the completions buffer."
(if (eq first ?\s) (if (eq first ?\s)
(set-window-configuration comint-dynamic-list-completions-config) (set-window-configuration comint-dynamic-list-completions-config)
(setq unread-command-events (listify-key-sequence key))))))) (setq unread-command-events (listify-key-sequence key)))))))
(defun comint-get-next-from-history () (defun comint-get-next-from-history ()
"After fetching a line from input history, this fetches the following line. "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." ...@@ -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 ;; For modes that use comint-mode, comint-dynamic-complete-functions is the
;; hook to add completion functions to. Functions on this list should return ;; hook to add completion functions to. Functions on this list should return
;; non-nil if completion occurs (i.e., further completion should not occur). ;; the completion data according to the documentation of
;; You could use comint-dynamic-simple-complete to do the bulk of the ;; `completion-at-point-functions'
;; completion job.
(provide 'comint) (provide 'comint)
......
...@@ -58,6 +58,8 @@ ...@@ -58,6 +58,8 @@
;;; Todo: ;;; 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-insert-complete-hook (called after inserting a complete
;; completion), typically used for "complete-abbrev" where it would expand ;; completion), typically used for "complete-abbrev" where it would expand
;; the abbrev. Tho we'd probably want to provide it from the ;; 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." ...@@ -1314,8 +1316,7 @@ Point needs to be somewhere between START and END."
(save-excursion (save-excursion
(goto-char (nth 2 completion-in-region--data)) (goto-char (nth 2 completion-in-region--data))
(line-end-position))) (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))) (completion-in-region-mode -1)))
;; (defalias 'completion-in-region--prech 'completion-in-region--postch) ;; (defalias 'completion-in-region--prech 'completion-in-region--postch)
...@@ -1330,11 +1331,11 @@ Point needs to be somewhere between START and END." ...@@ -1330,11 +1331,11 @@ Point needs to be somewhere between START and END."
(delq (assq 'completion-in-region-mode minor-mode-overriding-map-alist) (delq (assq 'completion-in-region-mode minor-mode-overriding-map-alist)
minor-mode-overriding-map-alist)) minor-mode-overriding-map-alist))
(if (null completion-in-region-mode) (if (null completion-in-region-mode)
(unless (or (equal "*Completions*" (buffer-name (window-buffer))) (unless (equal "*Completions*" (buffer-name (window-buffer)))
(null completion-in-region-mode--predicate))
(minibuffer-hide-completions)) (minibuffer-hide-completions))
;; (add-hook 'pre-command-hook #'completion-in-region--prech) ;; (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) completion-in-region-mode-predicate)
(add-hook 'post-command-hook #'completion-in-region--postch) (add-hook 'post-command-hook #'completion-in-region--postch)
(push `(completion-in-region-mode . ,completion-in-region-mode-map) (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