| Scripts quick access edit this |
- Author: Jens Thiele
- Version: unknown
- License: GPLv3
Synopsis[]
Selectively delegate window management to a "sub window manager". (another process, emacs :-)
Description[]
Selective delegeate window management to another process ("sub window manager"). At the moment there is only one sub window manager: emacs. WARNING: This is an evil hack and I only distribute that code because I really use that crap and find it useful enough to share it.
Installation[]
There are two parts: sawfish side and emacs side. Put both in their corresponding lisp directory and require them.
Configuration[]
You have to edit the code.
Screencast[]
http://karme.de/delme/subwm.ogv (screencast, ogg theora video)
Sawfish Code[]
;;; subwm.jl -- selectively delegate window management to a sub
;;; window manager (another process, emacs :-)
;; Copyright (C) 2010 Jens Thiele
;; Author: Jens Thiele <karme@berlios.de>
;; 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 3, or (at your option)
;; any later version.
;; This file 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.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; at the moment there is only one subwm and that is emacs
;; EVIL HACK FOLLOWS!
;; I only distribute that code because I really use that crap and find
;; it useful enough to share it
(defun syslog l
(apply call-process
(append (list (make-process
standard-output) nil)
(list "/usr/bin/logger" "sawfish:") l)))
(defun subwm-debug l
;; (format standard-error "%s sawfish: %s\n" (current-time) l)
;; (apply syslog l)
l)
(defun kill-process-gracefully-1 (p timeout signals)
(if (process-in-use-p p)
(if signals
(progn
(signal-process p (car signals))
(apply accept-process-output timeout)
(kill-process-gracefully-1 p timeout (cdr signals)))
nil)
t))
(defun kill-process-gracefully (p timeout)
(kill-process-gracefully-1 p timeout '(INT TERM KILL)))
;; note: timeout is more like a hint
(defun call-process-timeout (timeout p dummy #!rest args)
(apply start-process (cons p args))
(while (process-in-use-p p)
(when (apply accept-process-output timeout)
;; timeout reached, kill that sucker
(kill-process-gracefully p timeout)))
(process-exit-value p))
(defun shell-command-to-string-timeout (timeout #!rest l)
(let* ((b (make-string-output-stream))
(args (append (list timeout (make-process b) nil) l))
(dummy (subwm-debug (format nil "calling (call-process %s)" args)))
(ret (apply call-process-timeout args)))
(subwm-debug (format nil "subprocess returned: %s" ret))
(list (get-output-stream-string b) (= ret 0) ret)))
(define (subwm-place-mode w)
(let ((subwm (window-get w 'subwm-dim)))
(subwm-debug (format nil "subwm-place-mode %s" subwm))
(window-put w 'ignore-program-position t)
(window-put w 'fixed-position t)
(window-put w 'never-maximize t)
(move-resize-window-to w (car subwm) (cadr subwm) (caddr subwm) (cadddr subwm))
t))
(define-placement-mode 'subwm subwm-place-mode #:for-normal t #:for-dialogs t)
(defun intersection (x y)
"intersection of 2 lists"
(filter (lambda(x) (member x y)) x))
;; todo: at the moment only the window id of the first entry is used
(setq subwm-registry (list))
(defun subwm-register (wid hooks)
"Register a sub-window manager"
(subwm-debug (format nil "New tiled sub-window-manager in window %s registered" wid))
(setq subwm-registry (cons (cons wid hooks) subwm-registry))
(mapcar (lambda(h)
(add-hook (car h) (cdr h))) hooks)
t)
(defun subwm-unregister (wid)
"Unregister a sub-window manager"
(subwm-debug (format nil "tiled sub-window-manager in window %s unregistered" wid))
;; remove old hooks!
(let ((swm (assoc wid subwm-registry)))
(when swm
(mapcar (lambda(h)
(remove-hook (car h) (cdr h))) (cdr swm))))
(setq subwm-registry
(filter (lambda(x) (not (equal (car x) wid))) subwm-registry)))
;; todo: this is not yet correct
(defun fix-window-at (wid x1 y1 ww wh)
(let ((w (get-window-by-id wid)))
(when w
(set-window-type w 'unframed)
(window-put w 'place-mode 'subwm)
(window-put w 'ignore-program-position t)
(when (window-iconified-p w)
(uniconify-window w))
(when (window-get w 'subwm)
(move-resize-window-to w x1 y1 ww wh))
(window-put w 'subwm-dim (list x1 y1 ww wh))
(window-put w 'subwm t))))
;; emacs as a sub window manager
;; todo: ugly
;; maybe use emacs.jl for that part
(defun emacs-eval-read (l)
(let ((eret (shell-command-to-string-timeout '(2 . 0) "/usr/bin/emacsclient" "-e" (prin1-to-string l))))
(subwm-debug (format nil "eret: %s" eret))
(if (and
(cadr eret)
(not (equal (car eret) "")))
(read (make-string-input-stream (car eret)))
nil)))
(defun emacs-eval-async (sexp)
"Pass sexp to emacs for asynchronous evaluation"
(start-process
(make-process standard-output)
"/usr/bin/emacsclient" "-e" (prin1-to-string sexp))
nil)
(defun emacs-place-window (w)
(subwm-debug "emacs-place-window: new window")
(window-put w 'subwm nil)
(condition-case data
(let* ((ewid (car (car subwm-registry)))
(ew (get-window-by-id ewid)))
(when (intersection (window-workspaces w)
(window-workspaces ew))
(eval (emacs-eval-read (list 'x-window-place-hook
(window-id w)
(window-name w)
(window-class w)
(cons 'list (window-workspaces w))
(cons 'list (window-workspaces ew))
(car (window-dimensions ew))
(cdr (window-dimensions ew))
(car (window-position ew))
(cdr (window-position ew)))))))
(error
;; Default handler
(let* ((b (make-string-output-stream))
(standard-output b))
(format standard-output "some error in my place-window-hook: %s" data)
(print "backtrace:\n")
(backtrace)
(subwm-debug (get-output-stream-string b)))
nil)))
(defun emacs-destroy-notify (w)
;; unfortunately the window is not passed
;; (somehow w is #<window 0>) :-(
(subwm-debug (format nil "window %s destroyed (%s)" w (window-id w)))
(emacs-eval-async '(x-window-destroy-hook)))
;; hack to prevent endless recursion
(setq in-window-moved-or-resized nil)
;; todo: this is not yet correct
(defun emacs-window-moved-or-resized (w moved)
(let ((action (if moved "moved" "resized")))
(subwm-debug (format nil "emacs-window-moved-or-resized: window %s %s, rec? %s subwm? %s fixed? %s client? %s"
w
action
in-window-moved-or-resized
(window-get w 'subwm)
(window-get w 'fixed-position)
(window-get w 'client-set-position)
))
(subwm-debug (format nil "pos: %s dim: %s placed?: %s"
(window-position w)
(window-dimensions w)
(window-get w 'placed)
))
(when (and (not in-window-moved-or-resized)
(window-get w 'subwm)
(window-get w 'client-set-position))
(subwm-debug (format nil "stupid app moving its window %s?" w))
(let ((subwm (window-get w 'subwm-dim)))
(setq in-window-moved-or-resized t)
(move-resize-window-to w (car subwm) (cadr subwm) (caddr subwm) (cadddr subwm))
(setq in-window-moved-or-resized nil))))
nil)
(defun emacs-window-moved (w)
(emacs-window-moved-or-resized w t))
(defun emacs-window-resized (w)
(emacs-window-moved-or-resized w nil))
;; todo: use server-name!
(defun subwm-register-emacs (wid server-name)
"Register a emacs sub-window-manager"
(subwm-register wid `((place-window-hook . ,emacs-place-window)
(destroy-notify-hook . ,emacs-destroy-notify)
(window-moved-hook . ,emacs-window-moved)
(window-resized-hook . ,emacs-window-resized))))
Emacs Code[]
;;; subwm.el --- emacs as sub window-manager for sawfish
;; Copyright (C) 2010 Jens Thiele
;; Author: Jens Thiele <karme@berlios.de>
;; Keywords:
;; 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 3, or (at your option)
;; any later version.
;; This file 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.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; emacs as sub window manager (EVIL HACK!)
;;; Code:
(eval-when-compile (require 'cl))
;; todo: get rid of ecb again?
(require 'ecb)
(require 'sawfish)
;; uhh - better way?
(defun server-start-if-not-running ()
(when (or (not (boundp 'server-process))
(not (processp server-process)))
(server-start)))
(defecb-window-dedicator ecb-set-xwindow-buffer " *xwindow*"
(switch-to-buffer (get-buffer-create " *xwindow*")))
(defun frame->x-window-id ()
"hack to get x window id for current frame"
(getenv "WINDOWID"))
(defun sawfish-runningp ()
(sawfish-eval-read t))
(defun x-subwm-register ()
"register with x window manager as sub-window manager"
(setq buffer-x-window-mapping '())
(sawfish-eval-read (list 'subwm-register-emacs
(string-to-number (frame->x-window-id))
server-name)))
(defun x-subwm-unregister ()
"unregister with x window manager as sub-window manager"
(sawfish-eval-read (list 'subwm-unregister
(string-to-number
(frame->x-window-id)) server-name)))
(defun window->x-window (x-width x-height x-offx x-offy t-width t-height)
(list (+ (* (nth 0 (window-inside-edges)) (/ x-width t-width)) x-offx)
(+ (* (nth 1 (window-inside-edges)) (/ x-height t-height)) x-offy)
(+ (* (- (nth 2 (window-inside-edges)) (if (= (nth 2 (window-inside-edges)) t-width) 0 1))
(/ x-width t-width)) x-offx -0)
(+ (* (- (nth 3 (window-inside-edges)) 0) (/ x-height t-height)) x-offy -0)))
(defun x-window-move (wid l)
"return a sawfish program to move a x-window"
(list 'fix-window-at wid (nth 0 l) (nth 1 l) (- (nth 2 l) (nth 0 l)) (- (nth 3 l) (nth 1 l))))
(defun x-window-catch (wid x-width x-height x-offx x-offy)
"return a sawfish program to place a x-window into current buffer"
(x-window-move wid (window->x-window x-width x-height x-offx x-offy (frame-width) (frame-height))))
(defun x-window-hide (wid)
"return a sawfish program to hide a x-window"
`(iconify-window (get-window-by-id ,wid)))
(defun x-window-close (wid)
"close x window referenced by id (if it exists)"
(sawfish-eval-read `(if (get-window-by-id ,wid)
(delete-window (get-window-by-id ,wid)
t))))
(defun x-subwm-first-x-buffer ()
"find first buffer with an x-window attached"
(or (some (lambda(bn) (if (string-match "^\*x-" bn) bn '()))
(mapcar 'buffer-name (buffer-list)))
" *xwindow*"))
(defun my-debug (s)
;; XXX: quote !!
;;(shell-command-to-string (format "logger 'emacs: %s'" s))
)
(defun my-ecb-switch-window-buffer (window nbuf)
"switch buffer in ecb window"
(my-debug (format "my-ecb-switch-window-buffer %s %s" window nbuf))
(if window
(ecb-with-some-adviced-functions nil
(progn ;; (with-selected-window window (switch-to-buffer nbuf))
(with-selected-window window
(my-debug "try to switch ecb window")
(dedicated-mode 1)
(dedicated-mode -1)
;; hmm switching buffers will call back sawfish via catch-x-windows?!
(if (not (ignore-errors (switch-to-buffer nbuf)))
(my-debug "my-ecb-switch-window-buffer failed to switch buffer"))
(dedicated-mode 1))))
(my-debug "my-ecb-switch-window-buffer called without valid window")))
(defun my-kill-buffer-hook ()
(let ((bw (assoc (buffer-name) buffer-x-window-mapping)))
(when bw
;; first remove from mapping
(setq buffer-x-window-mapping (delete* bw buffer-x-window-mapping))
;; now delete x-window (this will call us back!)
(x-window-close (cdr bw)))))
(defun x-window-place-hook (wid wname wclass wdesktops fdesktops x-width x-height x-offx x-offy)
;; ignore windows on other desktops and windows of apps not working well with tabbed window managers
;; (my-debug (format "new window %s (%s) %s: class: %s desktops: %s %s intersection: %s"
;; wid wname (string-match "VLC" wname) wclass wdesktops fdesktops
;; (intersection wdesktops fdesktops)))
;; (my-debug (format "v.digit match: %s" (= (string-match "^v.digit" wname) 0)))
(if (and (intersection wdesktops fdesktops)
(or (string= wname "xclock")
(string-match "^Xpdf" wname)
(string-match "^gv:" wname)
(string-match "MPlayer" wname)
(string-match "^Xdvi" wname)
(string-match "^Advi" wname)
(string-match "^Figure 1" wname)
(string-match "^GNUPlot" wname)
(string-match "my-image-viewer" wname)
(string-match "sgachine" wname)
(string-match "GRASS" wname)
(string-match "conkeror" wname)
(string-match "^v.digit -" wname)
(string-match "^VLC" wname)
(and wclass (or
(string-match "GQview" wclass)
(string-match "Epiphany" wclass)
(string-match "^Gnome-www-browser" wclass)
(string-match "^Eog" wclass)
(string-match "^X-www-browser" wclass)))
(and wclass (string-match "Evince" wclass) (not (string-match "Drucken" wname)))
;; (string-match "feh" wclass)
;; (string-match "Gliv" wclass)
;; imagemagick doesn't play nice
;; (string-match "^ImageMagick" wname)
))
;; XXX: disabled: bug here
;; a new window might be created using the same id as a window already
;; destroyed but we do not know yet!
;;(not (assoc (format "*x-%s<%s>*" wname wid) buffer-x-window-mapping)))
;; (print (format "new window: %d" wid))
;; create new buffer - insert into assoc list
(progn
(my-debug "create buffer for window")
(let ((nbuf (get-buffer-create (format "*x-%s<%s>*" wname wid))))
(setq buffer-x-window-mapping (append buffer-x-window-mapping (list (cons (buffer-name nbuf) wid))))
(my-debug (format "created buffer for window %s. new map:%s" wid buffer-x-window-mapping))
;; XXX: shit => disable hook at that point
(remove-hook 'window-configuration-change-hook 'catch-x-windows)
;; quite a hack:
;; if there already is a window showing a x window use that one
(let ((window
(some
(lambda(x)
(if
(or
;; (and
(string-match "^\*x-" (buffer-name (window-buffer x)))
;; (with-current-buffer x (not dedicated-mode)))
(string-match " *xwindow" (buffer-name (window-buffer x))))
x
nil))
(window-list))))
(if window
(my-ecb-switch-window-buffer window nbuf)
;; create a new window (todo: add some placement constraints for different apps)
;; (for example it would be nice to set the size)
(display-buffer nbuf t)))
(add-hook 'window-configuration-change-hook 'catch-x-windows)
(with-current-buffer nbuf
(add-hook 'kill-buffer-hook
'my-kill-buffer-hook))
(append (catch-x-windows-sync x-width x-height x-offx x-offy) (list '()))))
(progn
(my-debug "ignoring this window")
'())))
(defun x-window-destroyed (wid)
(my-debug (format "window %s destroyed" wid))
(let ((bw (rassoc wid buffer-x-window-mapping)))
(if bw
(progn
(my-debug (format "lost one of our windows kill corresponding buffer"))
(setq buffer-x-window-mapping (delete* bw buffer-x-window-mapping))
;; todo: it might be a dedicated ecb window!
(ecb-with-some-adviced-functions nil
(if (not (ignore-errors (kill-buffer (car bw))))
(progn
(my-debug
(format
"failed to kill buffer probably ecb window 2nd try »%s« in window »%s«"
(car bw) (get-buffer-window (car bw))))
;; XXX: shit => disable hook at that point
(remove-hook 'window-configuration-change-hook 'catch-x-windows)
(my-ecb-switch-window-buffer
(get-buffer-window (car bw)) " *xwindow*")
(my-debug "switched to special")
(add-hook 'window-configuration-change-hook 'catch-x-windows)
(if (not (ignore-errors (kill-buffer (car bw))))
(my-debug "finally failed to kill buffer")
(progn
(my-debug "finally killed the buffer now try to switch to next x buffer")
(my-ecb-switch-window-buffer
(get-buffer-window " *xwindow*") (x-subwm-first-x-buffer))))
)
(my-debug "killed buffer")))))))
(defun x-window-exists (wid)
(sawfish-eval-read `(get-window-by-id ,wid)))
(defun x-window-destroy-hook () ;; (wid)
;; (my-debug (format "got message that window %s was destroyed" wid))
(my-debug (format "got message that a window was destroyed"))
;; (if wid
;; (x-window-destroyed wid)
;; unfortunately we have to find the window ourself
(mapc (lambda(bw)
(if (not (x-window-exists (cdr bw)))
(x-window-destroyed (cdr bw))))
buffer-x-window-mapping)
'())
(defun catch-x-windows-sync (x-width x-height x-offx x-offy)
(let ((value (list 'progn)))
(dolist (bw buffer-x-window-mapping value)
(if (get-buffer (car bw))
(setq value
(append value
(if (get-buffer-window (car bw))
(list (with-selected-window (get-buffer-window (car bw))
(x-window-catch (cdr bw) x-width x-height x-offx x-offy)))
(list (x-window-hide (cdr bw))))))))))
(defun catch-x-windows ()
(let ((ew (string-to-number (frame->x-window-id))))
(my-debug (format "catch-x-windows called with selected frame %s" (selected-frame)))
(my-debug
(format "sawfish returned: %s"
(sawfish-eval-read
(apply 'catch-x-windows-sync
(sawfish-eval-read `(let ((ew (get-window-by-id ,ew)))
(list (car (window-dimensions ew))
(cdr (window-dimensions ew))
(car (window-position ew))
(cdr (window-position ew)))))))))))
(defun my-on-window-size-change (frame)
(catch-x-windows))
;; todo: at the moment only one emacs subwm is supported and we want
;; to start the corresponding server process
(when (and (getenv "DISPLAY")
;; do not start a second emacs server
(not (equal (shell-command-to-string "emacsclient -n -e 1 && echo -n ok") "ok"))
(sawfish-runningp))
(server-start-if-not-running) ;; in fact we know that no server is running, yet
(add-hook 'suspend-hook 'x-subwm-unregister)
(add-hook 'kill-emacs-hook 'x-subwm-unregister)
(add-hook 'suspend-resume-hook 'x-subwm-register)
(x-subwm-register)
(setq buffer-x-window-mapping '())
(add-hook 'window-size-change-functions 'my-on-window-size-change))
(provide 'subwm)
;;; subwm.el ends here