X-Git-Url: https://git.hcoop.net/clinton/bobotpp.git/blobdiff_plain/6e78bd19562feb6fec15ac2d25781af1784732c5..528799bd9ee2c03de68c6d2dc20a4813da3e3261:/scripts/bobot-utils.scm diff --git a/scripts/bobot-utils.scm b/scripts/bobot-utils.scm dissimilarity index 79% index 6327ad5..916a76e 100644 --- a/scripts/bobot-utils.scm +++ b/scripts/bobot-utils.scm @@ -1,118 +1,194 @@ -;;; 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