Changeset 21516 in project


Ignore:
Timestamp:
11/17/10 21:18:08 (9 years ago)
Author:
Moritz Heidkamp
Message:

vandusen: replace environments with sandbox in vandusen-eval (thanks Mario Goulart for the suggestion)

Location:
release/4/vandusen/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/vandusen/trunk/vandusen-eval.scm

    r18423 r21516  
    22
    33(import chicken scheme extras ports data-structures)
    4 (use vandusen environments srfi-18)
     4(use vandusen sandbox srfi-18)
    55
    66(plugin 'eval
    77        (lambda ()
    8           (let ((env (environment-copy (scheme-report-environment 5) #t)))
    9             (define (reply-with-eval-result m expression)
    10               (condition-case (reply-to m (format "~S" (eval (with-input-from-string expression read) env)))
    11                               (e () (reply-to m (format "Error: ~A~A"
    12                                                         (get-condition-property e 'exn 'message)
    13                                                         (let ((args (get-condition-property e 'exn 'arguments)))
    14                                                           (if (null? args)
    15                                                               ""
    16                                                               (apply conc (cons ": " args)))))))))
     8          (define (reply-with-eval-result m expression)
     9            (condition-case (reply-to m (format "~S" (safe-eval (with-input-from-string expression read))))
     10                (e () (reply-to m (format "Error: ~A~A"
     11                                          (get-condition-property e 'exn 'message)
     12                                          (let ((args (get-condition-property e 'exn 'arguments)))
     13                                            (if (null? args)
     14                                                ""
     15                                                (apply conc (cons ": " args)))))))))
    1716
    18             (command 'eval
    19                      '(: "eval" (+ whitespace) (submatch (+ any)))
    20                      (lambda (m expression)
    21                        (thread-start! (lambda ()
    22                                         (let ((thread (thread-start! (cut reply-with-eval-result m expression))))
    23                                           (thread-sleep! 3)
    24                                           (thread-terminate! thread))))))))))
     17          (command 'eval
     18                   '(: "eval" (+ whitespace) (submatch (+ any)))
     19                   (lambda (m expression)
     20                     (thread-start! (lambda ()
     21                                      (let ((thread (thread-start! (cut reply-with-eval-result m expression))))
     22                                        (thread-sleep! 3)
     23                                        (thread-terminate! thread)))))))))
    2524
  • release/4/vandusen/trunk/vandusen.meta

    r21508 r21516  
    44 (category net)
    55 (license "BSD")
    6  (needs irc chicken-doc environments uri-common sql-de-lite))
     6 (needs irc chicken-doc sandbox uri-common sql-de-lite))
Note: See TracChangeset for help on using the changeset viewer.