From sboukarev at common-lisp.net Mon Dec 3 03:35:10 2012 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Sun, 02 Dec 2012 19:35:10 -0800 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory tiger.common-lisp.net:/tmp/cvs-serv9105 Modified Files: ChangeLog swank-allegro.lisp Log Message: * swank-allegro.lisp (macroexpand-all): USe walk-form, not walk on >= 8.2. Patch by Utz-Uwe Haus. --- /project/slime/cvsroot/slime/ChangeLog 2012/11/23 17:51:15 1.2371 +++ /project/slime/cvsroot/slime/ChangeLog 2012/12/03 03:35:09 1.2372 @@ -1,3 +1,9 @@ +2012-12-03 Stas Boukarev + + * swank-allegro.lisp (macroexpand-all): USe walk-form, not walk + on >= 8.2. + Patch by Utz-Uwe Haus. + 2012-11-23 Stas Boukarev * slime.el (slime-edit-definition): Don't ask the user for a name --- /project/slime/cvsroot/slime/swank-allegro.lisp 2012/11/11 09:30:53 1.156 +++ /project/slime/cvsroot/slime/swank-allegro.lisp 2012/12/03 03:35:09 1.157 @@ -108,6 +108,9 @@ (simple-error () :not-available))) (defimplementation macroexpand-all (form) + #+(version>= 8 0) + (excl::walk-form form) + #-(version>= 8 0) (excl::walk form)) (defimplementation describe-symbol-for-emacs (symbol) From sboukarev at common-lisp.net Mon Dec 3 03:43:16 2012 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Sun, 02 Dec 2012 19:43:16 -0800 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory tiger.common-lisp.net:/tmp/cvs-serv10895 Modified Files: ChangeLog swank-backend.lisp swank-ccl.lisp swank-sbcl.lisp Log Message: * swank-backend.lisp (deinit-log-output): Move from swank-sbcl, use it on CCL in ccl:*save-exit-functions* as well. --- /project/slime/cvsroot/slime/ChangeLog 2012/12/03 03:35:09 1.2372 +++ /project/slime/cvsroot/slime/ChangeLog 2012/12/03 03:43:16 1.2373 @@ -1,5 +1,8 @@ 2012-12-03 Stas Boukarev + * swank-backend.lisp (deinit-log-output): Move from swank-sbcl, + use it on CCL in ccl:*save-exit-functions* as well. + * swank-allegro.lisp (macroexpand-all): USe walk-form, not walk on >= 8.2. Patch by Utz-Uwe Haus. --- /project/slime/cvsroot/slime/swank-backend.lisp 2012/05/11 06:52:05 1.220 +++ /project/slime/cvsroot/slime/swank-backend.lisp 2012/12/03 03:43:16 1.221 @@ -1498,3 +1498,8 @@ "Request saving a heap image to the file FILENAME. RESTART-FUNCTION, if non-nil, should be called when the image is loaded. COMPLETION-FUNCTION, if non-nil, should be called after saving the image.") + +(defun deinit-log-output () + ;; Can't hang on to an fd-stream from a previous session. + (setf (symbol-value (find-symbol "*LOG-OUTPUT*" 'swank)) + nil)) --- /project/slime/cvsroot/slime/swank-ccl.lisp 2012/08/04 23:48:19 1.28 +++ /project/slime/cvsroot/slime/swank-ccl.lisp 2012/12/03 03:43:16 1.29 @@ -797,3 +797,5 @@ (defimplementation hash-table-weakness (hashtable) (ccl:hash-table-weak-p hashtable)) + +(pushnew 'deinit-log-output ccl:*save-exit-functions*) --- /project/slime/cvsroot/slime/swank-sbcl.lisp 2012/08/04 23:48:19 1.324 +++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2012/12/03 03:43:16 1.325 @@ -1860,9 +1860,4 @@ (funcall completion-function (zerop (sb-posix:wexitstatus status)))))))))))) -(defun deinit-log-output () - ;; Can't hang on to an fd-stream from a previous session. - (setf (symbol-value (find-symbol "*LOG-OUTPUT*" 'swank)) - nil)) - (pushnew 'deinit-log-output sb-ext:*save-hooks*) From heller at common-lisp.net Sun Dec 16 13:38:08 2012 From: heller at common-lisp.net (CVS User heller) Date: Sun, 16 Dec 2012 05:38:08 -0800 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory tiger.common-lisp.net:/tmp/cvs-serv8338 Modified Files: ChangeLog slime.el Log Message: * slime.el (slime-attempt-connection): Show the attempt counter. --- /project/slime/cvsroot/slime/ChangeLog 2012/12/03 03:43:16 1.2373 +++ /project/slime/cvsroot/slime/ChangeLog 2012/12/16 13:38:07 1.2374 @@ -1,3 +1,7 @@ +2012-12-16 Helmut Eller + + * slime.el (slime-attempt-connection): Show the attempt counter. + 2012-12-03 Stas Boukarev * swank-backend.lisp (deinit-log-output): Move from swank-sbcl, --- /project/slime/cvsroot/slime/slime.el 2012/11/23 17:51:16 1.1424 +++ /project/slime/cvsroot/slime/slime.el 2012/12/16 13:38:07 1.1425 @@ -1383,12 +1383,13 @@ (defun slime-attempt-connection (process retries attempt) ;; A small one-state machine to attempt a connection with ;; timer-based retries. - (let ((file (slime-swank-port-file))) + (slime-cancel-connect-retry-timer) + (let ((file (slime-swank-port-file))) (unless (active-minibuffer-window) - (message "Polling %S.. (Abort with `M-x slime-abort-connection'.)" file)) + (message "Polling %S .. %d (Abort with `M-x slime-abort-connection'.)" + file attempt)) (cond ((and (file-exists-p file) (> (nth 7 (file-attributes file)) 0)) ; file size - (slime-cancel-connect-retry-timer) (let ((port (slime-read-swank-port)) (args (slime-inferior-lisp-args process))) (slime-delete-swank-port-file 'message) @@ -1396,24 +1397,22 @@ (plist-get args :coding-system)))) (slime-set-inferior-process c process)))) ((and retries (zerop retries)) - (slime-cancel-connect-retry-timer) (message "Gave up connecting to Swank after %d attempts." attempt)) ((eq (process-status process) 'exit) - (slime-cancel-connect-retry-timer) (message "Failed to connect to Swank: inferior process exited.")) (t - (when (and (file-exists-p file) + (when (and (file-exists-p file) (zerop (nth 7 (file-attributes file)))) (message "(Zero length port file)") ;; the file may be in the filesystem but not yet written (unless retries (setq retries 3))) - (unless slime-connect-retry-timer - (setq slime-connect-retry-timer - (run-with-timer - 0.3 0.3 - #'slime-timer-call #'slime-attempt-connection - process (and retries (1- retries)) - (1+ attempt)))))))) + (assert (not slime-connect-retry-timer)) + (setq slime-connect-retry-timer + (run-with-timer + 0.3 0.3 + #'slime-timer-call #'slime-attempt-connection + process (and retries (1- retries)) + (1+ attempt))))))) (defun slime-timer-call (fun &rest args) "Call function FUN with ARGS, reporting all errors. From heller at common-lisp.net Sun Dec 16 13:38:21 2012 From: heller at common-lisp.net (CVS User heller) Date: Sun, 16 Dec 2012 05:38:21 -0800 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory tiger.common-lisp.net:/tmp/cvs-serv8399 Modified Files: ChangeLog swank.lisp Log Message: * swank.lisp (thread-for-evaluation): Make generic. Remove keyword arg. Don't call find-repl-thread. --- /project/slime/cvsroot/slime/ChangeLog 2012/12/16 13:38:07 1.2374 +++ /project/slime/cvsroot/slime/ChangeLog 2012/12/16 13:38:21 1.2375 @@ -1,5 +1,10 @@ 2012-12-16 Helmut Eller + * swank.lisp (thread-for-evaluation): Make generic. Remove keyword + arg. Don't call find-repl-thread. + +2012-12-16 Helmut Eller + * slime.el (slime-attempt-connection): Show the attempt counter. 2012-12-03 Stas Boukarev --- /project/slime/cvsroot/slime/swank.lisp 2012/11/13 15:44:40 1.798 +++ /project/slime/cvsroot/slime/swank.lisp 2012/12/16 13:38:21 1.799 @@ -997,26 +997,21 @@ (force-output stream) (sleep *auto-flush-interval*))) -;; FIXME: drop dependency on find-repl-thread -(defun thread-for-evaluation (connection id &key find-existing) - "Find or create a thread to evaluate the next request." - (etypecase id - ((member t) - (etypecase connection - (multithreaded-connection - (if find-existing - (or (car (mconn.active-threads connection)) - (find-repl-thread connection)) - (spawn-worker-thread connection))) - (singlethreaded-connection (current-thread)))) - ((member :repl-thread) - (find-repl-thread connection)) - (fixnum - (find-thread id)))) +(defgeneric thread-for-evaluation (connection id) + (:documentation "Find or create a thread to evaluate the next request.") + (:method ((connection multithreaded-connection) (id (eql t))) + (spawn-worker-thread connection)) + (:method ((connection multithreaded-connection) (id (eql :find-existing))) + (car (mconn.active-threads connection))) + (:method (connection (id fixnum)) + (find-thread id)) + (:method ((connection singlethreaded-connection) id) + (current-thread))) (defun interrupt-worker-thread (connection id) - (let ((thread (thread-for-evaluation connection id - :find-existing t))) + (let ((thread (thread-for-evaluation connection + (cond ((eq id t) :find-existing) + (t id))))) (log-event "interrupt-worker-thread: ~a ~a~%" id thread) (if thread (etypecase connection From heller at common-lisp.net Sun Dec 16 13:38:21 2012 From: heller at common-lisp.net (CVS User heller) Date: Sun, 16 Dec 2012 05:38:21 -0800 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory tiger.common-lisp.net:/tmp/cvs-serv8399/contrib Modified Files: ChangeLog swank-repl.lisp Log Message: * swank.lisp (thread-for-evaluation): Make generic. Remove keyword arg. Don't call find-repl-thread. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2012/11/28 20:53:22 1.558 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2012/12/16 13:38:21 1.559 @@ -1,3 +1,7 @@ +2012-12-16 Helmut Eller + + * swank-repl.lisp (thread-for-evaluation): Override some cases. + 2012-11-28 Stas Boukarev * swank-asdf.lisp (asdf-system-directory): Return a namestring, --- /project/slime/cvsroot/slime/contrib/swank-repl.lisp 2012/11/23 11:28:27 1.6 +++ /project/slime/cvsroot/slime/contrib/swank-repl.lisp 2012/12/16 13:38:21 1.7 @@ -85,6 +85,15 @@ (when socket (close-socket socket))))) +(defmethod thread-for-evaluation ((connection multithreaded-connection) + (id (eql :find-existing))) + (or (car (mconn.active-threads connection)) + (find-repl-thread connection))) + +(defmethod thread-for-evaluation ((connection multithreaded-connection) + (id (eql :repl-thread))) + (find-repl-thread connection)) + (defun find-repl-thread (connection) (cond ((not (use-threads-p)) (current-thread)) From sboukarev at common-lisp.net Mon Dec 17 11:14:48 2012 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Mon, 17 Dec 2012 03:14:48 -0800 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory tiger.common-lisp.net:/tmp/cvs-serv19908 Modified Files: ChangeLog swank.lisp Log Message: * swank.lisp (thread-for-evaluation): Use INTEGER, not FIXNUM, as a specializer, FIXNUM is not a standard class. --- /project/slime/cvsroot/slime/ChangeLog 2012/12/16 13:38:21 1.2375 +++ /project/slime/cvsroot/slime/ChangeLog 2012/12/17 11:14:48 1.2376 @@ -1,3 +1,8 @@ +2012-12-17 Stas Boukarev + + * swank.lisp (thread-for-evaluation): Use INTEGER, not FIXNUM, as + a specializer, FIXNUM is not a standard class. + 2012-12-16 Helmut Eller * swank.lisp (thread-for-evaluation): Make generic. Remove keyword --- /project/slime/cvsroot/slime/swank.lisp 2012/12/16 13:38:21 1.799 +++ /project/slime/cvsroot/slime/swank.lisp 2012/12/17 11:14:48 1.800 @@ -1003,7 +1003,7 @@ (spawn-worker-thread connection)) (:method ((connection multithreaded-connection) (id (eql :find-existing))) (car (mconn.active-threads connection))) - (:method (connection (id fixnum)) + (:method (connection (id integer)) (find-thread id)) (:method ((connection singlethreaded-connection) id) (current-thread))) From sboukarev at common-lisp.net Mon Dec 17 11:33:47 2012 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Mon, 17 Dec 2012 03:33:47 -0800 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory tiger.common-lisp.net:/tmp/cvs-serv27839 Modified Files: ChangeLog swank-ecl.lisp Log Message: * swank-ecl.lisp (swank-mop): MOP works well now, import all symbols. --- /project/slime/cvsroot/slime/ChangeLog 2012/12/17 11:14:48 1.2376 +++ /project/slime/cvsroot/slime/ChangeLog 2012/12/17 11:33:47 1.2377 @@ -1,5 +1,8 @@ 2012-12-17 Stas Boukarev + * swank-ecl.lisp (swank-mop): MOP works well now on ECL, import + all symbols. + * swank.lisp (thread-for-evaluation): Use INTEGER, not FIXNUM, as a specializer, FIXNUM is not a standard class. --- /project/slime/cvsroot/slime/swank-ecl.lisp 2012/11/09 21:28:40 1.78 +++ /project/slime/cvsroot/slime/swank-ecl.lisp 2012/12/17 11:33:47 1.79 @@ -10,14 +10,20 @@ (in-package :swank-backend) + + (eval-when (:compile-toplevel :load-toplevel :execute) - (let ((version (find-symbol "+ECL-VERSION-NUMBER+" :EXT))) - (when (or (not version) (< (symbol-value version) 100301)) - (error "~&IMPORTANT:~% ~ + (defun ecl-version () + (let ((version (find-symbol "+ECL-VERSION-NUMBER+" :EXT))) + (if version + (symbol-value version) + 0))) + (when (< (ecl-version) 100301) + (error "~&IMPORTANT:~% ~ The version of ECL you're using (~A) is too old.~% ~ Please upgrade to at least 10.3.1.~% ~ Sorry for the inconvenience.~%~%" - (lisp-implementation-version))))) + (lisp-implementation-version)))) ;; Hard dependencies. (eval-when (:compile-toplevel :load-toplevel :execute) @@ -38,14 +44,15 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (import-from :gray *gray-stream-symbols* :swank-backend) - - (import-swank-mop-symbols :clos - `(:eql-specializer - :eql-specializer-object - :generic-function-declarations - :specializer-direct-methods - ,@(unless (fboundp 'clos:compute-applicable-methods-using-classes) - '(:compute-applicable-methods-using-classes))))) + (import-swank-mop-symbols + :clos + (and (< (ecl-version) 121201) + `(:eql-specializer + :eql-specializer-object + :generic-function-declarations + :specializer-direct-methods + ,@(unless (fboundp 'clos:compute-applicable-methods-using-classes) + '(:compute-applicable-methods-using-classes)))))) ;;;; TCP Server From sboukarev at common-lisp.net Wed Dec 26 10:40:47 2012 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Wed, 26 Dec 2012 02:40:47 -0800 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory tiger.common-lisp.net:/tmp/cvs-serv20513 Modified Files: ChangeLog swank-asdf.lisp Log Message: * swank-asdf.lisp: Better support for different versions of ASDF. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2012/12/16 13:38:21 1.559 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2012/12/26 10:40:47 1.560 @@ -1,3 +1,7 @@ +2012-12-26 Francois-Rene Rideau + + * swank-asdf.lisp: Better support for different versions of ASDF. + 2012-12-16 Helmut Eller * swank-repl.lisp (thread-for-evaluation): Override some cases. --- /project/slime/cvsroot/slime/contrib/swank-asdf.lisp 2012/11/28 20:52:29 1.34 +++ /project/slime/cvsroot/slime/contrib/swank-asdf.lisp 2012/12/26 10:40:47 1.35 @@ -14,20 +14,28 @@ (defvar *asdf-directory* (merge-pathnames #p"cl/asdf/" (user-homedir-pathname)) "Directory in which your favorite and/or latest version - of the ASDF source code is located")) + of the ASDF source code is located") + (defvar *upgrade-asdf-p* nil + "Should we upgrade ASDF immediately upon startup? + This is recommended if you upgrade ASDF at all.")) ;;; Doing our best to load ASDF -;; First, try loading asdf from your implementation +;; First, try loading asdf from your implementation. +;; Use eval to not fail on old CLISP. (eval-when (:compile-toplevel :load-toplevel :execute) (unless (member :asdf *features*) - (ignore-errors (require "asdf")))) + (ignore-errors (eval '(require "asdf"))))) ;; If not found, load asdf from wherever the user specified it (eval-when (:compile-toplevel :load-toplevel :execute) (unless (member :asdf *features*) - (handler-bind ((warning #'muffle-warning)) - (ignore-errors (load (make-pathname :name "asdf" :type "lisp" - :defaults *asdf-directory*)))))) + (ignore-errors + (handler-bind ((warning #'muffle-warning)) + (let ((asdf-lisp (probe-file + (make-pathname :name "asdf" :type "lisp" + :defaults *asdf-directory*)))) + (when asdf-lisp (load asdf-lisp))))))) + ;; If still not found, error out. (eval-when (:compile-toplevel :load-toplevel :execute) (unless (member :asdf *features*) @@ -36,10 +44,11 @@ (defparameter swank::*asdf-directory* #p\"/path/containing/asdf/\")"))) ;;; If ASDF is found, try to upgrade it to the latest installed version. -;; (eval-when (:compile-toplevel :load-toplevel :execute) -;; (handler-bind ((warning #'muffle-warning)) -;; (pushnew *asdf-directory* asdf:*central-registry*) -;; (asdf:oos 'asdf:load-op :asdf))) +(eval-when (:compile-toplevel :load-toplevel :execute) + (when *upgrade-asdf-p* + (handler-bind ((warning #'muffle-warning)) + (pushnew *asdf-directory* asdf:*central-registry*) + (ignore-errors (asdf:oos 'asdf:load-op :asdf))))) ;;; If ASDF is too old, punt. (eval-when (:compile-toplevel :load-toplevel :execute) @@ -73,6 +82,9 @@ (declaim (notinline ,name)) (when (asdf-at-least ,version) (setf (fdefinition ',name) (fdefinition ',aname))))) + (defmethod* (version aname rest) + `(unless (asdf-at-least ,version) + (defmethod ,aname , at rest))) (defvar* (name aname rest) `(progn (define-symbol-macro ,name ,aname) @@ -83,6 +95,7 @@ :collect (ecase def ((defun) (defun* version name aname args)) + ((defmethod) (defmethod* version aname args)) ((defvar) (defvar* name aname args))))))) (asdefs "2.015" @@ -179,7 +192,8 @@ (lambda (dir) (collect-asds-in-directory dir collect)))) (defun system-source-directory (system-designator) - (pathname-directory-pathname (asdf::system-source-file system-designator))) + (asdf::pathname-directory-pathname + (asdf::system-source-file system-designator))) (defun filter-logical-directory-results (directory entries merger) (if (typep directory 'logical-pathname) @@ -229,7 +243,7 @@ directory dirs (let ((prefix (or (normalize-pathname-directory-component (pathname-directory directory)) - ;; because allegro returns NIL for #p"FOO:" + ;; because allegro 8.x returns NIL for #p"FOO:" '(:absolute)))) (lambda (d) (let ((dir (normalize-pathname-directory-component @@ -296,20 +310,22 @@ :version (make-pathname-component-logical (pathname-version f))))))))) +(asdefs "2.27" + (defmethod component-relative-pathname ((component asdf:component)) + (asdf::coerce-pathname + (or (and (slot-boundp component 'asdf::relative-pathname) + (slot-value component 'asdf::relative-pathname)) + (asdf::component-name component)) + :type (asdf::source-file-type component (asdf::component-system component)) + :defaults (asdf::component-parent-pathname component)))) + ;;; Taken from ASDF 1.628 (defmacro while-collecting ((&rest collectors) &body body) - (let ((vars (mapcar (lambda (x) (gensym (symbol-name x))) collectors)) - (initial-values (mapcar (constantly nil) collectors))) - `(let ,(mapcar #'list vars initial-values) - (flet ,(mapcar (lambda (c v) `(,c (x) (push x ,v) (values))) - collectors vars) - , at body - (values ,@(mapcar (lambda (v) `(reverse ,v)) vars)))))) - + `(asdf::while-collecting ,collectors , at body)) ;;; Now for SLIME-specific stuff -(defun find-operation (operation) +(defun asdf-operation (operation) (or (find-symbol* operation :asdf) (error "Couldn't find ASDF operation ~S" operation))) @@ -342,7 +358,8 @@ (defmethod asdf:component-pathname :around ((component asdf:component)) (let ((p (call-next-method))) - (setf (gethash p *pathname-component*) component) + (when (pathnamep p) + (setf (gethash p *pathname-component*) component)) p)) (defun register-component-pathname (component) @@ -392,7 +409,7 @@ \(operate-on-system \"swank\" 'compile-op :force t)" (handler-case (with-compilation-hooks () - (apply #'asdf:operate (find-operation operation-name) + (apply #'asdf:operate (asdf-operation operation-name) system-name keyword-args) t) (asdf:compile-error () nil))) @@ -533,7 +550,8 @@ (when component ;;(format t "~&Compiling ASDF component ~S~%" component) (let ((op (make-instance 'asdf:compile-op))) - (asdf:perform op component) + (with-compilation-hooks () + (asdf:perform op component)) (when load-p (asdf:perform (make-instance 'asdf:load-op) component)) (values t t nil (first (asdf:output-files op component))))))) From sboukarev at common-lisp.net Thu Dec 27 20:22:35 2012 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Thu, 27 Dec 2012 12:22:35 -0800 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory tiger.common-lisp.net:/tmp/cvs-serv1490 Modified Files: ChangeLog swank.lisp Log Message: * swank.lisp (find-definitions-find-symbol-or-package): Rename from `find-definitions-find-symbol'. Packages are not named by symbols and an uninterned string can refer to a package. In case it finds a package, return a new uninterned symbol. --- /project/slime/cvsroot/slime/ChangeLog 2012/12/17 11:33:47 1.2377 +++ /project/slime/cvsroot/slime/ChangeLog 2012/12/27 20:22:35 1.2378 @@ -1,3 +1,10 @@ +2012-12-27 Stas Boukarev + + * swank.lisp (find-definitions-find-symbol-or-package): Rename + from `find-definitions-find-symbol'. Packages are not named by + symbols and an uninterned string can refer to a package. In case + it finds a package, return a new uninterned symbol. + 2012-12-17 Stas Boukarev * swank-ecl.lisp (swank-mop): MOP works well now on ECL, import --- /project/slime/cvsroot/slime/swank.lisp 2012/12/17 11:14:48 1.800 +++ /project/slime/cvsroot/slime/swank.lisp 2012/12/27 20:22:35 1.801 @@ -2927,17 +2927,22 @@ ((:sldb frame var) (frame-var-value frame var)))) -(defvar *find-definitions-right-trim* ",:.") -(defvar *find-definitions-left-trim* "#:") +(defvar *find-definitions-right-trim* ",:.>") +(defvar *find-definitions-left-trim* "#:<") -(defun find-definitions-find-symbol (name) +(defun find-definitions-find-symbol-or-package (name) (flet ((do-find (name) - (multiple-value-bind (symbol found) + (multiple-value-bind (symbol found name) (with-buffer-syntax () (parse-symbol name)) - (when found - (return-from find-definitions-find-symbol - (values symbol found)))))) + (cond (found + (return-from find-definitions-find-symbol-or-package + (values symbol found))) + ;; Packages are not named by symbols, so + ;; not-interned symbols can refer to packages + ((find-package name) + (return-from find-definitions-find-symbol-or-package + (values (make-symbol name) t))))))) (do-find name) (do-find (string-right-trim *find-definitions-right-trim* name)) (do-find (string-left-trim *find-definitions-left-trim* name)) @@ -2949,7 +2954,7 @@ "Return a list ((DSPEC LOCATION) ...) of definitions for NAME. DSPEC is a string and LOCATION a source location. NAME is a string." (multiple-value-bind (symbol found) - (find-definitions-find-symbol name) + (find-definitions-find-symbol-or-package name) (when found (mapcar #'xref>elisp (find-definitions symbol)))))