+ (let ((data (comint--complete-file-name-data)))
+ (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)))))
+
+(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-beg (if filename (match-beginning 0) (point)))
+ (filename-end (if filename (match-end 0) (point)))
+ (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)))))
+ (nconc
+ (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))
+ (complete-with-action action table string pred))))
+ (unless (zerop (length filesuffix))
+ (list :exit-function
+ (lambda (_s finished)
+ (when (memq finished '(sole finished))
+ (if (looking-at (regexp-quote filesuffix))
+ (goto-char (match-end 0))
+ (insert filesuffix)))))))))