X-Git-Url: http://dolda2000.com/gitweb/?a=blobdiff_plain;f=lib%2Fguile%2Fdolcon%2Futil.scm;h=30b25c1c49ab041fb48d6f55d8ca7bfd0d031b79;hb=aff8e2e1d96589da107d0bd55d8c30df35ade37c;hp=5276ba8dfc9bfb41448f2d12e80b9ad9e5af5c97;hpb=1a893343f388e2bde1ba33dfea9e8f5a48a2f70b;p=doldaconnect.git diff --git a/lib/guile/dolcon/util.scm b/lib/guile/dolcon/util.scm index 5276ba8..30b25c1 100644 --- a/lib/guile/dolcon/util.scm +++ b/lib/guile/dolcon/util.scm @@ -1,9 +1,27 @@ +; Dolda Connect - Modular multiuser Direct Connect-style client +; Copyright (C) 2007 Fredrik Tolf +; +; This program 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. +; +; You should have received a copy of the GNU General Public License +; along with this program; if not, write to the Free Software +; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + (define-module (dolcon util)) (use-modules (dolcon ui)) (define fnetnodes '()) (define loop-procs '()) (define fn-procs '()) +(define msg-procs '()) (define-public dc-fn-update (lambda () @@ -54,7 +72,7 @@ (set! fn-procs (cons (list event proc) fn-procs)))) -(define-public dc-handle-fn +(define dc-handle-fn (lambda () (dc-fn-update) (let* ((notify (lambda (event data) (for-each (lambda (o) (if (eq? event (car o)) ((cadr o) data))) fn-procs))) @@ -86,6 +104,26 @@ (notify 'dstr (cdr nform)) (set! fnetnodes (delq nform fnetnodes)))))))) +(define-public dc-msgproc-reg + (lambda (proc) + (set! msg-procs (cons proc msg-procs)))) + +(define dc-handle-msg + (lambda () + (dc-loop-reg ".notify" 640 (lambda (r er) + (let ((sender (cadadr (assq 'resp er))) + (message (cddadr (assq 'resp er)))) + (for-each (lambda (o) (o sender message)) + msg-procs)))))) + +(define-public dc-util-handle + (lambda what + (for-each (lambda (o) + (case o + ((fn) (dc-handle-fn)) + ((msg) (dc-handle-msg)))) + what))) + (define-public dc-loop-reg (lambda (cmd code proc) (set! loop-procs (cons (cons (cons cmd code) proc)