[project @ 2005-07-07 21:19:26 by unknown_lamer]
[clinton/bobotpp.git] / scripts / bobot-utils.scm
dissimilarity index 79%
index 6327ad5..916a76e 100644 (file)
-;;; this is a library of stuff that bobot++ scripts would probably
-;;; want to use. This file is autoloaded by bobot++
-
-;;; This file is covered by the GPL version 2 or (at your option) any
-;;; later version 
-
-;;; Why the GPL? Technically anything that uses Bobot++'s functions
-;;; must be GPLed, so all of your scripts have to be GPLed anyway
-;;; because you are really linking with Bobot++, a GPLed program.
-
-;;; Bot load (loads a file from %bot:loadpath)
-
-(define %bot:loadpath (list
-                      (string-append (getenv "HOME")
-                                     "/.bobotpp/scripts/")
-                      bot:sys-scripts-dir))
-
-(define (bot:load file)
-  (let loop ((load-path %bot:loadpath))
-    (if (not (null? load-path))
-      (if (catch 'system-error
-            (lambda ()
-              (load
-               (string-append (car load-path)
-                              file)))
-            (lambda args
-              #f ))
-        #t
-        (loop (cdr load-path)))
-      (begin (bot:log "ERROR: File " file " Not Found!\n") #f))))
-
-;;; REGEX UTILS
-
-;;; match-not-channel adds a prefix regex to your regex so it doesn't
-;;; match the sender or channel in a PUBLIC message
-(define (bot:match-not-channel regex)
-  (string-append "^[[:graph:]]* [&#+!][^ ,\a]+ [[:graph:][:space:]]*" regex))
-
-;;; match-to-me matches text that was addressed to the bot with a
-;;; ':',',', or nothing after the bot name
-(define (bot:match-to-me regex)
-  (string-append (match-not-channel (bot:getnickname))
-                "[[:space:][:graph:]]*" regex))
-
-;;;; string-utils
-(define str-app string-append) ; shorter
-
-
-;;;; Misc UTILS
-
-;;; 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 (bot:log . messages)
-  (for-each
-   (lambda (x)
-     (if (thunk? x)
-       (display (x) (bot-logport))
-       (display x (bot-logport))))
-   messages )
-  (bot:flushport))
-
-;;; Message sending utils
-
-;;; returns the CTCP quoted message
-(define (ctcp-quote message)
-  message) ; FIXME: fill me in
-
-;;; DEPRECATED FUNCTION NAMES
-;;; These are provided for backwards compatibility
-;;; and will be removed in the 2.3 dev tree
-
-(define bot-load bot:load)
-(define bot-action bot:action)
-(define bot-adduser bot:adduser)
-(define bot-addserver bot:addserver)
-(define bot-addshit bot:addshit)
-(define bot-ban bot:ban)
-(define bot-cycle bot:cycle)
-(define bot-deban bot:deban)
-(define bot-delserver bot:delserver)
-(define bot-deluser bot:deluser)
-(define bot-delshit bot:delshit)
-(define bot-deop bot:deop)
-(define bot-die bot:die)
-(define bot-do bot:do)
-(define bot-invite bot:invite)
-(define bot-join bot:join)
-(define bot-keep bot:keep)
-(define bot-kick bot:kick)
-(define bot-kickban bot:kickban)
-(define bot-lock bot:lock)
-(define bot-logport bot:logport)
-(define bot-mode bot:mode)
-(define bot-msg bot:msg)
-(define bot-nextserver bot:nextserver)
-(define bot-nick bot:nick)
-(define bot-op bot:op)
-(define bot-part bot:part)
-(define bot-reconnect bot:reconnect)
-(define bot-say bot:say)
-(define bot-server bot:server)
-(define bot-setversion bot:setversion)
-(define bot-tban bot:tban)
-(define bot-tkban bot:tkban)
-(define bot-topic bot:topic)
-(define bot-unlock bot:unlock)
-(define bot-getnickname bot:getnickname)
-(define bot-getserver bot:getserver)
-(define bot-getserverlist bot:getserverlist)
-(define bot-flush bot:flush)
-(define bot-flushport bot:flushport)
-(define bot-random bot:random)
-(define bot-addcommand bot:addcommand)
-(define bot-delcommand bot:delcommand)
-(define bot-addhook bot:addhook)
-(define bot-addtimer bot:addtimer)
-(define bot-deltimer bot:deltimer)
\ No newline at end of file
+;;; This file is automatically loaded by Bobot++. This is required for
+;;; the bot to function.
+
+;;; This file is covered by the GPL version 2 or (at your option) any
+;;; later version 
+
+;;; the-bot-module must be available to guile-user so that scripts
+;;; loaded with Interp::Load have access to the bot: procedures
+(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
+;;; arg is a thunk it will be executed and it's output will be
+;;; written to the log
+(define-public (bot:log . messages)
+  (for-each
+   (lambda (x)
+     (if (thunk? x)
+       (display (x) (bot:logport))
+       (display x (bot:logport))))
+   messages)
+  (bot:flushport))
+
+(define-public (bot:load file)
+  (let path-loop ((load-path %bot:loadpath))
+    (cond ((not (null? load-path))
+          (if (not
+               (let ext-loop ((extensions %bot:load-extensions))
+                 (if (not (null? extensions))
+                     (if (catch 'system-error
+                                (lambda ()
+                                  (load
+                                   (string-append (car load-path)
+                                                  file
+                                                  (car extensions))))
+                                (lambda args
+                                  #f ))
+                         #t
+                         (ext-loop (cdr extensions))))))
+              (path-loop (cdr load-path))))
+         (else
+          (begin (bot:log "ERROR: File " file " Not Found!\n") #f)))))
+
+(define-public (bot:load-module module-spec)
+  (let ((module->string
+        (lambda (module)
+         (apply
+          (lambda (s . rest)
+            (string-append
+             s
+             (apply string-append
+                    (map (lambda (str) (string-append "/" str)) rest))))
+                (map symbol->string module))))
+       (new-module
+        (make-module))
+       (old-module (current-module)))
+    (module-use! new-module the-bot-module)
+    (set-current-module new-module)
+    (bot:load (module->string module-spec))
+    (set-current-module old-module)
+    new-module))
+
+(define-public (bot:use-module module-spec)
+  (module-use! (current-module)
+              (bot:load-module module-spec)))
+    
+
+;;; REGEX UTILS
+
+;;; match-not-channel adds a prefix regex to your regex so it doesn't
+;;; match the sender or channel in a PUBLIC message
+(define-public (bot:match-not-channel regex)
+  (string-append "^[[:graph:]]* [&#+!][^ ,\a]+ [[:graph:][:space:]]*"
+                regex))
+
+;;; match-to-me matches text that was addressed to the bot with a
+;;; ':',',', or nothing after the bot name
+(define-public (bot:match-to-me regex)
+  (string-append (bot:match-not-channel (bot:getnickname))
+                "[[:space:][:graph:]]*" regex))
+
+(define-public bot:sent-to-me?
+  (let ((to-me (make-regexp (bot:match-to-me ""))))
+    (lambda (message)
+      (if (regexp-exec to-me message) #t #f))))
+
+;;;; string-utils
+(define-public str-app string-append) ; shorter
+
+;;; Message sending utils
+
+;;; Returns the CTCP quoted message
+;;; Input _MUST NOT_ contain the trailing \r\n
+;;; (it is added by the message sending code)
+(define-public (bot:ctcp-quote message)
+  ;; 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 3.0 release
+(begin-deprecated
+
+ (define-macro (_deprecated-fun old-name new-name)
+   `(define-public ,old-name
+      (lambda args
+       (let ((old-error
+              (set-current-error-port (bot:logport))))
+         (issue-deprecation-warning
+          (string-append
+           (symbol->string ',old-name)
+           " is a deprecated function. Please use "
+           (symbol->string ',new-name) " instead."))
+         (bot:flushport)
+         (set-current-error-port old-error))
+         (apply ,new-name args))))
+     
+ (_deprecated-fun bot-load bot:load)
+ (_deprecated-fun bot-action bot:action)
+ (_deprecated-fun bot-adduser bot:adduser)
+ (_deprecated-fun bot-addserver bot:addserver)
+ (_deprecated-fun bot-addshit bot:addshit)
+ (_deprecated-fun bot-ban bot:ban)
+ (_deprecated-fun bot-cycle bot:cycle)
+ (_deprecated-fun bot-deban bot:deban)
+ (_deprecated-fun bot-delserver bot:delserver)
+ (_deprecated-fun bot-deluser bot:deluser)
+ (_deprecated-fun bot-delshit bot:delshit)
+ (_deprecated-fun bot-deop bot:deop)
+ (_deprecated-fun bot-die bot:die)
+ (_deprecated-fun bot-do bot:do)
+ (_deprecated-fun bot-invite bot:invite)
+ (_deprecated-fun bot-join bot:join)
+ (_deprecated-fun bot-keep bot:keep)
+ (_deprecated-fun bot-kick bot:kick)
+ (_deprecated-fun bot-kickban bot:kickban)
+ (_deprecated-fun bot-lock bot:lock)
+ (_deprecated-fun bot-logport bot:logport)
+ (_deprecated-fun bot-mode bot:mode)
+ (_deprecated-fun bot-msg bot:msg)
+ (_deprecated-fun bot-nextserver bot:nextserver)
+ (_deprecated-fun bot-nick bot:nick)
+ (_deprecated-fun bot-op bot:op)
+ (_deprecated-fun bot-part bot:part)
+ (_deprecated-fun bot-reconnect bot:reconnect)
+ (_deprecated-fun bot-say bot:say)
+ (_deprecated-fun bot-server bot:server)
+ (_deprecated-fun bot-setversion bot:setversion)
+ (_deprecated-fun bot-tban bot:tban)
+ (_deprecated-fun bot-tkban bot:tkban)
+ (_deprecated-fun bot-topic bot:topic)
+ (_deprecated-fun bot-unlock bot:unlock)
+ (_deprecated-fun bot-getnickname bot:getnickname)
+ (_deprecated-fun bot-getserver bot:getserver)
+ (_deprecated-fun bot-getserverlist bot:getserverlist)
+ (_deprecated-fun bot-flush bot:flush)
+ (_deprecated-fun bot-flushport bot:flushport)
+ (_deprecated-fun bot-random bot:random)
+ (_deprecated-fun bot-addcommand bot:addcommand)
+ (_deprecated-fun bot-delcommand bot:delcommand)
+ (_deprecated-fun bot-addhook bot:addhook)
+ (_deprecated-fun bot-addtimer bot:addtimer)
+ (_deprecated-fun bot-deltimer bot:deltimer)
+ (define-public hooks/leave hooks/part))
\ No newline at end of file