Mercurial > emacs
changeset 86061:d04fdae07d21
(gdb-parent-bptno-enabled): New variable.
(gdb-breakpoint-regexp, gdb-mouse-toggle-breakpoint-margin)
(gdb-mouse-toggle-breakpoint-fringe, gdb-delete-breakpoint)
(gdb-goto-breakpoint): Generalise for breakpoints with multiple
locations.
(gdb-info-breakpoints-custom, gdb-assembler-custom)
(gdb-toggle-breakpoint): Update for new gdb-breakpoint-regexp.
(gdb-put-breakpoint-icon): Only display icon for parent breakpoint.
author | Nick Roberts <nickrob@snap.net.nz> |
---|---|
date | Wed, 14 Nov 2007 08:59:16 +0000 |
parents | 7aeb4f4f819f |
children | f4816ef45bcb |
files | lisp/progmodes/gdb-ui.el |
diffstat | 1 files changed, 52 insertions(+), 42 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/progmodes/gdb-ui.el Wed Nov 14 08:58:07 2007 +0000 +++ b/lisp/progmodes/gdb-ui.el Wed Nov 14 08:59:16 2007 +0000 @@ -138,6 +138,7 @@ (defvar gdb-frame-begin nil "Non-nil when GDB generates frame-begin annotation.") (defvar gdb-printing t) +(defvar gdb-parent-bptno-enabled nil) (defvar gdb-buffer-type nil "One of the symbols bound in `gdb-buffer-rules'.") @@ -1860,7 +1861,7 @@ :group 'gud) (defconst gdb-breakpoint-regexp - "\\([0-9]+\\).*?\\(?:point\\|catch\\s-+\\S-+\\)\\s-+\\S-+\\s-+\\(.\\)\\s-+") + "\\(?:\\([0-9]+\\).*?\\(?:point\\|catch\\s-+\\S-+\\)\\s-+\\S-+\\|\\([0-9]+\\.[0-9]+\\)\\)\\s-+\\(.\\)\\s-+") ;; Put breakpoint icons in relevant margins (even those set in the GUD buffer). (defun gdb-info-breakpoints-custom () @@ -1879,10 +1880,12 @@ (forward-line 1) (if (looking-at gdb-breakpoint-regexp) (progn - (setq bptno (match-string 1)) - (setq flag (char-after (match-beginning 2))) + (setq bptno (or (match-string 1) (match-string 2))) + (setq flag (char-after (match-beginning 3))) + (if (match-string 1) + (setq gdb-parent-bptno-enabled (eq flag ?y))) (add-text-properties - (match-beginning 2) (match-end 2) + (match-beginning 3) (match-end 3) (if (eq flag ?y) '(face font-lock-warning-face) '(face font-lock-type-face))) @@ -1963,17 +1966,18 @@ (save-excursion (goto-char (posn-point posn)) (if (posn-object posn) - (gdb-enqueue-input - (list - (let ((bptno (get-text-property - 0 'gdb-bptno (car (posn-string posn))))) + (let* ((bptno (get-text-property + 0 'gdb-bptno (car (posn-string posn))))) + (string-match "\\([0-9+]\\)*" bptno) + (gdb-enqueue-input + (list (concat gdb-server-prefix (if (get-text-property 0 'gdb-enabled (car (posn-string posn))) "disable " "enable ") - bptno "\n")) - 'ignore)))))))) + (match-string 1 bptno) "\n") + 'ignore))))))))) (defun gdb-mouse-toggle-breakpoint-fringe (event) "Enable/disable breakpoint in left fringe with mouse click." @@ -1991,14 +1995,16 @@ (when (overlay-get overlay 'put-break) (setq obj (overlay-get overlay 'before-string)))) (when (stringp obj) - (gdb-enqueue-input - (list - (concat gdb-server-prefix - (if (get-text-property 0 'gdb-enabled obj) - "disable " - "enable ") - (get-text-property 0 'gdb-bptno obj) "\n") - 'ignore)))))))) + (let* ((bptno (get-text-property 0 'gdb-bptno obj))) + (string-match "\\([0-9+]\\)*" bptno) + (gdb-enqueue-input + (list + (concat gdb-server-prefix + (if (get-text-property 0 'gdb-enabled obj) + "disable " + "enable ") + (match-string 1 bptno) "\n") + 'ignore))))))))) (defun gdb-breakpoints-buffer-name () (with-current-buffer gud-comint-buffer @@ -2064,21 +2070,25 @@ (gdb-enqueue-input (list (concat gdb-server-prefix - (if (eq ?y (char-after (match-beginning 2))) + (if (eq ?y (char-after (match-beginning 3))) "disable " "enable ") - (match-string 1) "\n") 'ignore)) + (or (match-string 1) (match-string 2)) "\n") 'ignore)) (error "Not recognized as break/watchpoint line")))) (defun gdb-delete-breakpoint () "Delete the breakpoint at current line." (interactive) - (beginning-of-line 1) - (if (looking-at gdb-breakpoint-regexp) - (gdb-enqueue-input - (list - (concat gdb-server-prefix "delete " (match-string 1) "\n") 'ignore)) - (error "Not recognized as break/watchpoint line"))) + (save-excursion + (beginning-of-line 1) + (if (looking-at gdb-breakpoint-regexp) + (if (match-string 1) + (gdb-enqueue-input + (list + (concat gdb-server-prefix "delete " (match-string 1) "\n") + 'ignore)) + (message-box "This breakpoint cannot be deleted on its own.")) + (error "Not recognized as break/watchpoint line")))) (defun gdb-goto-breakpoint (&optional event) "Display the breakpoint location specified at current line." @@ -2086,7 +2096,7 @@ (if event (posn-set-point (event-end event))) (save-excursion (beginning-of-line 1) - (if (looking-at "\\([0-9]+\\) .+ in .+ at\\s-+\\(\\S-+\\):\\([0-9]+\\)") + (if (looking-at "\\([0-9]+\\.?[0-9]*\\) .+ in .+ at\\s-+\\(\\S-+\\):\\([0-9]+\\)") (let ((bptno (match-string 1)) (file (match-string 2)) (line (match-string 3))) @@ -3156,6 +3166,8 @@ (delete-overlay overlay)))) (defun gdb-put-breakpoint-icon (enabled bptno) + (if (string-match "[0-9+]+\\." bptno) + (setq enabled gdb-parent-bptno-enabled)) (let ((start (- (line-beginning-position) 1)) (end (+ (line-end-position) 1)) (putstring (if enabled "B" "b")) @@ -3215,8 +3227,8 @@ (setq left-margin-width 2) (let ((window (get-buffer-window (current-buffer) 0))) (if window - (set-window-margins - window left-margin-width right-margin-width))))) + (set-window-margins + window left-margin-width right-margin-width))))) (gdb-put-string (propertize putstring 'face (if enabled 'breakpoint-enabled 'breakpoint-disabled)) @@ -3286,18 +3298,16 @@ (goto-char (point-min)) (while (< (point) (- (point-max) 1)) (forward-line 1) - (if (looking-at "[^\t].*?breakpoint") - (progn - (looking-at - "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\(.\\)\\s-+0x0*\\(\\S-+\\)") - (setq bptno (match-string 1)) - (setq flag (char-after (match-beginning 2))) - (setq address (match-string 3)) - (with-current-buffer buffer - (save-excursion - (goto-char (point-min)) - (if (search-forward address nil t) - (gdb-put-breakpoint-icon (eq flag ?y) bptno)))))))) + (when (looking-at + "\\([0-9]+\\.?[0-9]*\\).*?\\s-+\\(.\\)\\s-+0x0*\\(\\S-+\\)") + (setq bptno (match-string 1)) + (setq flag (char-after (match-beginning 2))) + (setq address (match-string 3)) + (with-current-buffer buffer + (save-excursion + (goto-char (point-min)) + (if (search-forward address nil t) + (gdb-put-breakpoint-icon (eq flag ?y) bptno))))))) (if (not (equal gdb-pc-address "main")) (with-current-buffer buffer (set-window-point (get-buffer-window buffer 0) pos))))) @@ -3458,7 +3468,7 @@ (gdb-force-mode-line-update (propertize "ready" 'face font-lock-variable-name-face))) -; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards. +; Uses "-var-list-children --all-values". Needs GDB 6.4 onwards. (defun gdb-var-list-children-1 (varnum) (gdb-enqueue-input (list