bug-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

bug#12638: 24.2.50; FR: Some suggestions for icomplete-mode


From: Jambunathan K
Subject: bug#12638: 24.2.50; FR: Some suggestions for icomplete-mode
Date: Wed, 24 Oct 2012 01:38:02 +0530
User-agent: Gnus/5.13 (Gnus v5.13) Emacs/24.2.50 (gnu/linux)

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.

=== 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


Stefan Monnier <monnier@iro.umontreal.ca> 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)))
>
>
>
>
>

-- 

reply via email to

[Prev in Thread] Current Thread [Next in Thread]