[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/minibuffer.el,v
From: |
Stefan Monnier |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/minibuffer.el,v |
Date: |
Sun, 13 Apr 2008 22:12:04 +0000 |
CVSROOT: /sources/emacs
Module name: emacs
Changes by: Stefan Monnier <monnier> 08/04/13 22:12:02
Index: lisp/minibuffer.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/minibuffer.el,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -b -r1.8 -r1.9
--- lisp/minibuffer.el 13 Apr 2008 01:47:42 -0000 1.8
+++ lisp/minibuffer.el 13 Apr 2008 22:12:01 -0000 1.9
@@ -24,6 +24,9 @@
;; Names starting with "minibuffer--" are for functions and variables that
;; are meant to be for internal use only.
+;; TODO:
+;; - make the `hide-spaces' arg of all-completions obsolete.
+
;; BUGS:
;; - envvar completion for file names breaks completion-base-size.
@@ -31,9 +34,27 @@
(eval-when-compile (require 'cl))
+(defvar completion-all-completions-with-base-size nil
+ "If non-nil, `all-completions' may return the base-size in the last cdr.
+The base-size is the length of the prefix that is elided from each
+element in the returned list of completions. See `completion-base-size'.")
+
;;; Completion table manipulation
+(defun completion--some (fun xs)
+ "Apply FUN to each element of XS in turn.
+Return the first non-nil returned value.
+Like CL's `some'."
+ (let (res)
+ (while (and (not res) xs)
+ (setq res (funcall fun (pop xs))))
+ res))
+
(defun apply-partially (fun &rest args)
+ "Do a \"curried\" partial application of FUN to ARGS.
+ARGS is a list of the first N arguments to pass to FUN.
+The result is a new function that takes the remaining arguments,
+and calls FUN."
(lexical-let ((fun fun) (args1 args))
(lambda (&rest args2) (apply fun (append args1 args2)))))
@@ -90,14 +111,23 @@
(defun completion-table-with-context (prefix table string pred action)
;; TODO: add `suffix', and think about how we should support `pred'.
- ;; Notice that `pred' is not a predicate when called from read-file-name.
+ ;; Notice that `pred' is not a predicate when called from read-file-name
+ ;; or Info-read-node-name-2.
;; (if pred (setq pred (lexical-let ((pred pred))
;; ;; FIXME: this doesn't work if `table' is an
obarray.
;; (lambda (s) (funcall pred (concat prefix s))))))
- (let ((comp (complete-with-action action table string nil))) ;; pred
- (if (stringp comp)
- (concat prefix comp)
- comp)))
+ (let ((comp (complete-with-action action table string pred)))
+ (cond
+ ;; In case of try-completion, add the prefix.
+ ((stringp comp) (concat prefix comp))
+ ;; In case of non-empty all-completions,
+ ;; add the prefix size to the base-size.
+ ((consp comp)
+ (let ((last (last comp)))
+ (when completion-all-completions-with-base-size
+ (setcdr last (+ (or (cdr last) 0) (length prefix))))
+ comp))
+ (t comp))))
(defun completion-table-with-terminator (terminator table string pred action)
(let ((comp (complete-with-action action table string pred)))
@@ -110,13 +140,17 @@
comp))
comp)))
-(defun completion-table-in-turn (a b)
- "Create a completion table that first tries completion in A and then in B.
-A and B should not be costly (or side-effecting) expressions."
- (lexical-let ((a a) (b b))
+(defun completion-table-in-turn (&rest tables)
+ "Create a completion table that tries each table in TABLES in turn."
+ (lexical-let ((tables tables))
(lambda (string pred action)
- (or (complete-with-action action a string pred)
- (complete-with-action action b string pred)))))
+ (completion--some (lambda (table)
+ (complete-with-action action table string pred))
+ tables))))
+
+(defmacro complete-in-turn (a b) `(completion-table-in-turn ,a ,b))
+(define-obsolete-function-alias
+ 'complete-in-turn 'completion-table-in-turn "23.1")
;;; Minibuffer completion
@@ -162,6 +196,41 @@
:type '(choice (const nil) (const t) (const lazy))
:group 'minibuffer)
+(defvar completion-styles-alist
+ '((basic try-completion all-completions)
+ ;; (partial-completion
+ ;; completion-pcm--try-completion completion-pcm--all-completions)
+ )
+ "List of available completion styles.
+Each element has the form (NAME TRY-COMPLETION ALL-COMPLETIONS)
+where NAME is the name that should be used in `completion-styles'
+TRY-COMPLETION is the function that does the completion, and
+ALL-COMPLETIONS is the function that lists the completions.")
+
+(defcustom completion-styles '(basic)
+ "List of completion styles to use."
+ :type `(repeat (choice ,@(mapcar (lambda (x) (list 'const (car x)))
+ completion-styles-alist)))
+ :group 'minibuffer
+ :version "23.1")
+
+(defun minibuffer-try-completion (string table pred)
+ (if (and (symbolp table) (get table 'no-completion-styles))
+ (try-completion string table pred)
+ (completion--some (lambda (style)
+ (funcall (intern (concat style "try-completion"))
+ string table pred))
+ completion-styles)))
+
+(defun minibuffer-all-completions (string table pred &optional hide-spaces)
+ (let ((completion-all-completions-with-base-size t))
+ (if (and (symbolp table) (get table 'no-completion-styles))
+ (all-completions string table pred hide-spaces)
+ (completion--some (lambda (style)
+ (funcall (intern (concat style "all-completions"))
+ string table pred hide-spaces))
+ completion-styles))))
+
(defun minibuffer--bitset (modified completions exact)
(logior (if modified 4 0)
(if completions 2 0)
@@ -184,7 +253,8 @@
111 7 completed to an exact completion"
(let* ((beg (field-beginning))
(string (buffer-substring beg (point)))
- (completion (funcall (or try-completion-function 'try-completion)
+ (completion (funcall (or try-completion-function
+ 'minibuffer-try-completion)
string
minibuffer-completion-table
minibuffer-completion-predicate)))
@@ -290,7 +360,8 @@
(when completion-ignore-case
;; Fixup case of the field, if necessary.
(let* ((string (field-string))
- (compl (try-completion string
+ (compl (minibuffer-try-completion
+ string
minibuffer-completion-table
minibuffer-completion-predicate)))
(when (and (stringp compl)
@@ -325,7 +396,7 @@
(t nil)))))
(defun minibuffer-try-word-completion (string table predicate)
- (let ((completion (try-completion string table predicate)))
+ (let ((completion (minibuffer-try-completion string table predicate)))
(if (not (stringp completion))
completion
@@ -369,7 +440,7 @@
(let ((exts '(" " "-"))
tem)
(while (and exts (not (stringp tem)))
- (setq tem (try-completion (concat string (pop exts))
+ (setq tem (minibuffer-try-completion (concat string (pop exts))
table predicate)))
(if (stringp tem) (setq completion tem))))
@@ -492,7 +563,12 @@
(insert "There are no possible completions of what you have typed.")
(insert "Possible completions are:\n")
+ (let ((last (last completions)))
+ ;; Get the base-size from the tail of the list.
+ (set (make-local-variable 'completion-base-size) (or (cdr last) 0))
+ (setcdr last nil)) ;Make completions a properly nil-terminated list.
(minibuffer--insert-strings completions))))
+
(let ((completion-common-substring common-substring))
(run-hooks 'completion-setup-hook))
nil)
@@ -502,16 +578,23 @@
(interactive)
(message "Making completion list...")
(let* ((string (field-string))
- (completions (all-completions
+ (completions (minibuffer-all-completions
string
minibuffer-completion-table
minibuffer-completion-predicate
t)))
(message nil)
(if (and completions
- (or (cdr completions) (not (equal (car completions) string))))
+ (or (consp (cdr completions))
+ (not (equal (car completions) string))))
(with-output-to-temp-buffer "*Completions*"
- (display-completion-list (sort completions 'string-lessp)))
+ (let* ((last (last completions))
+ (base-size (cdr last)))
+ ;; Remove the base-size tail because `sort' requires a properly
+ ;; nil-terminated list.
+ (when last (setcdr last nil))
+ (display-completion-list (nconc (sort completions 'string-lessp)
+ base-size))))
;; If there are no completions, or if the current input is already the
;; only possible completion, then hide (previous&stale) completions.
@@ -597,9 +680,13 @@
str))))
((eq action t)
- (let ((all (file-name-all-completions name realdir)))
- (if (memq read-file-name-predicate '(nil file-exists-p))
- all
+ (let ((all (file-name-all-completions name realdir))
+ ;; Actually, this is not always right in the presence of
+ ;; envvars, but there's not much we can do, I think.
+ (base-size (length (file-name-directory string))))
+
+ ;; Check the predicate, if necessary.
+ (unless (memq read-file-name-predicate '(nil file-exists-p))
(let ((comp ())
(pred
(if (eq read-file-name-predicate 'file-directory-p)
@@ -613,7 +700,10 @@
(let ((default-directory realdir))
(dolist (tem all)
(if (funcall pred tem) (push tem comp))))
- (nreverse comp)))))
+ (setq all (nreverse comp))))
+
+ ;; Add base-size, but only if the list is non-empty.
+ (if (consp all) (nconc all base-size))))
(t
;; Only other case actually used is ACTION = lambda.
- [Emacs-diffs] Changes to emacs/lisp/minibuffer.el,v, Stefan Monnier, 2008/04/09
- [Emacs-diffs] Changes to emacs/lisp/minibuffer.el,v, Juanma Barranquero, 2008/04/09
- [Emacs-diffs] Changes to emacs/lisp/minibuffer.el,v, Stefan Monnier, 2008/04/09
- [Emacs-diffs] Changes to emacs/lisp/minibuffer.el,v, Stefan Monnier, 2008/04/09
- [Emacs-diffs] Changes to emacs/lisp/minibuffer.el,v, Stefan Monnier, 2008/04/11
- [Emacs-diffs] Changes to emacs/lisp/minibuffer.el,v, Johan Bockgård, 2008/04/11
- [Emacs-diffs] Changes to emacs/lisp/minibuffer.el,v, Juanma Barranquero, 2008/04/12
- [Emacs-diffs] Changes to emacs/lisp/minibuffer.el,v,
Stefan Monnier <=
- [Emacs-diffs] Changes to emacs/lisp/minibuffer.el,v, Stefan Monnier, 2008/04/13
- [Emacs-diffs] Changes to emacs/lisp/minibuffer.el,v, Stefan Monnier, 2008/04/13
- [Emacs-diffs] Changes to emacs/lisp/minibuffer.el,v, Stefan Monnier, 2008/04/14
- [Emacs-diffs] Changes to emacs/lisp/minibuffer.el,v, Stefan Monnier, 2008/04/14
- [Emacs-diffs] Changes to emacs/lisp/minibuffer.el,v, Stefan Monnier, 2008/04/17
- [Emacs-diffs] Changes to emacs/lisp/minibuffer.el,v, Miles Bader, 2008/04/17
- [Emacs-diffs] Changes to emacs/lisp/minibuffer.el,v, Stefan Monnier, 2008/04/18
- [Emacs-diffs] Changes to emacs/lisp/minibuffer.el,v, Stefan Monnier, 2008/04/18
- [Emacs-diffs] Changes to emacs/lisp/minibuffer.el,v, Stefan Monnier, 2008/04/18
- [Emacs-diffs] Changes to emacs/lisp/minibuffer.el,v, Juanma Barranquero, 2008/04/20