[STUMP] Multi-col in message window

[Manuel Giraud]

Hi folks,

Here's a patch to have multiple column in the message window (note that
it also include partial command function):

---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   11 May 2004 09:42:09 -0000
@@ -364,24 +364,79 @@
   (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 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))))
+  (let ((screen-width (screen-width screen))
        (win (screen-message-window screen)))
-    ;; Now that we know the dimensions, raise and resize it.
-    (xlib:map-window (screen-message-window screen))
-    (setf (xlib:drawable-y win) 0
-         (xlib:drawable-height win) height
-         (xlib:drawable-x win) (- screen-width width
-                                  (* (xlib:drawable-border-width win) 2)
-                                  (* *message-window-padding* 2))
-         (xlib:drawable-width win) (+ width (* *message-window-padding* 2))
-         (xlib:window-priority win) :above)
-    ;; Clear the window
-    (xlib:clear-area win)))
+    (multiple-value-bind (vertical-list height width)
+       (vertical-box-placement l (screen-height screen) 
*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)))
+      ;; Now that we know the dimensions, raise and resize it.
+      (xlib:map-window (screen-message-window screen))
+      (setf (xlib:drawable-y win) 0
+           (xlib:drawable-height win) height
+           (xlib:drawable-x win) (- screen-width width
+                                    (* (xlib:drawable-border-width win) 2)
+                                    (* *message-window-padding* 2))
+           (xlib:drawable-width win) (+ width (* *message-window-padding* 2))
+           (xlib:window-priority win) :above)
+      ;; Clear the window
+      (xlib:clear-area win)
+      ;; Return the new list to the caller
+      vertical-list)))
 
 (defun invert-rect (screen win x y width height)
   "invert the color in the rectangular area. Used for highlighting text."
@@ -702,22 +757,30 @@
   (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))
+        (vertical-strings (setup-message-window screen strings))
+        (max-width 0)
+        (highlight-index -1))
+    (loop for col in vertical-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)))))
   ;; Set a timer to hide the message after a number of seconds
   (reset-timeout))
 
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     11 May 2004 09:42:09 -0000
@@ -110,6 +110,7 @@
 
 ;; Message window constants
 (defvar *message-window-padding* 5)
+(defvar *message-window-inner-padding* 15)
 
 ;; 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   11 May 2004 09:42:09 -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,19 @@
     (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-end (read-one-line screen prompt))
+            (cmd (concatenate 'string prompt cmd-end)))
+       (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 +217,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

ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,