From msimmons at common-lisp.net Wed Jul 2 10:02:14 2008 From: msimmons at common-lisp.net (msimmons) Date: Wed, 2 Jul 2008 06:02:14 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080702100214.AE7F03700D@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv17364 Modified Files: ChangeLog Log Message: update --- /project/slime/cvsroot/slime/ChangeLog 2008/06/07 11:50:24 1.1359 +++ /project/slime/cvsroot/slime/ChangeLog 2008/07/02 10:02:14 1.1360 @@ -1,3 +1,7 @@ +2008-07-02 Martin Simmons + * swank-lispworks.lisp (install-debugger-globally): hook into the + environment globally to catch BREAK. + 2008-06-07 Tobias C. Rittweiler * slime.el (def-slime-test find-definition.2, arglist): From msimmons at common-lisp.net Wed Jul 2 10:03:07 2008 From: msimmons at common-lisp.net (msimmons) Date: Wed, 2 Jul 2008 06:03:07 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080702100307.DA6731B05C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv17892 Modified Files: swank-lispworks.lisp Log Message: (install-debugger-globally): hook into the environment globally to catch BREAK. --- /project/slime/cvsroot/slime/swank-lispworks.lisp 2008/04/17 14:56:43 1.99 +++ /project/slime/cvsroot/slime/swank-lispworks.lisp 2008/07/02 10:02:57 1.100 @@ -225,6 +225,10 @@ (env:with-environment ((slime-env hook '())) (funcall fun)))) +(defimplementation install-debugger-globally (function) + (setq *debugger-hook* function) + (setf (env:environment) (slime-env function '()))) + (defvar *sldb-top-frame*) (defun interesting-frame-p (frame) From trittweiler at common-lisp.net Fri Jul 4 21:56:23 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Fri, 4 Jul 2008 17:56:23 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080704215623.74995682C6@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv27707 Modified Files: slime.el Log Message: * slime.el (slime-call-defun): Broken on DEFMETHOD forms. Fix that. Also, don't insert package qualifier anymore if the inserted qualifier is the same as the current REPL package. --- /project/slime/cvsroot/slime/slime.el 2008/06/07 11:49:58 1.941 +++ /project/slime/cvsroot/slime/slime.el 2008/07/04 21:56:23 1.942 @@ -5326,17 +5326,27 @@ (defun slime-call-defun () "Insert a call to the toplevel form defined around point into the REPL." (interactive) - (let ((toplevel (slime-parse-toplevel-form))) - (destructure-case toplevel - (((:defun :defmethod :defgeneric :defmacro :define-compiler-macro) symbol) - (let ((function-call - (format "(%s " (slime-qualify-cl-symbol-name symbol)))) - (slime-switch-to-output-buffer) - (goto-char slime-repl-input-start-mark) - (insert function-call) - (save-excursion (insert ")")))) - (t - (error "Not in a function definition"))))) + (flet ((insert-call (symbol) + (let* ((qualified-symbol-name (slime-qualify-cl-symbol-name symbol)) + (symbol-name (slime-cl-symbol-name qualified-symbol-name)) + (symbol-package (slime-cl-symbol-package qualified-symbol-name)) + (function-call + (format "(%s " (if (equalp (slime-lisp-package) symbol-package) + symbol-name + qualified-symbol-name)))) + (slime-switch-to-output-buffer) + (goto-char slime-repl-input-start-mark) + (insert function-call) + (save-excursion (insert ")"))))) + (let ((toplevel (slime-parse-toplevel-form))) + (destructure-case toplevel + (((:defun :defgeneric :defmacro :define-compiler-macro) symbol) + (insert-call symbol)) + ((:defmethod symbol &rest args) + (declare (ignore args)) + (insert-call symbol)) + (t + (error "Not in a function definition")))))) ;;;; Edit Lisp value ;;; @@ -6157,7 +6167,6 @@ (indent-sexp) (goto-char point)))))))) - (defun slime-macroexpand-1 (&optional repeatedly) "Display the macro expansion of the form at point. The form is expanded with CL:MACROEXPAND-1 or, if a prefix argument is given, with @@ -9104,7 +9113,7 @@ (if (slime-cl-symbol-package s) s (format "%s::%s" - (let* ((package (slime-current-package))) + (let* ((package (or (slime-current-package) (slime-lisp-package)))) ;; package is a string like ":cl-user" or "CL-USER". (if (and package (string-match "^:" package)) (substring package 1) From trittweiler at common-lisp.net Fri Jul 4 21:56:56 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Fri, 4 Jul 2008 17:56:56 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080704215656.7B971702FE@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv27846 Modified Files: ChangeLog Log Message: * slime.el (slime-call-defun): Broken on DEFMETHOD forms. Fix that. Also, don't insert package qualifier anymore if the inserted qualifier is the same as the current REPL package. --- /project/slime/cvsroot/slime/ChangeLog 2008/07/02 10:02:14 1.1360 +++ /project/slime/cvsroot/slime/ChangeLog 2008/07/04 21:56:56 1.1361 @@ -1,3 +1,9 @@ +2008-07-04 Tobias C. Rittweiler + + * slime.el (slime-call-defun): Broken on DEFMETHOD forms. Fix + that. Also, don't insert package qualifier anymore if the inserted + qualifier is the same as the current REPL package. + 2008-07-02 Martin Simmons * swank-lispworks.lisp (install-debugger-globally): hook into the environment globally to catch BREAK. From trittweiler at common-lisp.net Fri Jul 4 22:04:13 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Fri, 4 Jul 2008 18:04:13 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080704220413.125886600D@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv32124 Modified Files: swank-sbcl.lisp Log Message: * swank-sbcl.lisp (code-location-source-location), (code-location-debug-source-name): Patched for incompatible structure change in SBCL 1.0.18.10. --- /project/slime/cvsroot/slime/swank-sbcl.lisp 2008/05/19 13:12:52 1.196 +++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2008/07/04 22:04:12 1.197 @@ -850,9 +850,14 @@ (plist (sb-c::debug-source-plist dsource))) (if (getf plist :emacs-buffer) (emacs-buffer-source-location code-location plist) + #+#.(swank-backend::sbcl-with-symbol 'debug-source-from 'sb-di) (ecase (sb-di:debug-source-from dsource) (:file (file-source-location code-location)) - (:lisp (lisp-source-location code-location)))))) + (:lisp (lisp-source-location code-location))) + #-#.(swank-backend::sbcl-with-symbol 'debug-source-from 'sb-di) + (if (sb-di:debug-source-namestring dsource) + (file-source-location code-location) + (lisp-source-location code-location))))) ;;; FIXME: The naming policy of source-location functions is a bit ;;; fuzzy: we have FUNCTION-SOURCE-LOCATION which returns the @@ -906,7 +911,12 @@ `(:snippet ,snippet))))))) (defun code-location-debug-source-name (code-location) - (namestring (truename (sb-c::debug-source-name + (namestring (truename (#+#.(swank-backend::sbcl-with-symbol + 'debug-source-name 'sb-di) + sb-c::debug-source-name + #-#.(swank-backend::sbcl-with-symbol + 'debug-source-name 'sb-di) + sb-c::debug-source-namestring (sb-di::code-location-debug-source code-location))))) (defun code-location-debug-source-created (code-location) From trittweiler at common-lisp.net Fri Jul 4 22:04:51 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Fri, 4 Jul 2008 18:04:51 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080704220451.DFE1E702FE@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv32229 Modified Files: ChangeLog Log Message: * swank-sbcl.lisp (code-location-source-location), (code-location-debug-source-name): Patched for incompatible structure change in SBCL 1.0.18.10. --- /project/slime/cvsroot/slime/ChangeLog 2008/07/04 21:56:56 1.1361 +++ /project/slime/cvsroot/slime/ChangeLog 2008/07/04 22:04:51 1.1362 @@ -1,3 +1,9 @@ +2008-07-04 Richard M Kreuter + + * swank-sbcl.lisp (code-location-source-location), + (code-location-debug-source-name): Patched for incompatible + structure change in SBCL 1.0.18.10. + 2008-07-04 Tobias C. Rittweiler * slime.el (slime-call-defun): Broken on DEFMETHOD forms. Fix @@ -27,7 +33,7 @@ (slime-cl-symbol-package), (slime-qualify-cl-symbol-name): Resurrected from the `slime-parse' contrib, as they've been used by `slime-call-defun'. - + 2008-06-02 Raymond Toy Unicode support for CMUCL. From trittweiler at common-lisp.net Fri Jul 4 22:55:30 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Fri, 4 Jul 2008 18:55:30 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080704225530.3FC5C5E0FF@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv19869 Modified Files: slime.el Log Message: * slime.el (slime-call-defun): Properly signal error message when used in a context that is not a function definition. --- /project/slime/cvsroot/slime/slime.el 2008/07/04 21:56:23 1.942 +++ /project/slime/cvsroot/slime/slime.el 2008/07/04 22:55:29 1.943 @@ -5339,14 +5339,16 @@ (insert function-call) (save-excursion (insert ")"))))) (let ((toplevel (slime-parse-toplevel-form))) - (destructure-case toplevel - (((:defun :defgeneric :defmacro :define-compiler-macro) symbol) - (insert-call symbol)) - ((:defmethod symbol &rest args) - (declare (ignore args)) - (insert-call symbol)) - (t - (error "Not in a function definition")))))) + (if (symbolp toplevel) + (error "Not in a function definition") + (destructure-case toplevel + (((:defun :defgeneric :defmacro :define-compiler-macro) symbol) + (insert-call symbol)) + ((:defmethod symbol &rest args) + (declare (ignore args)) + (insert-call symbol)) + (t + (error "Not in a function definition"))))))) ;;;; Edit Lisp value ;;; @@ -5585,11 +5587,12 @@ (skip-syntax-forward " ")) (defun slime-parse-toplevel-form () - (save-excursion - (beginning-of-defun) - (down-list 1) - (forward-sexp 1) - (slime-parse-context (read (current-buffer))))) + (ignore-errors ; (foo) + (save-excursion + (beginning-of-defun) + (down-list 1) + (forward-sexp 1) + (slime-parse-context (read (current-buffer)))))) (defun slime-arglist-specializers (arglist) (cond ((or (null arglist) From trittweiler at common-lisp.net Fri Jul 4 22:56:10 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Fri, 4 Jul 2008 18:56:10 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080704225610.4910566008@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv19999 Modified Files: ChangeLog Log Message: * slime.el (slime-call-defun): Properly signal error message when used in a context that is not a function definition. --- /project/slime/cvsroot/slime/ChangeLog 2008/07/04 22:04:51 1.1362 +++ /project/slime/cvsroot/slime/ChangeLog 2008/07/04 22:56:08 1.1363 @@ -1,3 +1,8 @@ +2008-07-04 Tobias C. Rittweiler + + * slime.el (slime-call-defun): Properly signal error message when + used in a context that is not a function definition. + 2008-07-04 Richard M Kreuter * swank-sbcl.lisp (code-location-source-location), From trittweiler at common-lisp.net Fri Jul 4 22:59:54 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Fri, 4 Jul 2008 18:59:54 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080704225954.1AE1E1A0C1@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv20787 Modified Files: swank-allegro.lisp Log Message: * slime-allegro.lisp (fspec-definition-locations): Workaround for the issue that Allegro does not record the source file location for methods defined inside a defgeneric form. The idea is that if the source location of a method is not found, then the defgeneric form is almost certainly the right place. --- /project/slime/cvsroot/slime/swank-allegro.lisp 2008/04/17 14:56:43 1.102 +++ /project/slime/cvsroot/slime/swank-allegro.lisp 2008/07/04 22:59:53 1.103 @@ -414,6 +414,13 @@ (fspec-definition-locations next))) (t (let ((defs (excl::find-source-file fspec))) + (when (and (null defs) + (listp fspec) + (string= (car fspec) '#:method)) + ;; If methods are defined in a defgeneric form, the source location is + ;; recorded for the gf but not for the methods. Therefore fall back to + ;; the gf as the likely place of definition. + (setq defs (excl::find-source-file (second fspec)))) (if (null defs) (list (list (list nil fspec) From trittweiler at common-lisp.net Fri Jul 4 23:01:02 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Fri, 4 Jul 2008 19:01:02 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080704230102.03C0A1A2D5@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv21641 Modified Files: ChangeLog Log Message: * slime-allegro.lisp (fspec-definition-locations): Workaround for the issue that Allegro does not record the source file location for methods defined inside a defgeneric form. The idea is that if the source location of a method is not found, then the defgeneric form is almost certainly the right place. --- /project/slime/cvsroot/slime/ChangeLog 2008/07/04 22:56:08 1.1363 +++ /project/slime/cvsroot/slime/ChangeLog 2008/07/04 23:00:48 1.1364 @@ -1,9 +1,17 @@ +2008-07-04 Willem Broekema + + * slime-allegro.lisp (fspec-definition-locations): Workaround for + the issue that Allegro does not record the source file location + for methods defined inside a defgeneric form. The idea is that if + the source location of a method is not found, then the defgeneric + form is almost certainly the right place. + 2008-07-04 Tobias C. Rittweiler * slime.el (slime-call-defun): Properly signal error message when used in a context that is not a function definition. -2008-07-04 Richard M Kreuter +2008-07-04 Richard M Kreuter * swank-sbcl.lisp (code-location-source-location), (code-location-debug-source-name): Patched for incompatible @@ -15,7 +23,7 @@ that. Also, don't insert package qualifier anymore if the inserted qualifier is the same as the current REPL package. -2008-07-02 Martin Simmons +2008-07-02 Martin Simmons * swank-lispworks.lisp (install-debugger-globally): hook into the environment globally to catch BREAK. @@ -39,7 +47,7 @@ (slime-qualify-cl-symbol-name): Resurrected from the `slime-parse' contrib, as they've been used by `slime-call-defun'. -2008-06-02 Raymond Toy +2008-06-02 Raymond Toy Unicode support for CMUCL. From trittweiler at common-lisp.net Fri Jul 4 23:30:11 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Fri, 4 Jul 2008 19:30:11 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080704233011.4CBED4060@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv1365 Modified Files: swank.lisp Log Message: * swank.lisp (call-with-redirected-io): Rebind only standard streams if *GLOBALLY-REDIRECT-IO*. Fixes lost output after disconnect, reconnect. --- /project/slime/cvsroot/slime/swank.lisp 2008/04/17 14:56:43 1.543 +++ /project/slime/cvsroot/slime/swank.lisp 2008/07/04 23:30:10 1.544 @@ -1291,18 +1291,30 @@ (defun call-with-redirected-io (connection function) "Call FUNCTION with I/O streams redirected via CONNECTION." (declare (type function function)) - (let* ((io (connection.user-io connection)) - (in (connection.user-input connection)) - (out (connection.user-output connection)) - (trace (or (connection.trace-output connection) out)) - (*standard-output* out) - (*error-output* out) - (*trace-output* trace) - (*debug-io* io) - (*query-io* io) - (*standard-input* in) - (*terminal-io* io)) - (funcall function))) + (if *globally-redirect-io* + ;; Rebind the standard streams which isn't strictly necessary, + ;; but makes it easier to interpret (SETQ *STANDARD-OUTPUT* ...) + ;; and such in a repl transcript. + (let* ((*standard-output* *standard-output*) + (*error-output* *error-output*) + (*trace-output* *trace-output*) + (*debug-io* *debug-io*) + (*query-io* *query-io*) + (*standard-input* *standard-input*) + (*terminal-io* *terminal-io*)) + (funcall function)) + (let* ((io (connection.user-io connection)) + (in (connection.user-input connection)) + (out (connection.user-output connection)) + (trace (or (connection.trace-output connection) out)) + (*standard-output* out) + (*error-output* out) + (*trace-output* trace) + (*debug-io* io) + (*query-io* io) + (*standard-input* in) + (*terminal-io* io)) + (funcall function)))) (defun read-from-emacs () "Read and process a request from Emacs." From trittweiler at common-lisp.net Fri Jul 4 23:30:44 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Fri, 4 Jul 2008 19:30:44 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080704233044.9E74A1A0ED@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv1576 Modified Files: ChangeLog Log Message: * swank.lisp (call-with-redirected-io): Rebind only standard streams if *GLOBALLY-REDIRECT-IO*. Fixes lost output after disconnect, reconnect. --- /project/slime/cvsroot/slime/ChangeLog 2008/07/04 23:00:48 1.1364 +++ /project/slime/cvsroot/slime/ChangeLog 2008/07/04 23:30:44 1.1365 @@ -1,3 +1,9 @@ +2008-07-04 G?bor Melis + + * swank.lisp (call-with-redirected-io): Rebind only standard + streams if *GLOBALLY-REDIRECT-IO*. Fixes lost output after + disconnect, reconnect. + 2008-07-04 Willem Broekema * slime-allegro.lisp (fspec-definition-locations): Workaround for From trittweiler at common-lisp.net Sat Jul 5 11:48:12 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Sat, 5 Jul 2008 07:48:12 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080705114812.95CF681003@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv27837 Modified Files: swank.lisp swank-sbcl.lisp swank-backend.lisp slime.el ChangeLog Log Message: `M-x slime-lisp-threads' will now contain a summary of what's currently executed in a thread that was created by Swank. * swank-backend.lisp (thread-description, set-thread-description): New interface functions to associate strings with threads. * swank-sbcl.lisp (thread-description, set-thread-description): Implemented. * swank.lisp (call-with-thread-description), (with-thread-description): New. (read-from-emacs): Now temporarily sets the thread-description of the current thread to a summary of what's going to be executed by the current request. (defslimefun list-threads): Changed return value to also contain a thread's description. * slime.el (slime-list-threads, slime-thread-insert): Adapted to new return value of LIST-THREADS. --- /project/slime/cvsroot/slime/swank.lisp 2008/07/04 23:30:10 1.544 +++ /project/slime/cvsroot/slime/swank.lisp 2008/07/05 11:48:11 1.545 @@ -1316,9 +1316,33 @@ (*terminal-io* io)) (funcall function)))) +(defun call-with-thread-description (description thunk) + (let* ((thread (current-thread)) + (old-description (thread-description thread))) + (set-thread-description thread description) + (unwind-protect (funcall thunk) + (set-thread-description thread old-description)))) + +(defmacro with-thread-description (description &body body) + `(call-with-thread-description ,description #'(lambda () , at body))) + (defun read-from-emacs () "Read and process a request from Emacs." - (apply #'funcall (funcall (connection.read *emacs-connection*)))) + (flet ((request-to-string (req) + (remove #\Newline + (string-trim '(#\Space #\Tab) + (prin1-to-string req)))) + (truncate-string (str n) + (if (> (length str) n) + (format nil "~A..." (subseq str 0 n)) + str))) + (let ((request (funcall (connection.read *emacs-connection*)))) + (if (eq *communication-style* :spawn) + ;; For `M-x slime-list-threads': Display what threads + ;; created by swank are currently doing. + (with-thread-description (truncate-string (request-to-string request) 55) + (apply #'funcall request)) + (apply #'funcall request))))) (defun read-from-control-thread () (receive)) @@ -2878,13 +2902,15 @@ a time.") (defslimefun list-threads () - "Return a list ((NAME DESCRIPTION) ...) of all threads." + "Return a list ((ID NAME STATUS DESCRIPTION) ...) of all threads." (setq *thread-list* (all-threads)) (loop for thread in *thread-list* for name = (thread-name thread) - collect (list (if (symbolp name) (symbol-name name) name) + collect (list (thread-id thread) + (if (symbolp name) (symbol-name name) name) (thread-status thread) - (thread-id thread)))) + (thread-description thread) + ))) (defslimefun quit-thread-browser () (setq *thread-list* nil)) --- /project/slime/cvsroot/slime/swank-sbcl.lisp 2008/07/04 22:04:12 1.197 +++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2008/07/05 11:48:11 1.198 @@ -1212,7 +1212,22 @@ (if (sb-thread:thread-alive-p thread) "RUNNING" "STOPPED")) - + #+#.(swank-backend::sbcl-with-weak-hash-tables) + (progn + (defparameter *thread-description-map* + (make-weak-key-hash-table)) + + (defvar *thread-descr-map-lock* + (sb-thread:make-mutex :name "thread description map lock")) + + (defimplementation thread-description (thread) + (sb-thread:with-mutex (*thread-descr-map-lock*) + (or (gethash thread *thread-description-map*) ""))) + + (defimplementation set-thread-description (thread description) + (sb-thread:with-mutex (*thread-descr-map-lock*) + (setf (gethash thread *thread-description-map*) description)))) + (defimplementation make-lock (&key name) (sb-thread:make-mutex :name name)) --- /project/slime/cvsroot/slime/swank-backend.lisp 2008/04/24 18:51:03 1.132 +++ /project/slime/cvsroot/slime/swank-backend.lisp 2008/07/05 11:48:12 1.133 @@ -950,6 +950,16 @@ (declare (ignore thread)) "") +(definterface thread-description (thread) + "Return a string describing THREAD." + (declare (ignore thread)) + "") + +(definterface set-thread-description (thread description) + "Set THREAD's description to DESCRIPTION." + (declare (ignore thread description)) + "") + (definterface make-lock (&key name) "Make a lock for thread synchronization. Only one thread may hold the lock (via CALL-WITH-LOCK-HELD) at a time." --- /project/slime/cvsroot/slime/slime.el 2008/07/04 22:55:29 1.943 +++ /project/slime/cvsroot/slime/slime.el 2008/07/05 11:48:12 1.944 @@ -7133,18 +7133,19 @@ (let ((inhibit-read-only t)) (erase-buffer) (loop for idx from 0 - for (name status id) in threads - do (slime-thread-insert idx name status id)) + for (id name status desc) in threads + do (slime-thread-insert idx name status desc id)) (goto-char (point-min)) (setq buffer-read-only t) (pop-to-buffer (current-buffer)))))) -(defun slime-thread-insert (idx name summary id) +(defun slime-thread-insert (idx name status summary id) (slime-propertize-region `(thread-id ,idx) (insert (format "%3s: " id)) (slime-insert-propertized '(face bold) name) (insert-char ?\ (- 30 (current-column))) (let ((summary-start (point))) + (insert " " status) (insert " " summary) (unless (bolp) (insert "\n")) (indent-rigidly summary-start (point) 2)))) --- /project/slime/cvsroot/slime/ChangeLog 2008/07/04 23:30:44 1.1365 +++ /project/slime/cvsroot/slime/ChangeLog 2008/07/05 11:48:12 1.1366 @@ -1,3 +1,24 @@ +2008-07-05 Tobias C. Rittweiler + + `M-x slime-lisp-threads' will now contain a summary of what's + currently executed in a thread that was created by Swank. + + * swank-backend.lisp (thread-description, set-thread-description): + New interface functions to associate strings with threads. + * swank-sbcl.lisp (thread-description, set-thread-description): + Implemented. + + * swank.lisp (call-with-thread-description), + (with-thread-description): New. + (read-from-emacs): Now temporarily sets the thread-description of + the current thread to a summary of what's going to be executed by + the current request. + (defslimefun list-threads): Changed return value to also contain + a thread's description. + + * slime.el (slime-list-threads, slime-thread-insert): Adapted to + new return value of LIST-THREADS. + 2008-07-04 G?bor Melis * swank.lisp (call-with-redirected-io): Rebind only standard From trittweiler at common-lisp.net Sat Jul 5 13:37:25 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Sat, 5 Jul 2008 09:37:25 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080705133725.9625549111@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv1935 Modified Files: swank.lisp Log Message: * swank.lisp: Revert Melis' change from 2008-07-04; Global IO redirection seems currently to be broken, and while it's not due to that commit (it seems that it's been broken since longer), I want to be on a safe bet. --- /project/slime/cvsroot/slime/swank.lisp 2008/07/05 11:48:11 1.545 +++ /project/slime/cvsroot/slime/swank.lisp 2008/07/05 13:37:25 1.546 @@ -1291,30 +1291,18 @@ (defun call-with-redirected-io (connection function) "Call FUNCTION with I/O streams redirected via CONNECTION." (declare (type function function)) - (if *globally-redirect-io* - ;; Rebind the standard streams which isn't strictly necessary, - ;; but makes it easier to interpret (SETQ *STANDARD-OUTPUT* ...) - ;; and such in a repl transcript. - (let* ((*standard-output* *standard-output*) - (*error-output* *error-output*) - (*trace-output* *trace-output*) - (*debug-io* *debug-io*) - (*query-io* *query-io*) - (*standard-input* *standard-input*) - (*terminal-io* *terminal-io*)) - (funcall function)) - (let* ((io (connection.user-io connection)) - (in (connection.user-input connection)) - (out (connection.user-output connection)) - (trace (or (connection.trace-output connection) out)) - (*standard-output* out) - (*error-output* out) - (*trace-output* trace) - (*debug-io* io) - (*query-io* io) - (*standard-input* in) - (*terminal-io* io)) - (funcall function)))) + (let* ((io (connection.user-io connection)) + (in (connection.user-input connection)) + (out (connection.user-output connection)) + (trace (or (connection.trace-output connection) out)) + (*standard-output* out) + (*error-output* out) + (*trace-output* trace) + (*debug-io* io) + (*query-io* io) + (*standard-input* in) + (*terminal-io* io)) + (funcall function))) (defun call-with-thread-description (description thunk) (let* ((thread (current-thread)) From trittweiler at common-lisp.net Sat Jul 5 13:38:25 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Sat, 5 Jul 2008 09:38:25 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080705133825.A27BD6D238@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv1989 Modified Files: ChangeLog Log Message: * swank.lisp: Revert Melis' change from 2008-07-04; Global IO redirection seems currently to be broken, and while it's not due to that commit (it seems that it's been broken since longer), I want to be on a safe bet. --- /project/slime/cvsroot/slime/ChangeLog 2008/07/05 11:48:12 1.1366 +++ /project/slime/cvsroot/slime/ChangeLog 2008/07/05 13:38:25 1.1367 @@ -1,5 +1,12 @@ 2008-07-05 Tobias C. Rittweiler + * swank.lisp: Revert Melis' change from 2008-07-04; Global IO + redirection seems currently to be broken, and while it's not due + to that commit (it seems that it's been broken since longer), I + want to be on a safe bet. + +2008-07-05 Tobias C. Rittweiler + `M-x slime-lisp-threads' will now contain a summary of what's currently executed in a thread that was created by Swank. From trittweiler at common-lisp.net Wed Jul 16 16:14:51 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Wed, 16 Jul 2008 12:14:51 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080716161451.23F0E5C18D@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv31805 Modified Files: swank.lisp slime.el ChangeLog Log Message: Recompilation support added to xref buffers. You can now use `C-c C-c' in an xref buffer to recompile the defun represented by the xref at point. Similiarly, you can use `C-c C-k' to recompile all xrefs displayed. For example, if you've changed a macro, and want to recompile all the functions in the image which use that macro, you first call `slime-who-macroexpands' (C-c C-w RET), and then issues `C-c C-k' in the xref buffer that just popped up. [There's no guarantee that this will actually recompile all functions that depend on the changed macro, as this obviously depends on the quality of the backend's WHO-MACROEXPANDS implementation.] * swank.lisp: Introduced the notion of a SWANK-COMPILATION-UNIT, so we're able to compile different stuff comming from Slime one after the other, and have compiler notes &c. collected in a contiguous manner. (defstruct :swank-compilation-unit): New. Contains compilation notes, compilation results, etc. (*swank-compilation-unit*): New. Current Swank Compilation Unit. (with-swank-compilation-unit): New. Like WITH-COMPILATION-UNIT. (swank-compilation-unit-for-emacs): New. (swank-compiler): Adapted; collect compilation stuff into the current swank-compilation-unit. (compile-string-for-emacs): Use WITH-SWANK-COMPILATION-UNIT. (compile-file-for-emacs): Ditto. (*compiler-notes*, clear-compiler-notes): Removed. (compiler-notes-for-emacs): Removed. * slime.el (slime-compilation-unit, slime-last-compilation-unit), (slime-compiler-notes, slime-compiler-results): New/Adapted. (slime-make-compile-expression-for-swank): Factored out from `slime-compile-string'. (slime-recompile-location): New. (slime-recompile-locations): New. (slime-pop-to-location): &optional `where' arg can now also be 'excursion to only reset the current-buffer, but not switch. (slime-xref-mode-map): Add `C-c C-c' and `C-c C-k'. (slime-xref-dspec-at-point): New. (slime-all-xrefs): New. (slime-recompile-xref): New. (slime-recompile-all-xrefs): New. (slime-make-xref-recompilation-cont): New. (slime-xref-inert-recompilation-flags): New. (slime-trim-whitespace): New utility. --- /project/slime/cvsroot/slime/swank.lisp 2008/07/05 13:37:25 1.546 +++ /project/slime/cvsroot/slime/swank.lisp 2008/07/16 16:14:50 1.547 @@ -56,7 +56,8 @@ #:profile-package #:default-directory #:set-default-directory - #:quit-lisp)) + #:quit-lisp + #:with-swank-compilation-unit)) (in-package :swank) @@ -2195,15 +2196,16 @@ ;;;; Compilation Commands. -(defvar *compiler-notes* '() - "List of compiler notes for the last compilation unit.") +(defstruct (:swank-compilation-unit + (:type list) :named + (:conc-name swank-compilation-unit.) + (:constructor make-swank-compilation-unit ())) + notes ; + results ; a result is of type (MEMBER T NIL :COMPLAINED) + durations ; + ) -(defun clear-compiler-notes () - (setf *compiler-notes* '())) - -(defslimefun compiler-notes-for-emacs () - "Return the list of compiler notes for the last compilation unit." - (reverse *compiler-notes*)) +(defvar *swank-compilation-unit* nil) (defun measure-time-interval (fn) "Call FN and return the first return value and the elapsed time. @@ -2216,8 +2218,10 @@ (/ 1000000 internal-time-units-per-second))))) (defun record-note-for-condition (condition) - "Record a note for a compiler-condition." - (push (make-compiler-note condition) *compiler-notes*)) + "Record a note for a compiler-condition into the currently active +Swank-Compilation-Unit." + (push (make-compiler-note condition) + (swank-compilation-unit.notes *swank-compilation-unit*))) (defun make-compiler-note (condition) "Make a compiler note data structure from a compiler-condition." @@ -2229,41 +2233,65 @@ (let ((s (short-message condition))) (if s (list :short-message s))))) +(defmacro with-swank-compilation-unit ((&key override) &body body) + "Similiar to CL:WITH-COMPILATION-UNIT. Within a +Swank-Compilation-Unit all notes, results etc. produced by +COMPILE-FILE-FOR-EMACS and COMPILE-STRING-FOR-EMACS (possibly called +more than once) will be collected into this unit." + (if override + `(let ((*swank-compilation-unit* (make-swank-compilation-unit))) + , at body) + `(let ((*swank-compilation-unit* (or *swank-compilation-unit* + (make-swank-compilation-unit)))) + , at body))) + +(defun swank-compilation-unit-for-emacs (unit) + "Make a Swank-Compilation-Unit suitable for Emacs." + (let ((new (make-swank-compilation-unit))) + (with-struct (swank-compilation-unit. notes results durations) unit + (setf (swank-compilation-unit.notes new) (reverse notes)) + (setf (swank-compilation-unit.results new) (reverse results)) + (setf (swank-compilation-unit.durations new) + (reverse (mapcar #'(lambda (usecs) (/ usecs 1000000.0)) durations)))) + new)) + (defun swank-compiler (function) - (clear-compiler-notes) - (multiple-value-bind (result usecs) - (with-simple-restart (abort "Abort SLIME compilation.") - (handler-bind ((compiler-condition #'record-note-for-condition)) - (measure-time-interval function))) - ;; WITH-SIMPLE-RESTART returns (values nil t) if its restart is invoked; - ;; unfortunately the SWANK protocol doesn't support returning multiple - ;; values, so we gotta convert it explicitely to a list in either case. - (if (and (not result) (eq usecs 't)) - (list nil nil) - (list (to-string result) - (format nil "~,2F" (/ usecs 1000000.0)))))) + (let ((notes-p)) + (multiple-value-bind (result usecs) + (with-simple-restart (abort "Abort SLIME compilation.") + (handler-bind ((compiler-condition #'(lambda (c) + (setf notes-p t) + (record-note-for-condition c)))) + (measure-time-interval function))) + (when result (setf result (if notes-p :complained t))) + (push result (swank-compilation-unit.results *swank-compilation-unit*)) + (push usecs (swank-compilation-unit.durations *swank-compilation-unit*)) + (swank-compilation-unit-for-emacs *swank-compilation-unit*)))) (defslimefun compile-file-for-emacs (filename load-p) "Compile FILENAME and, when LOAD-P, load the result. Record compiler notes signalled as `compiler-condition's." - (with-buffer-syntax () - (let ((*compile-print* nil)) - (swank-compiler - (lambda () - (swank-compile-file filename load-p - (or (guess-external-format filename) - :default))))))) + (with-swank-compilation-unit (:override nil) + (with-buffer-syntax () + (let ((*compile-print* nil)) + (swank-compiler + (lambda () + (swank-compile-file filename load-p + (or (guess-external-format filename) + :default)))))))) (defslimefun compile-string-for-emacs (string buffer position directory debug) "Compile STRING (exerpted from BUFFER at POSITION). Record compiler notes signalled as `compiler-condition's." - (with-buffer-syntax () - (swank-compiler - (lambda () - (let ((*compile-print* nil) (*compile-verbose* t)) - (swank-compile-string string :buffer buffer :position position - :directory directory - :debug debug)))))) + (with-swank-compilation-unit (:override nil) + (with-buffer-syntax () + (swank-compiler + (lambda () + (let ((*compile-print* nil) (*compile-verbose* t)) + (swank-compile-string string :buffer buffer :position position + :directory directory + :debug debug))))))) + (defun file-newer-p (new-file old-file) "Returns true if NEW-FILE is newer than OLD-FILE." @@ -3111,4 +3139,4 @@ (defun init () (run-hook *after-init-hook*)) -;;; swank.lisp ends here +;;; swank.lisp ends here \ No newline at end of file --- /project/slime/cvsroot/slime/slime.el 2008/07/05 11:48:12 1.944 +++ /project/slime/cvsroot/slime/slime.el 2008/07/16 16:14:50 1.945 @@ -3753,6 +3753,25 @@ :group 'slime-mode :type 'boolean) +(defstruct (slime-compilation-unit + (:type list) + (:conc-name slime-compilation-unit.) + (:constructor nil) + (:copier nil)) + tag notes results durations) + +(defvar slime-last-compilation-unit nil + "The result of the most recently issued compilation.") + +(defun slime-compiler-notes () + "Return all compiler notes, warnings, and errors." + (slime-compilation-unit.notes slime-last-compilation-unit)) + +(defun slime-compiler-results () + "Return the results of the most recently issued compilations." + (slime-compilation-unit.results slime-last-compilation-unit)) + + (defun slime-compile-and-load-file () "Compile and load the buffer's file and highlight compiler notes. @@ -3806,14 +3825,32 @@ (defun slime-compile-string (string start-offset) (slime-eval-async - `(swank:compile-string-for-emacs - ,string - ,(buffer-name) - ,start-offset - ,(if (buffer-file-name) (file-name-directory (buffer-file-name))) - ',slime-compile-with-maximum-debug) + (slime-make-compile-expression-for-swank string start-offset) (slime-make-compilation-finished-continuation (current-buffer)))) +(defun slime-make-compile-expression-for-swank (string start-offset) + `(swank:compile-string-for-emacs + ,string + ,(buffer-name) + ,start-offset + ,(if (buffer-file-name) (file-name-directory (buffer-file-name))) + ',slime-compile-with-maximum-debug)) + +(defun slime-make-compilation-finished-continuation (current-buffer &optional emacs-snapshot) + (lexical-let ((buffer current-buffer) (snapshot emacs-snapshot)) + (lambda (result) + (slime-compilation-finished result buffer snapshot)))) + +(defun slime-compilation-finished (compilation-unit buffer &optional emacs-snapshot) + (with-struct (slime-compilation-unit. notes durations) compilation-unit + (with-current-buffer buffer + (setf slime-compilation-just-finished t) + (setf slime-last-compilation-unit compilation-unit) + (slime-show-note-counts notes (reduce #'+ durations)) + (when slime-highlight-compiler-notes + (slime-highlight-notes notes))) + (run-hook-with-args 'slime-compilation-finished-hook notes emacs-snapshot))) + (defun slime-note-count-string (severity count &optional suppress-if-zero) (cond ((and (zerop count) suppress-if-zero) "") @@ -3832,49 +3869,8 @@ (slime-note-count-string "warning" nwarnings) (slime-note-count-string "style-warning" nstyle-warnings t) (slime-note-count-string "note" nnotes) - (if secs (format "[%s secs]" secs) "")))) + (if secs (format "[%.2f secs]" secs) "")))) -(defun slime-xrefs-for-notes (notes) - (let ((xrefs)) - (dolist (note notes) - (let* ((location (getf note :location)) - (fn (cadr (assq :file (cdr location)))) - (file (assoc fn xrefs)) - (node - (cons (format "%s: %s" - (getf note :severity) - (slime-one-line-ify (getf note :message))) - location))) - (when fn - (if file - (push node (cdr file)) - (setf xrefs (acons fn (list node) xrefs)))))) - xrefs)) - -(defun slime-one-line-ify (string) - "Return a single-line version of STRING. -Each newlines and following indentation is replaced by a single space." - (with-temp-buffer - (insert string) - (goto-char (point-min)) - (while (re-search-forward "\n[\n \t]*" nil t) - (replace-match " ")) - (buffer-string))) - -(defun slime-compilation-finished (result buffer &optional emacs-snapshot) - (let ((notes (slime-compiler-notes))) - (with-current-buffer buffer - (setf slime-compilation-just-finished t) - (destructuring-bind (result secs) result - (slime-show-note-counts notes secs) - (when slime-highlight-compiler-notes - (slime-highlight-notes notes)))) - (run-hook-with-args 'slime-compilation-finished-hook notes emacs-snapshot))) - -(defun slime-make-compilation-finished-continuation (current-buffer &optional emacs-snapshot) - (lexical-let ((buffer current-buffer) (snapshot emacs-snapshot)) - (lambda (result) - (slime-compilation-finished result buffer snapshot)))) (defun slime-highlight-notes (notes) "Highlight compiler notes, warnings, and errors in the buffer." @@ -3886,9 +3882,6 @@ (slime-remove-old-overlays) (mapc #'slime-overlay-note (slime-merge-notes-for-display notes)))))) -(defun slime-compiler-notes () - "Return all compiler notes, warnings, and errors." - (slime-eval `(swank:compiler-notes-for-emacs))) (defun slime-remove-old-overlays () "Delete the existing Slime overlays in the current buffer." @@ -3911,6 +3904,38 @@ (with-current-buffer %buffer (funcall predicate))) (buffer-list))) + +;;;;; Recompilation. + +;;; FIXME: Add maximum-debug-p. + +(defun slime-recompile-location (location) + (save-excursion + (slime-pop-to-location location 'excursion) + (slime-compile-defun))) + +(defun slime-recompile-locations (locations) + (flet ((make-compile-expr (loc) + (save-excursion + (slime-pop-to-location loc 'excursion) + (multiple-value-bind (start end) (slime-region-for-defun-at-point) + (slime-make-compile-expression-for-swank + (buffer-substring-no-properties start end) + start))))) + (slime-eval-async + `(swank:with-swank-compilation-unit (:override t) + ;; We have to compile each location seperately because of + ;; buffer and offset tracking during notes generation. + ,@(loop for loc in locations + collect (make-compile-expr loc))) + (slime-make-compilation-finished-continuation (current-buffer))))) + +;;; FIXME: implement: + +;; (defun slime-recompile-symbol-at-point (name) +;; (interactive (list (slime-read-symbol-name "Name: "))) +;; ) + ;;;;; Merging together compiler notes in the same location. @@ -3958,6 +3983,33 @@ ;;;;; Compiler notes list +(defun slime-one-line-ify (string) + "Return a single-line version of STRING. +Each newlines and following indentation is replaced by a single space." + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (while (re-search-forward "\n[\n \t]*" nil t) + (replace-match " ")) + (buffer-string))) + +(defun slime-xrefs-for-notes (notes) + (let ((xrefs)) + (dolist (note notes) + (let* ((location (getf note :location)) + (fn (cadr (assq :file (cdr location)))) + (file (assoc fn xrefs)) + (node + (cons (format "%s: %s" + (getf note :severity) + (slime-one-line-ify (getf note :message))) + location))) + (when fn + (if file + (push node (cdr file)) + (setf xrefs (acons fn (list node) xrefs)))))) + xrefs)) + (defun slime-maybe-show-xrefs-for-notes (&optional notes emacs-snapshot) "Show the compiler notes NOTES if they come from more than one file." (let* ((notes (or notes (slime-compiler-notes))) @@ -5046,12 +5098,13 @@ (defun slime-pop-to-location (location &optional where) (slime-goto-source-location location) (ecase where - ((nil) (switch-to-buffer (current-buffer))) - (window (pop-to-buffer (current-buffer) t)) - (frame (let ((pop-up-frames t)) (pop-to-buffer (current-buffer) t))))) + ((nil) (switch-to-buffer (current-buffer))) + (window (pop-to-buffer (current-buffer) t)) + (frame (let ((pop-up-frames t)) (pop-to-buffer (current-buffer) t))) + (excursion nil))) ; NOP, slime-goto-source-location did set-buffer. (defun slime-find-definitions (name) - "Find definitions for NAME and pass them to CONT." + "Find definitions for NAME." (funcall slime-find-definitions-function name)) (defun slime-find-definitions-rpc (name) @@ -5863,7 +5916,9 @@ (" " 'slime-goto-xref) ("q" 'slime-xref-quit) ("n" 'slime-next-line/not-add-newlines) - ("p" 'previous-line)) + ("p" 'previous-line) + ("\C-c\C-c" 'slime-recompile-xref) + ("\C-c\C-k" 'slime-recompile-all-xrefs)) (defun slime-next-line/not-add-newlines () (interactive) @@ -6030,6 +6085,22 @@ (or (get-text-property (point) 'slime-location) (error "No reference at point.")))) +(defun slime-xref-dspec-at-point () + (save-excursion + (beginning-of-line 1) + (slime-trim-whitespace (substring-no-properties (thing-at-point 'line))))) + +(defun slime-all-xrefs () + (let ((xrefs nil)) + (save-excursion + (beginning-of-buffer) + (while (ignore-errors (slime-next-line/not-add-newlines) t) + (when-let (loc (get-text-property (point) 'slime-location)) + (let* ((dspec (slime-xref-dspec-at-point)) + (xref (make-slime-xref :dspec dspec :location loc))) + (push xref xrefs))))) + (nreverse xrefs))) + (defun slime-goto-xref () "Goto the cross-referenced location at point." (interactive) @@ -6073,6 +6144,58 @@ (slime-xref-cleanup) (slime-set-emacs-snapshot snapshot))) +(defun slime-recompile-xref () + (interactive) + (let ((location (slime-xref-location-at-point)) + (dspec (slime-xref-dspec-at-point))) + (add-hook 'slime-compilation-finished-hook + (slime-make-xref-recompilation-cont (list dspec)) + nil) + (slime-recompile-location location))) + +(defun slime-recompile-all-xrefs () + (interactive) + (let ((dspecs) (locations)) + (dolist (xref (slime-all-xrefs)) + (when (slime-xref-has-location-p xref) + (push (slime-xref.dspec xref) dspecs) + (push (slime-xref.location xref) locations))) + (add-hook 'slime-compilation-finished-hook + (slime-make-xref-recompilation-cont dspecs) + nil) + (slime-recompile-locations locations))) + +(defun slime-make-xref-recompilation-cont (dspecs) + ;; Extreme long-windedness to insert status of recompilation; + ;; sometimes Elisp resembles more of an Ewwlisp. + (lexical-let ((dspecs dspecs) (buffer (current-buffer))) + (labels ((recompilation-cont (&rest args) + (with-current-buffer buffer + (remove-hook 'slime-compilation-finished-hook + #'recompilation-cont) + (save-excursion + (slime-xref-insert-recompilation-flags + dspecs (slime-compiler-results)))))) + #'recompilation-cont))) + +(defun slime-xref-insert-recompilation-flags (dspecs compilation-results) + (let* ((buffer-read-only nil) + (max-dspec-length (reduce #'max dspecs :key #'length :initial-value 0)) + (max-column (+ max-dspec-length 2))) ; 2 initial spaces + (beginning-of-buffer) + (loop for dspec in dspecs + for result in compilation-results + do (save-excursion + (search-forward dspec) + (dotimes (i (- max-column (current-column))) + (insert " ")) + (insert " ") + (insert (format "[%s]" + (case result + ((t) :success) + ((nil) :failure) + (t result)))))))) + (defun slime-xref-cleanup () "Delete overlays created by xref mode and kill the xref buffer." (sldb-delete-overlays) @@ -9080,6 +9203,11 @@ (list (nthcdr n seq)) (seq (> (length seq) n)))) +(defun slime-trim-whitespace (str) + (save-match-data + (string-match "^\\s-*\\(.*?\\)\\s-*$" str) + (match-string 1 str))) + ;;;;; Buffer related (defun slime-buffer-narrowed-p (&optional buffer) --- /project/slime/cvsroot/slime/ChangeLog 2008/07/05 13:38:25 1.1367 +++ /project/slime/cvsroot/slime/ChangeLog 2008/07/16 16:14:50 1.1368 @@ -1,3 +1,58 @@ +2008-07-16 Tobias C. Rittweiler + + Recompilation support added to xref buffers. You can now use + `C-c C-c' in an xref buffer to recompile the defun represented by + the xref at point. Similiarly, you can use `C-c C-k' to recompile + all xrefs displayed. + + For example, if you've changed a macro, and want to recompile all + the functions in the image which use that macro, you first call + `slime-who-macroexpands' (C-c C-w RET), and then issues `C-c C-k' + in the xref buffer that just popped up. + + [There's no guarantee that this will actually recompile all + functions that depend on the changed macro, as this obviously + depends on the quality of the backend's WHO-MACROEXPANDS + implementation.] + + * swank.lisp: Introduced the notion of a SWANK-COMPILATION-UNIT, + so we're able to compile different stuff comming from Slime one + after the other, and have compiler notes &c. collected in a + contiguous manner. + + (defstruct :swank-compilation-unit): New. Contains compilation + notes, compilation results, etc. + (*swank-compilation-unit*): New. Current Swank Compilation Unit. + (with-swank-compilation-unit): New. Like WITH-COMPILATION-UNIT. + (swank-compilation-unit-for-emacs): New. + (swank-compiler): Adapted; collect compilation stuff into the + current swank-compilation-unit. + (compile-string-for-emacs): Use WITH-SWANK-COMPILATION-UNIT. + (compile-file-for-emacs): Ditto. + + (*compiler-notes*, clear-compiler-notes): Removed. + (compiler-notes-for-emacs): Removed. + + * slime.el (slime-compilation-unit, slime-last-compilation-unit), + (slime-compiler-notes, slime-compiler-results): New/Adapted. + + (slime-make-compile-expression-for-swank): Factored out from + `slime-compile-string'. + (slime-recompile-location): New. + (slime-recompile-locations): New. + (slime-pop-to-location): &optional `where' arg can now also be + 'excursion to only reset the current-buffer, but not switch. + + (slime-xref-mode-map): Add `C-c C-c' and `C-c C-k'. + (slime-xref-dspec-at-point): New. + (slime-all-xrefs): New. + (slime-recompile-xref): New. + (slime-recompile-all-xrefs): New. + (slime-make-xref-recompilation-cont): New. + (slime-xref-inert-recompilation-flags): New. + + (slime-trim-whitespace): New utility. + 2008-07-05 Tobias C. Rittweiler * swank.lisp: Revert Melis' change from 2008-07-04; Global IO From trittweiler at common-lisp.net Wed Jul 16 18:44:28 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Wed, 16 Jul 2008 14:44:28 -0400 (EDT) Subject: [slime-cvs] CVS slime/contrib Message-ID: <20080716184428.380644204D@common-lisp.net> Update of /project/slime/cvsroot/slime/contrib In directory clnet:/tmp/cvs-serv27568/contrib Modified Files: swank-asdf.lisp ChangeLog Log Message: * swank-asdf.lisp (operate-on-system-for-emacs): Wrapped in WITH-SWANK-COMPILATION-UNIT. --- /project/slime/cvsroot/slime/contrib/swank-asdf.lisp 2008/05/19 13:12:56 1.3 +++ /project/slime/cvsroot/slime/contrib/swank-asdf.lisp 2008/07/16 18:44:27 1.4 @@ -15,9 +15,10 @@ (defslimefun operate-on-system-for-emacs (system-name operation &rest keywords) "Compile and load SYSTEM using ASDF. Record compiler notes signalled as `compiler-condition's." - (swank-compiler - (lambda () - (apply #'operate-on-system system-name operation keywords)))) + (with-swank-compilation-unit (:override nil) + (swank-compiler + (lambda () + (apply #'operate-on-system system-name operation keywords))))) (defun operate-on-system (system-name operation-name &rest keyword-args) "Perform OPERATION-NAME on SYSTEM-NAME using ASDF. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2008/06/07 11:46:15 1.107 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2008/07/16 18:44:28 1.108 @@ -1,3 +1,8 @@ +2008-07-16 Tobias C. Rittweiler + + * swank-asdf.lisp (operate-on-system-for-emacs): Wrapped in + WITH-SWANK-COMPILATION-UNIT. + 2008-06-07 Tobias C. Rittweiler * slime-parse.el (slime-cl-symbol-name), From trittweiler at common-lisp.net Wed Jul 16 19:18:51 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Wed, 16 Jul 2008 15:18:51 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080716191851.719567E0B6@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv32196 Modified Files: slime.el ChangeLog Log Message: * slime.el (slime-xref-dspec-at-point): Make more robust. (slime-xref-insert-recompilation-flags): Ditto. (slime-column-max): New. --- /project/slime/cvsroot/slime/slime.el 2008/07/16 16:14:50 1.945 +++ /project/slime/cvsroot/slime/slime.el 2008/07/16 19:18:51 1.946 @@ -6088,7 +6088,10 @@ (defun slime-xref-dspec-at-point () (save-excursion (beginning-of-line 1) - (slime-trim-whitespace (substring-no-properties (thing-at-point 'line))))) + (with-syntax-table lisp-mode-syntax-table + (forward-sexp) + (backward-sexp) + (slime-sexp-at-point)))) (defun slime-all-xrefs () (let ((xrefs nil)) @@ -6180,13 +6183,15 @@ (defun slime-xref-insert-recompilation-flags (dspecs compilation-results) (let* ((buffer-read-only nil) - (max-dspec-length (reduce #'max dspecs :key #'length :initial-value 0)) - (max-column (+ max-dspec-length 2))) ; 2 initial spaces + (max-column (slime-column-max))) (beginning-of-buffer) (loop for dspec in dspecs for result in compilation-results do (save-excursion - (search-forward dspec) + (loop for dspec-at-point = (progn (search-forward dspec) + (slime-xref-dspec-at-point)) + until (equal dspec-at-point dspec)) + (end-of-line) ; skip old status information. (dotimes (i (- max-column (current-column))) (insert " ")) (insert " ") @@ -9218,6 +9223,13 @@ (total (buffer-size))) (or (/= beg 1) (/= end (1+ total)))))) +(defun slime-column-max () + (save-excursion + (beginning-of-buffer) + (loop for column = (prog2 (end-of-line) (current-column) (forward-line)) + until (= (point) (point-max)) + maximizing column))) + ;;;;; CL symbols vs. Elisp symbols. (defun slime-cl-symbol-name (symbol) --- /project/slime/cvsroot/slime/ChangeLog 2008/07/16 16:14:50 1.1368 +++ /project/slime/cvsroot/slime/ChangeLog 2008/07/16 19:18:51 1.1369 @@ -1,5 +1,11 @@ 2008-07-16 Tobias C. Rittweiler + * slime.el (slime-xref-dspec-at-point): Make more robust. + (slime-xref-insert-recompilation-flags): Ditto. + (slime-column-max): New. + +2008-07-16 Tobias C. Rittweiler + Recompilation support added to xref buffers. You can now use `C-c C-c' in an xref buffer to recompile the defun represented by the xref at point. Similiarly, you can use `C-c C-k' to recompile From trittweiler at common-lisp.net Thu Jul 17 22:19:12 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Thu, 17 Jul 2008 18:19:12 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080717221912.8477A2F002@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv31342 Modified Files: swank-sbcl.lisp swank-backend.lisp slime.el ChangeLog Log Message: An explicit numeric value as prefix-arg given to `C-c C-c' will now represent the debug level the defun is compiled with; `C-u C-c C-c' defaults to maximum debug like before. (Now also works for recompilation commands in xref buffers.) * slime.el (slime-compilation-debug-level): Renamed from `slime-compile-with-maximum-debug'. (slime-normalize-optimization-level): New. (slime-compile-defun): Adapted accordingly. (slime-compile-region): Ditto. (slime-recompile-location): Added setting of debug-level. (slime-recompile-locations): Ditto. (slime-recompile-xref): Now takes debug-level prefix-arg. (slime-recompile-all-xrefs): Ditto. * swank-sbcl.lisp (defimplementation swank-compile-string): Adapted accordingly. --- /project/slime/cvsroot/slime/swank-sbcl.lisp 2008/07/05 11:48:11 1.198 +++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2008/07/17 22:19:11 1.199 @@ -460,7 +460,7 @@ ) #+#.(swank-backend::sbcl-with-symbol 'restrict-compiler-policy 'sb-ext) (when debug - (sb-ext:restrict-compiler-policy 'debug 3)) + (sb-ext:restrict-compiler-policy 'debug debug)) (flet ((compile-it (fn) (with-compilation-hooks () (with-compilation-unit @@ -783,7 +783,7 @@ (defimplementation call-with-debugging-environment (debugger-loop-fn) (declare (type function debugger-loop-fn)) (let* ((*sldb-stack-top* (or sb-debug:*stack-top-hint* (sb-di:top-frame))) - (sb-debug:*stack-top-hint* nil)) + (sb-debug:*stack-top-hint* nil)) (handler-bind ((sb-di:debug-condition (lambda (condition) (signal (make-condition --- /project/slime/cvsroot/slime/swank-backend.lisp 2008/07/05 11:48:12 1.133 +++ /project/slime/cvsroot/slime/swank-backend.lisp 2008/07/17 22:19:12 1.134 @@ -346,8 +346,9 @@ rebind *DEFAULT-PATHNAME-DEFAULTS* which may improve the recording of source information. -If DEBUG is supplied, it may be used by certain implementations to -compile with maximum debugging information. +If DEBUG is supplied, and non-NIL, it may be used by certain +implementations to compile with a debug optimization quality of its +value.. ") (definterface swank-compile-file (filename load-p external-format) --- /project/slime/cvsroot/slime/slime.el 2008/07/16 19:18:51 1.946 +++ /project/slime/cvsroot/slime/slime.el 2008/07/17 22:19:12 1.947 @@ -3723,9 +3723,6 @@ ;;;; Compilation and the creation of compiler-note annotations -(defvar slime-compile-with-maximum-debug nil - "When non-nil compile defuns with maximum debug optimization.") - (defvar slime-highlight-compiler-notes t "*When non-nil annotate buffers with compilation notes etc.") @@ -3753,6 +3750,15 @@ :group 'slime-mode :type 'boolean) +(defvar slime-compilation-debug-level nil + "When non-nil compile defuns with this debug optimization level.") + +(defun slime-normalize-optimization-level (n) + (cond ((not n) nil) + ((> n 3) 3) + ((< n 0) 0) + (t n))) + (defstruct (slime-compilation-unit (:type list) (:conc-name slime-compilation-unit.) @@ -3805,10 +3811,16 @@ (slime-rcurry #'slime-compilation-finished (current-buffer))) (message "Compiling %s..." file))) -(defun slime-compile-defun (&optional maximum-debug-p) - "Compile the current toplevel form." +(defun slime-compile-defun (&optional raw-prefix-arg) + "Compile the current toplevel form. + +If invoked with a simple prefix-arg (`C-u'), compile the defun +with maximum debug setting. If invoked with a numeric prefix arg, +compile with a debug setting of that number." (interactive "P") - (let ((slime-compile-with-maximum-debug maximum-debug-p)) + (let* ((prefix-arg (and raw-prefix-arg (prefix-numeric-value raw-prefix-arg))) + (debug-level (slime-normalize-optimization-level prefix-arg)) + (slime-compilation-debug-level debug-level)) (apply #'slime-compile-region (slime-region-for-defun-at-point)))) (defun slime-compile-region (start end) @@ -3834,7 +3846,7 @@ ,(buffer-name) ,start-offset ,(if (buffer-file-name) (file-name-directory (buffer-file-name))) - ',slime-compile-with-maximum-debug)) + ',slime-compilation-debug-level)) (defun slime-make-compilation-finished-continuation (current-buffer &optional emacs-snapshot) (lexical-let ((buffer current-buffer) (snapshot emacs-snapshot)) @@ -3909,12 +3921,12 @@ ;;; FIXME: Add maximum-debug-p. -(defun slime-recompile-location (location) +(defun slime-recompile-location (location &optional debug-level) (save-excursion (slime-pop-to-location location 'excursion) - (slime-compile-defun))) + (slime-compile-defun debug-level))) -(defun slime-recompile-locations (locations) +(defun slime-recompile-locations (locations &optional debug-level) (flet ((make-compile-expr (loc) (save-excursion (slime-pop-to-location loc 'excursion) @@ -3922,13 +3934,14 @@ (slime-make-compile-expression-for-swank (buffer-substring-no-properties start end) start))))) - (slime-eval-async - `(swank:with-swank-compilation-unit (:override t) - ;; We have to compile each location seperately because of - ;; buffer and offset tracking during notes generation. - ,@(loop for loc in locations - collect (make-compile-expr loc))) - (slime-make-compilation-finished-continuation (current-buffer))))) + (let ((slime-compilation-debug-level debug-level)) + (slime-eval-async + `(swank:with-swank-compilation-unit (:override t) + ;; We have to compile each location seperately because of + ;; buffer and offset tracking during notes generation. + ,@(loop for loc in locations + collect (make-compile-expr loc))) + (slime-make-compilation-finished-continuation (current-buffer)))))) ;;; FIXME: implement: @@ -6147,26 +6160,34 @@ (slime-xref-cleanup) (slime-set-emacs-snapshot snapshot))) -(defun slime-recompile-xref () - (interactive) - (let ((location (slime-xref-location-at-point)) - (dspec (slime-xref-dspec-at-point))) - (add-hook 'slime-compilation-finished-hook - (slime-make-xref-recompilation-cont (list dspec)) - nil) - (slime-recompile-location location))) - -(defun slime-recompile-all-xrefs () - (interactive) - (let ((dspecs) (locations)) - (dolist (xref (slime-all-xrefs)) - (when (slime-xref-has-location-p xref) - (push (slime-xref.dspec xref) dspecs) - (push (slime-xref.location xref) locations))) - (add-hook 'slime-compilation-finished-hook - (slime-make-xref-recompilation-cont dspecs) - nil) - (slime-recompile-locations locations))) +(defun foo (&optional p) + (interactive "p") + (message "%S" p)) + +(defun slime-recompile-xref (&optional raw-prefix-arg) + (interactive "P") + (let* ((prefix-arg (and raw-prefix-arg (prefix-numeric-value raw-prefix-arg))) + (debug-level (slime-normalize-optimization-level prefix-arg))) + (let ((location (slime-xref-location-at-point)) + (dspec (slime-xref-dspec-at-point))) + (add-hook 'slime-compilation-finished-hook + (slime-make-xref-recompilation-cont (list dspec)) + nil) + (slime-recompile-location location debug-level)))) + +(defun slime-recompile-all-xrefs (&optional raw-prefix-arg) + (interactive "P") + (let* ((prefix-arg (and raw-prefix-arg (prefix-numeric-value raw-prefix-arg))) + (debug-level (slime-normalize-optimization-level prefix-arg))) + (let ((dspecs) (locations)) + (dolist (xref (slime-all-xrefs)) + (when (slime-xref-has-location-p xref) + (push (slime-xref.dspec xref) dspecs) + (push (slime-xref.location xref) locations))) + (add-hook 'slime-compilation-finished-hook + (slime-make-xref-recompilation-cont dspecs) + nil) + (slime-recompile-locations locations debug-level)))) (defun slime-make-xref-recompilation-cont (dspecs) ;; Extreme long-windedness to insert status of recompilation; --- /project/slime/cvsroot/slime/ChangeLog 2008/07/16 19:18:51 1.1369 +++ /project/slime/cvsroot/slime/ChangeLog 2008/07/17 22:19:12 1.1370 @@ -1,3 +1,23 @@ +2008-07-18 Tobias C. Rittweiler + + An explicit numeric value as prefix-arg given to `C-c C-c' will + now represent the debug level the defun is compiled with; + `C-u C-c C-c' defaults to maximum debug like before. (Now also + works for recompilation commands in xref buffers.) + + * slime.el (slime-compilation-debug-level): Renamed from + `slime-compile-with-maximum-debug'. + (slime-normalize-optimization-level): New. + (slime-compile-defun): Adapted accordingly. + (slime-compile-region): Ditto. + (slime-recompile-location): Added setting of debug-level. + (slime-recompile-locations): Ditto. + (slime-recompile-xref): Now takes debug-level prefix-arg. + (slime-recompile-all-xrefs): Ditto. + + * swank-sbcl.lisp (defimplementation swank-compile-string): + Adapted accordingly. + 2008-07-16 Tobias C. Rittweiler * slime.el (slime-xref-dspec-at-point): Make more robust. From trittweiler at common-lisp.net Thu Jul 17 22:49:36 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Thu, 17 Jul 2008 18:49:36 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080717224936.9D0EC50028@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv6903 Modified Files: slime.el ChangeLog Log Message: * slime.el (slime-recompile-locations): Locations were potentially recompiled within a wrong package. Fix that. --- /project/slime/cvsroot/slime/slime.el 2008/07/17 22:19:12 1.947 +++ /project/slime/cvsroot/slime/slime.el 2008/07/17 22:49:36 1.948 @@ -3919,8 +3919,6 @@ ;;;;; Recompilation. -;;; FIXME: Add maximum-debug-p. - (defun slime-recompile-location (location &optional debug-level) (save-excursion (slime-pop-to-location location 'excursion) @@ -3931,13 +3929,17 @@ (save-excursion (slime-pop-to-location loc 'excursion) (multiple-value-bind (start end) (slime-region-for-defun-at-point) - (slime-make-compile-expression-for-swank - (buffer-substring-no-properties start end) - start))))) + ;; FIXME: Kludge. The slime-eval-async may send a buffer-package + ;; that is not necessarily the same as the one the LOC points to. + `(cl:let ((swank::*buffer-package* (swank::guess-buffer-package + ,(slime-current-package)))) + ,(slime-make-compile-expression-for-swank + (buffer-substring-no-properties start end) + start)))))) (let ((slime-compilation-debug-level debug-level)) (slime-eval-async `(swank:with-swank-compilation-unit (:override t) - ;; We have to compile each location seperately because of + ;; We have to compile each location separately because of ;; buffer and offset tracking during notes generation. ,@(loop for loc in locations collect (make-compile-expr loc))) --- /project/slime/cvsroot/slime/ChangeLog 2008/07/17 22:19:12 1.1370 +++ /project/slime/cvsroot/slime/ChangeLog 2008/07/17 22:49:36 1.1371 @@ -1,5 +1,10 @@ 2008-07-18 Tobias C. Rittweiler + * slime.el (slime-recompile-locations): Locations were potentially + recompiled within a wrong package. Fix that. + +2008-07-18 Tobias C. Rittweiler + An explicit numeric value as prefix-arg given to `C-c C-c' will now represent the debug level the defun is compiled with; `C-u C-c C-c' defaults to maximum debug like before. (Now also From trittweiler at common-lisp.net Sat Jul 19 11:34:20 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Sat, 19 Jul 2008 07:34:20 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080719113420.2B79A7A001@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv30883 Modified Files: slime.el ChangeLog Log Message: REPL shortcuts now leave an appropriate Common Lisp form in the REPL history. * slime.el (slime-within-repl-shortcut-handler-p): New global. T if truly inside a repl shortcut handler invoked by ,foo on the REPL. (slime-handle-repl-shortcut): Bind above global appropriatly. (slime-repl-shortcut-eval): New; should be used in repl shortcut handlers instead of `slime-eval'. (slime-repl-shortcut-eval-async): New; should be used in repl shortcut handlers instead of `slime-eval-async'. (defslime-repl-shortcut): Update docstring. (slime-repl-set-package): Use slime-repl-shortcut-eval. (slime-set-default-directory): Ditto. (slime-sync-package-and-default-directory): Ditto. --- /project/slime/cvsroot/slime/slime.el 2008/07/17 22:49:36 1.948 +++ /project/slime/cvsroot/slime/slime.el 2008/07/19 11:34:19 1.949 @@ -3190,7 +3190,7 @@ (with-current-buffer (slime-output-buffer) (let ((unfinished-input (slime-repl-current-input))) (destructuring-bind (name prompt-string) - (slime-eval `(swank:set-package ,package)) + (slime-repl-shortcut-eval `(swank:set-package ,package)) (setf (slime-lisp-package) name) (setf (slime-lisp-package-prompt-string) prompt-string) (slime-repl-insert-prompt) @@ -3500,6 +3500,9 @@ (defvar slime-repl-shortcut-history '() "History list of shortcut command names.") +(defvar slime-within-repl-shortcut-handler-p nil + "Bound to T if we're in a REPL shortcut handler invoked from the REPL.") + (defun slime-handle-repl-shortcut () (interactive) (if (> (point) slime-repl-input-start-mark) @@ -3510,7 +3513,9 @@ (slime-list-all-repl-shortcuts)) nil t nil 'slime-repl-shortcut-history)))) - (call-interactively (slime-repl-shortcut.handler shortcut))))) + (with-struct (slime-repl-shortcut. handler) shortcut + (let ((slime-within-repl-shortcut-handler-p t)) + (call-interactively handler)))))) (defun slime-list-all-repl-shortcuts () (loop for shortcut in slime-repl-shortcut-table @@ -3522,10 +3527,13 @@ (defmacro defslime-repl-shortcut (elisp-name names &rest options) "Define a new repl shortcut. ELISP-NAME is a symbol specifying - the name of the interactive function to create, or NIL if no - function should be created. NAMES is a list of (full-name . - aliases). OPTIONS is an olist specifying the handler and the - help text." +the name of the interactive function to create, or NIL if no +function should be created. + +NAMES is a list of \(full-name . aliases\). + +OPTIONS is an plist specifying the handler doing the actual work +of the shortcut \(`:handler'\), and a help text \(`:one-liner'\)." `(progn ,(when elisp-name `(defun ,elisp-name () @@ -3542,6 +3550,23 @@ (push new-shortcut slime-repl-shortcut-table) ',elisp-name))) +(defun slime-repl-shortcut-eval (sexp &optional package) + "This function should be used by REPL shortcut handlers instead +of `slime-eval' to evaluate their final expansion. (This +expansion will be added to the REPL's history.)" + (when slime-within-repl-shortcut-handler-p ; were we invoked via ,foo? + (slime-repl-add-to-input-history (prin1-to-string sexp))) + (slime-eval sexp package)) + +(defun slime-repl-shortcut-eval-async (sexp &optional cont package) + "This function should be used by REPL shortcut handlers instead +of `slime-eval-async' to evaluate their final expansion. (This +expansion will be added to the REPL's history.)" + (when slime-within-repl-shortcut-handler-p ; were we invoked via ,foo? + (slime-repl-add-to-input-history (prin1-to-string sexp))) + (slime-eval-async sexp cont package)) + + (defun slime-list-repl-short-cuts () (interactive) (slime-with-output-to-temp-buffer ("*slime-repl-help*") nil @@ -3567,6 +3592,7 @@ (not (null buffer-file-name))))) (save-some-buffers))) + (defslime-repl-shortcut slime-repl-shortcut-help ("help" "?") (:handler 'slime-list-repl-short-cuts) (:one-liner "Display the help.")) @@ -3663,7 +3689,7 @@ (interactive (list (expand-file-name (read-file-name "File: " nil nil nil nil)))) (slime-save-some-lisp-buffers) - (slime-eval-async + (slime-repl-shortcut-eval-async `(swank:compile-file-if-needed ,(slime-to-lisp-filename filename) t) (slime-make-compilation-finished-continuation (current-buffer))))) @@ -5300,6 +5326,10 @@ (t (message "%s" value))))) fn))) +(defun slime-show-description (string package) + (slime-with-output-to-temp-buffer ("*SLIME Description*") + package (princ string))) + (defun slime-eval-describe (form) "Evaluate FORM in Lisp and display the result in a new buffer." (lexical-let ((package (slime-current-package))) @@ -5765,10 +5795,6 @@ 'common-lisp-hyperspec-history))))) (hyperspec-lookup symbol-name)) -(defun slime-show-description (string package) - (slime-with-output-to-temp-buffer ("*SLIME Description*") - package (princ string))) - (defun slime-describe-symbol (symbol-name) "Describe the symbol at point." (interactive (list (slime-read-symbol-name "Describe symbol: "))) @@ -6081,9 +6107,6 @@ (lexical-let ((type type) (symbol symbol) (package (slime-current-package)) - ;; We have to take the snapshot here, because SLIME-EVAL-ASYNC - ;; is invoking its continuation within the extent of a different - ;; buffer. (2007-08-14) (snapshot (slime-current-emacs-snapshot))) (lambda (result) (let ((file-alist (cadr (slime-analyze-xrefs result)))) @@ -6104,7 +6127,7 @@ (save-excursion (beginning-of-line 1) (with-syntax-table lisp-mode-syntax-table - (forward-sexp) + (forward-sexp) ; skip initial whitespaces (backward-sexp) (slime-sexp-at-point)))) @@ -6395,20 +6418,20 @@ (let ((dir (expand-file-name directory))) (message "default-directory: %s" (slime-from-lisp-filename - (slime-eval `(swank:set-default-directory - ,(slime-to-lisp-filename dir))))) + (slime-repl-shortcut-eval `(swank:set-default-directory + ,(slime-to-lisp-filename dir))))) (with-current-buffer (slime-output-buffer) (setq default-directory dir)))) (defun slime-sync-package-and-default-directory () "Set Lisp's package and directory to the values in current buffer." (interactive) - (let ((package (slime-eval `(swank:set-package - ,(slime-find-buffer-package)))) + (let ((package (slime-repl-shortcut-eval `(swank:set-package + ,(slime-find-buffer-package)))) (directory (slime-from-lisp-filename - (slime-eval `(swank:set-default-directory - ,(slime-to-lisp-filename - default-directory)))))) + (slime-repl-shortcut-eval `(swank:set-default-directory + ,(slime-to-lisp-filename + default-directory)))))) (let ((dir default-directory)) ;; Sync REPL dir (with-current-buffer (slime-output-buffer) --- /project/slime/cvsroot/slime/ChangeLog 2008/07/17 22:49:36 1.1371 +++ /project/slime/cvsroot/slime/ChangeLog 2008/07/19 11:34:19 1.1372 @@ -1,3 +1,21 @@ +2008-07-19 Tobias C. Rittweiler + + REPL shortcuts now leave an appropriate Common Lisp form in the + REPL history. + + * slime.el (slime-within-repl-shortcut-handler-p): New global. T + if truly inside a repl shortcut handler invoked by ,foo on the + REPL. + (slime-handle-repl-shortcut): Bind above global appropriatly. + (slime-repl-shortcut-eval): New; should be used in repl shortcut + handlers instead of `slime-eval'. + (slime-repl-shortcut-eval-async): New; should be used in repl + shortcut handlers instead of `slime-eval-async'. + (defslime-repl-shortcut): Update docstring. + (slime-repl-set-package): Use slime-repl-shortcut-eval. + (slime-set-default-directory): Ditto. + (slime-sync-package-and-default-directory): Ditto. + 2008-07-18 Tobias C. Rittweiler * slime.el (slime-recompile-locations): Locations were potentially From trittweiler at common-lisp.net Sat Jul 19 11:39:23 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Sat, 19 Jul 2008 07:39:23 -0400 (EDT) Subject: [slime-cvs] CVS slime/contrib Message-ID: <20080719113923.8814D6A16A@common-lisp.net> Update of /project/slime/cvsroot/slime/contrib In directory clnet:/tmp/cvs-serv31235/contrib Modified Files: slime-asdf.el ChangeLog Log Message: * slime-asdf.el (slime-oos): Use `slime-repl-shortcut-async'. --- /project/slime/cvsroot/slime/contrib/slime-asdf.el 2007/09/21 12:44:13 1.3 +++ /project/slime/cvsroot/slime/contrib/slime-asdf.el 2008/07/19 11:39:23 1.4 @@ -60,7 +60,7 @@ (message "Performing ASDF %S%s on system %S" operation (if keyword-args (format " %S" keyword-args) "") system) - (slime-eval-async + (slime-repl-shortcut-eval-async `(swank:operate-on-system-for-emacs ,system ,operation , at keyword-args) (slime-make-compilation-finished-continuation (current-buffer)))) --- /project/slime/cvsroot/slime/contrib/ChangeLog 2008/07/16 18:44:28 1.108 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2008/07/19 11:39:23 1.109 @@ -1,3 +1,7 @@ +2008-07-19 Tobias C. Rittweiler + + * slime-asdf.el (slime-oos): Use `slime-repl-shortcut-async'. + 2008-07-16 Tobias C. Rittweiler * swank-asdf.lisp (operate-on-system-for-emacs): Wrapped in From trittweiler at common-lisp.net Wed Jul 23 14:17:33 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Wed, 23 Jul 2008 10:17:33 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080723141733.2FCD86F23F@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv3271 Modified Files: slime.el Log Message: * slime.el (slime-at-list-p): New. Returns t if point is at a list. (slime-at-expression-p): New. Similiar to `slime-in-expression-p'. (slime-end-of-list): New. Pendant to `slime-beginning-of-list'. --- /project/slime/cvsroot/slime/slime.el 2008/07/19 11:34:19 1.949 +++ /project/slime/cvsroot/slime/slime.el 2008/07/23 14:17:32 1.950 @@ -5072,8 +5072,10 @@ dspec location) (defstruct (slime-location (:conc-name slime-location.) (:type list) - (:constructor nil) (:copier nil)) + (:constructor nil) + (:copier nil)) tag buffer position hints) + (defun slime-location-p (o) (and (consp o) (eq (car o) :location))) (defun slime-xref-has-location-p (xref) @@ -5647,6 +5649,19 @@ (t name)))) +(defun slime-at-list-p (&optional skip-blanks) + (save-excursion + (when skip-blanks + (slime-forward-blanks)) + (ignore-errors + (= (point) (progn (down-list 1) (backward-up-list 1) (point)))))) + +(defun slime-at-expression-p (pattern &optional skip-blanks) + (when (slime-at-list-p skip-blanks) + (save-excursion + (down-list 1) + (slime-in-expression-p pattern)))) + (defun slime-in-expression-p (pattern) "A helper function to determine the current context. The pattern can have the form: @@ -5678,12 +5693,17 @@ (cons (cons 1 (slime-pattern-path (car pattern))))))) (defun slime-beginning-of-list (&optional up) - "Move backward the the beginning of the current expression. + "Move backward to the beginning of the current expression. Point is placed before the first expression in the list." (backward-up-list (or up 1)) (down-list 1) (skip-syntax-forward " ")) +(defun slime-end-of-list (&optional up) + (backward-up-list (or up 1)) + (forward-list 1) + (backward-down-list 1)) + (defun slime-parse-toplevel-form () (ignore-errors ; (foo) (save-excursion @@ -6134,7 +6154,7 @@ (defun slime-all-xrefs () (let ((xrefs nil)) (save-excursion - (beginning-of-buffer) + (goto-char (point-min)) (while (ignore-errors (slime-next-line/not-add-newlines) t) (when-let (loc (get-text-property (point) 'slime-location)) (let* ((dspec (slime-xref-dspec-at-point)) @@ -6230,7 +6250,7 @@ (defun slime-xref-insert-recompilation-flags (dspecs compilation-results) (let* ((buffer-read-only nil) (max-column (slime-column-max))) - (beginning-of-buffer) + (goto-char (point-min)) (loop for dspec in dspecs for result in compilation-results do (save-excursion @@ -9271,7 +9291,7 @@ (defun slime-column-max () (save-excursion - (beginning-of-buffer) + (goto-char (point-min)) (loop for column = (prog2 (end-of-line) (current-column) (forward-line)) until (= (point) (point-max)) maximizing column))) From trittweiler at common-lisp.net Wed Jul 23 14:18:01 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Wed, 23 Jul 2008 10:18:01 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080723141801.B7CDF7913E@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv3388 Modified Files: ChangeLog Log Message: * slime.el (slime-at-list-p): New. Returns t if point is at a list. (slime-at-expression-p): New. Similiar to `slime-in-expression-p'. (slime-end-of-list): New. Pendant to `slime-beginning-of-list'. --- /project/slime/cvsroot/slime/ChangeLog 2008/07/19 11:34:19 1.1372 +++ /project/slime/cvsroot/slime/ChangeLog 2008/07/23 14:18:00 1.1373 @@ -1,3 +1,9 @@ +2008-07-23 Tobias C. Rittweiler + + * slime.el (slime-at-list-p): New. Returns t if point is at a list. + (slime-at-expression-p): New. Similiar to `slime-in-expression-p'. + (slime-end-of-list): New. Pendant to `slime-beginning-of-list'. + 2008-07-19 Tobias C. Rittweiler REPL shortcuts now leave an appropriate Common Lisp form in the From trittweiler at common-lisp.net Wed Jul 23 14:27:36 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Wed, 23 Jul 2008 10:27:36 -0400 (EDT) Subject: [slime-cvs] CVS slime/contrib Message-ID: <20080723142736.E848073205@common-lisp.net> Update of /project/slime/cvsroot/slime/contrib In directory clnet:/tmp/cvs-serv6974/contrib Modified Files: ChangeLog Added Files: swank-package-fu.lisp slime-package-fu.el Log Message: * slime-package-fu.el, swank-package-fu.lisp: New contrib to aumatically add symbols to the relevant DEFPACKAGE forms. You can use `C-c x' to export the symbol at point, and `C-u C-c x' to unexport it. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2008/07/19 11:39:23 1.109 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2008/07/23 14:27:36 1.110 @@ -1,5 +1,12 @@ 2008-07-19 Tobias C. Rittweiler + * slime-package-fu.el, swank-package-fu.lisp: New contrib to + aumatically add symbols to the relevant DEFPACKAGE forms. + You can use `C-c x' to export the symbol at point, and + `C-u C-c x' to unexport it. + +2008-07-19 Tobias C. Rittweiler + * slime-asdf.el (slime-oos): Use `slime-repl-shortcut-async'. 2008-07-16 Tobias C. Rittweiler --- /project/slime/cvsroot/slime/contrib/swank-package-fu.lisp 2008/07/23 14:27:36 NONE +++ /project/slime/cvsroot/slime/contrib/swank-package-fu.lisp 2008/07/23 14:27:36 1.1 (in-package :swank) (defslimefun package= (string1 string2) (let* ((pkg1 (guess-package string1)) (pkg2 (guess-package string2))) (and pkg1 pkg2 (eq pkg1 pkg2)))) (defslimefun export-symbol-for-emacs (symbol-str package-str) (let ((package (guess-package package-str))) (when package (let ((*buffer-package* package)) (export `(,(from-string symbol-str)) package))))) (defslimefun unexport-symbol-for-emacs (symbol-str package-str) (let ((package (guess-package package-str))) (when package (let ((*buffer-package* package)) (unexport `(,(from-string symbol-str)) package))))) (provide :swank-package-fu)--- /project/slime/cvsroot/slime/contrib/slime-package-fu.el 2008/07/23 14:27:36 NONE +++ /project/slime/cvsroot/slime/contrib/slime-package-fu.el 2008/07/23 14:27:36 1.1 ;;; slime-package-fu.el --- Exporting/Unexporting symbols at point. ;; ;; Author: Tobias C. Rittweiler ;; ;; License: GNU GPL (same license as Emacs) ;; (defvar slime-package-file-candidates (mapcar #'file-name-nondirectory '("package.lisp" "packages.lisp" "pkgdcl.lisp" "defpackage.lisp"))) (defvar slime-export-symbol-representation-function #'(lambda (n) (format "#:%s" n))) (defvar slime-defpackage-regexp "^(\\(cl:\\|common-lisp:\\)?defpackage\\>[ \t']*") (defun slime-find-package-definition-rpc (package) (slime-eval `(swank:find-definition-for-thing (swank::guess-package ,package)))) (defun slime-find-package-definition-regexp (package) (save-excursion (save-match-data (goto-char (point-min)) (block nil (while (re-search-forward slime-defpackage-regexp nil t) (when (slime-package-equal package (slime-sexp-at-point)) (return `(:location (:file ,(buffer-file-name)) ;; Return position of |(DEFPACKAGE ...) (:position ,(progn (backward-up-list 1) (point))) (:hints))))))))) (defun slime-package-equal (designator1 designator2) ;; First try to be lucky and compare the strings themselves (for the ;; case when one of the designated packages isn't loaded in the ;; image.) Then try to do it properly using the inferior Lisp which ;; will also resolve nicknames for us &c. (or (equalp (slime-cl-symbol-name designator1) (slime-cl-symbol-name designator2)) (slime-eval `(swank:package= ,designator1 ,designator2)))) (defun slime-export-symbol (symbol package) (slime-eval `(swank:export-symbol-for-emacs ,symbol ,package))) (defun slime-unexport-symbol (symbol package) (slime-eval `(swank:unexport-symbol-for-emacs ,symbol ,package))) (defun slime-find-possible-package-file (buffer-file-name) (flet ((file-name-subdirectory (dirname) (expand-file-name (concat (file-name-as-directory (slime-to-lisp-filename dirname)) (file-name-as-directory "..")))) (try (dirname) (dolist (package-file-name slime-package-file-candidates) (let ((f (slime-to-lisp-filename (concat dirname package-file-name)))) (when (file-readable-p f) (return f)))))) (when buffer-file-name (let ((buffer-cwd (file-name-directory buffer-file-name))) (or (try buffer-cwd) (try (file-name-subdirectory buffer-cwd)) (try (file-name-subdirectory (file-name-subdirectory buffer-cwd)))))))) (defun slime-goto-package-source-definition (package) (flet ((try (location) (when (slime-location-p location) (slime-pop-to-location location 'excursion) t))) (or (try (slime-find-package-definition-rpc package)) (try (slime-find-package-definition-regexp package)) (try (when-let (package-file (slime-find-possible-package-file (buffer-file-name))) (with-current-buffer (find-file-noselect package-file t) (slime-find-package-definition-regexp package)))) (error "Couldn't find source definition of package: %s" package)))) (defun slime-goto-next-export-clause () (let ((point)) (save-excursion (block nil (while (ignore-errors (slime-forward-sexp) t) (when (slime-at-expression-p '(:export *) :skip-blanks) (slime-forward-blanks) (setq point (point)) (return))))) (if point (goto-char point) (error "No next (:export ...) clause found")))) (defun slime-search-exports-in-defpackage (symbol-name) (save-excursion (block nil (while (ignore-errors (slime-goto-next-export-clause) t) (let ((clause-end (save-excursion (forward-sexp) (point)))) (when (and (search-forward symbol-name clause-end t) (equal (slime-symbol-name-at-point) symbol-name)) (return (point)))))))) (defun slime-frob-defpackage-form (current-package do-what symbol &optional batch) (let ((symbol-name (slime-cl-symbol-name symbol))) (save-excursion (slime-goto-package-source-definition current-package) (down-list 1) ; enter DEFPACKAGE form (forward-sexp) ; skip DEFPACKAGE symbol (forward-sexp) ; skip package name (let ((already-exported-p (slime-search-exports-in-defpackage symbol-name))) (ecase do-what (:export (if already-exported-p (unless batch (message "Symbol `%s' already exported in `%s'" symbol-name current-package)) (slime-insert-export symbol-name))) (:unexport (if already-exported-p (slime-remove-export symbol-name) (unless batch (message "Symbol `%s' not exported from `%s'" symbol-name current-package))))))))) (defun slime-insert-export (symbol-name) (flet ((goto-last-export-clause () (let (point) (save-excursion (while (ignore-errors (slime-goto-next-export-clause) t) (setq point (point)))) (when point (goto-char point)) point))) (let ((defpackage-point (point)) (symbol-name (funcall slime-export-symbol-representation-function symbol-name))) (cond ((goto-last-export-clause) (down-list) (slime-end-of-list) (unless (looking-back "^\\s-*") (newline-and-indent)) (insert symbol-name)) (t (slime-end-of-list) (newline-and-indent) (insert (format "(:export %s)" symbol-name))))))) (defun slime-remove-export (symbol-name) (let ((point)) (while (setq point (slime-search-exports-in-defpackage symbol-name)) (save-excursion (goto-char point) (backward-sexp) (delete-region (point) point) (beginning-of-line) (when (looking-at "^\\s-*$") (join-line)))))) (defun slime-export-symbol-at-point () "Add the symbol at point to the defpackage source definition belonging to the current buffer-package. With prefix-arg, remove the symbol again. Additionally performs an EXPORT/UNEXPORT of the symbol in the Lisp image if possible." (interactive) (let ((package (slime-current-package)) (symbol (slime-symbol-name-at-point))) (unless symbol (error "No symbol at point.")) (cond (current-prefix-arg (slime-frob-defpackage-form package :unexport symbol) (slime-unexport-symbol symbol package)) (t (slime-frob-defpackage-form package :export symbol) (slime-export-symbol symbol package))))) (defun slime-package-fu-init () (define-key slime-mode-map "\C-cx" 'slime-export-symbol-at-point)) (slime-require :swank-package-fu) (provide 'slime-package-fu) From trittweiler at common-lisp.net Wed Jul 23 14:29:10 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Wed, 23 Jul 2008 10:29:10 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080723142910.BB8F150AE@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv7168 Modified Files: swank-loader.lisp Log Message: * swank-loader.lisp (*contribs*): Added `swank-package-fu'. --- /project/slime/cvsroot/slime/swank-loader.lisp 2008/04/24 01:24:34 1.85 +++ /project/slime/cvsroot/slime/swank-loader.lisp 2008/07/23 14:29:10 1.86 @@ -185,6 +185,7 @@ swank-fancy-inspector swank-presentations swank-presentation-streams #+(or asdf sbcl) swank-asdf + swank-package-fu ) "List of names for contrib modules.") From trittweiler at common-lisp.net Wed Jul 23 14:29:27 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Wed, 23 Jul 2008 10:29:27 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080723142927.2DFB11C09F@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv7221 Modified Files: ChangeLog Log Message: * swank-loader.lisp (*contribs*): Added `swank-package-fu'. --- /project/slime/cvsroot/slime/ChangeLog 2008/07/23 14:18:00 1.1373 +++ /project/slime/cvsroot/slime/ChangeLog 2008/07/23 14:29:26 1.1374 @@ -1,5 +1,9 @@ 2008-07-23 Tobias C. Rittweiler + * swank-loader.lisp (*contribs*): Added `swank-package-fu'. + +2008-07-23 Tobias C. Rittweiler + * slime.el (slime-at-list-p): New. Returns t if point is at a list. (slime-at-expression-p): New. Similiar to `slime-in-expression-p'. (slime-end-of-list): New. Pendant to `slime-beginning-of-list'. From trittweiler at common-lisp.net Sat Jul 26 23:05:59 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Sat, 26 Jul 2008 19:05:59 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080726230559.C4D4A72091@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv16867 Modified Files: swank.lisp swank-sbcl.lisp swank-backend.lisp ChangeLog Log Message: * swank.lisp (swank-compiler): Fix bug when invoking an abort restart on a failed compilation attempt. * swank-sbcl.lisp (swank-compile-string): If a compilation attempt fails, COMPILE-FILE returns NIL which we tried to LOAD. Fix that. * swank-backend.lisp (swank-compile-string, swank-compile-file): Document return value. --- /project/slime/cvsroot/slime/swank.lisp 2008/07/16 16:14:50 1.547 +++ /project/slime/cvsroot/slime/swank.lisp 2008/07/26 23:05:59 1.548 @@ -46,7 +46,7 @@ #:buffer-first-change #:frame-source-location-for-emacs #:restart-frame - #:sldb-step + #:sldb-step #:sldb-break #:sldb-break-on-return #:profiled-functions @@ -1025,7 +1025,7 @@ (flet ((handler () (cond ((null *swank-state-stack*) (with-reader-error-handler (connection) - (process-available-input + (process-available-input client (lambda () (handle-request connection))))) ((eq (car *swank-state-stack*) :read-next-form)) (t @@ -2263,7 +2263,8 @@ (setf notes-p t) (record-note-for-condition c)))) (measure-time-interval function))) - (when result (setf result (if notes-p :complained t))) + (when result (setf result (if notes-p :complained t))) + (when (eql usecs t) (setf usecs 0)) ; compilation aborted. (push result (swank-compilation-unit.results *swank-compilation-unit*)) (push usecs (swank-compilation-unit.durations *swank-compilation-unit*)) (swank-compilation-unit-for-emacs *swank-compilation-unit*)))) --- /project/slime/cvsroot/slime/swank-sbcl.lisp 2008/07/17 22:19:11 1.199 +++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2008/07/26 23:05:59 1.200 @@ -461,20 +461,22 @@ #+#.(swank-backend::sbcl-with-symbol 'restrict-compiler-policy 'sb-ext) (when debug (sb-ext:restrict-compiler-policy 'debug debug)) - (flet ((compile-it (fn) + (flet ((load-it (filename) + (when filename (load filename))) + (compile-it (cont) (with-compilation-hooks () (with-compilation-unit (:source-plist (list :emacs-buffer buffer :emacs-directory directory :emacs-string string :emacs-position position)) - (funcall fn (compile-file filename)))))) + (funcall cont (compile-file filename)))))) (with-open-file (s filename :direction :output :if-exists :error) (write-string string s)) (unwind-protect (if *trap-load-time-warnings* - (compile-it #'load) - (load (compile-it #'identity))) + (compile-it #'load-it) + (load-it (compile-it #'identity))) (ignore-errors #+#.(swank-backend::sbcl-with-symbol 'restrict-compiler-policy 'sb-ext) @@ -527,16 +529,18 @@ (structure-class :structure-class) (class :class) (method-combination :method-combination) + (package :package) + (condition :condition) (structure-object :structure-object) (standard-object :standard-object) - (condition :condition) (t :thing))) (to-string (obj) (typecase obj + (package (princ-to-string obj)) ; Packages are possibly named entities. ((or structure-object standard-object condition) (with-output-to-string (s) (print-unreadable-object (obj s :type t :identity t)))) - (t (format nil "~A" obj))))) + (t (princ-to-string obj))))) (handler-case (make-definition-source-location (sb-introspect:find-definition-source obj) (general-type-of obj) (to-string obj)) @@ -751,7 +755,7 @@ #'(lambda (condition old-hook) ;; Notice that *INVOKE-DEBUGGER-HOOK* is tried before ;; *DEBUGGER-HOOK*, so we have to make sure that the latter gets - ;; run when it was established locally by a user. + ;; run when it was established locally by a user (i.e. changed meanwhile.) (if *debugger-hook* (funcall *debugger-hook* condition old-hook) (funcall hook condition old-hook)))) --- /project/slime/cvsroot/slime/swank-backend.lisp 2008/07/17 22:19:12 1.134 +++ /project/slime/cvsroot/slime/swank-backend.lisp 2008/07/26 23:05:59 1.135 @@ -348,14 +348,18 @@ If DEBUG is supplied, and non-NIL, it may be used by certain implementations to compile with a debug optimization quality of its -value.. +value. + +Should return T on successfull compilation, NIL otherwise. ") (definterface swank-compile-file (filename load-p external-format) "Compile FILENAME signalling COMPILE-CONDITIONs. If LOAD-P is true, load the file after compilation. EXTERNAL-FORMAT is a value returned by find-external-format or -:default.") +:default. + +Should return T on successfull compilation, NIL otherwise.") (deftype severity () '(member :error :read-error :warning :style-warning :note)) @@ -766,7 +770,7 @@ OBJECT. E.g. on a STANDARD-OBJECT, the source location of the respective DEFCLASS definition is returned, on a STRUCTURE-CLASS the respective DEFSTRUCT definition, and so on." - ;; This returns _ source location and not a list of locations. It's + ;; This returns one source location and not a list of locations. It's ;; supposed to return the location of the DEFGENERIC definition on ;; #'SOME-GENERIC-FUNCTION. ) --- /project/slime/cvsroot/slime/ChangeLog 2008/07/23 14:29:26 1.1374 +++ /project/slime/cvsroot/slime/ChangeLog 2008/07/26 23:05:59 1.1375 @@ -1,3 +1,14 @@ +2008-07-27 Tobias C. Rittweiler + + * swank.lisp (swank-compiler): Fix bug when invoking an abort + restart on a failed compilation attempt. + + * swank-sbcl.lisp (swank-compile-string): If a compilation attempt + fails, COMPILE-FILE returns NIL which we tried to LOAD. Fix that. + + * swank-backend.lisp (swank-compile-string, swank-compile-file): + Document return value. + 2008-07-23 Tobias C. Rittweiler * swank-loader.lisp (*contribs*): Added `swank-package-fu'. From heller at common-lisp.net Tue Jul 29 11:03:20 2008 From: heller at common-lisp.net (heller) Date: Tue, 29 Jul 2008 07:03:20 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080729110320.0C7947E011@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv2889 Modified Files: ChangeLog slime.el Log Message: Fix slime-quit-lisp in non-default REPL buffer. Patch from Richard M Kreuter. * slime.el (slime-quit-lisp): Killing the REPL buffer also removes the buffer local binding of slime-buffer-connection. Remember the connection before killing the buffer. --- /project/slime/cvsroot/slime/ChangeLog 2008/07/26 23:05:59 1.1375 +++ /project/slime/cvsroot/slime/ChangeLog 2008/07/29 11:03:20 1.1376 @@ -1,3 +1,11 @@ +2008-07-29 Richard M Kreuter + + Fix slime-quit-lisp in non-default REPL buffer. + + * slime.el (slime-quit-lisp): Killing the REPL buffer also removes + the buffer local binding of slime-buffer-connection. Remember the + connection before killing the buffer. + 2008-07-27 Tobias C. Rittweiler * swank.lisp (swank-compiler): Fix bug when invoking an abort --- /project/slime/cvsroot/slime/slime.el 2008/07/23 14:17:32 1.950 +++ /project/slime/cvsroot/slime/slime.el 2008/07/29 11:03:20 1.951 @@ -6419,9 +6419,10 @@ "Quit lisp, kill the inferior process and associated buffers." (interactive) (slime-eval-async '(swank:quit-lisp)) - (kill-buffer (slime-output-buffer)) - (set-process-filter (slime-connection) nil) - (set-process-sentinel (slime-connection) 'slime-quit-sentinel)) + (let ((connection (slime-connection))) + (kill-buffer (slime-output-buffer)) + (set-process-filter connection nil) + (set-process-sentinel connection 'slime-quit-sentinel))) (defun slime-quit-sentinel (process message) (assert (process-status process) 'closed) From heller at common-lisp.net Tue Jul 29 11:03:26 2008 From: heller at common-lisp.net (heller) Date: Tue, 29 Jul 2008 07:03:26 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080729110326.1F4457E011@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv2916 Modified Files: ChangeLog swank-sbcl.lisp Log Message: * swank-sbcl.lisp (add-sigio-handler, add-fd-handler): Be quiet as a workaround for non-properly initialized *debug-io*. Patch from Richard M Kreuter. --- /project/slime/cvsroot/slime/ChangeLog 2008/07/29 11:03:20 1.1376 +++ /project/slime/cvsroot/slime/ChangeLog 2008/07/29 11:03:25 1.1377 @@ -1,5 +1,10 @@ 2008-07-29 Richard M Kreuter + * swank-sbcl.lisp (add-sigio-handler, add-fd-handler): Be quiet + as a workaround for non-properly initialized *debug-io*. + +2008-07-29 Richard M Kreuter + Fix slime-quit-lisp in non-default REPL buffer. * slime.el (slime-quit-lisp): Killing the REPL buffer also removes --- /project/slime/cvsroot/slime/swank-sbcl.lisp 2008/07/26 23:05:59 1.200 +++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2008/07/29 11:03:25 1.201 @@ -133,7 +133,6 @@ (defimplementation add-sigio-handler (socket fn) (set-sigio-handler) (let ((fd (socket-fd socket))) - (format *debug-io* "Adding sigio handler: ~S ~%" fd) (enable-sigio-on-fd fd) (push (cons fd fn) *sigio-handlers*))) @@ -146,7 +145,6 @@ (defimplementation add-fd-handler (socket fn) (declare (type function fn)) (let ((fd (socket-fd socket))) - (format *debug-io* "; Adding fd handler: ~S ~%" fd) (sb-sys:add-fd-handler fd :input (lambda (_) _ (funcall fn))))) From heller at common-lisp.net Tue Jul 29 11:03:32 2008 From: heller at common-lisp.net (heller) Date: Tue, 29 Jul 2008 07:03:32 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080729110332.368B05F05C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv2958 Modified Files: ChangeLog NEWS slime.el Log Message: Environment variables for Lisp process. Patch by Richard M Kreuter. * slime.el (slime-start, slime-maybe-start-lisp) (slime-reinitialize-inferior-lisp-p, slime-start-lisp) (slime-restart-sentinel): Pass new parameter "env" through. --- /project/slime/cvsroot/slime/ChangeLog 2008/07/29 11:03:25 1.1377 +++ /project/slime/cvsroot/slime/ChangeLog 2008/07/29 11:03:31 1.1378 @@ -1,5 +1,13 @@ 2008-07-29 Richard M Kreuter + Environment variables for Lisp process. + + * slime.el (slime-start, slime-maybe-start-lisp) + (slime-reinitialize-inferior-lisp-p, slime-start-lisp) + (slime-restart-sentinel): Pass new parameter "env" through. + +2008-07-29 Richard M Kreuter + * swank-sbcl.lisp (add-sigio-handler, add-fd-handler): Be quiet as a workaround for non-properly initialized *debug-io*. --- /project/slime/cvsroot/slime/NEWS 2007/11/27 11:50:13 1.9 +++ /project/slime/cvsroot/slime/NEWS 2008/07/29 11:03:31 1.10 @@ -2,6 +2,15 @@ * 3.0 (not released yet) +** Environment variables for Lisp process +slime-lisp-implementations can be used to specify a list of strings to +augment the process environment of the Lisp process. E.g.: + + (sbcl-cvs + ("/home/me/sbcl-cvs/src/runtime/sbcl" + "--core" "/home/me/sbcl-cvs/output/sbcl.core") + :env ("SBCL_HOME=/home/me/sbcl-cvs/contrib/")) + ** Removed Features Some of the more esoteric features, like presentations or fuzzy completion, are no longer enabled by default. A new directory --- /project/slime/cvsroot/slime/slime.el 2008/07/29 11:03:20 1.951 +++ /project/slime/cvsroot/slime/slime.el 2008/07/29 11:03:31 1.952 @@ -1125,14 +1125,15 @@ (init 'slime-init-command) name (buffer "*inferior-lisp*") - init-function) + init-function + env) (let ((args (list :program program :program-args program-args :buffer buffer :coding-system coding-system :init init :name name - :init-function init-function))) + :init-function init-function :env env))) (slime-check-coding-system coding-system) (when (slime-bytecode-stale-p) (slime-urge-bytecode-recompile)) - (let ((proc (slime-maybe-start-lisp program program-args + (let ((proc (slime-maybe-start-lisp program program-args env directory buffer))) (slime-inferior-connect proc args) (pop-to-buffer (process-buffer proc))))) @@ -1240,33 +1241,34 @@ ;;; Starting the inferior Lisp and loading Swank: -(defun slime-maybe-start-lisp (program program-args directory buffer) +(defun slime-maybe-start-lisp (program program-args env directory buffer) "Return a new or existing inferior lisp process." (cond ((not (comint-check-proc buffer)) - (slime-start-lisp program program-args directory buffer)) - ((slime-reinitialize-inferior-lisp-p program program-args buffer) + (slime-start-lisp program program-args env directory buffer)) + ((slime-reinitialize-inferior-lisp-p program program-args env buffer) (when-let (conn (find (get-buffer-process buffer) slime-net-processes :key #'slime-inferior-process)) (slime-net-close conn)) (get-buffer-process buffer)) - (t (slime-start-lisp program program-args - directory + (t (slime-start-lisp program program-args env directory (generate-new-buffer-name buffer))))) -(defun slime-reinitialize-inferior-lisp-p (program program-args buffer) +(defun slime-reinitialize-inferior-lisp-p (program program-args env buffer) (let ((args (slime-inferior-lisp-args (get-buffer-process buffer)))) (and (equal (plist-get args :program) program) (equal (plist-get args :program-args) program-args) + (equal (plist-get args :env) env) (not (y-or-n-p "Create an additional *inferior-lisp*? "))))) -(defun slime-start-lisp (program program-args directory buffer) +(defun slime-start-lisp (program program-args env directory buffer) "Does the same as `inferior-lisp' but less ugly. Return the created process." (with-current-buffer (get-buffer-create buffer) (when directory (cd (expand-file-name directory))) (comint-mode) - (comint-exec (current-buffer) "inferior-lisp" program nil program-args) + (let ((process-environment (append env process-environment))) + (comint-exec (current-buffer) "inferior-lisp" program nil program-args)) (lisp-mode-variables t) (let ((proc (get-buffer-process (current-buffer)))) (slime-set-query-on-exit-flag proc) @@ -3705,7 +3707,7 @@ (slime-eval-async '(swank:quit-lisp)) (set-process-filter (slime-connection) nil) (set-process-sentinel (slime-connection) 'slime-restart-sentinel)) - + (defun slime-restart-sentinel (process message) "Restart the inferior lisp process. Also rearrange windows." @@ -3716,6 +3718,7 @@ (buffer-window (get-buffer-window buffer)) (new-proc (slime-start-lisp (plist-get args :program) (plist-get args :program-args) + (plist-get args :env) nil buffer)) (repl-buffer (slime-repl-buffer nil process)) @@ -5575,7 +5578,7 @@ (((:labels :flet) &rest _) (slime-read-from-minibuffer "(Un)trace local function: " (prin1-to-string spec))) - (t (error "Don't know how to trace the spec ~S" spec)))))) + (t (error "Don't know how to trace the spec %S" spec)))))) (defun slime-extract-context () "Parse the context for the symbol at point. @@ -6049,7 +6052,7 @@ XREF-ALIST is of the form ((GROUP . ((LABEL LOCATION) ...)) ...). GROUP and LABEL are for decoration purposes. LOCATION is a source-location." - (loop for (group . refs) in xrefs do + (loop for (group . refs) in xref-alist do (slime-insert-propertized '(face bold) group "\n") (loop for (label location) in refs do (slime-insert-propertized (list 'slime-location location @@ -8620,7 +8623,7 @@ (let ((slime-buffer-package "SWANK") (symbol '*buffer-package*)) (slime-edit-definition (symbol-name symbol)) - (slime-check ("Checking that we've got M-. into swank.lisp." symbol) + (slime-check ("Checking that we've got M-. into swank.lisp. %S" symbol) (string= (file-name-nondirectory (buffer-file-name)) "swank.lisp")) (slime-pop-find-definition-stack) From trittweiler at common-lisp.net Thu Jul 31 08:31:32 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Thu, 31 Jul 2008 04:31:32 -0400 (EDT) Subject: [slime-cvs] CVS slime Message-ID: <20080731083132.D4BA25F05C@common-lisp.net> Update of /project/slime/cvsroot/slime In directory clnet:/tmp/cvs-serv12558 Modified Files: slime.el ChangeLog Log Message: * slime.el (make-slime-buffer-location): New. (make-slime-file-location): New. --- /project/slime/cvsroot/slime/slime.el 2008/07/29 11:03:31 1.952 +++ /project/slime/cvsroot/slime/slime.el 2008/07/31 08:31:30 1.953 @@ -5084,6 +5084,13 @@ (defun slime-xref-has-location-p (xref) (slime-location-p (slime-xref.location xref))) +(defun make-slime-buffer-location (buffer-name position &optional hints) + `(:location (:buffer ,buffer-name) (:position ,position) + ,(if hints `(:hints ,hints) `(:hints)))) + +(defun make-slime-file-location (file-name position &optional hints) + `(:location (:file ,file-name) (:position ,position) + ,(if hints `(:hints ,hints) `(:hints)))) ;;; The hooks are tried in order until one succeeds, otherwise the ;;; default implementation involving `slime-find-definitions-function' --- /project/slime/cvsroot/slime/ChangeLog 2008/07/29 11:03:31 1.1378 +++ /project/slime/cvsroot/slime/ChangeLog 2008/07/31 08:31:32 1.1379 @@ -1,3 +1,8 @@ +2008-07-27 Tobias C. Rittweiler + + * slime.el (make-slime-buffer-location): New. + (make-slime-file-location): New. + 2008-07-29 Richard M Kreuter Environment variables for Lisp process. From trittweiler at common-lisp.net Thu Jul 31 08:35:40 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Thu, 31 Jul 2008 04:35:40 -0400 (EDT) Subject: [slime-cvs] CVS slime/contrib Message-ID: <20080731083540.259493E063@common-lisp.net> Update of /project/slime/cvsroot/slime/contrib In directory clnet:/tmp/cvs-serv13080/contrib Modified Files: slime-package-fu.el ChangeLog Log Message: * slime-package-fu.el (slime-find-package-definition-regexp): Use new constructor `make-slime-file-location'. (slime-frob-defpackage-form, slime-export-symbol-at-point): Now always display a message regarding success of the operation. (slime-package-fu-init-undo-stack, slime-package-fu-unload): New. --- /project/slime/cvsroot/slime/contrib/slime-package-fu.el 2008/07/23 14:27:36 1.1 +++ /project/slime/cvsroot/slime/contrib/slime-package-fu.el 2008/07/31 08:35:39 1.2 @@ -26,10 +26,7 @@ (block nil (while (re-search-forward slime-defpackage-regexp nil t) (when (slime-package-equal package (slime-sexp-at-point)) - (return `(:location (:file ,(buffer-file-name)) - ;; Return position of |(DEFPACKAGE ...) - (:position ,(progn (backward-up-list 1) (point))) - (:hints))))))))) + (return (make-slime-file-location ,(buffer-file-name) (point))))))))) (defun slime-package-equal (designator1 designator2) ;; First try to be lucky and compare the strings themselves (for the @@ -41,11 +38,14 @@ (slime-eval `(swank:package= ,designator1 ,designator2)))) (defun slime-export-symbol (symbol package) + "Unexport `symbol' from `package' in the Lisp image." (slime-eval `(swank:export-symbol-for-emacs ,symbol ,package))) (defun slime-unexport-symbol (symbol package) + "Export `symbol' from `package' in the Lisp image." (slime-eval `(swank:unexport-symbol-for-emacs ,symbol ,package))) + (defun slime-find-possible-package-file (buffer-file-name) (flet ((file-name-subdirectory (dirname) (expand-file-name @@ -62,8 +62,9 @@ (try (file-name-subdirectory buffer-cwd)) (try (file-name-subdirectory (file-name-subdirectory buffer-cwd)))))))) - (defun slime-goto-package-source-definition (package) + "Tries to find the DEFPACKAGE form of `package'. If found, +places the cursor at the start of the DEFPACKAGE form." (flet ((try (location) (when (slime-location-p location) (slime-pop-to-location location 'excursion) @@ -75,13 +76,15 @@ (slime-find-package-definition-regexp package)))) (error "Couldn't find source definition of package: %s" package)))) + (defun slime-goto-next-export-clause () + ;; Assumes we're inside the beginning of a DEFPACKAGE form. (let ((point)) (save-excursion (block nil (while (ignore-errors (slime-forward-sexp) t) - (when (slime-at-expression-p '(:export *) :skip-blanks) - (slime-forward-blanks) + (slime-forward-blanks) + (when (slime-at-expression-p '(:export *)) (setq point (point)) (return))))) (if point @@ -89,6 +92,8 @@ (error "No next (:export ...) clause found")))) (defun slime-search-exports-in-defpackage (symbol-name) + "Look if `symbol-name' is mentioned in one of the :EXPORT clauses." + ;; Assumes we're inside the beginning of a DEFPACKAGE form. (save-excursion (block nil (while (ignore-errors (slime-goto-next-export-clause) t) @@ -98,7 +103,13 @@ (return (point)))))))) -(defun slime-frob-defpackage-form (current-package do-what symbol &optional batch) +(defun slime-frob-defpackage-form (current-package do-what symbol) + "Adds/removes `symbol' from the DEFPACKAGE form of `current-package' +depending on the value of `do-what' which can either be `:export', +or `:unexport'. + +Returns t if the symbol was added/removed. Nil if the symbol was +already exported/unexported." (let ((symbol-name (slime-cl-symbol-name symbol))) (save-excursion (slime-goto-package-source-definition current-package) @@ -109,16 +120,16 @@ (ecase do-what (:export (if already-exported-p - (unless batch (message "Symbol `%s' already exported in `%s'" - symbol-name current-package)) - (slime-insert-export symbol-name))) + nil + (prog1 t (slime-insert-export symbol-name)))) (:unexport (if already-exported-p - (slime-remove-export symbol-name) - (unless batch (message "Symbol `%s' not exported from `%s'" - symbol-name current-package))))))))) + (prog1 t (slime-remove-export symbol-name)) + nil))))))) + (defun slime-insert-export (symbol-name) + ;; Assumes we're inside the beginning of a DEFPACKAGE form. (flet ((goto-last-export-clause () (let (point) (save-excursion @@ -140,6 +151,7 @@ (insert (format "(:export %s)" symbol-name))))))) (defun slime-remove-export (symbol-name) + ;; Assumes we're inside the beginning of a DEFPACKAGE form. (let ((point)) (while (setq point (slime-search-exports-in-defpackage symbol-name)) (save-excursion @@ -161,15 +173,28 @@ (symbol (slime-symbol-name-at-point))) (unless symbol (error "No symbol at point.")) (cond (current-prefix-arg - (slime-frob-defpackage-form package :unexport symbol) + (if (slime-frob-defpackage-form package :unexport symbol) + (message "Symbol `%s' no longer exported form `%s'" symbol package) + (message "Symbol `%s' is not exported from `%s'" symbol package)) (slime-unexport-symbol symbol package)) (t - (slime-frob-defpackage-form package :export symbol) + (if (slime-frob-defpackage-form package :export symbol) + (message "Symbol `%s' now exported from `%s'" symbol package) + (message "Symbol `%s' already exported from `%s'" symbol package)) (slime-export-symbol symbol package))))) + +(defvar slime-package-fu-init-undo-stack nil) + (defun slime-package-fu-init () + (slime-require :swank-package-fu) + (push `(progn (define-key slime-mode-map "\C-cx" + ',(lookup-key slime-mode-map "\C-cx"))) + slime-package-fu-init-undo-stack) (define-key slime-mode-map "\C-cx" 'slime-export-symbol-at-point)) -(slime-require :swank-package-fu) +(defun slime-package-fu-unload () + (while slime-c-p-c-init-undo-stack + (eval (pop slime-c-p-c-init-undo-stack)))) (provide 'slime-package-fu) \ No newline at end of file --- /project/slime/cvsroot/slime/contrib/ChangeLog 2008/07/23 14:27:36 1.110 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2008/07/31 08:35:40 1.111 @@ -1,9 +1,17 @@ +2008-07-31 Tobias C. Rittweiler + + * slime-package-fu.el (slime-find-package-definition-regexp): Use + new constructor `make-slime-file-location'. + (slime-frob-defpackage-form, slime-export-symbol-at-point): Now + always display a message regarding success of the operation. + (slime-package-fu-init-undo-stack, slime-package-fu-unload): New. + 2008-07-19 Tobias C. Rittweiler * slime-package-fu.el, swank-package-fu.lisp: New contrib to - aumatically add symbols to the relevant DEFPACKAGE forms. - You can use `C-c x' to export the symbol at point, and - `C-u C-c x' to unexport it. + automatically add symbols to the relevant DEFPACKAGE forms. You + can use `C-c x' to export the symbol at point, and `C-u C-c x' to + unexport it. 2008-07-19 Tobias C. Rittweiler From trittweiler at common-lisp.net Thu Jul 31 08:37:22 2008 From: trittweiler at common-lisp.net (trittweiler) Date: Thu, 31 Jul 2008 04:37:22 -0400 (EDT) Subject: [slime-cvs] CVS slime/contrib Message-ID: <20080731083722.98C444061@common-lisp.net> Update of /project/slime/cvsroot/slime/contrib In directory clnet:/tmp/cvs-serv13369/contrib Modified Files: ChangeLog Added Files: slime-mdot-fu.el Log Message: * slime-mdot-fu.el: New contrib. Makes M-. work on local definitions. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2008/07/31 08:35:40 1.111 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2008/07/31 08:37:22 1.112 @@ -1,5 +1,9 @@ 2008-07-31 Tobias C. Rittweiler + * slime-mdot-fu.el: New contrib. Makes M-. work on local definitions. + +2008-07-31 Tobias C. Rittweiler + * slime-package-fu.el (slime-find-package-definition-regexp): Use new constructor `make-slime-file-location'. (slime-frob-defpackage-form, slime-export-symbol-at-point): Now --- /project/slime/cvsroot/slime/contrib/slime-mdot-fu.el 2008/07/31 08:37:22 NONE +++ /project/slime/cvsroot/slime/contrib/slime-mdot-fu.el 2008/07/31 08:37:22 1.1 ;;; slime-mdot-fu.el --- Making M-. work on local functions. ;; ;; Author: Tobias C. Rittweiler ;; ;; License: GNU GPL (same license as Emacs) ;; (require 'slime-parse) (defvar slime-binding-ops-alist '((flet &bindings &body) (labels &bindings &body) (macrolet &bindings &body))) (defun slime-lookup-binding-op (op) (assoc* op slime-binding-ops-alist :test 'equalp :key 'symbol-name)) (defun slime-binding-op-p (op) (and (slime-lookup-binding-op op) t)) (defun slime-binding-op-body-pos (op) (when-let (special-lambda-list (slime-lookup-binding-op op)) (position '&body special-lambda-list))) (defun slime-binding-op-bindings-pos (op) (when-let (special-lambda-list (slime-lookup-binding-op op)) (position '&bindings special-lambda-list))) (defun slime-enclosing-bound-names () "Returns all bound function names as first value, and the points where their bindings are established as second value." (multiple-value-bind (ops indices points) (slime-enclosing-form-specs) (let ((binding-names) (binding-start-points)) (save-excursion (loop for (op . nil) in ops for index in indices for point in points do (when (and (slime-binding-op-p op) ;; Are the bindings of OP in scope? (= index (slime-binding-op-body-pos op))) (goto-char point) (forward-sexp (slime-binding-op-bindings-pos op)) (down-list) (ignore-errors (loop (down-list) (push (slime-symbol-name-at-point) binding-names) (push (save-excursion (backward-up-list) (point)) binding-start-points) (up-list))))) (values (nreverse binding-names) (nreverse binding-start-points)))))) (defun slime-edit-local-definition (name &optional where) "Like `slime-edit-definition', but tries to find the definition in a local function binding near point." (interactive (list (slime-read-symbol-name "Name: "))) (multiple-value-bind (binding-name point) (multiple-value-call #'some #'(lambda (binding-name point) (when (equalp binding-name name) (values binding-name point))) (slime-enclosing-bound-names)) (when (and binding-name point) (slime-edit-definition-cont `((,binding-name ,(make-slime-buffer-location (buffer-name (current-buffer)) point))) name where)))) (defun slime-mdot-fu-init () (add-hook 'slime-edit-definition-hooks 'slime-edit-local-definition)) (defun slime-mdot-fu-unload () (remove-hook 'slime-edit-definition-hooks 'slime-edit-local-definition)) (provide 'slime-mdot-fu)