emacs window manager

[grischka]

Since someone told me that emacs has a tiling window manager but
all I could find was tiled windows, I eventually wrote s manager.

Note that this is experimental code meant to play with.  Some might
find it useful though.

--- grischka

;; -------------------------------------------------------------
;; ewm.el - emacs window manager
;;
;; An experimental proof-of-concept for an emacs window manager
;; with strict content->window association
;;
;; Copyright (C) 2010 grischka
;;
;;
;; This file is free software: you can redistribute it and/or modify it under
;; the terms of the GNU General Public License as published by the Free
;; Software Foundation, either version 2 of the License, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
;; more details.


;; Quick Start:
;; ------------
;;   Visit ewm.el and type 'M-x eval-buffer RET'
;;
;;
;; Key Summary:
;; ------------
;;   Ctrl-1 - toggle sidebar-1
;;   Ctrl-2 - toggle sidebar-2
;;   Ctrl-3 - toggle sidebar-3
;;   Ctrl-4 - toggle compile window
;;   Ctrl-5 - toggle top left window
;;   Ctrl-6 - toggle top right window
;;   Ctrl-7 - toggle primary edit window
;;   Ctrl-8 - toggle secondary edit window
;;   Ctrl-9 - toggle info window
;;
;;   Ctrl-0 - refresh layout
;;   Ctrl-F4 - kill active buffer
;;
;;   F1 - info
;;   F2 - switch window
;;   F3 - switch frame
;;   F7 - save and reload ewm.el
;;   F9 - compilation
;;
;;
;; Example layout:
;; ---------------
;;   The example layout (below) and bindings are ment to give the
;;   following behaviour:
;;
;;   A speedbar is created in the sidebar
;;
;;   "*compilation*" is shown in a full-width bottom pane
;;   "*Help* and "Buffer List" are shown in top panes
;;
;;   "*info*" and "*grep*"  are shown on a second frame
;;   "*About GNU Emacs*" is shown on a third frame
;;
;;   Other buffers are shown in the 'edit' window on the main frame
;;
;;
;; How it works:
;; -------------
;;   ewm provide two main interfaces:
;;    - ewm-display-buffer
;;    - ewm-hide-buffer
;;
;;   emacs own functions such as 'display-buffer',  'switch-to-window'
;;   'kill/bury-buffer' are advised to use the two interfaces above.
;;
;;   When asked to display some buffer, ewm looks for a suitable window
;;   in 'ewm-window-bindings.  This window is then marked as active
;;   and the buffer is added on top of the window's buffer stack.
;;
;;   To hide some buffer, ewm removes ot from the window's buffer
;;   stack.  If the stack is empty, the window is marked not active.
;;
;;   After any change, an emacs window-tree with the active windows
;;   is built accordingly to the layout in 'ewm-window-layout'.
;;   Frames are created if necessary.  Frames without active windows
;;   are deleted.
;;
;;   ewm is based on the thought that on a shared, tiled screen only
;;   a central instance is able to coordinate the display for packages
;;   and features and to decide where to display what.
;;
;;   ewm is experimental because any calls to the emacs window
;;   interface ('split-window', 'set-window-buffer', etc). from
;;   code other than ewm itself is contraproductive to the concept.


;; Not implemented:
;; ----------------
;;   Manual resize or layout changes by the user are not recorded.


;; -------------------------------------------------------------
;; Layout definition - Welcome to play with this.

