From sboukarev at common-lisp.net Thu Jan 3 12:40:52 2013 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Thu, 03 Jan 2013 04:40:52 -0800 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory tiger.common-lisp.net:/tmp/cvs-serv3420/contrib Modified Files: ChangeLog slime-cl-indent.el Log Message: * contrib/slime-cl-indent.el (define-common-lisp-style "basic"): Don't set `comment-column' to NIL, it only can accept integers. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2012/12/26 10:40:47 1.560 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2013/01/03 12:40:52 1.561 @@ -1,3 +1,8 @@ +2013-01-03 Stas Boukarev + + * slime-cl-indent.el (define-common-lisp-style "basic"): Don't set + `comment-column' to NIL, it only can accept integers. + 2012-12-26 Francois-Rene Rideau * swank-asdf.lisp: Better support for different versions of ASDF. --- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el 2012/04/13 16:16:11 1.67 +++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el 2013/01/03 12:40:52 1.68 @@ -438,8 +438,7 @@ (lisp-indent-defun-method (4 &lambda &body)) ;; Without these (;;foo would get a space inserted between ;; ( and ; by indent-sexp. - (comment-indent-function (lambda () nil)) - (comment-column nil))) + (comment-indent-function (lambda () nil)))) (define-common-lisp-style "classic" "This style of indentation emulates the most striking features of 1995 From sboukarev at common-lisp.net Fri Jan 4 18:22:01 2013 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Fri, 04 Jan 2013 10:22:01 -0800 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory tiger.common-lisp.net:/tmp/cvs-serv1471 Modified Files: ChangeLog slime-fancy-inspector.el Log Message: * slime-fancy-inspector.el (slime-edit-inspector-part): New function, tries to find a definition of the part at point. Hooks into `slime-edit-definition-hooks'. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2013/01/03 12:40:52 1.561 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2013/01/04 18:22:01 1.562 @@ -1,3 +1,9 @@ +2013-01-04 Stas Boukarev + + * slime-fancy-inspector.el (slime-edit-inspector-part): New + function, tries to find a definition of the part at point. Hooks + into `slime-edit-definition-hooks'. + 2013-01-03 Stas Boukarev * slime-cl-indent.el (define-common-lisp-style "basic"): Don't set --- /project/slime/cvsroot/slime/contrib/slime-fancy-inspector.el 2010/07/23 01:41:27 1.8 +++ /project/slime/cvsroot/slime/contrib/slime-fancy-inspector.el 2013/01/04 18:22:01 1.9 @@ -4,7 +4,11 @@ (:authors "Marco Baringer and others") (:license "GPL") (:slime-dependencies slime-parse) - (:swank-dependencies swank-fancy-inspector)) + (:swank-dependencies swank-fancy-inspector) + (:on-load + (add-hook 'slime-edit-definition-hooks 'slime-edit-inspector-part)) + (:on-unload + (remove-hook 'slime-edit-definition-hooks 'slime-edit-inspector-part))) (defun slime-inspect-definition () "Inspect definition at point" @@ -17,4 +21,30 @@ (slime-eval-describe `(swank:disassemble-form ,(slime-definition-at-point t)))) +(let* ((id (slime-presentation-id presentation)) + (presentation-string (format "Presentation %s" id)) + (location (slime-eval `(swank:find-definition-for-thing + (swank:lookup-presented-object + ',(slime-presentation-id presentation)))))) + (slime-edit-definition-cont + (and location (list (make-slime-xref :dspec `(,presentation-string) + :location location))) + presentation-string + where)) + +(defun slime-edit-inspector-part (name &optional where) + (destructuring-bind (&optional property value) + (slime-inspector-property-at-point) + (when (eq property 'slime-part-number) + (let ((location (slime-eval `(swank:find-definition-for-thing + (swank:inspector-nth-part ,value)))) + (name (format "Inspector part %s" value))) + (when (and (consp location) + (not (eq (car location) :error))) + (slime-edit-definition-cont + (list (make-slime-xref :dspec `(,name) + :location location)) + name + where)))))) + (provide 'slime-fancy-inspector) From heller at common-lisp.net Sat Jan 5 08:50:13 2013 From: heller at common-lisp.net (CVS User heller) Date: Sat, 05 Jan 2013 00:50:13 -0800 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory tiger.common-lisp.net:/tmp/cvs-serv26824 Modified Files: ChangeLog swank-loader.lisp Log Message: * swank-loader.lisp (init): Add a :quiet argument. --- /project/slime/cvsroot/slime/ChangeLog 2012/12/27 20:22:35 1.2378 +++ /project/slime/cvsroot/slime/ChangeLog 2013/01/05 08:50:12 1.2379 @@ -1,3 +1,7 @@ +2013-01-05 Helmut Eller + + * swank-loader.lisp (init): Add a :quiet argument. + 2012-12-27 Stas Boukarev * swank.lisp (find-definitions-find-symbol-or-package): Rename --- /project/slime/cvsroot/slime/swank-loader.lisp 2012/09/04 15:03:23 1.116 +++ /project/slime/cvsroot/slime/swank-loader.lisp 2013/01/05 08:50:12 1.117 @@ -156,7 +156,7 @@ (ignore-errors (delete-file pathname))) (abort)) -(defun compile-files (files fasl-dir load) +(defun compile-files (files fasl-dir load quiet) "Compile each file in FILES if the source is newer than its corresponding binary, or the file preceding it was recompiled. If LOAD is true, load the fasl file." @@ -174,13 +174,14 @@ ;; everything after this too. (setq needs-recompile t) (setq state :compile) - (or (compile-file src :output-file dest :print nil :verbose t) + (or (compile-file src :output-file dest :print nil + :verbose (not quiet)) ;; An implementation may not necessarily signal a ;; condition itself when COMPILE-FILE fails (e.g. ECL) (error "COMPILE-FILE returned NIL."))) (when load (setq state :load) - (load dest :verbose t))) + (load dest :verbose (not quiet)))) ;; Fail as early as possible (serious-condition (c) (ecase state @@ -189,13 +190,13 @@ (:unknown (handle-swank-load-error c "???ing" src))))))))) #+(or cormanlisp) -(defun compile-files (files fasl-dir load) +(defun compile-files (files fasl-dir load quiet) "Corman Lisp has trouble with compiled files." (declare (ignore fasl-dir)) (when load (dolist (file files) - (load file :verbose t) - (force-output)))) + (load file :verbose (not quiet) + (force-output))))) (defun load-user-init-file () "Load the user init file, return NIL if it does not exist." @@ -239,8 +240,9 @@ (append-dir base-dir "contrib")) (defun load-swank (&key (src-dir *source-directory*) - (fasl-dir *fasl-directory*)) - (compile-files (src-files *swank-files* src-dir) fasl-dir t) + (fasl-dir *fasl-directory*) + quiet) + (compile-files (src-files *swank-files* src-dir) fasl-dir t quiet) (funcall (q "swank::before-init") (slime-version-string) (list (contrib-dir fasl-dir) @@ -257,12 +259,12 @@ (defun compile-contribs (&key (src-dir (contrib-dir *source-directory*)) (fasl-dir (contrib-dir *fasl-directory*)) (swank-src-dir *source-directory*) - load) + load quiet) (let* ((swank-src-files (src-files *swank-files* swank-src-dir)) (contrib-src-files (src-files *contribs* src-dir))) (delete-stale-contrib-fasl-files swank-src-files contrib-src-files fasl-dir) - (compile-files contrib-src-files fasl-dir load))) + (compile-files contrib-src-files fasl-dir load quiet))) (defun loadup () (load-swank) @@ -277,7 +279,8 @@ (eval `(pushnew 'compile-contribs ,(q "swank::*after-init-hook*")))) (funcall (q "swank::init"))) -(defun init (&key delete reload load-contribs (setup t)) +(defun init (&key delete reload load-contribs (setup t) + (quiet (not *load-verbose*))) "Load SWANK and initialize some global variables. If DELETE is true, delete any existing SWANK packages. If RELOAD is true, reload SWANK, even if the SWANK package already exists. @@ -287,11 +290,11 @@ (when (and delete (find-package :swank)) (mapc #'delete-package '(:swank :swank-io-package :swank-backend))) (cond ((or (not (find-package :swank)) reload) - (load-swank)) - (t + (load-swank :quiet quiet)) + (t (warn "Not reloading SWANK. Package already exists."))) (when load-contribs - (compile-contribs :load t)) + (compile-contribs :load t :quiet quiet)) (when setup (setup))) From heller at common-lisp.net Sat Jan 5 08:50:24 2013 From: heller at common-lisp.net (CVS User heller) Date: Sat, 05 Jan 2013 00:50:24 -0800 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory tiger.common-lisp.net:/tmp/cvs-serv26874 Modified Files: ChangeLog swank-ccl.lisp Log Message: * swank-ccl.lisp (frame-package): Implemented. --- /project/slime/cvsroot/slime/ChangeLog 2013/01/05 08:50:12 1.2379 +++ /project/slime/cvsroot/slime/ChangeLog 2013/01/05 08:50:24 1.2380 @@ -1,5 +1,9 @@ 2013-01-05 Helmut Eller + * swank-ccl.lisp (frame-package): Implemented. + +2013-01-05 Helmut Eller + * swank-loader.lisp (init): Add a :quiet argument. 2012-12-27 Stas Boukarev --- /project/slime/cvsroot/slime/swank-ccl.lisp 2012/12/03 03:43:16 1.29 +++ /project/slime/cvsroot/slime/swank-ccl.lisp 2013/01/05 08:50:24 1.30 @@ -407,6 +407,20 @@ (pc-source-location lfun pc) (function-source-location lfun))))) +(defimplementation frame-package (frame-number) + (with-frame (p context) frame-number + (let* ((lfun (ccl:frame-function p context)) + (name (ccl:function-name lfun))) + (labels ((name-package (name) + (etypecase name + (null nil) + (symbol (symbol-package name)) + ((cons (eql setf) symbol) (symbol-package (cadr name))) + ((cons (eql :internal)) (name-package (car (last name)))) + ((cons (and symbol (not keyword)) (cons list null)) + (symbol-package (car name)))))) + (name-package name))))) + (defimplementation eval-in-frame (form index) (with-frame (p context) index (let ((vars (ccl:frame-named-variables p context))) From sboukarev at common-lisp.net Sat Jan 5 11:38:52 2013 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Sat, 05 Jan 2013 03:38:52 -0800 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory tiger.common-lisp.net:/tmp/cvs-serv29517 Modified Files: slime-fancy-inspector.el Log Message: Remove stray code. --- /project/slime/cvsroot/slime/contrib/slime-fancy-inspector.el 2013/01/04 18:22:01 1.9 +++ /project/slime/cvsroot/slime/contrib/slime-fancy-inspector.el 2013/01/05 11:38:52 1.10 @@ -21,17 +21,6 @@ (slime-eval-describe `(swank:disassemble-form ,(slime-definition-at-point t)))) -(let* ((id (slime-presentation-id presentation)) - (presentation-string (format "Presentation %s" id)) - (location (slime-eval `(swank:find-definition-for-thing - (swank:lookup-presented-object - ',(slime-presentation-id presentation)))))) - (slime-edit-definition-cont - (and location (list (make-slime-xref :dspec `(,presentation-string) - :location location))) - presentation-string - where)) - (defun slime-edit-inspector-part (name &optional where) (destructuring-bind (&optional property value) (slime-inspector-property-at-point) From heller at common-lisp.net Mon Jan 7 10:12:09 2013 From: heller at common-lisp.net (CVS User heller) Date: Mon, 07 Jan 2013 02:12:09 -0800 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory tiger.common-lisp.net:/tmp/cvs-serv2095 Modified Files: ChangeLog slime.el swank-backend.lisp swank-ecl.lisp Log Message: * swank-ecl.lisp (describe-symbol-for-emacs): Include bound symbols even those without documentation. * slime.el (slime-print-apropos): Do some input validation to detect bugs on the Lisp side. * swank-backend.lisp (describe-symbol-for-emacs): Allow NIL where :NOT-DOCUMENTED was needed. --- /project/slime/cvsroot/slime/ChangeLog 2013/01/05 08:50:24 1.2380 +++ /project/slime/cvsroot/slime/ChangeLog 2013/01/07 10:12:08 1.2381 @@ -1,3 +1,14 @@ +2013-01-07 Helmut Eller + + * swank-ecl.lisp (describe-symbol-for-emacs): Include bound + symbols even those without documentation. + + * slime.el (slime-print-apropos): Do some input validation to + detect bugs on the Lisp side. + + * swank-backend.lisp (describe-symbol-for-emacs): Allow NIL where + :NOT-DOCUMENTED was needed. + 2013-01-05 Helmut Eller * swank-ccl.lisp (frame-package): Implemented. --- /project/slime/cvsroot/slime/slime.el 2012/12/16 13:38:07 1.1425 +++ /project/slime/cvsroot/slime/slime.el 2013/01/07 10:12:08 1.1426 @@ -4630,42 +4630,43 @@ (set-syntax-table lisp-mode-syntax-table) (goto-char (point-min))))) +(defvar slime-apropos-namespaces + '((:variable "Variable") + (:function "Function") + (:generic-function "Generic Function") + (:macro "Macro") + (:special-operator "Special Operator") + (:setf "Setf") + (:type "Type") + (:class "Class") + (:alien-type "Alien type") + (:alien-struct "Alien struct") + (:alien-union "Alien type") + (:alien-enum "Alien enum"))) + (defun slime-print-apropos (plists) (dolist (plist plists) (let ((designator (plist-get plist :designator))) (assert designator) (slime-insert-propertized `(face slime-apropos-symbol) designator)) (terpri) - (loop for (prop namespace) - in '((:variable "Variable") - (:function "Function") - (:generic-function "Generic Function") - (:macro "Macro") - (:special-operator "Special Operator") - (:setf "Setf") - (:type "Type") - (:class "Class") - (:alien-type "Alien type") - (:alien-struct "Alien struct") - (:alien-union "Alien type") - (:alien-enum "Alien enum")) - ;; Properties not listed here will not show up in the buffer - do - (let ((value (plist-get plist prop)) + (loop for (prop value) on plist by #'cddr + unless (eq prop :designator) do + (let ((namespace (cadr (or (assq prop slime-apropos-namespaces) + (error "Unknown property: %S" prop)))) (start (point))) - (when value - (princ " ") - (slime-insert-propertized `(face slime-apropos-label) namespace) - (princ ": ") - (princ (etypecase value - (string value) - ((member :not-documented) "(not documented)"))) - (add-text-properties - start (point) - (list 'type prop 'action 'slime-call-describer - 'button t 'apropos-label namespace - 'item (plist-get plist :designator))) - (terpri)))))) + (princ " ") + (slime-insert-propertized `(face slime-apropos-label) namespace) + (princ ": ") + (princ (etypecase value + (string value) + ((member nil :not-documented) "(not documented)"))) + (add-text-properties + start (point) + (list 'type prop 'action 'slime-call-describer + 'button t 'apropos-label namespace + 'item (plist-get plist :designator))) + (terpri))))) (defun slime-call-describer (arg) (let* ((pos (if (markerp arg) arg (point))) --- /project/slime/cvsroot/slime/swank-backend.lisp 2012/12/03 03:43:16 1.221 +++ /project/slime/cvsroot/slime/swank-backend.lisp 2013/01/07 10:12:09 1.222 @@ -840,8 +840,9 @@ :TYPE :CLASS :ALIEN-TYPE :ALIEN-STRUCT :ALIEN-UNION :ALIEN-ENUM The value of each property is the corresponding documentation string, -or :NOT-DOCUMENTED. It is legal to include keys not listed here (but -slime-print-apropos in Emacs must know about them). +or NIL (or the obsolete :NOT-DOCUMENTED). It is legal to include keys +not listed here (but slime-print-apropos in Emacs must know about +them). Properties should be included if and only if they are applicable to the symbol. For example, only (and all) fbound symbols should include --- /project/slime/cvsroot/slime/swank-ecl.lisp 2012/12/17 11:33:47 1.79 +++ /project/slime/cvsroot/slime/swank-ecl.lisp 2013/01/07 10:12:09 1.80 @@ -329,9 +329,13 @@ (defimplementation describe-symbol-for-emacs (symbol) (let ((result '())) - (dolist (type '(:VARIABLE :FUNCTION :CLASS)) - (when-let (doc (describe-definition symbol type)) - (setf result (list* type doc result)))) + (flet ((frob (type boundp) + (when (funcall boundp symbol) + (let ((doc (describe-definition symbol type))) + (setf result (list* type doc result)))))) + (frob :VARIABLE #'boundp) + (frob :FUNCTION #'fboundp) + (frob :CLASS (lambda (x) (find-class x nil)))) result)) (defimplementation describe-definition (name type) From heller at common-lisp.net Mon Jan 7 13:01:28 2013 From: heller at common-lisp.net (CVS User heller) Date: Mon, 07 Jan 2013 05:01:28 -0800 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory tiger.common-lisp.net:/tmp/cvs-serv19789 Modified Files: ChangeLog swank-ccl.lisp Log Message: * swank-ccl.lisp (compiler-warning-short-message): Add a method for ccl::shadowed-typecase-clause. Whithout that we only get "Nonspecific warning". (function-name-package): Factored out from frame-package. Add case for standard-method. --- /project/slime/cvsroot/slime/ChangeLog 2013/01/07 10:12:08 1.2381 +++ /project/slime/cvsroot/slime/ChangeLog 2013/01/07 13:01:28 1.2382 @@ -1,5 +1,13 @@ 2013-01-07 Helmut Eller + * swank-ccl.lisp (compiler-warning-short-message): Add a method + for ccl::shadowed-typecase-clause. Whithout that we only get + "Nonspecific warning". + (function-name-package): Factored out from frame-package. Add + case for standard-method. + +2013-01-07 Helmut Eller + * swank-ecl.lisp (describe-symbol-for-emacs): Include bound symbols even those without documentation. --- /project/slime/cvsroot/slime/swank-ccl.lisp 2013/01/05 08:50:24 1.30 +++ /project/slime/cvsroot/slime/swank-ccl.lisp 2013/01/07 13:01:28 1.31 @@ -180,6 +180,11 @@ (with-output-to-string (stream) (ccl:report-compiler-warning c stream :short t))) +;; Needed because `ccl:report-compiler-warning' would return +;; "Nonspecific warning". +(defmethod compiler-warning-short-message ((c ccl::shadowed-typecase-clause)) + (princ-to-string c)) + (defimplementation call-with-compilation-hooks (function) (handler-bind ((ccl:compiler-warning 'handle-compiler-warning)) (let ((ccl:*merge-compiler-warnings* nil)) @@ -407,19 +412,21 @@ (pc-source-location lfun pc) (function-source-location lfun))))) +(defun function-name-package (name) + (etypecase name + (null nil) + (symbol (symbol-package name)) + ((cons (eql setf) symbol) (symbol-package (cadr name))) + ((cons (eql :internal)) (function-name-package (car (last name)))) + ((cons (and symbol (not keyword)) (cons list null)) + (symbol-package (car name))) + (standard-method (function-name-package (ccl:method-name name))))) + (defimplementation frame-package (frame-number) (with-frame (p context) frame-number (let* ((lfun (ccl:frame-function p context)) (name (ccl:function-name lfun))) - (labels ((name-package (name) - (etypecase name - (null nil) - (symbol (symbol-package name)) - ((cons (eql setf) symbol) (symbol-package (cadr name))) - ((cons (eql :internal)) (name-package (car (last name)))) - ((cons (and symbol (not keyword)) (cons list null)) - (symbol-package (car name)))))) - (name-package name))))) + (function-name-package name)))) (defimplementation eval-in-frame (form index) (with-frame (p context) index From heller at common-lisp.net Wed Jan 9 14:29:12 2013 From: heller at common-lisp.net (CVS User heller) Date: Wed, 09 Jan 2013 06:29:12 -0800 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory tiger.common-lisp.net:/tmp/cvs-serv1521 Modified Files: ChangeLog swank-sbcl.lisp Log Message: * swank-sbcl.lisp (frame-debug-vars): Only include :valid locals. (*keep-non-valid-locals*): New. --- /project/slime/cvsroot/slime/ChangeLog 2013/01/07 13:01:28 1.2382 +++ /project/slime/cvsroot/slime/ChangeLog 2013/01/09 14:29:10 1.2383 @@ -1,3 +1,8 @@ +2013-01-09 Helmut Eller + + * swank-sbcl.lisp (frame-debug-vars): Only include :valid locals. + (*keep-non-valid-locals*): New. + 2013-01-07 Helmut Eller * swank-ccl.lisp (compiler-warning-short-message): Add a method --- /project/slime/cvsroot/slime/swank-sbcl.lisp 2012/12/03 03:43:16 1.325 +++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2013/01/09 14:29:11 1.326 @@ -1270,9 +1270,18 @@ (code-location-source-location (sb-di:frame-code-location (nth-frame index))))) +(defvar *keep-non-valid-locals* nil) + (defun frame-debug-vars (frame) "Return a vector of debug-variables in frame." - (sb-di::debug-fun-debug-vars (sb-di:frame-debug-fun frame))) + (let ((all-vars (sb-di::debug-fun-debug-vars (sb-di:frame-debug-fun frame)))) + (cond (*keep-non-valid-locals* all-vars) + (t (let ((loc (sb-di:frame-code-location frame))) + (remove-if (lambda (var) + (ecase (sb-di:debug-var-validity var loc) + (:valid nil) + ((:invalid :unknown) t))) + all-vars)))))) (defun debug-var-value (var frame location) (ecase (sb-di:debug-var-validity var location) From heller at common-lisp.net Wed Jan 9 14:29:29 2013 From: heller at common-lisp.net (CVS User heller) Date: Wed, 09 Jan 2013 06:29:29 -0800 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory tiger.common-lisp.net:/tmp/cvs-serv1574 Modified Files: ChangeLog swank-sbcl.lisp Log Message: * swank-sbcl.lisp (frame-package): New. --- /project/slime/cvsroot/slime/ChangeLog 2013/01/09 14:29:10 1.2383 +++ /project/slime/cvsroot/slime/ChangeLog 2013/01/09 14:29:27 1.2384 @@ -2,6 +2,7 @@ * swank-sbcl.lisp (frame-debug-vars): Only include :valid locals. (*keep-non-valid-locals*): New. + (frame-package): New. 2013-01-07 Helmut Eller --- /project/slime/cvsroot/slime/swank-sbcl.lisp 2013/01/09 14:29:11 1.326 +++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2013/01/09 14:29:28 1.327 @@ -1360,6 +1360,16 @@ (sb-di:frame-code-location frame))) frame))) +(defimplementation frame-package (frame-number) + (let* ((frame (nth-frame frame-number)) + (fun (sb-di:debug-fun-fun (sb-di:frame-debug-fun frame)))) + (when fun + (let ((name (function-name fun))) + (typecase name + (null nil) + (symbol (symbol-package name)) + ((cons (eql setf) (cons symbol)) (symbol-package (cadr name)))))))) + #+#.(swank-backend::sbcl-with-restart-frame) (progn (defimplementation return-from-frame (index form) From heller at common-lisp.net Wed Jan 9 14:29:58 2013 From: heller at common-lisp.net (CVS User heller) Date: Wed, 09 Jan 2013 06:29:58 -0800 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory tiger.common-lisp.net:/tmp/cvs-serv1644 Modified Files: ChangeLog swank.lisp Log Message: * swank.lisp (frame-locals-for-emacs): Print variable names in frame-package. --- /project/slime/cvsroot/slime/ChangeLog 2013/01/09 14:29:27 1.2384 +++ /project/slime/cvsroot/slime/ChangeLog 2013/01/09 14:29:50 1.2385 @@ -1,5 +1,10 @@ 2013-01-09 Helmut Eller + * swank.lisp (frame-locals-for-emacs): Print variable names in + frame-package. + +2013-01-09 Helmut Eller + * swank-sbcl.lisp (frame-debug-vars): Only include :valid locals. (*keep-non-valid-locals*): New. (frame-package): New. --- /project/slime/cvsroot/slime/swank.lisp 2012/12/27 20:22:35 1.801 +++ /project/slime/cvsroot/slime/swank.lisp 2013/01/09 14:29:57 1.802 @@ -2328,7 +2328,8 @@ (with-bindings *backtrace-printer-bindings* (loop for var in (frame-locals index) collect (destructuring-bind (&key name id value) var - (list :name (prin1-to-string name) + (list :name (let ((*package* (or (frame-package index) *package*))) + (prin1-to-string name)) :id id :value (to-line value *print-right-margin*)))))) From heller at common-lisp.net Thu Jan 10 11:45:48 2013 From: heller at common-lisp.net (CVS User heller) Date: Thu, 10 Jan 2013 03:45:48 -0800 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory tiger.common-lisp.net:/tmp/cvs-serv16365 Modified Files: ChangeLog slime-autodoc.el Log Message: * slime-autodoc.el (slime-autodoc): Remove :gnu-emacs-only. Suggested by Raymond Toy. (slime-autodoc): Fix long lines. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2013/01/04 18:22:01 1.562 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2013/01/10 11:45:48 1.563 @@ -1,3 +1,9 @@ +2013-01-10 Helmut Eller + + * slime-autodoc.el (slime-autodoc): Remove :gnu-emacs-only. + Suggested by Raymond Toy. + (slime-autodoc): Fix long lines. + 2013-01-04 Stas Boukarev * slime-fancy-inspector.el (slime-edit-inspector-part): New --- /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2011/10/05 14:17:59 1.48 +++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el 2013/01/10 11:45:48 1.49 @@ -1,7 +1,6 @@ (define-slime-contrib slime-autodoc "Show fancy arglist in echo area." - (:gnu-emacs-only t) (:license "GPL") (:authors "Luke Gorrie " "Lawrence Mitchell " @@ -9,7 +8,7 @@ "Tobias C. Rittweiler ") (:slime-dependencies slime-parse) (:swank-dependencies swank-arglists) - (:on-load + (:on-load (dolist (h '(slime-mode-hook slime-repl-mode-hook sldb-mode-hook)) (add-hook h 'slime-autodoc-maybe-enable))) (:on-unload @@ -22,7 +21,7 @@ (when slime-use-autodoc-mode (slime-autodoc-mode 1) (setq slime-echo-arglist-function - (lambda () + (lambda () (if slime-autodoc-mode (eldoc-message (slime-autodoc)) (slime-show-arglist)))))) @@ -141,7 +140,8 @@ (multiple-value-bind (cache-key retrieve-form) (slime-make-autodoc-rpc-form) (let* (cached - (multilinep (or (slime-autodoc-multiline-cached (car cache-key)) + (multilinep (or (slime-autodoc-multiline-cached + (car cache-key)) multilinep))) (slime-autodoc-cache-multiline (car cache-key) cache-multiline) (cond @@ -182,7 +182,7 @@ (defun slime-autodoc-manually () "Like slime-autodoc, but when called twice, -or after slime-autodoc was already automatically called, +or after slime-autodoc was already automatically called, display multiline arglist" (interactive) (eldoc-message (slime-autodoc (or slime-autodoc-use-multiline-p @@ -204,7 +204,7 @@ (message (format "Slime autodoc mode %s." (if slime-autodoc-mode "enabled" "disabled"))))) -(defadvice eldoc-display-message-no-interference-p +(defadvice eldoc-display-message-no-interference-p (after slime-autodoc-message-ok-p) (when slime-autodoc-mode (setq ad-return-value @@ -233,8 +233,8 @@ (slime-canonicalize-whitespace autodoc)))) (defun slime-check-autodoc-at-point (arglist) - (slime-test-expect (format "Autodoc in `%s' (at %d) is as expected" - (buffer-string) (point)) + (slime-test-expect (format "Autodoc in `%s' (at %d) is as expected" + (buffer-string) (point)) arglist (slime-autodoc-to-string) 'equal)) @@ -247,10 +247,12 @@ ("(swank::emacs-connected*HERE*" "(emacs-connected)") ("(swank::emacs-connected *HERE*" "(emacs-connected)") ("(swank::create-socket*HERE*" "(create-socket host port)") - ("(swank::create-socket *HERE*" "(create-socket ===> host <=== port)") - ("(swank::create-socket foo *HERE*" "(create-socket host ===> port <===)") + ("(swank::create-socket *HERE*" "(create-socket ===> host <=== port)") + ("(swank::create-socket foo *HERE*" + "(create-socket host ===> port <===)") - ;; Test that autodoc differentiates between exported and unexported symbols. + ;; Test that autodoc differentiates between exported and + ;; unexported symbols. ("(swank:create-socket*HERE*" :not-available) ;; Test if cursor is on non-existing required parameter @@ -262,27 +264,35 @@ t) ;; Test variable content display - ("(progn swank::default-server-port*HERE*" "DEFAULT-SERVER-PORT => 4005") + ("(progn swank::default-server-port*HERE*" + "DEFAULT-SERVER-PORT => 4005") - ;; Test that "variable content display" is not triggered for trivial constants. - ("(swank::create-socket t*HERE*" "(create-socket ===> host <=== port)") - ("(swank::create-socket :foo*HERE*" "(create-socket ===> host <=== port)") + ;; Test that "variable content display" is not triggered for + ;; trivial constants. + ("(swank::create-socket t*HERE*" "(create-socket ===> host <=== port)") + ("(swank::create-socket :foo*HERE*" + "(create-socket ===> host <=== port)") ;; Test with syntactic sugar ("#'(lambda () (swank::create-socket*HERE*" "(create-socket host port)") ("`(lambda () ,(swank::create-socket*HERE*" "(create-socket host port)") - ("(remove-if #'(lambda () (swank::create-socket*HERE*" "(create-socket host port)") - ("`(remove-if #'(lambda () ,@(swank::create-socket*HERE*" "(create-socket host port)") + ("(remove-if #'(lambda () (swank::create-socket*HERE*" + "(create-socket host port)") + ("`(remove-if #'(lambda () ,@(swank::create-socket*HERE*" + "(create-socket host port)") ;; Test &optional - ("(swank::symbol-status foo *HERE*" - "(symbol-status symbol &optional ===> (package (symbol-package symbol)) <===)") + ("(swank::symbol-status foo *HERE*" + "(symbol-status symbol &optional\ + ===> (package (symbol-package symbol)) <===)") ;; Test context-sensitive autodoc (DEFMETHOD) ("(defmethod swank::arglist-dispatch (*HERE*" - "(defmethod arglist-dispatch (===> operator <=== arguments) &body body)") + "(defmethod arglist-dispatch\ + (===> operator <=== arguments) &body body)") ("(defmethod swank::arglist-dispatch :before (*HERE*" - "(defmethod arglist-dispatch :before (===> operator <=== arguments) &body body)") + "(defmethod arglist-dispatch :before\ + (===> operator <=== arguments) &body body)") ;; Test context-sensitive autodoc (APPLY) ("(apply 'swank::eval-for-emacs*HERE*" @@ -290,26 +300,32 @@ ("(apply #'swank::eval-for-emacs*HERE*" "(apply #'eval-for-emacs &optional form buffer-package id &rest args)") ("(apply 'swank::eval-for-emacs foo *HERE*" - "(apply 'eval-for-emacs &optional form ===> buffer-package <=== id &rest args)") + "(apply 'eval-for-emacs &optional form\ + ===> buffer-package <=== id &rest args)") ("(apply #'swank::eval-for-emacs foo *HERE*" - "(apply #'eval-for-emacs &optional form ===> buffer-package <=== id &rest args)") + "(apply #'eval-for-emacs &optional form\ + ===> buffer-package <=== id &rest args)") ;; Test context-sensitive autodoc (ERROR, CERROR) ("(error 'simple-condition*HERE*" - "(error 'simple-condition &rest arguments &key format-arguments format-control)") + "(error 'simple-condition &rest arguments\ + &key format-arguments format-control)") ("(cerror \"Foo\" 'simple-condition*HERE*" - "(cerror \"Foo\" 'simple-condition &rest arguments &key format-arguments format-control)") - + "(cerror \"Foo\" 'simple-condition\ + &rest arguments &key format-arguments format-control)") + ;; Test &KEY and nested arglists ("(swank::with-retry-restart (:msg *HERE*" "(with-retry-restart (&key ===> (msg \"Retry.\") <===) &body body)") ("(swank::with-retry-restart (:msg *HERE*(foo" "(with-retry-restart (&key ===> (msg \"Retry.\") <===) &body body)" t) ("(swank::start-server \"/tmp/foo\" :coding-system *HERE*" - "(start-server port-file &key (style swank:*communication-style*) (dont-close swank:*dont-close*) ===> (coding-system swank::*coding-system*) <===)") - + "(start-server port-file &key (style swank:*communication-style*)\ + (dont-close swank:*dont-close*)\ + ===> (coding-system swank::*coding-system*) <===)") + ;; Test declarations and type specifiers - ("(declare (string *HERE*" + ("(declare (string *HERE*" "(declare (string &rest ===> variables <===))") ("(declare ((string *HERE*" "(declare ((string &optional ===> size <===) &rest variables))") @@ -320,8 +336,8 @@ ("(flet ((foo (x y) (+ x y))) (foo *HERE*" "(foo ===> x <=== y)") ("(macrolet ((foo (x y) `(+ ,x ,y))) (foo *HERE*" "(foo ===> x <=== y)") ("(labels ((foo (x y) (+ x y))) (foo *HERE*" "(foo ===> x <=== y)") - ("(labels ((foo (x y) (+ x y)) - (bar (y) (foo *HERE*" + ("(labels ((foo (x y) (+ x y)) + (bar (y) (foo *HERE*" "(foo ===> x <=== y)")) (slime-check-top-level) (with-temp-buffer From heller at common-lisp.net Thu Jan 10 11:46:42 2013 From: heller at common-lisp.net (CVS User heller) Date: Thu, 10 Jan 2013 03:46:42 -0800 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory tiger.common-lisp.net:/tmp/cvs-serv18352 Modified Files: ChangeLog swank-ecl.lisp Log Message: * swank-ecl.lisp (frame-var-value): Return the value without name. --- /project/slime/cvsroot/slime/ChangeLog 2013/01/09 14:29:50 1.2385 +++ /project/slime/cvsroot/slime/ChangeLog 2013/01/10 11:46:42 1.2386 @@ -1,3 +1,7 @@ +2013-01-10 Helmut Eller + + * swank-ecl.lisp (frame-var-value): Return the value without name. + 2013-01-09 Helmut Eller * swank.lisp (frame-locals-for-emacs): Print variable names in --- /project/slime/cvsroot/slime/swank-ecl.lisp 2013/01/07 10:12:09 1.80 +++ /project/slime/cvsroot/slime/swank-ecl.lisp 2013/01/10 11:46:42 1.81 @@ -499,14 +499,17 @@ (third (elt *backtrace* frame-number))) (defimplementation frame-locals (frame-number) - (loop for (name . value) in (nth-value 2 (frame-decode-env + (loop for (name . value) in (nth-value 2 (frame-decode-env (elt *backtrace* frame-number))) - with i = 0 - collect (list :name name :id (prog1 i (incf i)) :value value))) + collect (list :name name :id 0 :value value))) -(defimplementation frame-var-value (frame-number var-id) - (elt (nth-value 2 (frame-decode-env (elt *backtrace* frame-number))) - var-id)) +(defimplementation frame-var-value (frame-number var-number) + (destructuring-bind (name . value) + (elt + (nth-value 2 (frame-decode-env (elt *backtrace* frame-number))) + var-number) + (declare (ignore name)) + value)) (defimplementation disassemble-frame (frame-number) (let ((fun (frame-function (elt *backtrace* frame-number)))) From heller at common-lisp.net Fri Jan 11 09:00:31 2013 From: heller at common-lisp.net (CVS User heller) Date: Fri, 11 Jan 2013 01:00:31 -0800 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory tiger.common-lisp.net:/tmp/cvs-serv24461 Modified Files: ChangeLog swank.lisp Log Message: * swank.lisp (swank-compile-file*): Renamed from compile-file-with-compile-file. --- /project/slime/cvsroot/slime/ChangeLog 2013/01/10 11:46:42 1.2386 +++ /project/slime/cvsroot/slime/ChangeLog 2013/01/11 09:00:30 1.2387 @@ -1,3 +1,8 @@ +2013-01-11 Helmut Eller + + * swank.lisp (swank-compile-file*): Renamed from + compile-file-with-compile-file. + 2013-01-10 Helmut Eller * swank-ecl.lisp (frame-var-value): Return the value without name. --- /project/slime/cvsroot/slime/swank.lisp 2013/01/09 14:29:57 1.802 +++ /project/slime/cvsroot/slime/swank.lisp 2013/01/11 09:00:30 1.803 @@ -2421,9 +2421,8 @@ :loadp (if loadp t) :faslfile faslfile)))))) -(defun compile-file-with-compile-file (pathname load-p &rest options - &key policy - &allow-other-keys) +(defun swank-compile-file* (pathname load-p &rest options &key policy + &allow-other-keys) (multiple-value-bind (output-pathname warnings? failure?) (swank-compile-file pathname (fasl-pathname pathname options) @@ -2434,7 +2433,7 @@ (declare (ignore warnings?)) (values t (not failure?) load-p output-pathname))) -(defvar *compile-file-for-emacs-hook* '(compile-file-with-compile-file)) +(defvar *compile-file-for-emacs-hook* '(swank-compile-file*)) (defslimefun compile-file-for-emacs (filename load-p &rest options) "Compile FILENAME and, when LOAD-P, load the result. @@ -2452,6 +2451,8 @@ (when tried (return (values success load? output-pathname)))))))))) +;; FIXME: now that *compile-file-for-emacs-hook* is there this is +;; redundant and confusing. (defvar *fasl-pathname-function* nil "In non-nil, use this function to compute the name for fasl-files.") From sboukarev at common-lisp.net Fri Jan 11 23:36:35 2013 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Fri, 11 Jan 2013 15:36:35 -0800 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory tiger.common-lisp.net:/tmp/cvs-serv5796 Modified Files: ChangeLog swank-ecl.lisp Log Message: * swank-ecl.lisp (accept-connection): Fix a typo, line => :line. --- /project/slime/cvsroot/slime/ChangeLog 2013/01/11 09:00:30 1.2387 +++ /project/slime/cvsroot/slime/ChangeLog 2013/01/11 23:36:35 1.2388 @@ -1,3 +1,7 @@ +2013-01-11 Stas Boukarev + + * swank-ecl.lisp (accept-connection): Fix a typo, line => :line. + 2013-01-11 Helmut Eller * swank.lisp (swank-compile-file*): Renamed from --- /project/slime/cvsroot/slime/swank-ecl.lisp 2013/01/10 11:46:42 1.81 +++ /project/slime/cvsroot/slime/swank-ecl.lisp 2013/01/11 23:36:35 1.82 @@ -95,7 +95,7 @@ :buffering (ecase buffering ((t) :full) ((nil) :none) - (:line line)) + (:line :line)) :element-type (if external-format 'character '(unsigned-byte 8)) From sboukarev at common-lisp.net Sat Jan 12 12:32:21 2013 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Sat, 12 Jan 2013 04:32:21 -0800 Subject: [slime-cvs] CVS slime Message-ID: Update of /project/slime/cvsroot/slime In directory tiger.common-lisp.net:/tmp/cvs-serv27799 Modified Files: ChangeLog swank-backend.lisp Log Message: * swank-backend.lisp: Add a couple of ignore declarations. --- /project/slime/cvsroot/slime/ChangeLog 2013/01/11 23:36:35 1.2388 +++ /project/slime/cvsroot/slime/ChangeLog 2013/01/12 12:32:20 1.2389 @@ -1,3 +1,7 @@ +2013-01-12 Stas Boukarev + + * swank-backend.lisp: Add a couple of ignore declarations. + 2013-01-11 Stas Boukarev * swank-ecl.lisp (accept-connection): Fix a typo, line => :line. --- /project/slime/cvsroot/slime/swank-backend.lisp 2013/01/07 10:12:09 1.222 +++ /project/slime/cvsroot/slime/swank-backend.lisp 2013/01/12 12:32:21 1.223 @@ -1347,6 +1347,7 @@ (definterface send (thread object) "Send OBJECT to thread THREAD." + (declare (ignore thread)) object) (definterface receive (&optional timeout) @@ -1366,6 +1367,7 @@ (definterface find-registered (name) "Find the thread that was registered for the symbol NAME. Return nil if the no thread was registred or if the tread is dead." + (declare (ignore name)) nil) (definterface set-default-initial-binding (var form) From sboukarev at common-lisp.net Sun Jan 20 06:37:32 2013 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Sat, 19 Jan 2013 22:37:32 -0800 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory tiger.common-lisp.net:/tmp/cvs-serv24781 Modified Files: ChangeLog swank-asdf.lisp Log Message: * swank-asdf.lisp: Better compatibility with newer ASDF. Patch by Francois-Rene Rideau and Stelian Ionescu. Remove auto-upgrading. Rename *asdf-directory* to *asdf-path*, to be a full path to asdf.lisp. Remove #+gcl and #+genera. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2013/01/10 11:45:48 1.563 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2013/01/20 06:37:32 1.564 @@ -1,3 +1,13 @@ +2013-01-20 Stas Boukarev + + * swank-asdf.lisp: Better compatibility with newer ASDF. + Patch by Francois-Rene Rideau and Stelian Ionescu. + + Remove auto-upgrading. + Rename *asdf-directory* to *asdf-path*, to be a full path to + asdf.lisp. + Remove #+gcl and #+genera. + 2013-01-10 Helmut Eller * slime-autodoc.el (slime-autodoc): Remove :gnu-emacs-only. --- /project/slime/cvsroot/slime/contrib/swank-asdf.lisp 2012/12/26 10:40:47 1.35 +++ /project/slime/cvsroot/slime/contrib/swank-asdf.lisp 2013/01/20 06:37:32 1.36 @@ -11,55 +11,49 @@ (in-package :swank) (eval-when (:compile-toplevel :load-toplevel :execute) - (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") - (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. -;; Use eval to not fail on old CLISP. +;;; The best way to load ASDF is from an init file of an +;;; implementation. If ASDF is not loaded at the time swank-asdf is +;;; loaded, it will be tried first with (require "asdf"), if that +;;; doesn't help and *asdf-path* is set, it will be loaded from that +;;; file. +;;; To set *asdf-path* put the following into ~/.swank.lisp: +;;; (defparameter swank::*asdf-path* #p"/path/to/asdf/asdf.lisp") + (defvar *asdf-path* nil + "Path to asdf.lisp file, to be loaded in case (require \"asdf\") fails.")) + (eval-when (:compile-toplevel :load-toplevel :execute) (unless (member :asdf *features*) - (ignore-errors (eval '(require "asdf"))))) + (ignore-errors (funcall 'require "asdf")))) -;; If not found, load asdf from wherever the user specified it (eval-when (:compile-toplevel :load-toplevel :execute) (unless (member :asdf *features*) - (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))))))) + (handler-bind ((warning #'muffle-warning)) + (when *asdf-path* + (load *asdf-path* :if-does-not-exist nil))))) ;; If still not found, error out. (eval-when (:compile-toplevel :load-toplevel :execute) (unless (member :asdf *features*) (error "Could not load ASDF. -Please install ASDF2 and in your ~~/.swank.lisp specify: - (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) - (when *upgrade-asdf-p* - (handler-bind ((warning #'muffle-warning)) - (pushnew *asdf-directory* asdf:*central-registry*) - (ignore-errors (asdf:oos 'asdf:load-op :asdf))))) +Please update your implementation or +install ASDF2 and in your ~~/.swank.lisp specify: + (defparameter swank::*asdf-path* #p\"/path/containing/asdf/asdf.lisp\")"))) ;;; If ASDF is too old, punt. +;; Quicklisp has 2.014.6 for the longest time, now 2.26. +;; CLISP ships with 2.11? Too bad, have them upgrade or +;; install an upgrade yourself and configure *asdf-path* +;; It's just not worth the hassle supporting something +;; that doesn't even have COERCE-PATHNAME. (eval-when (:compile-toplevel :load-toplevel :execute) - (unless (or #+asdf2 (asdf:version-satisfies (asdf:asdf-version) "2.000")) - (error "Your ASDF version is too old. -Please upgrade to ASDF2 and in your ~~/.swank.lisp specify: - (defparameter swank::*asdf-directory* #p\"/path/containing/asdf/\")"))) + (unless (or #+asdf2 + (asdf:version-satisfies (asdf:asdf-version) "2.14.6")) + (error "ASDF is too old. The latest supported version is 2.14.6."))) ;;; Import functionality from ASDF that isn't available in all ASDF versions. ;;; Please do NOT depend on any of the below as reference: ;;; they are sometimes stripped down versions, for compatibility only. +;;; Indeed, they are supposed to work on *OLDER*, not *NEWER* versions of ASDF. ;;; ;;; The way I got these is usually by looking at the current definition, ;;; using git blame in one screen to locate which commit last modified it, @@ -98,48 +92,9 @@ ((defmethod) (defmethod* version aname args)) ((defvar) (defvar* name aname args))))))) -(asdefs "2.015" - (defvar *wild* #-cormanlisp :wild #+cormanlisp "*")) +(asdefs "2.15" + (defvar *wild* #-cormanlisp :wild #+cormanlisp "*") -(asdefs "2.010" - (defun collect-sub*directories (directory collectp recursep collector) - (when (funcall collectp directory) - (funcall collector directory)) - (dolist (subdir (subdirectories directory)) - (when (funcall recursep subdir) - (collect-sub*directories subdir collectp recursep collector))))) - -(asdefs "2.011" - (defun find-symbol* (s p) - (find-symbol (string s) p))) - -(asdefs "2.012" - (defvar *wild-file* - (make-pathname :name *wild* :type *wild* - :version (or #-(or abcl xcl) *wild*) :directory nil)) - (defvar *wild-directory* - (make-pathname :directory `(:relative ,*wild*) - :name nil :type nil :version nil))) - -(asdefs "2.014" - (defun ensure-directory-pathname (pathspec) - (cond - ((stringp pathspec) - (ensure-directory-pathname (pathname pathspec))) - ((not (pathnamep pathspec)) - (error "Invalid pathname designator ~S" pathspec)) - ((wild-pathname-p pathspec) - (error "Can't reliably convert wild pathname ~S" pathspec)) - ((asdf::directory-pathname-p pathspec) - pathspec) - (t - (make-pathname :directory (append (or (pathname-directory pathspec) - (list :relative)) - (list (file-namestring pathspec))) - :name nil :type nil :version nil - :defaults pathspec))))) - -(asdefs "2.015" (defun collect-asds-in-directory (directory collect) (map () collect (directory-asd-files directory))) @@ -149,7 +104,7 @@ (collect-sub*directories-asd-files directory :exclude exclude :collect collect)))) -(asdefs "2.016" +(asdefs "2.16" (defun load-sysdef (name pathname) (declare (ignore name)) (let ((package (asdf::make-temporary-package))) @@ -159,7 +114,7 @@ (asdf::pathname-directory-pathname (translate-logical-pathname pathname)))) (asdf::asdf-message - "~&; Loading system definition from ~A into ~A~%" + "~&; Loading system definition from ~A into ~A~%" ; pathname package) (load pathname)) (delete-package package)))) @@ -179,12 +134,12 @@ #+sbcl (when (find-symbol "RESOLVE-SYMLINKS" '#:sb-impl) '(:resolve-symlinks nil))))))) -(asdefs "2.017" +(asdefs "2.17" (defun collect-sub*directories-asd-files (directory &key (exclude asdf::*default-source-registry-exclusions*) collect) - (collect-sub*directories + (asdf::collect-sub*directories directory (constantly t) (lambda (x) (not (member (car (last (pathname-directory x))) @@ -198,7 +153,7 @@ (defun filter-logical-directory-results (directory entries merger) (if (typep directory 'logical-pathname) (loop for f in entries - when + when (if (typep f 'logical-pathname) f (let ((u (ignore-errors (funcall merger f)))) @@ -212,39 +167,36 @@ (defun directory-asd-files (directory) (directory-files directory asdf::*wild-asd*))) -(asdefs "2.019" +(asdefs "2.19" (defun subdirectories (directory) - (let* ((directory (ensure-directory-pathname directory)) - #-(or abcl cormanlisp genera xcl) + (let* ((directory (asdf::ensure-directory-pathname directory)) + #-(or abcl cormanlisp xcl) (wild (asdf::merge-pathnames* #-(or abcl allegro cmu lispworks sbcl scl xcl) - *wild-directory* + asdf::*wild-directory* #+(or abcl allegro cmu lispworks sbcl scl xcl) "*.*" directory)) (dirs - #-(or abcl cormanlisp genera xcl) + #-(or abcl cormanlisp xcl) (ignore-errors (directory* wild . #.(or #+clozure '(:directories t :files nil) #+mcl '(:directories t)))) #+(or abcl xcl) (system:list-directory directory) - #+cormanlisp (cl::directory-subdirs directory) - #+genera (fs:directory-list directory)) - #+(or abcl allegro cmu genera lispworks sbcl scl xcl) + #+cormanlisp (cl::directory-subdirs directory)) + #+(or abcl allegro cmu lispworks sbcl scl xcl) (dirs (loop for x in dirs for d = #+(or abcl xcl) (extensions:probe-directory x) #+allegro (excl:probe-directory x) #+(or cmu sbcl scl) (asdf::directory-pathname-p x) - #+genera (getf (cdr x) :directory) #+lispworks (lw:file-directory-p x) when d collect #+(or abcl allegro xcl) d - #+genera (ensure-directory-pathname (first x)) #+(or cmu lispworks sbcl scl) x))) (filter-logical-directory-results directory dirs (let ((prefix (or (normalize-pathname-directory-component (pathname-directory directory)) ;; because allegro 8.x returns NIL for #p"FOO:" - '(:absolute)))) + '(:absolute)))) (lambda (d) (let ((dir (normalize-pathname-directory-component (pathname-directory d)))) @@ -257,13 +209,14 @@ (last dir)))))))))))) (asdefs "2.21" + (defun component-loaded-p (c) + (and (gethash 'load-op (asdf::component-operation-times + (asdf::find-component c nil))) t)) + (defun normalize-pathname-directory-component (directory) (cond #-(or cmu sbcl scl) ((stringp directory) `(:absolute ,directory) directory) - #+gcl - ((and (consp directory) (stringp (first directory))) - `(:absolute , at directory)) ((or (null directory) (and (consp directory) (member (first directory) '(:absolute :relative)))) @@ -286,8 +239,8 @@ :type (make-pathname-component-logical (pathname-type pathname)) :version (make-pathname-component-logical (pathname-version pathname))))) -(asdefs "2.022" - (defun directory-files (directory &optional (pattern *wild-file*)) +(asdefs "2.22" + (defun directory-files (directory &optional (pattern asdf::*wild-file*)) (let ((dir (pathname directory))) (when (typep dir 'logical-pathname) (when (wild-pathname-p dir) @@ -310,14 +263,13 @@ :version (make-pathname-component-logical (pathname-version f))))))))) -(asdefs "2.27" - (defmethod component-relative-pathname ((component asdf:component)) +(asdefs "2.26.125" + (defmethod component-relative-pathname ((system asdf:system)) (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)))) + (and (slot-boundp system 'asdf::relative-pathname) + (slot-value system 'asdf::relative-pathname)) + :type :directory + :defaults (system-source-directory system)))) ;;; Taken from ASDF 1.628 (defmacro while-collecting ((&rest collectors) &body body) @@ -326,7 +278,7 @@ ;;; Now for SLIME-specific stuff (defun asdf-operation (operation) - (or (find-symbol* operation :asdf) + (or (asdf::find-symbol* operation :asdf) (error "Couldn't find ASDF operation ~S" operation))) (defun map-system-components (fn system) @@ -409,7 +361,7 @@ \(operate-on-system \"swank\" 'compile-op :force t)" (handler-case (with-compilation-hooks () - (apply #'asdf:operate (asdf-operation operation-name) + (apply #'asdf:operate (asdf-operation operation-name) system-name keyword-args) t) (asdf:compile-error () nil))) @@ -431,7 +383,7 @@ #+asdf2 (progn (asdf:ensure-source-registry) - (if (asdf:version-satisfies (asdf:asdf-version) "2.015") + (if (asdf:version-satisfies (asdf:asdf-version) "2.15") (loop :for k :being :the :hash-keys :of asdf::*source-registry* :do (c k)) (dolist (entry (asdf::flatten-source-registry)) @@ -484,9 +436,7 @@ files))) (defslimefun asdf-system-loaded-p (name) - (and (gethash 'asdf:load-op - (asdf::component-operation-times (asdf:find-system name))) - t)) + (component-loaded-p name)) (defslimefun asdf-system-directory (name) (namestring (asdf:system-source-directory name))) @@ -536,11 +486,10 @@ ;; Doing list-all-systems-in-central-registry might be quite slow ;; since it accesses a file-system, so run it once at the background ;; to initialize caches. -(eval-when (:load-toplevel :execute) - (when (eql *communication-style* :spawn) - (spawn (lambda () - (ignore-errors (list-all-systems-in-central-registry))) - :name "init-asdf-fs-caches"))) +(when (eql *communication-style* :spawn) + (spawn (lambda () + (ignore-errors (list-all-systems-in-central-registry))) + :name "init-asdf-fs-caches")) ;;; Hook for compile-file-for-emacs From sboukarev at common-lisp.net Tue Jan 29 16:17:24 2013 From: sboukarev at common-lisp.net (CVS User sboukarev) Date: Tue, 29 Jan 2013 08:17:24 -0800 Subject: [slime-cvs] CVS slime/contrib Message-ID: Update of /project/slime/cvsroot/slime/contrib In directory tiger.common-lisp.net:/tmp/cvs-serv27359 Modified Files: ChangeLog swank-asdf.lisp Log Message: * swank-asdf.lisp: Better upcoming ASDF3 support. --- /project/slime/cvsroot/slime/contrib/ChangeLog 2013/01/20 06:37:32 1.564 +++ /project/slime/cvsroot/slime/contrib/ChangeLog 2013/01/29 16:17:24 1.565 @@ -1,3 +1,7 @@ +2013-01-29 Francois-Rene Rideau + + * swank-asdf.lisp: Better upcoming ASDF3 support. + 2013-01-20 Stas Boukarev * swank-asdf.lisp: Better compatibility with newer ASDF. --- /project/slime/cvsroot/slime/contrib/swank-asdf.lisp 2013/01/20 06:37:32 1.36 +++ /project/slime/cvsroot/slime/contrib/swank-asdf.lisp 2013/01/29 16:17:24 1.37 @@ -46,9 +46,10 @@ ;; It's just not worth the hassle supporting something ;; that doesn't even have COERCE-PATHNAME. (eval-when (:compile-toplevel :load-toplevel :execute) - (unless (or #+asdf2 + (unless (or #+asdf3 t #+asdf2 (asdf:version-satisfies (asdf:asdf-version) "2.14.6")) - (error "ASDF is too old. The latest supported version is 2.14.6."))) + (error "Your ASDF is too old. ~ + The oldest version supported by swank-asdf is 2.014.6."))) ;;; Import functionality from ASDF that isn't available in all ASDF versions. ;;; Please do NOT depend on any of the below as reference: @@ -263,13 +264,17 @@ :version (make-pathname-component-logical (pathname-version f))))))))) -(asdefs "2.26.125" +(asdefs "2.26.149" (defmethod component-relative-pathname ((system asdf:system)) (asdf::coerce-pathname (and (slot-boundp system 'asdf::relative-pathname) (slot-value system 'asdf::relative-pathname)) :type :directory - :defaults (system-source-directory system)))) + :defaults (system-source-directory system))) + (defun load-asd (pathname &key name &allow-other-keys) + (asdf::load-sysdef (or name (string-downcase (pathname-name pathname))) + pathname))) + ;;; Taken from ASDF 1.628 (defmacro while-collecting ((&rest collectors) &body body) @@ -364,7 +369,8 @@ (apply #'asdf:operate (asdf-operation operation-name) system-name keyword-args) t) - (asdf:compile-error () nil))) + ((or asdf:compile-error #+asdf3 asdf/lisp-build:compile-file-error) + () nil))) (defun unique-string-list (&rest lists) (sort (delete-duplicates (apply #'append lists) :test #'string=) #'string<)) @@ -380,17 +386,15 @@ for defaults = (eval dir) when defaults do (collect-asds-in-directory defaults #'c)) - #+asdf2 - (progn - (asdf:ensure-source-registry) - (if (asdf:version-satisfies (asdf:asdf-version) "2.15") - (loop :for k :being :the :hash-keys :of asdf::*source-registry* - :do (c k)) - (dolist (entry (asdf::flatten-source-registry)) - (destructuring-bind (directory &key recurse exclude) entry - (register-asd-directory - directory - :recurse recurse :exclude exclude :collect #'c))))))))) + (asdf:ensure-source-registry) + (if (or #+asdf3 t (asdf:version-satisfies (asdf:asdf-version) "2.15")) + (loop :for k :being :the :hash-keys :of asdf::*source-registry* + :do (c k)) + (dolist (entry (asdf::flatten-source-registry)) + (destructuring-bind (directory &key recurse exclude) entry + (register-asd-directory + directory + :recurse recurse :exclude exclude :collect #'c)))))))) (defslimefun list-all-systems-known-to-asdf () "Returns a list of all systems ASDF knows already." @@ -508,7 +512,7 @@ (defun try-compile-asd-file (pathname load-p &rest options) (declare (ignore load-p options)) (when (equalp (pathname-type pathname) "asd") - (load-sysdef (string-downcase (pathname-name pathname)) pathname) + (load-asd pathname) (values t t nil pathname))) (pushnew 'try-compile-asd-file *compile-file-for-emacs-hook*)