scsh-conservatory
/
orion-wm
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

added iconify, maximize 

added show-clients
This commit is contained in:
frese 2003-05-05 14:38:50 +00:00
parent 0598918d0c
commit 985b20dcb2
4 changed files with 196 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
src/move-wm-icon.scm Normal file
View File

@ -0,0 +1,86 @@
(define-record-type icon :icon
(make-icon wm client window)
icon?
(wm icon:wm)
(client icon:client)
(window icon:window))
(define (create-icon wm client rect)
(let* ((dpy (wm:dpy wm))
(window (create-simple-window dpy (wm:window wm)
(rectangle:x rect) (rectangle:y rect)
(rectangle:width rect)
(rectangle:height rect)
0
(black-pixel dpy) (white-pixel dpy)))
(gc (create-gc dpy window
(make-gc-value-alist
(foreground (black-pixel dpy))
(background (white-pixel dpy))))))
(spawn*
(list 'move-wm-icon wm client window)
(lambda (release)
(call-with-current-continuation
(lambda (exit)
(call-with-event-channel
dpy window (event-mask exposure
structure-notify
button-press)
(lambda (event-channel)
(release)
(let loop ()
(let ((xevent (receive event-channel)))
(cond
((destroy-window-event? xevent) (exit 'destroyed))
((expose-event? xevent)
(if (= 0 (expose-event-count xevent))
(draw-icon dpy window gc client)))
((and (button-event? xevent)
(eq? (event-type button-press)
(button-event-type xevent)))
(send (wm:internal-out-channel wm)
(list 'normalize-client client))
(exit 'normalized)))
(loop)))))))
(free-gc dpy gc)))
(make-icon wm client window)))
(define (map-icon icon)
(map-window (wm:dpy (icon:wm icon)) (icon:window icon)))
(define (destroy-icon icon)
(destroy-window (wm:dpy (icon:wm icon)) (icon:window icon)))
(define (draw-icon dpy window gc client)
(let ((title (client-name dpy client)) ;; or WM_ICON_NAME ??
(r (clip-rectangle dpy window)))
(draw-image-string dpy window gc 2 14 title)))
(define (find-icon-rect wm-rect icons)
(let* ((icon-w 200)
(icon-h 18)
(xs (iota (quotient (rectangle:width wm-rect) icon-w)))
(ys (reverse (iota (quotient (rectangle:height wm-rect) icon-h))))
(all (flatten (map (lambda (yi)
(map (lambda (xi)
(make-rectangle (* xi icon-w)
(* yi icon-h)
icon-w icon-h))
xs))
ys)))
(icon-rects (map (lambda (i)
(window-rectangle (wm:dpy (icon:wm i))
(icon:window i)))
icons))
(free (filter (lambda (r)
(not (any (lambda (ir)
(rectangles-overlap? r ir))
icon-rects)))
all)))
(if (null? free)
(if (null? all)
(make-rectangle 0 0 icon-w icon-h)
(car all))
(car free))))

98
src/move-wm.scm
View File

@ -12,7 +12,9 @@
(define (create-move-wm out-channel dpy parent options default-options
. children)
(create-wm dpy parent options default-options children
(create-wm dpy parent options (append default-options
'((focus-policy . (click))))
children
(manager-type move) move-wm-options-spec
out-channel
(lambda (wm in-channel)
@ -77,6 +79,33 @@
(append (make-window-change-alist
(border-width 0))
changes))))
((iconify-client)
(let ((client (second msg)))
(if (not (client-data:icon client))
(begin
(unmap-window dpy (client:client-window client))
(unmap-window dpy (client:window client))
(set-wm-state! dpy (client:window client) (wm-state iconic)
none)
(let ((icon (create-client-icon wm client)))
(set-client-data:icon! client icon)
(map-icon icon))))))
((maximize-client)
(let ((client (second msg)))
(maximize-window dpy (client:client-window client))))
((normalize-client)
(let ((client (second msg)))
(if (client-data:icon client)
(begin
(destroy-icon (client-data:icon client))
(map-window dpy (client:window client))
(map-window dpy (client:client-window client))
(set-wm-state! dpy (client:window client) (wm-state normal)
none)
(set-client-data:icon! client #f)))))
((draw-client-window)
(draw-client-window wm (second msg) gc))
@ -97,17 +126,41 @@
(state (if focused?
'focused
'normal))
(titlebar (car (client:data client))))
(titlebar (client-data:titlebar client)))
(set-titlebar-state! titlebar state)))
((update-client-name)
(let ((client (second msg))
(name (third msg)))
(let ((titlebar (car (client:data client))))
(let ((titlebar (client-data:titlebar client)))
(set-titlebar-title! titlebar name))))
((show-clients)
(let ((clients (second msg)))
(for-each (lambda (c)
(if (client-data:icon c)
(handle-message wm gc exit
(list 'normalize-client c)))
(raise-window dpy (client:client-window c)))
clients)))
(else (warn "unhandled move-wm message" wm msg)))))
(define (make-client-data titlebar resizer icon)
(list titlebar resizer icon))
(define (client-data:titlebar client)
(first (client:data client)))
(define (client-data:resizer client)
(second (client:data client)))
(define (client-data:icon client)
(third (client:data client)))
(define (set-client-data:icon! client icon)
(set-car! (cddr (client:data client)) icon))
(define (init-client wm client maybe-rect)
(let ((dpy (wm:dpy wm)))
(let* ((r (initial-client-rect wm (client:window client) maybe-rect))
@ -115,7 +168,7 @@
(titlebar (create-client-titlebar channel wm client))
(resizer (create-resizer wm client))
(options (wm:options wm)))
(set-client:data! client (list titlebar resizer))
(set-client:data! client (make-client-data titlebar resizer #f))
(set-titlebar-title! titlebar (client-name dpy client))
(let ((bw (get-option-value options 'border-width))
(th (get-option-value options 'titlebar-height)))
@ -155,6 +208,10 @@
;; from titlebar-buttons
((kill)
(delete-window dpy (client:window client) (second msg)))
((iconify)
(wm-iconify-window wm (client:window client)))
((maximize)
(wm-maximize-window wm (client:window client)))
))))
;; TODO: internal channel
(loop))
@ -169,7 +226,7 @@
(let ((options (wm:options wm)))
(create-titlebar channel (wm:dpy wm) (client:client-window client)
(wm:colormap wm)
(list (cons 'buttons '(kill maximize))
(list (cons 'buttons '(kill maximize iconify))
(cons 'normal-colors
(get-option options 'titlebar-colors))
(cons 'active-colors
@ -181,7 +238,14 @@
(define (deinit-client wm client)
(let ((dpy (wm:dpy wm)))
#t))
(set-input-focus dpy (wm:window wm) (revert-to parent) current-time)))
(define (create-client-icon wm client)
(let* ((other-icons (filter (lambda (x) x)
(map client-data:icon (wm-clients wm))))
(r (find-icon-rect (clip-rectangle (wm:dpy wm) (wm:window wm))
other-icons)))
(create-icon wm client r)))
;; ***
@ -201,7 +265,7 @@
(- (window-attribute:height wa)
(+ (* 2 border-width) titlebar-height))))
(move-resize-titlebar
(car (client:data client))
(client-data:titlebar client)
(make-rectangle border-width border-width
(- (window-attribute:width wa) (* 2 border-width))
titlebar-height))))
@ -223,8 +287,14 @@
(let* ((dpy (wm:dpy wm))
(win (client:client-window client))
(x (window-x dpy win))
(y (window-y dpy win)))
#t)) ;; ... TODO
(y (window-y dpy win))
(w (window-width (wm:window wm)))
(h (window-height (wm:window wm))))
;; TODO: assert-icon-visible ...
(if (>= x w)
(set-window-x! win (- w 10)))
(if (>= y h)
(set-window-y! win (- h 10)))))
(define (draw-client-window wm client gc)
(let* ((options (wm:options wm))
@ -267,7 +337,15 @@
(w.h-2 (maximal-size/hints dpy win (car w.h-1) (cdr w.h-1)))
(w.h (desired-size/hints dpy win w.h-2))
;; TODO: look for a free position ?! Transients centered?
(x.y (desired-position/hints dpy win (cons 0 0))))
(maybe-x.y (find-free-position wm w.h (cons 0 0)))
(x.y (desired-position/hints dpy win maybe-x.y)))
(make-rectangle (car x.y) (cdr x.y)
(car w.h) (cdr w.h)))))
(define (find-free-position wm size default-pos)
(let* ((dpy (wm:dpy wm))
(max-w (window-width dpy (wm:window wm)))
(max-h (window-height dpy (wm:window wm)))
(w (car size))
(h (cdr size)))
default-pos)) ;; TODO

4
src/split-wm.scm
View File

@ -109,6 +109,8 @@
(or first-client second-client))
(let ((r (client:window (or first-client second-client))))
(send (wm:out-channel wm) (list 'destroy-wm wm r)))))))
((iconfiy-client maximize-client) #t)
((draw-client-window) #t)
@ -138,6 +140,8 @@
(if (data:second-client data)
(wm-select-client wm (data:second-client data) time))))
((show-clients) #t)
(else (warn "unhandled split-wm message" wm msg)))))
(define (calc-rectangles wm)

20
src/switch-wm.scm
View File

@ -89,6 +89,8 @@
((deinit-client)
(deinit-client wm data (second msg)))
((iconify-client maximize-client) #t)
((configure-window)
(let ((window (second msg))
(changes (third msg)))
@ -144,6 +146,15 @@
((select-next) (select-next-client wm (second msg)))
((select-previous) (select-previous-client wm (second msg)))
((show-clients)
(let ((clients (second msg)))
;; it's a list of a client and it's transients.
(let ((cc (wm-current-client wm))
(top (last clients)))
(if (and cc (window-mapped? dpy (client:client-window cc)))
(unmap-window dpy (client:client-window cc)))
(map-window dpy (client:client-window top)))))
(else (warn "unhandled switch-wm message" wm msg)))))
(define (fit-titlebars wm data)
@ -222,7 +233,7 @@
(map-titlebar titlebar)
(if (window-exists? dpy (client:window client))
(map-window dpy (client:window client)))
(map-window dpy (client:client-window client)))))
(wm-select-client wm client current-time))))
(define (create-client-titlebar channel wm client)
(let ((options (wm:options wm)))
@ -263,7 +274,12 @@
(data:titlebars data)))
(if tb (destroy-titlebar tb))
(fit-titlebars wm data)
(update-titlebars wm data)))
(update-titlebars wm data)
(if (eq? client (wm-current-client wm))
(if (null? (wm-clients wm))
(set-input-focus dpy (wm:window wm) (revert-to parent)
current-time)
(wm-select-client wm (car (wm-clients wm)) current-time)))))
;; ***