[STUMP] Another diff

[Manuel Giraud]

Hi, 

Here's another diff. Now message window can be multi-column or
multi-row. Enhanced version of 'partial-command' where the prompt can be
edited.

----8<-------------------------------------------
cvs server: Diffing .
Index: core.lisp
===================================================================
RCS file: /cvsroot/stumpwm/stumpwm/core.lisp,v
retrieving revision 1.5
diff -u -r1.5 core.lisp
--- core.lisp   24 Apr 2004 05:49:28 -0000      1.5
+++ core.lisp   31 May 2004 21:02:56 -0000
@@ -364,13 +364,84 @@
   (loop for i in l
        maximize (xlib:text-width font i)))
 
+(defun vertical-box-placement (l h-max w-padding get-h get-w)
+  "I think an example is easier to understand. You give this:
+     l ---> '(#box(:h 10 :w 30) #box(:h 10 :w 5) #box(:h 10 :w 100))
+     h-max ---> 12
+     w-padding ---> 2
+   and it returns 3 values:
+     '((#box(:h 10 :w 30) #box(:h 10 :w 5))
+       (#box(:h 10 :w 100)))
+     20
+     132
+   which means:
+     -----             --------------------------  ^
+    | 1st |           | 3rd really big box       | |
+    | box |           |                          | |height (here 20)
+     --------------    --------------------------  |below
+    | 2nd big box  |                               |h-max
+    |              |                               |
+     --------------                                v
+                   <-->
+                    padding
+    <---------------------------------------------->
+                  caculated width (here 132)
+"
+  ;; Maybe someone can do this in pure loop style, but it ain't gonna be me :(
+  (let ((h-acc 0)
+       (max-w 0)
+       (l-acc '())
+       (all-h '())
+       (all-w '())
+       (all-l '()))
+    (loop for b in l do 
+         (if (> (+ h-acc (funcall get-h b)) h-max)
+             (progn 
+               (push (reverse l-acc) all-l)
+               (push h-acc all-h)
+               (push max-w all-w)
+               (setf l-acc (list b))
+               (setf h-acc (funcall get-h b))
+               (setf max-w (funcall get-w b)))
+           (progn
+             (push b l-acc)
+             (incf h-acc (funcall get-h b))
+             (setf max-w (max max-w (funcall get-w b)))))
+         finally 
+         (push (reverse l-acc) all-l)
+         (push h-acc all-h)
+         (push max-w all-w)
+         (return (values (reverse all-l) (reduce #'max all-h) (reduce 
#'(lambda (a b) (+ a b w-padding)) all-w))))))
+
+(defun horizontal-box-placement (l w-max w-padding get-h get-w)
+  "As `vertical-box-placement' but horizontally."
+  (vertical-box-placement l w-max w-padding get-w get-h))
+
 (defun setup-message-window (screen l)
-  (let ((height (* (length l)
-                  (+ (xlib:font-ascent (screen-font screen))
-                     (xlib:font-descent (screen-font screen)))))
-       (width (max-width (screen-font screen) l))
-       (screen-width (xlib:drawable-width (xlib:screen-root (screen-number 
screen))))
-       (win (screen-message-window screen)))
+  (let ((screen-width (screen-width screen))
+       (screen-height (screen-height screen))
+       (win (screen-message-window screen))
+       list height width)
+    (ecase *message-placement*
+      ('vertical
+       (multiple-value-setq (list height width)
+        (vertical-box-placement l screen-height *message-window-inner-padding*
+                                #'(lambda (s)
+                                    (declare (ignore s))
+                                    (+ (xlib:font-ascent (screen-font screen))
+                                       (xlib:font-descent (screen-font 
screen))))
+                                #'(lambda (s)
+                                    (xlib:text-width (screen-font screen) 
s)))))
+      ('horizontal
+       (multiple-value-setq (list width height)
+        (horizontal-box-placement l screen-width 0
+                                  #'(lambda (s)
+                                      (declare (ignore s))
+                                      (+ (xlib:font-ascent (screen-font 
screen))
+                                         (xlib:font-descent (screen-font 
screen))))
+                                  #'(lambda (s)
+                                      (+ (xlib:text-width (screen-font screen) 
s)
+                                         *message-window-inner-padding*))))))
     ;; Now that we know the dimensions, raise and resize it.
     (xlib:map-window (screen-message-window screen))
     (setf (xlib:drawable-y win) 0
@@ -381,7 +452,9 @@
          (xlib:drawable-width win) (+ width (* *message-window-padding* 2))
          (xlib:window-priority win) :above)
     ;; Clear the window
-    (xlib:clear-area win)))
+    (xlib:clear-area win)
+    ;; Return the new list to the caller
+    list))
 
 (defun invert-rect (screen win x y width height)
   "invert the color in the rectangular area. Used for highlighting text."
@@ -697,27 +770,54 @@
     (xlib:draw-image-glyphs win gcontext 0 (xlib:font-ascent font) string)))
         
 (defun echo-string-list (screen strings &optional highlight)
-  "draw each string in l in the screen's message window. HIGHLIGHT is
+  "Draw each string in l in the screen's message window. HIGHLIGHT is
 the nth entry to highlight."
   (let* ((height (+ (xlib:font-descent (screen-font screen))
                    (xlib:font-ascent (screen-font screen))))
         (gcontext (create-message-window-gcontext screen))
-        (message-win (screen-message-window screen)))
-    (setup-message-window screen strings)
-    (loop for s in strings
-         ;; We need this so we can track the row for each element
-         for i from 0 to (length strings)
-         do (xlib:draw-image-glyphs message-win gcontext
-                                    *message-window-padding*
-                                    (+ (* i height)
-                                       (xlib:font-ascent (screen-font screen)))
-                                    s)
-         when (and highlight
-                   (= highlight i))
-         do (invert-rect screen message-win
-                         0 (* i height)
-                         (xlib:drawable-width message-win)
-                         height)))
+        (message-win (screen-message-window screen))
+        (strings (setup-message-window screen strings))
+        (max-width 0)
+        (highlight-index -1))
+    ;; Some factorisation migth be possible
+    (ecase *message-placement*
+      ('vertical
+       (loop for col in strings
+            for x-pos = *message-window-padding* then (+ x-pos max-width 
*message-window-inner-padding*)
+            do (setf max-width (loop for s in col
+                                     ;; We need this so we can track the row 
for each element
+                                     for i from 0 to (length col) do 
+                                     (xlib:draw-image-glyphs message-win 
gcontext
+                                                             x-pos
+                                                             (+ (* i height)
+                                                                
(xlib:font-ascent (screen-font screen)))
+                                                             s)
+                                     (incf highlight-index)
+                                     
+                                     when (and highlight
+                                               (= highlight highlight-index))
+                                     do (invert-rect screen message-win
+                                                     (- x-pos 
*message-window-padding*) (* i height)
+                                                     (+ (xlib:text-width 
(screen-font screen) s)
+                                                        
*message-window-padding*)
+                                                     height)
+                                     maximize (xlib:text-width (screen-font 
screen) s)))))
+      ('horizontal 
+       (loop for row in strings
+            for y-pos = (xlib:font-ascent (screen-font screen)) then (+ y-pos 
height)
+            do (loop for x-pos = *message-window-padding* then (+ x-pos 
(xlib:text-width (screen-font screen) s)
+                                                                  
*message-window-inner-padding*)
+                     for s in row do
+                     (xlib:draw-image-glyphs message-win gcontext x-pos y-pos 
s)
+                     (incf highlight-index)
+                     when (and highlight
+                               (= highlight highlight-index))
+                     do (invert-rect screen message-win
+                                     (- x-pos *message-window-padding*)
+                                     (- y-pos (xlib:font-ascent (screen-font 
screen)))
+                                     (+ (xlib:text-width (screen-font screen) 
s)
+                                        *message-window-padding*)
+                                     height))))))
   ;; Set a timer to hide the message after a number of seconds
   (reset-timeout))
 
Index: input.lisp
===================================================================
RCS file: /cvsroot/stumpwm/stumpwm/input.lisp,v
retrieving revision 1.3
diff -u -r1.3 input.lisp
--- input.lisp  24 Apr 2004 05:49:28 -0000      1.3
+++ input.lisp  31 May 2004 21:02:56 -0000
@@ -73,10 +73,14 @@
   (do ((ret nil (xlib:process-event *display* :handler #'read-key-handle-event 
:timeout nil)))
       ((consp ret) ret)))
 
-(defun read-one-line (screen prompt)
+(defun read-one-line (screen prompt &optional (editable-prompt-p nil))
   "Read a line of input through stumpwm and return it."
   (labels ((key-loop ()
             (let (input)
+              (when editable-prompt-p
+                (setf input (coerce prompt 'list))
+                (setf prompt (make-string 0))
+                (format t "Input: ~s~%" input))
               (do ((key (read-key) (read-key)))
                   (nil)
                 (multiple-value-bind (inp ret) (process-input screen prompt 
input
@@ -109,7 +113,7 @@
         (win (screen-input-window screen))
         (prompt-width (xlib:text-width (screen-font screen) prompt))
         (width (+ prompt-width
-                  (max 100 (xlib:text-width (screen-font screen) input))))
+                  (xlib:text-width (screen-font screen) input)))
        (screen-width (xlib:drawable-width (xlib:screen-root (screen-number 
screen)))))
     (xlib:clear-area win :x (+ *message-window-padding*
                               prompt-width
Index: primitives.lisp
===================================================================
RCS file: /cvsroot/stumpwm/stumpwm/primitives.lisp,v
retrieving revision 1.3
diff -u -r1.3 primitives.lisp
--- primitives.lisp     24 Apr 2004 05:49:28 -0000      1.3
+++ primitives.lisp     31 May 2004 21:02:56 -0000
@@ -108,8 +108,10 @@
 (defconstant +normal-state+ 1)
 (defconstant +iconic-state+ 3)  
 
-;; Message window constants
+;; Message window constants and parameters
 (defvar *message-window-padding* 5)
+(defvar *message-window-inner-padding* 15)
+(defparameter *message-placement* 'vertical)
 
 ;; line editor
 (defvar *editor-bindings* 
Index: user.lisp
===================================================================
RCS file: /cvsroot/stumpwm/stumpwm/user.lisp,v
retrieving revision 1.3
diff -u -r1.3 user.lisp
--- user.lisp   24 Apr 2004 05:49:28 -0000      1.3
+++ user.lisp   31 May 2004 21:02:56 -0000
@@ -65,7 +65,8 @@
   (set-key-binding #\f '() 'focus-frame-by-number)
   (set-key-binding #\t '() 'send-meta-key)
   (set-key-binding #\N '(:control) 'renumber)
-  (set-key-binding #\: '() 'eval-line))
+  (set-key-binding #\: '() 'eval-line)
+  )
 
 (defun focus-next-window (screen)
   (focus-forward screen (frame-sort-windows screen
@@ -115,8 +116,8 @@
   "Print a list of the windows to the screen."
   (let* ((wins (sort-windows screen))
         (highlight (position (screen-current-window screen) wins :test 
#'xlib:window-equal))
-       (names (mapcar (lambda (w)
-                        (funcall *window-format-fn* screen w)) wins)))
+        (names (mapcar (lambda (w)
+                         (funcall *window-format-fn* screen w)) wins)))
     (if (null wins)
        (echo-string screen "No Managed Windows")
       (echo-string-list screen names highlight))))
@@ -168,6 +169,18 @@
     (unless (null cmd)
       (port:run-prog *shell-program* :args (list "-c" cmd) :wait nil))))
 
+(defun partial-command (prompt)
+  "Provide a function that will execute the command completed by the
+stumpwm user. Behave mostly like `shell-command' if PROMPT is the
+empty string."
+  #'(lambda (screen)
+      (let ((cmd (read-one-line screen prompt t)))
+       (unless (null cmd)
+         (let* ((split (remove "" (partition:partition #\Space cmd) :test 
'string-equal))
+                (prog (car split))
+                (args (cdr split)))
+           (port:run-prog prog :args args :wait nil))))))
+
 (defun horiz-split-frame (screen)
   (split-frame screen (lambda (f) (split-frame-h screen f))))
 
@@ -203,9 +216,8 @@
 
 (defun focus-frame-sibling (screen)
   (let* ((sib (sibling (screen-frame-tree screen)
-                     (screen-current-frame screen)))
-
-oeutnh(l (tree-accum-fn sib (lambda (x y) x) (lambda (x) x))))
+                      (screen-current-frame screen)))
+        (l (tree-accum-fn sib (lambda (x y) x) (lambda (x) x))))
     (focus-frame screen l)))
 
 (defun focus-frame-by-number (screen)
----8<-------------------------------------------

-- 
Manuel Giraud