From aruttenberg at common-lisp.net Tue Jan 3 03:58:44 2006 From: aruttenberg at common-lisp.net (Alan Ruttenberg) Date: Tue, 3 Jan 2006 04:58:44 +0100 (CET) Subject: [slime-cvs] CVS update: slime/ChangeLog slime/swank-abcl.lisp Message-ID: <20060103035844.5B1AD88446@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv23123/slime Modified Files: ChangeLog swank-abcl.lisp Log Message: 2005-12-27 Alan Ruttenberg * swank-abcl. (backtrace-as-list-ignoring-swank-calls): remove the swank calls from the backtrace to make it easier to use. (frame-locals): Fix a typo that caused entry into the debugger if you tried to look at frame locals. Now you don't error out, but you still don't see frame locals because I don't know how to get them :( Date: Tue Jan 3 04:58:43 2006 Author: aruttenberg Index: slime/ChangeLog diff -u slime/ChangeLog:1.826 slime/ChangeLog:1.827 --- slime/ChangeLog:1.826 Sat Dec 31 16:08:22 2005 +++ slime/ChangeLog Tue Jan 3 04:58:39 2006 @@ -1,3 +1,11 @@ +2005-12-27 Alan Ruttenberg + + * swank-abcl. (backtrace-as-list-ignoring-swank-calls): remove the + swank calls from the backtrace to make it easier to use. + (frame-locals): Fix a typo that caused entry into the debugger if you tried to + look at frame locals. Now you don't error out, but you still don't see frame locals + because I don't know how to get them :( + 2005-12-31 Harald Hanche-Olsen * slime.el (slime-open-stream-to-lisp): Inherit the Index: slime/swank-abcl.lisp diff -u slime/swank-abcl.lisp:1.30 slime/swank-abcl.lisp:1.31 --- slime/swank-abcl.lisp:1.30 Sun Nov 13 18:27:40 2005 +++ slime/swank-abcl.lisp Tue Jan 3 04:58:39 2006 @@ -17,7 +17,7 @@ (defun sys::break (&optional (format-control "BREAK called") &rest format-arguments) - (let ((*saved-backtrace* (sys::backtrace-as-list))) + (let ((*saved-backtrace* (backtrace-as-list-ignoring-swank-calls))) (with-simple-restart (continue "Return from BREAK.") (invoke-debugger (sys::%make-condition 'simple-condition @@ -25,7 +25,6 @@ :format-arguments format-arguments)))) nil)) - (defimplementation make-fn-streams (input-fn output-fn) (let* ((output (ext:make-slime-output-stream output-fn)) (input (ext:make-slime-input-stream input-fn output))) @@ -191,16 +190,20 @@ (defvar *sldb-topframe*) +(defun backtrace-as-list-ignoring-swank-calls () + (let ((list (ext:backtrace-as-list))) + (subseq list (1+ (or (position 'swank::swank-debugger-hook list :key 'car) -1))))) + (defimplementation call-with-debugging-environment (debugger-loop-fn) - (let ((*sldb-topframe* (car (ext:backtrace-as-list)) #+nil (excl::int-newest-frame))) + (let ((*sldb-topframe* (car (backtrace-as-list-ignoring-swank-calls)) #+nil (excl::int-newest-frame))) (funcall debugger-loop-fn))) (defun nth-frame (index) - (nth index (ext:backtrace-as-list))) + (nth index (backtrace-as-list-ignoring-swank-calls))) (defimplementation compute-backtrace (start end) (let ((end (or end most-positive-fixnum))) - (subseq (ext:backtrace-as-list) start end))) + (subseq (backtrace-as-list-ignoring-swank-calls) start end))) (defimplementation print-frame (frame stream) (write-string (string-trim '(#\space #\newline) @@ -208,7 +211,7 @@ stream)) (defimplementation frame-locals (index) - `((list :name "??" :id 0 :value "??"))) + `(,(list :name "??" :id 0 :value "??"))) (defimplementation frame-catch-tags (index) From aruttenberg at common-lisp.net Tue Jan 3 04:05:52 2006 From: aruttenberg at common-lisp.net (Alan Ruttenberg) Date: Tue, 3 Jan 2006 05:05:52 +0100 (CET) Subject: [slime-cvs] CVS update: slime/swank-abcl.lisp Message-ID: <20060103040552.D0A2F88446@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv24240/slime Modified Files: swank-abcl.lisp Log Message: Date: Tue Jan 3 05:05:52 2006 Author: aruttenberg Index: slime/swank-abcl.lisp diff -u slime/swank-abcl.lisp:1.31 slime/swank-abcl.lisp:1.32 --- slime/swank-abcl.lisp:1.31 Tue Jan 3 04:58:39 2006 +++ slime/swank-abcl.lisp Tue Jan 3 05:05:52 2006 @@ -192,7 +192,7 @@ (defun backtrace-as-list-ignoring-swank-calls () (let ((list (ext:backtrace-as-list))) - (subseq list (1+ (or (position 'swank::swank-debugger-hook list :key 'car) -1))))) + (subseq list (1+ (or (position '(intern SWANK-DEBUGGER-HOOK 'swank) list :key 'car) -1))))) (defimplementation call-with-debugging-environment (debugger-loop-fn) (let ((*sldb-topframe* (car (backtrace-as-list-ignoring-swank-calls)) #+nil (excl::int-newest-frame))) From aruttenberg at common-lisp.net Tue Jan 3 04:46:52 2006 From: aruttenberg at common-lisp.net (Alan Ruttenberg) Date: Tue, 3 Jan 2006 05:46:52 +0100 (CET) Subject: [slime-cvs] CVS update: slime/swank-abcl.lisp Message-ID: <20060103044652.BDD0F88446@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp.net:/tmp/cvs-serv27415/slime Modified Files: swank-abcl.lisp Log Message: Date: Tue Jan 3 05:46:52 2006 Author: aruttenberg Index: slime/swank-abcl.lisp diff -u slime/swank-abcl.lisp:1.32 slime/swank-abcl.lisp:1.33 --- slime/swank-abcl.lisp:1.32 Tue Jan 3 05:05:52 2006 +++ slime/swank-abcl.lisp Tue Jan 3 05:46:52 2006 @@ -192,7 +192,7 @@ (defun backtrace-as-list-ignoring-swank-calls () (let ((list (ext:backtrace-as-list))) - (subseq list (1+ (or (position '(intern SWANK-DEBUGGER-HOOK 'swank) list :key 'car) -1))))) + (subseq list (1+ (or (position (intern "SWANK-DEBUGGER-HOOK" 'swank) list :key 'car) -1))))) (defimplementation call-with-debugging-environment (debugger-loop-fn) (let ((*sldb-topframe* (car (backtrace-as-list-ignoring-swank-calls)) #+nil (excl::int-newest-frame))) From heller at common-lisp.net Tue Jan 17 20:26:08 2006 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 17 Jan 2006 14:26:08 -0600 (CST) Subject: [slime-cvs] CVS update: slime/slime.el Message-ID: <20060117202608.170C62A024@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp:/tmp/cvs-serv21113 Modified Files: slime.el Log Message: (slime-compile-defun): If point was at the opening paren we wrongly used the preceding toplevel form. Fix it. Reported by Chisheng Huang and Liam M. Healy. (slime-selector ?r): Call slime instead of slime-start to pick up the usual defaults. (slime-init-command): Updated for the new loader. Date: Tue Jan 17 14:26:07 2006 Author: heller Index: slime/slime.el diff -u slime/slime.el:1.575 slime/slime.el:1.576 --- slime/slime.el:1.575 Sat Dec 31 09:06:09 2005 +++ slime/slime.el Tue Jan 17 14:26:07 2006 @@ -1,8 +1,8 @@ -;; slime.el -- Superior Lisp Interaction Mode for Emacs +;;; slime.el -- Superior Lisp Interaction Mode for Emacs ;; ;;;; License ;; Copyright (C) 2003 Eric Marsden, Luke Gorrie, Helmut Eller -;; Copyright (C) 2004,2005 Luke Gorrie, Helmut Eller +;; Copyright (C) 2004,2005,2006 Luke Gorrie, Helmut Eller ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as @@ -1238,8 +1238,8 @@ (defvar slime-inferior-lisp-program-history '() "History list of command strings. Used by `slime'.") -;; XXX: inferior-lisp-program isn't preloaded in XEmacs. maybe we -;; should use something else. +;; We no longer load inf-lisp, but we use this variable for backward +;; compatibility. (defvar inferior-lisp-program "lisp" "*Program name for invoking an inferior Lisp with for Inferior Lisp mode.") @@ -1284,8 +1284,9 @@ (slime-lookup-lisp-implementation table (intern key)))) (t (destructuring-bind (program &rest program-args) - (split-string (read-string "Run lisp: " inferior-lisp-program - 'slime-inferior-lisp-program-history)) + (split-string (read-string + "Run lisp: " inferior-lisp-program + 'slime-inferior-lisp-program-history)) (let ((coding-system (if (eq 16 (prefix-numeric-value current-prefix-arg)) (read-coding-system "set slime-coding-system: " @@ -1480,17 +1481,18 @@ (with-current-buffer (process-buffer process) slime-inferior-lisp-args)) - -;;; XXX load-server & start-server used to separated. maybe that was better. +;; XXX load-server & start-server used to separated. maybe that was better. (defun slime-init-command (port-filename coding-system) "Return a string to initialize Lisp." - (let ((swank (slime-to-lisp-filename (if (file-name-absolute-p slime-backend) - slime-backend - (concat slime-path slime-backend)))) + (let ((loader + (slime-to-lisp-filename (if (file-name-absolute-p slime-backend) + slime-backend + (concat slime-path slime-backend)))) (encoding (slime-coding-system-cl-name coding-system)) (filename (slime-to-lisp-filename port-filename))) - (format "%S\n%S\n\n" - `(load ,swank :verbose t) + (format "%S\n%S\n%S\n\n" + `(load ,loader :verbose t) + `(swank-loader:load-swank) `(swank:start-server ,filename :external-format ,encoding)))) (defun slime-swank-port-file () @@ -1531,7 +1533,7 @@ (t (when retries (decf retries)) (setq slime-connect-retry-timer - (run-with-timer 1 nil #'attempt-connection)))))) + (run-with-timer 1.0 nil #'attempt-connection)))))) (attempt-connection)))) (defun slime-read-swank-port () @@ -2138,7 +2140,9 @@ (defun slime-background-activities-enabled-p () (and (or slime-mode (eq major-mode 'slime-repl-mode)) - (slime-current-connection) + (let ((con (slime-current-connection))) + (and con + (eq (process-status con) 'open))) (or (not (slime-busy-p)) (not slime-inhibit-pipelining)))) @@ -4264,12 +4268,7 @@ (defun slime-compile-defun () "Compile the current toplevel form." (interactive) - (destructuring-bind (start end) - (save-excursion - (beginning-of-defun) - (list (point) - (progn (end-of-defun) (point)))) - (slime-compile-region start end))) + (apply #'slime-compile-region (slime-region-for-defun-at-point))) (defun slime-compile-region (start end) "Compile the region." @@ -8573,7 +8572,7 @@ (cond ((slime-current-connection) (slime-output-buffer)) ((y-or-n-p "No connection: start Slime? ") - (slime-start)))) + (slime)))) (def-slime-selector-method ?s "*slime-scratch* buffer." @@ -9336,8 +9335,9 @@ (slime-check-top-level) (slime-eval-async '(cl:loop :for i :from 0 :do (cl:progn (cl:print i) (cl:finish-output))) - (lambda (_) ) "CL-USER") - (slime-wait-condition "running" #'slime-busy-p 5) + (lambda (_) ) + "CL-USER") + (sleep-for 1) (slime-interrupt) (slime-wait-condition "Debugger visible" (lambda () @@ -9513,7 +9513,8 @@ ???????????????????????????? SWANK> " t)) (when (and (fboundp 'string-to-multibyte) - default-enable-multibyte-characters) + (with-current-buffer (process-buffer (slime-connection)) + enable-multibyte-characters)) (setq input (funcall 'string-to-multibyte input)) (setq result-contents (funcall 'string-to-multibyte result-contents))) (with-current-buffer (slime-output-buffer) @@ -9528,9 +9529,6 @@ visiblep (not (not (get-buffer-window (current-buffer))))))) -;; XXX this test should fail with :fd-handler style because -;; (sldb-quit) doesn't find the abort-request restart, but for some -;; reason it succeeds. (def-slime-test break () "Test if BREAK invokes SLDB." @@ -9551,6 +9549,21 @@ (sldb-quit)) (accept-process-output nil 1) (slime-sync-to-top-level 5)) + +(def-slime-test user-interrupt + () + "Let's see what happens if we send a user interrupt at toplevel." + '(()) + (slime-check-top-level) + (slime-interrupt) + (slime-wait-condition "Debugger visible" + (lambda () + (and (slime-sldb-level= 1) + (get-buffer-window (sldb-get-default-buffer)))) + 5) + (with-current-buffer (sldb-get-default-buffer) + (sldb-quit)) + (slime-sync-to-top-level 5)) ;;;; Utilities @@ -9601,11 +9614,16 @@ (defun slime-defun-at-point () "Return the text of the defun at point." + (apply #'buffer-substring-no-properties + (slime-region-for-defun-at-point))) + +(defun slime-region-for-defun-at-point () + "Return the start and end position of the toplevel form at point." (save-excursion (end-of-defun) (let ((end (point))) (beginning-of-defun) - (buffer-substring-no-properties (point) end)))) + (list (point) end)))) (defun slime-beginning-of-symbol () "Move point to the beginning of the current symbol." From heller at common-lisp.net Tue Jan 17 20:28:57 2006 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 17 Jan 2006 14:28:57 -0600 (CST) Subject: [slime-cvs] CVS update: slime/swank.lisp Message-ID: <20060117202857.4822737765@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp:/tmp/cvs-serv21202 Modified Files: swank.lisp Log Message: (spawn-threads-for-connection): Fix a race condition: Don't accept input before all threads are ready. (throw-to-toplevel): No longer invoke the 'abort restart if the 'abort-request isn't available. Date: Tue Jan 17 14:28:57 2006 Author: heller Index: slime/swank.lisp diff -u slime/swank.lisp:1.356 slime/swank.lisp:1.357 --- slime/swank.lisp:1.356 Tue Dec 27 09:12:22 2005 +++ slime/swank.lisp Tue Jan 17 14:28:57 2006 @@ -283,8 +283,7 @@ (defun call-with-connection (connection fun) (let ((*emacs-connection* connection)) (with-io-redirection (*emacs-connection*) - (let ((*debugger-hook* #'swank-debugger-hook)) - (funcall fun))))) + (call-with-debugger-hook #'swank-debugger-hook fun)))) (defmacro without-interrupts (&body body) `(call-without-interrupts (lambda () , at body))) @@ -333,7 +332,7 @@ Useful for low level debugging." (when *enable-event-history* (setf (aref *event-history* *event-history-index*) - (apply #'format nil format-string args)) + (format nil "~?" format-string args)) (setf *event-history-index* (mod (1+ *event-history-index*) (length *event-history*)))) (when *log-events* @@ -531,8 +530,7 @@ "Read and process one request. The processing is done in the extend of the toplevel restart." (assert (null *swank-state-stack*)) - (let ((*swank-state-stack* '(:handle-request)) - (*debugger-hook* nil)) + (let ((*swank-state-stack* '(:handle-request))) (with-connection (connection) (with-simple-restart (abort-request "Abort handling SLIME request.") (read-from-emacs))))) @@ -572,10 +570,12 @@ (defslimefun simple-break () (with-simple-restart (continue "Continue from interrupt.") - (let ((*debugger-hook* #'swank-debugger-hook)) - (invoke-debugger - (make-condition 'simple-error - :format-control "Interrupt from Emacs")))) + (call-with-debugger-hook + #'swank-debugger-hook + (lambda () + (invoke-debugger + (make-condition 'simple-error + :format-control "Interrupt from Emacs"))))) nil) ;;;;;; Thread based communication @@ -595,11 +595,14 @@ (defun repl-thread (connection) (let ((thread (connection.repl-thread connection))) - (if (thread-alive-p thread) - thread - (setf (connection.repl-thread connection) - (spawn-repl-thread connection "new-repl-thread"))))) - + (when (not thread) + (log-event "ERROR: repl-thread is nil")) + (assert thread) + (cond ((thread-alive-p thread) + thread) + (t + (setf (connection.repl-thread connection) + (spawn-repl-thread connection "new-repl-thread")))))) (defun find-worker-thread (id) (etypecase id @@ -676,28 +679,35 @@ (encode-message event socket-io)))) (defun spawn-threads-for-connection (connection) - (let* ((socket-io (connection.socket-io connection)) - (control-thread (spawn (lambda () - (let ((*debugger-hook* nil)) - (dispatch-loop socket-io connection))) - :name "control-thread"))) - (setf (connection.control-thread connection) control-thread) - (let ((reader-thread (spawn (lambda () - (let ((*debugger-hook* nil)) - (read-loop control-thread socket-io - connection))) - :name "reader-thread")) - (repl-thread (spawn-repl-thread connection "repl-thread"))) - (setf (connection.reader-thread connection) reader-thread) - (setf (connection.repl-thread connection) repl-thread) - connection))) + (macrolet ((without-debugger-hook (&body body) + `(call-with-debugger-hook nil (lambda () , at body)))) + (let* ((socket-io (connection.socket-io connection)) + (control-thread (spawn (lambda () + (without-debugger-hook + (dispatch-loop socket-io connection))) + :name "control-thread"))) + (setf (connection.control-thread connection) control-thread) + (let ((reader-thread (spawn (lambda () + (let ((go (receive))) + (assert (eq go 'accept-input))) + (without-debugger-hook + (read-loop control-thread socket-io + connection))) + :name "reader-thread")) + (repl-thread (spawn-repl-thread connection "repl-thread"))) + (setf (connection.repl-thread connection) repl-thread) + (setf (connection.reader-thread connection) reader-thread) + (send reader-thread 'accept-input) + connection)))) (defun cleanup-connection-threads (connection) (let ((threads (list (connection.repl-thread connection) (connection.reader-thread connection) (connection.control-thread connection)))) (dolist (thread threads) - (unless (equal (current-thread) thread) + (when (and thread + (thread-alive-p thread) + (not (equal (current-thread) thread))) (kill-thread thread))))) (defun repl-loop (connection) @@ -736,15 +746,17 @@ (process-available-input client (lambda () (handle-request connection))))) ((eq (car *swank-state-stack*) :read-next-form)) - (t (process-available-input client #'read-from-emacs))))) - (setq *debugger-hook* - (lambda (c h) - (with-reader-error-handler (connection) - (block debugger - (with-connection (connection) - (swank-debugger-hook c h) - (return-from debugger)) - (abort))))) + (t + (process-available-input client #'read-from-emacs))))) + ;; handle sigint + (install-debugger-globally + (lambda (c h) + (with-reader-error-handler (connection) + (block debugger + (with-connection (connection) + (swank-debugger-hook c h) + (return-from debugger)) + (abort))))) (add-fd-handler client #'handler) (handler)))) @@ -755,11 +767,19 @@ (defun simple-serve-requests (connection) (with-reader-error-handler (connection) - (unwind-protect (loop (with-simple-restart - (abort "Return to SLIME top-level.") - (handle-request connection))) + (unwind-protect + (loop + (with-connection (connection) + (with-simple-restart (abort-request "") + (do () + ((wait-until-readable (connection.socket-io connection)))))) + (handle-request connection)) (close-connection connection)))) +(defun wait-until-readable (stream) + (unread-char (read-char stream) stream) + t) + (defun read-from-socket-io () (let ((event (decode-message (current-socket-io)))) (log-event "DISPATCHING: ~S~%" event) @@ -1051,7 +1071,7 @@ (format stream "~6,'0x" length)) (write-string string stream) ;;(terpri stream) - (force-output stream))) + (finish-output stream))) (defun prin1-to-string-for-emacs (object) (with-standard-io-syntax @@ -1815,7 +1835,7 @@ "Save OBJECT and return the assigned id. If OBJECT was saved previously return the old id." (or (gethash object *object-to-presentation-id*) - (let ((id (decf *presentation-counter*))) + (let ((id (incf *presentation-counter*))) (setf (gethash id *presentation-id-to-object*) object) (setf (gethash object *object-to-presentation-id*) id) id))) @@ -2284,11 +2304,7 @@ If we are not evaluating an RPC then ABORT instead." (let ((restart (find-restart 'abort-request))) (cond (restart (invoke-restart restart)) - (t - ;; If we get here then there was no catch. Try aborting as - ;; a fallback. That makes the 'q' command in SLDB safer to - ;; use with threads. - (abort))))) + (t "Restart not found: ABORT-REQUEST")))) (defslimefun invoke-nth-restart-for-emacs (sldb-level n) "Invoke the Nth available restart. From heller at common-lisp.net Tue Jan 17 20:29:58 2006 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 17 Jan 2006 14:29:58 -0600 (CST) Subject: [slime-cvs] CVS update: slime/swank-loader.lisp Message-ID: <20060117202958.64B04967E@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp:/tmp/cvs-serv21242 Modified Files: swank-loader.lisp Log Message: (load-swank): New entry point. Date: Tue Jan 17 14:29:58 2006 Author: heller Index: slime/swank-loader.lisp diff -u slime/swank-loader.lisp:1.53 slime/swank-loader.lisp:1.54 --- slime/swank-loader.lisp:1.53 Fri Oct 14 13:11:16 2005 +++ slime/swank-loader.lisp Tue Jan 17 14:29:58 2006 @@ -9,35 +9,26 @@ ;;; (cl:defpackage :swank-loader - (:use :cl)) + (:use :cl) + (:export :load-swank)) (cl:in-package :swank-loader) -(defun make-swank-pathname (name &optional (type "lisp")) - "Return a pathname with name component NAME in the Slime directory." - (merge-pathnames (make-pathname :name name :type type) - (or *compile-file-pathname* - *load-pathname* - *default-pathname-defaults*))) - -(defparameter *sysdep-pathnames* - (mapcar #'make-swank-pathname - (append - '("nregex") - #+cmu '("swank-source-path-parser" "swank-source-file-cache" - "swank-cmucl") - #+scl '("swank-source-path-parser" "swank-source-file-cache" - "swank-scl") - #+sbcl '("swank-sbcl" "swank-source-path-parser" - "swank-source-file-cache" "swank-gray") - #+openmcl '("metering" "swank-openmcl" "swank-gray") - #+lispworks '("swank-lispworks" "swank-gray") - #+allegro '("swank-allegro" "swank-gray") - #+clisp '("xref" "metering" "swank-clisp" "swank-gray") - #+armedbear '("swank-abcl") - #+cormanlisp '("swank-corman" "swank-gray") - #+ecl '("swank-ecl" "swank-gray") - ))) +(defparameter *sysdep-files* + (append + '("nregex") + #+cmu '("swank-source-path-parser" "swank-source-file-cache" "swank-cmucl") + #+scl '("swank-source-path-parser" "swank-source-file-cache" "swank-scl") + #+sbcl '("swank-sbcl" "swank-source-path-parser" + "swank-source-file-cache" "swank-gray") + #+openmcl '("metering" "swank-openmcl" "swank-gray") + #+lispworks '("swank-lispworks" "swank-gray") + #+allegro '("swank-allegro" "swank-gray") + #+clisp '("xref" "metering" "swank-clisp" "swank-gray") + #+armedbear '("swank-abcl") + #+cormanlisp '("swank-corman" "swank-gray") + #+ecl '("swank-ecl" "swank-gray") + )) (defparameter *implementation-features* '(:allegro :lispworks :sbcl :openmcl :cmu :clisp :ccl :corman :cormanlisp @@ -91,30 +82,33 @@ implementation version."))) (format nil "~(~@{~a~^-~}~)" lisp version os arch)))) -(defparameter *swank-pathname* (make-swank-pathname "swank")) - (defun file-newer-p (new-file old-file) "Returns true if NEW-FILE is newer than OLD-FILE." (> (file-write-date new-file) (file-write-date old-file))) -(defun binary-pathname (source-pathname) +(defun default-fasl-directory () + (merge-pathnames + (make-pathname + :directory `(:relative ".slime" "fasl" ,(unique-directory-name))) + (user-homedir-pathname))) + +(defun binary-pathname (source-pathname binary-directory) "Return the pathname where SOURCE-PATHNAME's binary should be compiled." (let ((cfp (compile-file-pathname source-pathname))) - (merge-pathnames (make-pathname - :directory - `(:relative ".slime" "fasl" ,(unique-directory-name)) - :name (pathname-name cfp) - :type (pathname-type cfp)) - (user-homedir-pathname)))) + (merge-pathnames (make-pathname :name (pathname-name cfp) + :type (pathname-type cfp)) + binary-directory))) + -(defun compile-files-if-needed-serially (files) +(defun compile-files-if-needed-serially (files fasl-directory) "Compile each file in FILES if the source is newer than its corresponding binary, or the file preceding it was recompiled." (with-compilation-unit () (let ((needs-recompile nil)) (dolist (source-pathname files) - (let ((binary-pathname (binary-pathname source-pathname))) + (let ((binary-pathname (binary-pathname source-pathname + fasl-directory))) (handler-case (progn (when (or needs-recompile @@ -133,8 +127,9 @@ )))))) #+(or cormanlisp ecl) -(defun compile-files-if-needed-serially (files) +(defun compile-files-if-needed-serially (files fasl-directory) "Corman Lisp and ECL have trouble with compiled files." + (declare (ignore fasl-directory)) (dolist (file files) (load file :verbose t) (force-output))) @@ -145,17 +140,24 @@ (make-pathname :name ".swank" :type "lisp")) :if-does-not-exist nil)) -(defun load-site-init-file () +(defun load-site-init-file (directory) (load (make-pathname :name "site-init" :type "lisp" - :defaults *load-truename*) + :defaults directory) :if-does-not-exist nil)) -(compile-files-if-needed-serially - (append (list (make-swank-pathname "swank-backend")) - *sysdep-pathnames* - (list *swank-pathname*))) - -(funcall (intern (string :warn-unimplemented-interfaces) :swank-backend)) - -(load-site-init-file) -(load-user-init-file) +(defun swank-source-files (source-directory) + (mapcar (lambda (name) + (merge-pathnames (make-pathname :name name :type "lisp") + source-directory)) + `("swank-backend" ,@*sysdep-files* "swank"))) + +(defun load-swank (&key + (fasl-directory (default-fasl-directory)) + (source-directory #.(or *compile-file-pathname* + *load-pathname* + *default-pathname-defaults*))) + (compile-files-if-needed-serially (swank-source-files source-directory) + fasl-directory) + (funcall (intern (string :warn-unimplemented-interfaces) :swank-backend)) + (load-site-init-file source-directory) + (load-user-init-file)) From heller at common-lisp.net Tue Jan 17 20:34:19 2006 From: heller at common-lisp.net (Helmut Eller) Date: Tue, 17 Jan 2006 14:34:19 -0600 (CST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20060117203419.D330F2001C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp:/tmp/cvs-serv22460 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Tue Jan 17 14:34:19 2006 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.827 slime/ChangeLog:1.828 --- slime/ChangeLog:1.827 Mon Jan 2 21:58:39 2006 +++ slime/ChangeLog Tue Jan 17 14:34:19 2006 @@ -1,16 +1,36 @@ -2005-12-27 Alan Ruttenberg +2006-01-14 Helmut Eller - * swank-abcl. (backtrace-as-list-ignoring-swank-calls): remove the - swank calls from the backtrace to make it easier to use. - (frame-locals): Fix a typo that caused entry into the debugger if you tried to - look at frame locals. Now you don't error out, but you still don't see frame locals - because I don't know how to get them :( + * slime.el (slime-compile-defun): If point was at the opening + paren we wrongly used the preceding toplevel form. Fix it. + Reported by Chisheng Huang and Liam M. Healy. + + * swank.lisp (spawn-threads-for-connection): Fix a race condition: + Don't accept input before all threads are ready. + + Make the fasl directory customizable: load-swank must now be + called explicitly so that we can supply the fasl dir as argument. + + * swank-loader.lisp (load-swank): New entry point. + +2006-01-14 Andreas Fuchs + + * slime.el (slime-selector ?r): Call slime instead of slime-start + to pick up the usual defaults. 2005-12-31 Harald Hanche-Olsen * slime.el (slime-open-stream-to-lisp): Inherit the process-coding-system from the current connection. +2005-12-27 Alan Ruttenberg + + * swank-abcl. (backtrace-as-list-ignoring-swank-calls): remove the + swank calls from the backtrace to make it easier to use. + (frame-locals): Fix a typo that caused entry into the debugger if + you tried to look at frame locals. Now you don't error out, but + you still don't see frame locals because I don't know how to get + them :( + 2005-12-27 Helmut Eller Keep a history of protocol events for better bug reports. From heller at common-lisp.net Thu Jan 19 22:56:19 2006 From: heller at common-lisp.net (Helmut Eller) Date: Thu, 19 Jan 2006 16:56:19 -0600 (CST) Subject: [slime-cvs] CVS update: slime/ChangeLog slime/swank-loader.lisp slime/slime.el Message-ID: <20060119225619.C0007239D4@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp:/tmp/cvs-serv3035 Modified Files: ChangeLog swank-loader.lisp slime.el Log Message: Return to the previous loading strategy: load everything when swank-loader is loaded. It's just to convenient to give that up. To customize the fasl directories, the new variable swank-loader:*fasl-directory* can be set before loading swank-loader. * swank-loader.lisp (*fasl-directory*, *source-directory*): New variables. (load-swank): Call it during loading. Date: Thu Jan 19 16:56:19 2006 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.828 slime/ChangeLog:1.829 --- slime/ChangeLog:1.828 Tue Jan 17 14:34:19 2006 +++ slime/ChangeLog Thu Jan 19 16:56:16 2006 @@ -1,3 +1,15 @@ +2006-01-19 Helmut Eller + + Return to the previous loading strategy: load everything when + swank-loader is loaded. It's just to convenient to give that up. + To customize the fasl directories, the new variable + swank-loader:*fasl-directory* can be set before loading + swank-loader. + + * swank-loader.lisp (*fasl-directory*, *source-directory*): New + variables. + (load-swank): Call it during loading. + 2006-01-14 Helmut Eller * slime.el (slime-compile-defun): If point was at the opening Index: slime/swank-loader.lisp diff -u slime/swank-loader.lisp:1.54 slime/swank-loader.lisp:1.55 --- slime/swank-loader.lisp:1.54 Tue Jan 17 14:29:58 2006 +++ slime/swank-loader.lisp Thu Jan 19 16:56:16 2006 @@ -8,9 +8,22 @@ ;;; are disclaimed. ;;; +;; If you want customize the source- or fasl-directory you can set +;; swank-loader:*source-directory* resp. swank-loader:*fasl-directory* +;; before loading this files. (you also need to create the +;; swank-loader package.) +;; E.g.: +;; +;; (make-package :swank-laoder) +;; (defparameter swank-loader::*fasl-directory* "/tmp/fasl/") +;; (load ".../swank-loader.lisp") + + (cl:defpackage :swank-loader (:use :cl) - (:export :load-swank)) + (:export :load-swank + :*source-directory* + :*fasl-directory*)) (cl:in-package :swank-loader) @@ -151,13 +164,20 @@ source-directory)) `("swank-backend" ,@*sysdep-files* "swank"))) +(defvar *source-directory* (or *load-pathname* + *default-pathname-defaults*) + "The directory where to look for the source.") + +(defvar *fasl-directory* (default-fasl-directory) + "The directory where fasl files should be placed.") + (defun load-swank (&key - (fasl-directory (default-fasl-directory)) - (source-directory #.(or *compile-file-pathname* - *load-pathname* - *default-pathname-defaults*))) + (source-directory *source-directory*) + (fasl-directory *fasl-directory*)) (compile-files-if-needed-serially (swank-source-files source-directory) fasl-directory) (funcall (intern (string :warn-unimplemented-interfaces) :swank-backend)) (load-site-init-file source-directory) (load-user-init-file)) + +(load-swank) \ No newline at end of file Index: slime/slime.el diff -u slime/slime.el:1.576 slime/slime.el:1.577 --- slime/slime.el:1.576 Tue Jan 17 14:26:07 2006 +++ slime/slime.el Thu Jan 19 16:56:18 2006 @@ -1490,9 +1490,8 @@ (concat slime-path slime-backend)))) (encoding (slime-coding-system-cl-name coding-system)) (filename (slime-to-lisp-filename port-filename))) - (format "%S\n%S\n%S\n\n" + (format "%S\n%S\n\n" `(load ,loader :verbose t) - `(swank-loader:load-swank) `(swank:start-server ,filename :external-format ,encoding)))) (defun slime-swank-port-file () @@ -2270,7 +2269,7 @@ (let ((pkg (ignore-errors (read (current-buffer))))) (if pkg (format "%S" pkg))))))) -;;; Synchronous requests is implemented in terms of asynchronous +;;; Synchronous requests are implemented in terms of asynchronous ;;; ones. We make an asynchronous request with a continuation function ;;; that `throw's its result up to a `catch' and then enter a loop of ;;; handling I/O until that happens. From heller at common-lisp.net Fri Jan 20 21:31:20 2006 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 20 Jan 2006 15:31:20 -0600 (CST) Subject: [slime-cvs] CVS update: slime/swank-sbcl.lisp Message-ID: <20060120213120.71752200C1@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp:/tmp/cvs-serv26289 Modified Files: swank-sbcl.lisp Log Message: (restart-frame): Provide an implementation even if it doesn't quite do what it's supposed to do. Date: Fri Jan 20 15:31:20 2006 Author: heller Index: slime/swank-sbcl.lisp diff -u slime/swank-sbcl.lisp:1.151 slime/swank-sbcl.lisp:1.152 --- slime/swank-sbcl.lisp:1.151 Mon Dec 5 17:01:50 2005 +++ slime/swank-sbcl.lisp Fri Jan 20 15:31:20 2006 @@ -737,8 +737,7 @@ (defvar *sldb-stack-top*) (defimplementation install-debugger-globally (function) - (setq sb-ext:*invoke-debugger-hook* function) - (setq *debugger-hook* function)) + (setq sb-ext:*invoke-debugger-hook* function)) (defimplementation call-with-debugging-environment (debugger-loop-fn) (declare (type function debugger-loop-fn)) @@ -926,6 +925,13 @@ (sb-di::frame-catches frame)))) (cond (probe (throw (car probe) (eval-in-frame form index))) (t (format nil "Cannot return from frame: ~S" frame))))) + +;; FIXME: this implementation doesn't unwind the stack before +;; re-invoking the function, but it's better than no implementation at +;; all. +(defimplementation restart-frame (index) + (let ((frame (nth-frame index))) + (return-from-frame index (sb-debug::frame-call-as-list frame)))) ;;;;; reference-conditions From heller at common-lisp.net Fri Jan 20 21:33:00 2006 From: heller at common-lisp.net (Helmut Eller) Date: Fri, 20 Jan 2006 15:33:00 -0600 (CST) Subject: [slime-cvs] CVS update: slime/ChangeLog Message-ID: <20060120213300.57A64200C2@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp:/tmp/cvs-serv26322 Modified Files: ChangeLog Log Message: Date: Fri Jan 20 15:33:00 2006 Author: heller Index: slime/ChangeLog diff -u slime/ChangeLog:1.829 slime/ChangeLog:1.830 --- slime/ChangeLog:1.829 Thu Jan 19 16:56:16 2006 +++ slime/ChangeLog Fri Jan 20 15:33:00 2006 @@ -1,3 +1,8 @@ +2006-01-20 M?sz?ros Levente + + * swank-sbcl.lisp (restart-frame): Provide an implementation even + if it doesn't quite do what it's supposed to do. + 2006-01-19 Helmut Eller Return to the previous loading strategy: load everything when From heller at common-lisp.net Mon Jan 30 19:07:43 2006 From: heller at common-lisp.net (heller) Date: Mon, 30 Jan 2006 13:07:43 -0600 (CST) Subject: [ubf-cvs] CVS %p Message-ID: <20060130190743.C01F92A4A3@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp:/tmp/cvs-serv25050 Modified Files: slime.el swank.lisp ChangeLog Log Message: Patch from Lu?s Oliveira. Extend slime-echo-arglist to display initargs and initforms when make-instance is detected. * slime.el (slime-enclosing-operator-names): detect make-instance forms and collect the class-name argument if it exists and is a quoted symbol. * swank.lisp (arglist-for-echo-area): handle pairs of of the form ("make-instance" . "") by passing them to format-initargs-and-initforms-for-echo-area. (class-initargs-and-iniforms): New function. (format-initargs-and-initforms-for-echo-area): New function. From heller at common-lisp.net Mon Jan 30 19:56:55 2006 From: heller at common-lisp.net (heller) Date: Mon, 30 Jan 2006 13:56:55 -0600 (CST) Subject: [ubf-cvs] CVS %p Message-ID: <20060130195655.559E02A4A3@common-lisp.net> Update of /project/slime/cvsroot/slime In directory common-lisp:/tmp/cvs-serv28261 Modified Files: ChangeLog swank.lisp swank-backend.lisp Log Message: Patch from Ian Eslick. Show slot values for metaclasses that override the default storage locations for objects slots (i.e. where the default slot-boundp returns nil) in the inspector. * swank.lisp (inspect-for-emacs standard-object): Use slot-value-using-class and slot-boundp-using-class. * swank-backend.lisp: Add slot-value-using-class and slot-boundp-using-class to the swank-mop package.