Add module request support

Author: yitzchak

src/cl-jupyter/kernel.lisp

@@ -201,14 +201,9 @@
               (multiple-value-call #'values pathname (source-line-column pathname (ccl:source-note-start-pos source-note)))))
   #+clasp (let ((pos (clasp-debug:frame-source-position frame)))
             (when pos
-              (let ((pathname (clasp-debug:code-source-line-pathname pos)))
-                (values (if (and (uiop:physical-pathname-p pathname)
-                                 (not (uiop:absolute-pathname-p pathname)))
-                          (merge-pathnames (make-pathname :host "CELL" :version :newest)
-                                           pathname)
-                          pathname)
-                        (clasp-debug:code-source-line-line-number pos)
-                        (clasp-debug:code-source-line-column pos)))))
+              (values (clasp-debug:code-source-line-pathname pos)
+                      (clasp-debug:code-source-line-line-number pos)
+                      (clasp-debug:code-source-line-column pos))))
   #+cmucl (let* ((code-location (di:frame-code-location frame))
                  (debug-source (di:code-location-debug-source code-location))
                  (pathname (ignore-errors (di:debug-source-name debug-source))))
@@ -261,13 +256,36 @@
             instance)
           frames))
 
+(defvar *modules* nil)
+(defvar *system-name* "")
+
+(defgeneric grovel-component (component)
+  (:method (component)
+    (declare (ignore component)))
+  (:method :around ((component asdf:component))
+    (when (or (not (asdf::component-if-feature component))
+              (uiop:featurep (asdf::component-if-feature component)))
+      (call-next-method)))
+  (:method ((component asdf:cl-source-file))
+    (push (make-instance 'jupyter:debug-module
+                         :name (format nil "~a ~a" *system-name* (asdf:component-name component))
+                         :path (asdf:component-pathname component))
+          *modules*))
+  (:method ((component asdf:parent-component))
+    (loop for child in (asdf:component-children component)
+          do (grovel-component child))))
+
+(defmethod jupyter:debug-modules ((kernel kernel))
+  (loop with *modules* = nil
+        for *system-name* in (asdf:already-loaded-systems)
+        finally (return *modules*)
+        do (grovel-component (asdf:find-system *system-name*))))
 
 (defmethod jupyter:debug-object-children-resolve ((instance debug-frame))
   (list (make-instance 'debug-local-scope
                        :environment (jupyter:debug-object-environment instance)
                        :parent instance)))
 
-
 (defmethod jupyter:debug-object-children-resolve ((instance debug-local-scope))
   (stable-sort
     #+ccl   (let ((frame (jupyter:debug-object-data (jupyter:debug-object-parent instance))))

src/kernel.lisp

@@ -375,6 +375,11 @@
 (defgeneric debug-inspect-variables (kernel environment)
   (:documentation "Return a list of debug-objects represents the variables in the global scope."))
 
+(defgeneric debug-modules (kernel)
+  (:documentation "Return a list of debug-modules representing the modules available.")
+  (:method (kernel)
+    (declare (ignore kernel))
+    nil))
 
 (defclass debug-source ()
   ((name
@@ -485,6 +490,18 @@
      :documentation "Implementation specific data associated with the object."))
   (:documentation "A debug object. Superclass of frames, scopes, variables, etc."))
 
+(defclass debug-module (debug-object)
+  ((path
+     :reader debug-object-path
+     :initarg :path
+     :type (or pathname string)
+     :documentation "The path of the source."))
+  (:documentation "A module in the debugger."))
+
+(defmethod shasht:print-json-key-value :around ((object debug-module) key value output-stream)
+  (when (member key '(id name path) :test #'equal)
+    (let ((shasht:*symbol-name-function* #'symbol-to-camel-case))
+      (call-next-method))))
 
 (defmethod debug-object-children :before ((instance debug-object))
   (unless (slot-boundp instance 'children)
@@ -956,6 +973,8 @@
                 (handle-debug-request/initialize))
               ("debug_request/inspectVariables"
                 (handle-debug-request/inspect-variables environment))
+              ("debug_request/modules"
+                (handle-debug-request/modules))
               ("debug_request/setBreakpoints"
                 (handle-debug-request/set-breakpoints))
               ("debug_request/source"
@@ -1195,6 +1214,21 @@
 
 #|
 
+### Message type: debug_request / modules ###
+
+|#
+
+(defun handle-debug-request/modules ()
+  (inform :info *kernel* "Handling debug_request/modules message")
+  (let ((modules (debug-modules *kernel*)))
+    (send-debug-reply
+      `(:object-plist
+        "modules" ,(or modules :empty-array)
+        "totalModules" ,(length modules))))
+  (send-status-idle))
+
+#|
+
 ### Message type: debug_request / next ###
 
 |#

src/packages.lisp

@@ -70,6 +70,8 @@
     #:debug-inspect-variables
     #:debug-new-breakpoint
     #:debug-next
+    #:debug-module
+    #:debug-modules
     #:debug-object
     #:debug-object-children
     #:debug-object-children-resolve