X-Git-Url: http://git.hcoop.net/clinton/bobotpp.git/blobdiff_plain/4edefeb6d696ccc7291ab9ae8bf5996907510d7b..1ddb41489c1d934efaccfe37639a7ca083bfefba:/scripts/bobot-utils.scm diff --git a/scripts/bobot-utils.scm b/scripts/bobot-utils.scm dissimilarity index 64% index a3323dc..8a09c62 100644 --- a/scripts/bobot-utils.scm +++ b/scripts/bobot-utils.scm @@ -1,149 +1,196 @@ -;;; 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) - -(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? message) - (let ((to-me (make-regexp (bot:match-to-me "")))) - (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 -(define-public (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-public bot-load bot:load) -(define-public bot-action bot:action) -(define-public bot-adduser bot:adduser) -(define-public bot-addserver bot:addserver) -(define-public bot-addshit bot:addshit) -(define-public bot-ban bot:ban) -(define-public bot-cycle bot:cycle) -(define-public bot-deban bot:deban) -(define-public bot-delserver bot:delserver) -(define-public bot-deluser bot:deluser) -(define-public bot-delshit bot:delshit) -(define-public bot-deop bot:deop) -(define-public bot-die bot:die) -(define-public bot-do bot:do) -(define-public bot-invite bot:invite) -(define-public bot-join bot:join) -(define-public bot-keep bot:keep) -(define-public bot-kick bot:kick) -(define-public bot-kickban bot:kickban) -(define-public bot-lock bot:lock) -(define-public bot-logport bot:logport) -(define-public bot-mode bot:mode) -(define-public bot-msg bot:msg) -(define-public bot-nextserver bot:nextserver) -(define-public bot-nick bot:nick) -(define-public bot-op bot:op) -(define-public bot-part bot:part) -(define-public bot-reconnect bot:reconnect) -(define-public bot-say bot:say) -(define-public bot-server bot:server) -(define-public bot-setversion bot:setversion) -(define-public bot-tban bot:tban) -(define-public bot-tkban bot:tkban) -(define-public bot-topic bot:topic) -(define-public bot-unlock bot:unlock) -(define-public bot-getnickname bot:getnickname) -(define-public bot-getserver bot:getserver) -(define-public bot-getserverlist bot:getserverlist) -(define-public bot-flush bot:flush) -(define-public bot-flushport bot:flushport) -(define-public bot-random bot:random) -(define-public bot-addcommand bot:addcommand) -(define-public bot-delcommand bot:delcommand) -(define-public bot-addhook bot:addhook) -(define-public bot-addtimer bot:addtimer) -(define-public 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-1) + (srfi srfi-13)) + +(eval-when (compile load eval) + (set! %load-path (cons* (string-append (getenv "HOME") "/.bobotpp/scripts/") + bot:sys-scripts-dir + %load-path))) + +;;; 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 load-from-path) + +(define (module->string module) + (apply (lambda (s . rest) + (string-append + s + (apply string-append + (map (lambda (str) (string-append "/" str)) rest)))) + (map symbol->string module))) + +(define-public (bot:load-module module-spec) + (let ((new-module (make-module 31 (list the-bot-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? message) + (let ((to-me (make-regexp (bot:match-to-me "")))) + (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))))))) + +;;; bot:channel-users user object accessors +(define-public (bot:channel-user-nick cu) + (first cu)) + +(define-public (bot:channel-user-user/host cu) + (second cu)) + +(define-public (bot:channel-user-mode cu) + (third cu)) + +(define-public (bot:channel-user-has-modes? cu . modes) + (let ((mode (apply logior modes))) + (= (logand (bot:channel-user-mode cu)) mode mode))) + +(define-public (bot:channel-user-op? cu) + (bot:channel-user-has-modes? cu bot:mode/op)) + +(define-public (bot:channel-user-voice? cu) + (bot:channel-user-has-modes? cu bot:mode/voice)) + +(define-public (bot:channel-user-away? cu) + (bot:channel-user-has-modes? cu bot:mode/away)) + +(define-public (bot:channel-user-ircop? cu) + (bot:channel-user-has-modes? cu bot:mode/op)) + +;;; 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