- made manager windows 'locally-active
- added thread names - added manager focus and update-manager-state message - first step for handling transients - added client-replace-window used in splitting
This commit is contained in:
		
							parent
							
								
									6eeef48f98
								
							
						
					
					
						commit
						0e78046101
					
				| 
						 | 
					@ -20,6 +20,10 @@
 | 
				
			||||||
  (clients wm:clients set-wm:clients!)
 | 
					  (clients wm:clients set-wm:clients!)
 | 
				
			||||||
  (current-client wm:current-client set-wm:current-client!))
 | 
					  (current-client wm:current-client set-wm:current-client!))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(define-record-discloser :wm
 | 
				
			||||||
 | 
					  (lambda (wm)
 | 
				
			||||||
 | 
					    `(Wm ,(manager-type-name (wm:type wm)) ,(wm:window wm))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define wm-clients wm:clients)
 | 
					(define wm-clients wm:clients)
 | 
				
			||||||
(define wm-current-client wm:current-client)
 | 
					(define wm-current-client wm:current-client)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -63,10 +67,15 @@
 | 
				
			||||||
    ;; class-hint ??
 | 
					    ;; class-hint ??
 | 
				
			||||||
    (set-wm-protocols! dpy main-window
 | 
					    (set-wm-protocols! dpy main-window
 | 
				
			||||||
		       (list (intern-atom dpy "WM_TAKE_FOCUS" #t)))
 | 
							       (list (intern-atom dpy "WM_TAKE_FOCUS" #t)))
 | 
				
			||||||
 | 
					    (set-wm-hints! dpy main-window
 | 
				
			||||||
 | 
							   (make-wm-hint-alist
 | 
				
			||||||
 | 
							    (input? #t)))
 | 
				
			||||||
 | 
								  
 | 
				
			||||||
    ;; TODO: Colormaps
 | 
					    ;; TODO: Colormaps
 | 
				
			||||||
    
 | 
					    
 | 
				
			||||||
    ;; spawn handlers ************************************************
 | 
					    ;; spawn handlers ************************************************
 | 
				
			||||||
    (spawn* (lambda (release)
 | 
					    (spawn* (list 'manager type)
 | 
				
			||||||
 | 
						    (lambda (release)
 | 
				
			||||||
	      (call-with-event-channel
 | 
						      (call-with-event-channel
 | 
				
			||||||
	       (wm:dpy wm) (wm:window wm)
 | 
						       (wm:dpy wm) (wm:window wm)
 | 
				
			||||||
	       (event-mask structure-notify
 | 
						       (event-mask structure-notify
 | 
				
			||||||
| 
						 | 
					@ -107,6 +116,9 @@
 | 
				
			||||||
     ((configure-event? xevent)
 | 
					     ((configure-event? xevent)
 | 
				
			||||||
      (send internal-out-channel '(fit-windows)))
 | 
					      (send internal-out-channel '(fit-windows)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					     ((focus-change-event? xevent)
 | 
				
			||||||
 | 
					      (send internal-out-channel '(update-manager-state)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
     ;; the manager got the focus (as a client)
 | 
					     ;; the manager got the focus (as a client)
 | 
				
			||||||
     ((client-message-event? xevent)
 | 
					     ((client-message-event? xevent)
 | 
				
			||||||
      (let* ((p (client-message-event-property xevent))
 | 
					      (let* ((p (client-message-event-property xevent))
 | 
				
			||||||
| 
						 | 
					@ -118,7 +130,9 @@
 | 
				
			||||||
	      (if (and client
 | 
						      (if (and client
 | 
				
			||||||
		       (equal? name (intern-atom dpy "WM_TAKE_FOCUS" #t)))
 | 
							       (equal? name (intern-atom dpy "WM_TAKE_FOCUS" #t)))
 | 
				
			||||||
		  (handle-external-message wm exit
 | 
							  (handle-external-message wm exit
 | 
				
			||||||
					   (list 'select-client client time)))
 | 
										   (list 'select-client client time))
 | 
				
			||||||
 | 
							  (set-input-focus dpy main-window (revert-to parent)
 | 
				
			||||||
 | 
									   time))
 | 
				
			||||||
	      ))))
 | 
						      ))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
     )))
 | 
					     )))
 | 
				
			||||||
| 
						 | 
					@ -129,10 +143,11 @@
 | 
				
			||||||
    (case (car msg)
 | 
					    (case (car msg)
 | 
				
			||||||
     ((manage-window)
 | 
					     ((manage-window)
 | 
				
			||||||
      (let* ((window (second msg))
 | 
					      (let* ((window (second msg))
 | 
				
			||||||
	     (client (create-client wm window)))
 | 
						     (client (create-client wm window))
 | 
				
			||||||
 | 
						     (maybe-rect (third msg)))
 | 
				
			||||||
	(set-wm:clients! wm (cons client (wm:clients wm)))
 | 
						(set-wm:clients! wm (cons client (wm:clients wm)))
 | 
				
			||||||
	(send internal-out-channel
 | 
						(send internal-out-channel
 | 
				
			||||||
	      (list 'init-client client (third msg)))
 | 
						      (list 'init-client client maybe-rect))
 | 
				
			||||||
	(send internal-out-channel (list 'fit-client client))
 | 
						(send internal-out-channel (list 'fit-client client))
 | 
				
			||||||
	;; sync ??
 | 
						;; sync ??
 | 
				
			||||||
	(map-window dpy window)
 | 
						(map-window dpy window)
 | 
				
			||||||
| 
						 | 
					@ -167,9 +182,11 @@
 | 
				
			||||||
     ((select-client)
 | 
					     ((select-client)
 | 
				
			||||||
      (let ((client (second msg))
 | 
					      (let ((client (second msg))
 | 
				
			||||||
	    (time (third msg)))
 | 
						    (time (third msg)))
 | 
				
			||||||
	(set-wm:current-client! wm client)
 | 
						(for-each (lambda (client)
 | 
				
			||||||
	(raise-window dpy (client:client-window client))
 | 
							    (set-wm:current-client! wm client)
 | 
				
			||||||
	(take-focus dpy (client:window client) time)
 | 
							    (raise-window dpy (client:client-window client))
 | 
				
			||||||
 | 
							    (take-focus dpy (client:window client) time))
 | 
				
			||||||
 | 
							  (cons client (transients-for-client wm client)))
 | 
				
			||||||
;	(for-each (lambda (c)
 | 
					;	(for-each (lambda (c)
 | 
				
			||||||
;		    (if (not (eq? c client))
 | 
					;		    (if (not (eq? c client))
 | 
				
			||||||
;			(grab-button dpy
 | 
					;			(grab-button dpy
 | 
				
			||||||
| 
						 | 
					@ -213,10 +230,11 @@
 | 
				
			||||||
;; *** client ********************************************************
 | 
					;; *** client ********************************************************
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define-record-type client :client
 | 
					(define-record-type client :client
 | 
				
			||||||
  (make-client window client-window data)
 | 
					  (make-client window client-window in-channel data)
 | 
				
			||||||
  client?
 | 
					  client?
 | 
				
			||||||
  (window client:window)
 | 
					  (window client:window set-client:window!)
 | 
				
			||||||
  (client-window client:client-window)
 | 
					  (client-window client:client-window)
 | 
				
			||||||
 | 
					  (in-channel client:in-channel)
 | 
				
			||||||
  (data client:data set-client:data!))
 | 
					  (data client:data set-client:data!))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (create-client wm window)
 | 
					(define (create-client wm window)
 | 
				
			||||||
| 
						 | 
					@ -229,13 +247,15 @@
 | 
				
			||||||
					      0
 | 
										      0
 | 
				
			||||||
					      (white-pixel dpy)
 | 
										      (white-pixel dpy)
 | 
				
			||||||
					      (black-pixel dpy)))
 | 
										      (black-pixel dpy)))
 | 
				
			||||||
	 (client (make-client window client-window #f)))
 | 
						 (in-channel (make-channel))
 | 
				
			||||||
 | 
						 (client (make-client window client-window in-channel #f)))
 | 
				
			||||||
    (reparent-window dpy window client-window 0 0)
 | 
					    (reparent-window dpy window client-window 0 0)
 | 
				
			||||||
    (create-client-handler wm client)
 | 
					    (create-client-handler wm client)
 | 
				
			||||||
    client))
 | 
					    client))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (create-client-handler wm client)
 | 
					(define (create-client-handler wm client)
 | 
				
			||||||
  (spawn*
 | 
					  (spawn*
 | 
				
			||||||
 | 
					   (list "client-handler " (wm:type wm))
 | 
				
			||||||
   (lambda (release)
 | 
					   (lambda (release)
 | 
				
			||||||
     (call-with-event-channel
 | 
					     (call-with-event-channel
 | 
				
			||||||
      (wm:dpy wm) (client:client-window client)
 | 
					      (wm:dpy wm) (client:client-window client)
 | 
				
			||||||
| 
						 | 
					@ -255,6 +275,13 @@
 | 
				
			||||||
	      (release)
 | 
						      (release)
 | 
				
			||||||
	      (let loop ()
 | 
						      (let loop ()
 | 
				
			||||||
		(select*
 | 
							(select*
 | 
				
			||||||
 | 
							 (wrap (receive-rv (client:in-channel client))
 | 
				
			||||||
 | 
							       (lambda (msg)
 | 
				
			||||||
 | 
								 (case (car msg)
 | 
				
			||||||
 | 
								   ((restart-handler)
 | 
				
			||||||
 | 
								    (mdisplay "restarting handler\n")
 | 
				
			||||||
 | 
								    (create-client-handler wm client)
 | 
				
			||||||
 | 
								    (exit)))))
 | 
				
			||||||
		 (wrap (receive-rv client-window-channel)
 | 
							 (wrap (receive-rv client-window-channel)
 | 
				
			||||||
		       (lambda (xevent)
 | 
							       (lambda (xevent)
 | 
				
			||||||
			 (handle-client-window-xevent wm exit client xevent)))
 | 
								 (handle-client-window-xevent wm exit client xevent)))
 | 
				
			||||||
| 
						 | 
					@ -263,6 +290,29 @@
 | 
				
			||||||
			 (handle-client-xevent wm exit client xevent))))
 | 
								 (handle-client-xevent wm exit client xevent))))
 | 
				
			||||||
		(loop)))))))))))
 | 
							(loop)))))))))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(define (client-of-window wm window)
 | 
				
			||||||
 | 
					  (let ((l (filter (lambda (client)
 | 
				
			||||||
 | 
							     (equal? window (client:window client)))
 | 
				
			||||||
 | 
							   (wm-clients wm))))
 | 
				
			||||||
 | 
					    (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
 | 
				
			||||||
 | 
						(begin
 | 
				
			||||||
 | 
						  (set-client:window! client new-window)
 | 
				
			||||||
 | 
						  (send (client:in-channel client) '(restart-handler))
 | 
				
			||||||
 | 
						  ;; update everything... TODO
 | 
				
			||||||
 | 
						  ;;(send internal-out-channel (list 'init-client client #f))
 | 
				
			||||||
 | 
						  (send internal-out-channel (list 'fit-windows client))
 | 
				
			||||||
 | 
						  ;; sync ??
 | 
				
			||||||
 | 
						  (map-window (wm:dpy wm) new-window)
 | 
				
			||||||
 | 
						  (send internal-out-channel (list 'update-client-state client))
 | 
				
			||||||
 | 
						  )
 | 
				
			||||||
 | 
						#f)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (handle-client-window-xevent wm exit client xevent)
 | 
					(define (handle-client-window-xevent wm exit client xevent)
 | 
				
			||||||
  (let ((type (any-event-type xevent))
 | 
					  (let ((type (any-event-type xevent))
 | 
				
			||||||
	(internal-out-channel (wm:internal-out-channel wm))
 | 
						(internal-out-channel (wm:internal-out-channel wm))
 | 
				
			||||||
| 
						 | 
					@ -312,16 +362,16 @@
 | 
				
			||||||
     ((configure-event? xevent)
 | 
					     ((configure-event? xevent)
 | 
				
			||||||
      ;; TODO: we have to prevent this event if changed the size on our own.
 | 
					      ;; TODO: we have to prevent this event if changed the size on our own.
 | 
				
			||||||
      ;; --> XReconfigureWMWindow ??
 | 
					      ;; --> XReconfigureWMWindow ??
 | 
				
			||||||
      ;;(send internal-out-channel (list 'fit-client-window client))
 | 
					      (send internal-out-channel (list 'fit-client-window client))
 | 
				
			||||||
      #t)
 | 
					      )
 | 
				
			||||||
     ((reparent-event? xevent) #t)
 | 
					     ((reparent-event? xevent)
 | 
				
			||||||
;      (if (or (not (window-exists? dpy (client:window client)))
 | 
					      (if (or (not (window-exists? dpy (client:window client)))
 | 
				
			||||||
;	      (not (eq? (client:client-window client)
 | 
						      (not (eq? (client:client-window client)
 | 
				
			||||||
;			(window-parent dpy (client:window client)))))
 | 
								(window-parent dpy (client:window client)))))
 | 
				
			||||||
;	  (begin
 | 
						  (begin
 | 
				
			||||||
;	    (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.
 | 
				
			||||||
     ((destroy-window-event? xevent)
 | 
					     ((destroy-window-event? xevent)
 | 
				
			||||||
      (mdisplay "destroy-window client\n")
 | 
					      (mdisplay "destroy-window client\n")
 | 
				
			||||||
| 
						 | 
					@ -329,6 +379,13 @@
 | 
				
			||||||
      (exit))
 | 
					      (exit))
 | 
				
			||||||
     )))
 | 
					     )))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(define (transients-for-client wm client)
 | 
				
			||||||
 | 
					  (filter (lambda (c)
 | 
				
			||||||
 | 
						    (and (not (eq? c client))
 | 
				
			||||||
 | 
							 (equal? (client:window client)
 | 
				
			||||||
 | 
								 (get-transient-for (wm:dpy wm) (client:window c)))))
 | 
				
			||||||
 | 
						  (wm:clients wm)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
;; *** client names **************************************************
 | 
					;; *** client names **************************************************
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define client-name
 | 
					(define client-name
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue