src/clfswm-layout.lisp

   1 ;;; --------------------------------------------------------------------------
   2 ;;; CLFSWM - FullScreen Window Manager
   3 ;;;
   4 ;;; --------------------------------------------------------------------------
   5 ;;; Documentation: Layout functions
   6 ;;; --------------------------------------------------------------------------
   7 ;;;
   8 ;;; (C) 2010 Philippe Brochard <hocwp@free.fr>
   9 ;;;
  10 ;;; This program is free software; you can redistribute it and/or modify
  11 ;;; it under the terms of the GNU General Public License as published by
  12 ;;; the Free Software Foundation; either version 3 of the License, or
  13 ;;; (at your option) any later version.
  14 ;;;
  15 ;;; This program is distributed in the hope that it will be useful,
  16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;;; GNU General Public License for more details.
  19 ;;;
  20 ;;; You should have received a copy of the GNU General Public License
  21 ;;; along with this program; if not, write to the Free Software
  22 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  23 ;;;
  24 ;;; --------------------------------------------------------------------------
  25
  26 (in-package :clfswm)
  27
  28
  29 ;;; CONFIG - Layout menu
  30 ;;;
  31 ;;; To add a new layout:
  32 ;;;   1- define your own layout: a method returning the real size of the
  33 ;;;      child in screen size (integer) as 5 values (rx, ry, rw, rh).
  34 ;;;      This method can use the float size of the child (x, y ,w , h).
  35 ;;;      It can be specialised for xlib:window or frame
  36 ;;;   2- Define a setter function for your layout
  37 ;;;   3- Register your new layout with register-layout or create
  38 ;;;      a sub menu for it with register-layout-sub-menu.
  39
  40
  41
  42 (defparameter *layout-current-key* (1- (char-code #\a)))
  43
  44
  45 ;;; Generic functions
  46 (defun set-layout (layout)
  47   "Set the layout of the current child"
  48   (when (frame-p *current-child*)
  49     (setf (frame-layout *current-child*) layout)
  50     (leave-second-mode)))
  51
  52 (defun set-layout-dont-leave (layout)
  53   "Set the layout of the current child"
  54   (when (frame-p *current-child*)
  55     (setf (frame-layout *current-child*) layout)))
  56
  57 (defun set-layout-once (layout-name)
  58   (set-layout-dont-leave layout-name)
  59   (show-all-children *current-root*)
  60   (fixe-real-size-current-child)
  61   (set-layout-dont-leave #'no-layout))
  62
  63
  64 (defun get-managed-child (parent)
  65   "Return only the windows that are managed for tiling"
  66   (when (frame-p parent)
  67     (remove-if #'(lambda (x)
  68                    (and (xlib:window-p x) (not (managed-window-p x parent))))
  69                (frame-child parent))))
  70
  71
  72 (defun next-layout-key ()
  73   (code-char (incf *layout-current-key*)))
  74
  75
  76 (defun register-layout (layout)
  77   (add-menu-key 'frame-layout-menu (next-layout-key) layout))
  78
  79
  80 (defun register-layout-sub-menu (name doc layout-list)
  81   (add-sub-menu 'frame-layout-menu (next-layout-key) name doc)
  82   (loop :for item :in layout-list
  83      :for i :from 0
  84      :do (typecase item
  85            (cons (add-menu-key name (first item) (second item)))
  86            (string (add-menu-comment name item))
  87            (t (add-menu-key name (number->char i) item)))))
  88
  89
  90
  91
  92 (defun layout-ask-size (msg slot &optional (min 80))
  93   (when (frame-p *current-child*)
  94     (let ((new-size (/ (or (query-number msg (* (frame-data-slot *current-child* slot) 100)) min) 100)))
  95       (when (<= 0 new-size 1)
  96         (setf (frame-data-slot *current-child* slot) new-size)))))
  97
  98
  99
 100
 101
 102 (defun fast-layout-switch ()
 103   "Switch between two layouts"
 104   (when (frame-p *current-child*)
 105     (with-slots (layout) *current-child*
 106       (let* ((layout-list (frame-data-slot *current-child* :fast-layout))
 107              (first-layout (ensure-function (first layout-list)))
 108              (second-layout (ensure-function (second layout-list))))
 109         (setf layout (if (eql layout first-layout)
 110                          second-layout
 111                          first-layout))
 112         (leave-second-mode)))))
 113
 114
 115 (defun push-in-fast-layout-list ()
 116   "Push the current layout in the fast layout list"
 117   (when (frame-p *current-child*)
 118     (setf (frame-data-slot *current-child* :fast-layout)
 119           (list (frame-layout *current-child*)
 120                 (first (frame-data-slot *current-child* :fast-layout))))
 121     (leave-second-mode)))
 122
 123
 124
 125 (register-layout-sub-menu 'frame-fast-layout-menu "Frame fast layout menu"
 126                           '(("s" fast-layout-switch)
 127                             ("p" push-in-fast-layout-list)))
 128
 129
 130
 131 ;;; No layout
 132 (defgeneric no-layout (child parent)
 133   (:documentation "No layout: Maximize windows in there frame - Leave frames to there original size"))
 134
 135 (defmethod no-layout ((child xlib:window) parent)
 136   (with-slots (rx ry rw rh) parent
 137     (values (1+ rx)
 138             (1+ ry)
 139             (- rw 2)
 140             (- rh 2))))
 141
 142 (defmethod no-layout ((child frame) parent)
 143   (values (x-fl->px (frame-x child) parent)
 144           (y-fl->px (frame-y child) parent)
 145           (w-fl->px (frame-w child) parent)
 146           (h-fl->px (frame-h child) parent)))
 147
 148
 149
 150 (defun set-no-layout ()
 151   "No layout: Maximize windows in there frame - Leave frames to there original size"
 152   (set-layout #'no-layout))
 153
 154 (register-layout 'set-no-layout)
 155
 156 ;;; No layout remember size
 157 (defun set-no-layout-remember-size ()
 158   "No layout: Maximize windows in there frame - Leave frames to there actual size"
 159   (fixe-real-size-current-child)
 160   (set-no-layout))
 161
 162 (register-layout 'set-no-layout-remember-size)
 163
 164
 165
 166 ;;; Maximize layout
 167 (defgeneric maximize-layout (child parent)
 168   (:documentation "Maximize layout: Maximize windows and frames in there parent frame"))
 169
 170 (defmethod maximize-layout (child parent)
 171   (declare (ignore child))
 172   (with-slots (rx ry rw rh) parent
 173     (values (1+ rx)
 174             (1+ ry)
 175             (- rw 2)
 176             (- rh 2))))
 177
 178
 179 (defun set-maximize-layout ()
 180   "Maximize layout: Maximize windows and frames in there parent frame"
 181   (set-layout #'maximize-layout))
 182
 183 (register-layout 'set-maximize-layout)
 184
 185
 186
 187
 188 ;;; Tile layout
 189 (defun tile-layout-ask-keep-position ()
 190   (when (frame-p *current-child*)
 191     (let ((keep-position (query-string "Keep frame children positions?" "" '("yes" "no"))))
 192       (if (or (string= keep-position "")
 193               (char= (char keep-position 0) #\y)
 194               (char= (char keep-position 0) #\Y))
 195           (setf (frame-data-slot *current-child* :tile-layout-keep-positiion) :yes)
 196           (remove-frame-data-slot *current-child* :tile-layout-keep-positiion)))))
 197
 198
 199 (defun set-layout-managed-children ()
 200   (when (frame-p *current-child*)
 201     (setf (frame-data-slot *current-child* :layout-managed-children)
 202           (copy-list (get-managed-child *current-child*)))
 203     (tile-layout-ask-keep-position)))
 204
 205 (defun update-layout-managed-children-keep-position (child parent)
 206   (let ((managed-children (frame-data-slot parent :layout-managed-children))
 207         (managed-in-parent (get-managed-child parent)))
 208     (dolist (ch managed-in-parent)
 209       (unless (child-member ch managed-children)
 210         (setf managed-children (append managed-children (list child)))))
 211     (setf managed-children (remove-if-not (lambda (x)
 212                                             (child-member x managed-in-parent))
 213                                           managed-children))
 214     (setf (frame-data-slot parent :layout-managed-children) managed-children)
 215     managed-children))
 216
 217 (defun update-layout-managed-children (child parent)
 218   (if (eql (frame-data-slot *current-child* :tile-layout-keep-positiion) :yes)
 219       (update-layout-managed-children-keep-position child parent)
 220       (get-managed-child parent)))
 221
 222
 223
 224 (defgeneric tile-layout (child parent)
 225   (:documentation "Tile child in its frame (vertical)"))
 226
 227 (defmethod tile-layout (child parent)
 228   (let* ((managed-children (update-layout-managed-children child parent))
 229          (pos (child-position child managed-children))
 230          (len (length managed-children))
 231          (nx (ceiling (sqrt len)))
 232          (ny  (ceiling (/ len nx)))
 233          (dx (/ (frame-rw parent) nx))
 234          (dy (/ (frame-rh parent) ny))
 235          (dpos (- (* nx ny) len))
 236          (width dx))
 237     (when (plusp dpos)
 238       (if (zerop pos)
 239           (setf width (* dx (1+ dpos)))
 240           (incf pos dpos)))
 241     (values (round (+ (frame-rx parent) (truncate (* (mod pos nx) dx)) 1))
 242             (round (+ (frame-ry parent) (truncate (* (truncate (/ pos nx)) dy)) 1))
 243             (round (- width 2))
 244             (round (- dy 2)))))
 245
 246 (defun set-tile-layout ()
 247   "Tile child in its frame (vertical)"
 248   (set-layout-managed-children)
 249   (set-layout #'tile-layout))
 250
 251
 252
 253 ;; Horizontal tiling layout
 254 (defgeneric tile-horizontal-layout (child parent)
 255   (:documentation "Tile child in its frame (horizontal)"))
 256
 257 (defmethod tile-horizontal-layout (child parent)
 258   (let* ((managed-children (update-layout-managed-children child parent))
 259          (pos (child-position child managed-children))
 260          (len (length managed-children))
 261          (ny (ceiling (sqrt len)))
 262          (nx (ceiling (/ len ny)))
 263          (dx (/ (frame-rw parent) nx))
 264          (dy (/ (frame-rh parent) ny))
 265          (dpos (- (* nx ny) len))
 266          (height dy))
 267     (when (plusp dpos)
 268       (if (zerop pos)
 269           (setf height (* dy (1+ dpos)))
 270           (incf pos dpos)))
 271     (values (round (+ (frame-rx parent) (truncate (* (truncate (/ pos ny)) dx)) 1))
 272             (round (+ (frame-ry parent) (truncate (* (mod pos ny) dy)) 1))
 273             (round (- dx 2))
 274             (round (- height 2)))))
 275
 276 (defun set-tile-horizontal-layout ()
 277   "Tile child in its frame (horizontal)"
 278   (set-layout-managed-children)
 279   (set-layout #'tile-horizontal-layout))
 280
 281
 282
 283 ;; One column layout
 284 (defgeneric one-column-layout (child parent)
 285   (:documentation "One column layout"))
 286
 287 (defmethod one-column-layout (child parent)
 288   (let* ((managed-children (update-layout-managed-children child parent))
 289          (pos (child-position child managed-children))
 290          (len (length managed-children))
 291          (dy (/ (frame-rh parent) len)))
 292     (values (round (+ (frame-rx parent) 1))
 293             (round (+ (frame-ry parent) (*  pos dy) 1))
 294             (round (- (frame-rw parent) 2))
 295             (round (- dy 2)))))
 296
 297 (defun set-one-column-layout ()
 298   "One column layout"
 299   (set-layout-managed-children)
 300   (set-layout #'one-column-layout))
 301
 302
 303 ;; One line layout
 304 (defgeneric one-line-layout (child parent)
 305   (:documentation "One line layout"))
 306
 307 (defmethod one-line-layout (child parent)
 308   (let* ((managed-children (update-layout-managed-children child parent))
 309          (pos (child-position child managed-children))
 310          (len (length managed-children))
 311          (dx (/ (frame-rw parent) len)))
 312     (values (round (+ (frame-rx parent) (*  pos dx) 1))
 313             (round (+ (frame-ry parent) 1))
 314             (round (- dx 2))
 315             (round (- (frame-rh parent) 2)))))
 316
 317 (defun set-one-line-layout ()
 318   "One line layout"
 319   (set-layout-managed-children)
 320   (set-layout #'one-line-layout))
 321
 322
 323
 324
 325
 326 ;;; Space layout
 327 (defun tile-space-layout (child parent)
 328   "Tile Space: tile child in its frame leaving spaces between them"
 329   (with-slots (rx ry rw rh) parent
 330     (let* ((managed-children (update-layout-managed-children child parent))
 331            (pos (child-position child managed-children))
 332            (len (length managed-children))
 333            (n (ceiling (sqrt len)))
 334            (dx (/ rw n))
 335            (dy (/ rh (ceiling (/ len n))))
 336            (size (or (frame-data-slot parent :tile-space-size) 0.1)))
 337       (when (> size 0.5) (setf size 0.45))
 338       (values (round (+ rx (truncate (* (mod pos n) dx)) (* dx size) 1))
 339               (round (+ ry (truncate (* (truncate (/ pos n)) dy)) (* dy size) 1))
 340               (round (- dx (* dx size 2) 2))
 341               (round (- dy (* dy size 2) 2))))))
 342
 343
 344
 345
 346 (defun set-tile-space-layout ()
 347   "Tile Space: tile child in its frame leaving spaces between them"
 348   (layout-ask-size "Space size in percent (%)" :tile-space-size 0.01)
 349   (set-layout-managed-children)
 350   (set-layout #'tile-space-layout))
 351
 352
 353
 354 (register-layout-sub-menu 'frame-tile-layout-menu "Frame tile layout menu"
 355                           '(("v" set-tile-layout)
 356                             ("h" set-tile-horizontal-layout)
 357                             ("c" set-one-column-layout)
 358                             ("l" set-one-line-layout)
 359                             ("s" set-tile-space-layout)))
 360
 361
 362
 363 ;;; Tile Left
 364 (defun tile-left-layout (child parent)
 365   "Tile Left: main child on left and others on right"
 366   (with-slots (rx ry rw rh) parent
 367     (let* ((managed-children (get-managed-child parent))
 368            (pos (child-position child managed-children))
 369            (len (max (1- (length managed-children)) 1))
 370            (dy (/ rh len))
 371            (size (or (frame-data-slot parent :tile-size) 0.8)))
 372       (if (> (length managed-children) 1)
 373           (if (= pos 0)
 374               (values (1+ rx)
 375                       (1+ ry)
 376                       (- (round (* rw size)) 2)
 377                       (- rh 2))
 378               (values (1+ (round (+ rx (* rw size))))
 379                       (1+ (round (+ ry (* dy (1- pos)))))
 380                       (- (round (* rw (- 1 size))) 2)
 381                       (- (round dy) 2)))
 382           (no-layout child parent)))))
 383
 384
 385 (defun set-tile-left-layout ()
 386   "Tile Left: main child on left and others on right"
 387   (layout-ask-size "Tile size in percent (%)" :tile-size)
 388   (set-layout #'tile-left-layout))
 389
 390
 391
 392 ;;; Tile right
 393 (defun tile-right-layout (child parent)
 394   "Tile Right: main child on right and others on left"
 395   (with-slots (rx ry rw rh) parent
 396     (let* ((managed-children (get-managed-child parent))
 397            (pos (child-position child managed-children))
 398            (len (max (1- (length managed-children)) 1))
 399            (dy (/ rh len))
 400            (size (or (frame-data-slot parent :tile-size) 0.8)))
 401       (if (> (length managed-children) 1)
 402           (if (= pos 0)
 403               (values (1+ (round (+ rx (* rw (- 1 size)))))
 404                       (1+ ry)
 405                       (- (round (* rw size)) 2)
 406                       (- rh 2))
 407               (values (1+ rx)
 408                       (1+ (round (+ ry (* dy (1- pos)))))
 409                       (- (round (* rw (- 1 size))) 2)
 410                       (- (round dy) 2)))
 411           (no-layout child parent)))))
 412
 413
 414 (defun set-tile-right-layout ()
 415   "Tile Right: main child on right and others on left"
 416   (layout-ask-size "Tile size in percent (%)" :tile-size)
 417   (set-layout #'tile-right-layout))
 418
 419
 420
 421
 422
 423
 424 ;;; Tile Top
 425 (defun tile-top-layout (child parent)
 426   "Tile Top: main child on top and others on bottom"
 427   (with-slots (rx ry rw rh) parent
 428     (let* ((managed-children (get-managed-child parent))
 429            (pos (child-position child managed-children))
 430            (len (max (1- (length managed-children)) 1))
 431            (dx (/ rw len))
 432            (size (or (frame-data-slot parent :tile-size) 0.8)))
 433       (if (> (length managed-children) 1)
 434           (if (= pos 0)
 435               (values (1+ rx)
 436                       (1+ ry)
 437                       (- rw 2)
 438                       (- (round (* rh size)) 2))
 439               (values (1+ (round (+ rx (* dx (1- pos)))))
 440                       (1+ (round (+ ry (* rh size))))
 441                       (- (round dx) 2)
 442                       (- (round (* rh (- 1 size))) 2)))
 443           (no-layout child parent)))))
 444
 445
 446 (defun set-tile-top-layout ()
 447   "Tile Top: main child on top and others on bottom"
 448   (layout-ask-size "Tile size in percent (%)" :tile-size)
 449   (set-layout #'tile-top-layout))
 450
 451
 452
 453
 454 ;;; Tile Bottom
 455 (defun tile-bottom-layout (child parent)
 456   "Tile Bottom: main child on bottom and others on top"
 457   (with-slots (rx ry rw rh) parent
 458     (let* ((managed-children (get-managed-child parent))
 459            (pos (child-position child managed-children))
 460            (len (max (1- (length managed-children)) 1))
 461            (dx (/ rw len))
 462            (size (or (frame-data-slot parent :tile-size) 0.8)))
 463       (if (> (length managed-children) 1)
 464           (if (= pos 0)
 465               (values (1+ rx)
 466                       (1+ (round (+ ry (* rh (- 1 size)))))
 467                       (- rw 2)
 468                       (- (round (* rh size)) 2))
 469               (values (1+ (round (+ rx (* dx (1- pos)))))
 470                       (1+ ry)
 471                       (- (round dx) 2)
 472                       (- (round (* rh (- 1 size))) 2)))
 473           (no-layout child parent)))))
 474
 475
 476
 477 (defun set-tile-bottom-layout ()
 478   "Tile Bottom: main child on bottom and others on top"
 479   (layout-ask-size "Tile size in percent (%)" :tile-size)
 480   (set-layout #'tile-bottom-layout))
 481
 482
 483 (register-layout-sub-menu 'frame-tile-dir-layout-menu "Tile in one direction layout menu"
 484                           '(("l" set-tile-left-layout)
 485                             ("r" set-tile-right-layout)
 486                             ("t" set-tile-top-layout)
 487                             ("b" set-tile-bottom-layout)))
 488
 489
 490
 491
 492
 493
 494 ;;; Left and space layout: like left layout but leave a space on the left
 495 (defun layout-ask-space (msg slot &optional (default 100))
 496   (when (frame-p *current-child*)
 497     (let ((new-space (or (query-number msg (or (frame-data-slot *current-child* slot) default)) default)))
 498       (setf (frame-data-slot *current-child* slot) new-space))))
 499
 500
 501 (defun tile-left-space-layout (child parent)
 502   "Tile Left Space: main child on left and others on right. Leave some space on the left."
 503   (with-slots (rx ry rw rh) parent
 504     (let* ((managed-children (get-managed-child parent))
 505            (pos (child-position child managed-children))
 506            (len (max (1- (length managed-children)) 1))
 507            (dy (/ rh len))
 508            (size (or (frame-data-slot parent :tile-size) 0.8))
 509            (space (or (frame-data-slot parent :tile-left-space) 100)))
 510       (if (> (length managed-children) 1)
 511           (if (= pos 0)
 512               (values (+ rx space 1)
 513                       (1+ ry)
 514                       (- (round (* rw size)) 2 space)
 515                       (- rh 2))
 516               (values (1+ (round (+ rx (* rw size))))
 517                       (1+ (round (+ ry (* dy (1- pos)))))
 518                       (- (round (* rw (- 1 size))) 2)
 519                       (- (round dy) 2)))
 520           (multiple-value-bind (rnx rny rnw rnh)
 521               (no-layout child parent)
 522             (values (+ rnx space)
 523                     rny
 524                     (- rnw space)
 525                     rnh))))))
 526
 527
 528 (defun set-tile-left-space-layout ()
 529   "Tile Left Space: main child on left and others on right. Leave some space on the left."
 530   (layout-ask-size "Tile size in percent (%)" :tile-size)
 531   (layout-ask-space "Tile space" :tile-left-space)
 532   (set-layout #'tile-left-space-layout))
 533
 534 (register-layout-sub-menu 'frame-tile-space-layout-menu "Tile with some space on one side menu"
 535                           '(set-tile-left-space-layout))
 536
 537
 538
 539
 540 ;;; Main windows layout - A possible GIMP layout
 541 ;;;   The windows in the main list are tiled on the frame
 542 ;;;   others windows are on one side of the frame.
 543 (defun main-window-right-layout (child parent)
 544   "Main window right: Main windows on the right. Others on the left."
 545   (with-slots (rx ry rw rh) parent
 546     (let* ((main-windows (frame-data-slot parent :main-window-list))
 547            (len (length main-windows))
 548            (size (or (frame-data-slot parent :tile-size) 0.8)))
 549       (if (zerop len)
 550           (no-layout child parent)
 551           (if (child-member child main-windows)
 552               (let* ((dy (/ rh len))
 553                      (pos (child-position child main-windows)))
 554                 (values (1+ (round (+ rx (* rw (- 1 size)))))
 555                         (1+ (round (+ ry (* dy pos))))
 556                         (- (round (* rw size)) 2)
 557                         (- (round dy) 2)))
 558               (values (1+ rx)
 559                       (1+ ry)
 560                       (- (round (* rw (- 1 size))) 2)
 561                       (- rh 2)))))))
 562
 563 (defun set-main-window-right-layout ()
 564   "Main window right: Main windows on the right. Others on the left."
 565   (layout-ask-size "Split size in percent (%)" :tile-size)
 566   (set-layout #'main-window-right-layout))
 567
 568
 569
 570
 571 (defun main-window-left-layout (child parent)
 572   "Main window left: Main windows on the left. Others on the right."
 573   (with-slots (rx ry rw rh) parent
 574     (let* ((main-windows (frame-data-slot parent :main-window-list))
 575            (len (length main-windows))
 576            (size (or (frame-data-slot parent :tile-size) 0.8)))
 577       (if (zerop len)
 578           (no-layout child parent)
 579           (if (child-member child main-windows)
 580               (let* ((dy (/ rh len))
 581                      (pos (child-position child main-windows)))
 582                 (values (1+ rx)
 583                         (1+ (round (+ ry (* dy pos))))
 584                         (- (round (* rw size)) 2)
 585                         (- (round dy) 2)))
 586               (values (1+ (round (+ rx (* rw size))))
 587                       (1+ ry)
 588                       (- (round (* rw (- 1 size))) 2)
 589                       (- rh 2)))))))
 590
 591 (defun set-main-window-left-layout ()
 592   "Main window left: Main windows on the left. Others on the right."
 593   (layout-ask-size "Split size in percent (%)" :tile-size)
 594   (set-layout #'main-window-left-layout))
 595
 596
 597
 598 (defun main-window-top-layout (child parent)
 599   "Main window top: Main windows on the top. Others on the bottom."
 600   (with-slots (rx ry rw rh) parent
 601     (let* ((main-windows (frame-data-slot parent :main-window-list))
 602            (len (length main-windows))
 603            (size (or (frame-data-slot parent :tile-size) 0.8)))
 604       (if (zerop len)
 605           (no-layout child parent)
 606           (if (child-member child main-windows)
 607               (let* ((dx (/ rw len))
 608                      (pos (child-position child main-windows)))
 609                 (values (1+ (round (+ rx (* dx pos))))
 610                         (1+ ry)
 611                         (- (round dx) 2)
 612                         (- (round (* rh size)) 2)))
 613               (values (1+ rx)
 614                       (1+ (round (+ ry (* rh size))))
 615                       (- rw 2)
 616                       (- (round (* rh (- 1 size))) 2)))))))
 617
 618 (defun set-main-window-top-layout ()
 619   "Main window top: Main windows on the top. Others on the bottom."
 620   (layout-ask-size "Split size in percent (%)" :tile-size)
 621   (set-layout #'main-window-top-layout))
 622
 623
 624
 625 (defun main-window-bottom-layout (child parent)
 626   "Main window bottom: Main windows on the bottom. Others on the top."
 627   (with-slots (rx ry rw rh) parent
 628     (let* ((main-windows (frame-data-slot parent :main-window-list))
 629            (len (length main-windows))
 630            (size (or (frame-data-slot parent :tile-size) 0.8)))
 631       (if (zerop len)
 632           (no-layout child parent)
 633           (if (child-member child main-windows)
 634               (let* ((dx (/ rw len))
 635                      (pos (child-position child main-windows)))
 636                 (values (1+ (round (+ rx (* dx pos))))
 637                         (1+ (round (+ ry (* rh (- 1 size)))))
 638                         (- (round dx) 2)
 639                         (- (round (* rh size)) 2)))
 640               (values (1+ rx)
 641                       (1+ ry)
 642                       (- rw 2)
 643                       (- (round (* rh (- 1 size))) 2)))))))
 644
 645 (defun set-main-window-bottom-layout ()
 646   "Main window bottom: Main windows on the bottom. Others on the top."
 647   (layout-ask-size "Split size in percent (%)" :tile-size)
 648   (set-layout #'main-window-bottom-layout))
 649
 650
 651
 652
 653
 654 (defun add-in-main-window-list ()
 655   "Add the current window in the main window list"
 656   (when (frame-p *current-child*)
 657     (with-current-window
 658       (when (child-member window (get-managed-child *current-child*))
 659         (pushnew window (frame-data-slot *current-child* :main-window-list)))))
 660   (leave-second-mode))
 661
 662
 663 (defun remove-in-main-window-list ()
 664   "Remove the current window from the main window list"
 665   (when (frame-p *current-child*)
 666     (with-current-window
 667       (when (child-member window (get-managed-child *current-child*))
 668         (setf (frame-data-slot *current-child* :main-window-list)
 669               (child-remove window (frame-data-slot *current-child* :main-window-list))))))
 670   (leave-second-mode))
 671
 672 (defun clear-main-window-list ()
 673   "Clear the main window list"
 674   (when (frame-p *current-child*)
 675     (setf (frame-data-slot *current-child* :main-window-list) nil))
 676   (leave-second-mode))
 677
 678
 679
 680
 681 (register-layout-sub-menu 'frame-main-window-layout-menu "Main window layout menu"
 682                           '(("r" set-main-window-right-layout)
 683                             ("l" set-main-window-left-layout)
 684                             ("t" set-main-window-top-layout)
 685                             ("b" set-main-window-bottom-layout)
 686                             "-=- Actions on main windows list -=-"
 687                             ("a" add-in-main-window-list)
 688                             ("v" remove-in-main-window-list)
 689                             ("c" clear-main-window-list)))
 690
 691
 692
 693 (defun select-next/previous-child-no-main-window (fun-rotate)
 694   "Select the next/previous child - Skip windows in main window list"
 695   (when (frame-p *current-child*)
 696     (with-slots (child) *current-child*
 697       (let* ((main-windows (frame-data-slot *current-child* :main-window-list))
 698              (to-skip? (not (= (length main-windows)
 699                                (length child)))))
 700         (labels ((rec ()
 701                    (setf child (funcall fun-rotate child))
 702                    (when (and to-skip?
 703                               (child-member (frame-selected-child *current-child*) main-windows))
 704                      (rec))))
 705           (unselect-all-frames)
 706           (rec)
 707           (show-all-children))))))
 708
 709
 710 (defun select-next-child-no-main-window ()
 711   "Select the next child - Skip windows in main window list"
 712   (select-next/previous-child-no-main-window #'rotate-list))
 713
 714 (defun select-previous-child-no-main-window ()
 715   "Select the previous child - Skip windows in main window list"
 716   (select-next/previous-child-no-main-window #'anti-rotate-list))
 717
 718
 719 (defun mouse-click-to-focus-and-move-no-main-window (window root-x root-y)
 720   "Move and focus the current frame or focus the current window parent.
 721 Or do actions on corners - Skip windows in main window list"
 722   (unless (do-corner-action root-x root-y *corner-main-mode-left-button*)
 723     (if (and (frame-p *current-child*)
 724              (child-member window (frame-data-slot *current-child* :main-window-list)))
 725         (replay-button-event)
 726         (mouse-click-to-focus-generic window root-x root-y #'move-frame))))
 727
 728
 729
 730 (defun set-gimp-layout ()
 731   "The GIMP Layout"
 732   (when (frame-p *current-child*)
 733     ;; Note: There is no need to ungrab/grab keys because this
 734     ;; is done when leaving the second mode.
 735     (define-main-key ("F8" :mod-1) 'add-in-main-window-list)
 736     (define-main-key ("F9" :mod-1) 'remove-in-main-window-list)
 737     (define-main-key ("F10" :mod-1) 'clear-main-window-list)
 738     (define-main-key ("Tab" :mod-1) 'select-next-child-no-main-window)
 739     (define-main-key ("Tab" :mod-1 :shift) 'select-previous-child-no-main-window)
 740     (define-main-mouse (1) 'mouse-click-to-focus-and-move-no-main-window)
 741     (setf (frame-data-slot *current-child* :focus-policy-save)
 742           (frame-focus-policy *current-child*))
 743     (setf (frame-focus-policy *current-child*) :sloppy)
 744     (setf (frame-data-slot *current-child* :layout-save)
 745           (frame-layout *current-child*))
 746     ;; Set the default layout and leave the second mode.
 747     (set-main-window-right-layout)))
 748
 749
 750 (defun set-previous-layout ()
 751   "Restore the previous layout"
 752   (undefine-main-key ("F8" :mod-1))
 753   (undefine-main-key ("F9" :mod-1))
 754   (undefine-main-key ("F10" :mod-1))
 755   (define-main-key ("Tab" :mod-1) 'select-next-child)
 756   (define-main-key ("Tab" :mod-1 :shift) 'select-previous-child)
 757   (define-main-mouse (1) 'mouse-click-to-focus-and-move)
 758   (setf (frame-focus-policy *current-child*)
 759         (frame-data-slot *current-child* :focus-policy-save))
 760   (setf (frame-layout *current-child*)
 761         (frame-data-slot *current-child* :layout-save))
 762   (leave-second-mode))
 763
 764
 765 (defun help-on-gimp-layout ()
 766   "Help on the GIMP layout"
 767   (info-mode `(("-=- Help on The GIMP layout -=-" ,*info-color-title*)
 768                ""
 769                "The GIMP layout is a main-window-layout with a sloppy focus policy."
 770                "You can change the main windows direction with the layout menu."
 771                ""
 772                "Press Alt+F8 to add a window to the main windows list."
 773                "Press Alt+F9 to remove a window from the main windows list."
 774                "Press Alt+F10 to clear the main windows list."
 775                ""
 776                "You can select a main window with the right mouse button."
 777                ""
 778                "Use the layout menu to restore the previous layout and keybinding."))
 779   (leave-second-mode))
 780
 781
 782 (register-layout-sub-menu 'frame-gimp-layout-menu "The GIMP layout menu"
 783                           '(("g" set-gimp-layout)
 784                             ("p" set-previous-layout)
 785                             ("h" help-on-gimp-layout)
 786                             "-=- Main window layout -=-"
 787                             ("r" set-main-window-right-layout)
 788                             ("l" set-main-window-left-layout)
 789                             ("t" set-main-window-top-layout)
 790                             ("b" set-main-window-bottom-layout)
 791                             "-=- Actions on main windows list -=-"
 792                             ("a" add-in-main-window-list)
 793                             ("v" remove-in-main-window-list)
 794                             ("c" clear-main-window-list)))
 795
 796