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