1;; tab.jl - frame handling of tab
2;;
3;; Copyright (C) Yann Hodique <Yann.Hodique@lifl.fr>
4;;
5;; This file is an official accepted contribution into sawfish.
6;;
7;; This script is free software; you can redistribute it and/or modify it
8;; under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11;;
12;; sawfish is distributed in the hope that it will be useful, but
13;; WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15;; GNU General Public License for more details.
16;;
17;; You should have received a copy of the GNU General Public License
18;; along with sawfish; see the file COPYING.  If not, write to
19;; the Free Software Foundation, 51 Franklin Street, Fifth Floor,
20;; Boston, MA 02110-1301 USA.
21
22(define-structure sawfish.wm.tabs.tab
23
24    (export tab-pos
25            tabbar-left-margin
26            tabbar-left-margin-transient
27            tabbar-right-margin
28            tabbar-right-margin-transient
29            tab-window-add-to-tabgroup
30            set-tab-adjustments)
31
32    (open rep
33	  rep.system
34	  sawfish.wm.misc
35	  sawfish.wm.custom
36	  sawfish.wm.commands
37	  sawfish.wm.frames
38	  sawfish.wm.tabs.tabgroup
39      sawfish.wm.cursors
40	  sawfish.wm.windows
41      sawfish.wm.gaol)
42
43  (define-structure-alias tab sawfish.wm.tabs.tab)
44
45  ;; TODO:
46  ;; - make calculations work with tiny windows, should fixed
47  ;; - hide some frame parts on leftmost and rightmost tabs, should fixed
48  ;; - add a drag-n-drop way to group windows by tabs
49
50  (define select-cursor (default-cursor))
51  (define marked-window nil)
52
53  (define tabbar-left-dec-width)
54  (define tabbar-right-dec-width)
55  (define tabbar-left-margin)
56  (define tabbar-right-margin)
57  (define tabbar-left-margin-transient)
58  (define tabbar-right-margin-transient)
59
60  (define (set-tab-adjustments #!key theme-left-dec-width theme-right-dec-width theme-left-margin
61                               theme-right-margin theme-left-margin-transient theme-right-margin-transient)
62    (setq tabbar-left-dec-width theme-left-dec-width)
63    (setq tabbar-right-dec-width theme-right-dec-width)
64    (setq tabbar-left-margin theme-left-margin)
65    (setq tabbar-right-margin theme-right-margin)
66    (setq tabbar-left-margin-transient theme-left-margin-transient)
67    (setq tabbar-right-margin-transient theme-right-margin-transient))
68
69  (gaol-add set-tab-adjustments)
70
71  (define (get-tab-pos win)
72    (let* ((group (tab-find-window win))
73       	   (tabnum (tab-rank win (tab-group-window-list group))))
74      (tab-pos group tabnum win)))
75
76  (define (tab-pos group tabnum win)
77    "Find the left and right pixel offsets of a tab"
78    (let* ((dim-x (car (window-dimensions win)))
79           (dim-y (cdr (window-dimensions win)))
80           (margin-l
81            (if (or (eq (window-get win 'type) 'transient)
82                    (eq (window-get win 'type) 'shaped-transient))
83                tabbar-left-margin-transient
84              tabbar-left-margin))
85           (margin-r
86            (if (or (eq (window-get win 'type) 'transient)
87                    (eq (window-get win 'type) 'shaped-transient))
88                tabbar-right-margin-transient
89              tabbar-right-margin))
90           (tabarea-width (- dim-x margin-l margin-r))
91           (tabarea-height (- dim-y margin-l margin-r))
92           (numtabs (length (tab-group-window-list group)))
93           (left (quotient (* tabnum tabarea-width) numtabs))
94           (bottom (quotient (* tabnum tabarea-height) numtabs))
95           ;; the right edge is not always "left + (window-width / numtabs)"
96           ;; that would be inaccurate due to rounding errors
97           ;;
98           (right (quotient (* (+ tabnum 1) tabarea-width) numtabs))
99           (top (quotient (* (+ tabnum 1) tabarea-height) numtabs))
100           (width (- right left))
101           (height (- top bottom)))
102      (list dim-x dim-y margin-l margin-r left right width bottom top height)))
103
104  (define (tab-title-text-width win)
105    "Width of the title text area is the tabwidth minus decorations by horizontal titlebar themes"
106    (let* ((tabwidth (nth 6 (get-tab-pos win))))
107      (+ tabwidth
108         (- tabbar-left-dec-width)
109         (- tabbar-right-dec-width))))
110
111  (define (tab-title-text-height win)
112    "Height of the title text area is the tabheight minus decorations by vertical titlebar themes"
113    (let* ((tabheight (nth 9 (get-tab-pos win))))
114      (when (> tabheight 0)
115        (+ tabheight
116           (- tabbar-left-dec-width)
117           (- tabbar-right-dec-width)))))
118
119  (define (tab-left-edge win)
120    "Compute left edge of tab by horizontal titlebar themes"
121    (let* ((left (nth 4 (get-tab-pos win)))
122           (margin-l (nth 2 (get-tab-pos win))))
123      (+ left margin-l)))
124
125  (define (tab-bottom-edge win)
126    "Compute bottom edge of tab by vertical titlebar themes"
127    (let* ((bottom (nth 7 (get-tab-pos win)))
128           (margin-l (nth 2 (get-tab-pos win))))
129      (+ bottom margin-l)))
130
131  (define (tab-right-dec-pos win)
132    "Compute position of tab's right-edge decoration by horizontal titlebar themes"
133    (let* ((right (nth 5 (get-tab-pos win)))
134           (margin-l (nth 2 (get-tab-pos win)))
135           (dim-x (nth 0 (get-tab-pos win))))
136      (when (> dim-x margin-l) ;; don't display outside from frame
137        (+ right margin-l (- tabbar-right-dec-width)))))
138
139  (define (tab-top-dec-pos win)
140    "Compute position of tab's top-edge decoration by vertical titlebar themes"
141    (let* ((top (nth 8 (get-tab-pos win)))
142           (margin-l (nth 2 (get-tab-pos win)))
143           (dim-y (nth 1 (get-tab-pos win))))
144      (when (> dim-y margin-l) ;; don't display outside from frame
145        (+ top margin-l (- tabbar-right-dec-width)))))
146
147  (define (tab-title-left-edge win)
148    "Compute left edge of tab by horizontal titlebar themes"
149    (+ (tab-left-edge win) tabbar-left-dec-width))
150
151  (define (tab-title-bottom-edge win)
152    "Compute bottom edge of tab by vertical titlebar themes"
153    (+ (tab-bottom-edge win) tabbar-left-dec-width))
154
155  ;; new classes tabs : tabbar-horizontal-left-edge tabbar-horizontal tabbar-horizontal-right-edge
156  ;;
157  (define-frame-class 'tabbar-horizontal-left-edge
158    `((left-edge . ,tab-left-edge)) t)
159
160  (define-frame-class 'tabbar-horizontal
161    `((left-edge . ,tab-title-left-edge)
162      (width . ,tab-title-text-width)))
163
164  (define-frame-class 'tabbar-horizontal-right-edge
165    `((left-edge . ,tab-right-dec-pos)) t)
166
167  ;; new classes tabs on side : tabbar-vertical-top-edge tabbar-vertical tabbar-vertical-bottom-edge
168  ;;
169  (define-frame-class 'tabbar-vertical-top-edge
170    `((bottom-edge . ,tab-top-dec-pos)) t)
171
172  (define-frame-class 'tabbar-vertical
173    `((bottom-edge . ,tab-title-bottom-edge)
174      (height . ,tab-title-text-height)))
175
176  (define-frame-class 'tabbar-vertical-bottom-edge
177    `((bottom-edge . ,tab-bottom-edge)) t)
178
179  (define (emit-marked-hook w)
180    (call-window-hook 'window-state-change-hook w (list '(marked))))
181
182  ;; This function is for interactive use. Use tab-group-window for lisp.
183  (define (tab-window-add-to-tabgroup win)
184    "Add a window to a tabgroup. Apply this command on a window, then
185on another. The first window will be added to the tabgroup containig
186the second."
187    (when (net-wm-window-type-normal-p win)
188      (if marked-window
189          (progn
190            (mapcar (lambda (w)
191                      (window-put w 'marked nil)
192                      (emit-marked-hook w)
193                      (tab-group-window w win)) marked-window)
194            (default-cursor select-cursor)
195            (window-put win 'marked nil)
196            (setq marked-window nil))
197        (window-put win 'marked t)
198        (default-cursor (get-cursor marked-cursor-shape))
199        (setq marked-window (cons win)))
200      (emit-marked-hook win)))
201
202  (define-command 'tab-window-add-to-tabgroup tab-window-add-to-tabgroup #:spec "%W")
203
204  (define (tab-tabgroup-add-to-tabgroup win)
205    "Add a tabgroup to a tabgroup. Apply this command on a window
206from the tabgroup, then on another. The tabgroup will be added to
207the tabgroup containig the second."
208    (when (net-wm-window-type-normal-p win)
209      (if marked-window
210          (progn
211            (setq marked-window (tab-group-windows (car marked-window)))
212            (tab-window-add-to-tabgroup win))
213        (default-cursor (get-cursor marked-cursor-shape))
214        (setq marked-window (tab-group-windows win))
215        (mapcar (lambda (w)
216                  (window-put w 'marked t)
217                  (emit-marked-hook w)) marked-window))))
218
219  (define-command 'tab-tabgroup-add-to-tabgroup tab-tabgroup-add-to-tabgroup #:spec "%W")
220
221  (define (check-win)
222    "Check if a window that was marked as tab is destroy"
223    (if (car marked-window)
224        (let ((m-list marked-window))
225          (setq marked-window nil)
226          (mapcar (lambda (w)
227                    (if (window-id w)
228                        (setq marked-window (append marked-window (cons w nil))))) m-list)
229          (when (not (car marked-window))
230            (default-cursor select-cursor)
231            (setq marked-window nil)))))
232
233  (add-hook 'destroy-notify-hook check-win))
234
235;;(require 'x-cycle)
236;;(define-cycle-command-pair
237;;  'cycle-tabgroup 'cycle-tabgroup-backwards
238;;  (lambda (w)
239;;    (delete-if-not window-in-cycle-p
240;;                   (delete-if (lambda (win)
241;;                                (and (not (eq win w))
242;;                                     (tab-same-group-p win w)))
243;;                              (workspace-windows current-workspace))
244;;                   )
245;;    )
246;;  #:spec "%W")
247