[STUMP] Moving focus around

[Phil!Gregory]

One of the things that I like about ion is its ability to move focus
between its frames in a 2D manner, so here's a StumpWM command to do the
same thing.  'move-focus {up,down,left,right}' does what it says, moving
the focus to the next frame in the given direction.  If there's more than
one frame that satisfies the criteria, it picks the one closer to the
origin.

  (defun find-closest-frame (ref-frame framelist closeness-func lower-bound-func
                             upper-bound-func)
    (loop for f in framelist
          with r = nil
          do (when (and
                    ;; Frame is on the side that we want.
                    (<= 0 (funcall closeness-func f))
                    ;; Frame is within the bounds set by the reference frame.
                    (or (<= (funcall lower-bound-func ref-frame)
                            (funcall lower-bound-func f)
                            (funcall upper-bound-func ref-frame))
                        (<= (funcall lower-bound-func ref-frame)
                            (funcall upper-bound-func f)
                            (funcall upper-bound-func ref-frame))
                        (<= (funcall lower-bound-func f)
                            (funcall lower-bound-func ref-frame)
                            (funcall upper-bound-func f)))
                    ;; Frame is closer to the reference and the origin than the
                    ;; previous match
                    (or (null r)
                        (< (funcall closeness-func f) (funcall closeness-func 
r))
                        (and (= (funcall closeness-func f) (funcall 
closeness-func r))
                             (< (funcall lower-bound-func f) (funcall 
lower-bound-func r)))))
               (setf r f))
          finally (return r)))

  (define-stumpwm-command "move-focus" (screen (dir :string "Direction: "))
    (destructuring-bind (perp-coord perp-span parall-coord parall-span)
        (cond
          ((or (string= dir "left") (string= dir "right"))
           (list #'frame-y #'frame-height #'frame-x #'frame-width))
          ((or (string= dir "up") (string= dir "down"))
           (list #'frame-x #'frame-width #'frame-y #'frame-height))
          (t
           (echo-string "Valid directions: up, down, left, right")
           '(nil nil nil nil)))
      (when perp-coord
        (let ((new-frame (find-closest-frame
                          (screen-current-frame screen)
                          (screen-frames screen)
                          (if (or (string= dir "left") (string= dir "up"))
                              (lambda (f)
                                (- (funcall parall-coord (screen-current-frame 
screen))
                                   (funcall parall-coord f) (funcall 
parall-span f)))
                              (lambda (f)
                                (- (funcall parall-coord f)
                                   (funcall parall-coord (screen-current-frame 
screen))
                                   (funcall parall-span (screen-current-frame 
screen)))))
                          perp-coord
                          (lambda (f)
                            (+ (funcall perp-coord f) (funcall perp-span
                            f))))))
          (when new-frame
            (focus-frame screen new-frame))
          (show-frame-indicator screen)))))

I like having these bound to the M-<arrow> keys, for ease of zipping
around the screen:

  (define-key *top-map* (kbd "M-Up")    "move-focus up"   )
  (define-key *top-map* (kbd "M-Down")  "move-focus down" )
  (define-key *top-map* (kbd "M-Left")  "move-focus left" )
  (define-key *top-map* (kbd "M-Right") "move-focus right")
  (sync-keys)  ; Not sure if this is necessary when defining keys before
               ; any windows have been created.


-- 
...computer contrarian of the first order... / http://aperiodic.net/phil/
PGP: 026A27F2  print: D200 5BDB FC4B B24A 9248  9F7A 4322 2D22 026A 27F2
--- --
TIMECUBE ERROR, CORNER DUMPED
---- --- --