/[slime]/slime/swank-lispworks.lisp
ViewVC logotype

Diff of /slime/swank-lispworks.lisp

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

revision 1.125 by heller, Wed Dec 31 11:25:03 2008 UTC revision 1.128 by heller, Sat Jan 10 12:25:16 2009 UTC
# Line 426  Return NIL if the symbol is unbound." Line 426  Return NIL if the symbol is unbound."
426             (signal-undefined-functions compiler::*unknown-functions*             (signal-undefined-functions compiler::*unknown-functions*
427                                         ,location))))))                                         ,location))))))
428    
429  (defimplementation swank-compile-file (filename load-p external-format)  (defimplementation swank-compile-file (input-file output-file
430    (with-swank-compilation-unit (filename)                                         load-p external-format)
431      (compile-file filename :load load-p    (with-swank-compilation-unit (input-file)
432        (compile-file input-file
433                      :output-file output-file
434                      :load load-p
435                    :external-format external-format)))                    :external-format external-format)))
436    
437  (defvar *within-call-with-compilation-hooks* nil  (defvar *within-call-with-compilation-hooks* nil
# Line 628  function names like \(SETF GET)." Line 631  function names like \(SETF GET)."
631                  nil)))                  nil)))
632             htab))             htab))
633    
634  (defimplementation swank-compile-string (string &key buffer position directory  (defimplementation swank-compile-string (string &key buffer position filename
635                                                  policy)                                           policy)
636    (declare (ignore directory policy))    (declare (ignore filename policy))
637    (assert buffer)    (assert buffer)
638    (assert position)    (assert position)
639    (let* ((location (list :emacs-buffer buffer position string))    (let* ((location (list :emacs-buffer buffer position string))
# Line 753  function names like \(SETF GET)." Line 756  function names like \(SETF GET)."
756          (t (funcall continuation))))          (t (funcall continuation))))
757    
758  (defimplementation spawn (fn &key name)  (defimplementation spawn (fn &key name)
759    (let ((mp:*process-initial-bindings*    (mp:process-run-function name () fn))
          (remove (find-package :cl)  
                  mp:*process-initial-bindings*  
                  :key (lambda (x) (symbol-package (car x))))))  
     (mp:process-run-function name () fn)))  
760    
761  (defvar *id-lock* (mp:make-lock))  (defvar *id-lock* (mp:make-lock))
762  (defvar *thread-id-counter* 0)  (defvar *thread-id-counter* 0)
# Line 835  function names like \(SETF GET)." Line 834  function names like \(SETF GET)."
834        (setf (mailbox.queue mbox)        (setf (mailbox.queue mbox)
835              (nconc (mailbox.queue mbox) (list message))))))              (nconc (mailbox.queue mbox) (list message))))))
836    
837    (defimplementation set-default-initial-binding (var form)
838      (setq mp:*process-initial-bindings*
839            (acons var `(eval (quote ,form))
840                   mp:*process-initial-bindings* )))
841    
842  ;;; Some intergration with the lispworks environment  ;;; Some intergration with the lispworks environment
843    
844  (defun swank-sym (name) (find-symbol (string name) :swank))  (defun swank-sym (name) (find-symbol (string name) :swank))

Legend:
Removed from v.1.125  
changed lines
  Added in v.1.128

  ViewVC Help
Powered by ViewVC 1.1.5