/[erbot]/erbot/erbc2.el
ViewVC logotype

Diff of /erbot/erbc2.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.21 by deego, Sat Jan 1 04:37:31 2005 UTC revision 1.22 by deego, Sat Jan 8 17:53:08 2005 UTC
# Line 1  Line 1 
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
# Line 54  Line 54 
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                
# Line 94  Line 94 
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)
# Line 105  Line 105 
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))
# Line 114  Line 114 
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)))
# Line 159  Line 159 
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))
# Line 208  Line 208 
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    
# Line 218  Line 218 
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)
# Line 234  Line 234 
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
# Line 261  Line 261 
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                        

Legend:
Removed from v.1.21  
changed lines
  Added in v.1.22

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26