(defun ewm-set-layout ()

  ;; the layout tree (frames and windows) -- sizes in percent
  (setq ewm-window-layout '(
    (frame-1
     (div-rows
      (30 div-cols
          (65 top-1)
          (35 top-2)
          )
      (55 div-cols
          (25 div-rows
              (50 side-1)
              (25 side-2)
              (25 side-3)
              )
          (75 div-rows
              (50 edit-1)
              (50 edit-2)
              )
          )
      (15 tools)
      ))
    (frame-2
     (info)
     )
    (frame-3
     (about)
     )
   ))

  ;; frame layout
  (setq ewm-frame-layout '(
    (frame-1
     :params ((left . 10) (top . 26) (width . 90) (height . 64))
     :default t
     )
    (frame-2
     :params ((left . 700) (top . 26) (width . 66) (height . 40))
     )
    (frame-3
     :params ((left . 250) (top . 150) (width . 72) (height . 42))
     )
    ))

  ;; buffer to window association
  (setq ewm-window-bindings (copy-tree '(
    (side-1
     :classes ("*side-1*" "*SPEEDBAR*")
     )
    (side-2
     :classes ("*side-2*" " *undo-tree*")
     ;; -> http://www.emacswiki.org/emacs/UndoTree
     )
    (side-3
     :classes ("*side-3*")
     )
    (edit-1 ;; primary general purpose window
     :classes ("*scratch*" *)
     )
    (edit-2 ;; secondary general purpose window
     :classes ("*scratch*" *)
     )
    (top-1
     :classes ("*Help*" "*eproject*")
     ;; -> http://www.emacswiki.org/emacs/eproject
     )
    (top-2
     :classes ("*Buffer List*")
     )
    (tools
     :classes ("*compilation*" "*Completions*" "*Messages*")
     )
    (info
     :classes ("*info*" "*grep*")
     )
    (about
     :classes ("*GNU Emacs*" "*About GNU Emacs*" "^.*THE-GNU-PROJECT")
     ;; strings starting witn ^ are matched as regular expression
     )
   )))
)

;; -------------------------------------------------------------
;; bind some keys for testing

