[elpa] externals/realgud de31e77 55/72: Merge pull request #276 from 813gan/locals-window-v2.1

[Stefan Monnier]

branch: externals/realgud
commit de31e772092bf40cdc7de4ab3c63efe04f8e6736
Merge: 42bb9af 48c2562
Author: R. Bernstein <rocky@users.noreply.github.com>
Commit: GitHub <noreply@github.com>

    Merge pull request #276 from 813gan/locals-window-v2.1
    
    Locals window v2.1
---
 realgud.el                       |   1 +
 realgud/common/buffer/command.el |  13 ++++
 realgud/common/buffer/helper.el  |  25 ++++++-
 realgud/common/buffer/locals.el  | 157 +++++++++++++++++++++++++++++++++++++++
 realgud/common/cmds.el           |  18 +++++
 realgud/common/custom.el         |   5 ++
 realgud/common/key.el            |   1 +
 realgud/common/locals-mode.el    |  41 ++++++++++
 realgud/common/track.el          |   2 +
 realgud/common/window.el         |  44 +++++++++++
 realgud/debugger/pdb/init.el     |   4 +
 11 files changed, 310 insertions(+), 1 deletion(-)

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..8879708 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,13 @@ command-process buffer has stored."
       ))
   )
 
+(defun realgud-get-info (key &optional opt-buffer)
+  "Convinient function for getting data from realgud-cmdbuf-info."
+  (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..7589ce2 100644
--- a/realgud/common/buffer/helper.el
+++ b/realgud/common/buffer/helper.el
@@ -13,12 +13,13 @@
 ;; GNU General Public License for more details.
 
 (require 'load-relative)
-(require-relative-list '("../fringe" "../helper" "../lochist")
+(require-relative-list '("../fringe" "../helper" "../lochist" "locals")
                       "realgud-")
 (require-relative-list '("command" "source" "backtrace" "breakpoint") 
"realgud-buffer-")
 
 (declare-function realgud-backtrace?        'realgud-buffer-backtace)
 (declare-function realgud-breakpoint?       'realgud-buffer-breakpoint)
+(declare-function realgud-locals?           'realgud-buffer-locals)
 (declare-function realgud-cmdbuf?           'realgud-buffer-command)
 (declare-function realgud:loc-hist-describe 'realgud-lochist)
 (declare-function realgud-loc-hist-item     'realgud-lochist)
@@ -47,6 +48,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 +139,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 +163,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..33ca741
--- /dev/null
+++ b/realgud/common/buffer/locals.el
@@ -0,0 +1,157 @@
+;;; Locals buffer
+
+;; Author: 813gan
+
+;; This program 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.
+
+;; This program 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 this program.  If not, see
+;; <http://www.gnu.org/licenses/>.
+
+(require 'load-relative)
+(require-relative-list
+ '("helper") "realgud-")
+(require-relative-list
+ '("command") "realgud-buffer-")
+
+;; Local variable for easier buffer identification
+;; "realgud-locals-init" will set it to "'locals"
+(make-variable-buffer-local (defvar realgud-buffer-type))
+
+(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
+  (srcbuf    nil)  ;; associated source buffer
+  )
+(make-variable-buffer-local (defvar realgud-locals-info))
+
+(defun realgud-locals? ( &optional buffer)
+  "Return true if BUFFER is a locals buffer.
+
+If no BUFFER is given, current buffer is used."
+  (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 and fill it for first time."
+  (let ((cmdbuf (realgud-get-cmdbuf))
+       (srcbuf (realgud-get-srcbuf)))
+    (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-safe (realgud-get-srcbuf)
+         (add-hook 'realgud-update-hook 'realgud:window-locals nil t) )
+       (with-current-buffer locals-buffer
+         (realgud-locals-mode) ; It kills local variables
+         (add-hook 'kill-buffer-hook
+                   (lambda ()
+                     (with-current-buffer-safe (realgud-sget 'locals-info 
'srcbuf)
+                       (remove-hook 'realgud-update-hook 
'realgud:window-locals t) )) nil t)
+         (setq realgud-buffer-type 'locals)
+         (set (make-local-variable 'realgud-locals-info)
+              (make-realgud-locals-info
+               :cmdbuf cmdbuf
+               :srcbuf srcbuf)) )
+       (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))
+   (mapconcat 'identity (realgud-run-command-get-output 
'realgud:cmd-info-value local-var-name) "\n") ))
+
+(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/custom.el b/realgud/common/custom.el
index d429b23..771bc31 100644
--- a/realgud/common/custom.el
+++ b/realgud/common/custom.el
@@ -25,4 +25,9 @@ A setting of `nil` allows editing, but Short-Key-mode use may 
inhibit this."
   :type 'boolean
   :group 'realgud)
 
+(defcustom realgud-update-hook nil
+  "List of hooks to be run when debugger hits breakpoint"
+  :type 'hook
+  :group 'realgud)
+
 (provide-me "realgud-")
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..4b3ec81
--- /dev/null
+++ b/realgud/common/locals-mode.el
@@ -0,0 +1,41 @@
+;;; Locals buffer
+
+;; Author: 813gan
+
+;; This program 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.
+
+;; This program 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 this program.  If not, see
+;; <http://www.gnu.org/licenses/>.
+
+(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/track.el b/realgud/common/track.el
index 11b6b44..6d09d3a 100644
--- a/realgud/common/track.el
+++ b/realgud/common/track.el
@@ -435,6 +435,8 @@ encountering a new loc."
            (realgud-cmdbuf-info-in-srcbuf?= nil))
          )
        ))
+  (with-current-buffer-safe (realgud-get-srcbuf)
+    (run-hooks 'realgud-update-hook) )
   )
 
 (defun realgud-track-loc(text cmd-mark &optional opt-regexp opt-file-group
diff --git a/realgud/common/window.el b/realgud/common/window.el
index b5f1e66..1677000 100644
--- a/realgud/common/window.el
+++ b/realgud/common/window.el
@@ -178,6 +178,41 @@ See also `realgud-window-src'"
     src-window)
   )
 
+(defun realgud:window-locals-undisturb-src ( &optional opt-buffer switch?)
+  "Make sure the locals buffer is displayed in windows without
+disturbing the source window if it is also displayed. Returns
+the source window
+See also `realgud-window-src'"
+  (interactive)
+  (let* ((buffer (or opt-buffer (current-buffer)))
+        (src-buffer (realgud-get-srcbuf buffer))
+        (src-window (get-buffer-window src-buffer))
+        (cmd-buffer (realgud-get-cmdbuf buffer))
+        (cmd-window (get-buffer-window cmd-buffer))
+        (locals-buffer (realgud-get-locals-buf cmd-buffer))
+        (locals-window (get-buffer-window locals-buffer))
+        (window (selected-window))
+        )
+    (when cmd-buffer
+      (unless locals-window
+       (setq locals-window
+             (if (eq window src-window)
+                 ;; FIXME: generalize what to do here.
+                 (if (one-window-p 't)
+                     (split-window)
+                   (next-window window 'no-minibuf))
+               window))
+       (set-window-buffer locals-window locals-buffer)
+       )
+      (if switch?
+         (and (select-window locals-window)
+              (switch-to-buffer locals-buffer)))
+
+      )
+    src-window)
+  )
+
+
 (defun realgud:window-bt()
   "Refresh backtrace information and display that in a buffer"
   (interactive)
@@ -198,6 +233,15 @@ 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)
+    (realgud:window-locals-undisturb-src)
+    )
+  )
+
 ;; (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*")