[STUMP] Editing features in input window

[Manuel Giraud]

Here's patch that start to add editing features in the input window. It
is far from complete (I'd like history), far from intuitive (have to
materialize index visually) and far from beautiful (emacs-style harcoded
keybindings) ... but it is yet usable.

---8<-----------------------------------
Index: input.lisp
===================================================================
RCS file: /cvsroot/stumpwm/stumpwm/input.lisp,v
retrieving revision 1.4
diff -u -r1.4 input.lisp
--- input.lisp  12 Nov 2004 06:35:47 -0000      1.4
+++ input.lisp  17 Nov 2004 12:27:21 -0000
@@ -76,7 +76,8 @@
 (defun read-one-line (screen prompt &optional (initial-input ""))
   "Read a line of input through stumpwm and return it."
   (labels ((key-loop ()
-            (let ((input (coerce initial-input 'list)))
+            (let* ((content (coerce initial-input 'list))
+                   (input (make-buffer :content content :index (length 
content))))
               (do ((key (read-key) (read-key)))
                   (nil)
                 (multiple-value-bind (inp ret) (process-input screen prompt 
input
@@ -92,7 +93,7 @@
       (shutdown-input-window screen)
       (unless (eq ret 'abort)
        ;; Return the input bucket as a string
-       (concatenate 'string input)))))
+       (concatenate 'string (buffer-content input))))))
 
 (defun read-one-char (screen)
   "Read a single character."
@@ -128,6 +129,48 @@
                            (xlib:font-ascent (screen-font screen))
                            input)))
 
+;; Simple buffer with index management
+(defstruct buffer content index)
+
+(defun goto-end (buffer)
+  "Set index to the end of buffer."
+  (setf (buffer-index buffer) (length (buffer-content buffer))))
+
+(defun goto-start (buffer)
+  "Set index to the beginning of buffer."
+  (setf (buffer-index buffer) 0))
+
+(defun move-left (buffer)
+  "Move left :-)"
+  (setf (buffer-index buffer) (max 0 (1- (buffer-index buffer)))))
+
+(defun move-right (buffer)
+  "Move right :-)"
+  (setf (buffer-index buffer) (min (length (buffer-content buffer)) (1+ 
(buffer-index buffer)))))
+
+(defun insert-and-move (buffer obj)
+  "Insert obj and increment index."
+  (setf (buffer-content buffer)
+       (concatenate 'list 
+                    (subseq (buffer-content buffer) 0 (buffer-index buffer)) 
+                    (list obj)
+                    (subseq (buffer-content buffer) (buffer-index buffer))))
+  (incf (buffer-index buffer)))
+
+(defun deinsert-and-move (buffer)
+  "Remove one object of buffer and decrement index."
+  (setf (buffer-content buffer)
+       (concatenate 'list 
+                    (subseq (buffer-content buffer) 0 (max 0 (1- (buffer-index 
buffer))))
+                    (subseq (buffer-content buffer) (buffer-index buffer))))
+  (setf (buffer-index buffer) (max 0 (1- (buffer-index buffer)))))
+
+(defun deinsert-forward (buffer)
+  (setf (buffer-content buffer)
+       (concatenate 'list 
+                    (subseq (buffer-content buffer) 0 (buffer-index buffer))
+                    (subseq (buffer-content buffer) (1+ (buffer-index 
buffer))))))
+
 (defun process-input (screen prompt input code state)
   "Process the key (code and state), given the current input
 buffer. Returns a new modified input buffer."
@@ -140,18 +183,41 @@
                     (values inp 'done))
                    ((eq (xlib:keycode->keysym *display* code 0)
                         (char->keysym #\Backspace))
-                    (if (cdr inp)
-                        (rplacd (last inp 2) '())
-                      (setf inp nil))
+                    (deinsert-and-move inp)
                     (values inp nil))
                    ((and (eq (xlib:keycode->keysym *display* code 0)
                              (char->keysym #\g))
                          (member :control (xlib:make-state-keys state)))
                     (values inp 'abort))
+                   ((and (eq (xlib:keycode->keysym *display* code 0)
+                             (char->keysym #\a))
+                         (member :control (xlib:make-state-keys state)))
+                    (goto-start inp)
+                    (values inp nil))
+                   ((and (eq (xlib:keycode->keysym *display* code 0)
+                             (char->keysym #\b))
+                         (member :control (xlib:make-state-keys state)))
+                    (move-left inp)
+                    (values inp nil))
+                   ((and (eq (xlib:keycode->keysym *display* code 0)
+                             (char->keysym #\f))
+                         (member :control (xlib:make-state-keys state)))
+                    (move-right inp)
+                    (values inp nil))
+                   ((and (eq (xlib:keycode->keysym *display* code 0)
+                             (char->keysym #\d))
+                         (member :control (xlib:make-state-keys state)))
+                    (deinsert-forward inp)
+                    (values inp nil))
+                   ((and (eq (xlib:keycode->keysym *display* code 0)
+                             (char->keysym #\e))
+                         (member :control (xlib:make-state-keys state)))
+                    (goto-end inp)
+                    (values inp nil))
                    (t (let* ((mods (xlib:make-state-keys state))
                              (ch (keycode->character code mods)))
                         (if (and (characterp ch) (char>= ch #\Space) (char<= 
ch #\~))
-                            (setf inp (conc1 inp ch)))
+                            (insert-and-move inp ch))
                         (values inp nil))))))
     (multiple-value-bind (inp ret) (process-key input code state)
       (case ret
@@ -160,7 +226,7 @@
         ('abort
          (values inp 'abort))
         (t
-         (draw-input-bucket screen prompt inp)
+         (draw-input-bucket screen prompt (buffer-content inp))
          (values inp t))))))
 
 ;;;;; UNUSED

---8<-----------------------------------

-- 
Manuel Giraud (CNRS/CETP)