From aa32a7e69df9fd111b1e57f6978bc66128974935 Mon Sep 17 00:00:00 2001 From: frese Date: Thu, 3 Apr 2003 19:40:56 +0000 Subject: [PATCH] added root-wm options added shortcuts for splitting, execute commands and attach windows --- src/root-manager.scm | 187 +++++++++++++++++++++++++++++++++++-------- 1 file changed, 154 insertions(+), 33 deletions(-) diff --git a/src/root-manager.scm b/src/root-manager.scm index 37adb7c..ba31766 100644 --- a/src/root-manager.scm +++ b/src/root-manager.scm @@ -1,16 +1,36 @@ +(define-options-spec root-options-spec + (split-horizontal keys "M-s h") + (split-vertical keys "M-s v") + (split-horizontal-with-switch-wm keys "M-s s h") + (split-vertical-with-switch-wm keys "M-s s v") + (split-horizontal-with-move-wm keys "M-s m h") + (split-vertical-with-move-wm keys "M-s m v") + (create-switch-wm keys "M-k s") + (create-move-wm keys "M-k m") + (split-question string "What kind of manager do want in the second frame?\n(S)witch or (M)ove windowmanager:") + (execute keys "F3") + (execute-question string "Execute:") + (attach keys "M-a") + (attach-question string "Attach:") + ) + (define-record-type root-wm :root-wm - (make-root-wm dpy managers current-manager in-channel) + (make-root-wm dpy managers current-manager in-channel options) root-wm? (dpy root-wm:dpy) (managers root-wm:managers set-root-wm:managers!) (current-manager root-wm:current-manager set-root-wm:current-manager!) - (in-channel root-wm:in-channel)) + (in-channel root-wm:in-channel) + (options root-wm:options)) -(define (create-root-wm dpy) +(define (create-root-wm dpy options) (let* ((window (default-root-window dpy)) + (screen (display:default-screen dpy)) + (options (create-options dpy (screen:default-colormap screen) + root-options-spec options)) (children (window-children dpy window)) (in-channel (make-channel)) - (root-wm (make-root-wm dpy '() #f in-channel)) + (root-wm (make-root-wm dpy '() #f in-channel options)) (initial-manager (create-move-wm in-channel dpy window '()))) (mdisplay "creating root-wm\n") (set-root-wm:current-manager! root-wm initial-manager) @@ -22,10 +42,14 @@ (wm-manage-window initial-manager window)) children) - (grab-shortcut dpy window (string->keys dpy "M-k h") ;; -> options! - 'split-horizontal in-channel #t) - (grab-shortcut dpy window (string->keys dpy "M-k v") - 'split-vertical in-channel #t) + (for-each (lambda (name) + (grab-shortcut dpy window (get-option-value options name) + name in-channel #t)) + '(split-horizontal split-vertical + split-horizontal-with-switch-wm split-vertical-with-switch-wm + split-horizontal-with-move-wm split-vertical-with-move-wm + create-switch-wm create-move-wm + execute attach)) (call-with-event-channel dpy window (event-mask substructure-redirect) @@ -56,40 +80,75 @@ #f)) ))) +(define (do-split root-wm orientation new-wm) + (let* ((current (root-wm:current-manager root-wm)) + (parent (manager-parent root-wm current)) ;; #f if root + (dpy (wm:dpy current)) + (in-channel (root-wm:in-channel root-wm)) + (splitter (create-split-wm in-channel dpy + (window-parent dpy (wm:window current)) + ;; TODO other options + (list (cons 'orientation orientation)))) + (first current) + (creator (if (eq? new-wm 'switch-wm) + create-switch-wm + create-move-wm)) + (second (creator in-channel dpy (wm:window splitter) + ;; TODO options + '()))) + ;; we just replace the client:window + (if parent + (client-replace-window parent (wm:window current) + (wm:window splitter)) + (map-window dpy (wm:window splitter))) ;; maybe resize ?? + (wm-manage-window splitter (wm:window first)) + (wm-manage-window splitter (wm:window second)) + + (add-manager! root-wm splitter) + (add-manager! root-wm second))) + (define (handle-message root-wm exit msg) (case (car msg) ((split-vertical split-horizontal) - (let* ((current (root-wm:current-manager root-wm)) - (parent (manager-parent root-wm current)) ;; #f if root - (dpy (wm:dpy current)) - (in-channel (root-wm:in-channel root-wm)) - (orientation (if (eq? 'split-vertical (car msg)) - 'vertical 'horizontal)) - (splitter (create-split-wm in-channel dpy - (window-parent dpy (wm:window current)) - ;; TODO other options - (list (cons 'orientation orientation)))) - (first current) - ;; TODO: ask for second manager - (second (create-switch-wm in-channel dpy (wm:window splitter) - ;; TODO options - '()))) - ;; we just replace the client:window - (if parent - (client-replace-window parent (wm:window current) - (wm:window splitter)) - (map-window dpy (wm:window splitter))) ;; maybe resize ?? - (wm-manage-window splitter (wm:window first)) - (wm-manage-window splitter (wm:window second)) + (let ((c (prompt (root-wm:dpy root-wm) #f + (get-option-value (root-wm:options root-wm) + 'split-question) + '(#\s #\S #\m #\M) #f))) + (if c + (do-split root-wm + (if (eq? (car msg) 'split-vertical) + 'vertical 'horizontal) + (if (or (eq? c #\s) (eq? c #\S)) + 'switch-wm + 'move-wm))))) - (add-manager! root-wm splitter) - (add-manager! root-wm second))) + ((split-horizontal-with-switch-wm) + (do-split root-wm 'horizontal 'switch-wm)) + ((split-vertical-with-switch-wm) + (do-split root-wm 'vertical 'switch-wm)) + ((split-horizontal-with-move-wm) + (do-split root-wm 'horizontal 'move-wm)) + ((split-vertical-with-move-wm) + (do-split root-wm 'vertical 'move-wm)) + + ((create-switch-wm create-move-wm) + (let* ((current (root-wm:current-manager root-wm)) + (create (if (eq? (car msg) 'create-switch-wm) + create-switch-wm + create-move-wm)) + (dpy (root-wm:dpy root-wm)) + (in-channel (root-wm:in-channel root-wm)) + (new (create in-channel dpy (wm:window current) + '())) ;; TODO: options + ) + (add-manager! root-wm new) + (wm-manage-window current (wm:window new)))) ((manager-focused) (let ((manager (second msg))) ;; a split-wm should never be the current manager (if (not (eq? (manager-type split) (wm:type manager))) - (set-root-wm:current-manager! root-wm manager)))) + (set-root-wm:current-manager! root-wm manager)))) ((root-drop) (let ((window (second msg)) (pointer-x (third msg)) @@ -99,8 +158,70 @@ (wm-manage-window manager window) (mdisplay "did not find a manager at " pointer-x ":" pointer-y "\n"))))) + ((execute) + (let* ((cm (root-wm:current-manager root-wm)) + (exec (prompt (root-wm:dpy root-wm) (wm:window cm) + (get-option-value (root-wm:options root-wm) + 'execute-question) + #f exec-complete))) + (if exec + (run (sh -c ,(string-append exec " &")))))) + ((attach) + (let* ((cm (root-wm:current-manager root-wm)) + (all-names + (map cdr (filter (lambda (win.name) + ;; remove all that are below the current-wm + (not (member (wm:window cm) + (window-path (wm:dpy cm) + (car win.name))))) + (get-all-window-names)))) + (attach (prompt (root-wm:dpy root-wm) (wm:window cm) + (get-option-value (root-wm:options root-wm) + 'attach-question) + all-names (finite-complete all-names))) + (window (find-window-by-name attach))) + (if window + (wm-manage-window cm window)))) + (else (mdisplay "unknown root message: " msg "\n")))) +(define (exec-complete str pos) + ;; TODO + (cons str pos)) + +(define (finite-complete strings) + (lambda (str pos) + (let* ((s (substring str 0 pos)) + (candidates + (filter (lambda (str) + (and (<= (string-length s) (string-length str)) + (equal? s (substring str 0 (string-length s))))) + strings)) + (common (common-substring candidates))) + (cond + ((null? candidates) (cons str pos)) + ((null? (cdr candidates)) + (cons (car candidates) ;; or insert ?? + (string-length (car candidates)))) + ((not (or (equal? common "") (equal? common s))) + (cons common ;; or insert?? + (string-length common))) + (else candidates))))) + +(define (common-substring strings) + (cond + ((null? strings) "") + ((null? (cdr strings)) (car strings)) + (else (let ((s (car strings)) + (rec (common-substring (cdr strings)))) + (letrec ((loop (lambda (i) + (if (and (< i (string-length s)) + (< i (string-length rec)) + (eq? (string-ref s i) (string-ref rec i))) + (loop (+ i 1)) + (substring s 0 i))))) + (loop 0)))))) + ;; *** observing managers ******************************************** (define (add-manager! root-wm manager)