Author: dylan
Date: 2005-07-31 22:18:28 -0400 (Sun, 31 Jul 2005)
New Revision: 898
Added:
trunk/clients/guile/haver/protocol.scm
Removed:
trunk/clients/guile/haver/haver-protocol.scm
trunk/clients/guile/haver/haver-user.scm
Modified:
trunk/
trunk/clients/guile/test.scm
trunk/docs/spec/Haver/Spec/Auth.pod
trunk/perl/client/lib/Haver/Client.pm
Log:
[EMAIL PROTECTED]: dylan | 2005-07-31 18:47:42 -0400
Some stuff for the possible scheme client (just playing really)
and some doc fixups.
_call no longer needed; call() is provided by Haver::Session
Property changes on: trunk
___________________________________________________________________
Name: svk:merge
- 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/havercurs-objc:43089
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/winch/trunk:43192
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:1318
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
+ 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/havercurs-objc:43089
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/winch/trunk:43192
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:1324
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
Deleted: trunk/clients/guile/haver/haver-protocol.scm
===================================================================
--- trunk/clients/guile/haver/haver-protocol.scm 2005-07-29 21:57:43 UTC
(rev 897)
+++ trunk/clients/guile/haver/haver-protocol.scm 2005-08-01 02:18:28 UTC
(rev 898)
@@ -1,83 +0,0 @@
-
-; vim: set ft=scheme:
-
-
-
-(define-module
- (haver haver-protocol)
- :export (
- escape
- unescape
- event->line
- line->event
- escape-char
- ))
-
-
-(use-modules (ice-9 string-fun))
-
-(define (escape-char x)
- (case x
- ((#\tab) (list #\esc #\t))
- ((#\nl) (list #\esc #\n))
- ((#\cr) (list #\esc #\r))
- ((#\esc) (list #\esc #\e))
- (else (list x))))
-
-(define (escape s)
- (list->string (apply append (map escape-char (string->list s)))))
-
-
-(define (unescape-char char)
- (case char
- ((#\t) #\tab)
- ((#\e) #\esc)
- ((#\r) #\cr)
- ((#\n) #\nl)
- (else char)))
-
-(define (unescape-list chars)
- (cond ((null? chars) '())
- ((list? chars)
- (if (eq? (car chars) #\esc)
- (unescape-list (cons (unescape-char (car (cdr chars))) (cdr
(cdr chars))))
- (cons (car chars) (unescape-list (cdr chars)))))
- (else (throw 'badtype "Expected list or null!"))))
-
-
-(define (unescape s)
- (list->string (unescape-list (string->list s))))
-
-
-(define (line->event line)
- (let* (
- (str (sans-trailing-cr-nl line))
- (event (separate-fields-discarding-char #\tab str list)))
- (map unescape event)))
-
-(define (join s l)
- (cond ((null? l) "")
- ((= 1 (length l)) (car l))
- (else (string-append (car l) s (join s (cdr l))))))
-
-;(define (event->line event)
-; (let* (
-; (event (map escape event))
-; (line (join "\t" event)))
-; (string-append line "\r\n")))
-
-(define (event->line event)
- (string-append (join "\t" (map escape event)) "\r\n"))
-
-(define (sans-trailing-cr-nl s)
- (let ((st 0)
- (end (string-length s)))
- (while (and (< 0 end)
- (or
- (char=? #\cr (string-ref s (1- end)))
- (char=? #\nl (string-ref s (1- end)))
- ))
- (set! end (1- end)))
- (if (< end st)
- ""
- (substring s st end))))
Deleted: trunk/clients/guile/haver/haver-user.scm
===================================================================
--- trunk/clients/guile/haver/haver-user.scm 2005-07-29 21:57:43 UTC (rev
897)
+++ trunk/clients/guile/haver/haver-user.scm 2005-08-01 02:18:28 UTC (rev
898)
@@ -1,17 +0,0 @@
-; vim: set ft=scheme:
-
-
-
-(define-module
- (haver haver-protocol)
- :export (
- escape
- unescape
- event->line
- line->event
- ))
-
-
-(use-modules (ice-9 string-fun))
-
-
Added: trunk/clients/guile/haver/protocol.scm
===================================================================
--- trunk/clients/guile/haver/protocol.scm 2005-07-29 21:57:43 UTC (rev
897)
+++ trunk/clients/guile/haver/protocol.scm 2005-08-01 02:18:28 UTC (rev
898)
@@ -0,0 +1,73 @@
+
+; vim: set ft=scheme:
+
+(define-module
+ (haver protocol)
+ :export (
+ event->string
+ string->event
+ ))
+
+
+(use-modules (ice-9 string-fun))
+
+(define (escape-char x)
+ (case x
+ ((#\tab) (list #\esc #\t))
+ ((#\nl) (list #\esc #\n))
+ ((#\cr) (list #\esc #\r))
+ ((#\esc) (list #\esc #\e))
+ (else (list x))))
+
+(define (escape s)
+ (list->string (apply append (map escape-char (string->list s)))))
+
+
+(define (unescape-char char)
+ (case char
+ ((#\t) #\tab)
+ ((#\e) #\esc)
+ ((#\r) #\cr)
+ ((#\n) #\nl)
+ (else char)))
+
+(define (unescape-list chars)
+ (cond ((null? chars) '())
+ ((list? chars)
+ (if (eq? (car chars) #\esc)
+ (unescape-list (cons (unescape-char (car (cdr chars))) (cdr
(cdr chars))))
+ (cons (car chars) (unescape-list (cdr chars)))))
+ (else (throw 'badtype "Expected list or null!"))))
+
+
+(define (unescape s)
+ (list->string (unescape-list (string->list s))))
+
+
+(define (string->event line)
+ (let* (
+ (str (sans-trailing-cr-nl line))
+ (event (separate-fields-discarding-char #\tab str list)))
+ (map unescape event)))
+
+(define (event->string event)
+ (string-append (join "\t" (map escape event)) "\r\n"))
+
+
+(define (join s l)
+ (cond ((null? l) "")
+ ((= 1 (length l)) (car l))
+ (else (string-append (car l) s (join s (cdr l))))))
+
+(define (sans-trailing-cr-nl s)
+ (let ((st 0)
+ (end (string-length s)))
+ (while (and (< 0 end)
+ (or
+ (char=? #\cr (string-ref s (1- end)))
+ (char=? #\nl (string-ref s (1- end)))
+ ))
+ (set! end (1- end)))
+ (if (< end st)
+ ""
+ (substring s st end))))
Property changes on: trunk/clients/guile/haver/protocol.scm
___________________________________________________________________
Name: svn:eol-style
+ native
Modified: trunk/clients/guile/test.scm
===================================================================
--- trunk/clients/guile/test.scm 2005-07-29 21:57:43 UTC (rev 897)
+++ trunk/clients/guile/test.scm 2005-08-01 02:18:28 UTC (rev 898)
@@ -1,9 +1,13 @@
+#!/usr/bin/guile -s
+!#
+(use-modules
+ (gtk gtk) (gtk gdk)
+ (haver protocol)
+ (haver socket))
-(use-modules (gtk gtk) (gtk gdk))
-
(define (load-rcfile name)
(let ((file (string-append (getenv "HOME") "/" name)))
(if (file-exists? file)
@@ -23,10 +27,8 @@
(gtk-signal-connect entry "activate"
(lambda ()
- (let (
- (line
(gtk-entry-get-text entry)))
- (gtk-entry-set-text entry "")
-
- )))
+ (let (
+ (line
(gtk-entry-get-text entry)))
+ (gtk-entry-set-text entry
""))))
(gtk-widget-show-all window)
(gtk-standalone-main window))
Modified: trunk/docs/spec/Haver/Spec/Auth.pod
===================================================================
--- trunk/docs/spec/Haver/Spec/Auth.pod 2005-07-29 21:57:43 UTC (rev 897)
+++ trunk/docs/spec/Haver/Spec/Auth.pod 2005-08-01 02:18:28 UTC (rev 898)
@@ -98,7 +98,7 @@
sub passcode {
my ($user, $password, $host) = @_;
- sha1_base64("$password" . lc("$host$user"));
+ sha1_base64($password . lc("$host$user"));
}
=head1 AUTHOR
Modified: trunk/perl/client/lib/Haver/Client.pm
===================================================================
--- trunk/perl/client/lib/Haver/Client.pm 2005-07-29 21:57:43 UTC (rev
897)
+++ trunk/perl/client/lib/Haver/Client.pm 2005-08-01 02:18:28 UTC (rev
898)
@@ -79,10 +79,6 @@
return $msg;
}
-sub _call {
- return POE::Kernel->call(POE::Kernel->get_active_session(), @_);
-}
-
sub _dispatch {
_call('__dispatch', @_);
}
@@ -144,14 +140,14 @@
$heap->{pending} = \%opts;
return;
} elsif ($heap->{state} != S_IDLE) {
- _call('disconnect');
+ call('disconnect');
$heap->{pending} = \%opts;
} else {
$heap->{state} = S_CONN;
$heap->{name} = $opts{name};
$heap->{port} = $opts{port};
if (!$heap->{resolver}) {
- _call('_do_connect', $opts{host});
+ call('_do_connect', $opts{host});
} else {
my $resp = $heap->{resolver}->resolve(
host => $opts{host},
@@ -159,7 +155,7 @@
event => '_dns_resp',
);
if ($resp) {
- _call('_dns_resp', $resp);
+ call('_dns_resp', $resp);
}
}
}
@@ -169,7 +165,7 @@
my ($heap, $addr) = @_[HEAP,ARG0];
my $port = delete $heap->{port};
if ($heap->{state} == S_DYING) {
- _call('_cleanup');
+ call('_cleanup');
return;
}
$heap->{wheel} = POE::Wheel::SocketFactory->new(
@@ -207,7 +203,7 @@
}
# dns fail
_dispatch('connect_fail', 'dns');
- _call('_cleanup');
+ call('_cleanup');
} else {
_dispatch('connect_fail', 'dns', $packet->{error});
}
@@ -216,13 +212,13 @@
sub _conn_fail {
my $heap = $_[HEAP];
_dispatch('connect_fail', @_[ARG0..ARG2]);
- _call('_cleanup');
+ call('_cleanup');
}
sub _conn_ok {
my ($kernel, $heap, $sock) = @_[KERNEL,HEAP,ARG0];
if ($heap->{state} == S_DYING) {
- _call('_cleanup');
+ call('_cleanup');
return;
}
_dispatch('connected');
@@ -249,13 +245,13 @@
sub _err {
_dispatch('disconnected', @_[ARG0..ARG2]);
- _call('_cleanup');
+ call('_cleanup');
}
sub disconnect {
my $heap = $_[HEAP];
- _call('send_raw', 'BYE');
+ call('send_raw', 'BYE');
$heap->{state} = S_DYING;
$poe_kernel->delay('_force_down', 5);
}
@@ -263,7 +259,7 @@
sub _force_down {
my $heap = $_[HEAP];
$heap->{state} = S_IDLE;
- _call('_cleanup');
+ call('_cleanup');
}
sub _cleanup {
@@ -290,33 +286,33 @@
sub send {
my ($kernel, @args) = @_[KERNEL,ARG0..$#_];
- _call('send_raw', @args);
+ call('send_raw', @args);
}
sub join {
my $channel = $_[ARG0];
- _call('send', 'JOIN', $channel);
+ call('send', 'JOIN', $channel);
}
sub part {
my $channel = $_[ARG0];
- _call('send', 'PART', $channel);
+ call('send', 'PART', $channel);
}
sub public {
my ($kernel, $heap, $c, $t, @a) = @_[KERNEL,HEAP,ARG0..$#_];
- _call('send', 'IN', $c, $t, @a);
+ call('send', 'IN', $c, $t, @a);
}
sub private {
my ($kernel, $heap, $d, $t, @a) = @_[KERNEL,HEAP,ARG0..$#_];
- _call('send', 'TO', $d, $t, @a);
+ call('send', 'TO', $d, $t, @a);
}
sub list {
my ($chan, $type) = @_[ARG0, ARG1];
$type = defined $type ? $type : 'user';
- _call('send', 'LIST', $chan, $type);
+ call('send', 'LIST', $chan, $type);
}
sub destroy {
@@ -330,7 +326,7 @@
}
}
$heap->{reg} = {};
- _call('disconnect');
+ call('disconnect');
$kernel->alias_remove($heap->{alias});
}
@@ -383,13 +379,13 @@
}
sub _ev_PING {
- _call('send_raw', 'PONG', @_[ARG1..$#_]);
+ call('send_raw', 'PONG', @_[ARG1..$#_]);
}
sub _ev_BYE {
my ($type, $detail) = @_[ARG2,ARG3];
_dispatch('bye', $detail);
- _call('_cleanup');
+ call('_cleanup');
}
sub _ev_FAIL {
