Re: [STUMP] Just a bug fix

[Shawn Betts]

Manuel Giraud <address@hidden> writes:

> 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).

Hi Manuel,

I had a chance to look through your patch. See my comments below.

> ---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))

I've put this in CVS.

>  (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)))

This hunk looks good except for the bypass-maximize part. It's in CVS.

>  (defun grab-keys-on-window (win)
>    (xlib:grab-key win (xlib:keysym->keycodes *display* (char->keysym 
> *prefix-key*))
> @@ -364,13 +363,84 @@

[SNIP - vertical/horizontal lists hunk]

In CVS, the current window in the window list is highlighted with an
inverted bar that stretches the length of the window. But your code
only highlights the window name.

Also, I decided not to implement a horizontal window list because I've
found the vertical list is much more readable and can display more
windows without running off the edge of the screen.

So I haven't applied this hunk to CVS. Are there other reasons to
have a horizontal list that I've overlooked?

> @@ -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)))))

Why have you wrapped the function in (when f ..)? Was it to fix a bug?
Which one?

>  (defun frame-data (screen f)
>    "Return the data associated with frame F."
> @@ -697,27 +770,54 @@

[SNIP - another vert/horiz hunk]

> 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))

Rather than have an editable-prompt-p, why not have an initial-input
string you can pass in which gets put into the input area? That way
you can still have a prompt string.

>              (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)))

The reason I put 100 there was so the input window didn't shrink to a
tiny box. I'd rather make it customizable than get rid of it. Comments?

>       (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.")

No window will be left unmaximized.

>  ;; 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.")

Doh! I put this in CVS.

>  (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)))

I figured if we're going to parse the display string we should do it
completely. So I wrote one that pulls out the host and display. I used
port:getenv instead of xlib::getenv since xlib's fn isn't not exported.

>    ;; 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

See below.

>       (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))
>  

[SNIP - remove set-default-bindings fn]

Why remove the function? I think it's convenient to have a function
that restores the default bindings.

>  
>  (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)))

Oops. This is in CVS.

>      (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)

Why did you add dst_p and timezone? For completeness? :)

>                        (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)))))
> +

I think this could be done better with my initial-input comment above.

>  (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))))

That's nice and embarrassing :).