diff options
Diffstat (limited to 'elisp/erbot/erbc2.el')
| -rw-r--r-- | elisp/erbot/erbc2.el | 349 |
1 files changed, 349 insertions, 0 deletions
diff --git a/elisp/erbot/erbc2.el b/elisp/erbot/erbc2.el new file mode 100644 index 0000000..2d84cbc --- /dev/null +++ b/elisp/erbot/erbc2.el @@ -0,0 +1,349 @@ +;;; erbc2.el --- mostly: special functions for erbc.el +;; Time-stamp: <2007-11-23 11:30:12 deego> +;; Copyright (C) 2003 D. Goel +;; Emacs Lisp Archive entry +;; Filename: erbc2.el +;; Package: erbc2 +;; Author: D. Goel <deego@gnufans.org> +;; Keywords: +;; Version: +;; URL: 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. + + + +;; this gile contains yet more functions for fs-. The functions +;; here shall tend to be "specially defined" ones. + + +(defconst erbc2-version "0.0dev") +;;========================================== +;;; Requires: +(eval-when-compile (require 'cl)) + +;;; Code: + +(defcustom erbc2-before-load-hooks nil + "Hooks to run before loading erbc2." + :group 'erbc2) +(defcustom erbc2-after-load-hooks nil + "Hooks to run after loading erbc2." + :group 'erbc2) +(run-hooks 'erbc2-before-load-hooks) + + +;;; Real Code: + +(defvar erbn-while-max 10000) +(defvar erbn-while-ctr 0) +(defmacro fs-while (cond &rest body) + `(let + ((erbn-while-ctr 0)) + (while + ,cond + ;; this should enable the with-timeout checks.. + (sleep-for 0.01) + (if (> erbn-while-ctr erbn-while-max) + (error "Max while iterations exceeded: %S" + erbn-while-ctr)) + (incf erbn-while-ctr) + nil + ,@body))) + + + +(defmacro fs-dotimes (spec &rest body) + `(dotimes + ,spec + (sleep-for 0.01) + nil + ,@body)) + + + + +(defun fsi-set-difference (a b) + (set-difference a b)) + + +(defun fsi-pp (&optional foo &rest bar) + (pp foo)) + + + + + + +(defvar erbn-tmp-avar nil) +(defvar erbn-tmp-newargs nil) + +(defun erbn-apply-sandbox-args-old (args) + (cond + ((= (length args) 0) nil) + ((= (length args) 1) + (if (equal (caar args) 'quote) args + (mapcar 'erblisp-sandbox-quoted args))) + (t + (cons (erblisp-sandbox-quoted (car args)) + (erbn-apply-sandbox-args (cdr args)))))) +(defun erbn-apply-sandbox-args (args) + (cond + ((not (listp args)) + (erblisp-sandbox args)) + ((= (length args) 0) nil) + (t + (mapcar 'erblisp-sandbox args)))) + +(defvar erbn-apptmpa) +(defvar erbn-apptmpb) +(defvar erbn-apptmpc) +(defvar erbn-apptmpd) +(defvar erbn-tmpsymbolp) + + +(defmacro fs-apply (fcnsym &rest args) + "" + (when erbot-paranoid-p + (error "This function is disabled: erbot-paranoid-p")) + (unless fcnsym (error "No function to fs-apply!")) + (let (erbn-tmpargs + (erbn-tmplen (length args)) + erbn-tmpfirstargs + erbn-lastargs + erbn-tmpspecialp ;; denotes: NIL: no arguments at all. + erbn-tmpnoinitialp ;; denotes the case when the len args =1.. + ) + (cond + ((= (length args) 0) + (setq erbn-tmpspecialp t)) + ((= (length args) 1) + (setq erbn-tmpnoinitialp t))) + (cond + ((null args) + (setq erbn-tmpargs nil) + (setq erbn-tmplastargs nil) + (setq erbn-tmpspecialp nil)) + (t + (setq erbn-tmpargs + (append (subseq args 0 (- erbn-tmplen 1)))) + (setq erbn-tmplastargs + (first (last args))))) + (setq erbn-tmpargs (erbn-apply-sandbox-args erbn-tmpargs)) + (setq erbn-tmplastargs + (if (and (listp erbn-tmplastargs) + (equal (car erbn-tmplastargs) 'quote)) + erbn-tmplastargs + (erbn-apply-sandbox-args erbn-tmplastargs))) + (cond + ((listp fcnsym) + (setq fcnsym (erblisp-sandbox-quoted fcnsym))) + ((symbolp fcnsym) + (setq fcnsym (erblisp-sandbox-quoted fcnsym))) + (t (error "No clue how to apply that. "))) + (cond + (erbn-tmpspecialp + `(apply (erblisp-sandbox-quoted ,fcnsym) nil)) + (erbn-tmpnoinitialp + `(apply (erblisp-sandbox-quoted ,fcnsym) ,erbn-tmplastargs)) + (t + `(apply (erblisp-sandbox-quoted ,fcnsym) ,@erbn-tmpargs ,erbn-tmplastargs))))) + + +;; (defmacro fs-apply-old (fcnsym &rest args) +;; (error "This function is old.") +;; (unless fcnsym (error "No function to fs-apply!")) +;; (let (erbn-tmpargs +;; (erbn-tmplen (length args)) +;; erbn-tmpnewargs +;; ) +;; (cond +;; ((null args) +;; (setq erbn-tmpargs nil)) +;; (t +;; (setq erbn-tmpargs +;; (append (subseq args 0 (- erbn-tmplen 1)) +;; (last args))))) + +;; (let* ( +;; (erbn-tmp-newargs (erbn-apply-sandbox-args erbn-tmpargs)) +;; (erbn-tmp-newlen (length erbn-tmp-newargs))) +;; (cond +;; ((listp fcnsym) +;; (setq fcnsym (erblisp-sandbox-quoted fcnsym))) +;; ((symbolp fcnsym) +;; (setq fcnsym (erblisp-sandbox-quoted fcnsym))) +;; (t (error "No clue how to apply that. "))) +;; `(let ((erbn-tmp-avar ,fcnsym)) +;; (cond +;; ((symbolp erbn-tmp-avar) +;; (setq erbn-tmp-avar +;; (erblisp-sandbox-quoted erbn-tmp-avar))) +;; (t "nada")) +;; ,(if (= erbn-tmp-newlen 0) +;; `(apply erbn-tmp-avar nil) +;; `(apply erbn-tmp-avar ,@erbn-tmp-newargs nil)))))) + + +(defmacro fs-funcall (symbol &rest args) + `(fs-apply ,symbol ,@args nil)) + + + +;; hm, what is this? Was it me? silly me.. Why did I do this?? +(defalias 'fs-function 'identity) + +(defvar erbn-read-mode nil) +(defvar erbn-read-input nil) + +(defvar fs-internal-botread-prompt "Enter: ") + +(defun fsi-botread (&optional prompt) + (unless prompt (setq prompt fs-internal-botread-prompt)) + (ignore-errors + (erbot-reply (concat prompt "") proc nick tgt msg nil)) + (setq fs-internal-botread-prompt "Enter: ") + (setq erbn-read-mode t) + (while + (not erbn-read-input) + (sleep-for 0.1) + (sit-for 0.1)) + (let ((input erbn-read-input)) + (setq erbn-read-input nil) + (setq erbn-read-mode nil) + input)) + +(defun fsi-dun-mprinc (str) + (ignore-errors + (erbot-reply str proc nick tgt msg nil)) + (setq fs-internal-botread-prompt str)) + +(defun fsi-botread-feed-internal (str) + (setq erbn-read-input str) + (format + "Thanks for feeding the read-line. Msg obtained: %s" + str) + (setq erbn-read-mode nil) + str) + + + +;; i love this thing.. just no time to finish this yet.. + +;;; (defvar erbn-calsmart-tmp-expr nil) +;;; (defvar erbn-calsmart-tmp-exprb nil) +;;; (defvar erbn-calsmart-tmp-exprc nil) +;;; (defvar erbn-calsmart-tmp-error nil) + +;;; (defmacro fs-calsmart (&rest exprs) +;; "This will insert parenthesis appropriately, so you can type stuff +;; like , c + 2 3 4 - 3 4 * 3 4 5 (- 2 3) +;; and fsbot will try parenthesis at appropriate places until the +;; resulting expression makes sense .. " +;;; (require 'choose) +;;; (case (length exprs) +;;; ((1) `(car ,exprs)) +;;; (t +;;; `(choose-with +;;; (let* ( +;;; (erbn-calsmart-tmp-expr expr) +;;; (erbn-calsmart-tmp-exprb +;;; (erbn-calsmart-break-expr erbn-calsmart-tmp-expr)) +;;; (erbn-calsmart-tmp-exprc +;;; (choose (list erbn-calsmart-expr +;;; erbn-calsmart-tmp-exprb))) +;;; ) +;;; (cond +;;; (erbn-calsmart-tmp-exprb +;;; (condition-case erbn-calsmart-tmp-error +;;; (eval erbn-calsmart-tmp-exprc) +;;; (error (choose-fail)))) +;;; ;; couldn't break.. just do the normal thing. +;;; (t (eval erbn-calsmart-tmp-expr)))))))) + + +;;; (defun erbn-calsmart-break-expr (expr) +;;; "Expr is a list, which we intend to break. WE prefer breaking such +;;; that the broken function gets 2 arguments. +;;; We want to rewrap everything by erbn-calsmart, so things get broken +;;; further.. + + + +(defun fsi-bash-specific-quote (&optional number &rest ignored) + "NUMBER need not be jsut NUMBER. Any argument to +bash-specific-quotes, like random, should work." + (require 'bash-quotes) + (let (aa bb bashstr) + (unless number + (setq number "random")) + (bash-specific-quote (format "%s" number)) + (sit-for 5) + ;; (let (aa bb) + ;; (set-buffer "*bash*") + ;; (goto-char (point-min)) + ;; (setq aa (search-forward "--------" nil t)) + ;; (forward-line 1) + ;; (setq aa (search-forward "--------" nil t)) + ;; (forward-line 1) + ;; (setq aa (point)) + ;; (setq bb (search-forward "--------" nil t)) + ;; (forward-line -1) + ;; (setq bb (point)) + ;; (when (and aa bb) + ;; (buffer-substring-no-properties aa bb))) + (set-buffer "*bash*") + (setq bashstr (erbutils-buffer-string)) + (with-temp-buffer + (insert bashstr) + (goto-char (point-min)) + (setq aa (search-forward-regexp "^--------" nil t)) + (forward-line 1) + (setq aa (search-forward-regexp "^--------" nil t)) + (forward-line 1) + (beginning-of-line) + (setq aa (point)) + (setq bb (search-forward-regexp "^--------" nil t)) + (forward-line -1) + (end-of-line) + (setq bb (point)) + (if (and aa bb) + (buffer-substring-no-properties aa bb) + "No result")))) + +(defalias 'fsi-bsc 'fs-bash-specific-quote) +(defalias 'fs-bash-quote 'fs-bash-specific-quote) +(defalias 'fs-bash.org 'fs-bash-specific-quote) +;;(defalias 'fs-bash 'fs-bash-specific-quote) + + + + + + +(defalias 'fsi-lexical-let 'lexical-let) +(provide 'erbc2) +(run-hooks 'erbc2-after-load-hooks) + + + +;;; erbc2.el ends here |