emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/realgud 57a8fc1 126/140: Merge pull request #244 from r


From: Rocky Bernstein
Subject: [elpa] externals/realgud 57a8fc1 126/140: Merge pull request #244 from realgud/add-brpt-buffer
Date: Sat, 25 May 2019 19:35:48 -0400 (EDT)

branch: externals/realgud
commit 57a8fc1b6b88ac75ed45ea1fed4599b252013564
Merge: 79c982d 8028bfb
Author: R. Bernstein <address@hidden>
Commit: GitHub <address@hidden>

    Merge pull request #244 from realgud/add-brpt-buffer
    
    Add a breakpoint buffer analogous to backtrace
---
 realgud/common/breakpoint-mode.el   |  83 +++++++++
 realgud/common/buffer/breakpoint.el | 344 ++++++++++++++++++++++++++++++++++++
 realgud/common/buffer/command.el    |  11 +-
 realgud/common/buffer/helper.el     |  27 ++-
 realgud/common/cmds.el              |   6 +
 realgud/common/init.el              |   5 +-
 realgud/common/track.el             |   3 +-
 realgud/common/window.el            |  53 +++++-
 realgud/debugger/gdb/init.el        |  19 ++
 realgud/debugger/trepan3k/init.el   |  11 +-
 realgud/lang/python.el              |  34 ++++
 test/regexp-helper.el               |   8 +-
 test/test-loc-regexp-gdb.el         |  15 ++
 test/test-regexp-trepan3k.el        |  15 ++
 14 files changed, 618 insertions(+), 16 deletions(-)

