[elpa] externals/realgud 639db29 46/72: Add locals window

[Stefan Monnier]

branch: externals/realgud
commit 639db299467a5b98f1384cd62562746fe0a00d0f
Author: 813 <813gan@protonmail.com>
Commit: 813 <813gan@protonmail.com>

    Add locals window
---
 realgud.el                       |   1 +
 realgud/common/buffer/command.el |  12 ++++
 realgud/common/buffer/helper.el  |  22 +++++++
 realgud/common/buffer/locals.el  | 125 +++++++++++++++++++++++++++++++++++++++
 realgud/common/cmds.el           |  18 ++++++
 realgud/common/key.el            |   1 +
 realgud/common/locals-mode.el    |  23 +++++++
 realgud/common/window.el         |   8 +++
 realgud/debugger/pdb/init.el     |   4 ++
 9 files changed, 214 insertions(+)

diff --git a/realgud.el b/realgud.el
index b9d3635..b7796f5 100644
--- a/realgud.el
+++ b/realgud.el
@@ -95,6 +95,7 @@
        "./realgud/common/track-mode"
        "./realgud/common/backtrack-mode"
        "./realgud/common/breakpoint-mode"
+       "./realgud/common/locals-mode"
        "./realgud/common/utils"
        "./realgud/debugger/bashdb/bashdb"
        "./realgud/debugger/gdb/gdb"
diff --git a/realgud/common/buffer/command.el b/realgud/common/buffer/command.el
index fb0602c..89baf72 100644
--- a/realgud/common/buffer/command.el
+++ b/realgud/common/buffer/command.el
@@ -86,6 +86,8 @@
 
   bt-buf               ;; backtrace buffer if it exists
   brkpt-buf            ;; breakpoint buffer if it exists
+  locals-buf           ;; locals buffer if it exists
+  locals-data          ;; hash that holds data for locals-buffer
   bp-list              ;; list of breakpoints
   divert-output?       ;; Output is part of a conversation between front-end
                        ;; debugger.
@@ -151,6 +153,7 @@
 (realgud-struct-field-setter "realgud-cmdbuf-info" "bp-list")
 (realgud-struct-field-setter "realgud-cmdbuf-info" "bt-buf")
 (realgud-struct-field-setter "realgud-cmdbuf-info" "brkpt-buf")
+(realgud-struct-field-setter "realgud-cmdbuf-info" "locals-buf")
 (realgud-struct-field-setter "realgud-cmdbuf-info" "cmd-args")
 (realgud-struct-field-setter "realgud-cmdbuf-info" "last-input-end")
 (realgud-struct-field-setter "realgud-cmdbuf-info" "divert-output?")
@@ -456,6 +459,8 @@ values set in the debugger's init.el."
             :srcbuf-list nil
             :bt-buf nil
             :brkpt-buf nil
+            :locals-buf nil
+            :locals-data (make-hash-table :test 'equal)
             :bp-list nil
             :divert-output? nil
             :cmd-hash cmd-hash
@@ -574,5 +579,12 @@ command-process buffer has stored."
       ))
   )
 
+(defun realgud-get-info (key &optional opt-buffer)
+  (let* ((buffer (or opt-buffer (current-buffer)))
+        (cmdbuf (realgud-get-cmdbuf buffer)))
+    (if cmdbuf
+       (with-current-buffer-safe cmdbuf
+         (realgud-sget 'cmdbuf-info key))
+      (error "Unable to find cmdbuf for '%s'" buffer)) ))
 
 (provide-me "realgud-buffer-")
diff --git a/realgud/common/buffer/helper.el b/realgud/common/buffer/helper.el
index eb17983..e754dd0 100644
--- a/realgud/common/buffer/helper.el
+++ b/realgud/common/buffer/helper.el
@@ -47,6 +47,16 @@ assumed to be a source-code buffer."
          (realgud-sget 'breakpoint-info 'cmdbuf))
       nil)))
 
