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

added find-window-by-name and get-all-window-names

This commit is contained in:
frese 2003-04-03 19:36:26 +00:00
parent f1e3c2f9b5
commit cc639da34c
1 changed files with 42 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
src/manager.scm
View File

@ -279,7 +279,6 @@
(lambda (msg)
(case (car msg)
((restart-handler)
(mdisplay "restarting handler\n")
(create-client-handler wm client)
(exit)))))
(wrap (receive-rv client-window-channel)
@ -297,7 +296,6 @@
(and (pair? l) (car l))))
(define (client-replace-window wm old-window new-window)
(mdisplay "replace-window " wm " " old-window " " new-window "\n")
(let ((client (client-of-window wm old-window))
(internal-out-channel (wm:internal-out-channel wm)))
(if client
@ -372,7 +370,7 @@
(mdisplay "manager " (wm:type wm) " reparented client\n")
(wm-deinit-client wm client)
(exit))))
;; TODO: withdrawn-state etc.
;; TODO: withdrawn-state etc. unmap-event ...
((destroy-window-event? xevent)
(mdisplay "destroy-window client\n")
(wm-deinit-client wm client)
@ -388,31 +386,32 @@
;; *** client names **************************************************
(define client-name
(let ((names '()) ;; (window oname name)
(lock (make-lock)))
(lambda (dpy client)
(let* ((w (client:window client))
(cname (let* ((p (get-wm-name dpy w))
(l (if p (property->string-list p) '())))
(if (null? l)
"<untitled>"
(car l)))))
(with-lock lock
(lambda ()
(let ((name? (let ((p (assq w names)))
(and p (equal? (cadr p) cname)
(caddr p)))))
(set! names
(filter (lambda (e)
(and (not (eq? (car e) w))
(window-exists? dpy (car e))))
names))
(let ((name (if name? name?
(unique-name cname
(map caddr names)))))
(set! names (cons (list w cname name) names))
name))))))))
(define *client-names* '()) ;; (window oname name)
(define *client-names-lock* (make-lock))
(define (client-name dpy client)
(let* ((w (client:window client))
(cname (let* ((p (get-wm-name dpy w))
(l (if p (property->string-list p) '())))
(if (null? l)
"<untitled>"
(car l)))))
(with-lock *client-names-lock*
(lambda ()
(let ((name? (let ((p (assq w *client-names*)))
(and p (equal? (cadr p) cname)
(caddr p)))))
(set! *client-names*
(filter (lambda (e)
(and (not (eq? (car e) w))
(window-exists? dpy (car e))))
*client-names*))
(let ((name (if name? name?
(unique-name cname
(map caddr *client-names*)))))
(set! *client-names* (cons (list w cname name)
*client-names*))
name))))))
(define (unique-name name names)
(if (not (member name names))
@ -422,3 +421,18 @@
(if (member n names)
(loop (+ i 1))
n)))))
(define (find-window-by-name name)
(with-lock *client-names-lock*
(lambda ()
(let ((l (filter (lambda (w.o.n)
(equal? (third w.o.n) name))
*client-names*)))
(and (not (null? l)) (first (car l)))))))
(define (get-all-window-names)
(with-lock *client-names-lock*
(lambda ()
(map (lambda (w.o.n)
(cons (first w.o.n) (third w.o.n)))
*client-names*))))