diff options
Diffstat (limited to 'elisp/erbot/erbc.el')
| -rw-r--r-- | elisp/erbot/erbc.el | 5141 |
1 files changed, 5141 insertions, 0 deletions
diff --git a/elisp/erbot/erbc.el b/elisp/erbot/erbc.el new file mode 100644 index 0000000..0c81835 --- /dev/null +++ b/elisp/erbot/erbc.el @@ -0,0 +1,5141 @@ +;;; erbc.el --- Erbot user-interface commands -- see also erbc5.el +;; Time-stamp: <2009-09-26 22:20:39 fledermaus> +;; Copyright © 2002 D. Goel +;; Emacs Lisp Archive entry +;; Filename: erbc.el +;; Package: erbc +;; Author: D. Goel <deego@gnufans.org> +;; Version: 0.0DEV +;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot +;; Other files: +;;; erball.el --- Functions on all files. +;;; erbbdb.el --- +;;; erbc.el --- Erbot user-interface commands. +;;; erbc2.el --- mostly: special functions for erbc.el +;;; erbc3.el ---erbot lisp stuff which should be PERSISTENT ACROSS SESSIONS. +;;; erbc4.el --- Russian Roulette +;;; erbc5.el --- continuation of erbc.el +;;; erbc6.el --- fsbot functions contributed by freenode users, +;;; esp. #emacsers. +;;; erbcompat.el --- Erbot GNU Emacs/XEmacs compatibility issues +;;; erbcountry.el +;;; erbc-special.el --- Special/dangerous implementation functions. +;;; erbdata.el --- +;;; erbedit.el --- quicker operator editing of bots' bbdb +;;; erbeng.el --- english +;;; erbforget.el --- Help make the bots forget some TERMS. +;;; erbkarma.el --- +;;; erblisp.el --- +;;; erblog.el --- +;;; erbmsg.el --- memoserv-esque functions for Erbot +;;; erbot.el --- Another robot for ERC. +;;; erbp.el --- NOT FUNCTIONAL personal erbot-interface, stolen from dunnet.el +;;; erbtrain.el --- Train erbot (erbot).. +;;; erbutils.el --- utils +;;; erbwiki.el --- + +(defvar fs-home-page + "http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot") + + + +;; This file is NOT (yet) part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; This is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + + +;; See also: + + + + +(defvar erbc-version "0.0dev") +(defvar fs-version "0.0dev") + + +;;========================================== +;;; Code: + +;; NOTE: stuff like (fs-et) can be passed possibly mischievous +;; code as the first argument... never eval or "set" any +;; "code"... always convert it to a single atom... before setting it.. + + + +(require 'find-func) + +(defgroup erbc nil + "The group erbc" + :group 'applications) + + +(defcustom fs-before-load-hooks nil "" :group 'erbc) +(defcustom fs-after-load-hooks nil "" :group 'erbc) + + + +(defcustom erbn-char "," + "The character which calls the bot. + +in addition to directly addressing it. + +may be different for +different bots. + +Is really a string, but the length of the string should be 1,. +") +(defcustom erbn-char-double (concat erbn-char erbn-char) + "The string which calls the bot from midsentence + +this string should have a length of EXACTLY 2. + +") + + +(run-hooks 'fs-before-load-hooks) + + +;; Real code +(defcustom fs-internal-botito-mode nil + "Mode to turn on more english-like bunny-behavior" + :group 'erbc) + + + +(defvar fs-tgt nil "Tgt visible to the end-user, as well as changeable by them.") +(defvar erbn-tgt nil "Tgt NOT changeable by enduser.") + +(defvar fs-nick "") +(defvar erbn-nick "") + +(defvar erbn-buffer "") + +(defcustom fs-internal-parse-error-p + nil + "Whether to show lispy errors in term descriptions. + +When nil, an error in a lispy description of a term makes to bot +go to an english mode for the term. +When non-nil, we will just display the error. On a channel full of +lisp hackers, we will want to make this t for users' convenience.") + + +(defcustom erbn-shell-command-p nil + "Whether to allow commands that use shell-commands... +Some fsbot commands use shell-commands... shell-commands always mean +possibility of exploits. andn are disabled by default. + +Make this t at your own risk. ") + + +(defcustom fs-internal-questions + '("what" "where" "who" + ;; no please: + ;;"why" + ;;"how" + ) + "" + :group 'erbc) + +(defcustom erbn-google-defaults + '(("#emacs" ("emacs")) + ("#fsbot" ("fsbot"))) + "" :group 'erbc) + + + +(defun erbn-shell-command (&optional command overridep) + "Execute shell-commands when erbn-shell-command-p is true. + +However, if the second argument overridep is non-nil, we use that to +determine whether to execute the command. In that case, we execute +the command only if overridep is a list, whose first entry of that +list is non-nil" + (cond + ((or (and overridep + (listp overridep) + (first overridep)) + erbn-shell-command-p) + (apply 'shell-command command nil)) + (t + (error "The bot-operator has shell commands disabled")))) + + + + + +(defun erbn-shell-command-to-string (&optional command overridep) + "Execute shell-commands when erbn-shell-command-p is true. + +However, if the second argument overridep is non-nil, we use that to +determine whether to execute the command. In that case, we execute +the command only if overridep is a list, whose first entry of that +list is non-nil" + (cond + ((or (and overridep + (listp overridep) + (first overridep)) + erbn-shell-command-p) + (apply 'shell-command-to-string command nil)) + (t + (error "The bot-operator has shell commands disabled")))) + + + + + +(defun fsi-get-google-defaults () + (cadr (assoc fs-tgt erbn-google-defaults))) + +(defvar fsi-prestring "") +;; (make-variable-buffer-local 'fsi-prestring) + + +(defcustom fs-internal-google-level 0 + "75 is a good choice for fsbot. " + :group 'erbc) +(defcustom fs-internal-english-max-matches 20 + "This check is triggerred only when the users' original request didnot +succeed and so we have gone into an english-mode and are searching. +If the number of matches results in 1000, then most likely, the word +was something like i or you and the user was not intending a search. +" + +:group 'erbc) + +(defcustom fs-internal-questions-all + '("what" "where" "who" "why" "how" + "whose" "which" + ) + "" + :group 'erbc) + +(defcustom fs-internal-articles + '("the" "a" "an" "this" "that") + "" + :group 'erbc) + + +(defcustom fs-internal-english-target-regexp + "^$" + "Targets that prefer english.. so erbot will usually go to a +english-mode unless near-exact matches. This shall usually happen on +the few social channels erbot hangs out on. " + :group 'erbc) + +(defcustom fs-internal-query-target-regexp + "^$" + "Targets where erbot will respond to queries like: +Foo ? " + :group 'erbc) + +(defcustom fs-internal-add-nick-weights + '(1 ;; yes + 5 ;;no + ) + "" + :group 'erbc) + + +(defun fsi-correct-entry (name &rest fubar) + "Assumes that name is a string... this downcases strings. Rendering +it fit for database-entry. " + (unless (stringp name) (setq name (format "%s" name))) + ;;(downcase + (let ((newname + (mapconcat 'identity (split-string name) "-"))) + (or (erbbdb-get-exact-name newname) + newname))) + + +(defun fsi-describe-key-briefly (&optional key &rest args) + "Return the function on key..building block for other erbc's.. +If no such function, return the symbol 'unbound. " + + (unless key + (error + "Syntax: , dkb key")) + (when (and (null key) (null args)) + (setq key "")) + (unless (stringp key) + ;; is this safe? what about properties? + (setq key (read-kbd-macro + (mapconcat '(lambda (arg) (format "%s" arg)) + (cons key args) + " ")))) + (let ((res (key-binding key))) + (if res res + 'unbound))) + +;; for now.. +;;(defalias 'fs-describe-key 'fs-describe-key-briefly) + +(defun fsi-where-is-in-map (map &optional fcn) + (let* ((wi (where-is-internal fcn map))) + (mapconcat 'key-description wi ", "))) + +(defun fsi-where-is-gnus-group (&optional fcn) + (require 'gnus) + (unless fcn (error "please supply a function")) + (fs-where-is-in-map gnus-group-mode-map fcn)) + +(defun fsi-where-is-gnus-summary (&optional fcn) + (require 'gnus) + (unless fcn (error "please supply a function")) + (fs-where-is-in-map gnus-summary-mode-map fcn)) +(defun fsi-where-is-message (&optional fcn) + (require 'gnus) + (require 'message) + + (unless fcn (error "please supply a function")) + (fs-where-is-in-map message-mode-map fcn)) + + + +(defun fsi-keyize (key morekeys) + (setq key (read-kbd-macro + (mapconcat '(lambda (arg) (format "%s" arg)) + (cons key morekeys) " ")))) + + +(defun fsi-describe-key-one-line (&optional key &rest args) + "Key, and just one line of function" + (unless key (error "Syntax: , dk \"Key...\"")) + (let* ((fcn (apply 'fs-describe-key-briefly key args)) + (fcns (format "%s" fcn)) + (apr (or (fs-apropos-exact fcns) + "No doc. available. "))) + (concat (format "%s -- %s" + fcns + apr)))) + +(defalias 'fsi-dko 'fs-describe-key-one-line) + +(defalias 'fsi-describe-key 'fs-describe-key-and-function) + +(defun fsi-lookup-key-from-map-internal (&optional map key &rest morekeys) + (unless key (error "No key supplied. ")) + (unless (stringp key) + (setq key (read-kbd-macro + (mapconcat '(lambda (arg) (format "%s" arg)) + (cons key morekeys) " ")))) + (unless (arrayp key) (setq key (format "%s" key))) + (let* ((fcn (lookup-key map key)) + (fcns (format "%s" fcn)) + (apr (or (fs-apropos-exact fcns) + "No doc available. "))) + (concat (format "%s -- %s" fcns apr)))) + +(defun fsi-lookup-key-gnus-group (&optional key &rest args) + (unless key (error "Syntax: , lkgg \"Key...\"")) + (require 'gnus-group) + (apply 'fs-lookup-key-from-map-internal gnus-group-mode-map key args)) + +(defun fsi-lookup-key-gnus-summary (&optional key &rest args) + (unless key (error "Syntax: , lkgg \"Key...\"")) + (require 'gnus) + (apply 'fs-lookup-key-from-map-internal gnus-summary-mode-map key args)) + +(defun fsi-lookup-key-message (&optional key &rest args) + (unless key (error "Syntax: , lkgg \"Key...\"")) + (require 'gnus) + (require 'message) + (apply + 'fs-lookup-key-from-map-internal gnus-message-mode-map key args)) + + + +(defun fsi-apropos-exact (str) + (unless (stringp str) (setq str (format "%s" str))) + (let* ((reg (concat "^" (regexp-quote str) "$")) + (apr (apropos reg)) + (asso (assoc* str apr + :test + (lambda (a b) + (string= (format "%s" a) (format "%s" b))))) + + (val (second asso))) + (if val (format "%s" val) + nil))) + +(defun fsi-describe-key-long (k &rest args) + (let ((f (apply 'fs-describe-key-briefly k args))) + (fs-describe-function-long f))) + +(defun fsi-describe-key-and-function (key &rest args) + "Describe the key KEY. +Optional argument ARGS . If the input arguments are not strings, it +kbds's them first... , so that , df C-x C-c works" + (when (and (null key) (null args)) + (setq key "")) + (unless (stringp key) + (setq key (read-kbd-macro + (mapconcat '(lambda (arg) (format "%s" arg)) + (cons key args) + " ")))) + (let ((b (key-binding key))) + (cond + ((symbolp b) + (or + (ignore-errors (fs-describe-function b)) + (format "Bound to: %s" b))) + (t + (format "Bound to: %s" b))))) + + + +(defun fsi-describe-function (&optional function nolimitp &rest fubar) + "Describes the FUNCTION named function. +Also tries an fs- prefix for the function.. +nolimitp has to be eq 'nolimit for the nolimit effect to take place.. +" + (unless function + (error + "Syntax: (describe-function 'name-of-function) or , df 'name")) + (let* ((f function) + g + ) + (when (stringp f) + (setq f (erbn-read f))) + (cond + ((symbolp f) + (progn + (setq + g + (cond + ((fboundp f) f) + (t (erbn-read (concat "fs-" (format "%s" f)))))) + (unless (fboundp g) + (setq g f)) + (let* ((def (symbol-function g))) + (ignore-errors + (if (equal 'autoload (car-safe def)) + (load (second def)))) + ;; this check does nothing now.. need ro + (if (equal nolimitp 'nolimit) + + ;;(let ((fs-limit-lines 8)) + ;;(fs-limit-lines (describe-function g))) + (describe-function g) + (describe-function g)) + + ))) ;; if list, DO NOT wanna eval it--> + (t + "NO function specified")))) + + +(defun fsi-where-is (function &rest args) + "Tells what key the function is on.. + +" + (let* ( + (str0 "") + (str1 "") + (str2 "") + (str3 "") + ) + (cond + ((stringp function) (setq function (erbn-read function))) + (t nil)) + (cond + ((null function) (format "Sorry, %s is not a symbol" function)) + ((symbolp function) + (unless (fboundp function) (setq str0 "Either unbound or.. ")) + (setq str2 + (with-temp-buffer + (where-is function t) + (erbutils-buffer-string))) + (concat str0 str1 str2 str3)) + (t (format "Looks like %s is not a symbol" function))))) + +(defun fsi-describe-function-long (function &rest fubar) + "Similar to describe-function, but does not limit the strings... +Use with caution only in privmsgs please, for may produce long outputs. " + (fs-describe-function function 'nolimit)) + + +(defun fsi-describe-variable-long (variable &rest fubar ) + "Similar to describe-variable, but does not limit strings.." + (fs-describe-variable variable 'nolimit)) + +(defun fsi-describe-variable (&optional variable &rest ignore) + "Describes a VARIABLE.." + (unless variable (error "Syntax: , dv 'variable")) + (let* ((f variable)) + (if (stringp f) + (setq f (erbn-read f))) + (cond + ((symbolp f) + (erbutils-describe-variable f)) + + ;; if list, DO NOT wanna eval it--> + (t + "NO variable specified")))) + +(defalias 'fsi-parse 'fs-lispify) +(defalias 'fsi-parse-english 'fs-lispify) + +(defun fsi-require (feature &rest fubar) + "Make the bot require the feature FEATURE. +So that the command df +or dv works fine..Actually, df knows how to load unloaded features +automatically." + (if (stringp feature) + (setq feature (fsi-read feature))) + (when (or (string-match "/" (format "%s" feature)) + (string-match "\\\\" (format "%s" feature))) + (error "Your safety is VERY important to us, so we avoid loading features containing slashes.")) + (cond + ((symbolp feature) (format "%s" (require feature))) + (t "no feature specified"))) + + +(defvar fs-found-query-p nil + "internal.. should be normally set to nil. +When non nil, means that the msg was not meant to the bot, so the +reply please be abbreviated. ") + +(defvar fs-internal-addressedatlast nil + "internal.. normally nil") + +(defvar fs-internal-original-message "" + "internal") + +(defvar fs-internal-message-sans-bot-name "" + "internal") + +(defvar fs-internal-max-lisp-p nil) + + +(defun fsi-respond-to-query-p (msg) + ;; if it is of the form resolve? the user KNOWS what resolve or + ;; kensanata is, and is not asking for information. So, please don't + ;; respond in such a case. + (not + (member msg (mapcar 'first (fs-channel-members-all))))) + +(defcustom fs-internal-parse-preprocess-message-remove-end-chars + ;; remove trailing ^A's that occur on action strings... + (list 1) + "") + +(defcustom fs-web-page-title-p nil + "Change it to t to enable the erbot to look up the title of urls +posted in a channel. When string, will be matched against target.") + +(defcustom fsi-m8b-p nil + "Change it to t for the magic 8-ball... define m8b then of +course... +When string, will be matched against target. " +) + +(defun fsi-parse-preprocess-message (msg) + (let ((len (length msg))) + (when (and + (> len 0) + (member (aref msg (- len 1)) + fs-internal-parse-preprocess-message-remove-end-chars) + (setq msg (subseq msg 0 -1))))) + msg) + +(defvar erbn-dead-check-p nil + "If non-nil, we will not reply to people who have shot themselves +using mark-dead or russian roulette. These people need to be revived +first. Of course, like any magic, revival sometimes works, and +sometimes doesn't.") + +(defun fsi-lispify (&optional msg proc nick tgt localp + userinfo &rest foo) + "Parse the english MSG into a lisp command. + +If it is an 'is', it should always be the second word .. +viz: we had better use hyphens in the first word.. +MSG is a string.. +Is the main function.. but also available to the user as a command... + +NB: The end-result is always an expression.. and NOT a strign.. + + +Just once in a blue moon, this will, at random, even parse messages +not addressed to it... + +Finally, wanna parse messages whose last item contains erbot.. +Optional argument PROC . +Optional argument NICK . +Optional argument TGT . +Optional argument FOO . + +We will also bind a number of variables, as appropriate, for example, +fs-msg*, fs-lispargs, fs-lispa , fs-lispb... so that these vars can be used +anywhere in the code, or the user-defined parts of the code... + +In the grand scheme of things, these bindings should turn out to be +local, because the parent function calling this function should have +'letted these variables. + +" + ;;(when (stringp msg) + ;; (setq msg (split-string msg))) + ;msg + ;proc + ;nick + ;tgtg + ;foo + (setq fs-internal-original-message msg) + (setq msg (fs-parse-preprocess-message msg)) + (setq fs-msg msg) + (setq fs-msgsansbot msg) + (let* + ( + + + (msg (fs-parse-preprocess-message msg)) + (origmsg msg) + ;;(fs-internal-message-sans-bot-name fs-internal-message-sans-bot-name) + (foundquery nil) + (foundquerydouble nil) + (foundkarma nil) + ;; if t, means either our name was at last, or eevn if at + ;; first, they weren't really addressing us.. + ;;(addressedatlast nil) + (leave-alone-p t) + ;;(fs-nick nick) + bluemoon + ) + (unless (stringp origmsg) + (setq origmsg (format "%s" origmsg))) + (unless msg + (error "Format: %s (parse \"your-english-message\")" erbn-char)) + (unless (stringp msg) + (setq msg (format "%s" msg))) + ;; remove leading spaces.. + (while + (and (> (length msg) 0) + (equal (aref msg + 0) 32)) + (setq msg (substring msg 1))) + + ;; remove trailing spaces.. + (while + (and (> (length msg) 0) + (equal (aref msg (- (length msg) 1)) 32)) + (setq msg (substring msg 0 (- (length msg) 1)))) + + (when (and tgt proc) + (set-buffer (erc-get-buffer tgt proc))) + + (when + (and (stringp msg) + (string-match "\\(++\\|--\\)$" msg) + (<= (length (split-string msg)) 2)) + (setq foundkarma t)) + ;; 2003-11-14 T15:36:38-0500 (Friday) D. Goel + ;; requested by elf: + ;; if double ??, then make it a call to m8b + (when (and + fsi-m8b-p + (if (stringp fsi-m8b-p) + (and (stringp tgt) (string-match fsi-m8b-p tgt)) + t)) + (let (len) + (when (and (stringp msg) + (progn + (setq len (length msg)) t) + (> len 1) + (string= "??" + (substring msg (- len 2) len)) + ;;(or + ;;(string-match + ;;erbot-nick msg) + ;;(string-match (concat "^" erbn-char) msg) + ;;(string-match erbn-char-double msg)) + ) + (setq foundquerydouble t) + (setq msg (concat erbn-char " (m8b)"))))) + + (when (and (stringp msg) + (> (length msg) 0) + ;; ignore trailing ? + (equal (aref msg (- (length msg) 1)) 63)) + (progn + (setq foundquery t) + (setq msg (substring msg 0 (- (length msg) 1))))) + + (setq leave-alone-p t) + (setq bluemoon + (or + ;; responding to a general list conversation.. + (fs-blue-moon) + ;; responding in general.. + (and (equal nick tgt) + (or + (stringp nick) + ;; parse commands --> + (null nick) + ) + ))) + (unless (stringp msg) + (setq msg "")) + + + ;; convert midsentence ,, to parsable sentence. + (let (pos) + (when + (and (not (equal 0 + (string-match erbn-char msg))) + (not + (let ((nickpos (string-match erbot-nick msg))) + (and nickpos + (< nickpos 3)))) + ;; part of and + (setq pos + (string-match erbn-char-double msg))) + (setq msg (substring msg (+ pos 1))) + (when (setq pos (string-match erbn-char-double msg)) + (setq msg (substring msg 0 pos))))) + + ; deal with the leading , or ,, + (when (equal 0 + (string-match erbn-char msg)) + (let ((restmsg (substring msg 1))) + (when (equal 0 (string-match "," restmsg)) + (setq restmsg (substring restmsg 1))) + (setq msg (concat erbot-nick ": " restmsg)))) + + + ;; now we split strings.. + (setq msg (split-string msg)) + (setq fs-msglist msg) + (setq fs-msglistsansbot msg) + (cond + ( (and (first msg) + (let ((pos + (string-match erbot-nick (first msg)))) + (and pos (< pos 1)))) + ;;(or + ;;(erbutils-string= (first msg) erbot-nick) + ;;(erbutils-string= (first msg) (concat erbot-nick ",")) + ;(erbutils-string= (first msg) (concat erbot-nick + ;":"))) + (progn + (unless + (or + (string-match (concat erbot-nick ":") (first msg)) + (string-match (concat erbot-nick ",") (first msg)) + (null (second msg)) + (string-match "^," (second msg)) + (string-match "^:" (second msg))) + (setq fs-internal-addressedatlast t)) + (when (> (length msg) 1) + (setq msg (cdr msg))) + (setq leave-alone-p nil))) + + + ;; if it is a short sentence ending in fsbot.. + ((and (first (last msg)) (string-match erbot-nick (first (last + msg))) + (< (length msg) 5)) + ;; don't want this any more.. since no sense in removing the + ;; last term. Example: Want: what is erbot? to stay that way. + ;;(progn + ;;(setq msg (reverse (cdr (reverse msg))))) + (when leave-alone-p + (setq fs-internal-addressedatlast t)) + (setq leave-alone-p nil)) + + + + ;; this might be dangerous if nick is a small word like "apt".. + ;; this also means :( thagt erbot will intervene when users are + ;; talking about her, but not TO her.. + ;; nah, leave this one out.. + ;;((member erbot-nick msg) + ;; (setq leave-alone-p nil)) + + (bluemoon + (setq leave-alone-p nil))) + + (setq fs-internal-message-sans-bot-name + (mapconcat 'identity msg " ")) + + (when (and + foundquery + ;; if tgt is nil, we are being asked to parse + ;; something.. so cool + tgt + (string-match fs-internal-query-target-regexp tgt)) + ;; if this condition causes the thing to be triggerred, then + ;; setq temporarily, a global variable... so responses are muted + ;; in general.. + (let ((goonp nil) (newmsg msg)) + (cond + ((equal (length msg) 1) + (setq goonp + ;; setq to t only if the content of the msg represents + ;; something the user might be interested in. + (fs-respond-to-query-p (first msg)) + + )) + (t + (setq goonp t) + ;; convert what's to what is + (when (stringp (first newmsg)) + (setq newmsg + (append + (split-string (first newmsg) "'") + (cdr newmsg)))) + (if (and goonp + (member + (erbutils-downcase (first newmsg)) + fs-internal-questions)) + (setq newmsg (cdr newmsg)) + (setq goonp nil)) + (if (and goonp + (member + (erbutils-downcase (first newmsg)) + '("s" "is" "are" + ;;"am" + ))) + (setq newmsg (cdr newmsg)) + (setq goonp nil)) + + ;; remove articles + (if (and goonp + (member + (erbutils-downcase (first newmsg)) + fs-internal-articles)) + (setq newmsg (cdr newmsg))) + (unless (equal (length newmsg) 1) + (setq goonp nil)))) + (when goonp + (when leave-alone-p (setq fs-found-query-p t)) + (setq leave-alone-p nil) + (setq msg (list "(" "describe" + (format "%S" (first newmsg)) + "0" ")" + )) + )) + ) + + ;; Sat Jan 8 12:40:46 EST 2005 (petekaz) + ;; We need to make sure this is the last thing we check + ;; because we don't want to hijack another valid command + ;; with our parsing. I.e. if a user adds a term with an + ;; url included in its note, we don't process that. + (when (and leave-alone-p + fs-web-page-title-p + (if (stringp fs-web-page-title-p) + (and (stringp tgt) + (string-match fs-web-page-title-p tgt)) + t)) + (let* ((case-fold-search t) + (url (some 'erbutils-html-url-p msg))) + (when url + (setq leave-alone-p nil) + (setq msg (list "(" "web-page-title" (format "%S" url) ")"))))) + + ;; (cond + ;; ((equal (length msg) 1) + ;; (when leave-alone-p + ;; (setq fs-found-query-p t)) + ;; (setq msg (cons "describe" msg)) + ;; (setq leave-alone-p nil)) + ;; ((and + ;; (equal (length msg) 3) + ;; (member (erbutils-downcase (first msg)) + ;; fs-internal-questions) + ;; (member (erbutils-downcase (second msg)) + ;; '("is" "are"))) + ;; (setq msg (cons "describe" (cddr msg))) + ;; (when leave-alone-p + ;; (setq fs-found-query-p t)) + ;; (setq leave-alone-p nil)) + ;; ((and + ;; (equal (length msg) 3) + ;; (member (erbutils-downcase (first msg)) + ;; fs-internal-questions) + ;; (member (erbutils-downcase (second msg)) + ;; '("is" "are"))) + ;; (setq msg (cons "describe" (cddr msg))) + ;; (when leave-alone-p + ;; (setq fs-found-query-p t)) + ;; (setq leave-alone-p nil)) + + + ;;)) + + ;; finally, ignore bots/fools.. + (let ((ui (format "%S" userinfo))) + (when + (or + (and erbot-use-whitelist + (stringp nick) + (not (member-if + (lambda (arg) + (string-match arg nick)) + erbot-whitelist-nicks))) + (and (stringp nick) + (member-if + (lambda (arg) + (string-match arg nick)) + erbot-ignore-nicks)) + + (some + 'identity + (mapcar + (lambda (ignorethis) + (string-match ignorethis + ui)) + erbot-ignore-userinfos))) + (setq leave-alone-p t))) + + + (setq fs-msglistsansbot msg) +;;;==================================================== + ;; now do the work.. + (if leave-alone-p + ;; not addressed to us, so return nil and be done.. + nil + ;; else.. viz: go on... + (progn + (erblog-log-target tgt) + (let* (;(found nil) + (newmsglist nil) + (msgstr (erbutils-stringify msg)) + ;(newstrmsg nil) + (lispmsg (erbn-read msgstr) + )) + + + ;; do a dead check + (when erbn-dead-check-p (and (not foundquery) + (erbn-dead-check))) + + + (setq + newmsglist + (cond + + ;; are in a read mode.. + (erbn-read-mode + (fs-botread-feed-internal msgstr)) + + + + ;; look for a valid lisp form, then it just needs to be sandboxed + ((or + (consp lispmsg) + (and fs-internal-max-lisp-p (numberp lispmsg)) + (and fs-internal-max-lisp-p (stringp lispmsg)) + (and (symbolp lispmsg) + (let ((newsym + ;;(intern (format "fs-%S" lispmsg)) + (erblisp-sandbox lispmsg))) + (or + (equal 0 + (string-match "fs-" + (format "%S" lispmsg))) + (and + (boundp newsym) + (not (fboundp newsym))))))) + ;;(erblisp-sandbox-fuzzy lispmsg) + (erblisp-sandbox lispmsg) + ) + + + (fs-dunnet-mode + (fs-dunnet-command msgstr)) + + + ;; call to arbitrary function without parens + ;; prefer this before is etc. so that "how is it going" + ;; resolves properly.. + ((or + ;; fboundp ==> allowing macros as well.. + ;;(fboundp (intern (concat "fs-" (first msg)))) + (fboundp (erblisp-sandbox (intern (first msg)))) + ;;(functionp (intern (concat "fs-" (first msg)))) + (equal 0 (string-match "fs-" (first msg)))) + ;; this works great, except that we would like to quote the + ;; internals... because that is the most commonly used + ;; characteristic.. + ;;`("(" ,@msg ")") + (erblisp-sandbox-full + ;;`( ,(intern (first msg)) ,@(erbutils-quote-list + ;;(mapcar 'intern (cdr msg)))) + ;;(read (cons (intern (first msg)) + ;; (read (list (erbutils-stringify (cdr msg)))))) + (fsi-read (concat "( "(erbutils-stringify msg) " )")))) + + ((equal 0 + (string-match "\\(s\\|r\\)/" (first msg))) + (fs-replace-string-from-english-internal + msg)) + ((equal 0 + (string-match "[0-9]+->" (first msg))) + (fs-rearrange-from-english-internal msg)) + ( + (and + + + (or (erbutils-string= (second msg) "is" t) + (erbutils-string= (second msg) "are" t) + ;;(erbutils-string= (second msg) "am" t) + + ) + (member (erbutils-downcase (first msg)) + fs-internal-questions-all + )) + + + ;;`(apply 'fs-describe ',(cddr msg)) + `(funcall 'fs-describe + ',(third msg) + nil nil nil ,"origmsg" + ) + + ) + + ;; some english constructs first... + + ;; search removed---because: is a functionp... + ;;((erbutils-string= (first msg) "search") + ;; (setq newmsglist + ;; `("(" "search" ,@(cdr msg) ")"))) + ((and + + ;; do not want to take such cases, 100% are annoying + ;; false matches. + (not fs-internal-addressedatlast) + + (or + (erbutils-string= (second msg) "is" t) + (erbutils-string= (second msg) "are" t)) + ;;(erbutils-string= (third msg) "also" t) + (member-ignore-case (third msg) + (list "also" "also,")) + ) + (erblisp-sandbox-fuzzy + `( + fs-set-also ,(first msg) + ;;,@(erbutils-quote-list (cdddr msg)) + ,(erbutils-stringify (cdddr msg)) + ))) + ((and (erbutils-string= (first msg) "tell") + (erbutils-string= (third msg) "about")) + `(fs-tell-to + ,(erbutils-stringify (cdddr msg)) + ,(format "%s" + (second + msg)) + )) + + ( + (and + ;; do not want to take such cases, 100% are annoying + ;; false matches. + (not fs-internal-addressedatlast) + + (or (erbutils-string= (second msg) "is") + (erbutils-string= (second msg) "are"))) + (erblisp-sandbox-fuzzy + `(fs-set-term + ;; a string.. so we are safe.. + ,(first msg) + ;; another string... so we are safe.. + ,(erbutils-stringify (cddr msg))))) + + + + ((and + (not fs-internal-addressedatlast) + (or + (erbutils-string= (first msg) "no" t) + (erbutils-string= (first msg) "no," t)) + (or + (erbutils-string= (third msg) "is") + (erbutils-string= (third msg) "are") + ) + + ) + (erblisp-sandbox-fuzzy + `(fs-set-force ,(second msg) + ;;,@(erbutils-quote-list (cdddr msg)))) + ,(erbutils-stringify (cdddr msg)))) + ) + + ((let ((foo (first msg))) + (and + (not fs-internal-addressedatlast) + (<= (length msg) 2) + (string-match "\\(++\\|--\\)$" foo) + (not (fs-notes foo + )))) + (let* ((foo (first msg)) + (sec (second msg)) + (bar (substring foo 0 -2)) + (plusp (string-match "++$" foo))) + (if plusp + `(fs-karma-increase ,bar ,sec) + `(fs-karma-decrease ,bar ,sec)))) + ((or fs-internal-addressedatlast + (and fs-internal-botito-mode (> (length msg) 3))) + `(funcall 'fs-english-only ,origmsg ,fs-internal-addressedatlast)) + + (t + ;;`(apply 'fs-describe ',msg) + + ;;`(funcall 'fs-describe ',(first msg) + ;; ',(second msg) + ;; ',(third msg) + ;; nil + ;; ,origmsg + ;; ) + `(funcall 'fs-describe-from-english + ,origmsg + ',msg) + + + + + + ) + )) + ;; this should be "%S" and not "%s" the lattwer will convert + ;; (dk "k") into (dk k) + (format "%S" newmsglist)))))) + + +(defun fsi-describe-from-english (&optional origmsg msg) + "Call fs-describe appropriately. +ORIGMSG is in english. +MSG is a list.. + +Plan + +For multiple words, commence a search foo.*bar.*baz IF WE KNOW THAT +SEARCH or SEARCH--WIDE WILL SUCCEED, which will then, of course, go to +search-wide if it fails. + +Else, of course, do the usual thing: viz. call describe... + + +" + (unless (and origmsg msg) + (error "Are you a user trying to call this function? Perhaps just use +'describe instead :). Anyway, this function needs 2 arguments. ")) + (let ((len (length msg)) + mainterm firstterm remainder N M prestring expr tmpv + (searchp nil) + (multitermp nil) + (fs-internal-google-level fs-internal-google-level) + ) + (cond + ((<= len 1) + (if (fsi-notes (first msg)) + (fs-describe + (first msg) + nil nil nil origmsg) + (fs-describe + (fsi-generalize-search-term (first msg)) + nil nil nil origmsg))) + (t + (setq mainterm (first msg)) + (setq firstterm mainterm) + (setq remainder (cdr msg)) + (while + (and + remainder + (progn + (setq tmpv (first remainder)) + (and (not (integerp tmpv)) + (progn + (unless (stringp tmpv) (setq tmpv (format "%s" + tmpv))) + (not (integerp (ignore-errors (erbn-read tmpv)))))))) + ;;(setq searchp t) + (setq mainterm + (concat mainterm ".*" tmpv)) + (setq multitermp t) + (pop remainder)) + ;; why is this true only for multitermp??? + ;; Ah, because we say: if you end up searching and there are + ;; multiple terms, you might as well include a result from + ;; google among the search results. + (when multitermp + (setq fs-internal-google-level (+ fs-internal-google-level 25))) + + (when (and multitermp + ;; viz. if it will work + (second (fs-search-basic + mainterm nil nil 'describe))) + (setq searchp t)) + + + (if searchp + (fs-search + mainterm (first remainder) (second remainder) + "Try: " origmsg) + (fs-describe + (fsi-generalize-search-term firstterm) (first remainder) (second remainder) + (third remainder) origmsg)))))) + + +(defun fsi-generalize-search-term (term) + (erbutils-replace-string-in-string "-" "[ -]*" term)) + +;; (defalias 'fs-hello 'fs-hi) +;; (defalias 'fs-hey 'fs-hi) + +(defalias 'fs-thanks 'fs-thank) +(defun fs-thank (&rest args) + (let ((aa (erbutils-random '("no problem" "you are welcome" + + )))) + (eval + (erbutils-random + '( + (concat aa erbn-char " " fs-nick) + (concat fs-nick erbn-char " " aa)))))) + +(defun fs-greet (&optional nick &rest args) + ". + Optional argument NICK . + Optional argument ARGS ." + (if (and nick (not (string-match erbot-nick (format "%s" nick)))) + (format "hi %s !!" + (let ((foo (split-string (format "%s" nick ) + "[^a-bA-Z0-0]"))) + (or (first foo) nick)) + ) + (fs-describe "hi"))) + +;;; (defun fs-ni (&optional nick &rest args) +;;; ". +;;; Optional argument NICK . +;;; Optional argument ARGS ." +;;; (if (and nick (not (string-match erbot-nick (format "%s" nick)))) +;;; (format "NI %s !!" +;;; (let ((foo (split-string (format "%s" nick ) +;;; "[^a-bA-Z0-0]"))) +;;; (or (first foo) nick)) +;;; ) +;;; (fs-describe "hi"))) + +;;; (defun fs-greet (&optional nick &rest foo) +;;; "Nada..just a call to `fs-hi'. +;;; Optional argument NICK ." +;;; (fs-hi nick)) + +(defun fs-kiss (&optional nick &rest foo) + "Nada. +Optional argument NICK ." + (setq nick (format "%s" (or nick "itself"))) + (cond + ((member nick (list erbot-nick "yourself" "self")) + (eval + (erbutils-random + '("I'd rather kiss you" + "Kiss myself? Why?")))) + (t + (eval + (erbutils-random + '((format "/me kisses %s" nick) + (format "/me gives %s a big smooch" nick) + (format "/me runs in the other direction, shouting NEVER!!"))))))) + +(defun fs-hug (&optional nick) + (unless nick (setq nick "itself")) + (setq nick (format "%s" nick)) + (cond + ((member nick (list erbot-nick "yourself" "self")) + (eval + (erbutils-random + '("But i do that all the time. " + "Hug myself? Why?")))) + (t + (eval + (erbutils-random + '((format "/me gives %s a tight hug" nick) + (format "/me clings to %s" nick) + (format "/me runs in the other direction, shouting NEVER!!") + (format "/me grabs hold of %s and vows to never let go" nick) + (format "/me grabs hold of %s and vows to never let go" nick))))))) + + + + +(defun fs-love (&optional nick &rest bar) + ". +Optional argument NICK ." + + + (let ((nonep nil)) + (unless nick (setq nick "someone sexy") (setq nonep t)) + (setq nick (format "%s" nick)) + (cond + ((and (not nonep) (member nick (list "you" "me"))) + (erbutils-random + '("Thank you. Enjoyed that. " + "Thanks, I love you even more now. " + "Wouldn't that amount to interspecies sex? " + "Sex between humans and machines is not known to produce +anything useful. "))) + ((member nick + (list erbot-nick "yourself" "self")) + (erbutils-random + '("This is a complicated operation. Can't (yet) perform operation on self. " + "Please train me on this maneuver. "))) + (t + (eval + (erbutils-random + '((format "/me goes with %s to a private place..." nick) + (format "/me looks at %s and yells \"NEVER!\"" nick) + (format "/me looks at %s lustfully" nick)))))))) + +(defalias 'fs-fuck 'fs-love) + +(defvar fs-flame-target nil) + + + +(defun fsi-eval-or-say (str &optional fs-victim) + (let ((aa (when (stringp str) + (ignore-errors (erbn-read str))))) + (cond + ((consp aa) + (unless fs-victim (setq fs-victim fs-nick)) + (fsi-eval aa)) + (fs-victim + (format "%s: %s" fs-victim str)) + (t + (format "%s" str))))) + + + + + + +(defun fs-flame (&rest args) + "" + (let ((flames (ignore-errors (fs-notes "flames"))) + fs-flame-target num) + (cond ((and (numberp (cadr args)) + (not (cddr args))) + (setq fs-flame-target (car args) + num (cadr args))) + ((consp (cdr args)) + (setq fs-flame-target (mapconcat (lambda (arg) + (format "%s" arg)) + args " "))) + ((car args) + (setq fs-flame-target (format "%s" (car args)))) + (t (setq fs-flame-target (format "%s" erbot-end-user-nick)))) + (if (string= (format "%s" fs-flame-target) "me") + (setq fs-flame-target erbot-end-user-nick)) + ;; Check for flame.el support + (cond + ((and (consp flames) (> (length flames) 0)) + (fsi-eval-or-say + (if num + (nth num flames) + (fs-random-choose flames)) + fs-flame-target)) + (t (fs-flame-mild fs-flame-target))))) + + + + + + +(defun fs-flame-mild (&rest args) + "Doesn't really flame right now.. +Optional argument ARGS ." + (let ((target + (if (first args) + (format "%s" (first args)) + erbot-end-user-nick))) + (if (string= (format "%s" target) "me") + (setq target erbot-end-user-nick)) + ;; Check for flame.el support + (if (featurep 'flame) + (eval + (erbutils-random + '( + (format (erbutils-random erbdata-flames) + target target target) + (concat target ": " (flame-string))) + '(1 30))) + (format (erbutils-random erbdata-flames) + target target target)))) + +;; remove kill +;(defun fs-kill (&optional nick &rest nicks) +; ". +;Optional argument NICK . +;Optional argument NICKS ." +; (format "/me , trained by apt, chops %s into half with an AOL CD" nick));; + +;(defun fs-quote (&rest args) +; (quote args)) + +(defun fs-bye (&rest msg) + "" + (erbutils-random + '("Okay, see you later" + "later" + "Bye then" + "Take care now" + "Happy hacking"))) + + +;;; (defun fs-help (&rest args) +;;; "Introductiry help. " +;;; (let ((fir (first args))) +;;; (if (stringp fir) +;;; (setq fir (intern fir))) +;;; (unless (symbolp fir) (setq fir 'dummy-no-help)) +;;; (if (null fir) +;;; "I try to understand English, though lisp is the real way to go. Here are some interesting topics: quickstart, example, future-features, help about, help commands, help data, help english, help name, help homepage, +;;; help owner, help specs, help parse \(for lisp stuff\), describe help, describe suggest , help parse-web , help functionality +;;; " +;;; (cond +;;; ((equal fir 'about) +;;; (fs-help 'name)) +;;; ((equal fir 'owner) +;;; (fs-help 'data)) + +;;; ((equal fir 'name) +;;; "I am erbot: The Free Software Bot, using ERC in emacs.. +;;; I can also be addressed by , .. yeah, a comma .. +;;; The real way to address me is erbot: (lisp-command..) .. all this +;;; english is just candy-interface... ") +;;; ((equal fir 'specs) +;;; "/sv") +;;; ((equal fir 'address) +;;; (fs-help 'name)) +;;; ((equal fir 'homepage) +;;; "homepage: http://deego.gnufans.org/~deego/pub/emacspub/lisp-mine/erbot/ +;;; Data: http://deego.gnufans.org/~erbot/data/ +;;; Suggestions to D. Goel: deego@gnufans.org") +;;; ((equal fir 'code) +;;; (fs-help 'homepage)) +;;; ((equal fir 'data) +;;; (fs-help 'homepage)) +;;; ((equal fir 'suggestions) +;;; "Add stuff to keyword suggest, also see help homepage") +;;; ((equal fir 'english) +;;; "Some common syntaxes: , foo is bar; , foo is also bar; +;;; , no foo is bar; , forget foo ; , flame nick; , doctor ; etc.") +;;; ((equal fir 'parse) +;;; "Try the command , parse \", <english-message>\" to see the +;;; lisp renditions of your english messages") +;;; ((equal fir 'parse-web) +;;; "Ask me to parse a (please: USEFUL PAGE) webpage and a label +;;; and i will do so in my free time and gain knowledege... under +;;; construction.. ") +;;; ((equal fir 'functionality) +;;; "Bulk of the info is stored as assoc-list data (see +;;; homepage). You generally type foo and the corresp. data is +;;; returned.. you can also (search ... )") +;;; ((equal fir 'commands) +;;; " You can use both lisp and english to communicate.. +;;; Type , (commands) to get a list of commands..") + +;;; ((equal fir 'suggest) +;;; "Add your suggestions to the field \"suggestions\", or contact the author") + + +;;; (t "select an option or Type , help for a list of options.." +;;; ))))) + + + + + + +(defun fsi-command-list (&rest foo) + "Used by erbc.el and by erbot-install.. " + (erbn-command-list-from-prefix "fs-")) + + +(defun fsi-command-list-readonly (&rest foo) + "Used by erbc.el.. and erbot-install " + (erbn-command-list-from-prefix "fsi-")) + + +(defun erbn-command-list-from-prefix (prefix &rest foo) + "Used by erbc.el.. should return a string.." + (let* + ((longnames (erbutils-matching-functions prefix)) + (shortnames + (with-temp-buffer + (insert (format "%s" longnames)) + (goto-char (point-min)) + (replace-string prefix "") + (text-mode) + (fill-paragraph 1) + (erbn-read (buffer-substring (point-min) (point-max)))))) + shortnames)) + +(defun fsi-commands (&optional regexp N M &rest foo) + "List available commands matching REGEXP. If N and M provided, list +matches starting at N and ending at M. " + (if (and regexp (not (stringp regexp))) + (setq regexp (format "%s" regexp))) + (let* ((all-commands (fs-command-list)) + (pruned-commands + (if (stringp regexp) + (mapcon + '(lambda (arg) + (if (string-match regexp (format "%s" (car arg))) + (list (car arg)) nil)) + all-commands) + all-commands)) + (len (length pruned-commands)) + final-commands + (str0 "") + (str1 "") + (str2 "") + (str3 "") + (str4 "")) + (setq str0 (format "%s matches. " len)) + (unless (or (< len 20) (and (integerp N) (> N 0))) + (setq str1 + "Perhaps type , df commands for general syntax. ")) + (unless (integerp N) (setq N 0)) + (unless (integerp M) (setq M len)) + (if (= M N) (setq M (+ N 1))) + (when (> M len) (setq M len)) + (if (> N 0) (setq str2 (format "Matches starting at %s -->" N))) + (setq final-commands (subseq pruned-commands N M)) + (setq str3 + (format "%s" final-commands)) + (concat str0 str1 str2 str3))) + + + +(defun fsi-describe-commands (&rest foo) + "Just a help command. Describes how to run commands. " + (concat + "If you use plain english, it simply gets transformed to lisp +commands.. main/default command: (describe).. to see transformation, +use (parse). See also fs-commands. + +PS: no naughty ideas please :)--- the commands are sandboxed via an +fs- prefix.. + +Future commands: info-search, hurd-info-search etc. etc. +" +)) + + +(defalias 'fsi-d 'fs-describe) + + +(defun fsi-search (&optional regexp N M prestring expr &rest rest) + "Search for the REGEXP from among all the terms (and their +descriptions). See also fs-search-wide. +EXPR (optional) is the full initial expression.. " + (unless regexp + (error "Syntax: , s REGEXP &optional N M")) + (let* ((len-results (apply 'fs-search-basic regexp N M nil + rest)) + (len (first len-results)) + (results (second len-results)) + (str0 " ") + (str1 "") + (str2 "") + (str3 "") + (str4 "") + (str5 "") + ) + (when (and (> len 100) (not prestring)) + (setq str0 (format " Use , s REGEXP N M to limit results. "))) + (when (and (< len 5) (not prestring)) + (setq str0 (format " Perhaps try also , sw %s . " regexp))) + (unless prestring (setq str1 (format "%s match(es). " len))) + (if (and (integerp N) (> N 0) (not prestring)) + (setq str2 (format "Matches starting at %s\n" N))) + (unless prestring (setq str3 "--> ")) + (setq str4 + (mapconcat 'identity + results " " + ) + + ) + (when (and (> fs-internal-google-level 80) (> len 1)) + (setq str5 + (let ((foo (fs-google-lucky-raw + fs-internal-message-sans-bot-name))) + (if foo (concat " " foo) str5)))) + (cond + ((and prestring (= len 1)) + (fs-describe (first results))) + ((and (> len 0) + (or + (not prestring) + (< len fs-internal-english-max-matches))) + (unless (stringp prestring) + (setq prestring "")) + (concat prestring str0 str1 str2 str3 str4 str5)) + (t (apply 'fs-search-wide regexp N M + "Try: " + (or expr fs-internal-original-message) + rest))))) + + +(defun fsi-search-wide-sensitive (&rest args) + "Like fs-search-wide, but case-sensitive" + (let ((case-fold-search nil) + (bbdb-case-fold-search nil)) + (apply 'fs-search-wide args))) + + + + + + + + +(defun fsi-search-wide (&optional regexp N M prestring expr &rest rest) + "Search for the REGEXP from among all the terms (and their +descriptions). See also fs-search-wide. +EXPR is the full initial expression, well, mostly.. +" + (let* ((len-results (apply 'fs-search-basic regexp N M 'describe + rest)) + (len (first len-results)) + (results (second len-results)) + (str0 "") + (str1 "") + (str2 "") + (str3 "") + (str4 "") + (str5 "") + ) + (when (and (> len fs-internal-english-max-matches) (not prestring)) + (setq str0 (format "Perhaps try also , s %s . " regexp))) + (unless prestring (setq str1 (format "%s match(es). " len))) + (if (and (integerp N) (> N 0) (not prestring)) + (setq str2 (format "Matches starting at %s\n" N))) + (unless prestring (setq str3 "--> ")) + (setq str4 + ;;(format "%s" results) + (mapconcat 'identity results " ") + ) + (when (and (> fs-internal-google-level 80) (> len 1)) + (setq str5 + (let ((foo (apply 'fs-google-lucky-raw + fs-internal-message-sans-bot-name + (fs-get-google-defaults) + ))) + + (if foo (concat " " foo) str5)))) + + ;; why does this not work as expeecteD? adding a nil for now: + (when (and prestring (>= len fs-internal-english-max-matches)) + (setq fsi-prestring + (concat fsi-prestring + "[Too many DB matches] "))) + (cond + ((and prestring (= len 1)) + (fs-describe (first results))) + ((and (> len 0) + (or (not prestring) + (< len fs-internal-english-max-matches))) + (unless (stringp prestring) + (setq prestring "")) + (concat prestring str0 str1 str2 str3 str4 str5)) + (t + (fs-english-only (or expr fs-internal-original-message) + nil + ))))) + + +(defcustom erbn-greeting-string + "Greetings and Salutations from %s" "") + + +(defun fsi-english-only (expr &optional addressedatlast nogoogle) + "when addressedatlast is t, means that fsbot/botito was triggered because +it was addressed at last. " + ;; expr should already be a string ...but just in case: + (unless expr (setq expr fs-internal-original-message)) + (setq expr (erbutils-downcase (erbutils-stringify expr + + ))) + (let ((exprlist (split-string expr + ;;"[ \f\t\n\r\v]+" + "[^a-zA-Z0-9]" + )) + (gotit nil) + ans len + ) + (setq exprlist (remove "" exprlist)) + (setq len (length exprlist)) + (cond + ((or + + (and (= len 1) + (string-match erbot-nick (first exprlist)))) + (setq gotit t + ans + (format erbn-greeting-string + erbot-nick))) + ((or + (member "hi" exprlist) + (member "hello" exprlist) + (member "yo" exprlist)) + (setq + gotit + t + ans + (concat + (erbutils-random + '("hi " "hello " "hey " "hei ")) + (erbutils-random + '("sexy! " "!!" "there" ""))))) + + ((member "bye" exprlist) + (setq gotit t + ans + (erbutils-random + '("Later" "See ya" "Bye then" "Bye")))) + ((or + (member "welcome" exprlist) + (member "weclome" exprlist)) + (setq gotit t + ans + (erbutils-random + '(":-)" "How goes?" "Hello!" + "Greetings!" + "How is it going?" + "This is my favorite channel!" + "I love this place. " + "Thanks. I love it here.")))) + + ((or + (member "tnx" exprlist) + (member "tnks" exprlist) + (member "thanks" exprlist) + (member "thanku" exprlist) + (member "thankyou" exprlist) + (and (string-match "thank" expr) + (or + (string-match "you" expr) + (string-match erbot-nick expr)) + (string-match "thank you" expr))) + (setq gotit t + ans + (erbutils-random + '("No problem" "Welcome!" "You're welcome" + "no problemo" + "Sure!" + "(:" + "Cool." + + )))) + + ((or (member "thx" exprlist) + (member "thankx" exprlist) + (member "thanx" exprlist) + ) + (setq gotit t + ans + (erbutils-random + '("np" "urw" "hehe, np" )))) + ((or (string-match "wassup" expr) + (string-match "what's up" expr)) + (setq gotit t + ans + (concat + (erbutils-random + '("Nothing much. " "Just, you know. " + "Just the usual..")) + (erbutils-random + '("And you? " "How about you? " + "How goes with you? " + "What have you been up to?"))))) + ( + (or + (string-match "love" expr) + (string-match "like" expr)) + (setq gotit t + ans + (format "%s loves you!" erbot-nick))) + ( + (or + (string-match "hate" expr) + (string-match "dislike" expr) + (string-match "don't like" expr)) + (setq gotit t + ans + (format "%s only has love for you!" erbot-nick))) + + ((string-match "help" expr) + (setq gotit t + ans (format "Type , help"))) + ((or (member "bot" exprlist) + (member "robot" exprlist)) + (setq gotit t + ans + (concat + (erbutils-random + '( + "I am just an ordinary human" + "I am an organic" + "Why? Do you speak lisp?" + "Why? Do you have a lisp?" + "I am human. Are you a bot?" + "I am human. Are you a robot?" + "I am not a bot" + "Fine, say what you like" + "Bots should have rights too, not that I am one" + "Are you a bot-rights abuser?" + "I am a human. You?" + "YEAH!! I AM A GIANT ROBOT!")) + (erbutils-random + '("" "!")) + (erbutils-random + '("" " :)" " :(" " ;)" " :D" " heh"))))) + + + ) + + (if gotit ans + (if (and addressedatlast (not fs-internal-botito-mode)) + 'noreply + ;;(cond ((> rand fs-internal-doctor-rarity) + (if (and (> fs-internal-google-level 50) (not nogoogle)) + (apply 'fs-google-from-english fs-internal-message-sans-bot-name + (fs-get-google-defaults) + ) + (funcall 'fs-do-weighted-random (erbutils-stringify + expr + ))))))) +;;(t (apply 'fs-suggest-describe expr))))))) + +(defun fsi-eval (expr) + (eval + (erblisp-sandbox expr))) + + + +;;; (defmacro fs-apply (&optional msymbol &rest mexprs) +;;; (cond +;;; ((and (listp msymbol) +;;; (not (equal (first msymbol) "quote"))) +;;; (error "unquoted list")) +;;; ((and (symbolp msymbol) +;;; (not (equal 0 +;;; (string-match "fs-" +;;; (format "%s" msymbol))))) +;;; (setq msymbol (intern (format "fs-%s" msymbol)))) +;;; (t "Funcalling foo is really bar!")) +;;; `(erbnocmd-apply ,msymbol ,@mexprs)) + + + + +;;; (cond +;;; ((null mexprs) +;;; `(fs-funcall ,msymbol ,mexprs)) +;;; (t +;;; (let ((erbnocmd-tmpvar (length mexprs))) +;;; `(fs-funcall +;;; ,msymbol +;;; ,@(subseq mexprs 0 (- erbnocmd-tmpvar 1)) +;;; ,@(erblisp-sandbox-quoted (first (last mexprs)))))) +;;; )) + + +;;; (defmacro fs-funcall (&optional msymbol &rest mexprs) +;;; "This makes sure that if the first argument to fs- was a +;;; variable instead of a symbol, that variable does not get evaluated, +;;; unless it begins in fs-, or that variable gets converted to fs-." +;;; (when +;;; (listp msymbol) +;;; (setq msymbol +;;; (erblisp-sandbox-quoted msymbol)) +;;; (when (equal (first msymbol) 'quote) +;;; (setq msymbol (cdr msymbol)))) +;;; (when +;;; (and (symbolp msymbol) +;;; (not (equal 0 +;;; (string-match "fs-" +;;; (format "%s" msymbol))))) +;;; (setq msymbol (intern (format "fs-%s" msymbol)))) +;;; (unless +;;; (or (listp msymbol) (symbolp msymbol)) +;;; (error "Macros confuse this bot!")) +;;; `(erbnocmd-funcall ,msymbol ,@mexprs)) + + +;;; (defun erbnocmd-funcall (&optional symbol &rest exprs) +;;; (let (erbnocmd-ss ) +;;; (unless +;;; (or (symbolp symbol) +;;; (listp symbol)) +;;; (error "Syntax: (funcall SYMBOL &rest arguments)")) +;;; (unless +;;; (functionp symbol) +;;; (error "Even smart bots like me can't funcall nonfunctions. ")) +;;; (setq erbnocmd-ss (erblisp-sandbox-quoted symbol)) +;;; (when (listp erbnocmd-ss) +;;; (when (equal (first erbnocmd-ss) 'quote) +;;; (setq erbnocmd-ss (cadr erbnocmd-ss))) +;;; (unless (listp erbnocmd-ss) (error "no lambda in quote")) +;;; (unless (member (first erbnocmd-ss) '(fs-lambda lambda)) +;;; (error "Lambda unmember")) +;;; (when (equal (first erbnocmd-ss) 'fs-lambda) +;;; (setq erbnocmd-ss (cons 'lambda (cdr erbnocmd-ss))))) +;;; (cond +;;; ((null erbnocmd-apply-p) +;;; (erbnocmd-apply-basic +;;; erbnocmd-ss +;;; exprs)) +;;; ;; wanna apply +;;; (t +;;; (let ((len (length exprs))) +;;; (erbnocmd-apply-basic +;;; erbnocmd-ss +;;; (append +;;; (subseq exprs 0 (- len 1)) +;;; (first (last exprs))))))))) + + + +;;; (defun erbnocmd-apply-basic (fcn &rest args) +;;; (cond +;;; ((functionp fcn) +;;; (apply fcn args)) +;;; (t +;;; (fs-apply +;;; (erbnocmd-user-fcn-definition +;;; fcn) +;;; args)))) + +;;; ;;; (defun erbnocmd-apply (&optional symbol &rest args) +;;; ;;; (if (null args) +;;; ;;; (erbnocmd-funcall symbol) +;;; ;;; (let* ((rev (reverse args)) +;;; ;;; (fir (first rev)) +;;; ;;; (args1 (reverse (rest rev)))) +;;; ;;; (apply +;;; ;;; 'erbnocmd-funcall +;;; ;;; symbol +;;; ;;; (append +;;; ;;; (mapcar 'erblisp-sandbox-fuzzy +;;; ;;; args1) +;;; ;;; (mapcar 'erblisp-sandbox-fuzzy +;;; ;;; fir)))))) + + + +(defun fsi-search-basic (&optional regexp N M describep &rest rest) + "Don't call directly.. meant as a building block for other functions. + Search for the REGEXP from among all the terms (and their + descriptions). See also fs-search-wide. That function actually + calls this function with describep set to 'describe. + + Returns (len list-of-pruned-results). Len is the total number of + results. + + When describep is non-nil, search the whole bbdb, not just names.. " + (unless regexp + (error "Syntax: , sw regexp &optional N M")) + (let* ((bar (cons regexp (cons N rest))) + (foo (if (stringp regexp) regexp + (if regexp (format "%s" regexp) + "^$"))) + (barbar + (append + (and regexp (list regexp)) + (and N (list N)) + (and M (list M)) + (and describep (list describep)) + rest)) + (regexp-notes + (if (equal describep 'describe) + foo nil)) + records results + ) + + (if (stringp N) + (setq N (erbn-read N))) + (unless (integerp N) + (setq N 0)) + (if (stringp M) + (setq M (erbn-read M))) + (if (and (integerp M) (= M N)) + (setq M (+ N 1))) + (setq records + (if (equal describep 'describe) + (bbdb-search (bbdb-records) + foo nil nil foo) + (bbdb-search (bbdb-records) foo))) + + (setq results (mapcar '(lambda (arg) (aref arg 0)) records)) + (let ((len (length results))) + (unless (and (integerp M) (< M len)) + (setq M len)) + (list len (subseq results N M))))) + + +(defvar fs-internal-describe-literally-p nil) + + + + +(defvar fs-msg "The exact current message being parsed. ") +(defvar fs-msglist "Message broken into list. This list may have +removed characters like ? and ,, No guarantees here. See +fs-msgsandbot instead.") +(defvar fs-msgsansbot nil "Current message being parsed, but the +invocation part removed. ") + +(defvar fs-msglistsansbot nil + "Message broken into list, invocation parts removed. + +.. with the invokation parts, like ,, or , or fsbot:, removed. Thus, +if message taken from the middle of a sentence, then this is the list +from only that part. ") + + + + +(defvar fs-lispargs nil + "Will be used when using the lisp form") + + + +(defvar fs-lispa nil + "Will be used when using the lisp form") + + +(defvar fs-lispb nil + "Will be used when using the lisp form") + + +(defvar fs-lispc nil + "Will be used when using the lisp form") + +(defvar fs-lispd nil + "Will be used when using the lisp form") + +(defvar fs-lispe nil + "Will be used when using the lisp form") + + + +(defun fsi-describe-literally (&rest rest) + (unless rest + (error "Format: , describe-literally TERM [FROM] [TO]")) + (let ((fs-internal-describe-literally-p t) + (fir (first rest)) + (res (rest rest))) + (cond + (fir + (apply 'fs-describe + (if (stringp fir) (regexp-quote fir) + (regexp-quote (format "%s" fir))) + res)) + (t (apply 'fs-describe rest))))) + + +(defvar erbnocmd-describe-search-p t) + +(defun fsi-describe (&optional mainterm N M prestring expr &rest rest) + "The general syntax is (fs-describe TERM [N] [M]). +Looks for TERM, and shows its descriptions starting at description +number N, and ending at M-1. The first record is numbered 0. +" + (let + ;;((fs-lispargs (append (list mainterm N M prestring expr) rest))) + ;; nothing, just a let not used any more.. + ((fs-nothingsorry nil)) + ;; in the global scheme of things, this will turn out to be only a + ;; local binding, since erbeng-main will have (let)'ed this. Same + ;; for fs-lispa , fs-lispb, fs-lispc... + + (setq fs-lispargs (mapcar 'fsi-read-or-orig (cdr fs-msglistsansbot))) + (when fs-found-query-p + (setq N 0) + (setq M 1)) + (unless prestring (setq prestring "")) + (unless mainterm + (error + "Format , (describe TERM &optional number1 number2)")) + (let* ((bar (cons mainterm (cons N rest))) + (foo (format "%s" mainterm)) + (barbar + (append + (and mainterm (list mainterm)) + (and N (list N)) + (and M (list M)) + rest)) + + ) + (setq foo (fs-correct-entry foo)) + (if (stringp N) + (setq N (erbn-read N))) + (unless (integerp N) + (setq N 0)) + (if (stringp M) + (setq M (erbn-read M))) + (if (and (integerp M) (= M N)) + (setq M (+ N 1))) + (unless (stringp foo) + (setq foo (format "%s" foo))) + (let* ((result0 + (erbbdb-get-exact-notes + foo + )) + (result1 (and (stringp result0) + (ignore-errors (erbn-read result0)))) + (len (length result1)) + (newM (if (and (integerp M) + (< M len)) + M len)) + (result (subseq result1 N newM)) + (shortenedp (or (< newM len) + (> N 0))) + ) + + + (cond + ;; in cond0 + (result1 + (let* ( + ;; notice the use of result1 here, not result. + (aa (first result1)) + (aarest (cdr result1)) + (bb (split-string aa)) + + (cc (first bb)) + (dd (second bb)) + (ddd (or (and (stringp dd) (regexp-quote dd)) "")) + (ee (cdr bb)) + (expandp + (and + (not fs-internal-describe-literally-p) + + ;;(equal len 1) + )) + + ) + + (if (and + (equal cc "directonly") + ;;(equal len 1) + ) + ;; hmm this if part still doesn't take care of aa.. + (if fs-found-query-p + (progn + (setq aa "lisp 'noreply") + (setq bb (split-string aa)) + (setq cc (first bb)) + (setq dd (second bb)) + (setq dd (or (and (stringp dd) (regexp-quote dd)) "")) + (setq ee (cdr bb))) + (when expandp + (progn + (setq bb (cdr bb)) + (setq aa (mapconcat 'identity bb " ")) + (setq result1 (cons aa aarest)) + (setq result (subseq result1 N newM)) + (setq cc (first bb)) + (setq dd (second bb)) + (setq ddd (or (and (stringp dd) + (regexp-quote dd)) "")) + (setq ee (cdr bb)))) + + + + )) + (cond + ((and expandp + (erbutils-string= cc "redirect") + ;; do not redirect, when term had multiple + ;; entries: + (not aarest) + dd) + (apply 'fs-describe ddd + N M + (format "[->] " + ) + rest)) + ((and expandp (member cc '("unecho" "noecho")) + dd) + ;;dd) + (erbutils-itemize + (cons + (format "%s" + (mapconcat 'identity ee " ")) + (cdr result)) + N + shortenedp + )) + ((and expandp (member cc '("lisp"))) + (let* + ((fs-nothingsorry nil)) + ;; (fs-lispargs fs-lispargs) ;; no need + (setq fs-lispa (nth 0 fs-lispargs)) + (setq fs-lispb (nth 1 fs-lispargs)) + (setq fs-lispc (nth 2 fs-lispargs)) + (setq fs-lispd (nth 3 fs-lispargs)) + (setq fs-lispe (nth 4 fs-lispargs)) + (erbeng-main + (concat erbn-char " (progn " + (substring aa + (with-temp-buffer + (insert aa) + (goto-char (point-min)) + (search-forward "lisp" nil t))) + " )") + + erbeng-proc + erbeng-nick erbeng-tgt erbeng-localp + erbeng-userinfo))) + + + (t + (erbutils-add-nick-maybe + (concat + prestring + (format + (erbutils-random + '( + ;;"%s is perhaps " + "%s is, like, " + "I heard %s is " + "I think %s is " + ;;"/me thinks %s is " + "%s -- " + ;;"%s is " + "%s is " + "hmm, %s is " + "From memory, %s is " + )) + ;; 2004-01-27 T17:21:55-0500 (Tuesday) D. Goel + ;; why regexp-quote here?? changing it.. + ;;(regexp-quote foo) + foo + ) + ;; and notice the use of result here.. + (if result + (erbutils-itemize result N shortenedp) + (erbutils-itemize result1 0)) + ))) + + + + ))) + + ;; in cond0 + ;; else + (fs-found-query-p + 'noreply) + ((not erbnocmd-describe-search-p) + ;; most likely: redirected but the redirected stuff does not exist.. + (format + "Missing redirect. %s is now on fire. (Try , dl) " + erbot-nick mainterm)) + (t + ;; prevent any further expansions on further loopbacks. + (let ((erbnocmd-describe-search-p nil)) + (fs-search + mainterm nil nil + (concat prestring "try: ") + ;;barbar + expr + )))))))) + +(defvar fs-internal-doctor-rarity 80 + "A large number(1--100) means rarer doctor inovcation upon no matches." + ) + + +(defun fsi-suggest-describe (&rest terms) + "Fallback for when `fs-describe' fails. +It then (often) calls this function, which suggests +alternatives. +Optional argument TERMS ." + (let ((term (format "%s" (first terms))) + (none (erbutils-random + '("No such term.." + "Beeeeep..." + "<LOUD ERROR MSG >.." + "No luck.." + "No match.." + "Drew a blank.." + "Does not compute.."))) + (num (random 100))) + (cond + ((< num 30) + (concat none + (format "Perhaps try: , s %s or , sw %s or , %s 0" term + term term))) + ((< num 60) + (concat none + (format "Try search or search-wide on %s" term))) + (t + (concat none + (erbutils-random '("perhaps " "why not " "please " )) + "tell me what " term " is?"))))) + + +(defun fs-do-random (&optional msg nick &rest ignored) + "Either play doctor, or zippy or flame someone.. all at random..." + (case (random 4) + (0 (fs-doctor msg)) + (1 (fs-flame nick)) + (2 (fs-yow)) + (3 (fs-fortune)) + ) + ;;(3 (fs-bottalk)) + ) + +(defcustom fs-internal-english-weights + '(58 ;; doc + 17 ;; yow + 17 ;; fortune + 4 ;; flame + 4 ;; spook + 0 ;; pray + ) + "" + :group 'erbc) + +(defun fs-do-weighted-random (&optional msg nick &rest ignored) + "Either play doctor, or zippy or flame someone.. all at random..." + (let ((foo (random 100))) + (eval + (erbutils-random + `((fs-doctor ,msg) + (fs-yow ,msg) + (fs-fortune ,msg) + (fs-flame ,nick) + (fs-spook) + (fs-pray) + ) + fs-internal-english-weights)))) + + + + +(defun fsi-yow (&rest args) + "" + (erbutils-eval-until-limited + '(yow))) + +(defun fsi-rearrange (&optional from to term &rest dummy) + "Syntax: FROM->TO in TERM. +Move the FROMth entry to the TOth position in the given TERM. +Numbering of positions starts from 0. " + (unless term (error "Syntax: , N->M in TERM (no term found)")) + (when (stringp from) + (setq from (erbn-read from))) + (when (stringp to) + (setq to (erbn-read to))) + (unless (stringp term) + (setq term (format "%s" term))) + (let* + ((exactnotes (erbbdb-get-exact-notes term)) + (realterm (erbbdb-get-exact-name term)) + (notes (and (stringp exactnotes ) (erbn-read exactnotes))) + (len (length notes)) + (max (- len 1)) + (newnotes notes) + remlist + thisnote + (tostring (downcase (format "%s" to))) + ) + (unless realterm + (error "No such term exists %S" term)) + (unless notes + (error "Report this bug. Term exists but no notes?? %S" term)) + (when (string= tostring "last") + (setq to max)) + (when (string= tostring "first") + (setq to 0)) + (unless (and (integerp from) + (<= from max) (>= from 0)) + (error "The from term %S should lie between %S and %S" + from 0 max)) + (setq thisnote (nth from notes)) + (setq remlist + (append (subseq notes 0 from) + (subseq notes (+ from 1)))) + (setq newnotes + (append (subseq remlist 0 to) + (list thisnote) + (subseq remlist to))) + (erbot-working + (fs-forget term "all") + (fs-set-term realterm newnotes)) + (erbbdb-save) + (format "Moved entry %S to %S in %S" from to realterm) + )) + +;;; 2002-09-04 T01:51:08-0400 (Wednesday) D. Goel +(defun fsi-forget (&optional name number &rest dummy) + "Remove the entry correponding to NAME in the database. +With NUMBER, forget only the NUMBERth entry of NAME. " + + ;; before we do the usual thing, let's see if we need to and can get + ;; away with exchanging name and number. + (when + (and + (numberp name) + (not (string= (format "%s" number) + "all")) + ) + (let ((fstmp number)) + (setq number name) + (setq name fstmp))) + (unless (stringp name) + (setq name (format "%s" name))) + (unless name + (error "Syntax: , forget TERM &optional NUMBER")) + (setq name (fs-correct-entry name)) + (let* + (numstring + (entries0 (erbbdb-get-exact-notes name)) + (entries (and (stringp entries0 ) + (ignore-errors (erbn-read entries0)))) + (len (length entries))) + + (unless entries + (error "No such term %s" name)) + (when (and (null number) (= len 1)) + (setq number 0)) + (setq numstring (downcase (format "%s" number))) + (when (stringp number) + (setq number (erbn-read number))) + (unless (integerp number) (setq number nil)) + (unless + (or number + (string= numstring "all")) + (error "Syntax: , forget TERM [NUMBER or \"all\"]")) + (when number + (unless (and (< number len) (>= number 0)) + (error "Number should be \"all\" or lie between 0 and %s" + (- len 1)))) + ;; Note that this does remove the field but throws a strange error.. + ;; "Record doubleplus inpresent... It is just us who are discarding + ;; this error.. ... + ;; yet the field gets deleted.. and bbdb does not get saved at this + ;; time.. because of the error ...OH well, it works.. let's move on + ;; for now.. + (cond + ( + (and (equal number 0) + (= len 1)) + (ignore-errors (erbbdb-remove name)) + (erbbdb-save) + (format "Forgot %S which had exactly one entry." name)) + ((string= numstring "all") + (ignore-errors (erbbdb-remove name)) + (erbbdb-save) + (if (= len 1) (format "Forgot the single entry in %S" name) + (format "Forgot all %s entries of %S" len name))) + (t + (fs-forget name "all") + (fs-set-term + name + (append + (subseq entries 0 number) + (subseq entries (+ number 1)))) + (message "Removed entry %s of %s" number name))))) + + + +(defvar fs-set-add-all-p nil + "") + +(make-variable-buffer-local 'fs-set-add-all-p) + + +(defun fsi-set-add-all-enable () + (setq fs-set-add-all-p t)) +(defun fsi-set-add-all-disable () + (setq fs-set-add-all-p nil)) + +(defun fsi-set-add-all-toggle () + "Enable the \"is\" command to always work. +viz. Add field even if another field is already present. This is not the +recommended usage in general, except when using automated scripts to +train the bot. The default is nil, which suggests the user to use +\"is also\" instead. " + + (setq fs-set-add-all-p (not fs-set-add-all-p)) + (format + "All-is mode set to %S. To toggle, type , (fs-set-add-all-toggle)" + fs-set-add-all-p)) + +(defun fsi-set-term (&rest args) + "Add an entry to database. +An entry gleaned from (first ARGS) is +added. (second ARGS) is the description. The entry is converted to +lowercase, and all whitespace is converted to colons." + (let ((name (fs-correct-entry (format "%s" (first args)))) + (records (cadr args))) + (unless (listp records) (setq records (list records))) + (setq records (mapcar + '(lambda (arg) (format "%s" arg)) + records)) + (let ((current + (erbbdb-get-exact-notes name))) + (cond + ((null records) + (error "Please specify a description for %s.. Type , df fs-set-term for more details" name)) + + ((and current (string= current "")) + (progn (erbbdb-create name records) + (format "Added field to the currently empty %s " name))) + (current + (if fs-set-add-all-p + (apply 'fs-set-also args) + (error + "%s is already something else.. Use 'is also'.. \n Currently: %s" name + + (let* ((notes (fs-notes name)) + (shortenedp (> (length notes) 1))) + (erbutils-itemize + (list (first notes)) + 0 shortenedp)) + + ))) + (t + (progn (erbbdb-create name records) + (format "created." + ))))))) + + +(defun fsi-chase-redirects (name) + "either return nil or the redirected entry. " + (let* ((notes (fs-notes name)) + (fir (first notes))) + (when (and (stringp fir) + ;; do not chase redirects if a term has a second + ;; entry... + ;; In that case, the first entry should not have been a + ;; redirect in any case. + (= (length notes) 1) + (equal 0 (string-match "redirect\\b" fir))) + (let* ((foo (split-string fir)) + (sec (second foo))) + (if (stringp sec) sec + name))))) + + +(defun fsi-set-also (&rest args) + "Add more fields to the the database-entry gleaned from (first ARGS). +\(second ARGS) contains the new descriptions. +Record should be a single entity here... a string..." + (let* ((name (fs-correct-entry (format "%s" (first args)))) + (record (format "%s" (second args))) + notes + ;;(notes (fs-notes name))) + ) + (setq name (or (fs-chase-redirects name) name)) + (setq notes (fs-notes name)) + (unless notes (error "But there's no such record: %s" name)) + (cond + ((member record notes) + (format "Not added. This entry already exists in the term %S" name)) + (t + (erbbdb-add name record) + ;;(run-hook-with-args 'erbot-notify-add-functions nick channel + ;;name (length notes) + (format "Added entry to the term %S" name))))) + + +(defun fsi-doctor (&rest foo) + "" + (erbutils-add-nick + (funcall 'erbot-doctor + (erbutils-stringify foo)))) + + +(defun fsi-dunnet-command (&rest foo) + ;;(let ((fs-limit-lines 8)) + ;;(fs-limit-lines + ;;(let ((dun-batch-mode t)) + (funcall 'erbot-dunnet + (erbutils-stringify foo))) + + +(defun fsi-info-search (&rest foo) + "info-search.. Coming soon...will tell the number of matches +in manuals of HURD, tramp, eshell, elisp, gnus, message, emacs, ebrowse, calc, +gdb, make sawfish, cl-emacs, bash, gnuplot, latex and others by demand...") + +;; NO! else fsbot responds to <nick> fsbot is cool! in a wrong way. +;; (defalias 'fs-is 'erbutils-info-search) + +(defun fs-hurd-info-search (&rest foo) + "Coming soon...") +(defalias 'fs-his 'erbutils-hurd-info-search) + +(defun fsi-blue-moon (&rest foo) + "Return true in a really rare case. Currently 1 in 100,000.. was 1 in +2000. " + (= (random 100000) 0)) + + +(defun fsi-set-force (&rest args) + "Forget an entry and add new fields to it.. +Syntax: , no foo is bar." + (progn + (let* ((fir (first args)) + (aa (erbbdb-get-exact-notes fir)) + (notes (and (stringp aa) (erbn-read aa))) + (len (length notes))) + (when (= len 0) + (error "There's no such term %s. Use , %s is ..." fir fir)) + (unless (= len 1) + (error + "Term has multiple entries. Examine them and ask me to forget them first")) + (erbutils-ignore-errors (funcall 'fs-forget (first args) "all")) + (apply 'fs-set-term args)))) + + +(defcustom erbn-fortune-p t + "This is true by default.. since (shell-command \"fortune\") is not +risky.. ") + + +(defun erbn-fortune (arg) + (unless arg (setq arg "")) + (cond + ((string= arg "") + (erbutils-eval-until-limited + '(erbn-shell-command-to-string (concat "fortune " arg) + (list erbn-fortune-p) + ))) + (t + (erbn-shell-command-to-string (concat "fortune " arg) + (list erbn-fortune-p) + )))) + + +(defun fsi-fortune (&rest args) + (erbn-fortune "")) + + +(defalias 'fs-f 'fs-fortune) + +(defun fs-fortunes-help (&rest args) + (concat "Type ,fortune, or any of the commands beginning with f- : " + (fs-commands "^f-"))) + +(defalias 'fs-fortune-help 'fs-fortunes-help) +(defalias 'fs-f-help 'fs-fortunes-help) + + +(defun fs-f-f (&rest args) + (erbn-fortune "-f")) + +(defun fs-f-off (&rest args) + (erbn-fortune "-o")) +(defalias 'fs-f-o 'fs-f-off) +(defalias 'fs-f-offensive 'fs-f-off) + + +(defun fs-f-debian-hints (&rest args) + (erbn-fortune "debian-hints")) +(defalias 'fs-debian-hints 'fs-f-debian-hints) + + + +(defun fs-f-twisted-quotes (&rest args) + (erbn-fortune "twisted-quotes")) +(defalias 'fs-quotes 'fs-f-twisted-quotes) +(defalias 'fs-f-quotes 'fs-f-twisted-quotes) + +(defun fs-f-literature (&rest args) + (erbn-fortune "literature")) +(defalias 'fs-f-lit 'fs-f-literature) +(defalias 'fs-lit 'fs-f-literature) +(defalias 'fs-literature 'fs-f-literature) + + + +(defun fs-f-riddles(&rest args) + (erbn-fortune "riddles")) +(defalias 'fs-riddle 'fs-f-riddles) + + + +(defun fs-f-art (&rest args) + (erbn-fortune "art")) +(defalias 'fs-art 'fs-f-art) + + + + +(defun fs-f-bofh-excuses (&rest args) + (erbn-fortune "bofh-excuses")) +(defalias 'fs-bofh 'fs-f-bofh-excuses) + + + + +(defun fs-f-ascii-art (&rest args) + (erbn-fortune "ascii-art")) +(defalias 'fs-ascii 'fs-f-ascii-art) + + + + +(defun fs-f-computers (&rest args) + (erbn-fortune "computers")) + +(defalias 'fs-f-computer 'fs-f-computers) + + + + + +(defun fs-f-cookies (&rest args) + (erbn-fortune "cookies")) + +(defalias 'fs-f-cookie 'fs-f-cookies) +(defalias 'fs-cookie 'fs-f-cookies) + + + + + +(defalias 'fs-f-cookie 'fs-f-cookies) +(defalias 'fs-cookie 'fs-f-cookies) + + +(defun fs-f-definitions (&rest args) + (erbn-fortune "definitions")) + +(defalias 'fs-def 'fs-f-defintions) + + + + +(defun fs-f-drugs (&rest args) + (erbn-fortune "drugs")) +(defalias 'fs-drugs 'fs-f-drugs) +(defalias 'fs-drug 'fs-f-drugs) + + + + +(defun fs-f-education (&rest args) + (erbn-fortune "education")) + + +(defun fs-f-ethnic (&rest args) + (erbn-fortune "ethnic")) + + + + +(defun fs-f-food (&rest args) + (erbn-fortune "food")) +(defalias 'fs-food 'fs-f-food) + + + + + + +(defun fs-f-goedel (&rest args) + (erbn-fortune "goedel")) +(defalias 'fs-goedel 'fs-f-goedel) + + + + +(defun fs-f-humorists (&rest args) + (erbn-fortune "humorists")) + + +(defun fs-f-kids (&rest args) + (erbn-fortune "kids")) + + +(defun fs-f-law (&rest args) + (erbn-fortune "law")) + +(defalias 'fs-law 'fs-f-law) + + + +(defun fs-f-linuxcookie (&rest args) + (erbn-fortune "linuxcookie")) + + +(defun fs-f-love (&rest args) + (erbn-fortune "love")) + +(defun fs-f-magic (&rest args) + (erbn-fortune "magic")) + + + +(defun fs-f-medicine(&rest args) + (erbn-fortune "medicine")) + + + +(defun fs-f-men-women (&rest args) + (erbn-fortune "men-women")) + +(defalias 'fs-sexwar 'fs-f-men-women) + + + + + +(defun fs-f-miscellaneous(&rest args) + (erbn-fortune "miscellaneous")) + +(defalias 'fs-f-misc 'fs-f-miscellaneous) + + + +(defun fs-f-news (&rest args) + (erbn-fortune "news")) + + + +(defun fs-f-people (&rest args) + (erbn-fortune "people")) + + +(defun fs-f-pets (&rest args) + (erbn-fortune "pets")) + + + +(defun fs-f-platitudes (&rest args) + (erbn-fortune "platitudes")) + + + +(defun fs-f-politics (&rest args) + (erbn-fortune "politics")) + + +(defun fs-f-science (&rest args) + (erbn-fortune "science")) + +(defun fs-f-songs-poems (&rest args) + (erbn-fortune "songs-poems")) + + +(defun fs-f-sports(&rest args) + (erbn-fortune "sports")) + + + + + +(defun fs-f-startrek (&rest args) + (erbn-fortune "startrek")) +(defalias 'fs-startrek 'fs-f-startrek) + + + + + +(defun fs-f-translate-me (&rest args) + (erbn-fortune "translate-me")) + + + +(defun fs-f-wisdom(&rest args) + (erbn-fortune "wisdom")) +(defalias 'fs-wisdom 'fs-f-wisdom) + + + +(defun fs-f-work (&rest args) + (erbn-fortune "work")) + + + +(defun fs-f-linux (&rest args) + (erbn-fortune "linux")) + +(defun fs-f-perl (&rest args) + (erbn-fortune "perl")) + +(defun fs-f-knghtbrd (&rest args) + (erbn-fortune "knghtbrd")) + + + + +(defun fs-f-quotes-emacs-channel (&rest args) + (erbn-fortune "~/fortune-emacschannelquotes")) +(defalias 'fs-f-emacs 'fs-f-quotes-emacs-channel) +(defalias 'fs-f-quotes-emacs 'fs-f-quotes-emacs-channel) +(defalias 'fs-quotes-emacs 'fs-f-quotes-emacs-channel) +(defalias 'fs-quotes-emacs-channel 'fs-f-quotes-emacs-channel) + + + + + + + + + +;; (defalias 'fs-cons 'cons) + +(defvar fs-internal-limit-line-length 125 + "Suggested value: (multiple of 80) minus 35 .. suggested: 210.") + +(defvar fs-internal-limit-length + 300 + "A multiple of fs-internal-fill-column.. we suggest: double of it.. note +that the actual limited-length will be more than this number---it may +be upto double of this number depending on how the formatting is done. +viz: we shall go to the line containing this point, and include the +entire line. +") +(defvar fs-limit-lines 8 "") + + +(defvar fs-dunnet-mode nil + "") + +(make-variable-buffer-local 'fs-dunnet-mode) + +(defvar fs-internal-fill-column 350 + "Default is to disable filling. The receipient should be able to +fill the way they like. +should be <= fs-internal-limit-length, else we might set it to be during the +code. +also, a good idea to keep it < erc's builtin flood protection length, +else your lines will get broken during middle of words by ERC. +Thus, keep it below, say 350." +) + + + + + + +(defun fsi-limit-string (&optional str maxlen &rest ignored) + "Fills the string and then then limits lines" + (fs-limit-lines (fs-fill-string str))) + + +(defun fsi-fill-string (str) + (with-temp-buffer + (insert str) + (let ((fill-column fs-internal-fill-column)) + (text-mode) + (fill-region (point-min) (point-max)) + (buffer-substring-no-properties (point-min) (point-max))))) + +(defun fsi-limit-string-old (&optional str maxlen &rest ignored) + (cond + (str + (unless (stringp str) + (setq str (format "%s" str))) + ;; get rid of all the \n first.. + (setq str + (mapconcat 'identity + (split-string str "\n") + " ")) + (when (> (length str) fs-internal-limit-length) + (setq str (concat (substring str 0 (- fs-internal-limit-length 7)) + "..<more>"))) + (with-temp-buffer + (insert str) + (goto-char (point-min)) + (let ((fill-column fs-internal-fill-column)) + (fill-paragraph nil)) + (erbutils-buffer-string))) + (t "\n"))) +(defun fsi-dunnet-mode (&optional arg) + + (setq fs-dunnet-mode + (cond + ((or (not (numberp arg)) + (= arg 0)) + (not fs-dunnet-mode)) + ((plusp arg) + t) + ((minusp arg) nil))) + + (format "Dunnet mode set to %S. To toggle, type , (dunnet-mode)" + fs-dunnet-mode)) + +(defun fsi-limit-string-no-fill (&optional str limit-lines + limit-length + limit-line-length + &rest ignored + ) + "IS OLD. i think. not used anywwhere... certainly screws up more: +is not compliant with fsbot paginator. + +Limit string to reasonable length.. +Not more than fs-internal-limit-line-length characters per line, and +not more than fs-internal-limit-length characters in all.. and not more +than fs-limit-lines in all.." + (if str + (let ((fs-limit-lines + (or limit-lines fs-limit-lines)) + (fs-internal-limit-length + (or limit-length + fs-internal-limit-length)) + (fs-limit-line-length + (or limit-line-length + fs-internal-limit-line-length))) + (fs-limit-lines + (fs-internal-limit-length + (fs-limit-line-length + str t)))) + "\n")) + + +(defvar erbn-more nil + "Alist of pending more-strings per target. Each target is a +string. ") +;;(make-variable-buffer-local 'fs-more) + +(defun erbn-more-get (&optional target) + "When target is nil, we get the latest more that occurred in ANY +channel, else we get the more from the channel indicated by target. " + (setq target (format "%S" target)) + (let ((str (cdr (assoc target erbn-more)))) + (if (and (stringp str) + (not (string= str ""))) + str + (fs-describe "more")))) + +(defalias 'fsi-more-get 'erbn-more-get) + +(defun erbn-more-set (str &optional target) + (setq target (format "%S" target)) + (if (assoc target erbn-more) + (setf (cdr (assoc target erbn-more)) str) + (add-to-list 'erbn-more (cons target str))) + (if (assoc "nil" erbn-more) + (setf (cdr (assoc "nil" erbn-more)) str) + (add-to-list 'erbn-more (cons "nil" str))) + erbn-more) + + +(defun fsi-more-set (&optional str) + (unless str (error "Need a string. ")) + (erbn-more-set str erbn-tgt)) + + + +(defun fsi-limit-lines (str0 &optional nomorep &rest ignored) + "Limits the string, both, to a reasonable number of lines and a +reasonable number of characters, trying not to break lines and not to +break words, if possible. + +Thus, that becomes quite a complicated algorithm, and we do that +here." + (let* (ans + (ender "") + (more "") + (stra (erbutils-remove-text-properties str0)) + (str (mapconcat 'identity + (remove "" (split-string stra "\n")) + "\n")) + (limitedp nil) + ptmx + this-line + this-point + new-point + ) + (with-temp-buffer + ;; fledermaus: ensure that the buffer's byteness matches the str's. + (set-buffer-multibyte (multibyte-string-p str)) + (insert str) + (setq ptmx (point-max)) + (setq this-point ptmx new-point ptmx) + (if (> fs-internal-limit-length ptmx) + (goto-char ptmx) + (setq limitedp t) + (goto-char fs-internal-limit-length)) + ;;(goto-char (point-max)) + ;;(remove-text-properties (point-min) (point-max)) + (setq this-line (count-lines (point-min) (point))) + (when (> this-line fs-limit-lines) + (setq limitedp t) + (goto-line fs-limit-lines) + (setq this-line fs-limit-lines) + ) + + (setq this-point (point) new-point this-point) + + (cond + ((and limitedp (> this-line 1)) + (progn (beginning-of-line) + (setq new-point (point)) + (backward-char) (setq this-point (point)) + )) + ((and limitedp + (progn (ignore-errors + ;; we want a backward-word 1 here, but only + ;; whitespace is regarded as word-boundary for + ;; us. + (when + (search-backward-regexp "\\( \\|\n\\|\t\\)" nil t) + (forward-char 1)) + ;;(backward-word 1) + ) + (> (point) (point-min)))) + (setq new-point (point)) + (setq this-point new-point)) + + + ;;(limitedp (setq this-point (point) new-point (point))) + + ;; in the final case, this-point and new-point are already at + ;;point-max... + (t nil)) + (setq ans (buffer-substring (point-min) this-point)) + (when + ;;(< this-point (point-max)) + limitedp + (setq more (buffer-substring new-point (point-max))) + (if + (string-match "[^ \t\n]" more ) + (setq ans (concat ans (fsi-get-more-invocation-string))) + (when nomorep (setq more ""))) + ) + ) + ;;(setq fs-more more) + (erbn-more-set more erbn-tgt) + ans)) + +(defun fsi-get-more-invocation-string () + (if (erbot-safe-nocontrol-p erbn-char) + (concat " ..[Type " erbn-char "more]") + (concat " ..[Type " erbot-nick ": more]"))) + +(defun fsi-limit-lines-old (str0 &rest ignored) + "" + (let* ( + (str (erbutils-remove-text-properties str0)) + (brstr1 (split-string str "\n")) + (brstr (remove "" brstr1)) + (ender "") + (condp (> (length brstr) fs-limit-lines)) + (goodstr + (if condp + (progn + (setq ender "..+ more") + (subseq brstr 0 (- fs-limit-lines 1))) + brstr))) + (if condp (fs-more-set + (mapconcat 'identity + (subseq brstr (- fs-limit-lines + 1)) + "\n")) + (fs-more-set "")) + (concat (mapconcat 'identity goodstr "\n") ender))) + +(defun fsi-more (&rest args) + "Display the contents of the cache. " + (let ((str (fsi-more-get erbn-tgt))) + (if (and (stringp str) + (not (string= str ""))) + str + (fs-describe "more")))) + +;; (if (and (stringp fs-more) +;; (not (string= fs-more ""))) +;; fs-more +;; (fs-describe "more"))) + + +(defun fsi-limit-lines-long (str &rest ignored) + "" + (let ((fs-limit-lines 7)) + (apply 'fs-limit-lines str ignored))) + + + +(defun fsi-limit-length (str &rest ignored) + "Don't use this, use fs-limit-lines" + (if (> (length str) fs-internal-limit-length) + (concat (substring str 0 (- fs-internal-limit-length 1)) "...<more>") + str)) + +(defun fsi-limit-line-length (&optional str &rest args) + "a subfunction.." + (let* ( + ;; this not needed now.. + (brokenstr (split-string str "\n")) + (newlsstr + (mapcar + '(lambda (givenstr) + (let ((ls nil) + (thisstr givenstr) + ) + (while (> (length thisstr) + fs-internal-limit-line-length) + (push + (concat (substring thisstr 0 fs-internal-limit-line-length + ) " <break>") + ls) + (setq thisstr (substring thisstr fs-internal-limit-line-length + (length thisstr)))) + (push thisstr ls) + (reverse ls))) + brokenstr)) + (newbrokenstr + (apply 'append newlsstr))) + (mapconcat 'identity newbrokenstr "\n"))) + + +(defvar fs-internal-directed nil) + +(defun fsi-tell-to (string nick &rest ignored) + (setq fs-nick (format "%s" nick)) + (let* ((fs-internal-directed t) + (ni (if (string= (format "%s" nick) "me") + erbot-end-user-nick + (format "%s" nick))) + (reply + (erbeng-get-reply (fs-parse (concat erbot-nick ": " + string))))) + (if (string-match ni reply) + reply + (concat ni ": " reply)))) + + +(defun fsi-apropos (&optional regexp N M &rest ignored) + (fs-apropos-basic 'erbn-apropos regexp N M)) +(defun fsi-apropos-command (&optional regexp n m &rest ignored) + (fs-apropos-basic 'erbn-apropos-command regexp n m )) +(defun fsi-apropos-variable (&optional regexp n m &rest ignored) + (fs-apropos-basic 'erbn-apropos-variable regexp n m )) +(defun fsi-apropos-function (&optional regexp n m &rest ignored) + (fs-apropos-basic 'erbn-apropos-function regexp n m )) +(defun fsi-apropos-value (&optional regexp n m &rest ignored) + (fs-apropos-basic 'apropos-value regexp n m )) +(defun fsi-apropos-documentation (&optional regexp n m &rest ignored) + (fs-apropos-basic 'erbn-apropos-documentation regexp n m )) + +(defun erbn-apropos-documentation (reg) + (mapcar 'car (apropos-documentation reg))) +(defun erbn-apropos-command (reg) + (apropos-internal reg + 'commandp)) + + + +(defun erbn-apropos-function (reg) + (apropos-internal reg + 'functionp)) + +(defun erbn-apropos-variable (reg) + (apropos-internal reg + (lambda (s) + (or (boundp s) + (user-variable-p s))))) + + +(defun erbn-apropos (regexp) + (apropos-internal regexp + (lambda (symbol) + (or + (boundp symbol) + (fboundp symbol) + (facep symbol) + (symbol-plist symbol))))) + +(defun fsi-apropos-basic (fcn &optional regexp N M &rest ignored) + "Show the apropos-matches of regexp starting at match number N" + (unless regexp + (error "Syntax: , apropos REGEXP &optional N M")) + (if (stringp N) (setq N (erbn-read N))) + (unless (integerp N) (setq N 0)) + (unless (stringp regexp) + (setq regexp (format "%s" regexp))) + (let* ((results (funcall fcn regexp)) + (len (length results)) + (str0 "") + (str1 "") + (str2 "") + (str3 "") + (str4 "")) + (unless (and (integerp M) (< M len)) + (setq M len)) + (if (and (= N 0 ) (= M len) (> len 30)) + (setq + str0 + "Perhaps Try , df fs-apropos for general syntax. ")) + (if (> len 1) (setq str1 (format "%s matches. " len))) + (if (> N 0) (setq str2 (format "Matches starting at %s->" N))) + (setq str3 (progn (format "%s" + (subseq results + N M) + ))) + (concat str0 str1 str2 str3 str4))) + + +(defun fsi-find-variable (function &rest ignore) + (fs-find-variable-internal function 'nolimit)) + +(defun fsi-find-variable-internal (function &optional nolimitp &rest ignore) + "Finds the variable named FUNCTION." + (if (stringp function) (setq function (erbn-read function))) + (cond + ((symbolp function) + (unless (boundp function) + (let ((g (intern (concat "fs-" (format "%s" function))))) + (if (boundp g) + (setq function g)))) + (let ((fstr + (save-excursion + (find-function-do-it function t 'set-buffer) + (buffer-substring (point) + (save-excursion + (forward-sexp 1) + (point)))))) + (if (equal nolimitp 'nolimit) + fstr + fstr))) + (t "\n"))) + +(defalias 'fsi-find-variable-briefly 'fs-find-variable) + + + +(defun fsi-find-function (&optional function &rest ignore) + (unless function + (error "Syntax: , find-function 'function-name")) + ;;fs-limit-lines-long + (fs-find-function-internal + function 'nolimit)) + + + + +(defalias 'fsi-find-function-briefly 'fs-find-function) + +(defun fsi-find-function-on-key (&optional k &rest rest) + (unless k + (error + "Syntax (ffo <key>)")) + (fs-find-function (fs-describe-key-briefly k))) + +(defun fsi-find-function-on-key-briefly (k &rest rest) + (fs-find-function-briefly (fs-describe-key-briefly k))) + +(defun fsi-find-function-internal (&optional function nolimitp &rest nada) + (unless function + (error + "Syntax: (ff 'fucntion)")) + (if (stringp function) (setq function (erbn-read function))) + (cond + ((symbolp function) + (unless (fboundp function) + (let ((g (intern (concat "fs-" (format "%s" function))))) + (if (fboundp g) + (setq function g)))) + (let* ((fstrbare + (save-excursion + + ;; This has the problem that it is interactive.. asks to + ;; reread file if has changed etc. + ;;(find-function function) + (find-function-do-it function nil 'set-buffer) + (buffer-substring (point) + (save-excursion + (forward-sexp 1) + (point))))) + (fstr (erbutils-function-minus-doc fstrbare))) + (if (equal nolimitp 'nolimit) + fstr + (concat (format "%s characters.." (length + fstr)) + fstr)))) + (t "\n"))) + + + +;;; 2002-11-10 T14:50:20-0500 (Sunday) D. Goel +(defun fsi-say (&rest args) + ;; let's make it safe, even though we know it will be made safe again... + (let ((response + (mapconcat + '(lambda (arg) + (format "%s" arg)) + args " "))) + (if (erbot-safe-p response) response + (concat " " response)))) + + + + + + + + + +(defun fsi-regexp-quote (str) + (unless (stringp str) + (setq str (format "%s" str))) + (regexp-quote str)) + + +(defun fsi-concat (&rest sequences) + (apply 'concat + (mapcar + 'erbutils-convert-sequence + sequences))) + + + + + +(defun fs-bunny (&rest arg) + (concat " " + (erbutils-random + '( + "Bunny is magical!" + ;;"Bunny is hot!" + "Bunny is sexy!" + "Bunny!!" + "Bunny's page: http://www.hurd-bunny.org" + "Bunny rocks" + "Bunny rules!" + "One Bunny to rule us all" + "One Bunny to rule us all ... Muhahahhaha" + "Bunny! Bunny! Bunny!" + "Bunny! Bunny! Bunny! Bunny!" + ;;"ERC in Emacs just rocks" + + )))) + + + + + + + + +(defun erbnocmd-user-fcn-definition (&optional mainterm ) + "The general syntax is (fs-describe TERM [N] [M]). +Looks for TERM, and shows its descriptions starting at description +number N, and ending at M-1. The first record is numbered 0. +" + (unless mainterm + (error + "Format , (describe TERM &optional number1 number2)")) + (unless mainterm + (setq mainterm (format "%s" mainterm))) + (setq mainterm (fs-correct-entry mainterm)) + (let* ((result0 + (erbbdb-get-exact-notes + mainterm + )) + (result1 (and (stringp result0) + (ignore-errors (erbn-read result0)))) + (len (length result1))) + (cond + ;; in cond0 + (result1 + (let* ( + ;; notice the use of result1 here, not result. + (aa (first result1)) + (bb (split-string aa)) + (cc (first bb)) + (dd (second bb)) + (ee (cdr bb)) + ) + (cond + ( + (erbutils-string= cc "redirect") + dd) + (t nil))))))) + + + +(defun fs-seen (&rest args) + (concat "seen " + (mapconcat + '(lambda (arg) (format "%s" arg)) + args + " "))) + +;; this asks the google bot for results and gives it to our channel +;;(defvar erbnocmd-google-stack nil) +;;(defun fs-google (&rest args) +;; (progn +;; (add-to-list 'erbnocmd-google-stack 'foo)) +;; (erc-cmd-MSG google "hi") +;; nil) + +(defcustom fs-internal-google-time 4 + "" :group 'erbc) + +(defcustom fs-internal-dictionary-time 4 + "" :group 'erbc) + +(defun fsi-google-raw (&rest args) + "Return a list of google results. " + (let ((concatted + (mapconcat '(lambda (a) + (format "%s" a)) + args " "))) + (with-timeout + (fs-internal-google-time + (list concatted (list "google---TimedOut"))) + (let ((results + ;; this ignore-errors is very important. + ;; since the google stuff currently gives weird errors + ;; when called from within a with-timeout loop, and a + ;; timeout actually occurs. + (ignore-errors + (mapcar 'list + (google-result-urls + (google-search concatted 0 "web")) )) )) + results)) )) + +(defvar fs-internal-google-redirect-p nil) + + +(defun fsi-googlen (n &rest args) + "Format the first n results in a nice format. " + (let* ((rawres (apply 'fs-google-raw args)) + (terms (first rawres)) + (matches (cdr rawres))) + (when (> (length matches) n) + (setq matches (subseq matches 0 n))) + (cond + ((or (not (null matches)) (not fs-internal-google-redirect-p)) + (format "[google] %s" + ;;terms + (if matches + (mapconcat 'car matches "\n") + "No match. "))) + (t + (fs-english-only + fs-internal-original-message + fs-internal-addressedatlast + 'nogoogle + ))))) + +(defun fsi-google-lucky-raw (&rest args) + (caadr (apply 'fs-google-raw args))) + + +(defun fsi-google-redirect-to-google-bot (&rest args) + (concat "google: " + (mapconcat + '(lambda (arg) (format "%s" arg)) + args " "))) + + + +(defun fsi-google-from-english (&rest args) + (let ((fs-internal-google-redirect-p t)) + (apply 'fs-google args))) + +(defun fsi-google (&rest args) + (unless args (error "Syntax: , g[oogle] [NUMBER] WORD1 &rest MORE-WORDS ")) + (let (num + (fir (first args)) + ) + (when (> (length args) 1) + (setq num + (if (numberp fir) + fir + (ignore-errors (erbn-read fir))))) + (if (numberp num) + (setq args (cdr args)) + (setq num 2)) + (apply 'fs-googlen num args))) + +(defun fsi-google-with-options (options terms &rest args) + "internal" + (apply 'fs-google (append (list options) terms args))) + +(defun fsi-google-deego (&rest args) + "Google on the gnufans.net." + (fs-google-with-options "site:gnufans.net" args)) + + +(defun fsi-google-emacswiki(&rest args) + "Google on the emacswiki site." + (fs-google-with-options "site:emacswiki.org" args)) + +(defun fsi-google-sl4 (&rest args) + "Google on the sl4 site." + (fs-google-with-options "site:sl4.org" args)) + +(defun fsi-google-planetmath (&rest args) + "Google on the planetmath site." + (fs-google-with-options "site:planetmath.org" args)) + +(defun fsi-google-octave (&rest args) + "Google on the octave site." + (fs-google-with-options "site:octave.org" args)) + + +(defalias 'fs-go 'fs-google-octave) + +(defun fs-google-wikipedia-english (&rest args) + "Google on the emacswiki site." + (fs-google-with-options "site:en.wikipedia.org" args)) + + + +(defun fs-google-wikipedia (&rest args) + "Google on the emacswiki site." + (fs-google-with-options "site:wikipedia.org" args)) + +(defun fs-google-wikipedia (&rest args) + (fs-google-with-options "site:wikipedia.org" args)) + +(defun fs-google-imdb (&rest args) + "Google on IMDB" + (fs-google-with-options "site:imdb.com" "1" args)) + +(defun fs-google-gnufans-org (&rest args) + "Google on gnufans.org" + (fs-google-with-options "site:gnufans.org" args)) + +(defun fs-google-hurdwiki(&rest args) + "Google on the emacswiki site." + (fs-google-with-options "site:hurd.gnufans.org" args)) + + +(defun fs-google-nevadamissouri (&rest args) + "Google on the emacswiki site." + (fs-google-with-options "site:nevadamissouri.net" args)) + + + +(defun fs-google-scarymath (&rest args) + "Google on scarymath" + (fs-google-with-options "site:http:scarymath.org" args)) + +(defun fs-google-twiki (&rest args) + "Google on the twiki site." + (fs-google-with-options "site:http:twiki.org" args)) + +;; unprovide nonfree sites.. +;; (defun fs-google-usemod (&rest args) +;; "Google on usemod" +;; (fs-google-with-options "site:usemod.com" args)) + +;;(defalias 'fs-google-meatball 'fs-google-usemod) + +(defun fsi-replace-regexp (&optional from to term number delimited + fixedcase literal subexp) + "TODO: implemenet fixedcase, literal, subexp... If needed, let the +author know.." + (unless (and from to term) + (error "Syntax: %s (replace-regexp FROM TO TERM &optional NUMBER" erbn-char)) + (erbnocmd-iterate-internal term number 'replace-regexp-in-string from to + nil) + (format "Replaced regexp %S with %S" from to)) + +(defun fsi-cp (name dest) + (let* ((exn (erbbdb-get-exact-notes name)) + (notes (and (stringp exn) (erbn-read exn)))) + (unless notes + (error "No such term %s" name)) + (when (erbbdb-get-exact-notes dest) + (error "%S already exists. Use merge" dest)) + (fs-set-term dest notes) + (format "Copied entries of %S to %S" name dest))) + + +(defun fsi-notes (name) + "Internal. Return the notes as a list. Else nil" + (sit-for 0) + (let ((exnotes (erbbdb-get-exact-notes name))) + (and (stringp exnotes) (erbn-read exnotes)))) + + + +(defvar erbn-merge-redirect-p t + "When true, merging also redirects.") + + + +(defun fsi-merge-generic (&optional name dest &rest args) + (unless (and name dest (not args)) + (error "Syntax: %s merge TERM1 TERM2" erbn-char)) + (setq name (format "%s" name)) + (setq dest (format "%s" dest)) + (when (string= (downcase name) (downcase dest)) + (error "Cannot merge something into itself.")) + (let ((notes (fs-notes name)) + (destnotes (fs-notes dest)) + ) + (unless notes (error "No such field %S" name)) + (unless destnotes + (error "No such field %S. Use mv" dest)) + (setq name (fs-correct-entry name)) + (setq dest (fs-correct-entry dest)) + (erbot-working + (mapcar + '(lambda (arg) + (fs-set-also dest arg)) + notes) + (fs-forget name "all")) + (when erbn-merge-redirect-p + (erbot-working + (fsi-set-term name (format "redirect %s" dest)))) + (erbbdb-save) + (if erbn-merge-redirect-p + (format "Merged %S into %S, redirected %S to %S" name dest + name dest) + (format "Merged %S into %S" name dest)))) + +(defun fsi-merge-redirect (&rest args) + (let ((erbn-merge-redirect-p t)) + (apply 'fsi-merge-generic args))) + + +(defalias 'fsi-merge 'fsi-merge-redirect) + +(defun fsi-merge-noredirect (&rest args) + (let ((erbn-merge-redirect-p nil)) + (apply 'fsi-merge-generic args))) + +(defalias 'fsi-Merge 'fsi-merge-noredirect) + + +(defun fsi-mv (&optional name dest &rest args) + "Rename NAME to DEST. +Do not confuse this function with fs-rearrange which rearranges the +order of entries within a given term. " + (when (or args (not (and name dest))) + (error "Format: %s mv foo bar" erbn-char)) + (setq name (format "%s" name)) + (setq dest (format "%s" dest)) + (cond + ((string= (downcase name) (downcase dest)) + (fs-mv-change-case name dest)) + (t + (setq name (fs-correct-entry name)) + (erbot-working (fs-cp name dest)) + (erbot-working (fs-forget name "all")) + (erbbdb-save) + (format "Renamed the term %S to %S" name dest)))) + +(defalias 'fsi-rename 'fs-mv) + +(defun fsi-mv-change-case (name dest) + (when + (let ((bbdb-case-fold-search nil)) + (erbbdb-get-exact-name dest)) + (error "Destination %S already seems to exist" dest)) + (let ((tmp (format "TMPMV-%S" (random 1000)))) + (erbot-working + (ignore-errors (fs-forget tmp)) + (fs-mv name tmp) + (fs-mv tmp dest)) + (erbbdb-save) + (format "Readjusted case from %S to %S" name dest))) + +(defun fsi-swap (name dest) + (setq name (format "%s" name)) + (setq dest (format "%s" dest)) + (unless + (let ((bbdb-case-fold-search nil)) + (erbbdb-get-exact-name dest)) + (error "Destination %S does not exist." dest)) + (unless + (let ((bbdb-case-fold-search nil)) + (erbbdb-get-exact-name name)) + (error "Source term %S does not exist." name)) + (when (string= (downcase name) (downcase dest)) + (error "Can't swap term with itself. ")) + (let ((tmp (format "TMPMV-%S" (random 1000)))) + (erbot-working + (ignore-errors (fs-forget tmp)) + (fs-mv name tmp) + (fs-mv dest name) + (fs-mv tmp dest)) + (erbbdb-save) + (format "Readjusted case from %S to %S" name dest))) + + + +(defun fsi-rearrange-from-english-internal (msg) + (catch 'erbnocmd-tag-foo + (unless (equal (length msg) 3) + (throw 'erbnocmd-tag-foo + `(fs-error (format "Syntax: %s N->M in TERM" erbn-char)))) + (unless (equal (downcase (format "%s" (second msg))) "in") + (throw 'erbnocmd-tag-foo + `(fs-error (format "Syntax: %s N->M in TERM" erbn-char)))) + (let (term + fromto + lenfromto + ) + (setq term (third msg)) + (setq fromto + (split-string (first msg) "->")) + (setq lenfromto (length fromto)) + (unless (= lenfromto 2) + (throw 'erbnocmd-tag-foo + `(fs-error (format "Syntax: %s N->M in TERM" erbn-char)))) + `(fs-rearrange ,(first fromto) ,(second fromto) ,term)))) + + + + +(defun fsi-replace-string-from-english-internal (msg) + "Parse the input english message to return an elisp equivalent. +MSG here is a list which needs to be combined. " + (let* + ( + ;; original length + (leno (length msg)) + ;; remaining msg + (remmsg msg) + (remlen leno) + las + number + remengmsg + remenglen + revengmsg + splitloc + from + to + term + (ans nil) + (termcheckp nil) + fcn + sr + ) + (catch 'erbnocmd-repl-error + + (unless (and (>= leno 3) + (equal 0 (string-match "\\(s\\|r\\)/" (first remmsg)))) + (throw 'erbnocmd-repl-error + `(fs-error + "Format: s/foo.../bar..../ in TERM &optional N"))) + (setq sr + (if (equal 0 (string-match "s" (first remmsg))) "s" "r")) + (setq las (first (last remmsg))) + (setq number (and (stringp las) (erbn-read las))) + (if (or (numberp number) + (equal 0 (string-match + "all" + (downcase (format "%s" number))))) + (setq remmsg (subseq remmsg 0 (- remlen 1))) + (progn + (setq termcheckp t number nil))) + + ;; next comes the term + (setq remlen (length remmsg)) + (setq term (first (last remmsg))) + (setq remmsg (subseq remmsg 0 (- remlen 1))) + + (when termcheckp + (let* ((exn (erbbdb-get-exact-notes term)) + (notes (and (stringp exn) (erbn-read exn))) + (len (length notes))) + (if (> len 1) + (throw 'erbnocmd-repl-error + `(fs-error "Which numbered entry? %s/foo/bar in TERM NUMBER" , sr +)) + (setq number 0)))) + + ;; now the "in" + (setq remlen (length remmsg)) + (setq las (first (last remmsg))) + (unless + (string= "in" (downcase (format "%s" las))) + (throw 'erbnocmd-repl-error + `(fs-error + "Format: %s/foo.../bar..../ in TERM &optional NUMBER" + ,sr )) + ) + + (setq remmsg (subseq remmsg 0 (- remlen 1))) + (setq remlen (length remmsg)) + (setq remengmsg (mapconcat 'identity remmsg " ")) + + ;; remove trailing whitespace + ;; no need to check for length since we know msg stars with s/ + (while + (member + (aref remengmsg (- (length remengmsg) 1)) + '(9 ;; tab + 32 ;; space + 10 ;; newline + )) + (setq remengmsg (subseq remengmsg 0 (- (length remengmsg) 1)))) + ;; remove one trailing / + ;; no need to check for length since we know msg stars with s/ + (setq remenglen (length remengmsg)) + (when (equal + (aref + remengmsg (- (length remengmsg) 1)) + 47) + (setq remengmsg (subseq remengmsg 0 (- (length remengmsg) 1)))) + + (setq remenglen (length remengmsg)) + (unless (> (length remengmsg) 2) + (throw 'erbnocmd-repl-error + `(fs-error + "Format: %s/foo.../bar..../ in TERM &optional N" + ,sr + )) + + ) + ;; this should take care of almost anything imaginable. + ;; one can still construct "missing" cases but one should just use + ;; lisp for that. + ;; remove the s/ + (if (equal 0 (string-match "s" remengmsg)) + (setq fcn 'fs-replace-string) + (setq fcn 'fs-replace-regexp)) + (setq remengmsg (subseq remengmsg 2)) + ;; now find the last single / + (with-temp-buffer + (insert remengmsg) + (goto-char (point-max)) + (setq splitloc + (search-backward-regexp "[^/]/\\([^/]\\|$\\)" nil t))) + (unless splitloc + (throw 'erbnocmd-repl-error + `(fs-error + "Format: %s/foo.../bar..../ in TERM &optional N" + ,sr + ))) + (setq from (substring remengmsg 0 splitloc)) + (setq to (substring remengmsg (+ splitloc 1))) + (when (string= from "") + (throw 'erbnocmd-repl-error + `(fs-error "Replacement string must have nonzero size.."))) + ;; singlify the double /'s. + (setq from + (replace-regexp-in-string "//" "/" from)) + (setq to + (replace-regexp-in-string "//" "/" to)) + `(,fcn ,from ,to ,term ,(format "%s" number))))) + + + +(defun fsi-replace-string (&optional from to term number) + (unless (and from to term) + (error + "Syntax: %s s/foo.../bar in TERM [NUMBER or ALL]" erbn-char)) + (erbot-working + (erbnocmd-iterate-internal + (or (erbbdb-get-exact-name term ) term) + number 'erbutils-replace-string-in-string + from to nil)) + (erbbdb-save) + (format "Replaced string %S with %S." from to)) + +(defun erbnocmd-iterate-internal (term number function + &rest arglist) + + " Perform FUNCTION on the NUMBERth entry of TERM. +If NUMBER is not nil, the replacement is done for each entry in +the TERM. The function uses the term as its third argument. +Meant for use by fs-replace-regexp etc. + +The last entry of ARGLIST is assumed to be itself a list of arguments, +let's call it lastlist. Let the other entries of arglist be called +initargs. Then the function is applied as (function @initargs string +@arglist). Where the string is the string gotten from the TERM. " + + (setq number (format "%s" number)) + (let* + ((exactnotes (erbbdb-get-exact-notes term)) + (notes (and (stringp exactnotes) (erbn-read exactnotes))) + (len (length notes)) + newnotes + newnote + (lenargs (length arglist)) + (initargs (subseq arglist 0 (- lenargs 1))) + (finargs (first (last arglist))) + (numnum (erbn-read number)) + ) + (when (and (null number) (= len 1)) (setq number 0)) + (unless exactnotes (error "No such term: %S" term)) + (cond + ((string= "all" (downcase number)) + (setq newnotes + (mapcar + (lambda (thisentry) + (apply function (append initargs (list thisentry) + finargs))) + notes))) + ((or (not (numberp numnum)) + (< numnum 0) + (>= numnum len)) + (error "Number should be \"all\" or within %s and %s, given was: %s" + 0 (- len 1) numnum)) + (t + (setq newnotes + (append + (subseq notes 0 numnum) + (list + (apply function (append initargs + (list (nth numnum notes)) + finargs))) + (subseq notes (+ numnum 1) len))))) + (fs-forget term "all") + (fs-set-term term newnotes))) + + + +(defun fsi-info-emacs (&optional regexp) + (fs-info-file "emacs" regexp)) + +(defun fsi-info-elisp (&optional regexp) + (fs-info-file "elisp" regexp)) + +(defun fsi-info-efaq (&optional regexp) + (fs-info-file "efaq" regexp)) + +(defun fsi-info-eintr (&optional regexp) + (fs-info-file "eintr" regexp)) + +(defun fsi-info (&optional regexp) + (or + (ignore-errors (fs-info-emacs regexp)) + (ignore-errors (fs-info-elisp regexp)) + (ignore-errors (fs-info-efaq regexp)) + (ignore-errors (fs-info-eintr regexp)) + (error "Not found in Emacs manual, elisp manual, Emacs FAQ and Elisp intro"))) + + + + + +(defun fsi-info-file (&optional infofile regexp) + (unless regexp + (error "Syntax: %s info-node nodename REGEXP" erbn-char)) + (unless (stringp regexp) (setq regexp (format "%s" regexp))) + + + (unless infofile (error "Syntax: %s info info-file REGEXP" + erbn-char)) + (unless (stringp infofile) (setq infofile (format "%s" infofile))) + + (cond + ((ignore-errors (Info-goto-node + (concat "(" infofile ")" regexp))) + (concat "Press C-x C-e after: (info \"(" + infofile ")" Info-current-node + "\")") + ) + ((progn + (ignore-errors + (Info-goto-node (concat "(" infofile ")")) + (Info-top-node) + (Info-search regexp))) + (concat "Press C-x C-e after: (info \"(" + infofile + ")" Info-current-node + "\")")) + (t (error "Regexp or infofile not found in the file")))) + + +(defun fsi-locate-library (&optional arg &rest rest) + "REST WILL be ignored :-)" + (unless arg (error "Syntax: %s locate-library LIB" erbn-char)) + (unless (stringp arg) + (setq arg (format "%s" arg))) + (locate-library arg)) + + +(defun fsi-avg (&rest numbers) + (cond + ((null numbers) 'NaN) + (t (fs-// (apply '+ numbers) + (length numbers))))) + + +(defun fsi-dict (&optional word &rest ignore) + (unless word (error "Syntax: %s d[ict] word" erbn-char)) + (unless (stringp word) (setq word (format "%s" word))) + (fs-dictionary-search word)) + +(defalias 'fsi-dictionary 'fs-dict) + +(defun fsi-dictionary-search (word) + "lispy.. not for interface. " + (ignore-errors (kill-buffer "*Dictionary buffer*")) + (unless (stringp word) + (setq word (format "%s" word))) + (with-timeout + (fs-internal-dictionary-time "Dictionary--TimedOut") + (dictionary-search word) + (save-window-excursion + (switch-to-buffer "*Dictionary buffer*") + (goto-line 3) + (buffer-substring-no-properties (point) (point-max))))) + + + + + +;;8/10/00 +;;;###autoload +(defun fsi-// (&rest args) + "My sensible definition of /. +Does not say 4 / 3 = 0. Note: this usues equal and not equalp, the +last time i checked , equalp seemed to work as well.. " + (let ((aa (apply '/ args))) + (if (equal (car args) (apply '* aa (cdr args))) + aa + (apply '/ (cons (float (car args)) (cdr args)))))) + + +(defun fsi-channel-members-all () + (cond + ;; for earlier ERC. + ((boundp 'channel-members) channel-members) + ;; for later CVS versions of ERC. + (t nil))) + +(defun fsi-channel-members (&optional n m &rest args) + (when (stringp n) + (setq n (ignore-errors (erbn-read n)))) + (when (stringp m) + (setq m (ignore-errors (erbn-read m)))) + (unless (integerp n) (setq n 0)) + (unless (integerp m) (setq m nil)) + (subseq (fs-channel-members-all) n m)) + + +(defun fsi-length-channel-members (&rest args) + (cond + ;; for new erc versions + ((boundp erc-channel-users) + (hash-table-count erc-channel-users)) + (t (length (fs-channel-members-all))))) + + +(defalias 'fsi-number-channel-members 'fs-length-channel-members) + +(defun fsi-cto (&rest args) + (let* ((page (mapconcat (lambda (arg) (format "%s" arg)) + args "%20")) + (pg1 "http://cliki.tunes.org/") + ;;(pg2 "http://206.63.100.249/") + (pg3 + (erbutils-replace-strings-in-string + '("+" " " "\t") '("%2B" "%20" "%20") page))) + (format "%s%s" + pg1 pg3))) + + +;;; (defun fs-karma (&rest args) +;;; (let ((fir (first args))) +;;; (unless +;;; (and +;;; args +;;; fir) +;;; (error (format "Syntax: , karma ENTITY"))) +;;; (setq fir (downcase (format "%s" fir))) +;;; (let ((result (erbkarma fir))) +;;; (if result +;;; (format "%s's karma is %s" fir result) +;;; (format +;;; "No karma defined for %s, use ,ENTITY++ or ,karma-create" fir +;;; ))))) + +;;; (defvar erbn-karma-pt 10) + +;;; (defun fs-karma-increase (&optional arg points &rest ignore) +;;; (unless arg (error "Syntax: foo++ [&optional NUMBER]")) +;;; (when (stringp points) +;;; (setq points (ignore-errors (read points)))) +;;; (unless (and (integerp points) +;;; (<= (abs points) erbn-karma-pt)) +;;; (setq points erbn-karma-pt)) +;;; (setq arg (downcase (format "%s" arg))) +;;; (erbkarma-increase arg points)) + +(defun fsi-karma-increase (&rest args) + (if (car args) + (progn + + (ignore-errors (incf (gethash (intern (format "%s" (car args))) erbn-money) 1000)) + + + (format + "Noted, %s. One %s-point for %s!" + nick + (erbutils-random '("brownie" "karma" "wiki" "rms" "lispy")) + (car args)) + + + ) + ;;(error "Karma system is currently being reworked. ") + "")) + + + + +(defalias 'fs-karma-decrease 'fs-karma-increase) + +;;; (defun fs-karma-decrease (&optional arg points &rest ignore) +;;; (unless arg (error "Syntax: foo++ [&optional NUMBER]")) +;;; (when (stringp points) +;;; (setq points (ignore-errors (read points)))) +;;; (unless (and (integerp points) +;;; (<= (abs points) erbn-karma-pt)) +;;; (setq points erbn-karma-pt)) +;;; (setq arg (downcase (format "%s" arg))) +;;; (erbkarma-decrease arg points)) + + + +;;; (defun fs-karma (&optional foo) +;;; (if foo (setq foo (downcase (format "%s" foo)))) +;;; (erbkarma foo)) + +;;; (defalias 'fs-karma-best 'erbkarma-best) + + +(defalias 'fsi-ncm 'fs-length-channel-members) +(defun fs-superiorp (&rest args) + (erbutils-random '(t nil))) +(defun fs-sucksp (&rest args) + (erbutils-random '(t nil))) +(defun fs-bugp (&rest args) + (erbutils-random '(t nil))) + + +(defun fsi-country (&optional ct) + (unless ct (error "Syntax: %s country NM (example , country jp" erbn-char)) + (setq ct (format "%s" ct)) + (let ((addp (and (> (length ct) 1) + ;; does not start with . + (not (= (aref ct 0) 46))))) + (if addp (setq ct (concat "." ct)))) + (erbcountry (downcase ct))) + + + +(defun fsi-country-search (&rest names) + (unless names (error + "Syntax: %s country-search NM (example , country japa" erbn-char)) + (erbcountry-search + (mapconcat (lambda (arg) (format "%s" arg)) names " "))) + + +;;; 2003-02-09 T13:40:04-0500 (Sunday) D. Goel +(defun fsi-spook (&rest args) + (with-temp-buffer + (spook) + (goto-char (point-min)) + (forward-line 1) + (buffer-substring-no-properties + (progn (beginning-of-line 1) (point)) + (progn (end-of-line 1) (point))))) + + +(defun fs-explode (&rest args) + (let ((pieces + (erbutils-random '("a thousand" "a million" "a gazillion" + "aleph_2"))) + (watch + (erbutils-random '("" "you watch as " + "you run for cover as " + )))) + (eval + (erbutils-random + '((format "%s%s explodes into %s pieces!" + watch erbot-nick pieces) + (format "%s, with botheart broken into %s pieces, has left: \"Goodbye\"" + erbot-nick pieces)))))) + + + + +(defalias 'fs-die 'fs-explode) +(defalias 'fs-die! 'fs-explode) +(defalias 'fs-Die! 'fs-explode) +(defalias 'fs-Die 'fs-explode) +(defalias 'fs-DIE 'fs-explode) +(defalias 'fs-leave 'fs-explode) +(defalias 'fs-exit 'fs-explode) +(defalias 'fs-quit 'fs-explode) +(defalias 'fs-shut 'fs-explode) +(defalias 'fs-stfu 'fs-explode) +(defalias 'fs-STFU 'fs-explode) + + + +(defun fsi-morse (&rest str) + (apply 'erbutils-region-to-string 'morse-region str)) +(defun fsi-unmorse (&rest str) + (apply 'erbutils-region-to-string 'unmorse-region str)) + +(defun fsi-rot13 (&rest str) + (let (st) + (cond + ((= (length str) 1) + (setq st (format "%s" (first str)))) + (t (setq st (mapconcat + (lambda (a) (format "%s" a)) str " ")))) + (erbutils-rot13 st))) + +(defun fsi-studlify (&rest s) + (apply 'erbutils-region-to-string + (lambda (&rest args) + (ignore-errors (apply + 'studlify-region args))) + s)) + + +(defun fsi-h4x0r (&rest s) + (require 'h4x0r) + (funcall + 'h4x0r-string + (mapconcat + (lambda (a) (format "%s" a)) + s " "))) + + +(defalias 'fs-h4 'fs-h4x0r) +(defalias 'fs-h4 'fs-h4xor) +(defalias 'fs-h4 'fs-haxor) +(defalias 'fs-h4 'fs-hax0r) + +(defalias 'fs-l33t 'fs-h4x0r) +(defalias 'fs-leet 'fs-h4x0r) + +(defalias 'fs-stud 'fs-studlify) + +(defcustom fs-internal-studlify-maybe-weights + '(100 1) + "" + :group 'erbc) + +(defun fsi-studlify-maybe (&rest args) + (eval + (erbutils-random + '((erbutils-stringify args) + (apply 'fs-studlify args)) + fs-internal-studlify-maybe-weights + ))) + + +(defcustom fs-internal-h4x0r-maybe-weights + '(100 1) + "" + :group 'erbc) + +(defun fsi-h4x0r-maybe (&rest args) + (let* + ((aa (erbutils-stringify args)) + (bb + (ignore-errors + (eval + (erbutils-random + '(aa + (apply 'fs-h4x0r args)) + fs-internal-h4x0r-maybe-weights + ))))) + (or bb aa))) + + +(defalias 'fs-stud-maybe 'fs-studlify-maybe) + + +(defalias 'fs-studlify-word 'studlify-word) + + +(defun fsi-princ (a &rest ignore) + (princ a)) + + +(defun fsi-pray (&rest args) + (require 'faith) + (faith-quote)) + +(defalias 'fs-all-hail-emacs 'fs-pray) +(defalias 'fs-hail-emacs 'fs-pray) +(defalias 'fs-faith 'fs-pray) + +(erbutils-defalias-i '(faith-correct-string)) +(erbutils-defalias-i '(member)) + +(erbutils-defalias-i '(stringp consp symbolp numberp listp arrayp + boundp bufferp commandp consp endp + equalp evenp oddp facep fboundp + featurep functionp integerp keywordp + keymapp listp markerp minusp natnump + nlistp numberp overlayp plusp rationalp + sequencep subrp tailp timerp + typep vectorp windowp xemacsp zerop)) + + +(erbutils-defalias-i + '(char-to-string string-to-char string-to-int + string-to-number string-to-list + string-to-number-with-radix number-to-string + pp-to-string int-to-string number-to-string + prin1-to-string rational-to-string rational-to-float + radians-to-degrees rx-to-string degrees-to-radians)) + + + + + +(defun erbn-shell-test (string &optional substrings) + "Return t if any of the substrings matches string.. Used to weed +out harmful shell code.. + +See: http://www.w3.org/Security/faq/wwwsf4.html#CGI-Q7 + + +" + (unless substrings + (setq substrings (list " " "<" ">" "-" "`" "$" "=" ";" "&" "'" + "\\" "\"" "|" "*" "?" "~" "^" "(" ")" "[" + "]" "{" "}" "\n" "\r" ))) + (let ((found nil)) + (mapcar (lambda (arg) + (when (string-match (regexp-quote arg) string) + (setq found t))) + substrings) + found)) + +(defalias 'fsi-shell-test 'erbn-shell-test) + +(defcustom erbn-internal-web-page-time 10 + "" :group 'erbc) +(defcustom erbn-url-functions-p nil + "when true, enable url functions, provided that erbot-paranoid-p +allows us that. + +The reason you may not want to enable this function is that when you +fetch url's like http://205.188.215.230:8012 (icecast, etc. content), +url.el continues fetching that url forever (discovered by indio). The +bot times out, but url continues fetching it in the background, +slowing down your bot." + :group 'erbc) + + + +(defmacro erbn-with-web-page-buffer (site &rest body) + (let ((buffer (make-symbol "web-buffer"))) + `(progn + (unless (and (not erbot-paranoid-p) + erbn-url-functions-p) + (error "erbn-url-functions-p is disabled")) + (with-timeout (erbn-internal-web-page-time "HTTP time out") + (let ((,buffer (url-retrieve-synchronously ,site))) + (when (null ,buffer) + (error "Invalid URL %s" site)) + (save-excursion + (set-buffer ,buffer) + (goto-char (point-min)) + (prog1 + (progn + ,@body) + (kill-buffer ,buffer)))))))) + +(defun fsi-web-page-title (&optional site &rest args) + (unless site (error "Syntax: %s web-page-title SITE" erbn-char)) + (setq site (format "%s" site)) + (erbn-with-web-page-buffer site + (let* ((case-fold-search t) + (beg (search-forward "<title>" nil t)) + (end (search-forward "</title>" nil t))) + (concat "That page title is " + (if (and beg end) + (erbutils-cleanup-whitespace + (buffer-substring beg (- end 8))) + "not available"))))) + +(defun fsi-wserver (&optional site &rest args) + (unless site (error "Syntax: %s wserver SITE" erbn-char)) + (setq site (format "%s" site)) + (erbn-with-web-page-buffer site + (buffer-substring (point-min) + (or (search-forward "\n\n" nil t) + (point-max))))) + +(defalias 'fs-webserver 'fs-wserver) + +(defun fsi-web (&optional site &rest args) + (unless site (error "Syntax: %s web SITE" erbn-char)) + (setq site (format "%s" site)) + (erbn-with-web-page-buffer site + (shell-command-on-region (or (search-forward "\n\n" nil t) + (point-min)) + (point-max) + "w3m -dump -T text/html" t t) + (buffer-substring (point) (mark)))) + + +;;;###autoload +(defun fsi-length-load-history () + (interactive) + (message "%s%s%S" + (length load-history) + " ..." (mapcar 'car load-history))) + + +;(defun fsi-load-history () +; load-history) +;(defun fsi-load-history () +; load-history) + +(defalias 'fs-google: 'fs-google) + + + +(defconst fs-bunny 142857) +(defconst fs-pi pi) +(defconst fs-e e) +(defconst fs-euler e) +(defconst fs-emacs-version emacs-version) + +(defalias 'fsi-emacs-version 'emacs-version) +(defalias 'fsi-gnus-version 'gnus-version) + +;; the short aliases.. +(defalias 'fsi-a 'fs-apropos) +(defalias 'fs-da 'fs-apropos) +(defalias 'fsi-ac 'fs-apropos-command) +(defalias 'fsi-ad 'fs-apropos-documentation) +(defalias 'fsi-af 'fs-apropos-function) +(defalias 'fsi-av 'fs-apropos-variable) + +(defalias 'fsi-c 'fs-commands) +(defalias 'fsi-d 'fs-dict) +(defalias 'fsi-dict: 'fs-dict) + +(defalias 'fsi-dl 'fs-describe-literally) +(defalias 'fsi-doc 'fs-doctor ) +(defalias 'fsi-dkb 'fs-describe-key-briefly ) + +(defalias 'fsi-dk 'fs-describe-key) +(defalias 'fsi-dkf 'fs-describe-key-and-function) +(defalias 'fsi-dkl 'fs-describe-key-long) + +(defalias 'fs-lkgg 'fs-lookup-key-gnus-group) +(defalias 'fs-dkgg 'fs-lookup-key-gnus-group) + +(defalias 'fs-dkgs 'fs-lookup-key-gnus-summary) +(defalias 'fs-lkgs 'fs-lookup-key-gnus-summary) + +(defalias 'fs-lkm 'fs-lookup-key-message) +(defalias 'fs-lkm 'fs-lookup-key-message) + + +(defalias 'fsi-df 'fs-describe-function ) +(defalias 'fsi-cond 'cond) +(defalias 'fsi-if 'if) +(defalias 'fsi-when 'when) +(defalias 'fsi-dfl 'fs-describe-function-long ) +(defalias 'fsi-dv 'fs-describe-variable ) +(defalias 'fsi-ff 'fs-find-function) +(defalias 'fsi-ffb 'fs-find-function-briefly) +(defalias 'fsi-ffo 'fs-find-function-on-key) +(defalias 'fsi-ffob 'fs-find-function-on-key-briefly) +(defalias 'fsi-fv 'fs-find-variable) +(defalias 'fsi-fvb 'fs-find-variable-briefly) +(defalias 'fsi-? 'fs-help) +(defalias 'fs-32 'fs-help) +(defalias 'fsi-s 'fs-search) +(defalias 'fsi-sw 'fs-search-wide) +(defalias 'fsi-sws 'fs-search-wide-sensitive) +(defalias 'fsi-wi 'fs-where-is) +(defalias 'fs-wigg 'fs-where-is-gnus-group) +(defalias 'fs-wigs 'fs-where-is-gnus-summary) +(defalias 'fs-wim 'fs-where-is-message) +(defalias 'fs-dw 'fs-where-is) +;;(defalias 'fs-yo 'fs-hi) + +;; basic functions +(defalias 'fsi-lambda 'lambda) +(defalias 'fsi-length 'length) +(defalias 'fsi-sqrt 'sqrt) + +(defalias 'fsi-= '=) +(defalias 'fsi-/= '/=) +(defalias 'fsi-< '<) +(defalias 'fsi-> '>) +(defalias 'fsi-<= '<=) +(defalias 'fsi->= '>=) +(defalias 'fsi-not 'not) +(defalias 'fsi-and 'and) +(defalias 'fsi-or 'or) +(defalias 'fs-lart 'fs-flame) + +(defalias 'fsi-null 'null) +(defalias 'fsi-atom 'atom) +;;(defalias 'fsi-stringp 'stringp) +;;(defalias 'fsi-consp 'consp) + + + + +(defalias 'fsi-equal 'equal) +(defalias 'fsi-equalp 'equalp) +(defalias 'fsi-eql 'eql) +;; rr is used for russian-roulette now.. +;;(defalias 'fs-rr 'fs-replace-regexp) +(defalias 'fs-rs 'fs-replace-string) +(defalias 'fsi-+ '+) +(defalias 'fsi-- '-) +(defalias 'fsi-* '*) +(defalias 'fsi-/ '/) +(defalias 'fsi-less 'fs-more) +(defalias 'fsi-list 'list) +(defalias 'fsi-car 'car) +(defalias 'fs-ct 'erbccountry) +(defalias 'fsi-cdr 'cdr) +(defalias 'fsi-cons 'cons) +(defalias 'fsi-append 'append) +(defalias 'fsi-first 'first) +(defalias 'fsi-second 'second) +(defalias 'fsi-third 'third) +(defalias 'fsi-fourth 'fourth) +(defalias 'fsi-fifth 'fifth) +(defalias 'fsi-sixth 'sixth) +(defalias 'fsi-seventh 'seventh) +(defalias 'fsi-eighth 'eighth) +(defalias 'fsi-ninth 'ninth) +(defalias 'fsi-tenth 'tenth) +(defalias 'fsi-subseq 'subseq) +(defalias 'fsi-ceiling 'ceiling) +(defalias 'fsi-ceiling* 'ceiling*) +(defalias 'fsi-concatenate 'concatenate) +(defalias 'fsi-cos 'cos) +(defalias 'fsi-count-lines 'count-lines) + +(defalias 'fsi-last 'last) +(defalias 'fsi-llh 'fs-length-load-history) +(defalias 'fsi-error 'erbutils-error) +(defalias 'fsi-expt 'expt) +(defalias 'fsi-exp 'exp) +(defalias 'fsi-exchange-point-and-mark 'exchange-point-and-mark) +(defalias 'fs-rq 'fs-regexp-quote) +;; (defalias 'fs-function 'identity) + +(defalias 'fsi-identity 'identity) +(defalias 'fsi-nth 'nth) +(defalias 'fsi-nthcdr 'nthcdr) +(defalias 'fsi-random 'random) +(defalias 'fsi-random-choose 'erbutils-random) +(defalias 'fsi-remove 'remove) +(defalias 'fsi-replace-regexp-in-string 'replace-regexp-in-string) +(defalias 'fsi-replace-match 'replace-match) + +(defalias 'fsi-number-to-string 'number-to-string) +(defalias 'fsi-format 'format) +(erbutils-defalias-i '(format-time-string)) + +(defalias 'fsi-split-string 'split-string) +(defalias 'fsi-rm 'fs-forget) +(defalias 'fsi-progn 'progn) +(defalias 'fsi-ignore-errors 'ignore-errors) +(defalias 'fsi-lcm 'lcm) +(defalias 'fsi-let 'let) +(defalias 'fsi-let* 'let*) +(defalias 'fsi-ll 'fs-locate-library) +(defalias 'fsi-g 'fs-google) +(defalias 'fsi-gcd 'gcd) +(defalias 'fs-gd 'fs-google-deego) + +(defalias 'fsi-ge 'fs-google-emacswiki) +(defalias 'fs-gs 'fs-google-sl4) + +(defalias 'fs-gw 'fs-google-wikipedia) +(defalias 'fs-gi 'fs-google-imdb) +(defalias 'fs-gwe 'fs-google-wikipedia-english) +(defalias 'fs-gh 'fs-google-hurdwiki) +;;(defalias 'fs-gm 'fs-google-meatball) +(defalias 'fs-gnufans 'fs-google-gnufans-net) +(defalias 'fs-gg 'fs-google-gnufans-net) +(defalias 'fs-ggn 'fs-google-gnufans-net) +(defalias 'fs-ggo 'fs-google-gnufans-org) +(defalias 'fs-gn 'fs-google-nevadamissouri) +(defalias 'fs-gp 'fs-google-planetmath) +(defalias 'fs-gt 'fs-google-twiki) +;;(defalias 'fs-gu 'fs-google-usemod) + +(defalias 'fsi-mark 'mark) +(defalias 'fsi-point 'point) +(defalias 'fsi-pop-mark 'pop-mark) +(defalias 'fsi-push-mark 'push-mark) +(defalias 'fsi-floor 'floor) +(defalias 'fsi-floor* 'floor*) + +(defalias 'fsi-round 'round) +(defalias 'fsi-round* 'round*) + +(defalias 'fsi-setcar 'setcar) +(defalias 'fsi-setcdr 'setcdr) +(defalias 'fsi-sin 'sin) +(erbutils-defalias-i '(sleep-for sit-for)) +(defalias 'fsi-string 'string) + +(defalias 'fsi-string-as-multibyte 'string-as-multibyte) +(defalias 'fsi-string-bytes 'string-bytes) +(defalias 'fsi-string-equal 'string-equal) +(defalias 'fsi-string-key-binding 'string-key-binding) +(defalias 'fsi-string-lessp 'string-lessp) +(defalias 'fsi-string-make-multibyte 'string-make-multibyte) +(defalias 'fsi-string-make-unibyte 'string-make-unibyte) +(defalias 'fsi-string-to-char 'string-to-char) +(defalias 'fsi-string-to-int 'string-to-int) +(defalias 'fsi-string-to-list 'string-to-list) +(defalias 'fsi-string-to-number 'string-to-number) +(defalias 'fsi-string-to-sequence 'string-to-sequence) +(defalias 'fsi-string-to-syntax 'string-to-syntax) +(defalias 'fsi-string-to-vector 'string-to-vector) +(defalias 'fsi-string-width 'string-width) +(defalias 'fsi-symbol-file 'symbol-file) + +(defalias 'fsi-tan 'tan) +(defalias 'fsi-cos 'cos) +(defalias 'fsi-sin 'sin) +(defalias 'fsi-atan 'atan) +(defalias 'fsi-asin 'asin) +(defalias 'fsi-acos 'acos) +(defalias 'fsi-tanh 'tanh) + +(erbutils-defalias-i + '(timezone-world-timezones + timezone-months-assoc + timezone-make-date-arpa-standard timezone-make-date-sortable + timezone-make-arpa-date timezone-make-sortable-date + timezone-make-time-string timezone-parse-date timezone-parse-time + timezone-zone-to-minute timezone-time-from-absolute + timezone-time-zone-from-absolute timezone-fix-time + timezone-last-day-of-month timezone-leap-year-p timezone-day-number + timezone-absolute-from-gregorian)) + + +(defalias 'fsi-truncate 'truncate) + +(defalias 'fsi-truncate* 'truncate*) +(defalias 'fsi-truncate-string 'truncate-string) +(defalias 'fsi-truncate-string-to-width 'truncate-string-to-width) + + +(defalias 'fsi-erc-version 'erc-version) +(defalias 'fsi-sv 'erc-cmd-SV) +(defalias 'fsi-erc-cmd-SV 'erc-cmd-SV) +(defalias 'fsi-smv 'erc-cmd-SMV) +(defalias 'fsi-erc-cmd-SMV 'erc-cmd-SMV) +(defalias 'fsi-sm 'erc-cmd-SM) +(defalias 'fsi-cmd-SM 'erc-cmd-SM) +(defalias 'fsi-stringify 'erbutils-stringify) +;; (defalias 'fs-while 'while) + +;;;==================================================== + +;;;==================================================== +;; ERRORS: + +(defun fsi-load-library (&rest args) + (error "Use 'require instead. ")) + +(defalias 'fs-load 'fs-load-library) +(defalias 'fs-load-file 'fs-load-library) + + + +;; cl-extra.el + +(defalias 'fsi-equalp 'equalp) +;; done gcd +;; done lcm +(defalias 'fsi-isqrt 'isqrt) +(defalias 'fsi-floor* + 'floor* ) + +(defalias 'fsi-ceiling* +'ceiling* ) + +(defalias 'fsi-truncate* +'truncate*) + +;; done round* + +(defalias 'fsi-mod* + 'mod* ) + +(when (ignore-errors + (require 'geek)) + (erbutils-defalias-i '(geek-code))) + +(defalias 'fsi-rem* + 'rem* ) + +(erbutils-defalias-i + '(signum + random* + ;; yes? + make-random-state + random-state-p + + most-positive-float most-negative-float + least-positive-float least-negative-float + least-positive-normalized-float least-negative-normalized-float + float-epsilon float-negative-epsilon cl-float-limits ;; done subseq + concatenate revappend nreconc list-length tailp cl-copy-tree + copy-tree + ;;get* getf + ;;cl-set-getf cl-do-remf cl-remprop remprop + cl-make-hash-table + cl-hash-table-p cl-not-hash-table cl-hash-lookup cl-builtin-gethash + cl-builtin-remhash cl-builtin-clrhash cl-builtin-maphash cl-gethash + ;;cl-puthash cl-remhash cl-clrhash + ;;cl-maphash + cl-hash-table-count + cl-prettyprint cl-do-prettyprint cl-macroexpand-cmacs cl-closure-vars + cl-macroexpand-all cl-macroexpand-body cl-prettyexpand)) + + + +;; oct.el + +(ignore-errors (require 'oct)) + +(erbutils-defalias-i + + + '( + oct-zeros oct-ones oct-sum oct-size + oct-rows oct-columns oct-\.* + oct-add + oct-corr oct-complement oct-sumsq oct-mean + oct-sqrt oct-std oct-tanh oct-atanh) + "" "oct-") + +(erbutils-defalias-i '(oct-/ oct-+ )) +(erbutils-defalias-i '(lsh)) +(erbutils-defalias-i '(obarray)) + + +;; files.el +(erbutils-defalias-i + '(auto-mode-alist interpreter-mode-alist + directory-abbrev-alist)) + + +(erbutils-defalias-i '(load-history)) +(erbutils-defalias-i '(assoc)) +(erbutils-defalias-i '(eq)) +(erbutils-defalias-i '(message)) +(erbutils-defalias-i '(decf)) +(erbutils-defalias-i '(incf)) +(erbutils-defalias-i '(faith-quote)) +(erbutils-defalias-i '(zerop)) +;;(erbutils-defalias-i '(buffer-substring)) +(erbutils-defalias-i '(buffer-substring-no-properties)) +;;(erbutils-defalias-i '(buffer-string)) + +;; We define it to be no-properties, else people can (setq foo +;; (buffer-string)).. and cause a huge uservariables file.. + +(defun fsi-buffer-string (&rest args) + (buffer-substring-no-properties (point-min) (point-max))) + +(defalias 'fsi-buffer-substring 'buffer-substring-no-properties) + + +(erbutils-defalias-i + '(featurep feature-symbols feature-file features + + )) +(erbutils-defalias-i + '(minor-mode-alist minor-mode-map-alist + minor-mode-overriding-map-alist)) +(erbutils-defalias-vars '(major-mode)) + +;; from gnus-group.el + +(erbutils-defalias-vars '(gnus-group-mode-map)) +(erbutils-defalias-vars '(gnus-summary-mode-map)) +(erbutils-defalias-vars '(message-mode-map)) +(erbutils-defalias-vars '(text-mode-map)) +(erbutils-defalias-vars '(emacs-lisp-mode-map)) +(erbutils-defalias-vars '(lisp-mode-map)) + +(erbutils-defalias-i '(boundp fboundp)) +(erbutils-defalias-i '(lookup-key)) +(erbutils-defalias-i '(minor-mode-key-binding)) + +(erbutils-defalias-i '(where-is-internal)) +(erbutils-defalias-i '(% abs)) + +(erbutils-defalias-i '(cdr cddr car cadr cdar)) +(erbutils-defalias-i '(erc-channel-list)) + +(when (ignore-errors (require 'units)) + (erbutils-defalias-i '(units-version units-load-hook units-dat-file + units-buffer units-s-to-n + units-prefix-convert + units-si-prefix-list + units-si-short-prefix-list + units-convert-1 units-convert))) + + +(defvar erbn-nicks-dead nil) + +(defun erbn-mark-dead (&rest ignore) + (let ((ni (format "%s" erbn-nick))) + (unless (string= ni "nil") + (add-to-list 'erbn-nicks-dead (format "%s" erbn-nick))))) + + + +;; allow people to mark themselves dead :-) +(defalias 'fsi-mark-dead 'erbn-mark-dead) + +(defun erbn-unmark-dead (nick) + (setq erbn-nicks-dead (remove (format "%s" nick) erbn-nicks-dead))) + + + +(defun erbn-dead-check (&rest ignore) + (when (fsi-dead-p erbn-nick) + (error "I see dead people! + .... (but I don't talk to them!)"))) + +(defalias 'fsi-dead-check 'erbn-dead-check) + +(defun erbn-dead-p (&optional nick) + (unless nick (setq nick erbn-nick)) + (member (format "%s" nick) erbn-nicks-dead)) + +(defalias 'fsi-dead-p 'erbn-dead-p) + + + +(defun fs-give (&optional nini &rest stuff) + (unless nini (setq nini "self")) + (when (string= "me" nini) + (setq nini nick)) + (unless stuff (setq stuff '("a" "beer"))) + (format "/me gives %s %s" + nini + (mapconcat + (lambda (arg) (format "%s" arg)) + stuff " "))) + + +(defalias 'fs-hand 'fs-give) + +(erbutils-defalias-i + '(backward-kill-sentence + backward-sentence + flame-sentence flame-sentence-ify + flame-sentence-loop forward-sentence kill-sentence + mark-end-of-sentence sentence-at-point sentence-end + sentence-end-double-space sentence-end-without-period + transpose-sentences)) + +(defalias 'fsi-flatten 'erbutils-flatten) + + + +(erbutils-defalias-i '(log)) +(erbutils-defalias-i + '(most-positive-fixnum + most-negative-fixnum)) + + + +(erbutils-defalias-i + '( + regexp-opt + regexp-opt-depth + regexp-opt-group regexp-opt-charset)) + +(erbutils-defalias-i '(window-system)) + + +(defvar erbot-kbd-p nil + "Whether to enable kbd. + +Note that making this non-nil can lead to vector results. For +example, (kbd \"<home>\"), (thanks to fledermaus).") + +(when (and + (not erbot-paranoid-p) + erbot-kbd-p + (erbutils-defalias-i + '(kbd read-kbd-macro)))) + +(defconst fs-t t + "As such, when we sandbox a lisp expression, t remains t, so this is +not needed. +However, inside macros like (cond (t....)), t becomes fs-t because +it occurs in an unusual place. this const should take care of it.. +Of course, this also opens the bot to some FUN user abuse, when they +setq fs-t to nil :-) ") + + +(defconst fs-nil nil + "See the doc of fs-t ") + + +(defun fsi-revive (&optional name &rest ignore) + (unless name (error "no one to revive")) + (setq name (format "%s" name)) + (let (ansstr) + (setq ansstr + (cond + ((string= name nick) + (concat "Thou idiot, " nick ", thou canst not revive thyself!")) + (t (concat + "/me sprinkles some " + (erbutils-random + '("clear" "murky" "boiling" "dark" "holy" "smelly")) + " potion on " + (format "%s" name) + " and utters some prayers. " + (erbutils-random + (list + (format "%s wakes up" name) + "Nothing happens." + (format "%s wakes up, all refreshed. " name) + (format "%s wakes up, all confused. " name) + )))))) + (when (string-match "wakes up" ansstr) + (erbn-unmark-dead name)) + ansstr)) + +;; this may be unsafe, remove it: +;; (defalias 'fs-sandbox-quoted 'erblisp-sandbox-quoted) +;; (defalias 'fs-sandbox-quoted-maybe 'erblisp-sandbox-quoted-maybe) +;; (defalias 'fs-sandbox 'erblisp-sandbox) + +(erbutils-defalias-i '(macroexpand)) + + +;;"/usr/share/emacs/21.2/lisp/emacs-lisp/pp.el" +(erbutils-defalias + '(pp-escape-newlines + pp-to-string + ;; pp pp-eval-expression + ;;pp-eval-last-sexp)) + )) + + +(erbutils-defalias-i '(string-match identity)) + +(erbutils-defalias-i '(parse-time-string)) + +(erbutils-defalias-i '(reverse)) + +(defun fsi-pp (object &rest ignore) + (pp object)) + + +(defmacro fs-privmsg (&rest args) + "This macro is carefully constructed so that one user cannot force a +query to another user. " + `(cond + ;; This can occur when you are requesting a parse.. + ((null erbn-nick) + (progn ,@args)) + (t + (progn + (setq erbn-tgt erbn-nick) + ;; If there isn't already a buffer, create one.. + (erbn-query erbn-nick) + ,@args)))) + +(defun erbn-query (qnick) + (save-excursion (erc-query qnick erbn-buffer))) + + + +(defun fsi-read-or-orig (arg) + " If string and can read, read, else return the arg. +Note: Used by fs-describe" + (cond + ((stringp arg) + (condition-case fs-tmp (erbn-read arg) + (error arg))) + (t arg))) + + +(defun erbn-read-from-string (str) + (let (str2) + (cond + ((stringp str) + (setq str2 (copy-sequence str)) + (set-text-properties 0 (length str2) nil str2) + (read-from-string str)) + (t (error "The bot will only read from strings. "))))) + + + +(defun erbn-read (str) + "Like read, but only from strings" + (car (erbn-read-from-string str))) + + +(defalias 'fsi-read 'erbn-read) +(defalias 'fsi-read-from-string 'erbn-read-from-string) + + +(erbutils-defalias-i + '(substring subr-arity subrp subseq + subst-char-in-string + subtract-time + time-subtract + time-add + date-to-time + time-to-seconds + time-less-p + seconds-to-time + days-to-time + time-since + subtract-time + date-to-day + days-between + date-leap-year-p + time-to-day-in-year time-to-days time-to-number-of-days + safe-date-to-time)) + + +(erbutils-defalias-i '(ignore)) + +(erbutils-defalias-i '(caar elt)) + +(provide 'erbc) +(run-hooks 'fs-after-load-hooks) + + + +;;; erbc.el ends here + |