[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] emacs/lisp ChangeLog pcomplete.el
From: |
Stefan Monnier |
Subject: |
[Emacs-diffs] emacs/lisp ChangeLog pcomplete.el |
Date: |
Thu, 22 Oct 2009 15:17:53 +0000 |
CVSROOT: /sources/emacs
Module name: emacs
Changes by: Stefan Monnier <monnier> 09/10/22 15:17:52
Modified files:
lisp : ChangeLog pcomplete.el
Log message:
Allow the use of completion-tables.
(pcomplete-std-complete): New command.
(pcomplete-dirs-or-entries): Use a single call to pcomplete-entries.
(pcomplete--here): Use a function for `form' rather than an expression,
so it can be byte-compiled.
(pcomplete-here, pcomplete-here*): Adjust accordingly.
Add edebug declaration.
(pcomplete-show-completions): Remove unused var `curbuf'.
(pcomplete-do-complete, pcomplete-stub):
Don't assume `completions' is a list of strings any more.
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/ChangeLog?cvsroot=emacs&r1=1.16476&r2=1.16477
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/pcomplete.el?cvsroot=emacs&r1=1.40&r2=1.41
Patches:
Index: ChangeLog
===================================================================
RCS file: /sources/emacs/emacs/lisp/ChangeLog,v
retrieving revision 1.16476
retrieving revision 1.16477
diff -u -b -r1.16476 -r1.16477
--- ChangeLog 22 Oct 2009 09:42:22 -0000 1.16476
+++ ChangeLog 22 Oct 2009 15:17:48 -0000 1.16477
@@ -1,3 +1,16 @@
+2009-10-22 Stefan Monnier <address@hidden>
+
+ * pcomplete.el: Allow the use of completion-tables.
+ (pcomplete-std-complete): New command.
+ (pcomplete-dirs-or-entries): Use a single call to pcomplete-entries.
+ (pcomplete--here): Use a function for `form' rather than an expression,
+ so it can be byte-compiled.
+ (pcomplete-here, pcomplete-here*): Adjust accordingly.
+ Add edebug declaration.
+ (pcomplete-show-completions): Remove unused var `curbuf'.
+ (pcomplete-do-complete, pcomplete-stub):
+ Don't assume `completions' is a list of strings any more.
+
2009-10-22 Juanma Barranquero <address@hidden>
* find-dired.el (find-name-arg): Fix typo in docstring.
Index: pcomplete.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/pcomplete.el,v
retrieving revision 1.40
retrieving revision 1.41
diff -u -b -r1.40 -r1.41
--- pcomplete.el 12 Jul 2009 16:20:53 -0000 1.40
+++ pcomplete.el 22 Oct 2009 15:17:52 -0000 1.41
@@ -60,8 +60,9 @@
;; it means no completions were available.
;;
;; @ In order to provide completions, they must throw the tag
-;; `pcomplete-completions'. The value must be the list of possible
-;; completions for the final argument.
+;; `pcomplete-completions'. The value must be a completion table
+;; (i.e. a table that can be passed to try-completion and friends)
+;; for the final argument.
;;
;; @ To simplify completion function logic, the tag `pcompleted' may
;; be thrown with a value of nil in order to abort the function. It
@@ -118,7 +119,7 @@
;;; Code:
-(provide 'pcomplete)
+(eval-when-compile (require 'cl))
(defgroup pcomplete nil
"Programmable completion."
@@ -393,6 +394,41 @@
'(sole shortest))
pcomplete-last-completion-raw))))))
+(defun pcomplete-std-complete ()
+ "Provide standard completion using pcomplete's completion tables.
+Same as `pcomplete' but using the standard completion UI."
+ (interactive)
+ ;; FIXME: it fails to unquote/requote the arguments.
+ ;; FIXME: it doesn't implement paring.
+ ;; FIXME: when we bring up *Completions* we never bring it back down.
+ (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))
+ ;; The pcomplete code seems to presume that pcomplete-stub
+ ;; is always the text before point.
+ (ol (make-overlay (- (point) (length pcomplete-stub))
+ (point) nil nil t))
+ (minibuffer-completion-table
+ ;; 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.
+ (apply-partially 'completion-table-with-terminator
+ '(" " . "\\`a\\`") completions))
+ (minibuffer-completion-predicate nil))
+ (overlay-put ol 'field 'pcomplete)
+ (unwind-protect
+ (call-interactively 'minibuffer-complete)
+ (delete-overlay ol)))))
+
;;;###autoload
(defun pcomplete-reverse ()
"If cycling completion is in use, cycle backwards."
@@ -424,7 +460,7 @@
(pcomplete-expand-only-p t))
(pcomplete)
(when (and pcomplete-current-completions
- (> (length pcomplete-current-completions) 0))
+ (> (length pcomplete-current-completions) 0)) ;??
(delete-backward-char pcomplete-last-completion-length)
(while pcomplete-current-completions
(unless (pcomplete-insert-entry
@@ -599,7 +635,7 @@
;;;###autoload
(defun pcomplete-shell-setup ()
- "Setup shell-mode to use pcomplete."
+ "Setup `shell-mode' to use pcomplete."
(pcomplete-comint-setup 'shell-dynamic-complete-functions))
(declare-function comint-bol "comint" (&optional arg))
@@ -699,13 +735,15 @@
(defsubst pcomplete-dirs-or-entries (&optional regexp predicate)
"Return either directories, or qualified entries."
- (append (let ((pcomplete-stub pcomplete-stub))
+ ;; FIXME: pcomplete-entries doesn't return a list any more.
(pcomplete-entries
- regexp (or predicate
- (function
- (lambda (path)
- (not (file-directory-p path)))))))
- (pcomplete-entries nil 'file-directory-p)))
+ 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))))))))
(defun pcomplete-entries (&optional regexp predicate)
"Complete against a list of directory candidates.
@@ -873,7 +911,7 @@
(setq pcomplete-seen nil)
(unless (eq paring t)
(let ((arg (pcomplete-arg)))
- (unless (not (stringp arg))
+ (when (stringp arg)
(setq pcomplete-seen
(cons (if paring
(funcall paring arg)
@@ -891,12 +929,17 @@
(setq pcomplete-norm-func (or paring 'file-truename)))
(unless form-only
(run-hooks 'pcomplete-try-first-hook))
- (throw 'pcomplete-completions (eval form))))
+ (throw 'pcomplete-completions
+ (if (functionp form)
+ (funcall form)
+ ;; Old calling convention, might still be used by files
+ ;; byte-compiled with the older code.
+ (eval form)))))
(defmacro pcomplete-here (&optional form stub paring form-only)
"Complete against the current argument, if at the end.
-If completion is to be done here, evaluate FORM to generate the list
-of strings which will be used for completion purposes. If STUB is a
+If completion is to be done here, evaluate FORM to generate the completion
+table which will be used for completion purposes. If STUB is a
string, use it as the completion stub instead of the default (which is
the entire text of the current argument).
@@ -904,7 +947,7 @@
argument text is 'long-path-name/', you don't want the completions
list display to be cluttered by 'long-path-name/' appearing at the
beginning of every alternative. Not only does this make things less
-intelligle, but it is also inefficient. Yet, if the completion list
+intelligible, but it is also inefficient. Yet, if the completion list
does not begin with this string for every entry, the current argument
won't complete correctly.
@@ -923,11 +966,14 @@
If FORM-ONLY is non-nil, only the result of FORM will be used to
generate the completions list. This means that the hook
`pcomplete-try-first-hook' will not be run."
- `(pcomplete--here (quote ,form) ,stub ,paring ,form-only))
+ (declare (debug t))
+ `(pcomplete--here (lambda () ,form) ,stub ,paring ,form-only))
+
(defmacro pcomplete-here* (&optional form stub form-only)
"An alternate form which does not participate in argument paring."
- `(pcomplete-here ,form ,stub t ,form-only))
+ (declare (debug t))
+ `(pcomplete-here (lambda () ,form) ,stub t ,form-only))
;; display support
@@ -958,7 +1004,6 @@
(defun pcomplete-show-completions (completions)
"List in help buffer sorted COMPLETIONS.
Typing SPC flushes the help buffer."
- (let* ((curbuf (current-buffer)))
(when pcomplete-window-restore-timer
(cancel-timer pcomplete-window-restore-timer)
(setq pcomplete-window-restore-timer nil))
@@ -995,7 +1040,7 @@
pcomplete-restore-window-delay)
(setq pcomplete-window-restore-timer
(run-with-timer pcomplete-restore-window-delay nil
- 'pcomplete-restore-windows)))))))
+ 'pcomplete-restore-windows))))))
;; insert completion at point
@@ -1043,40 +1088,25 @@
(message "No completions of %s" stub)
(message "No completions")))
;; pare it down, if applicable
- (if (and pcomplete-use-paring pcomplete-seen)
- (let* ((arg (pcomplete-arg))
- (prefix
- (file-name-as-directory
- (funcall pcomplete-norm-func
- (substring arg 0 (- (length arg)
- (length pcomplete-stub)))))))
+ (when (and pcomplete-use-paring pcomplete-seen)
(setq pcomplete-seen
(mapcar 'directory-file-name pcomplete-seen))
- (let ((p pcomplete-seen))
- (while p
+ (dolist (p pcomplete-seen)
(add-to-list 'pcomplete-seen
- (funcall pcomplete-norm-func (car p)))
- (setq p (cdr p))))
+ (funcall pcomplete-norm-func p)))
(setq completions
- (mapcar
- (function
- (lambda (elem)
- (file-relative-name elem prefix)))
- (pcomplete-pare-list
- (mapcar
- (function
- (lambda (elem)
- (expand-file-name elem prefix)))
- completions)
- pcomplete-seen
- (function
- (lambda (elem)
- (member (directory-file-name
- (funcall pcomplete-norm-func elem))
- pcomplete-seen))))))))
+ (apply-partially 'completion-table-with-predicate
+ completions
+ (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
- (pcomplete-show-completions completions)
+ ;; FIXME: pay attention to boundaries.
+ (pcomplete-show-completions (all-completions stub completions))
(pcomplete-stub stub completions))))
(defun pcomplete-stub (stub candidates &optional cycle-p)
@@ -1093,29 +1123,32 @@
See also `pcomplete-filename'."
(let* ((completion-ignore-case pcomplete-ignore-case)
- (candidates (mapcar 'list candidates))
- (completions (all-completions stub candidates)))
- (let (result entry)
+ (completions (all-completions stub candidates))
+ (entry (try-completion stub candidates))
+ result)
(cond
- ((null completions)
+ ((null entry)
(if (and stub (> (length stub) 0))
(message "No completions of %s" stub)
(message "No completions")))
+ ((eq entry t)
+ (setq entry stub)
+ (message "Sole completion")
+ (setq result 'sole))
((= 1 (length completions))
- (setq entry (car completions))
- (if (string-equal entry stub)
- (message "Sole completion"))
(setq result 'sole))
((and pcomplete-cycle-completions
(or cycle-p
(not pcomplete-cycle-cutoff-length)
(<= (length completions)
pcomplete-cycle-cutoff-length)))
+ (let ((bound (car (completion-boundaries stub candidates nil ""))))
+ (unless (zerop bound)
+ (setq completions (mapcar (lambda (c) (concat (substring stub 0
bound) c))
+ completions)))
(setq entry (car completions)
- pcomplete-current-completions completions))
- (t ; There's no unique completion; use longest substring
- (setq entry (try-completion stub candidates))
- (cond ((and pcomplete-recexact
+ pcomplete-current-completions completions)))
+ ((and pcomplete-recexact
(string-equal stub entry)
(member entry completions))
;; It's not unique, but user wants shortest match.
@@ -1124,12 +1157,13 @@
((or pcomplete-autolist
(string-equal stub entry))
;; It's not unique, list possible completions.
+ ;; FIXME: pay attention to boundaries.
(pcomplete-show-completions completions)
(setq result 'listed))
(t
(message "Partially completed")
- (setq result 'partial)))))
- (cons result entry))))
+ (setq result 'partial)))
+ (cons result entry)))
;; context sensitive help
@@ -1194,14 +1228,16 @@
;; create a set of aliases which allow completion functions to be not
;; quite so verbose
-;; jww (1999-10-20): are these a good idea?
-; (defalias 'pc-here 'pcomplete-here)
-; (defalias 'pc-test 'pcomplete-test)
-; (defalias 'pc-opt 'pcomplete-opt)
-; (defalias 'pc-match 'pcomplete-match)
-; (defalias 'pc-match-string 'pcomplete-match-string)
-; (defalias 'pc-match-beginning 'pcomplete-match-beginning)
-; (defalias 'pc-match-end 'pcomplete-match-end)
+;;; jww (1999-10-20): are these a good idea?
+;; (defalias 'pc-here 'pcomplete-here)
+;; (defalias 'pc-test 'pcomplete-test)
+;; (defalias 'pc-opt 'pcomplete-opt)
+;; (defalias 'pc-match 'pcomplete-match)
+;; (defalias 'pc-match-string 'pcomplete-match-string)
+;; (defalias 'pc-match-beginning 'pcomplete-match-beginning)
+;; (defalias 'pc-match-end 'pcomplete-match-end)
+
+(provide 'pcomplete)
;; arch-tag: ae32ef2d-dbed-4244-8b0f-cf5a2a3b07a4
;;; pcomplete.el ends here
- [Emacs-diffs] emacs/lisp ChangeLog pcomplete.el,
Stefan Monnier <=