[STUMP] Just a bug fix

[Manuel Giraud]

Hi,

Now the 'stumpwm' command won't need a display argument. A small bug fix
that crash when doing 'focus-frame-sibling' and there's only one
frame. The patch (with old stuff also) follows (Shawn, if you read this
it would be really cool if you apply this patch to the cvs repository).

---8<------------------------------------
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   6 Oct 2004 20:16:03 -0000
@@ -72,7 +72,10 @@
   (find-screen (xlib:drawable-root w)))
 
 (defun window-name (win)
-  (concatenate 'string (mapcar #'code-char (xlib:get-property win :WM_NAME))))
+  (coerce (mapcar #'code-char (xlib:get-property win :WM_NAME)) 'string))
+
+(defun window-class (win)
+  (coerce (mapcar #'code-char (xlib:get-property win :WM_CLASS)) 'string))
 
 (defun window-number (screen win)
   (gethash :number (gethash win (screen-window-hash screen))))
@@ -134,25 +137,22 @@
   
 (defun maximize-window (win)
   "Maximize the window."
-  (let* ((screen (window-screen win))
-        (hints (geometry-hints screen win))
-        (x (first hints))
-        (y (second hints))
-        (width (third hints))
-        (height (fourth hints))
-        (inc-x (fifth hints))
-        (inc-y (sixth hints)))
-    ;; Move the window
-    (setf (xlib:drawable-x win) x
-         (xlib:drawable-y win) y)
-    ;; Resize the window
-    (setf (xlib:drawable-width win)
-         (+ (xlib:drawable-width win)
-            (* inc-x (truncate (/ (- width (xlib:drawable-width win)) inc-x))))
-         (xlib:drawable-height win)
-         (+ (xlib:drawable-height win)
-            (* inc-y (truncate (/ (- height (xlib:drawable-height win)) 
inc-y)))))
-    (xlib:display-force-output *display*)))
+  (unless (or (member (window-name win) *bypass-maximize* :test #'string-equal)
+             (member (window-class win) *bypass-maximize* :test 
#'string-equal))
+    (let ((screen (window-screen win)))
+      (multiple-value-bind (x y width height inc-x inc-y)
+         (geometry-hints screen win)
+       ;; Move the window
+       (setf (xlib:drawable-x win) x
+             (xlib:drawable-y win) y)
+       ;; Resize the window
+       (setf (xlib:drawable-width win)
+             (+ (xlib:drawable-width win)
+                (* inc-x (truncate (/ (- width (xlib:drawable-width win)) 
inc-x))))
+             (xlib:drawable-height win)
+             (+ (xlib:drawable-height win)
+                (* inc-y (truncate (/ (- height (xlib:drawable-height win)) 
inc-y)))))
+       (xlib:display-force-output *display*)))))
 
 (defun find-free-window-number (screen)
   "Return a free window number for SCREEN."
@@ -227,9 +227,8 @@
       (setf inc-x hints-inc-x))
     (when hints-inc-y
       (setf inc-y hints-inc-y))
-    ;; Now return our findings as a list
-    ;; FIXME: use values
-    (list x y width height inc-x inc-y)))
+    ;; Now return our findings
+    (values x y width height inc-x inc-y)))
 
 (defun grab-keys-on-window (win)
   (xlib:grab-key win (xlib:keysym->keycodes *display* (char->keysym 
*prefix-key*))
@@ -364,13 +363,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 +451,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."
@@ -402,12 +474,13 @@
   
 
 (defun focus-frame (screen f)
-  (let ((w (frame-window (frame-data screen f))))
-    (setf (screen-current-frame screen) f)
-    (pprint (frame-data screen f))
-    (if w
-       (focus-window w)
-      (no-focus screen))))
+  (when f
+    (let ((w (frame-window (frame-data screen f))))
+      (setf (screen-current-frame screen) f)
+      (pprint (frame-data screen f))
+      (if w
+         (focus-window w)
+       (no-focus screen)))))
 
 (defun frame-data (screen f)
   "Return the data associated with frame F."
@@ -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  6 Oct 2004 20:16:04 -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     6 Oct 2004 20:16:04 -0000
@@ -108,13 +108,18 @@
 (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)
+
+;; List of window class or name to bypass maximization
+(defparameter *bypass-maximize* nil
+  "List of window class or name to bypass maximization.")
 
 ;; line editor
-(defvar *editor-bindings* 
-  "A list of key-bindings for line editing."
-  nil)
+(defvar *editor-bindings* nil
+  "A list of key-bindings for line editing.")
 
 (defstruct frame
   (number nil :type integer)
Index: stumpwm.lisp
===================================================================
RCS file: /cvsroot/stumpwm/stumpwm/stumpwm.lisp,v
retrieving revision 1.16
diff -u -r1.16 stumpwm.lisp
--- stumpwm.lisp        29 Feb 2004 10:36:00 -0000      1.16
+++ stumpwm.lisp        6 Oct 2004 20:16:04 -0000
@@ -65,7 +65,9 @@
 ;; (stumpwm "" :display 0)
 (defun stumpwm (host &key display protocol)
   "Start the stump window manager."
-  (setf *display* (xlib:open-display host :display display :protocol protocol))
+  ;; Parse DISPLAY environment var
+  (let ((display (parse-integer (xlib::getenv "DISPLAY") :start 1 
:junk-allowed t)))
+    (setf *display* (xlib:open-display host :display display :protocol 
protocol)))
   ;; set our input handler
   (setf (xlib:display-error-handler *display*) #'error-handler)
   ;; In the event of an error, we always need to close the display
@@ -78,8 +80,7 @@
        (mapc #'process-existing-windows *screen-list*)
        ;; Give the first screen's frame focus
        (focus-frame (first *screen-list*) (screen-current-frame (first 
*screen-list*)))
-       ;; Setup our keys. FIXME: should this be in the hook?
-       (set-default-bindings)
+       ;; Run hooks
        (run-hook *start-hook*)
        ;; Let's manage.
        (stumpwm-internal-loop))
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   6 Oct 2004 20:16:05 -0000
@@ -30,42 +30,41 @@
   "Bind KEY to the function FN."
   (setf (gethash (list key mod) *key-bindings*) fn))
 
-(defun set-default-bindings ()
-  "Put the default bindings in the key-bindings hash table."
-  (set-key-binding #\n '() 'focus-next-window)
-  (set-key-binding #\n '(:control) 'focus-next-window)
-  (set-key-binding #\p '() 'focus-prev-window)
-  (set-key-binding #\p '(:control) 'focus-prev-window)
-  (set-key-binding #\w '() 'echo-windows)
-  (set-key-binding #\w '(:control) 'echo-windows)
-  (set-key-binding #\k '() 'delete-current-window)
-  (set-key-binding #\k '(:control) 'delete-current-window)
-  (set-key-binding #\b '() 'banish-pointer)
-  (set-key-binding #\b '(:control) 'banish-pointer)
-  (set-key-binding #\a '() 'echo-date)
-  (set-key-binding #\a '(:control) 'echo-date)
-  (set-key-binding #\' '() 'select-window)
-  (set-key-binding #\t '(:control) 'other-window)
-  (set-key-binding #\! '() 'shell-command)
-  (set-key-binding #\g '(:control) (lambda (s))) ; abort
-  (set-key-binding #\0 '() (lambda (s) (pull-window-by-number s 0)))
-  (set-key-binding #\1 '() (lambda (s) (pull-window-by-number s 1)))
-  (set-key-binding #\2 '() (lambda (s) (pull-window-by-number s 2)))
-  (set-key-binding #\3 '() (lambda (s) (pull-window-by-number s 3)))
-  (set-key-binding #\4 '() (lambda (s) (pull-window-by-number s 4)))
-  (set-key-binding #\5 '() (lambda (s) (pull-window-by-number s 5)))
-  (set-key-binding #\6 '() (lambda (s) (pull-window-by-number s 6)))
-  (set-key-binding #\7 '() (lambda (s) (pull-window-by-number s 7)))
-  (set-key-binding #\8 '() (lambda (s) (pull-window-by-number s 8)))
-  (set-key-binding #\9 '() (lambda (s) (pull-window-by-number s 9)))
-  (set-key-binding #\r '() 'remove-split)
-  (set-key-binding #\s '() 'horiz-split-frame)
-  (set-key-binding #\S '() 'vert-split-frame)
-  (set-key-binding #\o '() 'focus-frame-sibling)
-  (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))
+;; Default keybinding when loading
+(set-key-binding #\n '() 'focus-next-window)
+(set-key-binding #\n '(:control) 'focus-next-window)
+(set-key-binding #\p '() 'focus-prev-window)
+(set-key-binding #\p '(:control) 'focus-prev-window)
+(set-key-binding #\w '() 'echo-windows)
+(set-key-binding #\w '(:control) 'echo-windows)
+(set-key-binding #\k '() 'delete-current-window)
+(set-key-binding #\k '(:control) 'delete-current-window)
+(set-key-binding #\b '() 'banish-pointer)
+(set-key-binding #\b '(:control) 'banish-pointer)
+(set-key-binding #\a '() 'echo-date)
+(set-key-binding #\a '(:control) 'echo-date)
+(set-key-binding #\' '() 'select-window)
+(set-key-binding #\t '(:control) 'other-window)
+(set-key-binding #\! '() 'shell-command)
+(set-key-binding #\g '(:control) (lambda (s))) ; abort
+(set-key-binding #\0 '() (lambda (s) (pull-window-by-number s 0)))
+(set-key-binding #\1 '() (lambda (s) (pull-window-by-number s 1)))
+(set-key-binding #\2 '() (lambda (s) (pull-window-by-number s 2)))
+(set-key-binding #\3 '() (lambda (s) (pull-window-by-number s 3)))
+(set-key-binding #\4 '() (lambda (s) (pull-window-by-number s 4)))
+(set-key-binding #\5 '() (lambda (s) (pull-window-by-number s 5)))
+(set-key-binding #\6 '() (lambda (s) (pull-window-by-number s 6)))
+(set-key-binding #\7 '() (lambda (s) (pull-window-by-number s 7)))
+(set-key-binding #\8 '() (lambda (s) (pull-window-by-number s 8)))
+(set-key-binding #\9 '() (lambda (s) (pull-window-by-number s 9)))
+(set-key-binding #\r '() 'remove-split)
+(set-key-binding #\s '() 'horiz-split-frame)
+(set-key-binding #\S '() 'vert-split-frame)
+(set-key-binding #\o '() 'focus-frame-sibling)
+(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)
 
 (defun focus-next-window (screen)
   (focus-forward screen (frame-sort-windows screen
@@ -115,8 +114,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))))
@@ -127,7 +126,7 @@
          #("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" 
"Dec"))
         (day-names
          #("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun"))
-        (date-string (multiple-value-bind (sec min hour dom mon year dow)
+        (date-string (multiple-value-bind (sec min hour dom mon year dow dst_p 
timezone)
                         (get-decoded-time)
                       (format nil "~A ~A ~A 
~A:~2,,,'address@hidden:~2,,,'address@hidden ~A"
                               (aref day-names dow)
@@ -168,6 +167,22 @@
     (unless (null cmd)
       (port:run-prog *shell-program* :args (list "-c" cmd) :wait nil))))
 
+(defun run-command-string (str)
+  "Execute the given command string."
+  (let* ((split (remove "" (split-sequence:split-sequence #\Space str) :test 
'string-equal))
+        (prog (car split))
+        (args (cdr split)))
+    (port:run-prog prog :args args :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)
+         (run-command-string cmd)))))
+
 (defun horiz-split-frame (screen)
   (split-frame screen (lambda (f) (split-frame-h screen f))))
 
@@ -203,9 +218,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 (CNRS/CETP)