aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorNick Roberts2007-11-14 08:59:16 +0000
committerNick Roberts2007-11-14 08:59:16 +0000
commit266e779b867761d040bba661b645254434b6ea4d (patch)
treef1a3beadebb1f4d8e456d5a8b0eb1542f0f4d0ee
parent8e813bab827186902ba1b8e3e056193409bd198e (diff)
downloademacs-266e779b867761d040bba661b645254434b6ea4d.tar.gz
emacs-266e779b867761d040bba661b645254434b6ea4d.zip
(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.
-rw-r--r--lisp/progmodes/gdb-ui.el94
1 files changed, 52 insertions, 42 deletions
diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el
index 0d1a4b05d65..4100fceb057 100644
--- a/lisp/progmodes/gdb-ui.el
+++ b/lisp/progmodes/gdb-ui.el
@@ -138,6 +138,7 @@ Emacs can't find.")
138(defvar gdb-frame-begin nil 138(defvar gdb-frame-begin nil
139 "Non-nil when GDB generates frame-begin annotation.") 139 "Non-nil when GDB generates frame-begin annotation.")
140(defvar gdb-printing t) 140(defvar gdb-printing t)
141(defvar gdb-parent-bptno-enabled nil)
141 142
142(defvar gdb-buffer-type nil 143(defvar gdb-buffer-type nil
143 "One of the symbols bound in `gdb-buffer-rules'.") 144 "One of the symbols bound in `gdb-buffer-rules'.")
@@ -1860,7 +1861,7 @@ static char *magick[] = {
1860 :group 'gud) 1861 :group 'gud)
1861 1862
1862(defconst gdb-breakpoint-regexp 1863(defconst gdb-breakpoint-regexp
1863 "\\([0-9]+\\).*?\\(?:point\\|catch\\s-+\\S-+\\)\\s-+\\S-+\\s-+\\(.\\)\\s-+") 1864 "\\(?:\\([0-9]+\\).*?\\(?:point\\|catch\\s-+\\S-+\\)\\s-+\\S-+\\|\\([0-9]+\\.[0-9]+\\)\\)\\s-+\\(.\\)\\s-+")
1864 1865
1865;; Put breakpoint icons in relevant margins (even those set in the GUD buffer). 1866;; Put breakpoint icons in relevant margins (even those set in the GUD buffer).
1866(defun gdb-info-breakpoints-custom () 1867(defun gdb-info-breakpoints-custom ()
@@ -1879,10 +1880,12 @@ static char *magick[] = {
1879 (forward-line 1) 1880 (forward-line 1)
1880 (if (looking-at gdb-breakpoint-regexp) 1881 (if (looking-at gdb-breakpoint-regexp)
1881 (progn 1882 (progn
1882 (setq bptno (match-string 1)) 1883 (setq bptno (or (match-string 1) (match-string 2)))
1883 (setq flag (char-after (match-beginning 2))) 1884 (setq flag (char-after (match-beginning 3)))
1885 (if (match-string 1)
1886 (setq gdb-parent-bptno-enabled (eq flag ?y)))
1884 (add-text-properties 1887 (add-text-properties
1885 (match-beginning 2) (match-end 2) 1888 (match-beginning 3) (match-end 3)
1886 (if (eq flag ?y) 1889 (if (eq flag ?y)
1887 '(face font-lock-warning-face) 1890 '(face font-lock-warning-face)
1888 '(face font-lock-type-face))) 1891 '(face font-lock-type-face)))
@@ -1963,17 +1966,18 @@ static char *magick[] = {
1963 (save-excursion 1966 (save-excursion
1964 (goto-char (posn-point posn)) 1967 (goto-char (posn-point posn))
1965 (if (posn-object posn) 1968 (if (posn-object posn)
1966 (gdb-enqueue-input 1969 (let* ((bptno (get-text-property
1967 (list 1970 0 'gdb-bptno (car (posn-string posn)))))
1968 (let ((bptno (get-text-property 1971 (string-match "\\([0-9+]\\)*" bptno)
1969 0 'gdb-bptno (car (posn-string posn))))) 1972 (gdb-enqueue-input
1973 (list
1970 (concat gdb-server-prefix 1974 (concat gdb-server-prefix
1971 (if (get-text-property 1975 (if (get-text-property
1972 0 'gdb-enabled (car (posn-string posn))) 1976 0 'gdb-enabled (car (posn-string posn)))
1973 "disable " 1977 "disable "
1974 "enable ") 1978 "enable ")
1975 bptno "\n")) 1979 (match-string 1 bptno) "\n")
1976 'ignore)))))))) 1980 'ignore)))))))))
1977 1981
1978(defun gdb-mouse-toggle-breakpoint-fringe (event) 1982(defun gdb-mouse-toggle-breakpoint-fringe (event)
1979 "Enable/disable breakpoint in left fringe with mouse click." 1983 "Enable/disable breakpoint in left fringe with mouse click."
@@ -1991,14 +1995,16 @@ static char *magick[] = {
1991 (when (overlay-get overlay 'put-break) 1995 (when (overlay-get overlay 'put-break)
1992 (setq obj (overlay-get overlay 'before-string)))) 1996 (setq obj (overlay-get overlay 'before-string))))
1993 (when (stringp obj) 1997 (when (stringp obj)
1994 (gdb-enqueue-input 1998 (let* ((bptno (get-text-property 0 'gdb-bptno obj)))
1995 (list 1999 (string-match "\\([0-9+]\\)*" bptno)
1996 (concat gdb-server-prefix 2000 (gdb-enqueue-input
1997 (if (get-text-property 0 'gdb-enabled obj) 2001 (list
1998 "disable " 2002 (concat gdb-server-prefix
1999 "enable ") 2003 (if (get-text-property 0 'gdb-enabled obj)
2000 (get-text-property 0 'gdb-bptno obj) "\n") 2004 "disable "
2001 'ignore)))))))) 2005 "enable ")
2006 (match-string 1 bptno) "\n")
2007 'ignore)))))))))
2002 2008
2003(defun gdb-breakpoints-buffer-name () 2009(defun gdb-breakpoints-buffer-name ()
2004 (with-current-buffer gud-comint-buffer 2010 (with-current-buffer gud-comint-buffer
@@ -2064,21 +2070,25 @@ static char *magick[] = {
2064 (gdb-enqueue-input 2070 (gdb-enqueue-input
2065 (list 2071 (list
2066 (concat gdb-server-prefix 2072 (concat gdb-server-prefix
2067 (if (eq ?y (char-after (match-beginning 2))) 2073 (if (eq ?y (char-after (match-beginning 3)))
2068 "disable " 2074 "disable "
2069 "enable ") 2075 "enable ")
2070 (match-string 1) "\n") 'ignore)) 2076 (or (match-string 1) (match-string 2)) "\n") 'ignore))
2071 (error "Not recognized as break/watchpoint line")))) 2077 (error "Not recognized as break/watchpoint line"))))
2072 2078
2073(defun gdb-delete-breakpoint () 2079(defun gdb-delete-breakpoint ()
2074 "Delete the breakpoint at current line." 2080 "Delete the breakpoint at current line."
2075 (interactive) 2081 (interactive)
2076 (beginning-of-line 1) 2082 (save-excursion
2077 (if (looking-at gdb-breakpoint-regexp) 2083 (beginning-of-line 1)
2078 (gdb-enqueue-input 2084 (if (looking-at gdb-breakpoint-regexp)
2079 (list 2085 (if (match-string 1)
2080 (concat gdb-server-prefix "delete " (match-string 1) "\n") 'ignore)) 2086 (gdb-enqueue-input
2081 (error "Not recognized as break/watchpoint line"))) 2087 (list
2088 (concat gdb-server-prefix "delete " (match-string 1) "\n")
2089 'ignore))
2090 (message-box "This breakpoint cannot be deleted on its own."))
2091 (error "Not recognized as break/watchpoint line"))))
2082 2092
2083(defun gdb-goto-breakpoint (&optional event) 2093(defun gdb-goto-breakpoint (&optional event)
2084 "Display the breakpoint location specified at current line." 2094 "Display the breakpoint location specified at current line."
@@ -2086,7 +2096,7 @@ static char *magick[] = {
2086 (if event (posn-set-point (event-end event))) 2096 (if event (posn-set-point (event-end event)))
2087 (save-excursion 2097 (save-excursion
2088 (beginning-of-line 1) 2098 (beginning-of-line 1)
2089 (if (looking-at "\\([0-9]+\\) .+ in .+ at\\s-+\\(\\S-+\\):\\([0-9]+\\)") 2099 (if (looking-at "\\([0-9]+\\.?[0-9]*\\) .+ in .+ at\\s-+\\(\\S-+\\):\\([0-9]+\\)")
2090 (let ((bptno (match-string 1)) 2100 (let ((bptno (match-string 1))
2091 (file (match-string 2)) 2101 (file (match-string 2))
2092 (line (match-string 3))) 2102 (line (match-string 3)))
@@ -3156,6 +3166,8 @@ BUFFER nil or omitted means use the current buffer."
3156 (delete-overlay overlay)))) 3166 (delete-overlay overlay))))
3157 3167
3158(defun gdb-put-breakpoint-icon (enabled bptno) 3168(defun gdb-put-breakpoint-icon (enabled bptno)
3169 (if (string-match "[0-9+]+\\." bptno)
3170 (setq enabled gdb-parent-bptno-enabled))
3159 (let ((start (- (line-beginning-position) 1)) 3171 (let ((start (- (line-beginning-position) 1))
3160 (end (+ (line-end-position) 1)) 3172 (end (+ (line-end-position) 1))
3161 (putstring (if enabled "B" "b")) 3173 (putstring (if enabled "B" "b"))
@@ -3215,8 +3227,8 @@ BUFFER nil or omitted means use the current buffer."
3215 (setq left-margin-width 2) 3227 (setq left-margin-width 2)
3216 (let ((window (get-buffer-window (current-buffer) 0))) 3228 (let ((window (get-buffer-window (current-buffer) 0)))
3217 (if window 3229 (if window
3218 (set-window-margins 3230 (set-window-margins
3219 window left-margin-width right-margin-width))))) 3231 window left-margin-width right-margin-width)))))
3220 (gdb-put-string 3232 (gdb-put-string
3221 (propertize putstring 3233 (propertize putstring
3222 'face (if enabled 'breakpoint-enabled 'breakpoint-disabled)) 3234 'face (if enabled 'breakpoint-enabled 'breakpoint-disabled))
@@ -3286,18 +3298,16 @@ BUFFER nil or omitted means use the current buffer."
3286 (goto-char (point-min)) 3298 (goto-char (point-min))
3287 (while (< (point) (- (point-max) 1)) 3299 (while (< (point) (- (point-max) 1))
3288 (forward-line 1) 3300 (forward-line 1)
3289 (if (looking-at "[^\t].*?breakpoint") 3301 (when (looking-at
3290 (progn 3302 "\\([0-9]+\\.?[0-9]*\\).*?\\s-+\\(.\\)\\s-+0x0*\\(\\S-+\\)")
3291 (looking-at 3303 (setq bptno (match-string 1))
3292 "\\([0-9]+\\)\\s-+\\S-+\\s-+\\S-+\\s-+\\(.\\)\\s-+0x0*\\(\\S-+\\)") 3304 (setq flag (char-after (match-beginning 2)))
3293 (setq bptno (match-string 1)) 3305 (setq address (match-string 3))
3294 (setq flag (char-after (match-beginning 2))) 3306 (with-current-buffer buffer
3295 (setq address (match-string 3)) 3307 (save-excursion
3296 (with-current-buffer buffer 3308 (goto-char (point-min))
3297 (save-excursion 3309 (if (search-forward address nil t)
3298 (goto-char (point-min)) 3310 (gdb-put-breakpoint-icon (eq flag ?y) bptno)))))))
3299 (if (search-forward address nil t)
3300 (gdb-put-breakpoint-icon (eq flag ?y) bptno))))))))
3301 (if (not (equal gdb-pc-address "main")) 3311 (if (not (equal gdb-pc-address "main"))
3302 (with-current-buffer buffer 3312 (with-current-buffer buffer
3303 (set-window-point (get-buffer-window buffer 0) pos))))) 3313 (set-window-point (get-buffer-window buffer 0) pos)))))
@@ -3458,7 +3468,7 @@ is set in them."
3458 (gdb-force-mode-line-update 3468 (gdb-force-mode-line-update
3459 (propertize "ready" 'face font-lock-variable-name-face))) 3469 (propertize "ready" 'face font-lock-variable-name-face)))
3460 3470
3461; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards. 3471; Uses "-var-list-children --all-values". Needs GDB 6.4 onwards.
3462(defun gdb-var-list-children-1 (varnum) 3472(defun gdb-var-list-children-1 (varnum)
3463 (gdb-enqueue-input 3473 (gdb-enqueue-input
3464 (list 3474 (list