Skip to content
Browse files

Initial contents

  • Loading branch information...
0 parents commit 6c85586009df2ac72ae39bcf5096f8f027f09a19 @jaor committed
Showing with 334 additions and 0 deletions.
  1. +30 −0 README.org
  2. +16 −0 tile.jl
  3. +48 −0 tile/col.jl
  4. +90 −0 tile/tall.jl
  5. +64 −0 tile/tiler.jl
  6. +69 −0 tile/utils.jl
  7. +17 −0 utils.jl
30 README.org
@@ -0,0 +1,30 @@
+* Sawflibs
+
+ A collection of libraries for Sawfish.
+
+** sawflibs.tile
+
+ Tilings for your workspaces.
+
+ Sample usage:
+
+ (require 'sawflibs.tile)
+ (tall-tiling 3 #:width 2 #:top 0 #:bottom 1 #:gap 1 #:max 3)
+ (tall-tiling 1 #:width 3 #:top 20 #:bottom 3 #:gap 1 #:max 2 #:auto #f)
+ ;; we can have more than one tiling per workspace, and
+ ;; switch among them with 'next-tiling':
+ (tall-tiling 0 #:width 3 #:top 20 #:bottom 20 #:gap 1 #:max 2 #:auto #f)
+ (col-tiling 0 #:cols 3 #:gap 2 #:top 40 #:bottom 20)
+
+ (bind-keys global-keymap
+ "F12" 'tile-workspace
+ "Super-=" 'increase-max-windows
+ "Super--" 'decrease-max-windows
+ "Super-Space" 'next-tiling)
+
+*** sawflibs.util
+
+ Utility functions for rep programming.
+
+ - take N LST
+ - group-by LST N
16 tile.jl
@@ -0,0 +1,16 @@
+
+(define-structure sawflibs.tile
+ (export align-workspace-windows
+ tile-workspace
+ next-tiling
+ increase-max-windows
+ decrease-max-windows
+ tall-tiling
+ col-tiling)
+ (open rep
+ rep.system
+ sawflibs.tile.utils
+ sawflibs.tile.tiler
+ sawflibs.tile.tall
+ sawflibs.tile.col))
+
48 tile/col.jl
@@ -0,0 +1,48 @@
+
+(define-structure sawflibs.tile.col
+ (export col-tiling)
+ ;; increase-cols
+ ;; decrease-cols)
+ (open rep
+ rep.system
+ sawflibs.utils
+ sawflibs.tile.tiler
+ sawflibs.tile.utils)
+
+ (define (col-tiling ws #!key (top 0) (bottom 0) (cols 3) (gap 1) (auto #f))
+ (register-workspace-tiler ws col-tiler (list cols top bottom gap) auto))
+
+ (define (cols) (setting 0))
+ (define (top-m) (setting 1))
+ (define (bottom-m) (setting 2))
+ (define (gap) (setting 3))
+
+ (define (col-tiler focused deleted)
+ (let ((windows (workspace-windows deleted)))
+ (when (> (length windows) 0)
+ (let* ((master (or focused (input-focus) (car windows)))
+ (windows (cons master (delete master windows)))
+ (groups (group-by windows (cols))))
+ (mapc make-column groups)))))
+
+ (define (make-column windows)
+ (let* ((min-y (top-m))
+ (max-y (max (scr-height (window-height (last windows)) (bottom-m))
+ min-y))
+ (max-h (scr-height (top-m) (bottom-m)))
+ (dy (floor (/ (- max-y min-y) (1- (cols)))))
+ (dx (floor (/ (scr-width (* (1+ (cols)) (gap))) (cols)))))
+ (push-column windows (gap) min-y dx dy (gap) max-h)))
+
+ (define (push-column ws x y dx dy g max-h)
+ (when (not (null ws))
+ (push-window (car ws) x y dx (min (window-height (car ws)) max-h))
+ (push-column (cdr ws) (+ x dx g) (+ y dy) dx dy g max-h)))
+
+ (define (increase-cols)
+ (interactive)
+ #t)
+
+ (define (decrease-cols)
+ (interactive)
+ #t))
90 tile/tall.jl
@@ -0,0 +1,90 @@
+;; Description: Handles tiling of all windows on a given workspace to
+;; maintain them aligned with a main pane in the left and the others
+;; stacked on the right.
+;;
+;; Author: Jose A. Ortega Ruiz <jao@gnu.org>
+;; Inspiraton: smart-tile by Mark Triggs <mst@dishevelled.net>
+;;
+;; Usage:
+;; (require 'sawflibs.tile.tall)
+;; (tall-tiling 3 #:width 2 #:top 0 #:bottom 1 #:gap 1 #:max 3)
+;; (tall-tiling 1 #:width 3 #:top 20 #:bottom 3 #:gap 1 #:auto #f)
+;; (bind-keys global-keymap "M-=" 'increase-max-windows)
+;; (bind-keys global-keymap "M--" 'decrease-max-windows)
+;;
+
+(define-structure sawflibs.tile.tall
+ (export tall-tiling
+ increase-max-windows
+ decrease-max-windows)
+ (open rep
+ rep.system
+ sawflibs.utils
+ sawflibs.tile.tiler
+ sawflibs.tile.utils)
+
+ (define (tall-tiling n #!key
+ (width 2) (top 0) (bottom 0) (gap 0) (max 2) (auto t))
+ (register-workspace-tiler n
+ tall-tiler
+ (list width top bottom gap max)
+ auto))
+
+ (define (master-width f) (floor (1- (/ (scr-width) f))))
+
+ (define (child-height total tm bm)
+ (floor (/ (scr-height tm bm) (if (> total 0) total 1))))
+
+ (define (push-children children x y min-y w dy)
+ (define (top-y)
+ (if (and (null (cdr children)) (>= min-y 0)) min-y y))
+ (when (not (null children))
+ (push-window (car children) x (top-y) w dy)
+ (push-children (cdr children) x (- y dy) min-y w dy)))
+
+ (define (tall-tiler master ignore)
+ (let ((windows (workspace-windows ignore)))
+ (when (> (length windows) 0)
+ (let* ((master (or master (input-focus) (car windows)))
+ (master (if (eq master ignore) (car windows) master))
+ (children (remove master windows))
+ (lc (length children))
+ (cno (if (> (setting 4) 1) (min (1- (setting 4)) lc) lc))
+ (groups (reverse (group-by children cno)))
+ (tm (setting 1))
+ (bm (setting 2))
+ (gap (setting 3))
+ (m-width (master-width (setting 0)))
+ (c-height (child-height cno tm bm))
+ (c-width (scr-width m-width (* 3 gap) 1)))
+ (mapc (lambda (g)
+ (push-children (reverse g)
+ (+ m-width (* 2 gap))
+ (scr-height c-height bm)
+ (if (= (length g) cno) tm -1)
+ c-width
+ c-height))
+ groups)
+ (push-window master gap tm m-width (scr-height tm bm))))))
+
+ (define (ws-inc-max ws delta)
+ (let ((old (setting 4 #f ws)))
+ (when old
+ (let ((no (+ old delta)))
+ (when (> no 1)
+ (set-setting 4 no ws)
+ no)))))
+
+ (define (change-max-windows delta)
+ (let ((n (ws-inc-max current-workspace delta)))
+ (when n
+ (tall-tiler nil nil)
+ (notify "Maximum windows set to %s" n))))
+
+ (define (increase-max-windows)
+ (interactive)
+ (change-max-windows 1))
+
+ (define (decrease-max-windows)
+ (interactive)
+ (change-max-windows -1)))
64 tile/tiler.jl
@@ -0,0 +1,64 @@
+(define-structure sawflibs.tile.tiler
+ (export tile-workspace
+ register-workspace-tiler
+ next-tiling
+ setting
+ set-setting)
+ (open rep
+ rep.system
+ sawflibs.tile.utils)
+
+ (define %tilers '())
+
+ (define (register-workspace-tiler ws tiler args auto)
+ (let ((curr (assoc ws %tilers))
+ (new (list tiler args auto)))
+ (if (null curr)
+ (setq %tilers (cons (cons ws (list new) %tilers)))
+ (setcdr curr (cons new (cdr curr))))))
+
+ (define (next-tiling)
+ (interactive)
+ (when (rotate-tiling) (tile-workspace)))
+
+ (define (rotate-tiling #!optional ws)
+ (let ((ts (assoc (or ws current-workspace) %tilers)))
+ (when (> (length ts) 2)
+ (setcdr ts `(,@(cddr ts) ,(cadr ts))))))
+
+ (define (tilings #!optional ws)
+ (cdr (assoc (or ws current-workspace) %tilers)))
+
+ (define (tiling #!optional ws)
+ (car (tilings ws)))
+
+ (define (tiling-tiler ti) (nth 0 ti))
+ (define (tiling-auto-p ti) (nth 2 ti))
+ (define (tiling-settings ti) (nth 1 ti))
+
+ (define (tile-workspace #!optional new-window destroyed-window)
+ (interactive)
+ (let ((ti (tiling)))
+ (when ti ((tiling-tiler ti) new-window destroyed-window))))
+
+ (define (tileable-window-p w)
+ (and (tiling-auto-p (tiling (window-workspace w)))
+ (eq (window-type w) 'default)))
+
+ (define (add-autotile w)
+ (when (tileable-window-p w)
+ (tile-workspace w)))
+
+ (define (destroy-autotile w)
+ (when (tileable-window-p w)
+ (tile-workspace nil w)))
+
+ (define (setting n #!optional def ws)
+ (or (nth n (tiling-settings (tiling ws))) def))
+
+ (define (set-setting n v #!optional ws)
+ (let ((s (tiling-settings (tiling ws))))
+ (when s (rplaca (nthcdr n s) v))))
+
+ (add-hook 'after-add-window-hook add-autotile t)
+ (add-hook 'destroy-notify-hook destroy-autotile t))
69 tile/utils.jl
@@ -0,0 +1,69 @@
+;; Utilities for window placement and tiling
+
+(define-structure sawflibs.tile.utils
+ (export current-workspace
+ window-workspace
+ workspace-windows
+ window-type
+ window-x
+ window-y
+ window-width
+ window-height
+ scr-height
+ scr-width
+ push-window
+ input-focus
+ align-workspace-windows
+ notify)
+ (open rep
+ rep.io.timers
+ sawfish.wm.stacking
+ sawfish.wm.state.ignored
+ sawfish.wm.windows
+ sawfish.wm.frames
+ sawfish.wm.placement
+ sawfish.wm.workspace
+ sawfish.wm.util.window-order
+ sawfish.wm.misc)
+
+ (define (window-workspace w) (car (window-get w 'workspaces)))
+
+ (define (workspace-windows ignore)
+ (remove-if (lambda (w) (or (equal w ignore) (window-ignored-p w)))
+ (window-order current-workspace)))
+
+ (define (window-x w) (car (window-position w)))
+ (define (window-y w) (cdr (window-position w)))
+ (define (window-width w) (car (window-frame-dimensions w)))
+ (define (window-height w) (cdr (window-frame-dimensions w)))
+ (define (scr-height #!optional (tm 0) (bm 0)) (- (screen-height) tm bm))
+ (define (scr-width #!optional (l 0) (r 0) (g 0)) (- (screen-width) l r g))
+
+ (define (resize-frame-to w width height)
+ (let ((width-offset (- (car (window-frame-dimensions w))
+ (car (window-dimensions w))))
+ (height-offset (- (cdr (window-frame-dimensions w))
+ (cdr (window-dimensions w)))))
+ (resize-window-to w (- width width-offset) (- height height-offset))))
+
+ (define (push-window w x y width height)
+ (resize-frame-to w width height)
+ (move-window-to w x y)
+ (window-order-push w))
+
+ (define (align-workspace-windows)
+ (interactive)
+ (let* ((fw (input-focus))
+ (windows (workspace-windows fw))
+ (x (window-x fw))
+ (y (window-y fw)))
+ (mapc (lambda (w)
+ (push-window w x y (window-width w) (window-height w)))
+ windows)))
+
+ (define %hide-timer (make-timer (lambda (tm) (display-message nil))))
+
+ (define (notify fmt #!rest args)
+ (display-message (apply format (cons nil (cons fmt args))))
+ (set-timer %hide-timer 1)))
+
17 utils.jl
@@ -0,0 +1,17 @@
+;; General utilities
+
+(define-structure sawflibs.utils
+ (export take group-by)
+ (open rep)
+
+ (define (take n l)
+ (cond ((null l) '())
+ ((<= n 0) '())
+ ((= 1 n) (list (car l)))
+ (t (cons (car l) (take (- n 1) (cdr l))))))
+
+ (define (group-by ws n)
+ (cond ((null ws) ws)
+ ((< n 1) (list ws))
+ ((<= (length ws) n) (list ws))
+ (t (cons (take n ws) (group-by (nthcdr n ws) n))))))

0 comments on commit 6c85586

Please sign in to comment.
Something went wrong with that request. Please try again.