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

Diff of /slime/swank.lisp

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

revision 1.172 by heller, Sun Apr 25 06:41:21 2004 UTC revision 1.173 by lgorrie, Mon Apr 26 13:20:13 2004 UTC
# Line 95  Line 95 
95    ;;    ;;
96    control-thread    control-thread
97    reader-thread    reader-thread
98      ;; The REPL thread loops receiving functions to apply.
99      ;; REPL expressions are sent to this thread for evaluation so that
100      ;; they always run in the same thread.
101      repl-thread
102    (read             (missing-arg) :type function)    (read             (missing-arg) :type function)
103    (send             (missing-arg) :type function)    (send             (missing-arg) :type function)
104    (serve-requests   (missing-arg) :type function)    (serve-requests   (missing-arg) :type function)
# Line 402  element." Line 406  element."
406          (*active-threads* '())          (*active-threads* '())
407          (*thread-counter* 0)          (*thread-counter* 0)
408          (*lookup-counter* 50))          (*lookup-counter* 50))
409      (loop (with-simple-restart (abort "Retstart dispatch loop.")      (loop (with-simple-restart (abort "Restart dispatch loop.")
410              (loop (dispatch-event (receive) socket-io))))))              (loop (dispatch-event (receive) socket-io))))))
411    
412  (defun simple-break ()  (defun simple-break ()
# Line 461  element." Line 465  element."
465                                                 connection))                                                 connection))
466                                    :name "reader-thread")))                                    :name "reader-thread")))
467          (setf (connection.reader-thread connection) reader-thread)          (setf (connection.reader-thread connection) reader-thread)
468            (setf (connection.repl-thread connection)
469                  (spawn (lambda () (repl-loop connection))))
470          connection))))          connection))))
471    
472    (defun repl-loop (connection)
473      (with-connection (connection)
474        (loop do (funcall (receive)))))
475    
476  (defun initialize-streams-for-connection (connection)  (defun initialize-streams-for-connection (connection)
477    (multiple-value-bind (dedicated in out io) (open-streams connection)    (multiple-value-bind (dedicated in out io) (open-streams connection)
478      (setf (connection.dedicated-output connection) dedicated      (setf (connection.dedicated-output connection) dedicated
# Line 1180  change, then send Emacs an update." Line 1190  change, then send Emacs an update."
1190      (list (package-name p) (shortest-package-nickname p))))      (list (package-name p) (shortest-package-nickname p))))
1191    
1192  (defslimefun listener-eval (string)  (defslimefun listener-eval (string)
1193      (if (connection.repl-thread *emacs-connection*)
1194          (repl-thread-eval string)
1195          (repl-eval string)))
1196    
1197    (defun repl-thread-eval (string)
1198      "Evaluate STRING using REPL-EVAL in the REPL thread."
1199      ;; XXX Perhaps we should somehow formalize the set of "important"
1200      ;; specials which are here being passed to the other thread? -luke (26/Apr/2004)
1201      (let ((self (current-thread))
1202            (connection *emacs-connection*)
1203            (package *package*)
1204            (buffer-package *buffer-package*))
1205        (send (connection.repl-thread connection)
1206              (lambda ()
1207                (with-connection (connection)
1208                  (let ((*buffer-package* buffer-package)
1209                        (*package* package))
1210                    (restart-case (send self (repl-eval string))
1211                      (abort ()
1212                        :report "Abort REPL evaluation"
1213                        (send self "; Aborted")))))))
1214        (receive)))
1215    
1216    (defun repl-eval (string)
1217    (clear-user-input)    (clear-user-input)
1218    (multiple-value-bind (values last-form) (eval-region string t)    (multiple-value-bind (values last-form) (eval-region string t)
1219      (setq +++ ++  ++ +  + last-form      (setq +++ ++  ++ +  + last-form
# Line 1198  WHAT can be: Line 1232  WHAT can be:
1232    A list (FILENAME LINE [COLUMN]),    A list (FILENAME LINE [COLUMN]),
1233    A function name (symbol),    A function name (symbol),
1234    nil."    nil."
1235    (if (and (listp what) (pathnamep (first what)))    (let ((target
1236        (setf (car what) (canonicalize-filename (car what))))           (cond ((and (listp what) (pathnamep (first what)))
1237    (send-oob-to-emacs `(:ed ,(if (pathnamep what)                  (cons (canonicalize-filename (car what)) (cdr what)))
1238                                  (canonicalize-filename what)                 ((pathnamep what)
1239                                  what))))                  (canonicalize-filename what))
1240                   (t what))))
1241        (send-oob-to-emacs `(:ed ,target))))
1242    
1243    
1244  ;;;; Compilation Commands.  ;;;; Compilation Commands.
1245    
# Line 2061  a time.") Line 2098  a time.")
2098  (defun lookup-thread-by-id (id)  (defun lookup-thread-by-id (id)
2099    (nth id *thread-list*))    (nth id *thread-list*))
2100    
2101  (defun debug-thread (thread-id)  (defslimefun debug-thread-by-id (thread-id)
2102    (let ((connection *emacs-connection*))    (let ((connection *emacs-connection*))
2103      (interrupt-thread (lookup-thread-by-id thread-id)      (interrupt-thread (lookup-thread-by-id thread-id)
2104                        (lambda ()                        (lambda ()
2105                          (with-connection (connection)                          (with-connection (connection)
2106                            (simple-break))))))                            (simple-break))))))
2107    
2108    (defslimefun start-swank-server-in-thread (id port-file-name)
2109      "Interrupt a thread by ID and make it start a swank server.
2110    The server port is written to PORT-FILE-NAME."
2111      (interrupt-thread (lookup-thread-by-id id)
2112                        (lambda ()
2113                          (start-server port-file-name nil))))
2114    
2115    (defslimefun kill-thread-by-id (id)
2116      (kill-thread (lookup-thread-by-id id)))
2117    
2118  ;;; Local Variables:  ;;; Local Variables:
2119  ;;; eval: (font-lock-add-keywords 'lisp-mode '(("(\\(defslimefun\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)"  (1 font-lock-keyword-face) (2 font-lock-function-name-face))))  ;;; eval: (font-lock-add-keywords 'lisp-mode '(("(\\(defslimefun\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)"  (1 font-lock-keyword-face) (2 font-lock-function-name-face))))
2120  ;;; End:  ;;; End:

Legend:
Removed from v.1.172  
changed lines
  Added in v.1.173

  ViewVC Help
Powered by ViewVC 1.1.5