+(defun realgud-get-cmdbuf-from-locals ( &optional opt-buffer)
+  "Return the command buffer associated with source
+OPT-BUFFER or if that is ommited `current-buffer' which is
+assumed to be a source-code buffer."
+  (let ((buffer (or opt-buffer (current-buffer))))
+    (if (realgud-locals? buffer)
+       (with-current-buffer-safe buffer
+         (realgud-sget 'locals-info 'cmdbuf))
+      nil)))
+
 (defun realgud-get-cmdbuf-from-srcbuf ( &optional opt-buffer)
   "Return the command buffer associated with source
 OPT-BUFFER or if that is ommited `current-buffer' which is
@@ -128,6 +138,8 @@ if we don't find anything."
        (realgud-get-cmdbuf-from-backtrace buffer))
        ((realgud-breakpoint? buffer)
        (realgud-get-cmdbuf-from-breakpoint buffer))
+       ((realgud-locals? buffer)
+       (realgud-get-cmdbuf-from-locals buffer))
        (t nil)))))
 
 (defun realgud-get-backtrace-buf( &optional opt-buffer)
@@ -150,6 +162,16 @@ OPT-BUFFER or if that is ommited `current-buffer'."
       ))
   )
 
+(defun realgud-get-locals-buf( &optional opt-buffer)
+  "Return the locals buffer associated with
+OPT-BUFFER or if that is ommited `current-buffer'."
+  (let* ((buffer (or opt-buffer (current-buffer)))
+        (cmdbuf (realgud-get-cmdbuf buffer)))
+    (with-current-buffer-safe cmdbuf
+      (realgud-sget 'cmdbuf-info 'locals-buf)
+      ))
+  )
+
 (defun realgud-get-process (&optional opt-buffer)
   "Return the process buffer associated with OPT-BUFFER or
   `current-buffer' if that is omitted. nil is returned if
diff --git a/realgud/common/buffer/locals.el b/realgud/common/buffer/locals.el
new file mode 100644
index 0000000..cc3fa9a
--- /dev/null
+++ b/realgud/common/buffer/locals.el
@@ -0,0 +1,125 @@
+(require 'load-relative)
+(require-relative-list
+ '("helper") "realgud-")
+(require-relative-list
+ '("command") "realgud-buffer-")
+
+(make-variable-buffer-local (defvar realgud-buffer-type 'locals))
+
+(cl-defstruct realgud-locals-info
+  "debugger object/structure specific to a (top-level) program to be debugged."
+  (cmdbuf    nil)  ;; buffer of the associated debugger process
+  )
+(make-variable-buffer-local (defvar realgud-locals-info))
+
+(defun realgud-locals? ( &optional buffer)
+  (with-current-buffer-safe
+      (or buffer (current-buffer))
+    (and (boundp 'realgud-buffer-type)
+        (equal realgud-buffer-type 'locals) )))
+
+(defun realgud-run-command-get-output (cmd &rest args)
+  "Run debugger command and split output into list.
+
+First line (with command itself) is excluded.
+CMD - command to be executed
+ARGS - arguments for command"
+  (with-current-buffer-safe (realgud-get-cmdbuf)
+    (let ((sleep-count 0)
+         (process (get-buffer-process (current-buffer)))
+         (realgud-track-divert-string nil))
+      (realgud-cmdbuf-info-divert-output?= t)
+      (if args
+         (apply cmd args)
+       (funcall cmd))
+      (while (and (eq 'run (process-status process))
+                 (null realgud-track-divert-string)
+                 (> 1000 (setq sleep-count (1+ sleep-count))))
+       (sleep-for 0.001)
+       )
+      (if (>= sleep-count 1000)
+         (error "%s" "Timeout on running debugger command")
+       (cdr (split-string realgud-track-divert-string "\n" t)) )) ))
+
+(defun realgud-locals-init ()
+  "Create locals buffer."
+  (let ((cmdbuf (realgud-get-cmdbuf)))
+    (with-current-buffer-safe cmdbuf
+      (let ((locals-buffer (get-buffer-create
+                           (format "*locals %s*"
+                                   (realgud-get-buffer-base-name
+                                    (buffer-name))))))
+       (realgud-cmdbuf-info-locals-buf= locals-buffer)
+       (with-current-buffer locals-buffer
+         (realgud-locals-mode)
+         (set (make-local-variable 'realgud-locals-info)
+              (make-realgud-locals-info
+               :cmdbuf cmdbuf)) )
+       (realgud-locals-register-reload)
+       (realgud-locals-insert) ))))
+
+(defun realgud-locals-get-variable-data (local-var-name)
+  "Return list with type and value of variable, in that order.
+
+LOCAL-VAR-NAME - variable to inspect"
+  (list
+   (car (realgud-run-command-get-output 'realgud:cmd-info-type local-var-name))
+   (car (realgud-run-command-get-output 'realgud:cmd-info-value 
local-var-name)) ))
+
+(defun realgud-locals-register-reload ()
+  "Get list of local variables and load values selected by user."
+  (let* ((locals-names-list (realgud-run-command-get-output 
'realgud:cmd-info-locals-name-list))
+        (frame-id 'frame_id_placeholder)
+        (locals-data-hash (realgud-get-info 'locals-data))
+        (frame-data-hash (gethash frame-id locals-data-hash))
+        (new-frame-data-hash (make-hash-table :test 'equal)))
+    (dolist (local-var-name locals-names-list)
+      (if (and frame-data-hash
+              (gethash local-var-name frame-data-hash))
+         (puthash local-var-name
+                  (realgud-locals-get-variable-data local-var-name)
+                  new-frame-data-hash)
+       (puthash local-var-name nil new-frame-data-hash) ) )
+    (puthash frame-id new-frame-data-hash locals-data-hash) )) ; TODO remove 
non-exising keys instead creating new hash?
+
+(defun realgud-locals-toggle-value-visibility (local-var-name)
+  "Update value of single variable in frame hash and update locale buffer.
+
+LOCAL-VAR-NAME - variable to toggle"
+  (interactive "sVariable: ")
+  (let* ((frame-id 'frame_id_placeholder)
+        (locals-data-hash (realgud-get-info 'locals-data))
+        (frame-data-hash (gethash frame-id locals-data-hash))
+        (value nil))
+    (unless (gethash local-var-name frame-data-hash)
+      (setq value (realgud-locals-get-variable-data local-var-name)))
+    (puthash local-var-name value frame-data-hash) )
+  (realgud-locals-insert) )
+
+(defun realgud-locals-insert ()
+  "Serialize and format locales data."
+  (let ((frame-data-hash
+        (gethash 'frame_id_placeholder (realgud-get-info 'locals-data)))
+       (variable-data nil)
+       (prev-buffer-end (point-min)) )
+    (with-current-buffer (realgud-get-locals-buf)
+      (setq buffer-read-only nil)
+      (delete-region (point-min) (point-max))
+      (dolist (variable (hash-table-keys frame-data-hash))
+       (setq variable-data (gethash variable frame-data-hash))
+       (insert variable)
+       (make-button prev-buffer-end (point-max)
+                    'variable variable
+                    'action (lambda (button)
+                              (realgud-locals-toggle-value-visibility
+                               (button-get button 'variable) )) )
+       (when variable-data
+             (insert " ")
+             (insert (nth 0 variable-data))
+             (insert " ")
+             (insert (nth 1 variable-data)) )
+       (insert "\n")
+       (setq prev-buffer-end (point-max)) )
+      (setq buffer-read-only t) )) )
+
+(provide-me "realgud-")
diff --git a/realgud/common/cmds.el b/realgud/common/cmds.el
index b8ec55a..9c7facf 100644
--- a/realgud/common/cmds.el
+++ b/realgud/common/cmds.el
@@ -362,6 +362,24 @@ If no argument specified use 0 or the most recent frame."
   (realgud:cmd-run-command nil "info-breakpoints")
   )
 
+(defun realgud:cmd-info-locals-name-list()
+  "Get list of locals value's names"
+  (interactive "")
+  (realgud:cmd-run-command nil "info-locals-names-list")
+  )
+
+(defun realgud:cmd-info-value(var-name)
+  "Get value of single variable"
+  (interactive "sVariable name: ")
+  (realgud:cmd-run-command var-name "info-value")
+  )
+
+(defun realgud:cmd-info-type(var-name)
+  "Get type of single variable"
+  (interactive "sVariable name: ")
+  (realgud:cmd-run-command var-name "info-type")
+  )
+
 (defun realgud:cmd-kill()
   "Kill debugger process."
   (interactive)
diff --git a/realgud/common/key.el b/realgud/common/key.el
index d21e0a7..f4daf70 100644
--- a/realgud/common/key.el
+++ b/realgud/common/key.el
@@ -117,6 +117,7 @@ Nor does it touch prefix keys; for that see 
`realgud-populate-keys-standard'"
     (define-key map ">" 'realgud:cmd-older-frame)
     (define-key map "d" 'realgud:cmd-newer-frame)
     (define-key map "B" 'realgud:window-brkpt)
+    (define-key map "L" 'realgud:window-locals)
     (define-key map "u" 'realgud:cmd-older-frame)
     (define-key map "C" 'realgud-window-cmd-undisturb-src)
     (define-key map "F" 'realgud:window-bt)
diff --git a/realgud/common/locals-mode.el b/realgud/common/locals-mode.el
new file mode 100644
index 0000000..b913581
--- /dev/null
+++ b/realgud/common/locals-mode.el
@@ -0,0 +1,23 @@
+(require 'load-relative)
+(require-relative-list
+ '("helper" "buffer/locals") "realgud-")
+
+(defvar realgud-locals-mode-map
+  (let ((map  (realgud-populate-debugger-menu (make-sparse-keymap))))
+    (suppress-keymap map)
+    (realgud-populate-common-keys map)
+    (define-key map "q"       'realgud:cmd-quit)
+    (define-key map "L"       'realgud:window-locals)
+    map)
+  )
+
+(defun realgud-locals-mode ()
+  (interactive)
+  (kill-all-local-variables)
+  (setq buffer-read-only 't)
+  (setq major-mode 'realgud-locals-mode)
+  (setq mode-name "Realgud Locals")
+  (use-local-map realgud-locals-mode-map)
+  )
+
+(provide-me "realgud-")
diff --git a/realgud/common/window.el b/realgud/common/window.el
index b5f1e66..28057a4 100644
--- a/realgud/common/window.el
+++ b/realgud/common/window.el
@@ -198,6 +198,14 @@ See also `realgud-window-src'"
   )
 
 
+(defun realgud:window-locals()
+  "Refresh locals information and display that in a buffer"
+  (interactive)
+  (with-current-buffer-safe (realgud-get-cmdbuf)
+    (realgud-locals-init)
+    )
+  )
+
 ;; (defun realgud-window-src-and-cmd ( &optional opt-buffer )
 ;;   "Make sure the source buffers is displayed in windows without
 ;; disturbing the command window if it is also displayed. Returns
diff --git a/realgud/debugger/pdb/init.el b/realgud/debugger/pdb/init.el
index 95b35ec..5de93d6 100644
--- a/realgud/debugger/pdb/init.el
+++ b/realgud/debugger/pdb/init.el
@@ -159,6 +159,10 @@ the pdb command to use, like 'return'")
 (setf (gethash "eval"             realgud:pdb-command-hash) "!%s")
 (setf (gethash "info-breakpoints" realgud:pdb-command-hash) "break")
 
+(setf (gethash "info-locals-names-list" realgud:pdb-command-hash) 
"print('\\n'.join(locals().keys()))")
+(setf (gethash "info-value" realgud:pdb-command-hash) "pp %s")
+(setf (gethash "info-type" realgud:pdb-command-hash) "type(%s)")
+
 ;; Unsupported features:
 (setf (gethash "shell" realgud:pdb-command-hash) "*not-implemented*")
 (setf (gethash "frame" realgud:pdb-command-hash) "*not-implemented*")