diff --git a/source/clog-element.lisp b/source/clog-element.lisp index 8a86881..fb795d7 100644 --- a/source/clog-element.lisp +++ b/source/clog-element.lisp @@ -2334,8 +2334,9 @@ CLOG-ELEMENT and set CLOG-ELEMENT to html-id. Returns CLOG-ELEMENT")) ;;;;;;;;;;;;;;;;;;;; (defgeneric parent-element (clog-element) - (:documentation "Return a new clog-element represeting the parent of -CLOG-ELEMENT.")) + (:documentation "Return a _new_ clog-element represeting the parent of +CLOG-ELEMENT. In most cases use PARENT, this creates an alias lisp object +used for DOM tree walking or other throw away purposes.")) (defmethod parent-element ((obj clog-element)) (attach-as-child obj (jquery-query obj (format nil "parent().prop('id')")))) diff --git a/tools/clog-builder-probe.lisp b/tools/clog-builder-probe.lisp index c3e811a..531c3ea 100644 --- a/tools/clog-builder-probe.lisp +++ b/tools/clog-builder-probe.lisp @@ -133,11 +133,14 @@ symbol is used for title." (set-geometry evaltxt :height 27 :width "100%" :top 0 :left 0 :right 0) (set-geometry pac-line :height 27 :width "100%" :top 27 :left 0 :right 0) (setf (place-holder evaltxt) "Enter a form to evaluate to a probe") + (setf (spellcheckp evaltxt) nil) (set-on-change evaltxt (lambda (obj) (declare (ignore obj)) (let ((txt (text-value evaltxt))) (when (not (equal txt "")) - (let* ((*package* (find-package (string-upcase (text-value pac-line)))) + (let* ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) + (*package* (find-package (string-upcase (text-value pac-line)))) (result (eval (read-from-string txt)))) (clog-builder-probe result :title txt)))))) (create-div (window-content win) :class "w3-tiny w3-center" diff --git a/tools/clog-builder-scope.lisp b/tools/clog-builder-scope.lisp index eefc447..9451352 100644 --- a/tools/clog-builder-scope.lisp +++ b/tools/clog-builder-scope.lisp @@ -38,6 +38,7 @@ name. If CLOG-BODY not set use *clog-debug-instance*" (setf (width obj) (width obj)) (setf (height obj) (height obj)))))) (setf (place-holder root-obj) "Enter a form to evaluate") + (setf (spellcheckp root-obj) nil) (create-div tree :class "w3-tiny w3-center" :content "or use CLOG-TOOLS:CLOG-BUILDER-SCOPE to create new scope") (when object @@ -82,24 +83,41 @@ name. If CLOG-BODY not set use *clog-debug-instance*" (create-clog-tree (tree-root class-tree) :node-html "☰" :content "Direct Slots" - :visible is-root + :visible nil :indent-level (1+ (indent-level class-tree)) :fill-function (lambda (obj) (on-slots obj class object))) (create-clog-tree (tree-root class-tree) :node-html "◙" :content "Direct Generic Functions" - :visible is-root + :visible nil :indent-level (1+ (indent-level class-tree)) :fill-function (lambda (obj) (on-generic obj class))) (create-clog-tree (tree-root class-tree) :node-html "▱" :content "Direct Methods" - :visible is-root + :visible nil :indent-level (1+ (indent-level class-tree)) :fill-function (lambda (obj) - (on-method obj class))))) + (on-method obj class))) + (when is-root + (create-br class-tree) + (create-clog-tree class-tree + :node-html "☰" + :content "Class Slots" + :visible is-root + :indent-level 0 + :fill-function (lambda (obj) + (on-calc-slots obj class object))) + (create-br class-tree) + (create-clog-tree class-tree + :node-html "▱" + :content "Class Methods" + :visible is-root + :indent-level 0 + :fill-function (lambda (obj) + (on-calc-methods obj class)))))) (get-name (sym) (escape-lisp (if (typep sym 'cons) (format nil "(~A ~A:~A)" @@ -133,6 +151,29 @@ name. If CLOG-BODY not set use *clog-debug-instance*" (get-name (closer-mop:generic-function-name item)) (escape-lisp (closer-mop:generic-function-lambda-list item))))) (closer-mop:specializer-direct-generic-functions class))) + (on-calc-methods (obj class) + (dolist (dclass (closer-mop:class-precedence-list class)) + (when (or (equalp (get-name (class-name dclass)) "common-lisp:standard-object") + (equalp (get-name (class-name dclass)) "common-lisp:structure-object")) + (return)) + (create-div (tree-root obj) :content (format nil "  ~A" (get-name (class-name dclass))) + :class "w3-tiny") + (mapcar (lambda (item) + (create-clog-tree (tree-root obj) + :indent-level (1+ (indent-level obj)) + :node-html "▰" + :visible nil + :on-context-menu (lambda (obj) + (let ((sys (get-name-cons + (closer-mop:generic-function-name + (closer-mop:method-generic-function item))))) + (on-new-sys-browser obj + :search (first sys) + :package (second sys)))) + :content (format nil "~A ~A" + (get-name (closer-mop:generic-function-name (closer-mop:method-generic-function item))) + (escape-lisp (closer-mop:method-lambda-list item))))) + (closer-mop:specializer-direct-methods dclass)))) (on-method (obj class) (mapcar (lambda (item) (create-clog-tree (tree-root obj) @@ -175,7 +216,7 @@ name. If CLOG-BODY not set use *clog-debug-instance*" (escape-lisp (closer-mop:slot-definition-initargs slot)))) (create-clog-tree-item (tree-root sltt) :content (format nil "slot-definition-initform = ~A" - (escape-lisp (closer-mop:slot-definition-initform slot)))) + (escape-lisp (closer-mop:slot-definition-initform slot)))) (create-clog-tree-item (tree-root sltt) :content (format nil "slot-definition-initfunction = ~A" (escape-lisp (closer-mop:slot-definition-initfunction slot)))) @@ -190,17 +231,63 @@ name. If CLOG-BODY not set use *clog-debug-instance*" (escape-lisp (closer-mop:slot-definition-type slot)))) (create-clog-tree-item (tree-root sltt) :content (format nil "slot-definition-allocation = ~A" - (escape-lisp (closer-mop:slot-definition-allocation slot)))) - )) + (escape-lisp (closer-mop:slot-definition-allocation slot)))))) (closer-mop:class-direct-slots class))) + (on-calc-slots (obj class object) + (dolist (dclass (closer-mop:class-precedence-list class)) + (when (or (equalp (get-name (class-name dclass)) "common-lisp:standard-object") + (equalp (get-name (class-name dclass)) "common-lisp:structure-object")) + (return)) + (create-div (tree-root obj) :content (format nil "  ~A" (get-name (class-name dclass))) + :class "w3-tiny") + (mapcar (lambda (slot) + (let ((sltt (create-clog-tree (tree-root obj) + :indent-level (1+ (indent-level obj)) + :node-html "▬" + :visible nil + :on-context-menu (lambda (obj) + (on-new-sys-browser obj + :search (get-name (closer-mop:slot-definition-name slot)))) + :content (format nil "~A Object Value = ~A" + (get-name (closer-mop:slot-definition-name slot)) + (escape-lisp (slot-value object (closer-mop:slot-definition-name slot))))))) + (let* ((object (slot-value object (closer-mop:slot-definition-name slot))) + (class (class-of object))) + (add-class sltt class object)) + (create-clog-tree-item (tree-root sltt) + :content (format nil "slot-definition-initargs = ~A" + (escape-lisp (closer-mop:slot-definition-initargs slot)))) + (create-clog-tree-item (tree-root sltt) + :content (format nil "slot-definition-initform = ~A" + (escape-lisp (closer-mop:slot-definition-initform slot)))) + (create-clog-tree-item (tree-root sltt) + :content (format nil "slot-definition-initfunction = ~A" + (escape-lisp (closer-mop:slot-definition-initfunction slot)))) + (create-clog-tree-item (tree-root sltt) + :content (format nil "slot-definition-readers = ~A" + (escape-lisp (closer-mop:slot-definition-readers slot)))) + (create-clog-tree-item (tree-root sltt) + :content (format nil "slot-definition-writers = ~A" + (escape-lisp (closer-mop:slot-definition-writers slot)))) + (create-clog-tree-item (tree-root sltt) + :content (format nil "slot-type = ~A" + (escape-lisp (closer-mop:slot-definition-type slot)))) + (create-clog-tree-item (tree-root sltt) + :content (format nil "slot-definition-allocation = ~A" + (escape-lisp (closer-mop:slot-definition-allocation slot)))))) + (closer-mop:class-direct-slots dclass)))) (on-change (object) (setf (text tree) "") (setf class (class-of object)) + (create-div tree :class "w3-tiny w3-center" + :content "left-click - drill down / right-click - system browse") (add-class tree class object))) (set-on-change root-obj (lambda (obj) (declare (ignore obj)) (when (not (equal (text-value root-obj) "")) - (on-change (let ((*package* (find-package (string-upcase (text-value pac-line))))) + (on-change (let* ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) + (*package* (find-package (string-upcase (text-value pac-line))))) (eval (read-from-string (text-value root-obj)))))))) (when object (on-change object))))) \ No newline at end of file