procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* minibuffer.el (completion-all-completion-with-base-size): New var.

Browse source 
(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.
This commit is contained in:
Stefan Monnier 2008-04-13 22:12:02 +00:00
parent d41080ca3f
commit e2947429e7
6 changed files with 191 additions and 95 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
etc/NEWS
View file

@ -732,6 +732,13 @@ functions and variables (formerly used for Tamil script).
* Lisp Changes in Emacs 23.1
** `all-completions' may now return the base size in the last cdr.
Since this means the returned list is not properly nil-terminated, this
is an incompatible change and is thus enabled by the new variable
completion-all-completions-with-base-size.
** New function `apply-partially' for curried application.
** `fill-forward-paragraph-function' specifies which function the filling
code should use to find paragraph boundaries.

27
lisp/ChangeLog
View file

@ -1,10 +1,35 @@
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.

39
lisp/info.el
View file

@ -1513,20 +1513,15 @@ PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
(cond
;; First complete embedded file names.
((string-match "\\`([^)]*\\'" string)
(let ((file (substring string 1)))
(cond
((eq code nil)
(let ((comp (try-completion file 'Info-read-node-name-2
(cons Info-directory-list
(mapcar 'car Info-suffix-list)))))
(cond
((eq comp t) (concat string ")"))
(comp (concat "(" comp)))))
((eq code t)
(all-completions file 'Info-read-node-name-2
(cons Info-directory-list
(mapcar 'car Info-suffix-list))))
(t nil))))
(completion-table-with-context
"("
(apply-partially 'completion-table-with-terminator
")" 'Info-read-node-name-2)
(substring string 1)
(cons Info-directory-list
(mapcar 'car Info-suffix-list))
code))
;; If a file name was given, then any node is fair game.
((string-match "\\`(" string)
(cond
@ -1534,21 +1529,11 @@ PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
((eq code t) nil)
(t t)))
;; Otherwise use Info-read-node-completion-table.
((eq code nil)
(try-completion string Info-read-node-completion-table predicate))
((eq code t)
(all-completions string Info-read-node-completion-table predicate))
(t
(test-completion string Info-read-node-completion-table predicate))))
(t (complete-with-action
code Info-read-node-completion-table string predicate))))
;; Arrange to highlight the proper letters in the completion list buffer.
(put 'Info-read-node-name-1 'completion-base-size-function
(lambda ()
(if (string-match "\\`([^)]*\\'"
(or completion-common-substring
(minibuffer-completion-contents)))
1
0)))
(defun Info-read-node-name (prompt)
(let* ((completion-ignore-case t)

2
lisp/loadup.el
View file

@ -89,6 +89,7 @@
(file-error (load "ldefs-boot.el")))
(message "%s" (garbage-collect))
(load "abbrev") ;lisp-mode.el and simple.el use define-abbrev-table.
(load "simple")
(load "help")
@ -160,7 +161,6 @@
(load "textmodes/page")
(load "register")
(load "textmodes/paragraphs")
(load "abbrev") ;lisp-mode.el uses define-abbrev-table.
(load "emacs-lisp/lisp-mode")
(load "textmodes/text-mode")
(load "textmodes/fill")

140
lisp/minibuffer.el
View file

@ -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 @@ You should give VAR a non-nil `risky-local-variable' property."
(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 @@ You should give VAR a non-nil `risky-local-variable' property."
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 @@ the second failed attempt to complete."
: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 @@ E = after completion we now have an Exact match.
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,9 +360,10 @@ a repetition of this command will exit."
(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.
@ -325,7 +396,7 @@ a repetition of this command will exit."
(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,8 +440,8 @@ a repetition of this command will exit."
(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.
@ -492,7 +563,12 @@ during running `completion-setup-hook'."
(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 @@ during running `completion-setup-hook'."
(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 @@ during running `completion-setup-hook'."
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 @@ during running `completion-setup-hook'."
(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.

71
lisp/simple.el
View file

@ -5234,18 +5234,17 @@ With a prefix argument, set VARIABLE to VALUE buffer-locally."
;; 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)
@ -5425,7 +5424,7 @@ to decide what to delete."
(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.
@ -5433,15 +5432,7 @@ Use \\<completion-list-mode-map>\\[mouse-choose-completion] to select one\
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.
@ -5502,27 +5493,25 @@ of the minibuffer before point is always the common substring.)")
(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