Fandom

Sawfish

Subwm

773pages on
this wiki
Add New Page
Talk0 Share

Ad blocker interference detected!


Wikia is a free-to-use site that makes money from advertising. We have a modified experience for viewers using ad blockers

Wikia is not accessible if you’ve made further modifications. Remove the custom ad blocker rule(s) and the page will load as expected.

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

Also on Fandom

Random Wiki