Wikia

Sawfish

Subwm

773pages on
this wiki
Talk0
Scripts quick access edit this
  • Author: Jens Thiele
  • Version: unknown
  • License: GPLv3

Synopsis Edit

Selectively delegate window management to a "sub window manager". (another process, emacs :-)

Description Edit

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 Edit

There are two parts: sawfish side and emacs side. Put both in their corresponding lisp directory and require them.

Configuration Edit

You have to edit the code.

Screencast Edit

http://karme.de/delme/subwm.ogv (screencast, ogg theora video)

Sawfish Code Edit

;;; 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 Edit

;;; 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

Around Wikia's network

Random Wiki