Re: [STUMP] Editing features in input window

[Manuel Giraud]

Manuel Giraud <address@hidden> writes:

> 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.
>
> [...]

Forget about this patch. The following now has a cursor in the input
window:

---8<---------------------------------------
cvs diff: Diffing .
Index: core.lisp
===================================================================
RCS file: /cvsroot/stumpwm/stumpwm/core.lisp,v
retrieving revision 1.8
diff -u -r1.8 core.lisp
--- core.lisp   12 Nov 2004 06:35:47 -0000      1.8
+++ core.lisp   17 Nov 2004 14:35:47 -0000
@@ -363,6 +363,14 @@
                        :background
                        (xlib:screen-black-pixel (screen-number screen))))
 
+(defun create-cursor-gcontext (screen)
+  (xlib:create-gcontext :drawable (screen-message-window screen)
+                       :font (screen-font screen)
+                       :foreground
+                       (xlib:screen-white-pixel (screen-number screen))
+                       :background 
+                       (xlib:alloc-color (xlib:screen-default-colormap 
(screen-number screen)) "red")))
+
 (defun max-width (font l)
   "Return the width of the longest string in L using FONT."
   (loop for i in l
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 14:35:47 -0000
@@ -75,8 +75,9 @@
 
 (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))))
+    (labels ((key-loop ()
               (do ((key (read-key) (read-key)))
                   (nil)
                 (multiple-value-bind (inp ret) (process-input screen prompt 
input
@@ -86,13 +87,13 @@
                     ('done
                      (return (values input 'done)))
                     ('abort
-                     (return (values input 'abort)))))))))
-    (setup-input-window screen prompt initial-input)
-    (multiple-value-bind (input ret) (key-loop)
-      (shutdown-input-window screen)
-      (unless (eq ret 'abort)
-       ;; Return the input bucket as a string
-       (concatenate 'string input)))))
+                     (return (values input 'abort))))))))
+      (setup-input-window screen prompt input)
+      (multiple-value-bind (input ret) (key-loop)
+       (shutdown-input-window screen)
+       (unless (eq ret 'abort)
+         ;; Return the input bucket as a string
+         (concatenate 'string (buffer-content input)))))))
 
 (defun read-one-char (screen)
   "Read a single character."
@@ -106,14 +107,22 @@
 (defun draw-input-bucket (screen prompt input)
   "Draw to the screen's input window the contents of input."
   (let* ((gcontext (create-message-window-gcontext screen))
+        (cursor-gcontext (create-cursor-gcontext screen))
         (win (screen-input-window screen))
         (prompt-width (xlib:text-width (screen-font screen) prompt))
+        (content (buffer-content input))
+        (index (buffer-index input))
+        (before-chunk (subseq content 0 index))
+        (cursor-chunk (subseq content index (min (length content) (1+ index))))
+        (after-chunk (subseq content (min (length content) (1+ index))))
+        (before-width (xlib:text-width (screen-font screen) before-chunk))
+        (cursor-width (xlib:text-width (screen-font screen) cursor-chunk))
         (width (+ prompt-width
-                  (max 100 (xlib:text-width (screen-font screen) input))))
-       (screen-width (xlib:drawable-width (xlib:screen-root (screen-number 
screen)))))
+                  (max 100 (xlib:text-width (screen-font screen) content))))
+        (screen-width (xlib:drawable-width (xlib:screen-root (screen-number 
screen)))))
     (xlib:clear-area win :x (+ *message-window-padding*
                               prompt-width
-                              (xlib:text-width (screen-font screen) input)))
+                              (xlib:text-width (screen-font screen) content)))
     (xlib:with-state (win)
                     (setf (xlib:drawable-x win) (- screen-width width
                                                    (* 
(xlib:drawable-border-width win) 2)
@@ -123,10 +132,64 @@
                            *message-window-padding*
                            (xlib:font-ascent (screen-font screen))
                            prompt)
+    ;; Before cursor
     (xlib:draw-image-glyphs win gcontext
                            (+ *message-window-padding* prompt-width)
                            (xlib:font-ascent (screen-font screen))
-                           input)))
+                           before-chunk)
+    ;; Cursor
+    (xlib:draw-image-glyphs win cursor-gcontext
+                           (+ *message-window-padding* prompt-width 
before-width)
+                           (xlib:font-ascent (screen-font screen))
+                           cursor-chunk)
+    ;; After cursor
+    (xlib:draw-image-glyphs win gcontext
+                           (+ *message-window-padding* prompt-width 
before-width cursor-width)
+                           (xlib:font-ascent (screen-font screen))
+                           after-chunk)))
+
+
+;; 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
@@ -140,18 +203,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

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

-- 
Manuel Giraud (CNRS/CETP)