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

added the kill-button to client titlebars 

fixed select-next/previous
This commit is contained in:
frese 2003-04-15 16:01:23 +00:00
parent 70d94af8a5
commit 52c1669cbe
1 changed files with 17 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
src/switch-wm.scm
View File

@ -164,6 +164,9 @@
root-x root-y)))))) root-x root-y))))))
((click) ((click)
(wm-select-client wm client (fourth msg))) (wm-select-client wm client (fourth msg)))
;; from titlebar-buttons
((kill)
(delete-window dpy (client:window client) (second msg)))
(else (mdisplay "unhandled client message: " msg "\n")))) (else (mdisplay "unhandled client message: " msg "\n"))))
;; TODO: internal channel ;; TODO: internal channel
(loop)))) (loop))))
@ -191,7 +194,6 @@
(let* ((options (wm:options wm)) (let* ((options (wm:options wm))
(tb (tb
(create-titlebar #f (wm:dpy wm) (wm:window wm) (wm:colormap wm) (create-titlebar #f (wm:dpy wm) (wm:window wm) (wm:colormap wm)
;; buttons ??
(list ;; TODO: (cons 'draggable #f) (list ;; TODO: (cons 'draggable #f)
(cons 'normal-colors (cons 'normal-colors
(get-option options 'titlebar-colors)) (get-option options 'titlebar-colors))
@ -200,7 +202,8 @@
(cons 'focused-colors (cons 'focused-colors
(get-option options 'titlebar-colors-focused)) (get-option options 'titlebar-colors-focused))
(cons 'border-style (cons 'border-style
(get-option options 'titlebar-style)))))) (get-option options 'titlebar-style))
(cons 'buttons '())))))
(set-titlebar-title! tb "<empty frame>") (set-titlebar-title! tb "<empty frame>")
tb)) tb))
@ -233,16 +236,12 @@
(define (select-next-client* wm clients time) (define (select-next-client* wm clients time)
(let ((cc (wm-current-client wm))) (let ((cc (wm-current-client wm)))
(let loop ((rest clients)) (let loop ((l (append clients clients)))
(if (null? rest) (and (not (null? l))
(if (null? clients) (if (eq? (car l) cc)
#f (and (not (null? (cdr l)))
(car clients)) (wm-select-client wm (cadr l) time))
(if (eq? cc (car rest)) (loop (cdr l)))))))
(if (null? (cdr rest))
#f
(wm-select-client wm (cadr rest) time))
(loop (cdr rest)))))))
(define (select-next-client wm time) (define (select-next-client wm time)
(select-next-client* wm (wm-clients wm) time)) (select-next-client* wm (wm-clients wm) time))