added thread names
removed kill-client added main-window drawing fixed titlebars with height 0 (workspace manager)
This commit is contained in:
		
							parent
							
								
									537c32ce6c
								
							
						
					
					
						commit
						0b23d8bf08
					
				| 
						 | 
				
			
			@ -7,7 +7,6 @@
 | 
			
		|||
  (font font "-*-helvetica-medium-r-normal-*-12-*-*-*-*-*-*-*")
 | 
			
		||||
  (select-next keys "M-k n")
 | 
			
		||||
  (select-previous keys "M-k p")
 | 
			
		||||
  (kill-client keys "M-c")
 | 
			
		||||
  )
 | 
			
		||||
 | 
			
		||||
(define (create-switch-wm out-channel dpy parent options . children)
 | 
			
		||||
| 
						 | 
				
			
			@ -15,8 +14,10 @@
 | 
			
		|||
	     (manager-type switch) switch-wm-options-spec
 | 
			
		||||
	     out-channel
 | 
			
		||||
	     (lambda (wm in-channel)
 | 
			
		||||
	       (spawn (lambda ()
 | 
			
		||||
			(switch-wm-handler wm in-channel)))
 | 
			
		||||
	       (spawn* (list 'switch-wm wm)
 | 
			
		||||
		       (lambda (release)
 | 
			
		||||
			 (release)
 | 
			
		||||
			 (switch-wm-handler wm in-channel)))
 | 
			
		||||
	       wm)))
 | 
			
		||||
 | 
			
		||||
