Dynamic tiling window manager for Emacs (inspired by dwm/awesome/xmonad for Linux)

wm.el

(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