(dolist (k '(

  ;; toggle some windows
  ([?\C-1]  (ewm-toggle 'side-1))
  ([?\C-2]  (ewm-toggle 'side-2))
  ([?\C-3]  (ewm-toggle 'side-3))
  ([?\C-4]  (ewm-toggle 'tools))
  ([?\C-5]  (ewm-toggle 'top-1))
  ([?\C-6]  (ewm-toggle 'top-2))
  ([?\C-7]  (ewm-toggle 'edit-1))
  ([?\C-8]  (ewm-toggle 'edit-2))
  ([?\C-9]  (ewm-toggle 'info))

  ;; for convenience and demonstration
  ([?\C-0]  (ewm-update)) ;; refresh layout
  ([C-f4]   (kill-buffer nil)) ;; kill active buffer
  ([f7]     (ewm-reload)) ;; save and reload this file

  ([f1]     (info "(emacs)")) ;; show info
  ([f9]     (compile "echo \"hello world\"")) ;; show compilation

  ;; switch focus
  ([f2]     (other-window 1)) ;; focus next window
  ([S-f2]   (other-window -1)) ;; focus previous window
  ([f3]     (other-frame 1)) ;; focus next frame
  ([S-f3]   (other-frame -1)) ;; focus previous
  ))

  (global-set-key (car k) `(lambda () (interactive) ,@(cdr k)))
  )

;; -------------------------------------------------------------

;; -------------------------------------------------------------
;; implementation

;; make div or window
(defun ewm-make-elem (w e c)
  (let (a b)
    (cond ((eq (car e) 'div-cols)
           (ewm-make-div w t (cdr e) c)
           )
          ((eq (car e) 'div-rows)
           (ewm-make-div w nil (cdr e) c)
           )
          ((setq a (assoc (car e) c))
           (push (cons (car a) w) ewm-window-handles)
           (setq b (ewm-get-buffer (cdr a) t))
           (set-window-buffer w b)
           ))))

;; check if element is activated
(defun ewm-elem-active (e c)
  (let (a)
    (cond ((memq (car e) '(div-rows div-cols))
           (while (and (setq e (cdr e))
                       (null (ewm-elem-active (cdar e) c))
                       ))
           (consp e)
           )
          ((setq a (assoc (car e) c))
           (plist-get (cdr a) :active)
           ))))

;; make all elements in a div
(defun ewm-make-div (w h l c)
  (let (size w2 l2 e (ref 100) (n 0) (x 0) (s 0))
    (dolist (e l)
      (if (eq (car e) '*)
        (setq x (1+ x))
        (setq n (+ n (car e)))
        ))
    (when (> x 0)
      (setq s (/ (- ref n) x))
      )
    (setq ref (+ n (* x s)))
    (dolist (e l)
      (setq x (if (eq (car e) '*) s (car e)))
      (if (ewm-elem-active (cdr e) c)
        (push (cons x (cdr e)) l2)
        (setq ref (- ref x))
        ))
    (setq l2 (nreverse l2))
    (setq size (if h (window-width w) (window-height w)))
    (while (and l2 w)
      (setq e (car l2))
      (when (setq l2 (cdr l2))
        (setq x (/ (+ (* (car e) size) (/ ref 2)) ref))
        (setq w2 (split-window w x h))
        )
      (ewm-make-elem w (cdr e) c)
      (setq w w2)
      )))

;; generate entire layout
(defun ewm-make-layout (layout bindings)
  (let (f h p a d bl (ewm-making-layout t))
    (setq bl (buffer-list))
    (setq ewm-window-handles nil)
    (dolist (e layout)
      (when (setq f (cdr (assoc (car e) ewm-frame-layout)))
        (unless (setq a (assoc (car e) ewm-frame-handles))
          (push (setq a (list (car e))) ewm-frame-handles)
          )
        (setq d (plist-get f :default))
        (setq p (cons '(user-position . t) (plist-get f :params)))
        (setq h (cdr a))
        (setq e (cadr e))
        (and d
             (null (frame-live-p h))
             (setq h (car (last (frame-list))))
             )
        (cond ((or d (ewm-elem-active e bindings))
               (cond ((frame-live-p h)
                      (when ewm-init-frames
                        (modify-frame-parameters h p)
                        (sit-for 0.1)
                        ))
                     (t
                      (setq h (make-frame p))
                      (sit-for 0.1)
                      ))
               (let ((w (frame-first-window h)))
                 ;; delete all windows
                 (set-window-dedicated-p w nil)
                 (delete-other-windows w)
                 (setq w (split-window w nil t))
                 (delete-other-windows w)
                 ;; recreate window structure
                 (ewm-make-elem w e bindings)
                 ))
              ((frame-live-p h)
               (delete-frame h)
               (setq h nil)
               ))
        (setcdr a h)
        ))
    ;; restore original buffer order
    (while bl (bury-buffer (pop bl)))
    (setq ewm-init-frames nil)
    ))

;; -------------------------------------------------------------
;; functions for buffer-to-window association

;; get window id from elisp 'window'
(defun ewm-window-id (w)
  (car (rassoc w ewm-window-handles))
  )

;; get elisp window from window-id
(defun ewm-get-window (i)
  (cdr (assoc i ewm-window-handles))
  )

(defun ewm-get-binding (i)
  (cdr (assoc i ewm-window-bindings))
  )

(defun ewm-put (i p v)
  (let ((e (ewm-get-binding i)))
    (and e (plist-put e p v))
    ))

(defun ewm-get (i p)
  (let ((e (ewm-get-binding i)))
    (and e (plist-get e p))
    ))

;; remove buffer from the window's buffer-stack
(defun ewm-del-buffer (e b)
  (let ((bl (plist-get e :buffers)))
    (plist-put e :buffers (delete b bl))
    ))

;; add buffer on top of the window's buffer-stack
(defun ewm-add-buffer (e b)
  (let ((bl (plist-get e :buffers)))
    (plist-put e :buffers (cons b (delete b bl)))
    bl
    ))

;; cleanup and return buffer-stack
(defun ewm-buffer-list (e prop)
  (let (l)
    (dolist (b (plist-get e prop))
      (when (buffer-live-p b)
        (push b l)
        ))
    (setq l (nreverse l))
    (plist-put e prop l)
    l
    ))

;; get buffer to display in a window
(defun ewm-get-buffer (e force)
  (let ((bl (ewm-buffer-list e :buffers)))
    (when (and (null bl) force)
      (setq bl
            (list
             (or
              (car (ewm-buffer-list e :buffers-old))
              (get-buffer-create
               (or (car (plist-get e :classes)) "*scratch*")
               ))))
      (plist-put e :buffers bl)
      )
    (car bl)
    ))

;; mark window as inactive and clear its buffer-stack (but keep a copy)
(defun ewm-hide-window (i)
  (let ((e (ewm-get-binding i)) b1 b2 sel)
    (when e
      (setq b1 (ewm-buffer-list e :buffers))
      (setq b2 (ewm-buffer-list e :buffers-old))
      (dolist (b (reverse b1)) (setq b2 (cons b (delete b b2))))
      (plist-put e :buffers-old b2)
      ))
  (ewm-put i :buffers nil)
  (ewm-put i :active nil)
  (setq ewm-focus-stack (delete i ewm-focus-stack))
  (setq sel (and (eq (selected-window) (ewm-get-window i))
                 (or (car ewm-focus-stack) 'edit-1)
                 ))
  (ewm-update sel)
  )

(defun ewm-show-window (i sel)
  (ewm-put i :active t)
  (ewm-update (and sel i))
  )

;; select window and the frame where it's on
(defun ewm-select-window (w)
  (when (window-live-p w)
    (let (focus-follows-mouse)
      (select-window w)
      (select-frame-set-input-focus (window-frame w))
      w
      )))

;; update layout and focus window 'i' or the previously focussed
(defun ewm-update (&optional i)
  (or i (setq i (ewm-window-id (selected-window))))
  (ewm-make-layout ewm-window-layout ewm-window-bindings)
  (ewm-select-window (ewm-get-window i))
  )

;; toggle window
(defun ewm-toggle (i &optional a)
  (if (if a (> a 0) (not (ewm-get i :active)))
    (ewm-show-window i nil)
    (ewm-hide-window i)
    )
  )

;; figure out the preferred window to display buffer
(defun ewm-get-class (buffer)
  (let ((wb ewm-window-bindings)
        (name (buffer-name buffer))
        a c e r d1 d2
        )
    (while (and wb (null r))
      (setq a (pop wb))
      (setq c (plist-get (cdr a) :classes))
      (while (and c (null r))
        (setq e (pop c))
        (cond ((eq e '*)
               (if d1 (setq d2 a) (setq d1 a))
               )
              ((equal (substring e 0 1) "^")
               (when (string-match e name)
                 (setq r a)
                 ))
              ((equal e name)
               (setq r a)
               ))))

    (or r (ewm-get-class-default buffer d1 d2))
    ))

;; emulate (very) basic "other-window" logic
(defun ewm-get-class-default (buffer d1 d2)
  (if (and d1 d2)
      (let ((w (selected-window))
            (w1 (ewm-get-window (car d1)))
            (w2 (ewm-get-window (car d2)))
            ;;(b1 (plist-get (cdr d1) :buffers))
            ;;(b2 (plist-get (cdr d2) :buffers))
            )
        (cond (ewm-other-window 
               (if (eq w w2) d1 d2)
               )
              (t
               (if (eq w w2) d2 d1)
               )))
    (or d1 d2)
    ))

;; -------------------------------------------------------------
;; ewm interface : display & hide buffer

(defun ewm-display-buffer (b sel)
  (let (c e i w)
    (setq b (get-buffer-create (or b (current-buffer))))
    (setq c (ewm-get-class b))
    (when c
      (setq i (car c))
      (setq e (cdr c))
      (ewm-add-buffer e b)
      (setq w (ewm-get-window i))
      (cond ((and (plist-get e :active) (window-live-p w))
             (set-window-buffer w b)
             (if sel (ewm-select-window w))
             w
             )
            (t
             (ewm-show-window i sel)
             (ewm-get-window i)
             )))))

(defun ewm-hide-buffer (w b)
  (let (i e)
    (setq i (ewm-window-id w))
    (setq e (ewm-get-binding i))
    (when e
      (ewm-del-buffer e b)
      ;; get previously displayed buffer
      (setq b (ewm-get-buffer e nil))
      (cond (b
             (set-window-buffer w b)
             )
            (t
             (ewm-hide-window i)
             )))))

;; -------------------------------------------------------------
;; redirect emacs core functions to the ewm interface

(defun ewm-advise (f)
  (when (fboundp 'ad-unadvise)
    (setq display-buffer-function nil)
    (ad-unadvise 'switch-to-buffer)
    (ad-unadvise 'switch-to-buffer-other-window)
    (ad-unadvise 'pop-to-buffer)
    (ad-unadvise 'kill-buffer)
    (ad-unadvise 'bury-buffer)
    (ad-unadvise 'delete-window)
    (ad-unadvise 'delete-frame)
;;    (remove-hook 'window-focus-change-hook 'focus-change-hook)
    (setq ewm-focus-stack nil)
    )

  (when f
;;    (add-hook 'window-focus-change-hook 'focus-change-hook)

    (setq display-buffer-function (lambda (b &optional ntw f)
      (let (w display-buffer-function)
        (setq w (ewm-display-buffer b nil))
        (display-buffer b ntw f)
        w
        )))

    (defadvice switch-to-buffer (around ewm activate)
      (let ((b (or (ad-get-arg 0) (other-buffer))) w)
        (setq w (ewm-display-buffer b t))
        ad-do-it
        ))

    (defadvice switch-to-buffer-other-window (around ewm activate)
      (let ((ewm-other-window t))
        (switch-to-buffer (ad-get-arg 0) (ad-get-arg 1))
        ))

    (defadvice pop-to-buffer (around ewm activate)
      (let ((b (or (ad-get-arg 0) (other-buffer))) w)
        (setq w (ewm-display-buffer b t))
        (ad-set-arg 1 nil)
        ad-do-it
        ))

    (defadvice kill-buffer (around ewm activate)
      (let ((b (or (ad-get-arg 0) (current-buffer))) w)
        (setq w (get-buffer-window b))
        ad-do-it
        (ewm-hide-buffer w b)
        ))

    (defadvice bury-buffer (around ewm activate)
      (if ewm-making-layout
          ad-do-it
        (let ((a (ad-get-arg 0)) (b (current-buffer)) w)
          (setq w (get-buffer-window b))
          ad-do-it
          (unless a
            (ewm-hide-buffer w b)
            ))))

    (defadvice delete-window (around ewm activate)
      (if ewm-making-layout
          ad-do-it
        (let ((w (or (ad-get-arg 0) (selected-window))))
          ad-do-it
          (ewm-hide-window (ewm-window-id w))
          )))

    (defadvice delete-frame (around ewm activate)
      (if ewm-making-layout
          ad-do-it
        (let ((f (or (ad-get-arg 0) (selected-frame))) wl)
          (when (frame-live-p f)
            (setq wl (window-list f))
            ad-do-it
            (dolist (w wl) (ewm-hide-window (ewm-window-id w)))
            ))))
    ))

;; -------------------------------------------------------------
;; Could handle focus more consistently if emacs provided some
;; such as a 'focus-change-hook'

;; (defun focus-change-hook (w1 w2)
;;   (unless ewm-making-layout
;;     (let (i1 i2)
;;       (when (setq i2 (ewm-window-id w2))
;;         (unless (window-live-p w2)
;;           (setq ewm-focus-stack (delete i2 ewm-focus-stack))
;;           ))
;;       (when (setq i1 (ewm-window-id w1))
;;         (setq ewm-focus-stack (cons i1 (delete i1 ewm-focus-stack)))
;;         )
;;       (message "focus: %s -> %s" i2 i1)
;;       )))

;; -------------------------------------------------------------
;; speedbar integration

(defun ewm-speedbar ()
  (require 'speedbar)
  ;; speedbar would not update if it thinks that it's
  ;; on the same frame
  (defadvice speedbar-timer-fn (around ewm activate)
    (defadvice selected-frame (around ewm activate) nil)
    (defadvice select-frame (around ewm activate) nil)
    ad-do-it
    (ad-unadvise 'select-frame)
    (ad-unadvise 'selected-frame)
    )
  (setq speedbar-frame (selected-frame))
  (with-current-buffer
      (setq speedbar-buffer (get-buffer-create "*SPEEDBAR*"))
    (speedbar-mode)
    )
  (speedbar-frame-mode 1)
  (buffer-disable-undo speedbar-buffer)
  (display-buffer speedbar-buffer)
  )

;; -------------------------------------------------------------
;; initialization

;; global variables
(defvar ewm-frame-layout nil)
(defvar ewm-window-layout nil)
(defvar ewm-window-bindings nil)
(defvar ewm-window-handles nil)
(defvar ewm-frame-handles nil)
(defvar ewm-init-frames nil)
(defvar ewm-making-layout nil)
(defvar ewm-focus-stack nil)
(defvar ewm-other-window nil)

(defun ewm-init ()
  (let ((b (current-buffer)))
    (ewm-set-layout)
    (ewm-advise t)
    (ewm-speedbar)
    (switch-to-buffer b)
    ))

(defun ewm-exit ()
  (setq speedbar-frame nil)
  (kill-buffer speedbar-buffer)
  (ewm-advise nil)
  )

(defun ewm-reload ()
  (let ((f (symbol-file 'ewm-reload)) b)
    (if (setq b (get-file-buffer f))
        (with-current-buffer b (save-buffer 0))
        )
    (load-file f)
    ))

;; -------------------------------------------------------------
;; start the thing

(ewm-init)