1 |
;;; erbc2.el --- mostly: special functions for erbc.el |
;;; erbc2.el --- mostly: special functions for erbc.el |
2 |
;; Time-stamp: <2004-12-31 23:24:58 deego> |
;; Time-stamp: <2005-01-08 12:52:26 deego> |
3 |
;; Copyright (C) 2003 D. Goel |
;; Copyright (C) 2003 D. Goel |
4 |
;; Emacs Lisp Archive entry |
;; Emacs Lisp Archive entry |
5 |
;; Filename: erbc2.el |
;; Filename: erbc2.el |
54 |
|
|
55 |
;;; Real Code: |
;;; Real Code: |
56 |
|
|
57 |
(defvar erbnoc-while-max 10000) |
(defvar erbn-while-max 10000) |
58 |
(defvar erbnoc-while-ctr 0) |
(defvar erbn-while-ctr 0) |
59 |
(defmacro fs-while (cond &rest body) |
(defmacro fs-while (cond &rest body) |
60 |
`(let |
`(let |
61 |
((erbnoc-while-ctr 0)) |
((erbn-while-ctr 0)) |
62 |
(while |
(while |
63 |
,cond |
,cond |
64 |
;; this should enable the with-timeout checks.. |
;; this should enable the with-timeout checks.. |
65 |
(sleep-for 0.01) |
(sleep-for 0.01) |
66 |
(if (> erbnoc-while-ctr erbnoc-while-max) |
(if (> erbn-while-ctr erbn-while-max) |
67 |
(error "Max while iterations exceeded: %S" |
(error "Max while iterations exceeded: %S" |
68 |
erbnoc-while-ctr)) |
erbn-while-ctr)) |
69 |
(incf erbnoc-while-ctr) |
(incf erbn-while-ctr) |
70 |
nil |
nil |
71 |
,@body))) |
,@body))) |
72 |
|
|
94 |
|
|
95 |
|
|
96 |
|
|
97 |
(defvar erbnoc-tmp-avar nil) |
(defvar erbn-tmp-avar nil) |
98 |
(defvar erbnoc-tmp-newargs nil) |
(defvar erbn-tmp-newargs nil) |
99 |
|
|
100 |
(defun erbnoc-apply-sandbox-args-old (args) |
(defun erbn-apply-sandbox-args-old (args) |
101 |
(cond |
(cond |
102 |
((= (length args) 0) nil) |
((= (length args) 0) nil) |
103 |
((= (length args) 1) |
((= (length args) 1) |
105 |
(mapcar 'erblisp-sandbox-quoted args))) |
(mapcar 'erblisp-sandbox-quoted args))) |
106 |
(t |
(t |
107 |
(cons (erblisp-sandbox-quoted (car args)) |
(cons (erblisp-sandbox-quoted (car args)) |
108 |
(erbnoc-apply-sandbox-args (cdr args)))))) |
(erbn-apply-sandbox-args (cdr args)))))) |
109 |
(defun erbnoc-apply-sandbox-args (args) |
(defun erbn-apply-sandbox-args (args) |
110 |
(cond |
(cond |
111 |
((not (listp args)) |
((not (listp args)) |
112 |
(erblisp-sandbox args)) |
(erblisp-sandbox args)) |
114 |
(t |
(t |
115 |
(mapcar 'erblisp-sandbox args)))) |
(mapcar 'erblisp-sandbox args)))) |
116 |
|
|
117 |
(defvar erbnoc-apptmpa) |
(defvar erbn-apptmpa) |
118 |
(defvar erbnoc-apptmpb) |
(defvar erbn-apptmpb) |
119 |
(defvar erbnoc-apptmpc) |
(defvar erbn-apptmpc) |
120 |
(defvar erbnoc-apptmpd) |
(defvar erbn-apptmpd) |
121 |
(defvar erbnoc-tmpsymbolp) |
(defvar erbn-tmpsymbolp) |
122 |
|
|
123 |
|
|
124 |
(defmacro fs-apply (fcnsym &rest args) |
(defmacro fs-apply (fcnsym &rest args) |
125 |
"" |
"" |
126 |
(unless fcnsym (error "No function to fs-apply!")) |
(unless fcnsym (error "No function to fs-apply!")) |
127 |
(let (erbnoc-tmpargs |
(let (erbn-tmpargs |
128 |
(erbnoc-tmplen (length args)) |
(erbn-tmplen (length args)) |
129 |
erbnoc-tmpfirstargs |
erbn-tmpfirstargs |
130 |
erbnoc-lastargs |
erbn-lastargs |
131 |
erbnoc-tmpspecialp ;; denotes: NIL: no arguments at all. |
erbn-tmpspecialp ;; denotes: NIL: no arguments at all. |
132 |
erbnoc-tmpnoinitialp ;; denotes the case when the len args =1.. |
erbn-tmpnoinitialp ;; denotes the case when the len args =1.. |
133 |
) |
) |
134 |
(cond |
(cond |
135 |
((= (length args) 0) |
((= (length args) 0) |
136 |
(setq erbnoc-tmpspecialp t)) |
(setq erbn-tmpspecialp t)) |
137 |
((= (length args) 1) |
((= (length args) 1) |
138 |
(setq erbnoc-tmpnoinitialp t))) |
(setq erbn-tmpnoinitialp t))) |
139 |
(cond |
(cond |
140 |
((null args) |
((null args) |
141 |
(setq erbnoc-tmpargs nil) |
(setq erbn-tmpargs nil) |
142 |
(setq erbnoc-tmplastargs nil) |
(setq erbn-tmplastargs nil) |
143 |
(setq erbnoc-tmpspecialp nil)) |
(setq erbn-tmpspecialp nil)) |
144 |
(t |
(t |
145 |
(setq erbnoc-tmpargs |
(setq erbn-tmpargs |
146 |
(append (subseq args 0 (- erbnoc-tmplen 1)))) |
(append (subseq args 0 (- erbn-tmplen 1)))) |
147 |
(setq erbnoc-tmplastargs |
(setq erbn-tmplastargs |
148 |
(first (last args))))) |
(first (last args))))) |
149 |
(setq erbnoc-tmpargs (erbnoc-apply-sandbox-args erbnoc-tmpargs)) |
(setq erbn-tmpargs (erbn-apply-sandbox-args erbn-tmpargs)) |
150 |
(setq erbnoc-tmplastargs |
(setq erbn-tmplastargs |
151 |
(if (and (listp erbnoc-tmplastargs) |
(if (and (listp erbn-tmplastargs) |
152 |
(equal (car erbnoc-tmplastargs) 'quote)) |
(equal (car erbn-tmplastargs) 'quote)) |
153 |
erbnoc-tmplastargs |
erbn-tmplastargs |
154 |
(erbnoc-apply-sandbox-args erbnoc-tmplastargs))) |
(erbn-apply-sandbox-args erbn-tmplastargs))) |
155 |
(cond |
(cond |
156 |
((listp fcnsym) |
((listp fcnsym) |
157 |
(setq fcnsym (erblisp-sandbox-quoted fcnsym))) |
(setq fcnsym (erblisp-sandbox-quoted fcnsym))) |
159 |
(setq fcnsym (erblisp-sandbox-quoted fcnsym))) |
(setq fcnsym (erblisp-sandbox-quoted fcnsym))) |
160 |
(t (error "No clue how to apply that. "))) |
(t (error "No clue how to apply that. "))) |
161 |
(cond |
(cond |
162 |
(erbnoc-tmpspecialp |
(erbn-tmpspecialp |
163 |
`(apply ,fcnsym nil)) |
`(apply ,fcnsym nil)) |
164 |
(erbnoc-tmpnoinitialp |
(erbn-tmpnoinitialp |
165 |
`(apply ,fcnsym ,erbnoc-tmplastargs)) |
`(apply ,fcnsym ,erbn-tmplastargs)) |
166 |
(t |
(t |
167 |
`(apply ,fcnsym ,@erbnoc-tmpargs ,erbnoc-tmplastargs))))) |
`(apply ,fcnsym ,@erbn-tmpargs ,erbn-tmplastargs))))) |
168 |
|
|
169 |
|
|
170 |
(defmacro fs-apply-old (fcnsym &rest args) |
(defmacro fs-apply-old (fcnsym &rest args) |
171 |
(unless fcnsym (error "No function to fs-apply!")) |
(unless fcnsym (error "No function to fs-apply!")) |
172 |
(let (erbnoc-tmpargs |
(let (erbn-tmpargs |
173 |
(erbnoc-tmplen (length args)) |
(erbn-tmplen (length args)) |
174 |
erbnoc-tmpnewargs |
erbn-tmpnewargs |
175 |
) |
) |
176 |
(cond |
(cond |
177 |
((null args) |
((null args) |
178 |
(setq erbnoc-tmpargs nil)) |
(setq erbn-tmpargs nil)) |
179 |
(t |
(t |
180 |
(setq erbnoc-tmpargs |
(setq erbn-tmpargs |
181 |
(append (subseq args 0 (- erbnoc-tmplen 1)) |
(append (subseq args 0 (- erbn-tmplen 1)) |
182 |
(last args))))) |
(last args))))) |
183 |
|
|
184 |
(let* ( |
(let* ( |
185 |
(erbnoc-tmp-newargs (erbnoc-apply-sandbox-args erbnoc-tmpargs)) |
(erbn-tmp-newargs (erbn-apply-sandbox-args erbn-tmpargs)) |
186 |
(erbnoc-tmp-newlen (length erbnoc-tmp-newargs))) |
(erbn-tmp-newlen (length erbn-tmp-newargs))) |
187 |
(cond |
(cond |
188 |
((listp fcnsym) |
((listp fcnsym) |
189 |
(setq fcnsym (erblisp-sandbox-quoted fcnsym))) |
(setq fcnsym (erblisp-sandbox-quoted fcnsym))) |
190 |
((symbolp fcnsym) |
((symbolp fcnsym) |
191 |
(setq fcnsym (erblisp-sandbox-quoted fcnsym))) |
(setq fcnsym (erblisp-sandbox-quoted fcnsym))) |
192 |
(t (error "No clue how to apply that. "))) |
(t (error "No clue how to apply that. "))) |
193 |
`(let ((erbnoc-tmp-avar ,fcnsym)) |
`(let ((erbn-tmp-avar ,fcnsym)) |
194 |
(cond |
(cond |
195 |
((symbolp erbnoc-tmp-avar) |
((symbolp erbn-tmp-avar) |
196 |
(setq erbnoc-tmp-avar |
(setq erbn-tmp-avar |
197 |
(erblisp-sandbox-quoted erbnoc-tmp-avar))) |
(erblisp-sandbox-quoted erbn-tmp-avar))) |
198 |
(t "nada")) |
(t "nada")) |
199 |
,(if (= erbnoc-tmp-newlen 0) |
,(if (= erbn-tmp-newlen 0) |
200 |
`(apply erbnoc-tmp-avar nil) |
`(apply erbn-tmp-avar nil) |
201 |
`(apply erbnoc-tmp-avar ,@erbnoc-tmp-newargs nil)))))) |
`(apply erbn-tmp-avar ,@erbn-tmp-newargs nil)))))) |
202 |
|
|
203 |
(defmacro fs-funcall (symbol &rest args) |
(defmacro fs-funcall (symbol &rest args) |
204 |
`(fs-apply ,symbol ,@args nil)) |
`(fs-apply ,symbol ,@args nil)) |
208 |
;; hm, WTF is this? Was it me? silly me.. Why did I do this?? |
;; hm, WTF is this? Was it me? silly me.. Why did I do this?? |
209 |
(defalias 'fs-function 'identity) |
(defalias 'fs-function 'identity) |
210 |
|
|
211 |
(defvar erbnoc-read-mode nil) |
(defvar erbn-read-mode nil) |
212 |
(defvar erbnoc-read-input nil) |
(defvar erbn-read-input nil) |
213 |
|
|
214 |
(defvar fs-internal-botread-prompt "Enter: ") |
(defvar fs-internal-botread-prompt "Enter: ") |
215 |
|
|
218 |
(ignore-errors |
(ignore-errors |
219 |
(erbot-reply (concat prompt "") proc nick tgt msg nil)) |
(erbot-reply (concat prompt "") proc nick tgt msg nil)) |
220 |
(setq fs-internal-botread-prompt "Enter: ") |
(setq fs-internal-botread-prompt "Enter: ") |
221 |
(setq erbnoc-read-mode t) |
(setq erbn-read-mode t) |
222 |
(while |
(while |
223 |
(not erbnoc-read-input) |
(not erbn-read-input) |
224 |
(sleep-for 0.1) |
(sleep-for 0.1) |
225 |
(sit-for 0.1)) |
(sit-for 0.1)) |
226 |
(let ((input erbnoc-read-input)) |
(let ((input erbn-read-input)) |
227 |
(setq erbnoc-read-input nil) |
(setq erbn-read-input nil) |
228 |
(setq erbnoc-read-mode nil) |
(setq erbn-read-mode nil) |
229 |
input)) |
input)) |
230 |
|
|
231 |
(defun fsi-dun-mprinc (str) |
(defun fsi-dun-mprinc (str) |
234 |
(setq fs-internal-botread-prompt str)) |
(setq fs-internal-botread-prompt str)) |
235 |
|
|
236 |
(defun fsi-botread-feed-internal (str) |
(defun fsi-botread-feed-internal (str) |
237 |
(setq erbnoc-read-input str) |
(setq erbn-read-input str) |
238 |
(format |
(format |
239 |
"Thanks for feeding the read-line. Msg obtained: %s" |
"Thanks for feeding the read-line. Msg obtained: %s" |
240 |
str) |
str) |
241 |
(setq erbnoc-read-mode nil) |
(setq erbn-read-mode nil) |
242 |
str) |
str) |
243 |
|
|
244 |
|
|
245 |
|
|
246 |
;; i love this thing.. just no time to finish this yet.. |
;; i love this thing.. just no time to finish this yet.. |
247 |
|
|
248 |
;;; (defvar erbnoc-calsmart-tmp-expr nil) |
;;; (defvar erbn-calsmart-tmp-expr nil) |
249 |
;;; (defvar erbnoc-calsmart-tmp-exprb nil) |
;;; (defvar erbn-calsmart-tmp-exprb nil) |
250 |
;;; (defvar erbnoc-calsmart-tmp-exprc nil) |
;;; (defvar erbn-calsmart-tmp-exprc nil) |
251 |
;;; (defvar erbnoc-calsmart-tmp-error nil) |
;;; (defvar erbn-calsmart-tmp-error nil) |
252 |
|
|
253 |
;;; (defmacro fs-calsmart (&rest exprs) |
;;; (defmacro fs-calsmart (&rest exprs) |
254 |
;; "This will insert parenthesis appropriately, so you can type stuff |
;; "This will insert parenthesis appropriately, so you can type stuff |
261 |
;;; (t |
;;; (t |
262 |
;;; `(choose-with |
;;; `(choose-with |
263 |
;;; (let* ( |
;;; (let* ( |
264 |
;;; (erbnoc-calsmart-tmp-expr expr) |
;;; (erbn-calsmart-tmp-expr expr) |
265 |
;;; (erbnoc-calsmart-tmp-exprb |
;;; (erbn-calsmart-tmp-exprb |
266 |
;;; (erbnoc-calsmart-break-expr erbnoc-calsmart-tmp-expr)) |
;;; (erbn-calsmart-break-expr erbn-calsmart-tmp-expr)) |
267 |
;;; (erbnoc-calsmart-tmp-exprc |
;;; (erbn-calsmart-tmp-exprc |
268 |
;;; (choose (list erbnoc-calsmart-expr |
;;; (choose (list erbn-calsmart-expr |
269 |
;;; erbnoc-calsmart-tmp-exprb))) |
;;; erbn-calsmart-tmp-exprb))) |
270 |
;;; ) |
;;; ) |
271 |
;;; (cond |
;;; (cond |
272 |
;;; (erbnoc-calsmart-tmp-exprb |
;;; (erbn-calsmart-tmp-exprb |
273 |
;;; (condition-case erbnoc-calsmart-tmp-error |
;;; (condition-case erbn-calsmart-tmp-error |
274 |
;;; (eval erbnoc-calsmart-tmp-exprc) |
;;; (eval erbn-calsmart-tmp-exprc) |
275 |
;;; (error (choose-fail)))) |
;;; (error (choose-fail)))) |
276 |
;;; ;; couldn't break.. just do the normal thing. |
;;; ;; couldn't break.. just do the normal thing. |
277 |
;;; (t (eval erbnoc-calsmart-tmp-expr)))))))) |
;;; (t (eval erbn-calsmart-tmp-expr)))))))) |
278 |
|
|
279 |
|
|
280 |
;;; (defun erbnoc-calsmart-break-expr (expr) |
;;; (defun erbn-calsmart-break-expr (expr) |
281 |
;;; "Expr is a list, which we intend to break. WE prefer breaking such |
;;; "Expr is a list, which we intend to break. WE prefer breaking such |
282 |
;;; that the broken function gets 2 arguments. |
;;; that the broken function gets 2 arguments. |
283 |
;;; We want to rewrap everything by erbnoc-calsmart, so things get broken |
;;; We want to rewrap everything by erbn-calsmart, so things get broken |
284 |
;;; further.. |
;;; further.. |
285 |
|
|
286 |
|
|