1
;; server.jl -- execute forms on demand
2
;; $Id: server.jl,v 1.13 2000/09/11 07:44:42 john Exp $
4
;; Copyright (C) 1999 John Harper <john@dcs.warwick.ac.uk>
6
;; This file is part of sawmill.
8
;; sawmill is free software; you can redistribute it and/or modify it
9
;; under the terms of the GNU General Public License as published by
10
;; the Free Software Foundation; either version 2, or (at your option)
13
;; sawmill is distributed in the hope that it will be useful, but
14
;; WITHOUT ANY WARRANTY; without even the implied warranty of
15
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16
;; GNU General Public License for more details.
18
;; You should have received a copy of the GNU General Public License
19
;; along with sawmill; see the file COPYING. If not, write to
20
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
24
;; The protocol is something like:
26
;; 1. Send a ClientMessage event to the window identified by the
27
;; property _SAWFISH_REQUEST_WIN on the root window, event mask 0,
28
;; with the event's window field set to the root window, type
29
;; _SAWFISH_REQUEST, format 32. data.l[0] = protocol version (1),
30
;; data.l[1] = window to use for properties, data.l[2] = property
31
;; containing form to evaluate, data.l[3] is non-zero if a result
34
;; 2. The wm reads and evaluates the form from the specified
35
;; property on the specified window.
37
;; 3. If a result is required it overwrites the form with its
38
;; value, and assumes that the client will delete the property
39
;; after it has read it. If no result is required, it will delete
40
;; the property after having read it.
42
;; The result is a string, it's first byte defines whether an error
43
;; occurred or not, \001 if okay, \002 if an error
44
(define-structure sawfish.wm.server
55
(defconst protocol-version 1)
57
(define server-window nil)
59
(define (server-eval form)
60
(let ((print-escape t))
61
(condition-case error-data
63
(setq form (read-from-string form))
64
(format nil "\001%S" (user-eval form)))
66
(format nil "\002%S" error-data)))))
68
(define (server-client-message-handler w type data)
69
(when (and server-window (eq w 'root)
70
(eq type '_SAWFISH_REQUEST)
71
(= (aref data 0) protocol-version))
72
(let* ((window (aref data 1))
73
(prop (x-atom-name (aref data 2)))
74
(needs-result (/= (aref data 3) 0))
75
(form-data (get-x-property window prop)))
78
window prop (server-eval (nth 2 form-data)) 'STRING 8)
79
(delete-x-property window prop)
80
(server-eval (nth 2 form-data)))
83
(define (server-net-init)
85
(setq server-window (create-window 'root -100 -100 10 10))
86
(set-x-property 'root '_SAWFISH_REQUEST_WIN
87
(vector server-window) 'CARDINAL 32)
88
(set-x-property server-window '_SAWFISH_REQUEST_WIN
89
(vector server-window) 'CARDINAL 32)))
91
(define (server-net-exit)
93
(delete-x-property 'root '_SAWFISH_REQUEST_WIN)
94
(destroy-window server-window)
95
(setq server-window nil)))
97
(add-hook 'client-message-hook server-client-message-handler)
98
(add-hook 'before-exit-hook server-net-exit))
added
removed
lisp/sawfish/wm/server.jl
