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

- replaced the "last-focused" functionality in switch-wm with a list 

of clients in stacking order in manager.
This commit is contained in:
frese 2005-02-14 18:54:16 +00:00
parent af7138816e
commit 0344af777d
4 changed files with 22 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/manager.scm
View File

@ -1,7 +1,7 @@
(define-record-type wm :wm
(make-wm type in-channel out-channel internal-out-channel
dpy window colormap options special-options
clients current-client)
clients clients-stacking current-client)
wm?
(type wm:type)
(in-channel wm:in-channel)
@ -13,6 +13,7 @@
(options wm:options)
(special-options wm:special-options)
(clients wm:clients set-wm:clients!)
(clients-stacking wm:clients-stacking set-wm:clients-stacking!)
(current-client wm:current-client set-wm:current-client!))
(define-record-discloser :wm
@ -20,6 +21,7 @@
`(Wm ,(manager-type-name (wm:type wm)) ,(wm:window wm))))
(define wm-clients wm:clients)
(define wm-clients-stacking wm:clients-stacking)
(define wm-current-client wm:current-client)
(define-enumerated-type manager-type :manager-type
@ -46,7 +48,7 @@
(internal-out-channel (make-channel))
(wm (make-wm type in-channel out-channel internal-out-channel
dpy main-window colormap
options special-options '() #f)))
options special-options '() '() #f)))
(set-window-background-pixmap! dpy main-window parent-relative)
;; set properties ************************************************
@ -169,6 +171,7 @@
(maybe-rect (third msg)))
(let ((client (create-client wm window)))
(set-wm:clients! wm (append (wm:clients wm) (list client)))
(set-wm:clients-stacking! wm (cons client (wm:clients-stacking wm)))
(send-message+wait internal-out-channel
(list 'init-client client maybe-rect))
(if (not (wm:current-client wm))
@ -210,6 +213,8 @@
(let ((client (second msg)))
(set-wm:clients! wm (filter (lambda (c) (not (eq? c client)))
(wm:clients wm)))
(set-wm:clients-stacking! wm (filter (lambda (c) (not (eq? c client)))
(wm:clients-stacking wm)))
(send-message+wait (wm:internal-out-channel wm)
(list 'deinit-client client))
(if (eq? client (wm:current-client wm))
@ -226,6 +231,10 @@
(send-message+wait (wm:internal-out-channel wm)
(list 'show-clients all))
(set-wm:current-client! wm top)))
(set-wm:clients-stacking! wm
(append (reverse all)
(filter (lambda (c) (not (memq c all)))
(wm:clients-stacking wm))))
(if (window-exists? dpy (client:window top))
(take-focus dpy (client:window top) time))))

4
src/move-wm.scm
View File

@ -51,7 +51,7 @@
((wait)
(let ((sp (second msg))
(message (third msg)))
(handle-message wm pager gc
(handle-message wm pager gc titlebar-options
(lambda args
(sync-point-release sp)
(apply exit args))
@ -214,7 +214,7 @@
(let ((clients (second msg)))
(for-each (lambda (c)
(if (eq? (client:wm-state c) (wm-state iconic))
(handle-message wm pager gc exit
(handle-message wm pager gc titlebar-options exit
(list 'normalize-client c)))
(raise-window dpy (client:client-window c)))
clients)))

7
src/packages.scm
View File

@ -122,7 +122,7 @@
wm:internal-out-channel wm:special-options
(manager-type :syntax) manager-types manager-type-name
create-wm destroy-wm
wm-clients wm-current-client
wm-clients wm-clients-stacking wm-current-client
wm-manage-window wm-unmanage-window wm-select-client
wm-configure-window
wm-iconify-window wm-normalize-window wm-maximize-window
@ -137,7 +137,7 @@
client-name find-window-by-name get-all-window-names
client-replace-window
client-of-window)
(open scheme threads list-lib locks signals
(open scheme (subset scsh (format)) threads list-lib locks signals
xlib
define-record-types
finite-types
@ -175,7 +175,8 @@
(define-structure switch-wm
(export create-switch-wm)
(open scheme list-lib define-record-types signals
(open scheme (subset scsh (format))
list-lib define-record-types signals
threads rendezvous-channels rendezvous
xlib
manager titlebar dragging

26
src/switch-wm.scm
View File

@ -8,25 +8,12 @@
wm)))
(define-record-type switch-wm-data :switch-wm-data
(make-switch-wm-data titlebars empty-titlebar last-focused titlebar-options)
(make-switch-wm-data titlebars empty-titlebar titlebar-options)
switch-wm-data?
(titlebars data:titlebars set-data:titlebars!)
(empty-titlebar data:empty-titlebar)
(last-focused data:last-focused set-data:last-focused!)
(titlebar-options data:titlebar-options))
;; only for switch-wm's, but maybe we will need that for all...
(define (last-focused-client wm data)
(let ((c (cdr (data:last-focused data))))
(and (memq c (wm-clients wm)) c)))
(define (add-last-focused-client! wm data client)
(let ((p (data:last-focused data)))
(if (not (eq? client (car p)))
(begin
(set-cdr! p (car p))
(set-car! p client)))))
(define (init-switch-wm wm channel)
(let* ((dpy (wm:dpy wm))
(window (wm:window wm))
@ -47,8 +34,7 @@
(button-up-colors . ,(get 'titlebar-button-up-colors))
(height . ,(get 'titlebar-height))))))
(empty-titlebar (create-empty-titlebar wm))
(data (make-switch-wm-data '() empty-titlebar (cons #f #f)
titlebar-options)))
(data (make-switch-wm-data '() empty-titlebar titlebar-options)))
(update-titlebars wm data)
(for-each (lambda (id)
@ -148,8 +134,7 @@
(if (window-viewable? dpy window)
'active
'normal))))
(set-titlebar-state! titlebar state)))
(if focused? (add-last-focused-client! wm data client))))
(set-titlebar-state! titlebar state)))))
((update-client-name)
(let ((client (second msg))
@ -295,11 +280,10 @@
(fit-titlebars wm data)
(update-titlebars wm data)
(if (eq? client (wm-current-client wm))
(if (null? (wm-clients wm))
(if (null? (wm-clients-stacking wm))
(set-input-focus dpy (wm:window wm) (revert-to parent)
current-time)
(let ((next-client (or (last-focused-client wm data)
(car (wm-clients wm)))))
(let ((next-client (car (wm-clients-stacking wm))))
(wm-select-client wm next-client current-time))))))
;; ***