[Sawfish] Re: Add new window as tab patch

[fuchur <flohtransporter@xxxxxxxxx>]

Hi,

On Mon, 26 Mar 2012 04:01:26 +0200
wrote fuchur <flohtransporter@xxxxxxxxx>:

>Hi,
>
>Here is a patch to add a new window as tab if have one (the first
>created if more as one) of the windows the same 'tab-group property".
>'tab-group property can set by window-rules and also save in
>window-history. You can choose between 12 tab-groups. If you know how
>to grow Tab groups or "automatically" update (maybe by window-names) in
>window-rules please send a patch. 
>

Here is the same patch as above but with some bugfix.
Need more tester/ing.

-- 
Regards,
Fuchur

GPG Fingerprint: CA3B 8204 5B3E 6D48 6D53  C116 E5BC 70D5 B8D7 B2B0

diff -urNad sawfish.orgi/lisp/sawfish/wm/ext/match-window.jl sawfish/lisp/sawfish/wm/ext/match-window.jl
--- sawfish.orgi/lisp/sawfish/wm/ext/match-window.jl	2012-03-26 14:20:42.000000000 +0200
+++ sawfish/lisp/sawfish/wm/ext/match-window.jl	2012-03-26 03:31:33.000000000 +0200
@@ -109,6 +109,7 @@
             (ignored boolean)
             (group ,(lambda ()
                       `(symbol ,@(delete-if-not symbolp (window-group-ids)))))
+            (tab-group (choice Browser File Games Grafic Mail Office Settings System Term Utilities Video Web))
             (ungrouped boolean)
             (cycle-skip boolean)
             (window-list-skip boolean)
diff -urNad sawfish.orgi/lisp/sawfish/wm/ext/window-history.jl sawfish/lisp/sawfish/wm/ext/window-history.jl
--- sawfish.orgi/lisp/sawfish/wm/ext/window-history.jl	2012-03-26 14:20:42.000000000 +0200
+++ sawfish/lisp/sawfish/wm/ext/window-history.jl	2012-03-26 03:31:33.000000000 +0200
@@ -73,7 +73,7 @@
 
   ;; list of states in window-state-change-hook that should be tracked
   (defvar window-history-states '(sticky ignored never-focus type maximized
-                                         frame-style cycle-skip
+                                         frame-style cycle-skip tab-group
                                          window-list-skip title-position))
 
   ;; property matched on
diff -urNad sawfish.orgi/lisp/sawfish/wm/tabs/tabgroup.jl sawfish/lisp/sawfish/wm/tabs/tabgroup.jl
--- sawfish.orgi/lisp/sawfish/wm/tabs/tabgroup.jl	2012-03-26 14:20:43.000000000 +0200
+++ sawfish/lisp/sawfish/wm/tabs/tabgroup.jl	2012-03-26 14:12:03.000000000 +0200
@@ -55,6 +55,9 @@
   (define oldgroup nil)
   (define tab-groups nil)
   (define tab-refresh-lock t)
+  (define release-window nil)
+  (define last-unmap-id nil)
+  (define in-tab-group-name nil)
 
   (define (window-tabbed-p w)
     (window-get w 'tabbed))
@@ -132,6 +135,8 @@
 
   (define (tab-delete-window-from-tab-groups w)
     "Find window's group and remove it."
+    (if (not release-window)
+        (remove-from-tab-group w))
     (when (window-tabbed-p w)
       (tab-delete-window-from-group w (tab-window-group-index w))
       (window-put w 'fixed-position nil)
@@ -268,7 +273,9 @@
         (when (not (eq index index2))
           ;; tabgroup to tabgroup
           (when (window-tabbed-p w)
-            (tab-delete-window-from-tab-groups w))
+            (setq release-window t)
+            (tab-delete-window-from-tab-groups w)
+            (setq release-window nil))
           (setq tab-refresh-lock nil)
           (if (window-get w 'shaded) (unshade-window w))
           (if (window-get win 'shaded) (unshade-window win))
@@ -303,7 +310,9 @@
   
   (define (tab-release-window w)
     "Release the window from its group."
+    (setq release-window t)
     (tab-delete-window-from-tab-groups w)
+    (setq release-window nil)
     (tab-make-new-group w))
   
   (define-command 'tab-release-window tab-release-window #:spec "%f")
@@ -402,7 +411,27 @@
         (tab-refresh-group win 'move)
         (tab-refresh-group win 'frame))))
 
+  (define (unmap-id win)
+    (setq last-unmap-id (window-id win)))
+
+  (define (in-tab-group win)
+    "Add a new window as tab if have one (the first created if more as one) 
+of the windows the same 'tab-group property"
+    (when (window-get win 'tab-group)
+      (setq in-tab-group-name (append in-tab-group-name (cons (cons (window-id win) (window-get win 'tab-group)))))
+      (let ((open-win-tabgroup (get-window-by-id (car (rassoc (window-get win 'tab-group) in-tab-group-name)))))
+        (if (and open-win-tabgroup
+                 (not (eq win open-win-tabgroup)))
+            (tab-group-window win open-win-tabgroup)))))
+
+  (define (remove-from-tab-group win)
+    "Remove window from in-tab-group-name alist if it have a 'tab-group property"
+    (when (window-get win 'tab-group)
+      (setq in-tab-group-name (remove (assoc last-unmap-id in-tab-group-name) in-tab-group-name))))
+
   (unless batch-mode
+    (add-hook 'after-add-window-hook in-tab-group)
+    (add-hook 'unmap-notify-hook unmap-id)
     (add-hook 'window-state-change-hook
               (lambda (win args)
                 (when (window-tabbed-p win)

Attachment: signature.asc
Description: PGP signature