Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
477 lines (426 sloc) 17.9 KB
;;; kite-debug.el --- Kite debugger module implementation
;; Copyright (C) 2012 Julian Scheid
;; Author: Julian Scheid <julians37@gmail.com>
;; Keywords: tools
;; Package: kite
;; Compatibility: GNU Emacs 24
;; This file is not part of GNU Emacs.
;; Kite is free software: you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; Kite is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
;; License for more details.
;; You should have received a copy of the GNU General Public License
;; along with Kite. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This package implements the WebKit debugger buffer, which is used
;; to manage breakpoints.
;;
;; It is part of Kite, a WebKit inspector front-end.
;;; Code:
(require 'kite-breakpoint)
(require 'kite-sourcemap)
(require 'kite-global)
(require 'kite-object)
(require 'cl)
(require 'url-expand)
(require 'ewoc)
(require 'wid-edit)
(defvar kite-script-id nil
"Keeps the scriptId in a buffer-local variable in buffers that
correspond to one.")
(defvar kite-debug-mode-map
(let ((map (make-keymap))
(ctl-c-b-map (make-keymap))
(menu-map (make-sparse-keymap)))
(suppress-keymap map t)
(kite--define-global-mode-keys map)
(define-key map "C" 'kite-console)
(define-key map "p" 'kite-toggle-next-instruction-breakpoint)
(define-key map "b" 'kite-toggle-exception-breakpoint)
(define-key map "c" 'kite-debug-continue)
(define-key map "r" 'kite-debug-reload)
(define-key map "R" 'kite-repl)
(define-key map "D" 'kite-dom-inspect)
(define-key map "N" 'kite-network)
(define-key map "T" 'kite-timeline)
(define-key map "M" 'kite-memory)
(define-key mode-specific-map "b" ctl-c-b-map)
(define-key ctl-c-b-map "x" 'kite-set-xhr-breakpoint)
(define-key ctl-c-b-map "d" 'kite-set-dom-event-breakpoint)
(define-key ctl-c-b-map "i" 'kite-set-instrumentation-breakpoint)
(define-key ctl-c-b-map "b" 'kite-toggle-exception-breakpoint)
(define-key
ctl-c-b-map "p" 'kite-toggle-next-instruction-breakpoint)
map)
"Local keymap for `kite-connection-mode' buffers.")
(defvar kite-connection-ewoc)
(define-derived-mode kite-debug-mode special-mode "kite-debug"
"Toggle kite debug mode."
:group 'kite
(setq case-fold-search nil)
(kite--connect-buffer-insert)
(run-mode-hooks 'kite-debug-mode-hook))
(defun kite-debug-pause ()
(interactive)
(kite-send "Debugger.pause"))
(defun kite-debug-continue ()
(interactive)
(kite-send "Debugger.resume"))
(defun kite-debug-reload ()
(interactive)
(with-current-buffer (if (boundp 'kite-connection)
kite-connection
(current-buffer))
(kite-send "Page.reload")))
(defun kite--insert-favicon-async (favicon-url)
(lexical-let ((favicon-marker (point-marker))
(buf (current-buffer)))
(url-retrieve
favicon-url
(lambda (status)
(goto-char 0)
(when (and (looking-at "HTTP/1\\.. 200")
(re-search-forward "\n\n" nil t))
(ignore-errors
(let* ((favicon-image
(create-image (buffer-substring (point)
(buffer-size))
nil
t)))
(save-excursion
(with-current-buffer buf
(goto-char (marker-position favicon-marker))
(let ((inhibit-read-only t))
(insert-image favicon-image)))))))))))
(defun kite--connect-buffer-insert ()
(let ((favicon-url (kite-session-page-favicon-url kite-session)))
(when (and favicon-url
(not (string= favicon-url "")))
(kite--insert-favicon-async favicon-url))
(let* ((inhibit-read-only t)
(ewoc (ewoc-create
(lambda (session)
(insert (propertize
(concat " "
(kite-session-page-title
kite-session)
"\n\n")
'face 'info-title-1)
(propertize "URL: " 'face 'bold)
(kite-session-page-url kite-session)
"\n"
(propertize "Status: " 'face 'bold)
(kite-session-debugger-state session)
"\n\n"
"Press ? for help\n")))))
(set (make-local-variable 'kite-connection-ewoc) ewoc)
(ewoc-enter-last ewoc kite-session)
(goto-char (point-max)))))
(defun kite--Debugger-resumed (websocket-url packet)
(kite-send "Debugger.setOverlayMessage")
(message "Execution resumed"))
(defun kite--Debugger-paused (websocket-url packet)
(kite-send "Debugger.setOverlayMessage"
:params
(list :message "Paused in kite debugger"))
(lexical-let* ((call-frames (plist-get packet :callFrames))
(first-call-frame (elt call-frames 0))
(location (plist-get first-call-frame :location))
(script-info
(gethash (plist-get location :scriptId)
(kite-session-script-infos kite-session)))
(line-number (plist-get location :lineNumber))
(column-number (plist-get location :columnNumber))
(kite-session (gethash websocket-url
kite-active-sessions)))
(kite-visit-script
script-info
line-number
column-number
(lambda ()
(kite-debugging-mode)
(set (make-local-variable 'kite-script-id)
(plist-get location :scriptId))
(set (make-local-variable 'kite-session)
kite-session)
(let* ((stack-buffer (get-buffer-create "*kite stack*"))
(window (display-buffer
stack-buffer
(list (cons 'display-buffer-pop-up-window
nil)))))
(with-current-buffer stack-buffer
(special-mode)
(set (make-local-variable 'kite-session) kite-session)
(set (make-local-variable 'widget-link-prefix) "")
(set (make-local-variable 'widget-link-suffix) "")
(let ((inhibit-read-only t))
(erase-buffer)
(save-excursion
(mapc (lambda (call-frame)
(insert (concat
(plist-get call-frame :functionName)
" ("
(kite-script-info-url script-info)
":"
(number-to-string line-number)
")\n"))
(mapc (lambda (scope)
(kite--insert-object-widget
(kite--get scope :object :objectId)
(concat " " (kite--get scope :type))
2)
(insert "\n"))
(plist-get call-frame :scopeChain)))
call-frames)
(use-local-map widget-keymap)
(widget-setup)))))
(message "Execution paused")))))
(defun kite--Debugger-scriptParsed (websocket-url packet)
(puthash
(plist-get packet :scriptId)
(make-kite-script-info
:url (plist-get packet :url)
:start-line (plist-get packet :startLine)
:start-column (plist-get packet :startColumn)
:end-line (plist-get packet :endLine)
:end-column (plist-get packet :endColumn)
:source-map-url (plist-get packet :sourceMapURL))
(kite-session-script-infos kite-session)))
(add-hook 'kite-Debugger-paused-hooks
'kite--Debugger-paused)
(add-hook 'kite-Debugger-resumed-hooks
'kite--Debugger-resumed)
(add-hook 'kite-Debugger-scriptParsed-hooks
'kite--Debugger-scriptParsed)
;;; Augmented javascript-mode; loading of remote .js files
(defvar kite-debugging-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c i") 'kite-step-into)
(define-key map (kbd "C-c o") 'kite-step-over)
(define-key map (kbd "C-c u") 'kite-step-out)
(define-key map (kbd "C-c r") 'kite-resume)
(define-key map (kbd "C-c c") 'kite-continue-to-location)
(define-key map (kbd "C-c C-c") 'kite-set-script-source)
map)
"Local keymap for the `kite-debugging-mode' minor mode")
(define-minor-mode kite-debugging-mode
"Toggle kite JavaScript debugging in this buffer."
:group 'kite
:lighter (:eval (kite--debug-stats-mode-line-indicator))
:keymap kite-debugging-mode-map)
(defun kite-step-into ()
"Step into the next instruction in the current or most recent
session. Sends `Debugger.stepInto' to the remote debugger."
(interactive)
(let ((kite-session (kite--select-session)))
(kite-send "Debugger.stepInto")))
(defun kite-step-over ()
"Step over the next instruction in the current or most recent
session. Sends `Debugger.stepOver' to the remote debugger."
(interactive)
(let ((kite-session (kite--select-session)))
(kite-send "Debugger.stepOver")))
(defun kite-step-out ()
"Step out of the current block in the current or most recent
session. Sends `Debugger.stepOut' to the remote debugger."
(interactive)
(let ((kite-session (kite--select-session)))
(kite-send "Debugger.stepOut")))
(defun kite-resume ()
"Resume execution in the current or most recent session. Sends
`Debugger.resume' to the remote debugger."
(interactive)
(let ((kite-session (kite--select-session)))
(kite-send "Debugger.resume")))
(defun kite-continue-to-location ()
"Continue to the instruction at or after point. Sends
`Debugger.continueToLocation' to the remote debugger."
(interactive)
(let ((kite-session (kite--select-session)))
(kite-send "Debugger.continueToLocation"
:params
(list :location
(list :scriptId kite-script-id
:lineNumber (save-restriction
(widen)
(line-number-at-pos (point)))
:columnNumber (current-column))))))
(defun kite-set-script-source ()
"Send the buffer contents as the new contents for the script.
Causes `Debugger.setScriptSource' to be sent to the remote
debugger."
(interactive)
(if (kite-session-can-set-script-source
(kite-send "Debugger.setScriptSource"
:params
(list :scriptId kite-script-id
:scriptSource (save-restriction
(widen)
(buffer-string))
:preview :json-false)
:success-function
(lambda (result)
;; FIXME: use :callFrames to update context
;; information
(message "Script updated"))))
(message "Sorry, the remote debugger doesn't support setting\
the script source")))
(defun kite--create-remote-script-buffer (script-info
after-load-function)
(lexical-let* ((url (kite-script-info-url script-info))
(url-parts (url-generic-parse-url url))
(after-load-function after-load-function)
(new-buffer (generate-new-buffer url)))
(kite-send "Debugger.getScriptSource"
:params
(list :scriptId (plist-get script-info :scriptId))
:success-function
(lambda (result)
(with-current-buffer new-buffer
(setq buffer-file-name (url-filename url-parts))
(insert (plist-get result :scriptSource))
(setq buffer-read-only t)
(set-buffer-modified-p nil)
(normal-mode)
(funcall after-load-function))))
new-buffer))
(defun kite-script-info--source-map (script-info)
"Return the parsed source map for the given SCRIPT-INFO as a
`kite-source-map' struct, or nil if there is no source map for
the SCRIPT-INFO. Raise an error if the source map can't be
loaded or parsed."
(when (kite-script-info-source-map-url script-info)
(with-current-buffer
(url-retrieve-synchronously
(url-expand-file-name
(kite-script-info-source-map-url script-info)
(kite-script-info-url script-info)))
(goto-char 0)
(if (and (or (looking-at "HTTP/1\\.. 200")
(not (looking-at "HTTP/")))
(re-search-forward "\n\n" nil t))
(kite--source-map-decode
(let ((json-array-type 'list)
(json-object-type 'plist))
(json-read)))
(error "Could not retrieve source map: %s"
(buffer-substring-no-properties
(point-min) (point-max)))))))
(defun kite-script-info--source-map-cached (script-info)
"Return the parsed source map for the given SCRIPT-INFO as a
`kite-source-map' struct, or nil if there is no source map for
the SCRIPT-INFO. Raise an error if the source map can't be
loaded or parsed. Uses a cache in the session so that each
source map is loaded and parsed only once."
(when (kite-script-info-source-map-url script-info)
(let ((cached-entry
(gethash (kite-script-info-source-map-url script-info)
(kite-session-source-map-cache kite-session))))
(cond
((kite-source-map-p cached-entry)
cached-entry)
((consp cached-entry)
(signal (car cached-entry) (cdr cached-entry)))
(t
(condition-case err
(puthash (kite-script-info-source-map-url script-info)
(kite-script-info--source-map script-info)
(kite-session-source-map-cache kite-session))
(error
(puthash (kite-script-info-source-map-url script-info)
err
(kite-session-source-map-cache kite-session))
(signal (car err) (cdr err)))))))))
(defun kite-script-info--original-source (script-info line column)
"Return original URL, line, and column corresponding to the
given SCRIPT-INFO, LINE, and COLUMN. The original location is
returned as a plist with keys `:url', `:line' and `:column'."
(let ((source-map
(condition-case err
(kite-script-info--source-map-cached script-info)
(error
;; In case of error, display error and fall back to
;; generated source
(message (cdr err))
nil))))
(if source-map
(let ((original-pos
(kite-source-map-original-position-for
source-map
line
column)))
(list :url
(url-expand-file-name
(plist-get original-pos :source)
(kite-script-info-url script-info))
:line (plist-get original-pos :line)
:column (plist-get original-pos :column)))
(list :url (kite-script-info-url script-info)
:line line
:column column))))
(defun kite-visit-script (script-info line column after-load-function)
"Visit the script described by the given SCRIPT-INFO and, once
loaded, move point to LINE and COLUMN and execute
AFTER-LOAD-FUNCTION with the new buffer current. If a source map
is available, go to the original location instead."
(interactive)
(let* ((original-source (kite-script-info--original-source
script-info
line
column))
(url (plist-get original-source :url))
(url-parts (url-generic-parse-url url)))
(flet
((after-load ()
(goto-char (point-min))
(forward-line
(1- (plist-get original-source :line)))
(beginning-of-line)
(forward-char
(plist-get original-source :column))
(funcall after-load-function)))
(cond
((string= (url-type url-parts) "file")
(find-file (url-filename url-parts))
(after-load))
(t
(switch-to-buffer
(or (get-buffer url)
(kite--create-remote-script-buffer
script-info (function after-load)))))))))
(defun kite--debug-stats-mode-line-indicator ()
"Returns a string to be displayed in the mode line"
(concat " (" (kite-session-debugger-state kite-session) ")"))
(defun kite-session-script-info-for-url (url)
"Return the script-info entry for the given URL in the session
bound to `kite-session', or nil if not found."
(let (result)
(maphash (lambda (key value)
(when (string= url (kite-script-info-url value))
(setq result value)))
(kite-session-script-infos kite-session))
result))
(defun kite-visit-stack-frame (stack-frame-plist)
"Visit the source file corresponding to the stack frame given
by STACK-FRAME-PLIST, which should be a plist with at least the
properties `:url', `:lineNumber' and `:columnNumber'. The
variable `kite-session' should be bound to the session in which
to visit the source file."
(let ((line-number (plist-get stack-frame-plist :lineNumber))
(column-number (plist-get stack-frame-plist :columnNumber))
(script-info (kite-session-script-info-for-url
(plist-get stack-frame-plist :url))))
(if script-info
(kite-visit-script
script-info
line-number
column-number
(lambda ()
(set (make-local-variable 'kite-session) kite-session)))
(error "Source is unavailable"))))
(provide 'kite-debug)
;;; kite-debug.el ends here