[project @ 2004-06-13 02:03:43 by unknown_lamer]

[clinton/bobotpp.git] / scripts / bobot-utils.scm

diff --git a/scripts/bobot-utils.scm b/scripts/bobot-utils.scm
index a3323dc..16f3996 100644 (file)
--- a/scripts/bobot-utils.scm
+++ b/scripts/bobot-utils.scm
@@ -9,13 +9,15 @@
 (module-use! (resolve-module '(guile-user) #f)
             the-bot-module)
 
+(use-modules (srfi srfi-13))
+
 (define-public %bot:loadpath (list
                              (string-append (getenv "HOME")
                                             "/.bobotpp/scripts/")
                              bot:sys-scripts-dir))
 (define-public %bot:load-extensions %load-extensions)
 
-;;; bot-log: Write as many messages as you want to the log.  If the
+;;; bot:log: Write as many messages as you want to the log.  If the
 ;;; arg is a thunk it will be executed and it's output will be
 ;;; written to the log
 (define-public (bot:log . messages)
@@ -24,7 +26,7 @@
      (if (thunk? x)
        (display (x) (bot-logport))
        (display x (bot-logport))))
-   messages )
+   messages)
   (bot:flushport))
 
 (define-public (bot:load file)
@@ -93,13 +95,35 @@
 
 ;;; Message sending utils
 
-;;; returns the CTCP quoted message
+;;; Returns the CTCP quoted message
+;;; Input _MUST NOT_ contain the trailing \r\n
+;;; (it is added by the message sending code)
 (define-public (ctcp-quote message)
-  message) ; FIXME: fill me in
+  ;; TODO: Not very efficient, it may be worth reimplementing
+  (let ((ls (string->list message)))
+     (string-concatenate
+      (map (lambda (chr) ; CTCP level quoting
+            (case (char->integer chr)
+              ((#o134) (string (integer->char #o134) (integer->char #o134)))
+              ((#o01)  (string (integer->char #o134) #\a)) ; X-DELIM
+              (else (string chr))))
+          (string->list
+           (string-concatenate
+            (map (lambda (chr) ; Low-level
+                   (let ((m-quote (integer->char #o20)))
+                     (case chr
+                       ((m-quote)  (string m-quote m-quote))
+                       ((#\nul)    (string m-quote #\0))
+                       ((#\nl)     (string m-quote #\n))
+                       ((#\cr)     (string m-quote #\r))
+                       (else       (string chr)))))
+                 ls)))))))
+        
+  
 
 ;;; DEPRECATED FUNCTION NAMES
 ;;; These are provided for backwards compatibility
-;;; and will be removed in the 2.3 dev tree
+;;; and will be removed in the 3.0 release
 
 (define-public bot-load bot:load)
 (define-public bot-action bot:action)