# HG changeset patch # User Stefan Monnier # Date 1208124722 0 # Node ID 9fefa536be587356f0c94c5b7182c2fbf853732a # Parent d4e9da5a29d51cea6c72a933665733d79f33f0bd * 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. diff -r d4e9da5a29d5 -r 9fefa536be58 etc/NEWS --- a/etc/NEWS Sun Apr 13 18:07:54 2008 +0000 +++ b/etc/NEWS Sun Apr 13 22:12:02 2008 +0000 @@ -732,6 +732,13 @@ * 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. diff -r d4e9da5a29d5 -r 9fefa536be58 lisp/ChangeLog --- a/lisp/ChangeLog Sun Apr 13 18:07:54 2008 +0000 +++ b/lisp/ChangeLog Sun Apr 13 22:12:02 2008 +0000 @@ -1,10 +1,35 @@ +2008-04-13 Stefan Monnier + + * 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 * 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. diff -r d4e9da5a29d5 -r 9fefa536be58 lisp/info.el --- a/lisp/info.el Sun Apr 13 18:07:54 2008 +0000 +++ b/lisp/info.el Sun Apr 13 22:12:02 2008 +0000 @@ -1513,20 +1513,15 @@ (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 @@ ((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) diff -r d4e9da5a29d5 -r 9fefa536be58 lisp/loadup.el --- a/lisp/loadup.el Sun Apr 13 18:07:54 2008 +0000 +++ b/lisp/loadup.el Sun Apr 13 22:12:02 2008 +0000 @@ -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") diff -r d4e9da5a29d5 -r 9fefa536be58 lisp/minibuffer.el --- a/lisp/minibuffer.el Sun Apr 13 18:07:54 2008 +0000 +++ b/lisp/minibuffer.el Sun Apr 13 22:12:02 2008 +0000 @@ -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,9 +360,10 @@ (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 @@ (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 @@ (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 @@ (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. diff -r d4e9da5a29d5 -r 9fefa536be58 lisp/simple.el --- a/lisp/simple.el Sun Apr 13 18:07:54 2008 +0000 +++ b/lisp/simple.el Sun Apr 13 22:12:02 2008 +0000 @@ -5234,18 +5234,17 @@ ;; 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 @@ (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 \\\\[choose-completion] in the completion list\ to select the completion near point. @@ -5433,15 +5432,7 @@ 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 @@ (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