Permalink
Browse files

Remove breakpoint EWOC for now, keep an internal list instead

  • Loading branch information...
1 parent 6ab36b0 commit fcc3fb13d0063882b213388629c21a05878be433 @jscheid committed Sep 24, 2012
Showing with 150 additions and 145 deletions.
  1. +0 −65 kite-breakpoint-tests.el
  2. +133 −79 kite-breakpoint.el
  3. +2 −0 kite-cl.el
  4. +15 −1 kite-global.el
View
@@ -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
View
@@ -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)
View
@@ -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)
View
@@ -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

0 comments on commit fcc3fb1

Please sign in to comment.