+;;; Alternative front-end using the standard completion facilities.
+
+;; The way pcomplete-parse-arguments, pcomplete-stub, and
+;; pcomplete-quote-argument work only works because of some deep
+;; hypothesis about the way the completion work. Basically, it makes
+;; it pretty much impossible to have completion other than
+;; prefix-completion.
+;;
+;; pcomplete--common-quoted-suffix and pcomplete--table-subvert try to
+;; work around this difficulty with heuristics, but it's
+;; really a hack.
+
+(defvar pcomplete-unquote-argument-function nil)
+
+(defun pcomplete-unquote-argument (s)
+ (cond
+ (pcomplete-unquote-argument-function
+ (funcall pcomplete-unquote-argument-function s))
+ ((null pcomplete-arg-quote-list) s)
+ (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)
+ "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))
+ (ss1 (substring s1 (- (length s1) cs)))
+ (qss1 (pcomplete-quote-argument ss1))
+ qc)
+ (if (and (not (equal ss1 qss1))
+ (setq qc (pcomplete-quote-argument (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.
+ (pcomplete--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 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
+(defun pcomplete-completions-at-point ()
+ "Provide standard completion using pcomplete's completion tables.
+Same as `pcomplete' but using the standard completion UI."
+ ;; FIXME: it only completes the text before point, whereas the
+ ;; standard UI may also consider text after point.
+ ;; FIXME: the `pcomplete' UI may be used internally during
+ ;; pcomplete-completions and then throw to `pcompleted', thus
+ ;; imposing the pcomplete UI over the standard UI.
+ (catch 'pcompleted
+ (let* ((pcomplete-stub)
+ pcomplete-seen pcomplete-norm-func
+ pcomplete-args pcomplete-last pcomplete-index
+ (pcomplete-autolist pcomplete-autolist)
+ (pcomplete-suffix-list pcomplete-suffix-list)
+ ;; Apparently the vars above are global vars modified by
+ ;; side-effects, whereas pcomplete-completions is the core
+ ;; function that finds the chunk of text to complete
+ ;; (returned indirectly in pcomplete-stub) and the set of
+ ;; possible completions.
+ (completions (pcomplete-completions))
+ ;; Usually there's some close connection between pcomplete-stub
+ ;; and the text before point. But depending on what
+ ;; pcomplete-parse-arguments-function does, that connection
+ ;; might not be that close. E.g. in eshell,
+ ;; pcomplete-parse-arguments-function expands envvars.
+ ;;
+ ;; Since we use minibuffer-complete, which doesn't know
+ ;; 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
+ ;; table which expects strings using a prefix from the
+ ;; buffer's text but internally uses the corresponding
+ ;; prefix from pcomplete-stub.
+ (beg (max (- (point) (length pcomplete-stub))
+ (pcomplete-begin)))
+ (buftext (buffer-substring beg (point)))
+ (table
+ (cond
+ ((null completions) nil)
+ ((not (equal pcomplete-stub buftext))
+ ;; This isn't always strictly right (e.g. if
+ ;; FOO="toto/$FOO", then completion of /$FOO/bar may
+ ;; result in something incorrect), but given the lack of
+ ;; any other info, it's about as good as it gets, and in
+ ;; 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))))
+ (t
+ (lexical-let ((completions completions))
+ (lambda (string pred action)
+ (let ((res (complete-with-action
+ action completions string pred)))
+ (if (stringp res)
+ (pcomplete-quote-argument res)
+ res)))))))
+ (pred
+ ;; pare it down, if applicable
+ (when (and table pcomplete-use-paring pcomplete-seen)
+ (setq pcomplete-seen
+ (mapcar (lambda (f)
+ (funcall pcomplete-norm-func
+ (directory-file-name f)))
+ pcomplete-seen))
+ (lambda (f)
+ (not (member
+ (funcall pcomplete-norm-func
+ (directory-file-name f))
+ pcomplete-seen))))))
+
+ (list
+ beg (point)
+ ;; 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.
+ (if (zerop (length pcomplete-termination-string))
+ table
+ (apply-partially 'completion-table-with-terminator
+ (cons pcomplete-termination-string
+ "\\`a\\`")
+ table))
+ :predicate pred))))
+
+ ;; 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
+(defun pcomplete-std-complete ()
+ (let ((completion-at-point-functions '(pcomplete-completions-at-point)))
+ (completion-at-point)))
+
+;;; Pcomplete's native UI.
+