X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/cc37e70f6699cbadb1a8f5467e8dc9fcea986aa1..a2f5f4319321478cbfd4b26f9c6e7d4de776ae26:/lisp/icomplete.el diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 768692281f..fccb2644cc 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -1,7 +1,7 @@ ;;; icomplete.el --- minibuffer completion incremental feedback -;; Copyright (C) 1992-1994, 1997, 1999, 2001-2012 -;; Free Software Foundation, Inc. +;; Copyright (C) 1992-1994, 1997, 1999, 2001-2013 Free Software +;; Foundation, Inc. ;; Author: Ken Manheimer ;; Maintainer: Ken Manheimer @@ -74,7 +74,19 @@ (defcustom icomplete-separator " | " "String used by icomplete to separate alternatives in the minibuffer." :type 'string - :version "24.3") + :version "24.4") + +(defcustom icomplete-hide-common-prefix t + "When non-nil, hide common prefix from completion candidates. +When nil, show candidates in full." + :type 'boolean + :version "24.4" + :group 'icomplete) + +(defface icomplete-first-match '((t :weight bold)) + "Face used by icomplete for highlighting first match." + :version "24.4" + :group 'icomplete) ;;;_* User Customization variables (defcustom icomplete-prospects-height @@ -102,6 +114,9 @@ See `icomplete-delay-completions-threshold'." :type 'integer :group 'icomplete) +(defvar icomplete-in-buffer nil + "If non-nil, also use Icomplete when completing in non-mini buffers.") + (defcustom icomplete-minibuffer-setup-hook nil "Icomplete-specific customization of minibuffer setup. @@ -128,36 +143,30 @@ icompletion is occurring." (defvar icomplete-overlay (make-overlay (point-min) (point-min) nil t t) "Overlay used to display the list of completions.") -;;;_ = icomplete-pre-command-hook -(defvar icomplete-pre-command-hook nil - "Incremental-minibuffer-completion pre-command-hook. +(defun icomplete-pre-command-hook () + (let ((non-essential t)) + (icomplete-tidy))) -Is run in minibuffer before user input when `icomplete-mode' is non-nil. -Use `icomplete-mode' function to set it up properly for incremental -minibuffer completion.") -(add-hook 'icomplete-pre-command-hook 'icomplete-tidy) -;;;_ = icomplete-post-command-hook -(defvar icomplete-post-command-hook nil - "Incremental-minibuffer-completion post-command-hook. - -Is run in minibuffer after user input when `icomplete-mode' is non-nil. -Use `icomplete-mode' function to set it up properly for incremental -minibuffer completion.") -(add-hook 'icomplete-post-command-hook 'icomplete-exhibit) +(defun icomplete-post-command-hook () + (let ((non-essential t)) ;E.g. don't prompt for password! + (icomplete-exhibit))) ;;;_ = icomplete-with-completion-tables -(defvar icomplete-with-completion-tables '(internal-complete-buffer) +(defcustom icomplete-with-completion-tables t "Specialized completion tables with which icomplete should operate. Icomplete does not operate with any specialized completion tables -except those on this list.") +except those on this list." + :version "24.4" + :type '(choice (const :tag "All" t) + (repeat function))) (defvar icomplete-minibuffer-map (let ((map (make-sparse-keymap))) (define-key map [?\M-\t] 'minibuffer-force-complete) (define-key map [?\C-j] 'minibuffer-force-complete-and-exit) - (define-key map [?\C-s] 'icomplete-forward-completions) - (define-key map [?\C-r] 'icomplete-backward-completions) + (define-key map [?\C-.] 'icomplete-forward-completions) + (define-key map [?\C-,] 'icomplete-backward-completions) map)) (defun icomplete-forward-completions () @@ -165,23 +174,28 @@ except those on this list.") Second entry becomes the first and can be selected with `minibuffer-force-complete-and-exit'." (interactive) - (let* ((comps (completion-all-sorted-completions)) + (let* ((beg (icomplete--field-beg)) + (end (icomplete--field-end)) + (comps (completion-all-sorted-completions beg end)) (last (last comps))) - (setcdr last (cons (car comps) (cdr last))) - (completion--cache-all-sorted-completions (cdr comps)))) + (when comps + (setcdr last (cons (car comps) (cdr last))) + (completion--cache-all-sorted-completions beg end (cdr comps))))) (defun icomplete-backward-completions () "Step backward completions by one entry. Last entry becomes the first and can be selected with `minibuffer-force-complete-and-exit'." (interactive) - (let* ((comps (completion-all-sorted-completions)) + (let* ((beg (icomplete--field-beg)) + (end (icomplete--field-end)) + (comps (completion-all-sorted-completions beg end)) (last-but-one (last comps 2)) (last (cdr last-but-one))) - (when last + (when (consp last) ; At least two elements in comps (setcdr last-but-one (cdr last)) (push (car last) comps) - (completion--cache-all-sorted-completions comps)))) + (completion--cache-all-sorted-completions beg end comps)))) ;;;_ > icomplete-mode (&optional prefix) ;;;###autoload @@ -191,11 +205,32 @@ With a prefix argument ARG, enable Icomplete mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil." :global t :group 'icomplete - (if icomplete-mode - ;; The following is not really necessary after first time - - ;; no great loss. - (add-hook 'minibuffer-setup-hook 'icomplete-minibuffer-setup) - (remove-hook 'minibuffer-setup-hook 'icomplete-minibuffer-setup))) + (remove-hook 'minibuffer-setup-hook #'icomplete-minibuffer-setup) + (remove-hook 'completion-in-region-mode-hook #'icomplete--in-region-setup) + (when icomplete-mode + (when icomplete-in-buffer + (add-hook 'completion-in-region-mode-hook #'icomplete--in-region-setup)) + (add-hook 'minibuffer-setup-hook #'icomplete-minibuffer-setup))) + +(defun icomplete--completion-table () + (if (window-minibuffer-p) minibuffer-completion-table + (or (nth 2 completion-in-region--data) + (message "In %S (w=%S): %S" + (current-buffer) (selected-window) (window-minibuffer-p))))) +(defun icomplete--completion-predicate () + (if (window-minibuffer-p) minibuffer-completion-predicate + (nth 3 completion-in-region--data))) +(defun icomplete--field-string () + (if (window-minibuffer-p) (minibuffer-contents) + (buffer-substring-no-properties + (nth 0 completion-in-region--data) + (nth 1 completion-in-region--data)))) +(defun icomplete--field-beg () + (if (window-minibuffer-p) (minibuffer-prompt-end) + (nth 0 completion-in-region--data))) +(defun icomplete--field-end () + (if (window-minibuffer-p) (point-max) + (nth 1 completion-in-region--data))) ;;;_ > icomplete-simple-completing-p () (defun icomplete-simple-completing-p () @@ -204,17 +239,16 @@ the mode if ARG is omitted or nil." Conditions are: the selected window is a minibuffer, and not in the middle of macro execution, - and `minibuffer-completion-table' is not a symbol (which would + and the completion table is not a function (which would indicate some non-standard, non-simple completion mechanism, like file-name and other custom-func completions)." - (and (window-minibuffer-p (selected-window)) - (not executing-kbd-macro) - minibuffer-completion-table - (or (not (functionp minibuffer-completion-table)) - (eq icomplete-with-completion-tables t) - (member minibuffer-completion-table - icomplete-with-completion-tables)))) + (unless executing-kbd-macro + (let ((table (icomplete--completion-table))) + (and table + (or (not (functionp table)) + (eq icomplete-with-completion-tables t) + (member table icomplete-with-completion-tables)))))) ;;;_ > icomplete-minibuffer-setup () (defun icomplete-minibuffer-setup () @@ -224,16 +258,35 @@ Usually run by inclusion in `minibuffer-setup-hook'." (set (make-local-variable 'completion-show-inline-help) nil) (use-local-map (make-composed-keymap icomplete-minibuffer-map (current-local-map))) - (add-hook 'pre-command-hook - (lambda () (let ((non-essential t)) - (run-hooks 'icomplete-pre-command-hook))) - nil t) - (add-hook 'post-command-hook - (lambda () (let ((non-essential t)) ;E.g. don't prompt for password! - (run-hooks 'icomplete-post-command-hook))) - nil t) + (add-hook 'pre-command-hook #'icomplete-pre-command-hook nil t) + (add-hook 'post-command-hook #'icomplete-post-command-hook nil t) (run-hooks 'icomplete-minibuffer-setup-hook))) -; + +(defvar icomplete--in-region-buffer nil) + +(defun icomplete--in-region-setup () + (when (or (not completion-in-region-mode) + (and icomplete--in-region-buffer + (not (eq icomplete--in-region-buffer (current-buffer))))) + (with-current-buffer (or icomplete--in-region-buffer (current-buffer)) + (setq icomplete--in-region-buffer nil) + (delete-overlay icomplete-overlay) + (kill-local-variable 'completion-show-inline-help) + (remove-hook 'pre-command-hook 'icomplete-pre-command-hook t) + (remove-hook 'post-command-hook 'icomplete-post-command-hook t) + (message nil))) + (when (and completion-in-region-mode + icomplete-mode (icomplete-simple-completing-p)) + (setq icomplete--in-region-buffer (current-buffer)) + (set (make-local-variable 'completion-show-inline-help) nil) + (let ((tem (assq 'completion-in-region-mode + minor-mode-overriding-map-alist))) + (unless (memq icomplete-minibuffer-map (cdr tem)) + (setcdr tem (make-composed-keymap icomplete-minibuffer-map + (cdr tem))))) + (add-hook 'pre-command-hook 'icomplete-pre-command-hook nil t) + (add-hook 'post-command-hook 'icomplete-post-command-hook nil t))) + ;;;_* Completion @@ -250,32 +303,36 @@ and `minibuffer-setup-hook'." "Insert icomplete completions display. Should be run via minibuffer `post-command-hook'. See `icomplete-mode' and `minibuffer-setup-hook'." - (when (and icomplete-mode (icomplete-simple-completing-p)) + (when (and icomplete-mode + (icomplete-simple-completing-p)) ;Shouldn't be necessary. (save-excursion (goto-char (point-max)) ; Insert the match-status information: - (if (and (> (point-max) (minibuffer-prompt-end)) + (if (and (> (icomplete--field-end) (icomplete--field-beg)) buffer-undo-list ; Wait for some user input. (or ;; Don't bother with delay after certain number of chars: - (> (- (point) (field-beginning)) icomplete-max-delay-chars) + (> (- (point) (icomplete--field-beg)) + icomplete-max-delay-chars) ;; Don't delay if the completions are known. completion-all-sorted-completions ;; Don't delay if alternatives number is small enough: - (and (sequencep minibuffer-completion-table) - (< (length minibuffer-completion-table) + (and (sequencep (icomplete--completion-table)) + (< (length (icomplete--completion-table)) icomplete-delay-completions-threshold)) ;; Delay - give some grace time for next keystroke, before ;; embarking on computing completions: (sit-for icomplete-compute-delay))) - (let ((text (while-no-input - (icomplete-completions - (field-string) - minibuffer-completion-table - minibuffer-completion-predicate - (not minibuffer-completion-confirm)))) - (buffer-undo-list t) - deactivate-mark) + (let* ((field-string (icomplete--field-string)) + (text (while-no-input + (icomplete-completions + field-string + (icomplete--completion-table) + (icomplete--completion-predicate) + (if (window-minibuffer-p) + (not minibuffer-completion-confirm))))) + (buffer-undo-list t) + deactivate-mark) ;; Do nothing if while-no-input was aborted. (when (stringp text) (move-overlay icomplete-overlay (point) (point) (current-buffer)) @@ -305,15 +362,19 @@ The displays for unambiguous matches have ` [Matched]' appended matches exist. \(Keybindings for uniquely matched commands are exhibited within the square braces.)" - (let* ((md (completion--field-metadata (field-beginning))) - (comps (completion-all-sorted-completions)) + (let* ((minibuffer-completion-table candidates) + (minibuffer-completion-predicate predicate) + (md (completion--field-metadata (icomplete--field-beg))) + (comps (completion-all-sorted-completions + (icomplete--field-beg) (icomplete--field-end))) (last (if (consp comps) (last comps))) (base-size (cdr last)) (open-bracket (if require-match "(" "[")) (close-bracket (if require-match ")" "]"))) ;; `concat'/`mapconcat' is the slow part. (if (not (consp comps)) - (format " %sNo matches%s" open-bracket close-bracket) + (progn ;;(debug (format "Candidates=%S field=%S" candidates name)) + (format " %sNo matches%s" open-bracket close-bracket)) (if last (setcdr last nil)) (let* ((most-try (if (and base-size (> base-size 0)) @@ -337,12 +398,17 @@ are exhibited within the square braces.)" ((= compare (length name)) ;; Typical case: name is a prefix. (substring most compare)) - ((< compare 5) most) - (t (concat "..." (substring most compare)))) + ;; Don't bother truncating if it doesn't gain + ;; us at least 2 columns. + ((< compare 3) most) + (t (concat "…" (substring most compare)))) close-bracket))) ;;"-prospects" - more than one candidate - (prospects-len (+ (length determ) 6 ;; take {,...} into account - (string-width (buffer-string)))) + (prospects-len (+ (string-width + (or determ (concat open-bracket close-bracket))) + (string-width icomplete-separator) + 3 ;; take {…} into account + (string-width (buffer-string)))) (prospects-max ;; Max total length to use, including the minibuffer content. (* (+ icomplete-prospects-height @@ -350,44 +416,70 @@ are exhibited within the square braces.)" ;; one line, increase the allowable space accordingly. (/ prospects-len (window-width))) (window-width))) + ;; Find the common prefix among `comps'. + ;; We can't use the optimization below because its assumptions + ;; aren't always true, e.g. when completion-cycling (bug#10850): + ;; (if (eq t (compare-strings (car comps) nil (length most) + ;; most nil nil completion-ignore-case)) + ;; ;; Common case. + ;; (length most) + ;; Else, use try-completion. + (prefix (when icomplete-hide-common-prefix + (try-completion "" comps))) (prefix-len - ;; Find the common prefix among `comps'. - ;; We can't use the optimization below because its assumptions - ;; aren't always true, e.g. when completion-cycling (bug#10850): - ;; (if (eq t (compare-strings (car comps) nil (length most) - ;; most nil nil completion-ignore-case)) - ;; ;; Common case. - ;; (length most) - ;; Else, use try-completion. - (let ((comps-prefix (try-completion "" comps))) - (and (stringp comps-prefix) - (length comps-prefix)))) ;;) - - prospects most-is-exact comp limit) - (if (eq most-try t) ;; (or (null (cdr comps)) + (and (stringp prefix) + ;; Only hide the prefix if the corresponding info + ;; is already displayed via `most'. + (string-prefix-p prefix most t) + (length prefix))) ;;) + prospects comp limit) + (if (or (eq most-try t) (not (consp (cdr comps)))) (setq prospects nil) + (when (member name comps) + ;; NAME is complete but not unique. This scenario poses + ;; following UI issues: + ;; + ;; - When `icomplete-hide-common-prefix' is non-nil, NAME + ;; is stripped empty. This would make the entry + ;; inconspicuous. + ;; + ;; - Due to sorting of completions, NAME may not be the + ;; first of the prospects and could be hidden deep in + ;; the displayed string. + ;; + ;; - Because of `icomplete-prospects-height' , NAME may + ;; not even be displayed to the user. + ;; + ;; To circumvent all the above problems, provide a visual + ;; cue to the user via an "empty string" in the try + ;; completion field. + (setq determ (concat open-bracket "" close-bracket))) + ;; Compute prospects for display. (while (and comps (not limit)) (setq comp (if prefix-len (substring (car comps) prefix-len) (car comps)) comps (cdr comps)) - (cond ((string-equal comp "") (setq most-is-exact t)) - ((member comp prospects)) - (t (setq prospects-len - (+ (string-width comp) 1 prospects-len)) + (setq prospects-len + (+ (string-width comp) + (string-width icomplete-separator) + prospects-len)) (if (< prospects-len prospects-max) (push comp prospects) - (setq limit t)))))) + (setq limit t)))) + (setq prospects (nreverse prospects)) + ;; Decorate first of the prospects. + (when prospects + (let ((first (copy-sequence (pop prospects)))) + (put-text-property 0 (length first) + 'face 'icomplete-first-match first) + (push first prospects))) ;; Restore the base-size info, since completion-all-sorted-completions ;; is cached. (if last (setcdr last base-size)) (if prospects (concat determ "{" - (and most-is-exact - (substring icomplete-separator - (string-match "[^ ]" icomplete-separator))) - (mapconcat 'identity (nreverse prospects) - icomplete-separator) + (mapconcat 'identity prospects icomplete-separator) (and limit (concat icomplete-separator "…")) "}") (concat determ " [Matched]"))))))