[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/realgud 8028bfb 125/140: Add a breakpoint buffer analog
|
From: |
Rocky Bernstein |
|
Subject: |
[elpa] externals/realgud 8028bfb 125/140: Add a breakpoint buffer analogous to backtrace |
|
Date: |
Sat, 25 May 2019 19:35:48 -0400 (EDT) |
branch: externals/realgud
commit 8028bfb8bb8854487d12219295e86347421248ad
Author: rocky <address@hidden>
Commit: rocky <address@hidden>
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 776225e..fa001d4 100644
--- a/realgud/common/cmds.el
+++ b/realgud/common/cmds.el
@@ -355,6 +355,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)
- [elpa] externals/realgud 4d9c31b 119/140: Improve realgud:attach-cmd-buffer..., (continued)
- [elpa] externals/realgud 4d9c31b 119/140: Improve realgud:attach-cmd-buffer..., Rocky Bernstein, 2019/05/25
- [elpa] externals/realgud 79c982d 124/140: Add a comment, Rocky Bernstein, 2019/05/25
- [elpa] externals/realgud 0821db0 137/140: Get ready for release 1.4.6, Rocky Bernstein, 2019/05/25
- [elpa] externals/realgud c5d52ff 131/140: Add breakpoint-all regexps for most debuggers, Rocky Bernstein, 2019/05/25
- [elpa] externals/realgud 7c0acdc 140/140: Another pass over function declarations, Rocky Bernstein, 2019/05/25
- [elpa] externals/realgud 807c066 128/140: Initialize more debuggers with breakpoint buffer information, Rocky Bernstein, 2019/05/25
- [elpa] externals/realgud 57a8fc1 126/140: Merge pull request #244 from realgud/add-brpt-buffer, Rocky Bernstein, 2019/05/25
- [elpa] externals/realgud 1cfadb2 123/140: Lots of small changes..., Rocky Bernstein, 2019/05/25
- [elpa] externals/realgud d79a090 133/140: Handle location not found in bp-list for breakpoint buffer, Rocky Bernstein, 2019/05/25
- [elpa] externals/realgud 1ccd8cd 139/140: buffer info org-mode tweaks, Rocky Bernstein, 2019/05/25
- [elpa] externals/realgud 8028bfb 125/140: Add a breakpoint buffer analogous to backtrace,
Rocky Bernstein <=