bug#10998: Allow movements in bookmark-bmenu-search

[Karl Fogel]

The code has changed somewhat since the original patch -- it now uses
`pcase' instead of `case', for example (and thus `_' instead of `t'),
ever since monnier@iro.umontreal.ca-20120710115154-012cs2xbndtlpvh1.

Furthermore, in http://debbugs.gnu.org/cgi/bugreport.cgi?bug=10998#11
Thierry said "the patch sent contain free-variables, it is fixed here"
but there was no new patch attached.

So, I've adjusted the original patch (see below) and done some light
testing, but I'm not confident enough in this to commit it yet.
Thierry, what were those free variables?  And can you test this to make
sure it behaves as your original patch did?

I agree with Stefan that this is not an ideal solution, by the way, and
have left a comment in the patch below to that effect.  It might still
be better than the status quo, though.

-Karl

=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog      2012-10-01 03:44:59 +0000
+++ lisp/ChangeLog      2012-10-01 04:31:27 +0000
@@ -1,3 +1,11 @@
+2012-10-01  Karl Fogel  <kfogel@openitp.org>
+
+       * bookmark.el (bookmark-cursor, bookmark-set-cursor-in-prompt):
+       New face, new function.
+       (bookmark-read-search-input): Set the cursor and listen to more
+       command characters.
+       (Bug#10998)
+
 2012-10-01  Karl Fogel  <kfogel@red-bean.com>
 
        * bookmark.el (bookmark-version-control): Give tags in the

=== modified file 'lisp/bookmark.el'
--- lisp/bookmark.el    2012-10-01 04:15:48 +0000
+++ lisp/bookmark.el    2012-10-01 04:34:25 +0000
@@ -168,6 +168,11 @@
   :group 'bookmark
   :version "22.1")
 
+(defface bookmark-cursor
+  '((t (:foreground "green")))
+  "Face for cursor color in `bookmark-bmenu-search' prompt."
+  :group 'bookmark)
+
 
 ;;; No user-serviceable parts beyond this point.
 
@@ -2013,20 +2018,62 @@
 ;; Store keyboard input for incremental search.
 (defvar bookmark-search-pattern)
 
+(defun bookmark-set-cursor-in-prompt (str pos)
+  "Add a cursor in string STR at index position POS."
+  (setq pos (min index (1- (length tmp-list))))
+  (when (not (string= str ""))
+    (let* ((real-index (- (1- (length tmp-list)) pos))
+           (cur-str (substring str real-index (1+ real-index))))
+      (concat (substring str 0 real-index)
+              (propertize cur-str 'display
+                          (if (= index (length tmp-list))
+                              (concat
+                               (propertize "|" 'face 'bookmark-cursor)
+                               cur-str)
+                            (concat
+                             cur-str
+                             (propertize "|" 'face 'bookmark-cursor))))
+              (substring str (1+ real-index))))))
+
 (defun bookmark-read-search-input ()
   "Read each keyboard input and add it to `bookmark-search-pattern'."
   (let ((prompt       (propertize "Pattern: " 'face 'minibuffer-prompt))
         ;; (inhibit-quit t) ; inhibit-quit is evil.  Use it with extreme care!
-        (tmp-list     ()))
+        (tmp-list     ())
+        (index        0))
     (while
-        (let ((char (read-key (concat prompt bookmark-search-pattern))))
+        (let ((char (read-key
+                     (concat prompt (bookmark-set-cursor-in-prompt
+                                     bookmark-search-pattern index)))))
+          ;; FIXME: This is kind of a kluge.  The right way to do this
+          ;; would be to use a real minibuffer, maybe with an
+          ;; after-change-function to update the set of matching
+          ;; entries each time.
           (pcase char
             ((or ?\e ?\r) nil) ; RET or ESC break the search loop.
             (?\C-g (setq bookmark-quit-flag t) nil)
-            (?\d (pop tmp-list) t) ; Delete last char of pattern with DEL
+            (?\d (with-no-warnings ; Delete last char of pattern with DEL.
+                   (pop (nthcdr index tmp-list))) t)
+            ;; Movements in minibuffer.
+            (?\C-b                         ; backward-char.
+             (setq index (min (1+ index) (length tmp-list))) t)
+            (?\C-f                         ; forward-char.
+             (setq index (max (1- index) 0)) t)
+            (?\C-a                         ; move bol.
+             (setq index (length tmp-list)) t)
+            (?\C-e                         ; move eol.
+             (setq index 0) t)
+            (?\C-k
+             (kill-new (substring bookmark-search-pattern
+                                  (- (length tmp-list) index)))
+             (setq tmp-list (nthcdr index tmp-list)) (setq index 0) t)
+            (?\C-y
+             (let ((str (car kill-ring)))
+               (loop for char across str
+                     do (push char (nthcdr index tmp-list)))) t)
             (_
              (if (characterp char)
-                 (push char tmp-list)
+                 (push char (nthcdr index tmp-list))
                (setq unread-command-events
                      (nconc (mapcar 'identity
                                     (this-single-command-raw-keys))