diff --git a/realgud/common/breakpoint-mode.el 
b/realgud/common/breakpoint-mode.el
new file mode 100644
index 0000000..9e57b61
--- /dev/null
+++ b/realgud/common/breakpoint-mode.el
@@ -0,0 +1,83 @@
+;; Copyright (C) 2019 Free Software Foundation, Inc
+
+;; Author: Rocky Bernstein <address@hidden>
+
+;; 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/>.
+;;; Debugger Breakpoint buffer mode settings
+(require 'load-relative)
+(require-relative-list  '("menu" "key") "realgud-")
+(require-relative-list  '("buffer/command") "realgud-buffer-")
+
+(declare-function realgud-populate-debugger-menu 'realgud-menu)
+(declare-function realgud-populate-common-keys 'realgud-menu)
+(declare-function realgud-cmdbuf-pat 'realgud-menu)
+
+(defvar realgud:breakpoints-menu nil
+  "menu in Breakpoints buffer.")
+
+
+(defvar realgud-breakpoint-mode-map
+  (let ((map  (realgud-populate-debugger-menu (make-sparse-keymap))))
+    (suppress-keymap map)
+    (realgud-populate-common-keys map)
+    (define-key map "r"       'realgud:breakpoint-init)
+    (define-key map [double-mouse-1] 'realgud:follow-event)
+    (define-key map [mouse-2] 'realgud:follow-event)
+    (define-key map [enter]   'realgud:follow-event)
+    (define-key map [mouse-3] 'realgud:follow-event)
+    (define-key map [enter]   'realgud:follow-event)
+    (define-key map [return]  'realgud:follow-point)
+    (define-key map "l"       'realgud-recenter-arrow)
+
+    (define-key map [frames-menu]
+      (list 'menu-item "Specific Frames" 'realgud:frames-menu))
+
+    ;; FIXME: these can go to a common routine. See also shortkey.el and
+    ;; key.el
+    (define-key map "q"       'realgud:cmd-quit)
+    (define-key map "C"       'realgud-window-cmd-undisturb-src)
+    (define-key map "F"       'realgud:window-bt)
+    (define-key map "I"       'realgud:cmdbuf-info-describe)
+    (define-key map "S"       'realgud-window-src-undisturb-cmd)
+
+    map)
+  "Keymap to navigate realgud breakpoints.
+
+\\{realgud-breakpoint-mode-map}")
+
+(defun realgud-breakpoint-mode (&optional cmdbuf)
+  "Major mode for displaying the stack frames.
+\\{realgud-frames-mode-map}"
+  (interactive)
+  (kill-all-local-variables)
+  (setq buffer-read-only 't)
+  (setq major-mode 'realgud-breakpoint-mode)
+  (setq mode-name "Realgud Breakpoints")
+  ;; (set (make-local-variable 'realgud-secondary-buffer) t)
+  (setq mode-line-process 'realgud-mode-line-process)
+  (use-local-map realgud-breakpoint-mode-map)
+
+  ;; FIXME: make buffer specific
+  (if cmdbuf
+      (let* ((font-lock-breakpoint-keywords
+             (with-current-buffer cmdbuf
+               (realgud-cmdbuf-pat "font-lock-breakpoint-keywords"))))
+       (if font-lock-breakpoint-keywords
+           (set (make-local-variable 'font-lock-defaults)
+                (list font-lock-breakpoint-keywords)))
+       ))
+  ;; (run-mode-hooks 'realgud-breakpoint-mode-hook)
+  )
+
+(provide-me "realgud-")
diff --git a/realgud/common/buffer/breakpoint.el 
b/realgud/common/buffer/breakpoint.el
new file mode 100644
index 0000000..da49db2
--- /dev/null
+++ b/realgud/common/buffer/breakpoint.el
@@ -0,0 +1,344 @@
+;;; Backtrace buffer
+
+;; Author: Rocky Bernstein <address@hidden>
+
+;; Copyright (C) 2019 Free Software Foundation, Inc
+
+;; 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 'ansi-color)
+(require 'ring)
+(require 'load-relative)
+(eval-when-compile (require 'cl-lib))
+(require-relative-list
+ '("../key" "helper" "../follow" "../loc") "realgud-")
+
+(require-relative-list
+ '("command") "realgud-buffer-")
+
+(declare-function realgud-cmdbuf-debugger-name        'realgud-buffer-command)
+(declare-function realgud-cmdbuf?                     'realgud-buffer-command)
+(declare-function realgud-cmdbuf-info-divert-output?= 'realgud-buffer-command)
+(declare-function realgud-breakpoint-mode (cmdbuf))
+(declare-function realgud:cmd-breakpoint (arg))
+(declare-function realgud:cmd-info-breakpoints 'realgud-cmds)
+(declare-function realgud-cmdbuf-pat(key))
+(declare-function realgud-cmdbuf-info-in-srcbuf?= (arg))
+(declare-function realgud-get-cmdbuf 'realgud-buffer-helper)
+(declare-function realgud:file-loc-from-line 'realgud-file)
+(declare-function buffer-killed?       'realgud-helper)
+(declare-function realgud:loc-describe 'realgud-loc)
+
+(cl-defstruct realgud-breakpoint-info
+  "debugger object/structure specific to a (top-level) program to be debugged."
+  (cmdbuf    nil)  ;; buffer of the associated debugger process
+  (cur-pos   0)    ;; beakpoint we are at
+  breakpoint-ring  ;; ring of marks in buffer of breakpoint numbers. The
+                   ;; text at that marker has additional properties about the
+                   ;; breakpoint
+)
+
+(declare-function realgud:cmd-frame 'realgud-buffer-command)
+(declare-function realgud-get-cmdbuf(&optional opt-buffer))
+(declare-function realgud-command 'realgud-send)
+
+(make-variable-buffer-local (defvar realgud-breakpoint-info))
+
+;: FIXME: not picked up from track. Why?
+(defvar realgud-track-divert-string nil)
+
+(defvar realgud-goto-entry-acc "")
+
+(defun realgud:breakpoint-describe (&optional buffer)
+  (interactive "")
+  (unless buffer (setq buffer (current-buffer)))
+  (with-current-buffer buffer
+    (let ((breakpoints (realgud-breakpoint-info-breakpoint-ring 
realgud-breakpoint-info))
+         (brkpt)
+         (loc)
+         (i 0))
+      (switch-to-buffer (get-buffer-create "*Describe Breakpoints*"))
+      (while (and (< i (ring-length breakpoints)) (setq brkpt (ring-ref 
breakpoints i)))
+       (insert (format "*** %d\n" i))
+       (insert (format "%s\n" brkpt))
+       (when (markerp brkpt)
+         (with-current-buffer (marker-buffer brkpt)
+           (goto-char brkpt)
+           (setq loc (get-text-property (point) 'loc))
+         )
+         (when loc (realgud:loc-describe loc)))
+       (setq i (1+ i))
+      )
+    )
+    ))
+
+;; FIXME: create this in a new frame.
+(defun realgud:breakpoint-init ()
+  (interactive)
+  (let ((buffer (current-buffer))
+       (cmdbuf (realgud-get-cmdbuf))
+       (process)
+       )
+    (with-current-buffer-safe cmdbuf
+      (let ((brkpt-pat (realgud-cmdbuf-pat "debugger-breakpoint"))
+           (brkpt-pos-ring)
+           (sleep-count 0)
+           )
+       (unless brkpt-pat
+         (error "No 'debugger-breakpoint' regular expression recorded for 
debugger %s"
+                (realgud-cmdbuf-debugger-name)))
+       (setq process (get-buffer-process (current-buffer)))
+       (realgud-cmdbuf-info-in-srcbuf?= (not (realgud-cmdbuf? buffer)))
+       (realgud-cmdbuf-info-divert-output?= t)
+       (setq realgud-track-divert-string nil)
+       (realgud:cmd-info-breakpoints)
+       (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)
+           (message "Timeout on running debugger command")
+         ;; else
+         ;; (message "+++4 %s" realgud-track-divert-string)
+         (let ((brkpt-buffer (get-buffer-create
+                           (format "*Breakpoint %s*"
+                                   (realgud-get-buffer-base-name
+                                    (buffer-name)))))
+               (divert-string realgud-track-divert-string)
+               )
+           (realgud-cmdbuf-info-brkpt-buf= brkpt-buffer)
+           (with-current-buffer brkpt-buffer
+             (setq buffer-read-only nil)
+             (delete-region (point-min) (point-max))
+             (if divert-string
+                 (let* ((duple
+                         (realgud:breakpoint-add-text-properties
+                          brkpt-pat cmdbuf divert-string))
+                        (string-with-props
+                         (ansi-color-filter-apply (car duple)))
+                        (brkpt-num-pos-list (cadr duple))
+                        )
+                   (insert string-with-props)
+                   ;; add marks for each position
+                   (realgud-breakpoint-mode cmdbuf)
+                   (setq brkpt-pos-ring
+                         (make-ring (length brkpt-num-pos-list)))
+                   (dolist (pos brkpt-num-pos-list)
+                     (goto-char (1+ pos))
+                     (ring-insert-at-beginning brkpt-pos-ring (point-marker))
+                     )
+                   )
+               )
+             ;; realgud-breakpoint-mode kills all local variables so
+             ;; we set this after. Alternatively change 
realgud-breakpoint-mode.
+             (set (make-local-variable 'realgud-breakpoint-info)
+                  (make-realgud-breakpoint-info
+                   :cmdbuf cmdbuf
+                   :breakpoint-ring brkpt-pos-ring
+                   ))
+             )
+           )
+         )
+       )
+      )
+    (unless cmdbuf
+      (message "Unable to find debugger command buffer for %s" buffer))
+    )
+  )
+
+(defun realgud-breakpoint? ( &optional buffer)
+  "Return true if BUFFER is a debugger command buffer."
+  (with-current-buffer-safe
+   (or buffer (current-buffer))
+   (realgud-breakpoint-info-set?)))
+
+
+(defalias 'realgud-breakpoint-info? 'realgud-breakpoint-info-p)
+
+(defun realgud-breakpoint-info-set? ()
+  "Return true if realgud-breakpoint-info is set."
+  (and (boundp 'realgud-breakpoint-info)
+       realgud-breakpoint-info
+       (realgud-breakpoint-info? realgud-breakpoint-info)))
+
+
+(defun realgud-goto-entry-n ()
+  "Go to an entry number.
+
+Breakpoints, Display expressions and Stack Frames all have
+numbers associated with them which are distinct from line
+numbers.  In a secondary buffer, this function is usually bound to
+a numeric key which will position you at that entry number.  To
+go to an entry above 9, just keep entering the number.  For
+example, if you press 1 and then 9, you should jump to entry
+1 (if it exists) and then 19 (if that exists).  Entering any
+non-digit will start entry number from the beginning again."
+  (interactive)
+  (if (not (eq last-command 'realgud-goto-entry-n))
+      (setq realgud-goto-entry-acc ""))
+  (realgud-goto-entry-n-internal (this-command-keys)))
+
+(defun realgud-goto-breakpoint ()
+  "Go to the breakpoint number. We get the breakpoint number from the
+'brkpt-num property"
+  (interactive)
+  (if (realgud-breakpoint?)
+      (let ((loc (get-text-property (point) 'loc)))
+       (if loc
+           (realgud-loc-goto loc)
+         (message "No location property found at this point")
+         )
+       )
+    )
+  )
+
+(defun realgud-goto-breakpoint-mouse (event)
+  (interactive "e")
+  (let* ((pos (posn-point (event-end event)))
+        (loc (get-text-property pos 'loc)))
+    (if (realgud-breakpoint?)
+       (if loc
+           (realgud-loc-goto loc)
+         (message "No location property found at this point")
+         )
+      )
+    )
+)
+
+(defun realgud-goto-breakpoint-n ()
+  "Goto breakpoint number indicated by the accumulated numeric keys just 
entered.
+
+This function is usually bound to a numeric key in a 'frame'
+secondary buffer. To go to an entry above 9, just keep entering
+the number. For example, if you press 1 and then 9, frame 1 is selected
+\(if it exists) and then frame 19 (if that exists). Entering any
+non-digit will start entry number from the beginning again."
+  (interactive)
+  (if (not (eq last-command 'realgud-goto-breakpoint-n))
+      (setq realgud-goto-entry-acc ""))
+  (realgud-goto-breakpoint-n-internal (this-command-keys)))
+
+(defun realgud-goto-breakpoint-n-internal (keys)
+  (if (and (stringp keys)
+           (= (length keys) 1))
+      (progn
+        (setq realgud-goto-entry-acc (concat realgud-goto-entry-acc keys))
+        ;; Try to find the longest suffix.
+        (let ((acc realgud-goto-entry-acc))
+          (while (not (string= acc ""))
+            (if (not (realgud-goto-entry-try acc))
+                (setq acc (substring acc 1))
+              (realgud:cmd-frame (string-to-number acc))
+              ;; Break loop.
+              (setq acc "")))))
+    (message "`realgud-goto-breakpoint-n' must be bound to a number key")))
+
+(defun realgud:breakpoint-add-text-properties(brkpt-pat cmdbuf &optional 
opt-string)
+  "Parse OPT-STRING or the current buffer and add frame properties: frame 
number,
+filename, line number, whether the frame is selected as text properties."
+
+  (let* ((string (or opt-string
+                   (buffer-substring (point-min) (point-max))
+                   ))
+        (stripped-string (ansi-color-filter-apply string))
+        (brkpt-regexp (realgud-loc-pat-regexp brkpt-pat))
+        (brkpt-group-pat (realgud-loc-pat-num brkpt-pat))
+        (file-group-pat (realgud-loc-pat-file-group brkpt-pat))
+        (line-group-pat (realgud-loc-pat-line-group brkpt-pat))
+        (alt-brkpt-num -1)
+        (last-pos 0)
+        (selected-brkpt-num nil)
+        (brkpt-num-pos-list '())
+        )
+    (while (string-match brkpt-regexp stripped-string last-pos)
+      (let ((brkpt-num-str) (brkpt-num) (line-num) (filename)
+           ;; From https://github.com/realgud/realgud/pull/192
+           ;; Each brkpt of breakpoint is searched via string-match
+           ;; invocation and a position of the current brkpt is
+           ;; updated via (setq last-pos (match-end 0)) in the end of
+           ;; the loop. But somewhere in the body of the loop (I do
+           ;; not know exactly where), there is another call to
+           ;; string-match and it messes up all positions.
+           (whole-match-begin (match-beginning 0))
+           (whole-match-end (match-end 0))
+           (brkpt-num-pos)
+
+           )
+       (if brkpt-group-pat
+           (progn
+             (setq brkpt-num-str
+                   (substring stripped-string
+                              (match-beginning brkpt-group-pat)
+                              (match-end brkpt-group-pat)))
+             (setq brkpt-num (string-to-number brkpt-num-str))
+             (setq brkpt-num-pos (match-beginning brkpt-group-pat))
+             (cl-pushnew brkpt-num-pos brkpt-num-pos-list)
+             (add-text-properties (match-beginning brkpt-group-pat)
+                                  (match-end brkpt-group-pat)
+                                  (list 'mouse-face 'highlight
+                                        'help-echo "mouse-2: goto this brkpt"
+                                        'brkpt brkpt-num)
+                                  string)
+             )
+         ; else
+         (progn
+           (setq brkpt-num-str
+                   (substring stripped-string (match-beginning 0)
+                              (match-end 0)))
+           (setq brkpt-num (cl-incf alt-brkpt-num))
+           (setq brkpt-num-pos (match-beginning 0))
+           (cl-pushnew brkpt-num-pos brkpt-num-pos-list)
+           (add-text-properties (match-beginning 0) (match-end 0)
+                                (list 'mouse-face 'highlight
+                                      'help-echo "mouse-2: goto this brkpt"
+                                      'brkpt brkpt-num)
+                                string)
+           )
+         )
+       (when file-group-pat
+         (setq filename (substring stripped-string
+                                   (match-beginning file-group-pat)
+                                   (match-end file-group-pat)))
+         (add-text-properties (match-beginning file-group-pat)
+                              (match-end file-group-pat)
+                              (list 'mouse-face 'highlight
+                                    'help-echo "mouse-2: goto this file"
+                                    'action 'realgud:follow-event
+                                    'file filename)
+                              string)
+           )
+       (when line-group-pat
+         (let ((line-num-str (substring stripped-string
+                                   (match-beginning line-group-pat)
+                                   (match-end line-group-pat))))
+           (setq line-num (string-to-number (or line-num-str "1")))
+         ))
+
+       (when (and (stringp filename) (numberp line-num))
+         (let ((loc (realgud:file-loc-from-line filename line-num cmdbuf)))
+           (put-text-property whole-match-begin whole-match-end
+                              'loc loc string)
+           ))
+       (put-text-property whole-match-begin whole-match-end
+                          'brkpt-num  brkpt-num string)
+       (setq last-pos whole-match-end)
+       ))
+
+    (list string (nreverse brkpt-num-pos-list))
+    )
+  )
+
+(provide-me "realgud-buffer-")
diff --git a/realgud/common/buffer/command.el b/realgud/common/buffer/command.el
index 2cd7cfe..66b381d 100644
--- a/realgud/common/buffer/command.el
+++ b/realgud/common/buffer/command.el
@@ -84,6 +84,7 @@
   source-path          ;; last source-code path we've seen
 
   bt-buf               ;; backtrace buffer if it exists
+  brkpt-buf            ;; breakpoint buffer if it exists
   bp-list              ;; list of breakpoints
   divert-output?       ;; Output is part of a conversation between front-end
                        ;; debugger.
@@ -148,6 +149,7 @@
 ;; FIXME: figure out how to put in a loop.
 (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" "cmd-args")
 (realgud-struct-field-setter "realgud-cmdbuf-info" "last-input-end")
 (realgud-struct-field-setter "realgud-cmdbuf-info" "divert-output?")
@@ -201,7 +203,7 @@
 ;; FIXME: this is a cheat. We are inserting
 ;; and afterwards inserting ""
 (defun realgud:cmdbuf-bp-list-describe (info)
-  (let ((bp-list (realgud-cmdbuf-info-bp-list info)))
+  (let ((bp-list (delete-dups (realgud-cmdbuf-info-bp-list info))))
     (cond (bp-list
           (insert "** Breakpoint list (bp-list)\n")
           (dolist (loc bp-list "")
@@ -426,6 +428,7 @@ values set in the debugger's init.el."
   (with-current-buffer-safe cmd-buf
     (let ((realgud-loc-pat (gethash "loc" regexp-hash))
          (font-lock-keywords)
+         (font-lock-breakpoint-keywords)
          )
       (setq realgud-cmdbuf-info
            (make-realgud-cmdbuf-info
@@ -442,6 +445,7 @@ values set in the debugger's init.el."
             :regexp-hash regexp-hash
             :srcbuf-list nil
             :bt-buf nil
+            :brkpt-buf nil
             :bp-list nil
             :divert-output? nil
             :cmd-hash cmd-hash
@@ -464,8 +468,11 @@ values set in the debugger's init.el."
       (if font-lock-keywords
          (set (make-local-variable 'font-lock-defaults)
               (list font-lock-keywords)))
+      (setq font-lock-breakpoint-keywords (realgud-cmdbuf-pat 
"font-lock-breakpoint-keywords"))
+      (if font-lock-breakpoint-keywords
+         (set (make-local-variable 'font-lock-breakpoint-keywords)
+              (list font-lock-breakpoint-keywords)))
       )
-
     (put 'realgud-cmdbuf-info 'variable-documentation
         "Debugger object for a process buffer."))
   )
diff --git a/realgud/common/buffer/helper.el b/realgud/common/buffer/helper.el
index b30f8ad..eb17983 100644
--- a/realgud/common/buffer/helper.el
+++ b/realgud/common/buffer/helper.el
@@ -1,4 +1,4 @@
-; Copyright (C) 2010, 2014 Free Software Foundation, Inc
+; Copyright (C) 2010, 2014, 2019 Free Software Foundation, Inc
 
 ;; Author: Rocky Bernstein <address@hidden>
 
@@ -15,9 +15,10 @@
 (require 'load-relative)
 (require-relative-list '("../fringe" "../helper" "../lochist")
                       "realgud-")
-(require-relative-list '("command" "source" "backtrace") "realgud-buffer-")
+(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-cmdbuf?           'realgud-buffer-command)
 (declare-function realgud:loc-hist-describe 'realgud-lochist)
 (declare-function realgud-loc-hist-item     'realgud-lochist)
@@ -36,6 +37,16 @@ assumed to be a source-code buffer."
          (realgud-sget 'backtrace-info 'cmdbuf))
       nil)))
 
+(defun realgud-get-cmdbuf-from-breakpoint ( &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-breakpoint? buffer)
+       (with-current-buffer-safe buffer
+         (realgud-sget 'breakpoint-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
@@ -115,6 +126,8 @@ if we don't find anything."
        ;; Perhaps buffer is a backtrace buffer?
        ((realgud-backtrace? buffer)
        (realgud-get-cmdbuf-from-backtrace buffer))
+       ((realgud-breakpoint? buffer)
+       (realgud-get-cmdbuf-from-breakpoint buffer))
        (t nil)))))
 
 (defun realgud-get-backtrace-buf( &optional opt-buffer)
@@ -127,6 +140,16 @@ OPT-BUFFER or if that is ommited `current-buffer'."
       ))
   )
 
+(defun realgud-get-breakpoint-buf( &optional opt-buffer)
+  "Return the backtrace 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 'brkpt-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/cmds.el b/realgud/common/cmds.el
index f5fbd7d..cc589e7 100644
--- a/realgud/common/cmds.el
+++ b/realgud/common/cmds.el
@@ -356,6 +356,12 @@ If no argument specified use 0 or the most recent frame."
     (realgud:cmd-run-command arg "frame" nil t t)
 )
 
+(defun realgud:cmd-info-breakpoints()
+  "Show all list of all breakpoints."
+  (interactive "")
+  (realgud:cmd-run-command nil "info-breakpoints")
+  )
+
 (defun realgud:cmd-kill()
   "Kill debugger process."
   (interactive)
diff --git a/realgud/common/init.el b/realgud/common/init.el
index 7001d85..920faf6 100644
--- a/realgud/common/init.el
+++ b/realgud/common/init.el
@@ -1,4 +1,4 @@
-;; Copyright (C) 2010, 2015 Free Software Foundation, Inc
+;; Copyright (C) 2010, 2015, 2019 Free Software Foundation, Inc
 
 ;; Author: Rocky Bernstein <address@hidden>
 
@@ -39,6 +39,9 @@
 (defvar realgud-backtrace-number-face 'realgud-backtrace-number
   "Face name to use for backtrace numbers.")
 
+(defvar realgud-breakpoint-number-face 'realgud-backtrace-number
+  "Face name to use for breakpoint numbers.")
+
 (defvar realgud-file-name-face 'realgud-file-name
   "Face name to use for file names.")
 
diff --git a/realgud/common/track.el b/realgud/common/track.el
index b131e30..ceaa20a 100644
--- a/realgud/common/track.el
+++ b/realgud/common/track.el
@@ -617,8 +617,7 @@ Otherwise return nil. CMD-MARK is set in the realgud-loc 
object created.
            (with-current-buffer-safe (marker-buffer (realgud-loc-marker loc))
              (realgud-bp-add-info loc))
 
-           (unless (member loc bp-list)
-             (realgud-cmdbuf-info-bp-list= (cons loc bp-list)))
+           (realgud-cmdbuf-info-bp-list= (delete-dups (cl-adjoin loc bp-list 
:test #'equal)))
 
            ;; Set to return location
            (setq found-loc loc-or-error)
diff --git a/realgud/common/window.el b/realgud/common/window.el
index e922094..08068a5 100644
--- a/realgud/common/window.el
+++ b/realgud/common/window.el
@@ -1,4 +1,4 @@
-;; Copyright (C) 2010, 2014-2016 Free Software Foundation, Inc
+;; Copyright (C) 2010, 2014-2016, 2019 Free Software Foundation, Inc
 
 ;; Author: Rocky Bernstein <address@hidden>
 
@@ -52,7 +52,7 @@ See also `realgud-window-src-undisturb-cmd'"
   "Make sure the source buffers is displayed in windows without
 disturbing the command window if it is also displayed. Returns
 the command window
-See also `realgud-window-src'"
+See also `realgud-window-src'."
   (interactive)
   (let* ((buffer (or opt-buffer (current-buffer)))
         (src-buffer (realgud-get-srcbuf buffer))
@@ -77,10 +77,9 @@ See also `realgud-window-src'"
   )
 
 (defun realgud-window-cmd-undisturb-src ( &optional opt-buffer switch?)
-  "Make sure the source buffer is displayed in windows without
+  "Make sure the command buffer is displayed in windows without
 disturbing the command window if it is also displayed. Returns
-the source window.
-See also `realgud-window-src'"
+the source window."
   (interactive)
   (let* ((buffer (or opt-buffer (current-buffer)))
         (src-buffer (realgud-get-srcbuf buffer))
@@ -143,6 +142,40 @@ See also `realgud-window-src'"
     src-window)
   )
 
+(defun realgud:window-brkpt-undisturb-src ( &optional opt-buffer switch?)
+  "Make sure the backtrace 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))
+        (brkpt-buffer (realgud-get-breakpoint-buf cmd-buffer))
+        (brkpt-window (get-buffer-window brkpt-buffer))
+        (window (selected-window))
+        )
+    (when cmd-buffer
+      (unless brkpt-window
+       (setq brkpt-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 brkpt-window brkpt-buffer)
+       )
+      (if switch?
+         (and (select-window brkpt-window)
+              (switch-to-buffer brkpt-buffer)))
+
+      )
+    src-window)
+  )
+
 (defun realgud:window-bt()
   "Refresh backtrace information and display that in a buffer"
   (interactive)
@@ -153,6 +186,16 @@ See also `realgud-window-src'"
   )
 
 
+(defun realgud:window-brkpt()
+  "Refresh breakpoint information and display that in a buffer"
+  (interactive)
+  (with-current-buffer-safe (realgud-get-cmdbuf)
+    (realgud:breakpoint-init)
+    (realgud:window-brkpt-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/gdb/init.el b/realgud/debugger/gdb/init.el
index 0667aa2..5efa69e 100644
--- a/realgud/debugger/gdb/init.el
+++ b/realgud/debugger/gdb/init.el
@@ -112,6 +112,25 @@ realgud-loc-pat struct")
        :line-group 3)
       )
 
+;; FIXME breakpoints aren't locations. It should be a different structure
+;; Regular expression that describes a gdb "info breakpoint" line
+;; For example:
+;; 1       breakpoint     keep y   0x0000000000401471 in vcdnav_get_entries at 
ctest.c:67
+
+(setf (gethash "debugger-breakpoint" realgud:gdb-pat-hash)
+  (make-realgud-loc-pat
+   :regexp (format "^%s[ \t]+\\(breakpoint\\)[ \t]+\\(keep\\|del\\)[ 
\t]+\\([yn]\\)[ \t]+.*at \\(.+\\):%s"
+                  realgud:regexp-captured-num realgud:regexp-captured-num)
+   :num 1
+   :text-group 2  ;; misnamed Is "breakpoint" or "watchpoint"
+   :string 3      ;; misnamed. Is "keep" or "del"
+   ;; Enable is missing
+   ;; Skipped address
+   :file-group 5
+   :line-group 6)
+  )
+
+
 (setf (gethash "font-lock-keywords" realgud:gdb-pat-hash)
       '(
        ;; #2  0x080593ac in main (argc=2, argv=0xbffff5a4, envp=0xbffff5b0)
diff --git a/realgud/debugger/trepan3k/init.el 
b/realgud/debugger/trepan3k/init.el
index 3b87997..248a109 100644
--- a/realgud/debugger/trepan3k/init.el
+++ b/realgud/debugger/trepan3k/init.el
@@ -1,4 +1,4 @@
-;; Copyright (C) 2010-2018 Free Software Foundation, Inc
+;; Copyright (C) 2010-2019 Free Software Foundation, Inc
 
 ;; Author: Rocky Bernstein <address@hidden>
 
@@ -76,6 +76,12 @@ realgud-loc-pat struct")
 (setf (gethash "debugger-backtrace" realgud:trepan3k-pat-hash)
       realgud:python-trepan-backtrace-pat)
 
+;;  realgud-loc-pat that describes a line a Python "info break" line.
+;; For example:
+;; 1   breakpoint    keep y   at /usr/local/bin/trepan3k:7
+(setf (gethash "debugger-breakpoint" realgud:trepan3k-pat-hash)
+      realgud-python-breakpoint-pat)
+
 ;;  realgud-loc-pat that describes a Python backtrace line.
 (setf (gethash "lang-backtrace" realgud:trepan3k-pat-hash)
       realgud-python-backtrace-loc-pat)
@@ -115,6 +121,9 @@ realgud-loc-pat struct")
 (setf (gethash "font-lock-keywords" realgud:trepan3k-pat-hash)
       realgud:python-debugger-font-lock-keywords)
 
+(setf (gethash "font-lock-breakpoint-keywords" realgud:trepan3k-pat-hash)
+      realgud:python-debugger-font-lock-breakpoint-keywords)
+
 (setf (gethash "trepan3k" realgud-pat-hash) realgud:trepan3k-pat-hash)
 
 (defvar realgud:trepan3k-command-hash (make-hash-table :test 'equal)
diff --git a/realgud/lang/python.el b/realgud/lang/python.el
index 9d8822e..a2ddbfd 100644
--- a/realgud/lang/python.el
+++ b/realgud/lang/python.el
@@ -93,6 +93,23 @@ traceback) line."  )
    :line-group 4
    ))
 
+;; FIXME breakpoints aren't locations. It should be a different structure
+;; Regular expression that describes a trepan2/3k backtrace line.
+;; For example:
+;; 1   breakpoint    keep y   at 
/home/rocky/.pyenv/versions/3.7.2/lib/python3.7/importlib/_bootstrap.py:1019
+;; 2   breakpoint    keep y   at 
/home/rocky/.pyenv/versions/3.7.2/lib/python3.7/importlib/_bootstrap.py:1023
+;; 3   breakpoint    keep y   at 
/home/rocky/.pyenv/versions/3.7.2/lib/python3.7/importlib/_bootstrap.py:1
+(defconst realgud-python-breakpoint-pat
+  (make-realgud-loc-pat
+   :regexp (format "^%s[ \t]+\\(breakpoint\\)[ \t]+\\(keep\\|del\\)[ 
\t]+\\([yn]\\)[ \t]+.*at \\(.+\\):%s"
+                  realgud:regexp-captured-num realgud:regexp-captured-num)
+   :num 1
+   :text-group 2  ;; misnamed Is "breakpoint" or "watchpoint"
+   :string 3      ;; misnamed. Is "keep" or "del"
+   :file-group 5
+   :line-group 6)
+  "A realgud-loc-pat struct that describes a Python breakpoint."  )
+
 ;;  Regular expression that describes a "breakpoint set" line
 (defconst realgud:python-trepan-brkpt-set-pat
   (make-realgud-loc-pat
@@ -155,6 +172,23 @@ traceback) line."  )
     ;;  (0 trepan2-frames-current-frame-face append))
     ))
 
+(defconst realgud:python-debugger-font-lock-breakpoint-keywords
+  '(
+    ;; The breakpoint number, type and disposition
+    ;; 1   breakpoint    keep y   at 
/home/rocky/.pyenv/versions/3.7.2/bin/trepan3k:6
+    ;; ^   ^^^^^^^^^^    ^^^^
+    ("^\\([0-9]+\\)[ \t]+\\(breakpoint\\)[ \t]+\\(keep\\|del\\)"
+     (1 realgud-breakpoint-number-face)
+     (2 font-lock-function-name-face nil t)     ; t means optional.
+     (3 font-lock-function-name-face nil t))     ; t means optional.
+
+    ;; 1   breakpoint    keep y   at 
/home/rocky/.pyenv/versions/3.7.2/bin/trepan3k:6
+    ;;                            
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+    ("[ \t]+at \\(.+*\\):\\([0-9]+\\)"
+     (1 realgud-file-name-face)
+     (1 realgud-line-number-face))
+    ))
+
 (defconst realgud-pytest-error-loc-pat
   (make-realgud-loc-pat
    :regexp "^\\(.*\\):\\([0-9]+\\): in "
diff --git a/test/regexp-helper.el b/test/regexp-helper.el
index 76b18f0..7b50916 100644
--- a/test/regexp-helper.el
+++ b/test/regexp-helper.el
@@ -3,6 +3,7 @@
 
 (eval-when-compile
   (defvar helper-bps)
+  (defvar helper-info-brkpt)
   (defvar helper-loc)
   (defvar helper-tb)
   (defvar prompt-pat)
@@ -14,9 +15,10 @@
 
 
 (defun setup-regexp-vars(pat-hash)
-  (setq helper-bps    (gethash "brkpt-set" pat-hash))
-  (setq helper-loc    (gethash "loc"       pat-hash))
-  (setq helper-tb     (gethash "lang-backtrace" pat-hash))
+  (setq helper-bps         (gethash "brkpt-set" pat-hash))
+  (setq helper-info-brkpt  (gethash "debugger-breakpoint" pat-hash))
+  (setq helper-loc         (gethash "loc"       pat-hash))
+  (setq helper-tb          (gethash "lang-backtrace" pat-hash))
 )
 
 (defun loc-match(text regexp-list)
diff --git a/test/test-loc-regexp-gdb.el b/test/test-loc-regexp-gdb.el
index abde2a5..70c3281 100644
--- a/test/test-loc-regexp-gdb.el
+++ b/test/test-loc-regexp-gdb.el
@@ -24,6 +24,7 @@
   (defvar dbg-name)
   (defvar realgud-pat-hash)
   (defvar helper-bps)
+  (defvar helper-info-brkpt)
   (defvar loc-pat)
   (defvar prompt-pat)
   (defvar realgud:gdb-pat-hash)
@@ -102,5 +103,19 @@
              (match-string 3  test-s1)
              "extract breakpoint line number")
 
+(setq test-s1
+      "1       breakpoint     keep y   0x0000000000401471 in 
vcdnav_get_entries at ctest.c:67")
+
+(assert-t (numberp (loc-match test-s1 helper-info-brkpt))
+         "basic breakpoint location")
+(assert-equal "1"
+             (match-string 1 test-s1)   "extract breakpoint number")
+
+(assert-equal "ctest.c"
+             (match-string 5 test-s1)   "extract breakpoint file name")
+(assert-equal "67"
+             (match-string 6  test-s1)
+             "extract breakpoint line number")
+
 
 (end-tests)
diff --git a/test/test-regexp-trepan3k.el b/test/test-regexp-trepan3k.el
index 1c60d52..e640827 100644
--- a/test/test-regexp-trepan3k.el
+++ b/test/test-regexp-trepan3k.el
@@ -164,4 +164,19 @@
  (match-string (realgud-loc-pat-text-group helper-loc)
               test-s1)   "extract source text")
 
+(setq test-s1
+      "1   breakpoint    keep y   at 
/home/rocky/.pyenv/versions/3.7.2/lib/python3.7/importlib/_bootstrap.py:1019")
+
+(assert-t (numberp (loc-match test-s1 helper-info-brkpt))
+         "basic breakpoint location")
+(assert-equal "1"
+             (match-string 1 test-s1)   "extract breakpoint number")
+
+(assert-equal 
"/home/rocky/.pyenv/versions/3.7.2/lib/python3.7/importlib/_bootstrap.py"
+             (match-string 5 test-s1)   "extract breakpoint file name")
+(assert-equal "1019"
+             (match-string 6 test-s1)
+             "extract breakpoint line number")
+
+
 (end-tests)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]