Last active
March 15, 2025 15:07
-
-
Save pervognsen/ee74944453cdc4b809cb to your computer and use it in GitHub Desktop.
Dynamic tiling window manager for Emacs (inspired by dwm/awesome/xmonad for Linux)
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
; This code is hereby released by its author (Per Vognsen) into the public domain. | |
; It's mostly a proof of concept though it was surprisingly usable for how simple it was to code. | |
; If you want to use it as a starting point for a more polished package, go right ahead. | |
(require 'cl) | |
(defstruct wm-window buffer (point 0) (start 0) (hscroll 0) dedicated) | |
(defvar wm-windows) | |
(defvar wm-windows-alist) | |
(defvar wm-focus) | |
(defvar wm-workspace 0) | |
(defvar wm-workspaces nil) | |
(defvar wm-layout 0) | |
(defvar wm-layouts '(wm-layout-stacked-columns | |
wm-layout-stacked-rows | |
wm-layout-grid | |
wm-layout-bisection | |
wm-layout-fullscreen)) | |
(defmacro wm-when-let (binding &rest body) | |
(declare (indent 1)) | |
`(let ((,(first binding) ,(second binding))) | |
(when ,(first binding) | |
,@body))) | |
(defun wm-window-from-emacs-window (window) | |
(make-wm-window :buffer (window-buffer window) | |
:point (window-point window) | |
:start (window-start window) | |
:hscroll (window-hscroll window) | |
:dedicated (window-dedicated-p window))) | |
(defun wm-window-from-buffer (buffer) | |
(make-wm-window :buffer buffer)) | |
(defun wm-restore-window (window) | |
(set-window-buffer nil (wm-window-buffer window)) | |
(set-window-point nil (wm-window-point window)) | |
(set-window-start nil (wm-window-start window)) | |
(set-window-hscroll nil (wm-window-hscroll window)) | |
(set-window-dedicated-p nil (wm-window-dedicated window))) | |
(defun wm-emacs-windows () | |
(window-list nil nil (frame-first-window))) | |
(defun wm-update-windows () | |
(dolist (window (wm-emacs-windows)) | |
(wm-when-let (kv (assoc window wm-windows-alist)) | |
(setf (nth (cdr kv) wm-windows) (wm-window-from-emacs-window window))))) | |
(defun wm-update-focus () | |
(wm-when-let (kv (assoc (selected-window) wm-windows-alist)) | |
(setq wm-focus (cdr kv)))) | |
(defun wm-status () | |
(let ((status "")) | |
(dotimes (n (length wm-windows)) | |
(let ((focused (= n wm-focus)) | |
(window (nth n wm-windows))) | |
(setq status (format "%s%-20s" | |
status | |
(concat (if focused "[" " ") | |
(format "%d: %s" (1+ n) (buffer-name (wm-window-buffer window))) | |
(if focused "] " " ")))))) | |
(format "%-35s %s" (format "<%d> %s: " (1+ wm-workspace) (symbol-name (nth wm-layout wm-layouts))) status))) | |
(defun wm-display-status () | |
(let ((message-log-max nil) | |
(message-truncate-lines t)) | |
(message (wm-status)))) | |
(defun wm-reset-layout () | |
(delete-other-windows) | |
(split-window) | |
(other-window 1) | |
(delete-other-windows)) | |
(defun wm-layout-fullscreen () | |
(wm-reset-layout) | |
(wm-restore-window (nth wm-focus wm-windows)) | |
(setq wm-windows-alist (list (cons (selected-window) wm-focus)))) | |
(defun wm-layout-grid () | |
(wm-reset-layout) | |
(let* ((n 0) | |
(len (length wm-windows)) | |
(sqrt-len (truncate (sqrt len))) | |
(dim (if (= len (* sqrt-len sqrt-len)) sqrt-len (1+ sqrt-len)))) | |
(dotimes (y (1- (/ (+ len (1- dim)) dim))) | |
(split-window-vertically)) | |
(while (< n len) | |
(dotimes (x dim) | |
(when (< n len) | |
(wm-restore-window (nth n wm-windows)) | |
(incf n)) | |
(when (and (< x (1- dim)) (< n len)) | |
(split-window-horizontally) | |
(other-window 1))) | |
(other-window 1))) | |
(balance-windows) | |
(other-window wm-focus) | |
(let ((n -1)) | |
(setq wm-windows-alist (mapcar (lambda (window) (cons window (incf n))) | |
(wm-emacs-windows))))) | |
(defun wm-layout-bisection () | |
(wm-reset-layout) | |
(dotimes (n (length wm-windows)) | |
(wm-restore-window (nth n wm-windows)) | |
(when (< n (1- (length wm-windows))) | |
(funcall (nth (mod n 2) '(split-window-horizontally split-window-vertically))) | |
(other-window 1))) | |
(other-window (1+ wm-focus)) | |
(balance-windows) | |
(let ((n -1)) | |
(setq wm-windows-alist (mapcar (lambda (window) (cons window (incf n))) | |
(wm-emacs-windows))))) | |
(defun wm-layout-stacked-columns () | |
(wm-reset-layout) | |
(wm-restore-window (first wm-windows)) | |
(when (rest wm-windows) | |
(split-window-horizontally) | |
(other-window 1) | |
(loop for (window . more-windows) on (rest wm-windows) | |
do (progn | |
(wm-restore-window window) | |
(when more-windows | |
(split-window-vertically) | |
(other-window 1)))) | |
(balance-windows) | |
(other-window (1+ wm-focus))) | |
(let ((n -1)) | |
(setq wm-windows-alist (mapcar (lambda (window) (cons window (incf n))) | |
(wm-emacs-windows))))) | |
(defun wm-layout-stacked-rows () | |
(wm-reset-layout) | |
(wm-restore-window (first wm-windows)) | |
(when (rest wm-windows) | |
(split-window-vertically) | |
(other-window 1) | |
(loop for (window . more-windows) on (rest wm-windows) | |
do (progn | |
(wm-restore-window window) | |
(when more-windows | |
(split-window-horizontally) | |
(other-window 1)))) | |
(balance-windows) | |
(other-window (1+ wm-focus))) | |
(let ((n -1)) | |
(setq wm-windows-alist (mapcar (lambda (window) (cons window (incf n))) | |
(wm-emacs-windows))))) | |
(defun wm-update-layout () | |
(wm-update-windows) | |
(funcall (nth wm-layout wm-layouts)) | |
(wm-display-status)) | |
(defun wm-cycle-layout () | |
(interactive) | |
(when (= (incf wm-layout) (length wm-layouts)) | |
(setq wm-layout 0)) | |
(wm-update-focus) | |
(wm-update-windows) | |
(wm-update-layout)) | |
(defun wm-focus-next-window () | |
(interactive) | |
(wm-update-windows) | |
(wm-update-focus) | |
(if (assoc (selected-window) wm-windows-alist) | |
(when (= (incf wm-focus) (length wm-windows)) | |
(setq wm-focus 0)) | |
(other-window 1) | |
(wm-update-focus)) | |
(wm-update-layout)) | |
(defun wm-focus-previous-window () | |
(interactive) | |
(wm-update-windows) | |
(wm-update-focus) | |
(if (assoc (selected-window) wm-windows-alist) | |
(when (= (decf wm-focus) -1) | |
(setq wm-focus (1- (length wm-windows)))) | |
(other-window -1) | |
(wm-update-focus)) | |
(wm-update-layout)) | |
(defun wm-remove-nth (n lst) | |
(when lst | |
(if (zerop n) | |
(rest lst) | |
(cons (first lst) (wm-remove-nth (1- n) (rest lst)))))) | |
(defun wm-delete (n) | |
(when (and (> (length wm-windows) 1) (< n (length wm-windows))) | |
(setq wm-windows (wm-remove-nth n wm-windows)) | |
(setq wm-windows-alist nil) | |
(when (= wm-focus (length wm-windows)) | |
(decf wm-focus))) | |
(wm-update-layout)) | |
(defun wm-insert-nth (lst n val) | |
(if (= n 0) | |
(cons val lst) | |
(cons (first lst) (wm-insert-nth (rest lst) (1- n) val)))) | |
(defun wm-insert (window n) | |
(wm-update-focus) | |
(wm-update-windows) | |
(setq wm-windows (wm-insert-nth wm-windows n window)) | |
(setq wm-windows-alist nil) | |
(when (>= wm-focus n) | |
(incf wm-focus)) | |
(wm-update-layout)) | |
(defun wm-push-window () | |
(interactive) | |
(wm-update-focus) | |
(wm-update-windows) | |
(setq wm-windows (append wm-windows (list (wm-window-from-emacs-window (selected-window))))) | |
(setq wm-windows-alist nil) | |
(wm-update-layout)) | |
(defun wm-insert-window () | |
(interactive) | |
(wm-update-focus) | |
(wm-update-windows) | |
(wm-insert (wm-window-from-emacs-window (selected-window)) (1+ wm-focus))) | |
(defun wm-pop-window () | |
(interactive) | |
(wm-delete (1- (length wm-windows)))) | |
(defun wm-delete-next-window () | |
(interactive) | |
(wm-update-focus) | |
(if (assoc (next-window) wm-windows-alist) | |
(wm-delete (mod (1+ wm-focus) (length wm-windows))) | |
(delete-window (next-window)))) | |
(defun wm-delete-window () | |
(interactive) | |
(wm-update-focus) | |
(if (assoc (selected-window) wm-windows-alist) | |
(wm-delete wm-focus) | |
(delete-window))) | |
(defun wm-move-window-forward () | |
(interactive) | |
(wm-update-windows) | |
(wm-update-focus) | |
(when (< (1+ wm-focus) (length wm-windows)) | |
(rotatef (nth wm-focus wm-windows) (nth (1+ wm-focus) wm-windows)) | |
(setq wm-windows-alist nil) | |
(setq wm-focus (1+ wm-focus))) | |
(wm-update-layout)) | |
(defun wm-move-window-backward () | |
(interactive) | |
(wm-update-windows) | |
(wm-update-focus) | |
(when (> wm-focus 0) | |
(rotatef (nth wm-focus wm-windows) (nth (1- wm-focus) wm-windows)) | |
(setq wm-windows-alist nil) | |
(setq wm-focus (1- wm-focus))) | |
(wm-update-layout)) | |
(defun wm-move-window-to-back () | |
(interactive) | |
(wm-update-focus) | |
(wm-update-windows) | |
(wm-push-window) | |
(wm-delete-window) | |
(setq wm-focus (1- (length wm-windows))) | |
(wm-update-layout)) | |
(defun wm-move-window-to-front () | |
(interactive) | |
(wm-update-windows) | |
(wm-insert (wm-window-from-emacs-window (selected-window)) 0) | |
(wm-delete-window) | |
(setq wm-focus 0) | |
(wm-update-layout)) | |
(defun wm-focus-window (n) | |
(interactive "p") | |
(when (< n (length wm-windows)) | |
(setq wm-focus n)) | |
(wm-update-layout)) | |
(defun wm-manage-windows () | |
(interactive) | |
(setq wm-focus (position (selected-window) (wm-emacs-windows))) | |
(setq wm-windows (mapcar 'wm-window-from-emacs-window (wm-emacs-windows))) | |
(setq wm-windows-alist nil) | |
(wm-update-layout)) | |
(defun wm-restore-workspace (layout focus windows) | |
(setq wm-layout layout) | |
(setq wm-focus focus) | |
(setq wm-windows windows) | |
(setq wm-windows-alist nil) | |
(wm-update-layout)) | |
(defun wm-save-workspace (workspace) | |
(wm-update-focus) | |
(wm-update-windows) | |
(unless (assoc workspace wm-workspaces) | |
(push (cons workspace nil) wm-workspaces)) | |
(setf (cdr (assoc workspace wm-workspaces)) (list wm-layout wm-focus wm-windows))) | |
(defun wm-switch-workspace (workspace) | |
(wm-save-workspace wm-workspace) | |
(unless (assoc workspace wm-workspaces) | |
(push (cons workspace (list wm-layout 0 (list (wm-window-from-emacs-window (selected-window))))) wm-workspaces)) | |
(let ((state (cdr (assoc workspace wm-workspaces)))) | |
(setq wm-workspace workspace) | |
(wm-restore-workspace (first state) (second state) (third state)))) | |
(define-minor-mode wm-mode | |
nil | |
:init-value t | |
:global t | |
:keymap (let ((keymap (make-sparse-keymap))) | |
(define-key keymap (kbd "M-RET") 'wm-cycle-layout) | |
(define-key keymap (kbd "C-=") 'wm-push-window) | |
(define-key keymap (kbd "C-+") 'wm-insert-window) | |
(define-key keymap (kbd "C--") 'wm-pop-window) | |
(define-key keymap (kbd "C-_") 'wm-delete-next-window) | |
(define-key keymap (kbd "C-0") 'wm-delete-window) | |
(define-key keymap (kbd "C-]") 'wm-move-window-backward) | |
(define-key keymap (kbd "C-\\") 'wm-move-window-forward) | |
(define-key keymap (kbd "C-}") 'wm-move-window-to-front) | |
(define-key keymap (kbd "C-|") 'wm-move-window-to-back) | |
(define-key keymap (kbd "C-<tab>") 'wm-focus-next-window) | |
(define-key keymap (kbd "C-S-<tab>") 'wm-focus-previous-window) | |
(define-key keymap (kbd "M-1") (lambda () (interactive) (wm-focus-window 0))) | |
(define-key keymap (kbd "M-2") (lambda () (interactive) (wm-focus-window 1))) | |
(define-key keymap (kbd "M-3") (lambda () (interactive) (wm-focus-window 2))) | |
(define-key keymap (kbd "M-4") (lambda () (interactive) (wm-focus-window 3))) | |
(define-key keymap (kbd "M-5") (lambda () (interactive) (wm-focus-window 4))) | |
(define-key keymap (kbd "M-6") (lambda () (interactive) (wm-focus-window 5))) | |
(define-key keymap (kbd "M-7") (lambda () (interactive) (wm-focus-window 6))) | |
(define-key keymap (kbd "M-8") (lambda () (interactive) (wm-focus-window 7))) | |
(define-key keymap (kbd "M-9") (lambda () (interactive) (wm-focus-window 8))) | |
(define-key keymap (kbd "<f1>") (lambda () (interactive) (wm-switch-workspace 0))) | |
(define-key keymap (kbd "<f2>") (lambda () (interactive) (wm-switch-workspace 1))) | |
(define-key keymap (kbd "<f3>") (lambda () (interactive) (wm-switch-workspace 2))) | |
(define-key keymap (kbd "<f4>") (lambda () (interactive) (wm-switch-workspace 3))) | |
keymap) | |
(wm-manage-windows)) | |
(provide 'wm) | |
;;; wm.el ends here |
cl
is obsolete, why not just use cl-lib
?
The last time I touched this code was in 2014 and it wasn't intended as a public release. I don't use Emacs anymore, but I always used cl instead of cl-lib in my own private code because I don't want to have to add verbose prefixes to basic functions/macros. In publicly released libraries that are intended to interop with arbitrary code, sure, do the right thing and follow the now-standard prefix convention for packages to avoid namespace pollution/clashes, but like I said this was just some private code I posted for a few friends to check out.
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
This is really cool and it is usable (in fact I'm going to use it).
However, I think that the proper way to implement this is via
display-buffer-alist
.