(define-record-type switch-wm-data :switch-wm-data
 | 
			
		||||
| 
						 | 
				
			
			@ -27,23 +28,27 @@
 | 
			
		|||
 | 
			
		||||
(define (switch-wm-handler wm channel)
 | 
			
		||||
  (let* ((dpy (wm:dpy wm))
 | 
			
		||||
	 (window (wm:window wm))
 | 
			
		||||
	 (options (wm:options wm))
 | 
			
		||||
	 (gc (create-gc dpy (wm:window wm) '()))
 | 
			
		||||
	 (gc (create-gc dpy window '()))
 | 
			
		||||
	 (empty-titlebar (create-empty-titlebar wm))
 | 
			
		||||
	 (data (make-switch-wm-data '() empty-titlebar)))
 | 
			
		||||
    (update-titlebars wm data)
 | 
			
		||||
 | 
			
		||||
    (grab-shortcut dpy (wm:window wm)
 | 
			
		||||
    (grab-shortcut dpy window
 | 
			
		||||
		   (get-option-value options 'select-next)
 | 
			
		||||
		   'select-next channel #f)
 | 
			
		||||
    (grab-shortcut dpy (wm:window wm)
 | 
			
		||||
    (grab-shortcut dpy window
 | 
			
		||||
		   (get-option-value options 'select-previous)
 | 
			
		||||
		   'select-previous channel #f)
 | 
			
		||||
 | 
			
		||||
    (let loop ()
 | 
			
		||||
      (let ((msg (receive channel)))
 | 
			
		||||
	(case (car msg)
 | 
			
		||||
	  ((draw-main-window) #t)
 | 
			
		||||
	  ((draw-main-window)
 | 
			
		||||
	   (set-gc-foreground! dpy gc (black-pixel dpy))
 | 
			
		||||
	   (fill-rectangle* dpy window gc
 | 
			
		||||
			    (clip-rectangle dpy window)))
 | 
			
		||||
 | 
			
		||||
	  ((fit-windows)
 | 
			
		||||
	   (fit-titlebars wm data)
 | 
			
		||||
| 
						 | 
				
			
			@ -97,29 +102,32 @@
 | 
			
		|||
	 (width (window-width dpy (wm:window wm)))
 | 
			
		||||
	 (height (window-height dpy (wm:window wm)))
 | 
			
		||||
	 (titlebar-height (get-option-value (wm:options wm) 'titlebar-height)))
 | 
			
		||||
    (move-resize-titlebar (data:empty-titlebar data)
 | 
			
		||||
			  (make-rectangle 0 0 width titlebar-height))
 | 
			
		||||
    (let* ((titlebars (map cdr (data:titlebars data)))
 | 
			
		||||
	   (n (length titlebars))
 | 
			
		||||
	   (widths (if (zero? n) '()
 | 
			
		||||
		       (let ((dw (quotient width n)))
 | 
			
		||||
			 (append (map (lambda (_) dw) (iota (- n 1)))
 | 
			
		||||
				 (list (- width (* dw (- n 1)))))))))
 | 
			
		||||
      (for-each (lambda (i width titlebar)
 | 
			
		||||
		  (move-resize-titlebar
 | 
			
		||||
		   titlebar
 | 
			
		||||
		   (make-rectangle (* i width) 0
 | 
			
		||||
				   width titlebar-height)))
 | 
			
		||||
		(iota n) widths titlebars))))
 | 
			
		||||
    (if (> titlebar-height 0)
 | 
			
		||||
	(begin
 | 
			
		||||
	  (move-resize-titlebar (data:empty-titlebar data)
 | 
			
		||||
				(make-rectangle 0 0 width titlebar-height))
 | 
			
		||||
	  (let* ((titlebars (map cdr (data:titlebars data)))
 | 
			
		||||
		 (n (length titlebars))
 | 
			
		||||
		 (widths (if (zero? n) '()
 | 
			
		||||
			     (let ((dw (quotient width n)))
 | 
			
		||||
			       (append (map (lambda (_) dw) (iota (- n 1)))
 | 
			
		||||
				       (list (- width (* dw (- n 1)))))))))
 | 
			
		||||
	    (for-each (lambda (i width titlebar)
 | 
			
		||||
			(move-resize-titlebar
 | 
			
		||||
			 titlebar
 | 
			
		||||
			 (make-rectangle (* i width) 0
 | 
			
		||||
					 width titlebar-height)))
 | 
			
		||||
		      (iota n) widths titlebars))))))
 | 
			
		||||
 | 
			
		||||
(define (update-titlebars wm data)
 | 
			
		||||
  (if (null? (data:titlebars data))
 | 
			
		||||
      (map-titlebar (data:empty-titlebar data))
 | 
			
		||||
      (begin
 | 
			
		||||
	(unmap-titlebar (data:empty-titlebar data))
 | 
			
		||||
	(for-each (lambda (c.t)
 | 
			
		||||
		    (map-titlebar (cdr c.t)))
 | 
			
		||||
		  (data:titlebars data)))))
 | 
			
		||||
  (if (> (get-option-value (wm:options wm) 'titlebar-height) 0)
 | 
			
		||||
      (if (null? (data:titlebars data))
 | 
			
		||||
	  (map-titlebar (data:empty-titlebar data))
 | 
			
		||||
	  (begin
 | 
			
		||||
	    (unmap-titlebar (data:empty-titlebar data))
 | 
			
		||||
	    (for-each (lambda (c.t)
 | 
			
		||||
			(map-titlebar (cdr c.t)))
 | 
			
		||||
		      (data:titlebars data))))))
 | 
			
		||||
 | 
			
		||||
(define (init-client wm data client maybe-rect)
 | 
			
		||||
  ;; TODO: transients!
 | 
			
		||||
| 
						 | 
				
			
			@ -138,11 +146,10 @@
 | 
			
		|||
      (install-dragging-control channel dpy
 | 
			
		||||
				(titlebar:window titlebar)
 | 
			
		||||
				(titlebar:window titlebar))
 | 
			
		||||
      (grab-shortcut dpy (client:client-window client)
 | 
			
		||||
		     (get-option-value options 'kill-client)
 | 
			
		||||
		     'kill-client channel #f)
 | 
			
		||||
      (spawn
 | 
			
		||||
       (lambda ()
 | 
			
		||||
      (spawn*
 | 
			
		||||
       (list 'switch-wm-client-handler wm client)
 | 
			
		||||
       (lambda (release)
 | 
			
		||||
	 (release)
 | 
			
		||||
	 (let loop ()
 | 
			
		||||
	   (let ((msg (receive channel)))
 | 
			
		||||
	     (case (car msg)
 | 
			
		||||
| 
						 | 
				
			
			@ -157,9 +164,6 @@
 | 
			
		|||
				    root-x root-y))))))
 | 
			
		||||
	       ((click)
 | 
			
		||||
		(wm-select-client wm client (fourth msg)))
 | 
			
		||||
	       ((kill-client)
 | 
			
		||||
		(let ((time (second msg)))
 | 
			
		||||
		  (delete-window dpy (client:window client) time)))
 | 
			
		||||
	       (else (mdisplay "unhandled client message: " msg "\n"))))
 | 
			
		||||
	   ;; TODO: internal channel
 | 
			
		||||
	   (loop))))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue