From 38222bb0ae1d282a458c3318a1789d932bd0655b Mon Sep 17 00:00:00 2001 From: Teddy Wing Date: Sun, 21 Feb 2021 17:56:14 +0100 Subject: Add `--debug` option to print debug output Let's keep a way to print WebSocket messages for debugging purposes in the release build rather than remove the messages completely. Since I've been struggling with the messages so much it seems like this could be a useful thing to have. --- l/src/config.lisp | 27 +++++++++++++++++++++------ l/src/main.lisp | 17 +++++++++-------- l/src/option.lisp | 1 + 3 files changed, 31 insertions(+), 14 deletions(-) diff --git a/l/src/config.lisp b/l/src/config.lisp index f826537..d01a1fd 100644 --- a/l/src/config.lisp +++ b/l/src/config.lisp @@ -14,6 +14,11 @@ :initform nil :reader reload-current-tab :documentation "True if the current tab should be reloaded") + (debug-output + :initarg :debug-output + :initform nil + :reader debug-output + :documentation "True to enable debug output") (ws-client :reader ws-client @@ -21,16 +26,26 @@ (defmethod print-object ((object config) stream) (print-unreadable-object (object stream :type t) - (with-slots (socket-url extension-ids reload-current-tab ws-client) object - (format stream - ":socket-url ~s :extension-ids ~s :reload-current-tab ~s :ws-client ~s" - socket-url extension-ids reload-current-tab ws-client)))) + (with-slots (socket-url + extension-ids + reload-current-tab + debug-output + ws-client) + object + (format + stream + ":socket-url ~s :extension-ids ~s :reload-current-tab ~s :debug-output ~s :ws-client ~s" + socket-url extension-ids reload-current-tab debug-output ws-client)))) -(defun make-config (&key socket-url extension-ids reload-current-tab) +(defun make-config (&key socket-url + extension-ids + reload-current-tab + debug-output) (let ((config (make-instance 'config :socket-url socket-url :extension-ids extension-ids - :reload-current-tab reload-current-tab))) + :reload-current-tab reload-current-tab + :debug-output debug-output))) ;; Initialise a new websocket-driver client (setf (slot-value config 'ws-client) (wsd:make-client socket-url)) diff --git a/l/src/main.lisp b/l/src/main.lisp index 6f6ed6b..8df0172 100644 --- a/l/src/main.lisp +++ b/l/src/main.lisp @@ -18,6 +18,9 @@ (:name :reload-current-tab :description "pass this to reload the active Chrome tab" :long "reload-current-tab") + (:name :debug + :description "print debug output" + :long "debug") (:name :help :description "print this help menu" :short #\h @@ -42,18 +45,19 @@ (ws-on-message message (extension-ids config) - (reload-current-tab config)))) + config))) (websocket-send *client* (target-get-targets-msg (next-call-id *devtools-root-call-id*))) (wait-group:wait *wg*)))))) -(defun ws-on-message (message extension-ids reload-current-tab) +(defun ws-on-message (message extension-ids config) (let* ((response (jsown:parse message)) (targets (parse-get-targets-response response))) - (format t "Response: ~a~%" response) - (format t "~a~%" *wg*) + (when (debug-output config) + (format t "Response: ~a~%" response) + (format t "~a~%" *wg*)) (when targets (let ((targets (extension-targets targets))) @@ -66,9 +70,8 @@ (json-obj-get response "params") "sessionId"))) - (when (and reload-current-tab + (when (and (reload-current-tab config) (runtime-evaluate-msg-p response)) - (format t "Reloading based on response: ~a~%" response) (reload-tab (json-obj-get (json-obj-get response "result") "sessionId"))) @@ -108,7 +111,6 @@ (defun reload-extension (session-id) ;; Use call ID "1" as this is the first message sent to the attached target. - (format t "reloading EXTENSION~%") (setf *last-session-id* session-id) (websocket-send *client* @@ -122,7 +124,6 @@ (defun reload-tab (session-id) ;; Use call ID "2" as this will always be sent after a `reload-extension` ;; message. - (format t "reloading NOW~%") (websocket-send *client* (runtime-evaluate-msg diff --git a/l/src/option.lisp b/l/src/option.lisp index 02c89c2..6965b71 100644 --- a/l/src/option.lisp +++ b/l/src/option.lisp @@ -48,4 +48,5 @@ (make-config :socket-url (getf options :socket-url) :reload-current-tab (getf options :reload-current-tab) + :debug-output (getf options :debug) :extension-ids free-args))) -- cgit v1.2.3