+2008-04-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * minibuffer.el (completion-all-completion-with-base-size): New var.
+ (completion--some): New function.
+ (completion-table-with-context, completion--file-name-table):
+ Return the base-size if requested.
+ (completion-table-in-turn): Generalize to multiple arguments.
+ (complete-in-turn): Compatibility alias.
+ (completion-styles-alist): New var.
+ (completion-styles): New customization.
+ (minibuffer-try-completion, minibuffer-all-completions):
+ New functions.
+ (minibuffer--do-completion, minibuffer-complete-and-exit)
+ (minibuffer-try-word-completion): Use them.
+ (display-completion-list, minibuffer-completion-help): Use them.
+ Handle all-completions's new base-size info to set completion-base-size.
+ * info.el (Info-read-node-name-1): Use completion-table-with-context,
+ completion-table-with-terminator and complete-with-action.
+ Remove the now obsolete completion-base-size-function property.
+ * simple.el (completion-list-mode-map): Move init into declaration.
+ (completion-list-mode): Use define-derived-mode.
+ (completion-setup-function): Use any completion-base-size that may
+ have been set before. Remove handling of completion-base-size-function.
+ * loadup.el: Move abbrev.el up earlier.
+
2008-04-13 Alexandre Julliard <julliard@winehq.org>
* vc-git.el (vc-git-after-dir-status-stage)
(vc-git-dir-status-goto-stage): New functions.
(vc-git-after-dir-status-stage1)
(vc-git-after-dir-status-stage1-empty-db)
- (vc-git-after-dir-status-stage2): Removed, functionality moved
+ (vc-git-after-dir-status-stage2): Remove, functionality moved
into the new generic stage functions.
(vc-git-dir-status-files): New function.
;; 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.
(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)))))
(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)))
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
: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)
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)))
(when completion-ignore-case
;; Fixup case of the field, if necessary.
(let* ((string (field-string))
- (compl (try-completion string
- minibuffer-completion-table
- minibuffer-completion-predicate)))
+ (compl (minibuffer-try-completion
+ string
+ minibuffer-completion-table
+ minibuffer-completion-predicate)))
(when (and (stringp compl)
;; If it weren't for this piece of paranoia, I'd replace
;; the whole thing with a call to complete-do-completion.
(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
(let ((exts '(" " "-"))
tem)
(while (and exts (not (stringp tem)))
- (setq tem (try-completion (concat string (pop exts))
- table predicate)))
+ (setq tem (minibuffer-try-completion (concat string (pop exts))
+ table predicate)))
(if (stringp tem) (setq completion tem))))
;; Otherwise cut after the first word.
(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)
(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.
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)
(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.
\f
;; Define the major mode for lists of completions.
-(defvar completion-list-mode-map nil
+(defvar completion-list-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-2] 'mouse-choose-completion)
+ (define-key map [follow-link] 'mouse-face)
+ (define-key map [down-mouse-2] nil)
+ (define-key map "\C-m" 'choose-completion)
+ (define-key map "\e\e\e" 'delete-completion-window)
+ (define-key map [left] 'previous-completion)
+ (define-key map [right] 'next-completion)
+ map)
"Local map for completion list buffers.")
-(or completion-list-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [mouse-2] 'mouse-choose-completion)
- (define-key map [follow-link] 'mouse-face)
- (define-key map [down-mouse-2] nil)
- (define-key map "\C-m" 'choose-completion)
- (define-key map "\e\e\e" 'delete-completion-window)
- (define-key map [left] 'previous-completion)
- (define-key map [right] 'next-completion)
- (setq completion-list-mode-map map)))
;; Completion mode is suitable only for specially formatted data.
(put 'completion-list-mode 'mode-class 'special)
(raise-frame (window-frame mini))))
(exit-minibuffer)))))))
-(defun completion-list-mode ()
+(define-derived-mode completion-list-mode nil "Completion List"
"Major mode for buffers showing lists of possible completions.
Type \\<completion-list-mode-map>\\[choose-completion] in the completion list\
to select the completion near point.
with the mouse.
\\{completion-list-mode-map}"
-
- (interactive)
- (kill-all-local-variables)
- (use-local-map completion-list-mode-map)
- (setq mode-name "Completion List")
- (setq major-mode 'completion-list-mode)
- (make-local-variable 'completion-base-size)
- (setq completion-base-size nil)
- (run-mode-hooks 'completion-list-mode-hook))
+ (set (make-local-variable 'completion-base-size) nil))
(defun completion-list-mode-finish ()
"Finish setup of the completions buffer.
(setq default-directory
(file-name-directory (expand-file-name mbuf-contents)))))
(with-current-buffer standard-output
- (completion-list-mode)
+ (let ((base-size completion-base-size)) ;Read before killing localvars.
+ (completion-list-mode)
+ (set (make-local-variable 'completion-base-size) base-size))
(set (make-local-variable 'completion-reference-buffer) mainbuf)
- (setq completion-base-size
- (cond
- ((and (symbolp minibuffer-completion-table)
- (get minibuffer-completion-table 'completion-base-size-function))
- ;; To compute base size, a function can use the global value of
- ;; completion-common-substring or minibuffer-completion-contents.
- (with-current-buffer mainbuf
- (funcall (get minibuffer-completion-table
- 'completion-base-size-function))))
- (minibuffer-completing-file-name
- ;; For file name completion, use the number of chars before
- ;; the start of the file name component at point.
- (with-current-buffer mainbuf
- (save-excursion
- (skip-chars-backward completion-root-regexp)
- (- (point) (minibuffer-prompt-end)))))
- (minibuffer-completing-symbol nil)
- ;; Otherwise, in minibuffer, the base size is 0.
- ((minibufferp mainbuf) 0)))
+ (unless completion-base-size
+ ;; This may be needed for old completion packages which don't use
+ ;; completion-all-completions-with-base-size yet.
+ (setq completion-base-size
+ (cond
+ (minibuffer-completing-file-name
+ ;; For file name completion, use the number of chars before
+ ;; the start of the file name component at point.
+ (with-current-buffer mainbuf
+ (save-excursion
+ (skip-chars-backward completion-root-regexp)
+ (- (point) (minibuffer-prompt-end)))))
+ (minibuffer-completing-symbol nil)
+ ;; Otherwise, in minibuffer, the base size is 0.
+ ((minibufferp mainbuf) 0))))
(setq common-string-length
(cond
(completion-common-substring
HCoop / bpt / emacs.git / commitdiff