-;;; pcomplete.el --- programmable completion
+;;; pcomplete.el --- programmable completion -*- lexical-binding: t -*-
;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
"A list of characters which constitute a proper suffix."
:type '(repeat character)
:group 'pcomplete)
+(make-obsolete-variable 'pcomplete-suffix-list nil "24.1")
(defcustom pcomplete-recexact nil
"If non-nil, use shortest completion if characters cannot be added.
(defvar pcomplete-show-list nil)
(defvar pcomplete-expand-only-p nil)
+;; for the sake of the bye-compiler, when compiling other files that
+;; contain completion functions
+(defvar pcomplete-args nil)
+(defvar pcomplete-begins nil)
+(defvar pcomplete-last nil)
+(defvar pcomplete-index nil)
+(defvar pcomplete-stub nil)
+(defvar pcomplete-seen nil)
+(defvar pcomplete-norm-func nil)
+
;;; User Functions:
;;; Alternative front-end using the standard completion facilities.
(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-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
;; 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))))
+ (buftext (buffer-substring beg (point))))
+ (when completions
+ (let ((table
+ (cond
+ ((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
+ (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 pcomplete-use-paring pcomplete-seen)
+ ;; Capture the dynbound values for later use.
+ (let ((norm-func pcomplete-norm-func)
+ (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)))
+ (list beg (point) table
+ :predicate pred
+ :exit-function
+ (unless (zerop (length pcomplete-termination-string))
+ (lambda (_s finished)
+ (when (memq finished '(sole finished))
+ (if (looking-at
+ (regexp-quote pcomplete-termination-string))
+ (goto-char (match-end 0))
+ (insert pcomplete-termination-string)))))))))))
;; 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)))
+ (let ((data (pcomplete-completions-at-point)))
+ (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)
+ (plist-get :predicate (nthcdr 3 data)))))
;;; Pcomplete's native UI.
;;; Internal Functions:
;; argument handling
-
-;; for the sake of the bye-compiler, when compiling other files that
-;; contain completion functions
-(defvar pcomplete-args nil)
-(defvar pcomplete-begins nil)
-(defvar pcomplete-last nil)
-(defvar pcomplete-index nil)
-(defvar pcomplete-stub nil)
-(defvar pcomplete-seen nil)
-(defvar pcomplete-norm-func nil)
-
(defun pcomplete-arg (&optional index offset)
"Return the textual content of the INDEXth argument.
INDEX is based from the current processing position. If INDEX is
this is `comint-dynamic-complete-functions'."
(set (make-local-variable 'pcomplete-parse-arguments-function)
'pcomplete-parse-comint-arguments)
+ (add-hook 'completion-at-point-functions
+ 'pcomplete-completions-at-point nil 'local)
(set (make-local-variable completef-sym)
(copy-sequence (symbol-value completef-sym)))
(let* ((funs (symbol-value completef-sym))
- (elem (or (memq 'shell-dynamic-complete-filename funs)
+ (elem (or (memq 'comint-filename-completion funs)
+ (memq 'shell-filename-completion funs)
+ (memq 'shell-dynamic-complete-filename funs)
(memq 'comint-dynamic-complete-filename funs))))
(if elem
(setcar elem 'pcomplete)
(while (< (point) end)
(skip-chars-forward " \t\n")
(push (point) begins)
- (let ((skip t))
- (while skip
- (skip-chars-forward "^ \t\n")
- (if (eq (char-before) ?\\)
- (skip-chars-forward " \t\n")
- (setq skip nil))))
+ (while
+ (progn
+ (skip-chars-forward "^ \t\n\\")
+ (when (eq (char-after) ?\\)
+ (forward-char 1)
+ (unless (eolp)
+ (forward-char 1)
+ t))))
(push (buffer-substring-no-properties (car begins) (point))
args))
(cons (nreverse args) (nreverse begins)))))
+(make-obsolete 'pcomplete-parse-comint-arguments
+ 'comint-parse-pcomplete-arguments "24.1")
(defun pcomplete-parse-arguments (&optional expand-p)
"Parse the command line arguments. Most completions need this info."
(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
(defsubst pcomplete-dirs-or-entries (&optional regexp predicate)
"Return either directories, or qualified entries."
- ;; FIXME: pcomplete-entries doesn't return a list any more.
(pcomplete-entries
nil
- (lexical-let ((re regexp)
- (pred predicate))
- (lambda (f)
- (or (file-directory-p f)
- (and (if (not re) t (string-match re f))
- (if (not pred) t (funcall pred f))))))))
+ (lambda (f)
+ (or (file-directory-p f)
+ (and (or (null regexp) (string-match regexp f))
+ (or (null predicate) (funcall predicate f)))))))
+
+(defun pcomplete--entries (&optional regexp predicate)
+ "Like `pcomplete-entries' but without env-var handling."
+ (let* ((ign-pred
+ (when (or pcomplete-file-ignore pcomplete-dir-ignore)
+ ;; Capture the dynbound value for later use.
+ (let ((file-ignore pcomplete-file-ignore)
+ (dir-ignore pcomplete-dir-ignore))
+ (lambda (file)
+ (not
+ (if (eq (aref file (1- (length file))) ?/)
+ (and dir-ignore (string-match dir-ignore file))
+ (and file-ignore (string-match file-ignore file))))))))
+ (reg-pred (if regexp (lambda (file) (string-match regexp file))))
+ (pred (cond
+ ((null (or ign-pred reg-pred)) predicate)
+ ((null (or ign-pred predicate)) reg-pred)
+ ((null (or reg-pred predicate)) ign-pred)
+ (t (lambda (f)
+ (and (or (null reg-pred) (funcall reg-pred f))
+ (or (null ign-pred) (funcall ign-pred f))
+ (or (null predicate) (funcall predicate f))))))))
+ (lambda (s p a)
+ (if (and (eq a 'metadata) pcomplete-compare-entry-function)
+ `(metadata (cycle-sort-function
+ . ,(lambda (comps)
+ (sort comps pcomplete-compare-entry-function)))
+ ,@(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))))))
+
+(defconst pcomplete--env-regexp
+ "\\(?:\\`\\|[^\\]\\)\\(?:\\\\\\\\\\)*\\(\\$\\(?:{\\([^}]+\\)}\\|\\(?2:[[:alnum:]_]+\\)\\)\\)")
(defun pcomplete-entries (&optional regexp predicate)
"Complete against a list of directory candidates.
\(files for which the PREDICATE returns nil will be excluded).
If no directory information can be extracted from the completed
component, `default-directory' is used as the basis for completion."
- (let* ((name (substitute-env-vars pcomplete-stub))
- (completion-ignore-case pcomplete-ignore-case)
- (default-directory (expand-file-name
- (or (file-name-directory name)
- default-directory)))
- above-cutoff)
- (setq name (file-name-nondirectory name)
- pcomplete-stub name)
- (let ((completions
- (file-name-all-completions name default-directory)))
- (if regexp
- (setq completions
- (pcomplete-pare-list
- completions nil
- (function
- (lambda (file)
- (not (string-match regexp file)))))))
- (if predicate
- (setq completions
- (pcomplete-pare-list
- completions nil
- (function
- (lambda (file)
- (not (funcall predicate file)))))))
- (if (or pcomplete-file-ignore pcomplete-dir-ignore)
- (setq completions
- (pcomplete-pare-list
- completions nil
- (function
- (lambda (file)
- (if (eq (aref file (1- (length file)))
- ?/)
- (and pcomplete-dir-ignore
- (string-match pcomplete-dir-ignore file))
- (and pcomplete-file-ignore
- (string-match pcomplete-file-ignore file))))))))
- (setq above-cutoff (and pcomplete-cycle-cutoff-length
- (> (length completions)
- pcomplete-cycle-cutoff-length)))
- (sort completions
- (function
- (lambda (l r)
- ;; for the purposes of comparison, remove the
- ;; trailing slash from directory names.
- ;; Otherwise, "foo.old/" will come before "foo/",
- ;; since . is earlier in the ASCII alphabet than
- ;; /
- (let ((left (if (eq (aref l (1- (length l)))
- ?/)
- (substring l 0 (1- (length l)))
- l))
- (right (if (eq (aref r (1- (length r)))
- ?/)
- (substring r 0 (1- (length r)))
- r)))
- (if above-cutoff
- (string-lessp left right)
- (funcall pcomplete-compare-entry-function
- left right)))))))))
+ ;; FIXME: The old code did env-var expansion here, so we reproduce this
+ ;; behavior for now, but really env-var handling should be performed globally
+ ;; rather than here since it also applies to non-file arguments.
+ (let ((table (pcomplete--entries regexp predicate)))
+ (lambda (string pred action)
+ (let ((strings nil)
+ (orig-length (length string)))
+ ;; Perform env-var expansion.
+ (while (string-match pcomplete--env-regexp string)
+ (push (substring string 0 (match-beginning 1)) strings)
+ (push (getenv (match-string 2 string)) strings)
+ (setq string (substring string (match-end 1))))
+ (if (not (and strings
+ (or (eq action t)
+ (eq (car-safe action) 'boundaries))))
+ (let ((newstring
+ (mapconcat 'identity (nreverse (cons string strings)) "")))
+ ;; FIXME: We could also try to return unexpanded envvars.
+ (complete-with-action action table newstring pred))
+ (let* ((envpos (apply #'+ (mapcar #' length strings)))
+ (newstring
+ (mapconcat 'identity (nreverse (cons string strings)) ""))
+ (bounds (completion-boundaries newstring table pred
+ (or (cdr-safe action) ""))))
+ (if (>= (car bounds) envpos)
+ ;; The env-var is "out of bounds".
+ (if (eq action t)
+ (complete-with-action action table newstring pred)
+ (list* 'boundaries
+ (+ (car bounds) (- orig-length (length newstring)))
+ (cdr bounds)))
+ ;; The env-var is in the file bounds.
+ (if (eq action t)
+ (let ((comps (complete-with-action
+ action table newstring pred))
+ (len (- envpos (car bounds))))
+ ;; Strip the part of each completion that's actually
+ ;; coming from the env-var.
+ (mapcar (lambda (s) (substring s len)) comps))
+ (list* 'boundaries
+ (+ envpos (- orig-length (length newstring)))
+ (cdr bounds))))))))))
(defsubst pcomplete-all-entries (&optional regexp predicate)
"Like `pcomplete-entries', but doesn't ignore any entries."
(pcomplete-next-arg)
(funcall sym)))))))
-(defun pcomplete-opt (options &optional prefix no-ganging args-follow)
+(defun pcomplete-opt (options &optional prefix _no-ganging _args-follow)
"Complete a set of OPTIONS, each beginning with PREFIX (?- by default).
PREFIX may be t, in which case no PREFIX character is necessary.
If NO-GANGING is non-nil, each option is separate (-xy is not allowed).
If ARGS-FOLLOW is non-nil, then options which take arguments may have
the argument appear after a ganged set of options. This is how tar
-behaves, for example."
+behaves, for example.
+Arguments NO-GANGING and ARGS-FOLLOW are currently ignored."
(if (and (= pcomplete-index pcomplete-last)
(string= (pcomplete-arg) "-"))
(let ((len (length options))
(setq completions
(apply-partially 'completion-table-with-predicate
completions
- (lambda (f)
- (not (member
- (funcall pcomplete-norm-func
- (directory-file-name f))
- pcomplete-seen)))
+ (when pcomplete-seen
+ (lambda (f)
+ (not (member
+ (funcall pcomplete-norm-func
+ (directory-file-name f))
+ pcomplete-seen))))
'strict)))
;; OK, we've got a list of completions.
(if pcomplete-show-list
;; general utilities
-(defun pcomplete-pare-list (l r &optional pred)
- "Destructively remove from list L all elements matching any in list R.
-Test is done using `equal'.
-If PRED is non-nil, it is a function used for further removal.
-Returns the resultant list."
- (while (and l (or (and r (member (car l) r))
- (and pred
- (funcall pred (car l)))))
- (setq l (cdr l)))
- (let ((m l))
- (while m
- (while (and (cdr m)
- (or (and r (member (cadr m) r))
- (and pred
- (funcall pred (cadr m)))))
- (setcdr m (cddr m)))
- (setq m (cdr m))))
- l)
-
(defun pcomplete-uniqify-list (l)
"Sort and remove multiples in L."
(setq l (sort l 'string-lessp))
HCoop / bpt / emacs.git / blobdiff