Skip to content
Browse files

irc.lsp: improve reliability, idle callback

  • Loading branch information...
1 parent 6f2a893 commit e40ffccba1f2753f8b829e4ea271447714ebfa35 @cormullion committed Oct 31, 2011
Showing with 42 additions and 26 deletions.
  1. +38 −24 irc.lsp
  2. +2 −0 newlisp-parser-test.lsp
  3. +1 −1 newlisp-parser.lsp
  4. +1 −1 newlisp-projects.wiki
View
62 irc.lsp
@@ -2,7 +2,7 @@
;; @module IRC
;; @description a basic irc library
-;; @version early alpha! 0.1 2011-10-18 15:51:05
+;; @version early alpha! 0.1 2011-10-31 14:21:26
;; @author cormullion
;; Usage:
;; (IRC:init "newlithper") ; a username/nick (not that one obviously :-)
@@ -17,6 +17,8 @@
(define Iserver)
(define Iconnected)
(define Icallbacks '())
+ (define Idle-time 400) ; seconds
+ (define Itime-stamp) ; time since last message was processed
(define (register-callback callback-name callback-function)
(println {registering callback for } callback-name { : } (sym (term callback-function) (prefix callback-function)))
@@ -27,43 +29,52 @@
(if-not (catch (apply func (list data)) 'error)
(println {error in callback } callback-name {: } error))))
+(define (do-callbacks callback-name data)
+ (dolist (rf (ref-all callback-name Icallbacks))
+ (set 'callback-entry (Icallbacks (first rf)))
+ (when (set 'func (last callback-entry))
+ (if-not (catch (apply func (list data)) 'error)
+ (println {error in callback } callback-name {: } error)))))
+
(define (init str)
(set 'Inickname str)
(set 'Iconnected nil)
- (set 'Ichannels '()))
+ (set 'Ichannels '())
+ (set 'Itime-stamp (time-of-day)))
(define (connect server port)
(set 'Iserver (net-connect server port))
(net-send Iserver (format "USER %s %s %s :%s\r\n" Inickname Inickname Inickname Inickname))
(net-send Iserver (format "NICK %s \r\n" Inickname))
(set 'Iconnected true)
- (do-callback "connect" (list (list "server" server) (list "port" port))))
+ (do-callbacks "connect" (list (list "server" server) (list "port" port))))
(define (identify password)
(net-send Iserver (format "PRIVMSG nickserv :identify %s\r\n" password)))
(define (join-channel channel)
(when (net-send Iserver (format "JOIN %s \r\n" channel))
(push channel Ichannels)
- (do-callback "join-channel" (list (list "channel" nickname)))))
+ (do-callbacks "join-channel" (list (list "channel" channel) (list "nickname" Inickname)))))
(define (part chan)
(if-not (empty? chan)
; leave specified
(begin
(net-send Iserver (format "PART %s\r\n" chan))
(replace channel Ichannels)
- (do-callback "part" (list (list "channel" channel))))
+ (do-callbacks "part" (list (list "channel" channel))))
; leave all
(begin
(dolist (channel Ichannels)
(net-send Iserver (format "PART %s\r\n" channel))
(replace channel Ichannels)
- (do-callback "part" (list (list "channel" channel)))))))
+ (do-callbacks "part" (list (list "channel" channel)))))))
(define (do-quit message)
- (do-callback "quit" '()) ; chance to do stuff before quit...
+ (do-callbacks "quit" '()) ; chance to do stuff before quit...
(net-send Iserver (format "QUIT :%s\r\n" message))
+ (sleep 1000)
(set 'Ichannels '())
(close Iserver)
(set 'Iconnected nil))
@@ -90,7 +101,7 @@
; say to specified channel
(if (find channel Ichannels)
(net-send Iserver (format "PRIVMSG %s :%s\r\n" channel message))))))
- (do-callback "send-to-server" (list (list "channel" channel) (list "message" message))))
+ (do-callbacks "send-to-server" (list (list "channel" channel) (list "message" message))))
(define (process-command sender command text)
(cond
@@ -102,34 +113,33 @@
(set 'username (first (clean empty? (parse sender {!|:} 0))))
(set 'channel (last (clean empty? (parse sender {!|:} 0))))
(println {username } username { joined } channel)
- (do-callback "join" (list (list "channel" channel) (list "username" username))))
+ (do-callbacks "join" (list (list "channel" channel) (list "username" username))))
(true
nil)))
(define (process-message sender command text)
(let ((username {} target {} message {}))
(set 'username (first (clean empty? (parse sender {!|:} 0))))
- (set 'target (trim (first (clean empty? (parse text {!|:} 0)))))
+ (set 'target (trim (first (clean empty? (parse text {!|:} 0)))))
(set 'message (slice text (+ (find {:} text) 1)))
- (println { raw message was } text )
(cond
((starts-with message "\001")
(process-ctcp username target message))
((find target Ichannels)
(cond
((= command {PRIVMSG})
- (do-callback "channel-message" (list (list "channel" target) (list "username" username) (list "message" message))))
+ (do-callbacks "channel-message" (list (list "channel" target) (list "username" username) (list "message" message))))
((= command {NOTICE})
- (do-callback "channel-notice" (list (list "channel" target) (list "username" username) (list "message" message))))))
+ (do-callbacks "channel-notice" (list (list "channel" target) (list "username" username) (list "message" message))))))
((= target Inickname)
(cond
((= command {PRIVMSG})
- (do-callback "private-message" (list (list "username" username) (list "message" message))))
+ (do-callbacks "private-message" (list (list "username" username) (list "message" message))))
((= command {NOTICE})
- (do-callback "private-notice" (list (list "username" username) (list "message" message))))))
+ (do-callbacks "private-notice" (list (list "username" username) (list "message" message))))))
(true
nil))))
-
+
(define (process-ctcp username target message)
(cond
((starts-with message "\001VERSION\001")
@@ -143,15 +153,19 @@
(set 'data (join data { }))
(set 'data (trim data "\001" "\001"))
(if (find target Ichannels)
- (do-callback "channel-action" (list (list "username" username) (list "message" message))))
+ (do-callbacks "channel-action" (list (list "username" username) (list "message" message))))
(if (= target Inickname)
- (do-callback "private-action" (list (list "username" username) (list "message" message)))))
+ (do-callbacks "private-action" (list (list "username" username) (list "message" message)))))
((starts-with message "\001TIME\001")
(net-send Iserver (format "NOTICE %s:\001TIME :%s\001\r\n" username (date))))))
(define (parse-buffer raw-buffer)
(let ((messages (clean empty? (parse raw-buffer "\r\n" 0)))
(sender {} command {} text {}))
+ ; check for elapsed time since last activity
+ (when (> (sub (time-of-day) Itime-stamp) (mul Idle-time 1000))
+ (do-callbacks "idle-event")
+ (set 'Itime-stamp (time-of-day)))
(dolist (message messages)
(set 'message-parts (parse message { }))
(unless (empty? message-parts)
@@ -162,14 +176,14 @@
(define (read-irc)
(let ((buffer {}))
- (when (!= (net-peek Iserver) 0)
- (net-receive Iserver buffer 8192 "\n")
- (unless (empty? buffer)
- (parse-buffer buffer)))))
+ (when (!= (net-peek Iserver) 0)
+ (net-receive Iserver buffer 8192 "\n")
+ (unless (empty? buffer)
+ (parse-buffer buffer)))))
(define (read-irc-loop) ; monitoring
- (let ((buffer {}))
- (while Iconnected
+ (let ((buffer {}))
+ (while Iconnected
(read-irc)
(sleep 1000))))
View
2 newlisp-parser-test.lsp
@@ -51,4 +51,6 @@
(println "\n" {all tests completed})
+(println (Nlex:parse-newlisp "(+ 2 2)"))
+
(exit)
View
2 newlisp-parser.lsp
@@ -295,4 +295,4 @@
(nlx-to-plaintext element 1)))
buff)
-;eof
+;eof
2 newlisp-projects.wiki
@@ -1 +1 @@
-Subproject commit 67946bb681ccb8a9b37a882a86434d45f2751632
+Subproject commit 41252a4aa63faa8ded176379555e64ba730203c0

0 comments on commit e40ffcc

Please sign in to comment.
Something went wrong with that request. Please try again.