;;; Code:
(eval-when-compile (require 'cl))
+(require 'comint)
(defgroup pcomplete nil
"Programmable completion."
;; it pretty much impossible to have completion other than
;; prefix-completion.
;;
-;; pcomplete--common-quoted-suffix and pcomplete--table-subvert try to
+;; pcomplete--common-quoted-suffix and comint--table-subvert try to
;; work around this difficulty with heuristics, but it's
;; really a hack.
(t
(replace-regexp-in-string "\\\\\\(.\\)" "\\1" s t))))
-(defun pcomplete--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)) ;; pcomplete-ignore-case
- (string-match ".*?\\(.*\\)\n.*\\1\\'" (concat s1 "\n" s2))
- (- (match-end 1) (match-beginning 1))))
-
(defun pcomplete--common-quoted-suffix (s1 s2)
+ ;; FIXME: Copied in comint.el.
"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 (pcomplete--common-suffix s1 s2))
+ (let* ((cs (comint--common-suffix s1 s2))
(ss1 (substring s1 (- (length s1) cs)))
(qss1 (pcomplete-quote-argument ss1))
qc)
(cons (substring s1 0 (- (length s1) cs))
(substring s2 0 (- (length s2) cs))))))
-(defun pcomplete--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 (pcomplete-unquote-argument
- (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 (pcomplete-quote-argument
- (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))))))))))
-
;; I don't think such commands are usable before first setting up buffer-local
;; variables to parse args, so there's no point autoloading it.
;; ;;;###autoload
;; pcomplete-stub and works from the buffer's text instead,
;; we need to trick minibuffer-complete, into using
;; pcomplete-stub without its knowledge. To that end, we
- ;; use pcomplete--table-subvert to construct a completion
+ ;; use comint--table-subvert to construct a completion
;; table which expects strings using a prefix from the
;; buffer's text but internally uses the corresponding
;; prefix from pcomplete-stub.
;; practice it should work just fine (fingers crossed).
(let ((prefixes (pcomplete--common-quoted-suffix
pcomplete-stub buftext)))
- (apply-partially #'pcomplete--table-subvert
- completions
- (cdr prefixes) (car prefixes))))
+ (comint--table-subvert
+ completions (cdr prefixes) (car prefixes)
+ #'pcomplete-quote-argument #'pcomplete-unquote-argument)))
(t
(lambda (string pred action)
(let ((res (complete-with-action
(pred
;; Pare it down, if applicable.
(when (and pcomplete-use-paring pcomplete-seen)
- (setq pcomplete-seen
- (mapcar (lambda (f)
- (funcall pcomplete-norm-func
- (directory-file-name f)))
- pcomplete-seen))
;; Capture the dynbound values for later use.
(let ((norm-func pcomplete-norm-func)
- (seen pcomplete-seen))
+ (seen
+ (mapcar (lambda (f)
+ (funcall pcomplete-norm-func
+ (directory-file-name f)))
+ pcomplete-seen)))
(lambda (f)
(not (member
(funcall norm-func (directory-file-name f))
seen)))))))
(when pcomplete-ignore-case
- (setq table
- (apply-partially #'completion-table-case-fold table)))
+ (setq table (completion-table-case-fold table)))
(list beg (point) table
:predicate pred
:exit-function
(or (run-hook-with-args-until-success
'pcomplete-quote-arg-hook filename index)
(when (memq c pcomplete-arg-quote-list)
- (string "\\" c))
+ (string ?\\ c))
(char-to-string c))
(setq index (1+ index))))
filename
,@(cdr (completion-file-name-table s p a)))
(let ((completion-ignored-extensions nil))
(completion-table-with-predicate
- 'completion-file-name-table pred 'strict s p a))))))
+ #'comint-completion-file-name-table pred 'strict s p a))))))
(defconst pcomplete--env-regexp
"\\(?:\\`\\|[^\\]\\)\\(?:\\\\\\\\\\)*\\(\\$\\(?:{\\([^}]+\\)}\\|\\(?2:[[:alnum:]_]+\\)\\)\\)")