Remove breakpoint EWOC for now, keep an internal list instead

kite-breakpoint-tests.el

@@ -343,71 +343,6 @@
       (:url "foo")
       nil))))
 
-(ert-deftest kite-breakpoint-ewoc-test ()
-  "Simple test that breakpoint ewoc works"
-  (with-temp-buffer
-    (let ((ewoc (kite--make-breakpoint-ewoc)))
-      (ewoc-enter-last ewoc (make-kite-dom-event-breakpoint :event-name "bar"))
-      (ewoc-enter-last ewoc (make-kite-xhr-breakpoint :url-substring "foo")))
-    (should (string= (buffer-string)
-                     (concat "Breakpoints:\n"
-                             "* Break on DOM event `bar'\n"
-                             "* Break on XMLHttpRequest with substring `foo'\n"
-                             "\n")))))
-
-(ert-deftest kite-breakpoint-ewoc-wrong-sort-order-test ()
-  "Test that breakpoint ewoc sort order works"
-  (with-temp-buffer
-    (let ((ewoc (kite--make-breakpoint-ewoc)))
-      (kite--add-breakpoint ewoc (make-kite-xhr-breakpoint :url-substring "foo"))
-      (kite--add-breakpoint ewoc (make-kite-dom-event-breakpoint :event-name "bar")))
-    (should (string= (buffer-string)
-                     (concat "Breakpoints:\n"
-                             "* Break on DOM event `bar'\n"
-                             "* Break on XMLHttpRequest with substring `foo'\n"
-                             "\n")))))
-
-(ert-deftest kite-breakpoint-ewoc-correct-sort-order-test ()
-  "Test that breakpoint ewoc sort order works when inserting in order"
-  (with-temp-buffer
-    (let ((ewoc (kite--make-breakpoint-ewoc)))
-      (kite--add-breakpoint ewoc (make-kite-dom-event-breakpoint :event-name "bar"))
-      (kite--add-breakpoint ewoc (make-kite-xhr-breakpoint :url-substring "foo")))
-    (should (string= (buffer-string)
-                     (concat "Breakpoints:\n"
-                             "* Break on DOM event `bar'\n"
-                             "* Break on XMLHttpRequest with substring `foo'\n"
-                             "\n")))))
-
-(ert-deftest kite-toggle-next-instruction-breakpoint-test ()
-  (let (invalidate-args
-        (kite-session (make-kite-session)))
-    (flet ((ewoc-invalidate (ewoc &rest nodes)
-                            (setq invalidate-args
-                                  (cons (cons ewoc nodes) invalidate-args))))
-      (with-temp-buffer
-        (setf (kite-session-breakpoint-ewoc kite-session)
-              (kite--make-breakpoint-ewoc))
-
-        (should (null (ewoc-nth (kite-session-breakpoint-ewoc kite-session) 0)))
-        (should (eq 0 (length invalidate-args)))
-        (kite-test--should-send-packets
-         (lambda ()
-           (kite-toggle-next-instruction-breakpoint))
-         '(("Debugger.pause" * *)))
-        (should (eq 1 (length invalidate-args)))
-        (should (null (ewoc-nth (kite-session-breakpoint-ewoc kite-session) 1)))
-        (let ((new-ewoc-element (ewoc-nth (kite-session-breakpoint-ewoc kite-session) 0)))
-          (should (not (null new-ewoc-element)))
-          (should (kite-next-instruction-breakpoint-p (ewoc-data new-ewoc-element))))
-        (kite-test--should-send-packets
-         (lambda ()
-           (kite-toggle-next-instruction-breakpoint))
-         '(("Debugger.resume" * *)))
-        (should (eq 2 (length invalidate-args)))
-        (should (null (ewoc-nth (kite-session-breakpoint-ewoc kite-session) 0)))))))
-
-
 (provide 'kite-breakpoint-tests)
 
 ;;; kite-breakpoint-tests.el ends here

kite-breakpoint.el

@@ -35,9 +35,45 @@
 (require 'kite-cl)
 (require 'kite-global)
 
-(require 'ewoc)
 (require 'browse-url nil t)
 
+(defconst kite--dom-breakpoint-names
+  '("abort" "beforecopy" "beforecut" "beforeload" "beforepaste"
+    "beforeunload" "blocked" "blur" "cached" "change" "checking" "click"
+    "close" "complete" "compositionend" "compositionstart"
+    "compositionupdate" "connect" "contextmenu" "copy" "cut" "dblclick"
+    "devicemotion" "deviceorientation" "display" "downloading" "drag"
+    "dragend" "dragenter" "dragleave" "dragover" "dragstart" "drop"
+    "error" "focus" "focusin" "focusout" "hashchange" "input" "invalid"
+    "keydown" "keypress" "keyup" "load" "loadstart" "message"
+    "mousedown" "mousemove" "mouseout" "mouseover" "mouseup"
+    "mousewheel" "noupdate" "obsolete" "offline" "online" "open"
+    "overflowchanged" "pagehide" "pageshow" "paste" "popstate"
+    "readystatechange" "reset" "resize" "scroll" "search" "select"
+    "selectstart" "selectionchange" "storage" "submit" "textInput"
+    "unload" "updateready" "versionchange" "webkitvisibilitychange"
+    "write" "writeend" "writestart" "zoom" "DOMActivate" "DOMFocusIn"
+    "DOMFocusOut" "DOMAttrModified" "DOMCharacterDataModified"
+    "DOMNodeInserted" "DOMNodeInsertedIntoDocument" "DOMNodeRemoved"
+    "DOMNodeRemovedFromDocument" "DOMSubtreeModified" "DOMContentLoaded"
+    "webkitBeforeTextInserted" "webkitEditableContentChanged" "canplay"
+    "canplaythrough" "durationchange" "emptied" "ended" "loadeddata"
+    "loadedmetadata" "pause" "play" "playing" "ratechange" "seeked"
+    "seeking" "timeupdate" "volumechange" "waiting" "addtrack"
+    "cuechange" "enter" "exit" "webkitbeginfullscreen"
+    "webkitendfullscreen" "webkitsourceopen" "webkitsourceended"
+    "webkitsourceclose" "progress" "stalled" "suspend"
+    "webkitAnimationEnd" "webkitAnimationStart"
+    "webkitAnimationIteration" "webkitTransitionEnd" "orientationchange"
+    "timeout" "touchstart" "touchmove" "touchend" "touchcancel"
+    "success" "loadend" "webkitfullscreenchange" "webkitfullscreenerror"
+    "webkitspeechchange" "webglcontextlost" "webglcontextrestored"
+    "webglcontextcreationerror" "audioprocess" "connecting"
+    "addstream" "removestream" "statechange" "show"
+    "webkitpointerlocklost")
+  "WebKit DOM breakpoint names, taken from
+  Source/WebCore/dom/EventNames.h")
+
 (kite--defstruct
   (kite-breakpoint
    (:constructor nil))   ; no default constructor
@@ -290,101 +326,119 @@
   (funcall (kite-breakpoint-remove-function breakpoint)
            breakpoint response-handler))
 
-;; EWOC functions
-
-(defun kite--make-breakpoint-ewoc ()
-  (ewoc-create
-   (lambda (breakpoint)
-     (insert (format
-              "* Break on %s"
-              (kite--breakpoint-to-string breakpoint))))
-   "Breakpoints:"))
-
 ;; High-level functions
 
-(defun kite--add-breakpoint (ewoc breakpoint)
-  (let ((insert-after (ewoc-nth ewoc 0)))
-    (if (or (null insert-after)
-            (>= (kite-breakpoint-sort-priority (ewoc-data insert-after))
-                (kite-breakpoint-sort-priority breakpoint)))
-        (ewoc-enter-first ewoc breakpoint)
-      (setq insert-after (ewoc-next ewoc insert-after))
-      (while (and insert-after
-                  (< (kite-breakpoint-sort-priority (ewoc-data insert-after))
-                     (kite-breakpoint-sort-priority breakpoint)))
-        (setq insert-after (ewoc-next ewoc insert-after)))
-      (if insert-after
-          (ewoc-enter-after ewoc insert-after breakpoint)
-        (ewoc-enter-last ewoc breakpoint)))))
+(defun kite--session-has-breakpoint (kite-session predicate)
+  (kite--find-if predicate
+                 (kite-session-breakpoint-list kite-session)))
+
+(defun kite--session-add-breakpoint (kite-session breakpoint)
+  (lexical-let ((lex-kite-session kite-session)
+                (lex-breakpoint breakpoint))
+    (kite--set-breakpoint
+     breakpoint
+     (lambda (result)
+       (setf (kite-session-breakpoint-list lex-kite-session)
+             (kite--stable-sort
+              (cons lex-breakpoint
+                    (kite-session-breakpoint-list lex-kite-session))
+              (lambda (a b)
+                (< (kite-breakpoint-sort-priority a)
+                   (kite-breakpoint-sort-priority b)))))
+       (message "Breakpoint set")))))
+
+(defun kite--session-remove-breakpoints (kite-session predicate)
+  (mapc (lambda (breakpoint)
+          (when (funcall predicate breakpoint)
+            (lexical-let ((lex-breakpoint breakpoint)
+                          (lex-kite-session kite-session))
+              (kite--remove-breakpoint
+               breakpoint
+               (lambda (result)
+                 (setf (kite-session-breakpoint-list lex-kite-session)
+                       (delete lex-breakpoint
+                               (kite-session-breakpoint-list lex-kite-session)))
+                 (message "Breakpoint removed"))))))
+        (copy-seq (kite-session-breakpoint-list kite-session))))
 
 (defun kite-set-xhr-breakpoint ()
   (interactive)
-  (kite--add-breakpoint
-   (kite-session-breakpoint-ewoc kite-session)
-   (make-kite-xhr-breakpoint
-    :url-substring (read-from-minibuffer
-                    "XHR breakpoint on URL substring: "
-                    (and (boundp 'browse-url-url-at-point)
-                         (browse-url-url-at-point))
-                    nil nil 'kite-url-substring-history))))
+  (let ((kite-session (kite--select-session)))
+    (kite--session-add-breakpoint
+     kite-session
+     (make-kite-xhr-breakpoint
+      :url-substring (read-from-minibuffer
+                      "XHR breakpoint on URL substring: "
+                      (and (boundp 'browse-url-url-at-point)
+                           (browse-url-url-at-point))
+                      nil nil 'kite-url-substring-history)))))
 
 (defun kite-set-dom-event-breakpoint ()
   (interactive)
-  (kite--add-breakpoint
-   (kite-session-breakpoint-ewoc kite-session)
-   (make-kite-dom-event-breakpoint
-    :event-name (read-from-minibuffer
-                 "Breakpoint on DOM event: "
-                 nil nil nil 'kite-dom-event-history))))
+  (let ((kite-session (kite--select-session))
+        (event-name (completing-read
+                     "Breakpoint on DOM event: "
+                     kite--dom-breakpoint-names
+                     nil
+                     'confirm
+                     nil
+                     'kite-dom-event-history)))
+    (when event-name
+      (kite--session-add-breakpoint
+       kite-session
+       (make-kite-dom-event-breakpoint
+        :event-name event-name)))))
 
 (defun kite-set-instrumentation-breakpoint ()
   (interactive)
-  (kite--add-breakpoint
-   (kite-session-breakpoint-ewoc kite-session)
-   (make-kite-instrumentation-breakpoint
-    :event-name (read-from-minibuffer
-                 "Breakpoint on native event: "
-                 nil nil nil 'kite-instrumentation-history))))
+  (let ((kite-session (kite--select-session)))
+    (kite--session-add-breakpoint
+     kite-session
+     (make-kite-instrumentation-breakpoint
+      :event-name (read-from-minibuffer
+                   "Breakpoint on native event: "
+                   nil nil nil 'kite-instrumentation-history)))))
 
 (defun kite-toggle-exception-breakpoint ()
   (interactive)
-  (lexical-let ((breakpoint-ewoc (kite-session-breakpoint-ewoc kite-session)))
-    (let ((uncaught-exceptions-breakpoints
-           (ewoc-collect breakpoint-ewoc 'kite-uncaught-exceptions-breakpoint-p))
-          (all-exceptions-breakpoints
-           (ewoc-collect breakpoint-ewoc 'kite-all-exceptions-breakpoint-p)))
-    (cond
-     (uncaught-exceptions-breakpoints
-      (ewoc-filter breakpoint-ewoc (lambda (breakpoint)
-                                     (not (kite-uncaught-exceptions-breakpoint-p breakpoint))))
-      (kite--add-breakpoint breakpoint-ewoc
-                            (make-kite-all-exceptions-breakpoint)))
-     (all-exceptions-breakpoints
-      (ewoc-filter breakpoint-ewoc (lambda (breakpoint)
-                                     (not (kite-all-exceptions-breakpoint-p breakpoint)))))
-     (t
-      (kite--add-breakpoint breakpoint-ewoc
-                            (make-kite-uncaught-exceptions-breakpoint)))))))
+  (cond
+
+   ;; break on uncaught -> break on all
+   ((kite--session-has-breakpoint
+     kite-session
+     #'kite-uncaught-exceptions-breakpoint-p)
+    (kite--session-remove-breakpoints
+     kite-session
+     #'kite-uncaught-exceptions-breakpoint-p)
+    (kite--session-add-breakpoint
+     kite-session
+     (make-kite-all-exceptions-breakpoint)))
+
+   ;; break on all -> don't break on exception
+   ((kite--session-has-breakpoint
+     kite-session
+     #'kite-all-exceptions-breakpoint-p)
+    (kite--session-remove-breakpoints
+     kite-session
+     #'kite-all-exceptions-breakpoint-p))
+
+   ;; don't break -> break on uncaught
+   (t
+    (kite--session-add-breakpoint
+     kite-session
+     (make-kite-uncaught-exceptions-breakpoint)))))
 
 (defun kite-toggle-next-instruction-breakpoint ()
   (interactive)
-  (lexical-let*
-      ((breakpoint-ewoc (kite-session-breakpoint-ewoc kite-session))
-       (old-breakpoints
-        (ewoc-collect breakpoint-ewoc 'kite-next-instruction-breakpoint-p)))
-    (if old-breakpoints
-        (kite--remove-breakpoint (car old-breakpoints)
-                                 (lambda (result)
-                                   (ewoc-filter breakpoint-ewoc
-                                                (lambda (breakpoint)
-                                                  (not (kite-next-instruction-breakpoint-p
-                                                        breakpoint))))
-                                   (ewoc-invalidate breakpoint-ewoc)))
-      (lexical-let ((new-breakpoint (make-kite-next-instruction-breakpoint)))
-        (kite--set-breakpoint new-breakpoint
-                              (lambda (result)
-                                (kite--add-breakpoint breakpoint-ewoc new-breakpoint)
-                                (ewoc-invalidate breakpoint-ewoc)))))))
+  (if (kite--session-has-breakpoint
+       kite-session
+       #'kite-next-instruction-breakpoint-p)
+      (kite--session-remove-breakpoints
+       kite-session
+       #'kite-next-instruction-breakpoint-p)
+    (kite--session-add-breakpoint
+       kite-session
+     (make-kite-next-instruction-breakpoint))))
 
 (provide 'kite-breakpoint)
 

kite-cl.el

@@ -44,6 +44,7 @@
       (defalias 'kite--mapcar 'cl-mapcar)
       (defalias 'kite--position 'cl-position)
       (defalias 'kite--remove-if 'cl-remove-if)
+      (defalias 'kite--stable-sort 'cl-stable-sort)
       (defalias 'kite--subseq 'cl-subseq))
   (require 'cl)
   (defalias 'kite--defstruct 'defstruct)
@@ -55,6 +56,7 @@
   (defalias 'kite--mapcar 'mapcar*)
   (defalias 'kite--position 'position)
   (defalias 'kite--remove-if 'remove-if)
+  (defalias 'kite--stable-sort 'stable-sort)
   (defalias 'kite--subseq 'subseq))
 
 (provide 'kite-cl)

kite-global.el

@@ -94,7 +94,7 @@ remote WebKit debugger instance."
   page-thumbnail-url
   page-url
   page-title
-  breakpoint-ewoc
+  breakpoint-list
   unique-name
   (script-infos (make-hash-table :test 'equal))
   (debugger-state kite--debugger-state-resumed)
@@ -267,6 +267,20 @@ create one with the given MODE."
       (goto-char (point-max))
       (insert (concat (apply 'format format-string args) "\n")))))
 
+(defun kite--select-session ()
+  "Used by global commands to select a session to act upon.  If
+the command is executed in a buffer with a local binding for
+`kite-session', use that.  Otherwise, use the most recent session
+if available.  Otherwise, raise an error."
+  (cond
+   ((and (boundp 'kite-session)
+         kite-session)
+    kite-session)
+   ((not (null kite-most-recent-session))
+    kite-most-recent-session)
+   (t
+    (error "No kite sessions active."))))
+
 (provide 'kite-global)
 
 ;;; kite-global.el ends here