1;; tabgroup.jl - tab main 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 22, 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.tabgroup 23 24 (export window-tabbed-p 25 frame-style-tabs-support-p 26 net-wm-window-type-normal-p 27 tab-refresh-group 28 tab-release-window 29 tab-raise-left-window 30 tab-raise-right-window 31 tab-move-to-beginning 32 tab-move-to-end 33 tab-move-to-right 34 tab-move-to-left 35 tab-window-group-index 36 tab-find-window 37 tab-rank 38 tab-group-window-list 39 tab-group-windows 40 tab-group-windows-stacking-order 41 tab-group-window 42 tab-move-resize-lock) 43 44 (open rep 45 rep.system 46 rep.io.timers 47 rep.data.records 48 sawfish.wm.gaol 49 sawfish.wm.misc 50 sawfish.wm.custom 51 sawfish.wm.commands 52 sawfish.wm.windows 53 sawfish.wm.frames 54 sawfish.wm.tabs.tab 55 sawfish.wm.events 56 sawfish.wm.state.iconify 57 sawfish.wm.state.shading 58 sawfish.wm.commands.move-resize 59 sawfish.wm.stacking 60 sawfish.wm.util.groups 61 sawfish.wm.util.window-order 62 sawfish.wm.commands.groups 63 sawfish.wm.ext.auto-raise 64 sawfish.wm.ext.shade-hover 65 sawfish.wm.workspace) 66 67 (define-structure-alias tabgroup sawfish.wm.tabs.tabgroup) 68 69 (define all-wins nil) 70 (define windows-stacking-order nil) 71 (define oldgroup nil) 72 (define tab-groups nil) 73 (define tab-refresh-lock t) 74 (define tab-move-resize-lock nil) 75 (define destroy nil) 76 (define release-window t) 77 (define last-unmap-id nil) 78 (define in-tab-group-name nil) 79 (define tab-theme-name) 80 (define tab-theme-tabbars) 81 (define timer-raise nil) 82 83 (defvar tab-group-windows-hook '() 84 "Tab-group-windows-hook called when changing or creating a tabgroup. 85Returning all windows in the current tabgroup") 86 87 (define (set-tab-theme-name #!key frame-style-supported-tabs) 88 (setq tab-theme-name frame-style-supported-tabs)) 89 90 (define (frame-style-tabs-support-p w) 91 "Returns t if the framestyle from W supports tabs. 92Also need the currect settings in the theme.jl from the theme." 93 (setq tab-theme-name nil) 94 (call-window-hook 'window-state-change-hook w (list '(tab-theme-name))) 95 (eq (window-get w 'current-frame-style) tab-theme-name)) 96 97 (define (set-tab-theme-tabbars #!key frame-style-supported-tabbars) 98 (setq tab-theme-tabbars frame-style-supported-tabbars)) 99 100 (define (frame-style-tabbars-support w) 101 "Returns a list with theme name and tabbars position if the framestyle from W 102has multiple tabbars. Also need the currect settings in the theme.jl from the theme." 103 (setq tab-theme-tabbars nil) 104 (call-window-hook 'window-state-change-hook w (list '(tab-theme-tabbars))) 105 tab-theme-tabbars) 106 107 (define (net-wm-window-type-normal-p w) 108 "Returns t if _NET_WM_WINDOW_TYPE by W is true or W has window-property 'force-tab" 109 (or (window-get w 'force-tab) 110 (if (get-x-property w '_NET_WM_WINDOW_TYPE) 111 (equal (aref (nth 2 (get-x-property w '_NET_WM_WINDOW_TYPE)) 0) '_NET_WM_WINDOW_TYPE_NORMAL)))) 112 113 (define (window-tabbed-p w) 114 (window-get w 'tabbed)) 115 116 (define-record-type :tab-group 117 (tab-build-group p d wl) 118 tab-group? 119 (p tab-group-position) 120 (d tab-group-dimensions) 121 (wl tab-group-window-list)) 122 123 (define (tab-move-resize-frame-window-to win x y w h) 124 "Move and resize according to *frame* dimensions." 125 (let* ((dim1 (window-dimensions win)) 126 (dim2 (window-frame-dimensions win)) 127 (dw (- (car dim2) (car dim1))) 128 (dh (- (cdr dim2) (cdr dim1)))) 129 (move-resize-window-to win x y (- w dw) (- h dh)))) 130 131 (define (tab-make-new-group win) 132 "Return a new group containing only WIN." 133 (let* ((pos (window-position win)) 134 (dim (window-frame-dimensions win)) 135 (group (tab-build-group pos dim (list win)))) 136 (setq tab-groups (append tab-groups (cons group nil))) 137 group)) 138 139 (define (tab-find-window win) 140 "Return the group containing WIN." 141 (let loop ((gr tab-groups)) 142 (cond 143 ((null gr) 144 (tab-make-new-group win) 145 ) 146 ((member win (tab-group-window-list (car gr))) 147 (car gr)) 148 (t 149 (loop (cdr gr)))))) 150 151 (define (tab-window-group-index win) 152 "Return the index of the group containing WIN." 153 (let loop ((index 0)) 154 (cond 155 ((eq index (length tab-groups)) 156 (tab-make-new-group win) 157 index) 158 ((member win (tab-group-window-list (nth index tab-groups))) 159 index) 160 (t 161 (loop (+ index 1)))))) 162 163 (define (tab-group-windows win) 164 "Return the windows of the group containing WIN." 165 (let* ((index (tab-window-group-index win)) 166 (wins (tab-group-window-list (nth index tab-groups)))) 167 wins)) 168 169 (define (tab-group-windows-stacking-order win) 170 "Return the windows of the group containing WIN sort by stacking order." 171 (let* ((tabs (tab-group-windows win)) 172 (all-wins (stacking-order)) 173 order) 174 (mapcar (lambda (w) 175 (if (member w tabs) 176 (setq order (append order (list w))))) all-wins) 177 order)) 178 179 (define (tab-rank elem list) 180 "Returns the nth position from elem (tab) in a list (tabbar)" 181 (if (eq elem (car list)) 182 0 183 (+ 1 (tab-rank elem (cdr list))))) 184 185 (define (destroy-hook w) 186 (setq destroy 't) 187 (tab-delete-window-from-tab-groups w)) 188 189 (define (tab-delete-window-from-group win index) 190 "Remove WIN from the group at given index." 191 (let* ((old (nth index tab-groups)) 192 (l (remove win (tab-group-window-list old)))) 193 (if (null l) 194 (setq tab-groups (delete old tab-groups)) 195 (rplaca (nthcdr index tab-groups) 196 (tab-build-group (tab-group-position old) (tab-group-dimensions old) l)) 197 (window-put win 'tabbed nil) 198 (if (not (cdr l)) 199 (window-put (car l) 'tabbed nil)) 200 (setq oldgroup (car l))))) 201 202 (define (tab-delete-window-from-tab-groups w) 203 "Find window's group and remove it." 204 (if release-window 205 (remove-from-tab-group w)) 206 (setq release-window t) 207 (when (window-tabbed-p w) 208 (let ((wins (list (remove w (tab-group-windows w))))) 209 (tab-delete-window-from-group w (tab-window-group-index w)) 210 (window-put w 'fixed-position nil) 211 (tab-refresh-group oldgroup 'frame) 212 (unshade-window (nth 0 (tab-group-windows-stacking-order oldgroup))) 213 (window-order-push (nth 0 (tab-group-windows-stacking-order oldgroup))) 214 (when (eq destroy 't) 215 (set-input-focus (nth 0 (tab-group-windows-stacking-order oldgroup))) 216 (setq destroy nil)) 217 (call-hook 'tab-group-windows-hook wins) 218 (reframe-window w)))) 219 220 (define (tab-put-window-in-group win index) 221 "Put window in group at given index." 222 (let* ((group (nth index tab-groups))) 223 (rplaca (nthcdr index tab-groups) 224 (tab-build-group (tab-group-position group) 225 (tab-group-dimensions group) 226 (append (tab-group-window-list group) (list win)))) 227 (window-order-push win))) 228 229 (define (tab-refresh-group win prop) 230 "Refresh the entire group containing WIN according to PROP. 231PROP can be one of the symbols: raise, frame, reframe, reframe-all, style, move, 232resize, title-position, type, depth, shade, unshade, iconify, uniconify, maximized, 233sticky, unsticky, fixed-position fixed-size." 234 (when tab-refresh-lock 235 (setq tab-refresh-lock nil) 236 (unwind-protect 237 (let* ((index (tab-window-group-index win)) 238 (wins (tab-group-window-list (nth index tab-groups))) 239 (focus (tab-group-offset win 0)) 240 (unfocus (remove focus wins)) 241 not-shaded) 242 (mapcar (lambda (w) 243 (if (not (window-get w 'shaded)) (setq not-shaded 't))) wins) 244 (if not-shaded 245 (mapcar (lambda (w) 246 (unshade-window w)) wins)) 247 (cond 248 ((eq prop 'raise) 249 (raise-windows win (remove win (tab-group-windows-stacking-order win)))) 250 ((eq prop 'title-position) 251 (let ((group-title-position (window-get win 'title-position))) 252 (mapcar (lambda (w) 253 (window-put w 'title-position group-title-position)) unfocus) 254 (window-put focus 'title-position group-title-position))) 255 ((eq prop 'frame) 256 (mapcar (lambda (w) 257 (reframe-window w)) unfocus) 258 (reframe-window focus)) 259 ((eq prop 'reframe) 260 (mapcar (lambda (w) 261 (reframe-window w)) unfocus)) 262 ((eq prop 'reframe-all) 263 (mapcar (lambda (w) 264 (reframe-window w)) unfocus) 265 (reframe-window focus)) 266 ((or (eq prop 'move) (eq prop 'resize)) 267 (let ((dim (window-frame-dimensions win)) 268 (pos (window-position win))) 269 (mapcar (lambda (w) 270 (tab-move-resize-frame-window-to w (car pos) (cdr pos) (car dim) (cdr dim))) unfocus))) 271 ((eq prop 'style) 272 (let ((group-frame-style (window-get win 'frame-style)) 273 (dim (window-frame-dimensions win)) 274 (pos (window-position win))) 275 (mapcar (lambda (w) 276 (set-frame-style w group-frame-style) 277 (tab-move-resize-frame-window-to w (car pos) (cdr pos) (car dim) (cdr dim))) unfocus))) 278 ((eq prop 'fixed-position) 279 (let ((group-frame-fixed-position (window-get win 'fixed-position))) 280 (mapcar (lambda (w) 281 (window-put w 'fixed-position group-frame-fixed-position)) unfocus))) 282 ((eq prop 'fixed-size) 283 (let ((group-frame-fixed-size (window-get win 'fixed-size))) 284 (mapcar (lambda (w) 285 (window-put w 'fixed-size group-frame-fixed-size)) unfocus))) 286 ((eq prop 'type) 287 (let ((group-frame-type (window-get win 'type))) 288 (mapcar (lambda (w) 289 (window-put w 'type group-frame-type)) unfocus))) 290 ((eq prop 'depth) 291 (let ((group-frame-depth (window-get win 'depth))) 292 (mapcar (lambda (w) 293 (window-put w 'depth group-frame-depth)) unfocus) 294 (raise-window win) 295 (set-input-focus win))) 296 ((eq prop 'iconify) 297 (mapcar (lambda (w) 298 (iconify-window w)) unfocus)) 299 ((eq prop 'uniconify) 300 (mapcar (lambda (w) 301 (uniconify-window w)) unfocus)) 302 ((eq prop 'maximized) 303 (let ((dim (window-frame-dimensions win)) 304 (pos (window-position win)) 305 (group-frame-maximized-vertically (window-get win 'maximized-vertically)) 306 (group-frame-maximized-horizontally (window-get win 'maximized-horizontally)) 307 (group-frame-maximized-fullscreen (window-get win 'maximized-fullscreen)) 308 (group-frame-unmaximized-type (window-get win 'unmaximized-type)) 309 (group-frame-unmaximized-geometry (window-get win 'unmaximized-geometry))) 310 (mapcar (lambda (w) 311 (window-put w 'maximized-vertically group-frame-maximized-vertically) 312 (window-put w 'maximized-horizontally group-frame-maximized-horizontally) 313 (window-put w 'maximized-fullscreen group-frame-maximized-fullscreen) 314 (window-put w 'unmaximized-type group-frame-unmaximized-type) 315 (window-put w 'unmaximized-geometry group-frame-unmaximized-geometry) 316 (tab-move-resize-frame-window-to w (car pos) (cdr pos) (car dim) (cdr dim))) unfocus))) 317 ((eq prop 'sticky) 318 (let ((workspace-sticky (window-sticky-p/workspace win)) 319 (viewport-sticky (window-sticky-p/viewport win)) 320 tab-workspace-sticky tab-viewport-sticky) 321 (mapcar (lambda (w) 322 (setq tab-workspace-sticky (window-sticky-p/workspace w)) 323 (setq tab-viewport-sticky (window-sticky-p/viewport w)) 324 (if (not (eq workspace-sticky tab-workspace-sticky)) 325 (if workspace-sticky 326 (make-window-sticky/workspace w) 327 (make-window-unsticky/workspace w))) 328 (if (not (eq viewport-sticky tab-viewport-sticky)) 329 (if viewport-sticky 330 (make-window-sticky/viewport w) 331 (make-window-unsticky/viewport w)))) unfocus)))) 332 (when (cdr (tab-group-windows win)) 333 (if not-shaded (unshade-window win)) 334 (mapcar (lambda (w) 335 (shade-window w)) (remove win (tab-group-windows win))))) 336 (setq tab-refresh-lock t)))) 337 338 ;; Entry points 339 (define (tab-group-window w win) 340 "Add window W to tabgroup containing WIN." 341 ;; don't add a window as tab, if it already 342 ;; exists on another workspace or window type 343 ;; is not a "normal" window (e.g. dock panel ...) 344 ;; and framestyle supported tabs 345 (when (and (not (cdr (window-get win 'workspaces))) 346 (net-wm-window-type-normal-p w) 347 (net-wm-window-type-normal-p win) 348 (frame-style-tabs-support-p win)) 349 (let* ((index (tab-window-group-index win)) 350 (index2 (tab-window-group-index w)) 351 (pos (window-position win)) 352 (dim (window-dimensions win)) 353 ;; adopt window settings for the new tab 354 (group-frame-style (window-get win 'frame-style)) 355 (group-frame-type (window-get win 'type)) 356 (group-frame-shade-hover (window-get win 'shade-hover)) 357 (group-frame-focus-mode (window-get win 'focus-mode)) 358 (group-frame-gravity (window-get win 'gravity)) 359 (group-frame-never-iconify (window-get win 'never-iconify)) 360 (group-frame-fixed-position (window-get win 'fixed-position)) 361 (group-frame-fixed-size (window-get win 'fixed-size)) 362 (group-frame-title-position (window-get win 'title-position)) 363 (group-frame-depth (window-get win 'depth)) 364 (group-frame-never-maximize (window-get win 'never-maximize)) 365 (group-frame-maximized-vertically (window-get win 'maximized-vertically)) 366 (group-frame-maximized-horizontally (window-get win 'maximized-horizontally)) 367 (group-frame-maximized-fullscreen (window-get win 'maximized-fullscreen)) 368 (group-frame-unmaximized-type (window-get win 'unmaximized-type)) 369 (group-frame-unmaximized-geometry (window-get win 'unmaximized-geometry)) 370 group-frame-to-workspaces group-frame-from-workspaces is-sticky-w is-sticky-v) 371 (when (not (eq index index2)) 372 ;; tabgroup to tabgroup 373 (when (window-tabbed-p w) 374 (setq release-window nil) 375 (tab-delete-window-from-tab-groups w) 376 (setq index2 (tab-window-group-index w))) 377 (if (window-get win 'iconified) (uniconify-window win)) 378 (if (window-get win 'shaded) (unshade-window win)) 379 (setq tab-refresh-lock nil) 380 (if (window-sticky-p/workspace win) (setq is-sticky-w 't)) 381 (if (window-sticky-p/viewport win) (setq is-sticky-v 't)) 382 (if (window-sticky-p win) (make-window-unsticky win)) 383 (setq group-frame-to-workspaces (car (window-workspaces win))) 384 (if (window-sticky-p w) (make-window-unsticky w)) 385 (setq group-frame-from-workspaces (car (window-workspaces w))) 386 (if (window-get w 'iconified) (uniconify-window w)) 387 (if (window-get w 'shaded) (unshade-window w)) 388 (window-put w 'frame-style group-frame-style) 389 (window-put w 'type group-frame-type) 390 (window-put w 'shade-hover group-frame-shade-hover) 391 (window-put w 'focus-mode group-frame-focus-mode) 392 (window-put w 'gravity group-frame-gravity) 393 (window-put w 'title-position group-frame-title-position) 394 (window-put w 'never-iconify group-frame-never-iconify) 395 (window-put w 'depth group-frame-depth) 396 (window-put w 'fixed-position group-frame-fixed-position) 397 (window-put w 'fixed-size group-frame-fixed-size) 398 (window-put w 'never-maximize group-frame-never-maximize) 399 (window-put w 'maximized-vertically group-frame-maximized-vertically) 400 (window-put w 'maximized-horizontally group-frame-maximized-horizontally) 401 (window-put w 'maximized-fullscreen group-frame-maximized-fullscreen) 402 (window-put w 'unmaximized-type group-frame-unmaximized-type) 403 (window-put w 'unmaximized-geometry group-frame-unmaximized-geometry) 404 ;; reframe w here, tab-refresh-group expectet 405 ;; the same frame for w and win 406 (reframe-window w) 407 (tab-put-window-in-group w index) 408 (tab-delete-window-from-group w index2) 409 (resize-window-to w (car dim) (cdr dim)) 410 (move-window-to w (car pos) (cdr pos)) 411 (when (and group-frame-to-workspaces group-frame-from-workspaces 412 (not (eq group-frame-to-workspaces group-frame-from-workspaces))) 413 (move-window-to-workspace w group-frame-from-workspaces group-frame-to-workspaces)) 414 (if (and is-sticky-w is-sticky-v) 415 (progn 416 (make-window-sticky win) 417 (make-window-sticky w)) 418 (when is-sticky-w 419 (make-window-sticky/workspace win) 420 (make-window-sticky/workspace w)) 421 (when is-sticky-v 422 (make-window-sticky/viewport win) 423 (make-window-sticky/viewport w))) 424 (setq tab-refresh-lock t) 425 (tab-refresh-group w 'frame) 426 (set-input-focus w) 427 (call-hook 'tab-group-windows-hook (list (tab-group-windows w))) 428 (if (not (window-tabbed-p win)) (window-put win 'tabbed t)) 429 (window-put w 'tabbed t) 430 (raise-windows w (remove w (tab-group-windows-stacking-order w))))))) 431 432 (define (tab-release-window w) 433 "Release the window from its group." 434 (setq release-window nil) 435 (tab-delete-window-from-tab-groups w) 436 (tab-make-new-group w)) 437 438 (define-command 'tab-release-window tab-release-window #:spec "%f") 439 440 (define (tab-group-offset win n) 441 "Return the window at position (pos+n) in window's group." 442 (let* ((gr (tab-group-window-list (tab-find-window win))) 443 (size (length gr)) 444 (r (tab-rank win gr))) 445 (nth (modulo (+ r n) size) gr))) 446 447 (define (tab-same-group-p w1 w2) 448 "Predicate : true <=> w1 and w2 are grouped together." 449 (member w1 (tab-group-window-list (tab-find-window w2)))) 450 451 (define (tab-raise-left-window) 452 "Raise left window in current tab group." 453 (let ((win (tab-group-offset (input-focus) -1))) 454 (raise-window win) 455 (set-input-focus win))) 456 457 (define-command 'tab-raise-left-window tab-raise-left-window) 458 459 (define (tab-raise-right-window) 460 "Raise right window in current tab group." 461 (let ((win (tab-group-offset (input-focus) 1))) 462 (raise-window win) 463 (set-input-focus win))) 464 465 (define-command 'tab-raise-right-window tab-raise-right-window) 466 467 (define (move-tab w pos) 468 "Move tab W to pos" 469 (when (window-tabbed-p w) 470 (let* ((wins (tab-group-windows w)) 471 (rank (tab-rank w wins)) 472 (list-end (nthcdr rank wins)) 473 (list-start wins) 474 right left current new-list) 475 (mapcar (lambda (w) 476 (setq list-start (remove w list-start))) list-end) 477 (when (eq pos 'next) 478 (if (not (nth (+ rank 1) wins)) 479 (tab-move-to-beginning w) 480 (setq list-end (remove w list-end)) 481 (setq right (nth (+ rank 1) wins)) 482 (setq list-end (remove (nth (+ rank 1) wins) list-end)) 483 (setq current (list w)) 484 (if (consp list-start) 485 (setq new-list (append new-list list-start))) 486 (if right 487 (setq new-list (append new-list (list right)))) 488 (if (consp current) 489 (setq new-list (append new-list current))) 490 (if (consp list-end) 491 (setq new-list (append new-list list-end))) 492 (setq all-wins (nthcdr 0 new-list)) 493 (after-move-resize w))) 494 (when (eq pos 'prev) 495 (setq left (last list-start)) 496 (if (not left) 497 (tab-move-to-end w) 498 (setq list-start (remove left list-start)) 499 (setq list-end (nthcdr (+ rank 1) wins)) 500 (setq current (list w)) 501 (if (consp list-start) 502 (setq new-list (append new-list list-start))) 503 (if (consp current) 504 (setq new-list (append new-list current))) 505 (if left 506 (setq new-list (append new-list (list left)))) 507 (if (consp list-end) 508 (setq new-list (append new-list list-end))) 509 (setq all-wins (nthcdr 0 new-list)) 510 (after-move-resize w)))))) 511 512 (define clicked-frame nil) 513 (define (tab-move-to-right w) 514 "Move tab to right in the tabbar." 515 (setq clicked-frame (clicked-frame-part)) 516 (move-tab w 'next)) 517 518 (define-command 'tab-move-to-right tab-move-to-right #:spec "%f") 519 520 (define (tab-move-to-left w) 521 "Move tab to left in the tabbar." 522 (setq clicked-frame (clicked-frame-part)) 523 (move-tab w 'prev)) 524 525 (define-command 'tab-move-to-left tab-move-to-left #:spec "%f") 526 527 (define (move-tab-edge w pos) 528 "Move tab W to pos" 529 (when (window-tabbed-p w) 530 (let ((tabs (remove w (tab-group-windows w)))) 531 (if (eq pos 'end) 532 (setq all-wins (append tabs (cons w nil)))) 533 (if (eq pos 'beg) 534 (setq all-wins (append (cons w nil) tabs))) 535 (after-move-resize w)))) 536 537 (define (tab-move-to-end w) 538 "Move tab to the end in the tabbar." 539 (setq clicked-frame (clicked-frame-part)) 540 (move-tab-edge w 'end)) 541 542 (define-command 'tab-move-to-end tab-move-to-end #:spec "%f") 543 544 (define (tab-move-to-beginning w) 545 "Move tab to the beginning in the tabbar." 546 (setq clicked-frame (clicked-frame-part)) 547 (move-tab-edge w 'beg)) 548 549 (define-command 'tab-move-to-beginning tab-move-to-beginning #:spec "%f") 550 551 (define (map-other-grouped-windows win func) 552 "" 553 (mapcar func 554 (delete-if 555 (lambda (w) (eq w win)) 556 (tab-group-window-list (tab-find-window win)))) ) 557 558 (define (before-move win) 559 (when (not (window-get win 'fixed-position)) 560 (before-move-resize win))) 561 562 (define (before-move-resize win) 563 "Releas WIN from the tabgroup and iconify the rest from the group." 564 (let* ((default-window-animator 'none) 565 (index (tab-window-group-index win)) 566 (wins (tab-group-windows win)) 567 (order (tab-group-windows-stacking-order win)) 568 (tabs (remove win (tab-group-windows win)))) 569 (setq tab-move-resize-lock 't) 570 (tab-delete-window-from-group win index) 571 (reframe-window win) 572 (setq tab-refresh-lock nil) 573 (mapcar (lambda (w) 574 (when (window-get w 'never-iconify) 575 (window-put w 'never-iconify nil) 576 (window-put w 'never-iconify-opaque t)) 577 (iconify-window w)) tabs) 578 (setq windows-stacking-order order) 579 (setq all-wins wins)) 580 (setq tab-refresh-lock t)) 581 582 (define (after-move-resize win) 583 "Add all tabs to the tabgroup from WIN. (Releas and iconify by before-move-resize)" 584 (setq tab-refresh-lock nil) 585 (let* ((default-window-animator 'none) 586 (wins all-wins) 587 (pos (window-position win)) 588 (dim (window-dimensions win)) 589 index index-old) 590 (when (cdr wins) 591 (setq index (tab-window-group-index (car wins))) 592 (mapcar (lambda (w) 593 (setq index-old (tab-window-group-index w)) 594 (tab-put-window-in-group w index) 595 (tab-delete-window-from-group w index-old) 596 (setq index (tab-window-group-index w)) 597 (move-window-to w (car pos) (cdr pos)) 598 (resize-window-to w (car dim) (cdr dim)) 599 (uniconify-window w) 600 (when (window-get w 'never-iconify-opaque) 601 (window-put w 'never-iconify-opaque nil) 602 (window-put w 'never-iconify t)) 603 (window-put w 'tabbed t)) wins) 604 (call-hook 'tab-group-windows-hook (list (tab-group-windows win))) 605 (raise-windows win (remove win windows-stacking-order)) 606 (tab-refresh-group win 'raise) 607 (setq all-wins nil)) 608 (setq tab-refresh-lock t) 609 (when (window-tabbed-p win) 610 (tab-refresh-group win 'move) 611 (tab-refresh-group win 'frame) 612 (set-input-focus (nth 0 (tab-group-windows-stacking-order win))) 613 (when clicked-frame 614 (move-cursor-in-tabbar (input-focus)) 615 (setq clicked-frame nil))) 616 (setq tab-move-resize-lock nil))) 617 618 (define (move-cursor-in-tabbar win) 619 (let* ((group (tab-find-window win)) 620 (tabnum (tab-rank win (tab-group-window-list group))) 621 (tab-pos-list (tab-pos group tabnum win)) 622 (start-right 623 (if (or (eq (window-get win 'type) 'transient) 624 (eq (window-get win 'type) 'shaped-transient)) 625 tabbar-left-margin-transient 626 tabbar-left-margin))) 627 (if (not (eq (window-get win 'current-frame-style) (nth 0 (frame-style-tabbars-support win)))) 628 (warp-cursor (+ (car (window-position win)) start-right (nth 4 tab-pos-list) (quotient (nth 6 tab-pos-list) 2)) 629 (+ (quotient (- (cdr (window-frame-dimensions win)) (cdr (window-dimensions win)) 4) 2) (cdr (window-position win)))) 630 (let ((current-pos 631 (if (window-get win 'title-position) 632 (window-get win 'title-position) 633 (nth 1 (frame-style-tabbars-support win))))) 634 (case current-pos 635 ((top) (warp-cursor (+ (car (window-position win)) start-right (nth 4 tab-pos-list) (quotient (nth 6 tab-pos-list) 2)) 636 (+ (quotient (- (cdr (window-frame-dimensions win)) (cdr (window-dimensions win)) 4) 2) (cdr (window-position win))))) 637 ((bottom) (warp-cursor (+ (car (window-position win)) start-right (nth 4 tab-pos-list) (quotient (nth 6 tab-pos-list) 2)) 638 (+ (quotient (- (cdr (window-frame-dimensions win)) (cdr (window-dimensions win))) 2) 639 (cdr (window-position win)) (cdr (window-dimensions win))))) 640 ((left) (warp-cursor (+ (quotient (- (car (window-frame-dimensions win)) (car (window-dimensions win)) 4) 2) (car (window-position win))) 641 (- (+ (cdr (window-position win)) (cdr (window-dimensions win))) start-right (nth 7 tab-pos-list) 642 (quotient (nth 9 tab-pos-list) 2)))) 643 ((right) (warp-cursor (+ (quotient (- (car (window-frame-dimensions win)) (car (window-dimensions win))) 2) 644 (car (window-position win)) (car (window-dimensions win)) 2) 645 (- (+ (cdr (window-position win)) (cdr (window-dimensions win))) start-right (nth 7 tab-pos-list) 646 (quotient (nth 9 tab-pos-list) 2))))))))) 647 648 (define (unmap-id win) 649 (setq last-unmap-id (window-id win))) 650 651 (define (in-tab-group win) 652 "Add a new window WIN as tab if have one (the first created if more as one) 653of the windows the same 'tab-group property" 654 (when (window-get win 'tab-group) 655 (setq in-tab-group-name (append in-tab-group-name (cons (cons (window-id win) (window-get win 'tab-group))))) 656 (let ((open-win-tabgroup (get-window-by-id (car (rassoc (window-get win 'tab-group) in-tab-group-name))))) 657 ;; unmap-notify-hook gets not always a window-id for all 658 ;; windows e.g. gimp (it will close more as one window and 659 ;; also not all call the unmap-notify-hook and/or we get the window-id). 660 ;; This next "if" will clean the list and remove the "ghosts". 661 (if (not (eq open-win-tabgroup nil)) 662 (if (not (eq win open-win-tabgroup)) 663 (tab-group-window win open-win-tabgroup)) 664 (setq in-tab-group-name (remove (rassoc (window-get win 'tab-group) in-tab-group-name) in-tab-group-name)) 665 (in-tab-group win))))) 666 667 (define (remove-from-tab-group win) 668 "Remove WIN from in-tab-group-name alist if it have a 'tab-group property" 669 (when (window-get win 'tab-group) 670 (setq in-tab-group-name (remove (assoc last-unmap-id in-tab-group-name) in-tab-group-name)))) 671 672 (define (focus-in-tab win) 673 (let ((timer-wait (if raise-windows-on-focus raise-window-timeout '1))) 674 (if (or (eq focus-mode 'click) 675 (eq (window-get win 'focus-mode) 'click)) 676 (setq timer-wait '1)) 677 (setq timer-raise 678 (make-timer (lambda () 679 (if (or shade-hover-mode (window-get win 'shade-hover)) 680 (raise-windows win (remove win (tab-group-windows-stacking-order win))) 681 (tab-refresh-group win 'raise))) 682 (quotient timer-wait 1000) (mod timer-wait 1000))))) 683 684 (define (focus-out-tab) 685 (when timer-raise 686 (delete-timer timer-raise) 687 (setq timer-raise nil))) 688 689 (define (unshade-tab win) 690 (let ((unshade-nil)) 691 (when (window-get win 'shade-hover-unshaded) 692 (mapcar (lambda (w) 693 (if (not (window-get w 'shaded)) (setq unshade-nil 't))) (remove win (tab-group-windows win))) 694 (when unshade-nil 695 (window-put win 'shade-hover-unshaded nil) 696 (clean-up) 697 (setq unshade-nil nil) 698 (mapcar (lambda (w) 699 (shade-window w)) (remove win (tab-group-windows win)))) 700 (set-input-focus win)))) 701 702 (unless batch-mode 703 (add-hook 'after-add-window-hook in-tab-group) 704 (add-hook 'unmap-notify-hook unmap-id) 705 (add-hook 'window-state-change-hook 706 (lambda (win args) 707 (when (window-tabbed-p win) 708 (setq args (car args)) 709 (cond ((eq 'sticky args) 710 (tab-refresh-group win 'sticky) 711 (tab-refresh-group win 'frame)) 712 ((eq 'fixed-position args) 713 (tab-refresh-group win 'fixed-position) 714 (tab-refresh-group win 'frame)) 715 ((eq 'fixed-size args) 716 (tab-refresh-group win 'fixed-size) 717 (tab-refresh-group win 'frame)) 718 ((eq 'frame-style args) 719 (tab-refresh-group win 'style) 720 (tab-refresh-group win 'reframe-all) 721 (tab-refresh-group win 'move)) 722 ((eq 'type args) 723 (tab-refresh-group win 'type) 724 (tab-refresh-group win 'reframe)) 725 ((eq 'stacking args) 726 (tab-refresh-group win 'depth) 727 (tab-refresh-group win 'frame)))))) 728 729 (when (eq move-outline-mode 'opaque) 730 (add-hook 'before-move-hook (lambda (win) (if (window-tabbed-p win) (before-move win))))) 731 (add-hook 'after-move-hook (lambda (win) (after-move-resize win))) 732 (when (eq resize-outline-mode 'opaque) 733 (add-hook 'before-resize-hook (lambda (win) (if (window-tabbed-p win) (before-move-resize win))))) 734 (add-hook 'after-resize-hook (lambda (win) (after-move-resize win))) 735 (add-hook 'focus-in-hook (lambda (win) (if (window-tabbed-p win) (focus-in-tab win)))) 736 (add-hook 'focus-out-hook (lambda (win) (if (window-tabbed-p win) (focus-out-tab)))) 737 (add-hook 'unshade-window-hook (lambda (win) (if (window-tabbed-p win) (unshade-tab win)))) 738 (add-hook 'iconify-window-hook (lambda (win) (if (window-tabbed-p win) (tab-refresh-group win 'iconify)))) 739 (add-hook 'uniconify-window-hook (lambda (win) (if (window-tabbed-p win) (tab-refresh-group win 'uniconify)))) 740 (add-hook 'window-maximized-hook (lambda (win) (if (window-tabbed-p win) (tab-refresh-group win 'maximized)))) 741 (add-hook 'window-unmaximized-hook (lambda (win) (if (window-tabbed-p win) (tab-refresh-group win 'maximized)))) 742 (add-hook 'destroy-notify-hook destroy-hook)) 743 744 (gaol-add set-tab-theme-name set-tab-theme-tabbars tab-refresh-group tab-group-windows)) 745