From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Jambunathan K Newsgroups: gmane.emacs.bugs Subject: bug#12638: 24.2.50; FR: Some suggestions for icomplete-mode Date: Wed, 24 Oct 2012 01:38:02 +0530 Message-ID: <87mwzdrly5.fsf@gmail.com> References: <87391ieck9.fsf@gmail.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1351022846 20280 80.91.229.3 (23 Oct 2012 20:07:26 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 23 Oct 2012 20:07:26 +0000 (UTC) Cc: 12638@debbugs.gnu.org To: Stefan Monnier Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Tue Oct 23 22:07:33 2012 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1TQkl8-0006xC-SY for geb-bug-gnu-emacs@m.gmane.org; Tue, 23 Oct 2012 22:07:31 +0200 Original-Received: from localhost ([::1]:38523 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1TQkl0-0002Cy-Tb for geb-bug-gnu-emacs@m.gmane.org; Tue, 23 Oct 2012 16:07:22 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:59846) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1TQkkq-0002CO-Ms for bug-gnu-emacs@gnu.org; Tue, 23 Oct 2012 16:07:20 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1TQkkn-0000Nv-4P for bug-gnu-emacs@gnu.org; Tue, 23 Oct 2012 16:07:12 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:47986) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1TQkkm-0000No-VD for bug-gnu-emacs@gnu.org; Tue, 23 Oct 2012 16:07:09 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.72) (envelope-from ) id 1TQkmc-00015A-Cn for bug-gnu-emacs@gnu.org; Tue, 23 Oct 2012 16:09:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Jambunathan K Original-Sender: debbugs-submit-bounces@debbugs.gnu.org Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 23 Oct 2012 20:09:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 12638 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 12638-submit@debbugs.gnu.org id=B12638.13510228994109 (code B ref 12638); Tue, 23 Oct 2012 20:09:02 +0000 Original-Received: (at 12638) by debbugs.gnu.org; 23 Oct 2012 20:08:19 +0000 Original-Received: from localhost ([127.0.0.1]:58237 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1TQkls-00014C-BL for submit@debbugs.gnu.org; Tue, 23 Oct 2012 16:08:18 -0400 Original-Received: from mail-pb0-f44.google.com ([209.85.160.44]:36277) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1TQklm-00013t-5r for 12638@debbugs.gnu.org; Tue, 23 Oct 2012 16:08:14 -0400 Original-Received: by mail-pb0-f44.google.com with SMTP id ro8so663904pbb.3 for <12638@debbugs.gnu.org>; Tue, 23 Oct 2012 13:06:10 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version:content-type; bh=nOt2ZPwgUuAvjAosbe6B0NNb3l/xv7cL4p7yMjo99jw=; b=hPcJKBFS9oaFwdnrjKFGwVRaplIEtMFqemKu9Kg5XvIiWdZN7pAWjjkmDOZXIdbS4F n3h3Z1DrW0r/Nwmo5TdvyooCB9uEAwtJ0LJL7nwCtbm6qG01c9++w13CUDoHqDMT+ixN NKtkFy56868lDlQeD/yPw6KXvVsHepng06WiYqzSeR9PwM8EvcRfgUXBBrRspjGatpMn Q63NwxRuM4cgsmQmskh/xg+/0V7bKD1ha1Yn/H/vN69zETBT84KYTi7gQRVe7KOI1j6w abHoFRaT51AJVXkDrMm+szEYg8MD0X0I6MZAhlryLl2hi6CPkI1T6Ar3/U5RhZ6eZjoG vYrg== Original-Received: by 10.68.225.34 with SMTP id rh2mr43439208pbc.78.1351022770680; Tue, 23 Oct 2012 13:06:10 -0700 (PDT) Original-Received: from debian-6.05 ([115.241.54.191]) by mx.google.com with ESMTPS id wo9sm8171239pbc.53.2012.10.23.13.06.05 (version=TLSv1/SSLv3 cipher=OTHER); Tue, 23 Oct 2012 13:06:09 -0700 (PDT) In-Reply-To: (Stefan Monnier's message of "Tue, 23 Oct 2012 15:43:11 -0400") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.2.50 (gnu/linux) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.13 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 2) X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:65948 Archived-At: --=-=-= Content-Type: text/plain I do have a patch that works (which I am attaching). Not sure what you will think of it. You can patch it locally and see how it feels. Speaking of screen estate, I would like to get full view of the candidate, including prefix. This helps me make sense out of the candidate particularly when partial completion is on. Implementation wise, I may have taken a different (probably amateurish) route. --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=bug-12638-firstcut.diff Content-Description: bug-12638-firstcut.diff === modified file 'lisp/hi-lock.el' --- lisp/hi-lock.el 2012-10-07 00:27:31 +0000 +++ lisp/hi-lock.el 2012-10-23 12:44:54 +0000 @@ -135,12 +135,20 @@ ;; It can have a function value. (put 'hi-lock-file-patterns-policy 'risky-local-variable t) +(defcustom hi-lock-auto-select-face nil + "Non-nil if highlighting commands should not prompt for face names. +When non-nil, each hi-lock command will cycle through faces in +`hi-lock-face-defaults'." + :type 'boolean + :group 'hi-lock + :version "24.3") + (defgroup hi-lock-faces nil "Faces for hi-lock." :group 'hi-lock :group 'faces) -(defface hi-yellow +(defface hi-lock-1 '((((min-colors 88) (background dark)) (:background "yellow1" :foreground "black")) (((background dark)) (:background "yellow" :foreground "black")) @@ -149,13 +157,13 @@ "Default face for hi-lock mode." :group 'hi-lock-faces) -(defface hi-pink +(defface hi-lock-2 '((((background dark)) (:background "pink" :foreground "black")) (t (:background "pink"))) "Face for hi-lock mode." :group 'hi-lock-faces) -(defface hi-green +(defface hi-lock-3 '((((min-colors 88) (background dark)) (:background "green1" :foreground "black")) (((background dark)) (:background "green" :foreground "black")) @@ -164,40 +172,50 @@ "Face for hi-lock mode." :group 'hi-lock-faces) -(defface hi-blue +(defface hi-lock-4 '((((background dark)) (:background "light blue" :foreground "black")) (t (:background "light blue"))) "Face for hi-lock mode." :group 'hi-lock-faces) -(defface hi-black-b +(defface hi-lock-5 '((t (:weight bold))) "Face for hi-lock mode." :group 'hi-lock-faces) -(defface hi-blue-b +(defface hi-lock-6 '((((min-colors 88)) (:weight bold :foreground "blue1")) (t (:weight bold :foreground "blue"))) "Face for hi-lock mode." :group 'hi-lock-faces) -(defface hi-green-b +(defface hi-lock-7 '((((min-colors 88)) (:weight bold :foreground "green1")) (t (:weight bold :foreground "green"))) "Face for hi-lock mode." :group 'hi-lock-faces) -(defface hi-red-b +(defface hi-lock-8 '((((min-colors 88)) (:weight bold :foreground "red1")) (t (:weight bold :foreground "red"))) "Face for hi-lock mode." :group 'hi-lock-faces) -(defface hi-black-hb +(defface hi-lock-9 '((t (:weight bold :height 1.67 :inherit variable-pitch))) "Face for hi-lock mode." :group 'hi-lock-faces) +(define-obsolete-face-alias 'hi-yellow 'hi-lock-1 "24.3") +(define-obsolete-face-alias 'hi-pink 'hi-lock-2 "24.3") +(define-obsolete-face-alias 'hi-green 'hi-lock-3 "24.3") +(define-obsolete-face-alias 'hi-blue 'hi-lock-4 "24.3") +(define-obsolete-face-alias 'hi-black-b 'hi-lock-5 "24.3") +(define-obsolete-face-alias 'hi-blue-b 'hi-lock-6 "24.3") +(define-obsolete-face-alias 'hi-green-b 'hi-lock-7 "24.3") +(define-obsolete-face-alias 'hi-red-b 'hi-lock-8 "24.3") +(define-obsolete-face-alias 'hi-black-hb 'hi-lock-9 "24.3") + (defvar hi-lock-file-patterns nil "Patterns found in file for hi-lock. Should not be changed.") @@ -207,12 +225,19 @@ (define-obsolete-variable-alias 'hi-lock-face-history 'hi-lock-face-defaults "23.1") (defvar hi-lock-face-defaults - '("hi-yellow" "hi-pink" "hi-green" "hi-blue" "hi-black-b" - "hi-blue-b" "hi-red-b" "hi-green-b" "hi-black-hb") + '("hi-lock-1" "hi-lock-2" "hi-lock-3" "hi-lock-4" "hi-lock-5" + "hi-lock-6" "hi-lock-7" "hi-lock-8" "hi-lock-9") "Default faces for hi-lock interactive functions.") -;;(dolist (f hi-lock-face-defaults) -;; (unless (facep f) (error "%s not a face" f))) +(defvar hi-lock-auto-select-face-defaults + (let ((l (copy-sequence hi-lock-face-defaults))) + (setcdr (last l) l)) + "Circular list of faces used for interactive highlighting. +When `hi-lock-auto-select-face' is non-nil, use the face at the +head of this list for next interactive highlighting. See also +`hi-lock-read-face-name'.") + +(make-variable-buffer-local 'hi-lock-auto-select-face-defaults) (define-obsolete-variable-alias 'hi-lock-regexp-history 'regexp-history @@ -408,9 +433,9 @@ (interactive (list (hi-lock-regexp-okay - (read-regexp "Regexp to highlight line" (car regexp-history))) + (read-regexp "Regexp to highlight line")) (hi-lock-read-face-name))) - (or (facep face) (setq face 'hi-yellow)) + (or (facep face) (setq face 'hi-lock-1)) (unless hi-lock-mode (hi-lock-mode 1)) (hi-lock-set-pattern ;; The \\(?:...\\) grouping construct ensures that a leading ^, +, * or ? @@ -433,9 +458,9 @@ (interactive (list (hi-lock-regexp-okay - (read-regexp "Regexp to highlight" (car regexp-history))) + (read-regexp "Regexp to highlight")) (hi-lock-read-face-name))) - (or (facep face) (setq face 'hi-yellow)) + (or (facep face) (setq face 'hi-lock-1)) (unless hi-lock-mode (hi-lock-mode 1)) (hi-lock-set-pattern regexp face)) @@ -455,9 +480,9 @@ (list (hi-lock-regexp-okay (hi-lock-process-phrase - (read-regexp "Phrase to highlight" (car regexp-history)))) + (read-regexp "Phrase to highlight"))) (hi-lock-read-face-name))) - (or (facep face) (setq face 'hi-yellow)) + (or (facep face) (setq face 'hi-lock-1)) (unless hi-lock-mode (hi-lock-mode 1)) (hi-lock-set-pattern regexp face)) @@ -466,10 +491,18 @@ ;;;###autoload (defalias 'unhighlight-regexp 'hi-lock-unface-buffer) ;;;###autoload -(defun hi-lock-unface-buffer (regexp) +(defun hi-lock-unface-buffer (regexp &optional prefix-arg) "Remove highlighting of each match to REGEXP set by hi-lock. -Interactively, prompt for REGEXP, accepting only regexps -previously inserted by hi-lock interactive functions." +Interactively, when PREFIX-ARG is non-nil, unhighlight all +highlighted text in current buffer. When PREFIX-ARG is nil, +prompt for REGEXP. If the cursor is on a previously highlighted +text and if the associated regexp can be inferred via simple +heuristics, offer that regexp as default. Otherwise, prompt for +REGEXP with completion and limit the choices to only those +regexps used previously with hi-lock commands. + +If this command is invoked via menu, pop-up a list of currently +highlighted patterns." (interactive (if (and (display-popup-menus-p) (listp last-nonmenu-event) @@ -497,23 +530,63 @@ ;; To prevent that, we return an empty string, which will ;; effectively disable the rest of the function. (throw 'snafu '("")))) - (let ((history-list (mapcar (lambda (p) (car p)) - hi-lock-interactive-patterns))) - (unless hi-lock-interactive-patterns - (error "No highlighting to remove")) + ;; Un-highlighting triggered via keyboard action. + (unless hi-lock-interactive-patterns + (error "No highlighting to remove")) + ;; Infer the regexp to un-highlight based on cursor position. + (let* (candidate-hi-lock-patterns + (default-regexp + (or + ;; When using overlays, there is no ambiguity on the best + ;; choice of regexp. + (let ((desired-serial (get-char-property + (point) 'hi-lock-overlay-regexp))) + (when desired-serial + (catch 'regexp + (maphash + (lambda (regexp serial) + (when (= serial desired-serial) + (throw 'regexp regexp))) + hi-lock-string-serialize-hash)))) + ;; With font-locking on, check if the cursor is on an + ;; highlighted text. Checking for hi-lock face is a + ;; good heuristic. + (and (string-match "\\`hi-lock-" (face-name (face-at-point))) + (let* ((hi-text + (buffer-substring-no-properties + (previous-single-property-change (point) 'face) + (next-single-property-change (point) 'face)))) + ;; Compute hi-lock patterns that match the + ;; highlighted text at point. Use this later in + ;; during completing-read. + (setq candidate-hi-lock-patterns + (delq nil + (mapcar + (lambda (hi-lock-pattern) + (let ((regexp (car hi-lock-pattern))) + (and (string-match regexp hi-text) + hi-lock-pattern))) + hi-lock-interactive-patterns))) + ;; Use regexp from the first matching pattern as + ;; a reasonable default. + (caar candidate-hi-lock-patterns)))))) (list - (completing-read "Regexp to unhighlight: " - hi-lock-interactive-patterns nil t - (car (car hi-lock-interactive-patterns)) - (cons 'history-list 1)))))) - (let ((keyword (assoc regexp hi-lock-interactive-patterns))) - (when keyword - (font-lock-remove-keywords nil (list keyword)) - (setq hi-lock-interactive-patterns - (delq keyword hi-lock-interactive-patterns)) - (remove-overlays - nil nil 'hi-lock-overlay-regexp (hi-lock-string-serialize regexp)) - (when font-lock-fontified (font-lock-fontify-buffer))))) + (and (not current-prefix-arg) + (completing-read "Regexp to unhighlight: " + (or candidate-hi-lock-patterns + hi-lock-interactive-patterns) + nil t default-regexp)) + current-prefix-arg)))) + (dolist (re (if (not prefix-arg) (list regexp) + (mapcar #'car hi-lock-interactive-patterns))) + (let ((keyword (assoc re hi-lock-interactive-patterns))) + (when keyword + (font-lock-remove-keywords nil (list keyword)) + (setq hi-lock-interactive-patterns + (delq keyword hi-lock-interactive-patterns)) + (remove-overlays + nil nil 'hi-lock-overlay-regexp (hi-lock-string-serialize re)) + (when font-lock-fontified (font-lock-fontify-buffer)))))) ;;;###autoload (defun hi-lock-write-interactive-patterns () @@ -567,25 +640,33 @@ regexp)) (defun hi-lock-read-face-name () - "Read face name from minibuffer with completion and history." - (intern (completing-read - "Highlight using face: " - obarray 'facep t - (cons (car hi-lock-face-defaults) - (let ((prefix - (try-completion - (substring (car hi-lock-face-defaults) 0 1) - hi-lock-face-defaults))) - (if (and (stringp prefix) - (not (equal prefix (car hi-lock-face-defaults)))) - (length prefix) 0))) - 'face-name-history - (cdr hi-lock-face-defaults)))) + "Return face name for interactive highlighting. +When `hi-lock-auto-select-face' is non-nil, return head of +`hi-lock-auto-select-face-defaults'. Otherwise, read face name +from minibuffer with completion and history." + (if hi-lock-auto-select-face + ;; Return current head and rotate the face list. + (prog1 (intern (car hi-lock-auto-select-face-defaults)) + (setq hi-lock-auto-select-face-defaults + (cdr hi-lock-auto-select-face-defaults))) + (intern (completing-read + "Highlight using face: " + obarray 'facep t + (cons (car hi-lock-face-defaults) + (let ((prefix + (try-completion + (substring (car hi-lock-face-defaults) 0 1) + hi-lock-face-defaults))) + (if (and (stringp prefix) + (not (equal prefix (car hi-lock-face-defaults)))) + (length prefix) 0))) + 'face-name-history + (cdr hi-lock-face-defaults))))) (defun hi-lock-set-pattern (regexp face) "Highlight REGEXP with face FACE." (let ((pattern (list regexp (list 0 (list 'quote face) t)))) - (unless (member pattern hi-lock-interactive-patterns) + (unless (assoc regexp hi-lock-interactive-patterns) (push pattern hi-lock-interactive-patterns) (if font-lock-mode (progn === modified file 'lisp/icomplete.el' --- lisp/icomplete.el 2012-06-22 17:37:28 +0000 +++ lisp/icomplete.el 2012-10-23 19:51:46 +0000 @@ -120,6 +120,35 @@ :type 'hook :group 'icomplete) +(defcustom icomplete-decorations + '( "{" "}" " | " " | ..." "[" "]" " [No match]" " [Matched%s]") + "List of strings used by icomplete to display alternatives in minibuffer. +There are 8 elements in this list: +1st and 2nd elements enclose the prospects. +3rd element is the separator between prospects. +4th element is the string inserted at the end of a truncated list of prospects. +5th and 6th elements are used as brackets around the common match string which +can be completed using TAB. +7th element is the string displayed when there are no matches. +8th element is displayed if there is a single match." + :type '(repeat string) + :version "24.3" + :group 'icomplete) + +(defcustom icomplete-cycle t + "Non-nil if cycling is to be enabled in `icomplete-mode'. +When cycling is enabled, keys \"C-j\", \"C-s\" and \"C-r\" are +bound to `icomplete-this-match', `icomplete-next-match' and +`icomplete-prev-match' respectively." + :type 'boolean + :version "24.3" + :group 'icomplete) + +(defface icomplete-first-match '((t :weight bold)) + "Face used by icomplete for highlighting first match." + :version "24.3" + :group 'icomplete) + ;;;_* Initialization @@ -149,7 +178,7 @@ "Return strings naming keys bound to FUNC-NAME, or nil if none. Examines the prior, not current, buffer, presuming that current buffer is minibuffer." - (when (commandp func-name) + (when (commandp (intern-soft func-name)) (save-excursion (let* ((sym (intern func-name)) (buf (other-buffer nil t)) @@ -169,6 +198,29 @@ Icomplete does not operate with any specialized completion tables except those on this list.") +;;;_ = icomplete-name +(defvar icomplete-name nil + "Minibuffer user input.") + +;;;_ = icomplete-matches +(defvar icomplete-matches nil + "Stored value of completion candidates that are on display. +This is set by `icomplete-exhibit', modified by +`icomplete-this-match', `icomplete-next-match' and +`icomplete-prev-match' and cleared by `icomplete-try'.") + +;;;_ = icomplete-most-try +(defvar icomplete-most-try nil + "Value of `completion-try-completion'. +When there are multiple matches, it signifies common match string +which can be completed using TAB.") + +;;;_ = icomplete-try +(defvar icomplete-try nil + "Part of `icomplete-most-try' that is displayed at the prompt. +Same as `icomplete-most-try' but with whole of `icomplete-name' +stripped from front, when possible.") + ;;;_ > icomplete-mode (&optional prefix) ;;;###autoload (define-minor-mode icomplete-mode @@ -227,7 +279,18 @@ "Remove completions display \(if any) prior to new user input. Should be run in on the minibuffer `pre-command-hook'. See `icomplete-mode' and `minibuffer-setup-hook'." - (delete-overlay icomplete-overlay)) + (unless (memq this-command '(icomplete-this-match icomplete-next-match + icomplete-prev-match)) + ;; Current command does not belong to icomplete-mode. + ;; Clear the matches. + (setq icomplete-matches nil) + ;; Cleanup local icomplete bindings. + (when (eq (key-binding "\C-j") 'icomplete-this-match) + (local-unset-key "\C-j") + (local-unset-key "\C-s") + (local-unset-key "\C-r")) + ;; Delete the overlay. + (delete-overlay icomplete-overlay))) ;;;_ > icomplete-exhibit () (defun icomplete-exhibit () @@ -235,6 +298,12 @@ Should be run via minibuffer `post-command-hook'. See `icomplete-mode' and `minibuffer-setup-hook'." (when (and icomplete-mode (icomplete-simple-completing-p)) + ;; Enable icomplete specific key bindings, if needed. + (when (and icomplete-cycle + (not (eq (key-binding "\C-j") 'icomplete-this-match))) + (local-set-key "\C-j" 'icomplete-this-match) + (local-set-key "\C-s" 'icomplete-next-match) + (local-set-key "\C-r" 'icomplete-prev-match)) (save-excursion (goto-char (point-max)) ; Insert the match-status information: @@ -274,6 +343,9 @@ The display is updated with each minibuffer keystroke during minibuffer completion. +A typical display looks like: + M-x loa[d-]{load-library | load-file | load-theme} + Prospective completion suffixes (if any) are displayed, bracketed by one of \(), \[], or \{} pairs. The choice of brackets is as follows: @@ -286,96 +358,134 @@ \(whether complete or not), or ` \[No matches]', if no eligible 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)) - (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) - (if last (setcdr last nil)) - (let* ((most-try - (if (and base-size (> base-size 0)) - (completion-try-completion - name candidates predicate (length name) md) - ;; If the `comps' are 0-based, the result should be - ;; the same with `comps'. - (completion-try-completion - name comps nil (length name) md))) - (most (if (consp most-try) (car most-try) - (if most-try (car comps) ""))) - ;; Compare name and most, so we can determine if name is - ;; a prefix of most, or something else. - (compare (compare-strings name nil nil - most nil nil completion-ignore-case)) - (determ (unless (or (eq t compare) (eq t most-try) - (= (setq compare (1- (abs compare))) - (length most))) - (concat open-bracket - (cond - ((= compare (length name)) - ;; Typical case: name is a prefix. - (substring most compare)) - ((< compare 5) 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-max - ;; Max total length to use, including the minibuffer content. - (* (+ icomplete-prospects-height - ;; If the minibuffer content already uses up more than - ;; one line, increase the allowable space accordingly. - (/ prospects-len (window-width))) - (window-width))) - (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)) - (setq prospects nil) - (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)) - (if (< prospects-len prospects-max) - (push comp prospects) - (setq limit t)))))) - ;; Restore the base-size info, since completion-all-sorted-completions - ;; is cached. - (if last (setcdr last base-size)) - (if prospects + (unless icomplete-matches + ;; Re-compute the matches. + (let* ((md (completion--field-metadata (field-beginning))) + (comps (completion-all-sorted-completions)) + (last (if (consp comps) (last comps))) + (base-size (cdr last))) + (when (consp comps) + (if last (setcdr last nil)) + (let* ((most-try + (if (and base-size (> base-size 0)) + (completion-try-completion + name candidates predicate (length name) md) + ;; If the `comps' are 0-based, the result should be + ;; the same with `comps'. + (completion-try-completion + name comps nil (length name) md))) + (most (if (consp most-try) (car most-try) + (if most-try name "")))) + ;; Cache results for use with `icomplete-this-match', + ;; `icomplete-next-match' and `icomplete-prev-match'. + (setq icomplete-name name) + (setq icomplete-matches (nconc (butlast comps) (list (car last)))) + ;; If prefix is itself an exact match, move it to the front of + ;; list of matches. + (let ((prefix (let ((comps-prefix (try-completion "" comps))) + (or (and (stringp comps-prefix) comps-prefix) "")))) + (when (member prefix icomplete-matches) + (setq icomplete-matches (cons prefix + (delete prefix icomplete-matches))))) + (setq icomplete-most-try most-try) + ;; Compare name and most, so we can determine if name is + ;; a prefix of most, or something else. + (setq icomplete-try + (let ((compare (compare-strings name nil nil + most nil nil + completion-ignore-case))) + (unless (or (eq t compare) (eq t most-try) + (= (setq compare (1- (abs compare))) + (length most))) + (cond + ((= compare (length name)) + ;; Typical case: name is a prefix. + (substring most compare)) + ((< compare 5) most) + (t (concat "..." (substring most compare))))))) + ;; Restore the base-size info, since + ;; `completion-all-sorted-completions' is cached. + (if last (setcdr last base-size)))))) + (if (not icomplete-matches) + (nth 6 icomplete-decorations) + (let* ((determ (and icomplete-try + (concat (nth 4 icomplete-decorations) + icomplete-try + (nth 5 icomplete-decorations))))) + (if (not (eq icomplete-most-try t)) + (let* ((comps icomplete-matches) + (prospects-max + ;; Max total length to use, including the + ;; minibuffer content. + (* (+ icomplete-prospects-height + ;; If the minibuffer content already uses up + ;; more than one line, increase the + ;; allowable space accordingly. + (/ (string-width (buffer-string)) (window-width))) + (window-width))) + (prospects-len (string-width (buffer-string))) + prospects limit first) + (setq prospects-len + (+ prospects-len (string-width (or determ "")) + ;; Account for { | ...} + (string-width (nth 0 icomplete-decorations)) + (string-width (nth 3 icomplete-decorations)) + (string-width (nth 1 icomplete-decorations)))) + ;; Decorate first of the prospects but remember to make a + ;; copy. This is to ensure correct behaviour when matches + ;; are cycled with C-s or C-r. + (setq first (copy-sequence (pop comps))) + (put-text-property 0 (length first) 'face + 'icomplete-first-match first) + (setq prospects-len (+ prospects-len (string-width first))) + (while (and comps (not limit)) + (let* ((p (concat (nth 2 icomplete-decorations) (pop comps)))) + (setq prospects-len (+ (string-width p) prospects-len)) + (if (< prospects-len prospects-max) + (setq prospects (concat prospects p)) + (setq limit t)))) (concat determ - "{" - (and most-is-exact ",") - (mapconcat 'identity (nreverse prospects) ",") - (and limit ",...") - "}") - (concat determ - " [Matched" - (let ((keys (and icomplete-show-key-bindings - (commandp (intern-soft most)) - (icomplete-get-keys most)))) - (if keys (concat "; " keys) "")) - "]")))))) + (nth 0 icomplete-decorations) + (concat first prospects) + (and limit (nth 3 icomplete-decorations)) + (nth 1 icomplete-decorations))) + (concat determ + (format (nth 7 icomplete-decorations) + (let* ((most (if (consp icomplete-most-try) + (car icomplete-most-try) + (if icomplete-most-try name ""))) + (keys (and icomplete-show-key-bindings + (icomplete-get-keys most)))) + (if keys (concat "; " keys) "")))))))) + +(defun icomplete-this-match () + "Input first of the displayed matches to minibuffer prompt. +See `icomplete-matches'." + (interactive) + (delete-region (minibuffer-prompt-end) (point)) + (when icomplete-matches + (insert (car icomplete-matches))) + (exit-minibuffer)) + +(defun icomplete-next-match () + "Shift displayed matches to the left. +Second of displayed matches is promoted to first position and can +be selected with `icomplete-this-match'." + (interactive) + (let ((first (pop icomplete-matches))) + (setq icomplete-matches (nconc icomplete-matches (list first))))) + +(defun icomplete-prev-match () + "Shift displayed matches to the right. +Last of displayed matches (which could be truncated from display) +is promoted to first position and can be selected with +`icomplete-this-match'." + (interactive) + (let* ((last-but-one (last icomplete-matches 2)) + (last (cdr last-but-one))) + (when last + (setcdr last-but-one nil) + (push (car last) icomplete-matches)))) ;;_* Local emacs vars. ;;Local variables: === modified file 'lisp/replace.el' --- lisp/replace.el 2012-10-16 23:27:40 +0000 +++ lisp/replace.el 2012-10-23 12:44:54 +0000 @@ -585,27 +585,32 @@ When PROMPT doesn't end with a colon and space, it adds a final \": \". If DEFAULTS is non-nil, it displays the first default in the prompt. -Non-nil optional arg DEFAULTS is a string or a list of strings that -are prepended to a list of standard default values, which include the -string at point, the last isearch regexp, the last isearch string, and -the last replacement regexp. +Optional arg DEFAULTS is a string or a list of strings that are +prepended to a list of standard default values, which include the +tag at point, the last isearch regexp, the last isearch string, +and the last replacement regexp. Non-nil HISTORY is a symbol to use for the history list. If HISTORY is nil, `regexp-history' is used." - (let* ((default (if (consp defaults) (car defaults) defaults)) - (defaults + (let* ((defaults (append (if (listp defaults) defaults (list defaults)) - (list (regexp-quote - (or (funcall (or find-tag-default-function - (get major-mode 'find-tag-default-function) - 'find-tag-default)) - "")) - (car regexp-search-ring) - (regexp-quote (or (car search-ring) "")) - (car (symbol-value - query-replace-from-history-variable))))) + (list + ;; Regexp for tag at point. + (let* ((tagf (or find-tag-default-function + (get major-mode 'find-tag-default-function) + 'find-tag-default)) + (tag (funcall tagf))) + (cond ((not tag) "") + ((eq tagf 'find-tag-default) + (format "\\_<%s\\_>" (regexp-quote tag))) + (t (regexp-quote tag)))) + (car regexp-search-ring) + (regexp-quote (or (car search-ring) "")) + (car (symbol-value + query-replace-from-history-variable))))) (defaults (delete-dups (delq nil (delete "" defaults)))) + (default (car defaults)) ;; Do not automatically add default to the history for empty input. (history-add-new-input nil) (input (read-from-minibuffer --=-=-= Content-Type: text/plain Stefan Monnier writes: >> 1. The icomplete candidates are comma separated but WITHOUT spaces. It >> makes readability difficult. >> So introduce `icomplete-decorations' which can be a copy of >> `ido-decorations' to begin with. May be the decorations could be >> extracted to some other file (minibuffer.el?) and commonly shared by >> both ido and icomplete. > > The lack of space is on purpose, to save screen real-estate, so it > indeed needs to be customizable. But I don't have a strong opinion on > what the default value should be. > >> 2. Support for cycling via C-s and C-r, highlighting and selection of >> current head (all much like ido-mode) > > Not sure what "highlighting" refers to; if you mean to put the first > element in bold, then yes, that fine. > > Selection of current head can be done with minibuffer-force-complete > (not bound to any key by default), tho it doesn't exit. But it should be > easy to add a minibuffer-force-complete-and-exit. > > To get you started the patch below adds a keymap to icomplete. > > Cycling would also be useful and should similarly be easy to add (it > just needs to play around with (completion-all-sorted-completions) and > store it back via completion--cache-all-sorted-completions, like > minibuffer-force-complete does). > >> I can prepare a patch for (1). > > We're in feature freeze, so please wait a few weeks before sending > your patch. > > > Stefan > > > > === modified file 'lisp/icomplete.el' > *** lisp/icomplete.el 2012-06-22 17:37:28 +0000 > --- lisp/icomplete.el 2012-10-23 19:30:20 +0000 > *************** > *** 169,174 **** > --- 169,179 ---- > Icomplete does not operate with any specialized completion tables > except those on this list.") > > + (defvar icomplete-minibuffer-map > + (let ((map (make-sparse-keymap))) > + (define-key map [?\M-\t] 'minibuffer-force-complete) > + map)) > + > ;;;_ > icomplete-mode (&optional prefix) > ;;;###autoload > (define-minor-mode icomplete-mode > *************** > *** 208,213 **** > --- 213,220 ---- > Usually run by inclusion in `minibuffer-setup-hook'." > (when (and icomplete-mode (icomplete-simple-completing-p)) > (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))) > > > > > -- --=-=-=--