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